Index: cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-2c.kids =================================================================== --- cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-2c.kids (revision 466) +++ cprs/branches/tmg-cprs/Server_KIDS/TMG1-1.0-2c.kids (revision 466) @@ -0,0 +1,124157 @@ +KIDS Distribution saved on Jun 21, 2008@15:38:50 +TMG 1*1.0*2c + +No Package File Link**KIDS**:TMG1*1.0*2^ + +**INSTALL NAME** +TMG1*1.0*2 +"BLD",5420,0) +TMG1*1.0*2^^0^3080621^n +"BLD",5420,1,0) +^^3^3^3080416^^ +"BLD",5420,1,1,0) +This KIDS build contains most of the TMG library as of 4/16/08. +"BLD",5420,1,2,0) +The primary purpose of the build is to install server-side code +"BLD",5420,1,3,0) +to support customizations of CPRS. +"BLD",5420,4,0) +^9.64PA^8925.1^12 +"BLD",5420,4,2005.2,0) +2005.2 +"BLD",5420,4,2005.2,2,0) +^9.641^2005.2^1 +"BLD",5420,4,2005.2,2,2005.2,0) +NETWORK LOCATION (File-top level) +"BLD",5420,4,2005.2,2,2005.2,1,0) +^9.6411^22700^3 +"BLD",5420,4,2005.2,2,2005.2,1,22700,0) +TMG PRIVATE PHYSICAL REFERENCE +"BLD",5420,4,2005.2,2,2005.2,1,22701,0) +TMG NODE DIVIDER SYMBOL +"BLD",5420,4,2005.2,2,2005.2,1,22702,0) +TMG DROPBOX PHYSICAL REFERENCE +"BLD",5420,4,2005.2,222) +y^y^p^^^^n^^n +"BLD",5420,4,2005.2,224) + +"BLD",5420,4,8925.1,0) +8925.1 +"BLD",5420,4,8925.1,222) +n^n^f^^y^^y^a^n +"BLD",5420,4,8925.1,224) +I X["TMG" +"BLD",5420,4,22706.1,0) +22706.1 +"BLD",5420,4,22706.1,222) +y^y^f^^^^n +"BLD",5420,4,22706.2,0) +22706.2 +"BLD",5420,4,22706.2,222) +y^y^f^^^^n +"BLD",5420,4,22706.3,0) +22706.3 +"BLD",5420,4,22706.3,222) +y^y^f^^^^n +"BLD",5420,4,22706.4,0) +22706.4 +"BLD",5420,4,22706.4,222) +y^y^f^^^^n +"BLD",5420,4,22706.5,0) +22706.5 +"BLD",5420,4,22706.5,222) +y^y^f^^^^n +"BLD",5420,4,22706.6,0) +22706.6 +"BLD",5420,4,22706.6,222) +y^y^f^^^^n +"BLD",5420,4,22706.7,0) +22706.7 +"BLD",5420,4,22706.7,222) +y^y^f^^^^n +"BLD",5420,4,22706.8,0) +22706.8 +"BLD",5420,4,22706.8,222) +y^y^f^^^^n +"BLD",5420,4,22706.82,0) +22706.82 +"BLD",5420,4,22706.82,222) +y^y^f^^^^n +"BLD",5420,4,22706.9,0) +22706.9 +"BLD",5420,4,22706.9,222) +y^y^f^^^^n +"BLD",5420,4,"APDD",2005.2,2005.2) + +"BLD",5420,4,"APDD",2005.2,2005.2,22700) + +"BLD",5420,4,"APDD",2005.2,2005.2,22701) + +"BLD",5420,4,"APDD",2005.2,2005.2,22702) + +"BLD",5420,4,"B",2005.2,2005.2) + +"BLD",5420,4,"B",8925.1,8925.1) + +"BLD",5420,4,"B",22706.1,22706.1) + +"BLD",5420,4,"B",22706.2,22706.2) + +"BLD",5420,4,"B",22706.3,22706.3) + +"BLD",5420,4,"B",22706.4,22706.4) + +"BLD",5420,4,"B",22706.5,22706.5) + +"BLD",5420,4,"B",22706.6,22706.6) + +"BLD",5420,4,"B",22706.7,22706.7) + +"BLD",5420,4,"B",22706.8,22706.8) + +"BLD",5420,4,"B",22706.82,22706.82) + +"BLD",5420,4,"B",22706.9,22706.9) + +"BLD",5420,"INIT") +POSTINST^TMGKIDS +"BLD",5420,"KRN",0) +^9.67PA^8989.52^19 +"BLD",5420,"KRN",.4,0) +.4 +"BLD",5420,"KRN",.4,"NM",0) +^9.68A^7^1 +"BLD",5420,"KRN",.4,"NM",7,0) +TMG SENSITIVITY ACCESS FILE #38.1^38.1^0 +"BLD",5420,"KRN",.4,"NM","B","TMG SENSITIVITY ACCESS FILE #38.1",7) + +"BLD",5420,"KRN",.401,0) +.401 +"BLD",5420,"KRN",.401,"NM",0) +^9.68A^^0 +"BLD",5420,"KRN",.402,0) +.402 +"BLD",5420,"KRN",.403,0) +.403 +"BLD",5420,"KRN",.403,"NM",0) +^9.68A^5^5 +"BLD",5420,"KRN",.403,"NM",1,0) +TMG EDIT DRUG FILE #50^50^0 +"BLD",5420,"KRN",.403,"NM",2,0) +TMG EDIT PROGRESS NOTE FILE #8925^8925^0 +"BLD",5420,"KRN",.403,"NM",3,0) +TMG REGISTER FILE #2^2^0 +"BLD",5420,"KRN",.403,"NM",4,0) +TMG UPDATE SETTINGS FILE #22711^22711^0 +"BLD",5420,"KRN",.403,"NM",5,0) +TMG VIEW DRUG FILE #50.68^50.68^0 +"BLD",5420,"KRN",.403,"NM","B","TMG EDIT DRUG FILE #50",1) + +"BLD",5420,"KRN",.403,"NM","B","TMG EDIT PROGRESS NOTE FILE #8925",2) + +"BLD",5420,"KRN",.403,"NM","B","TMG REGISTER FILE #2",3) + +"BLD",5420,"KRN",.403,"NM","B","TMG UPDATE SETTINGS FILE #22711",4) + +"BLD",5420,"KRN",.403,"NM","B","TMG VIEW DRUG FILE #50.68",5) + +"BLD",5420,"KRN",.5,0) +.5 +"BLD",5420,"KRN",.84,0) +.84 +"BLD",5420,"KRN",3.6,0) +3.6 +"BLD",5420,"KRN",3.8,0) +3.8 +"BLD",5420,"KRN",9.2,0) +9.2 +"BLD",5420,"KRN",9.8,0) +9.8 +"BLD",5420,"KRN",9.8,"NM",0) +^9.68A^112^96 +"BLD",5420,"KRN",9.8,"NM",1,0) +TMGABV^^0^B86362 +"BLD",5420,"KRN",9.8,"NM",2,0) +TMGBINF^^0^B6621 +"BLD",5420,"KRN",9.8,"NM",3,0) +TMGBROWS^^0^B6541 +"BLD",5420,"KRN",9.8,"NM",4,0) +TMGBUTIL^^0^B7315 +"BLD",5420,"KRN",9.8,"NM",5,0) +TMGCHR^^0^B22942466 +"BLD",5420,"KRN",9.8,"NM",6,0) +TMGDBAP2^^0^B3476 +"BLD",5420,"KRN",9.8,"NM",7,0) +TMGDBAPI^^0^B13065932 +"BLD",5420,"KRN",9.8,"NM",8,0) +TMGDEBUG^^0^B10834 +"BLD",5420,"KRN",9.8,"NM",9,0) +TMGDIA3^^0^B1371075 +"BLD",5420,"KRN",9.8,"NM",10,0) +TMGDIS^^0^B118560815 +"BLD",5420,"KRN",9.8,"NM",11,0) +TMGDIS0^^0^B39243874 +"BLD",5420,"KRN",9.8,"NM",12,0) +TMGDIS1^^0^B43572349 +"BLD",5420,"KRN",9.8,"NM",13,0) +TMGDIS2^^0^B21503917 +"BLD",5420,"KRN",9.8,"NM",14,0) +TMGDIS3^^0^B3848644 +"BLD",5420,"KRN",9.8,"NM",15,0) +TMGDRUG^^0^B5590 +"BLD",5420,"KRN",9.8,"NM",17,0) +TMGEDIT^^0^B4891 +"BLD",5420,"KRN",9.8,"NM",20,0) +TMGFMUT^^0^B7306 +"BLD",5420,"KRN",9.8,"NM",21,0) +TMGGDFN^^0^B101576 +"BLD",5420,"KRN",9.8,"NM",22,0) +TMGHTML1^^0^B6207 +"BLD",5420,"KRN",9.8,"NM",23,0) +TMGHUI1^^0^B205063 +"BLD",5420,"KRN",9.8,"NM",24,0) +TMGIDE^^0^B7091 +"BLD",5420,"KRN",9.8,"NM",25,0) +TMGIDE2^^0^B9859 +"BLD",5420,"KRN",9.8,"NM",26,0) +TMGINIT^^0^B65344038 +"BLD",5420,"KRN",9.8,"NM",27,0) +TMGIOUTL^^0^B7057 +"BLD",5420,"KRN",9.8,"NM",28,0) +TMGITR^^0^B9486 +"BLD",5420,"KRN",9.8,"NM",29,0) +TMGKERNL^^0^B5946 +"BLD",5420,"KRN",9.8,"NM",30,0) +TMGMATH^^0^B823927915 +"BLD",5420,"KRN",9.8,"NM",31,0) +TMGMEDIC^^0^B5161 +"BLD",5420,"KRN",9.8,"NM",32,0) +TMGMGRST^^0^B2452596 +"BLD",5420,"KRN",9.8,"NM",33,0) +TMGMISC^^0^B9343 +"BLD",5420,"KRN",9.8,"NM",34,0) +TMGMKU^^0^B159313 +"BLD",5420,"KRN",9.8,"NM",35,0) +TMGNDF0A^^0^B7420 +"BLD",5420,"KRN",9.8,"NM",36,0) +TMGNDF0B^^0^B6565 +"BLD",5420,"KRN",9.8,"NM",37,0) +TMGNDF0C^^0^B5013 +"BLD",5420,"KRN",9.8,"NM",38,0) +TMGNDF1A^^0^B9060 +"BLD",5420,"KRN",9.8,"NM",39,0) +TMGNDF1D^^0^B4671 +"BLD",5420,"KRN",9.8,"NM",40,0) +TMGNDF1E^^0^B4552 +"BLD",5420,"KRN",9.8,"NM",41,0) +TMGNDF1F^^0^B6001 +"BLD",5420,"KRN",9.8,"NM",42,0) +TMGNDF2A^^0^B7116 +"BLD",5420,"KRN",9.8,"NM",43,0) +TMGNDF2C^^0^B7038 +"BLD",5420,"KRN",9.8,"NM",44,0) +TMGNDF2E^^0^B10640 +"BLD",5420,"KRN",9.8,"NM",45,0) +TMGNDF2F^^0^B9113 +"BLD",5420,"KRN",9.8,"NM",46,0) +TMGNDF2G^^0^B7234 +"BLD",5420,"KRN",9.8,"NM",47,0) +TMGNDF2H^^0^B7403 +"BLD",5420,"KRN",9.8,"NM",48,0) +TMGNDF3A^^0^B12884 +"BLD",5420,"KRN",9.8,"NM",49,0) +TMGNDF3B^^0^B4797 +"BLD",5420,"KRN",9.8,"NM",50,0) +TMGNDF3C^^0^B5446 +"BLD",5420,"KRN",9.8,"NM",51,0) +TMGNDF3D^^0^B9007 +"BLD",5420,"KRN",9.8,"NM",52,0) +TMGNDF3E^^0^B4600 +"BLD",5420,"KRN",9.8,"NM",53,0) +TMGNDF4A^^0^B6524 +"BLD",5420,"KRN",9.8,"NM",54,0) +TMGNDF4B^^0^B7237 +"BLD",5420,"KRN",9.8,"NM",55,0) +TMGNDF4C^^0^B10766 +"BLD",5420,"KRN",9.8,"NM",56,0) +TMGNDF4D^^0^B7415 +"BLD",5420,"KRN",9.8,"NM",57,0) +TMGNDF4E^^0^B6240 +"BLD",5420,"KRN",9.8,"NM",58,0) +TMGNDF4F^^0^B7817 +"BLD",5420,"KRN",9.8,"NM",59,0) +TMGNDF4G^^0^B6258 +"BLD",5420,"KRN",9.8,"NM",60,0) +TMGNDFK1^^0^B4836 +"BLD",5420,"KRN",9.8,"NM",61,0) +TMGNDFUT^^0^B10639 +"BLD",5420,"KRN",9.8,"NM",66,0) +TMGPRNTR^^0^B9035 +"BLD",5420,"KRN",9.8,"NM",67,0) +TMGPRPN^^0^B76219 +"BLD",5420,"KRN",9.8,"NM",68,0) +TMGPSSDE^^0^B217084810 +"BLD",5420,"KRN",9.8,"NM",69,0) +TMGPSSDEE^^0^B217084810 +"BLD",5420,"KRN",9.8,"NM",70,0) +TMGPUTN0^^0^B125965713 +"BLD",5420,"KRN",9.8,"NM",71,0) +TMGQIO^^0^B78392 +"BLD",5420,"KRN",9.8,"NM",72,0) +TMGRPC1^^0^B6434 +"BLD",5420,"KRN",9.8,"NM",73,0) +TMGSELED^^0^B10024 +"BLD",5420,"KRN",9.8,"NM",74,0) +TMGSEQL1^^0^B44760 +"BLD",5420,"KRN",9.8,"NM",75,0) +TMGSEQL1B^^0^B44760 +"BLD",5420,"KRN",9.8,"NM",76,0) +TMGSEQL2^^0^B11873 +"BLD",5420,"KRN",9.8,"NM",77,0) +TMGSEQL3^^0^B11370 +"BLD",5420,"KRN",9.8,"NM",78,0) +TMGSHORT^^0^B7015 +"BLD",5420,"KRN",9.8,"NM",79,0) +TMGSTUTL^^0^B14081 +"BLD",5420,"KRN",9.8,"NM",80,0) +TMGTERM^^0^B16915 +"BLD",5420,"KRN",9.8,"NM",82,0) +TMGTIUOJ^^0^B11722 +"BLD",5420,"KRN",9.8,"NM",83,0) +TMGTRAN1^^0^B2382006 +"BLD",5420,"KRN",9.8,"NM",84,0) +TMGTREE^^0^B4518 +"BLD",5420,"KRN",9.8,"NM",85,0) +TMGTRNRP^^0^B1962236 +"BLD",5420,"KRN",9.8,"NM",86,0) +TMGUPLD^^0^B4904 +"BLD",5420,"KRN",9.8,"NM",87,0) +TMGUSRIF^^0^B7202 +"BLD",5420,"KRN",9.8,"NM",88,0) +TMGVPE^^0^B112139 +"BLD",5420,"KRN",9.8,"NM",97,0) +TMGXDLG^^0^B61415 +"BLD",5420,"KRN",9.8,"NM",98,0) +TMGXGF^^0^B43054173 +"BLD",5420,"KRN",9.8,"NM",99,0) +TMGXGS^^0^B32818030 +"BLD",5420,"KRN",9.8,"NM",100,0) +TMGXGSW^^0^B23984227 +"BLD",5420,"KRN",9.8,"NM",101,0) +TMGXINST^^0^B16647 +"BLD",5420,"KRN",9.8,"NM",102,0) +TMGXML1^^0^B7775128 +"BLD",5420,"KRN",9.8,"NM",103,0) +TMGXMLE2^^0^B27375 +"BLD",5420,"KRN",9.8,"NM",104,0) +TMGXMLEX^^0^B11237 +"BLD",5420,"KRN",9.8,"NM",105,0) +TMGXMLUI^^0^B8350 +"BLD",5420,"KRN",9.8,"NM",106,0) +TMGXPDR^^0^B20281682 +"BLD",5420,"KRN",9.8,"NM",107,0) +TMGXSBOX^^0^B6893011 +"BLD",5420,"KRN",9.8,"NM",108,0) +TMGXUP^^0^B98358 +"BLD",5420,"KRN",9.8,"NM",109,0) +TMGXUS2^^0^B55991259 +"BLD",5420,"KRN",9.8,"NM",110,0) +TMGIDE3^^0^B2891 +"BLD",5420,"KRN",9.8,"NM",111,0) +TMGIDE4^^0^B3347 +"BLD",5420,"KRN",9.8,"NM",112,0) +TMGKIDS^^0^B2764 +"BLD",5420,"KRN",9.8,"NM","B","TMGABV",1) + +"BLD",5420,"KRN",9.8,"NM","B","TMGBINF",2) + +"BLD",5420,"KRN",9.8,"NM","B","TMGBROWS",3) + +"BLD",5420,"KRN",9.8,"NM","B","TMGBUTIL",4) + +"BLD",5420,"KRN",9.8,"NM","B","TMGCHR",5) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDBAP2",6) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDBAPI",7) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDEBUG",8) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIA3",9) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIS",10) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIS0",11) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIS1",12) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIS2",13) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDIS3",14) + +"BLD",5420,"KRN",9.8,"NM","B","TMGDRUG",15) + +"BLD",5420,"KRN",9.8,"NM","B","TMGEDIT",17) + +"BLD",5420,"KRN",9.8,"NM","B","TMGFMUT",20) + +"BLD",5420,"KRN",9.8,"NM","B","TMGGDFN",21) + +"BLD",5420,"KRN",9.8,"NM","B","TMGHTML1",22) + +"BLD",5420,"KRN",9.8,"NM","B","TMGHUI1",23) + +"BLD",5420,"KRN",9.8,"NM","B","TMGIDE",24) + +"BLD",5420,"KRN",9.8,"NM","B","TMGIDE2",25) + +"BLD",5420,"KRN",9.8,"NM","B","TMGIDE3",110) + +"BLD",5420,"KRN",9.8,"NM","B","TMGIDE4",111) + +"BLD",5420,"KRN",9.8,"NM","B","TMGINIT",26) + +"BLD",5420,"KRN",9.8,"NM","B","TMGIOUTL",27) + +"BLD",5420,"KRN",9.8,"NM","B","TMGITR",28) + +"BLD",5420,"KRN",9.8,"NM","B","TMGKERNL",29) + +"BLD",5420,"KRN",9.8,"NM","B","TMGKIDS",112) + +"BLD",5420,"KRN",9.8,"NM","B","TMGMATH",30) + +"BLD",5420,"KRN",9.8,"NM","B","TMGMEDIC",31) + +"BLD",5420,"KRN",9.8,"NM","B","TMGMGRST",32) + +"BLD",5420,"KRN",9.8,"NM","B","TMGMISC",33) + +"BLD",5420,"KRN",9.8,"NM","B","TMGMKU",34) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF0A",35) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF0B",36) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF0C",37) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF1A",38) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF1D",39) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF1E",40) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF1F",41) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2A",42) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2C",43) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2E",44) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2F",45) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2G",46) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF2H",47) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF3A",48) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF3B",49) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF3C",50) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF3D",51) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF3E",52) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4A",53) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4B",54) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4C",55) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4D",56) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4E",57) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4F",58) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDF4G",59) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDFK1",60) + +"BLD",5420,"KRN",9.8,"NM","B","TMGNDFUT",61) + +"BLD",5420,"KRN",9.8,"NM","B","TMGPRNTR",66) + +"BLD",5420,"KRN",9.8,"NM","B","TMGPRPN",67) + +"BLD",5420,"KRN",9.8,"NM","B","TMGPSSDE",68) + +"BLD",5420,"KRN",9.8,"NM","B","TMGPSSDEE",69) + +"BLD",5420,"KRN",9.8,"NM","B","TMGPUTN0",70) + +"BLD",5420,"KRN",9.8,"NM","B","TMGQIO",71) + +"BLD",5420,"KRN",9.8,"NM","B","TMGRPC1",72) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSELED",73) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSEQL1",74) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSEQL1B",75) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSEQL2",76) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSEQL3",77) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSHORT",78) + +"BLD",5420,"KRN",9.8,"NM","B","TMGSTUTL",79) + +"BLD",5420,"KRN",9.8,"NM","B","TMGTERM",80) + +"BLD",5420,"KRN",9.8,"NM","B","TMGTIUOJ",82) + +"BLD",5420,"KRN",9.8,"NM","B","TMGTRAN1",83) + +"BLD",5420,"KRN",9.8,"NM","B","TMGTREE",84) + +"BLD",5420,"KRN",9.8,"NM","B","TMGTRNRP",85) + +"BLD",5420,"KRN",9.8,"NM","B","TMGUPLD",86) + +"BLD",5420,"KRN",9.8,"NM","B","TMGUSRIF",87) + +"BLD",5420,"KRN",9.8,"NM","B","TMGVPE",88) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXDLG",97) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXGF",98) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXGS",99) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXGSW",100) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXINST",101) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXML1",102) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXMLE2",103) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXMLEX",104) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXMLUI",105) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXPDR",106) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXSBOX",107) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXUP",108) + +"BLD",5420,"KRN",9.8,"NM","B","TMGXUS2",109) + +"BLD",5420,"KRN",19,0) +19 +"BLD",5420,"KRN",19,"NM",0) +^9.68A^55^52 +"BLD",5420,"KRN",19,"NM",1,0) +TMG ADAM^^0 +"BLD",5420,"KRN",19,"NM",2,0) +TMG ADD PATIENT^^0 +"BLD",5420,"KRN",19,"NM",3,0) +TMG ASK SHOW ARRAY NODES^^0 +"BLD",5420,"KRN",19,"NM",4,0) +TMG AUTHOR TRANS COST ANY^^0 +"BLD",5420,"KRN",19,"NM",5,0) +TMG AUTHOR TRANS COST CURRENT^^0 +"BLD",5420,"KRN",19,"NM",7,0) +TMG DEBUGGER^^0 +"BLD",5420,"KRN",19,"NM",8,0) +TMG DOC MENU^^0 +"BLD",5420,"KRN",19,"NM",10,0) +TMG EDIT PATIENT^^0 +"BLD",5420,"KRN",19,"NM",11,0) +TMG EDIT PROGRESS NOTE^^0 +"BLD",5420,"KRN",19,"NM",12,0) +TMG EDIT/ADD PATIENT^^0 +"BLD",5420,"KRN",19,"NM",13,0) +TMG ERROR TRAP CHECK^^0 +"BLD",5420,"KRN",19,"NM",14,0) +TMG MAIN MENU TRANSCRIPTION^^0 +"BLD",5420,"KRN",19,"NM",15,0) +TMG MEDIC CONVERTER^^0 +"BLD",5420,"KRN",19,"NM",16,0) +TMG MGR MENU^^0 +"BLD",5420,"KRN",19,"NM",17,0) +TMG NURSE MENU^^0 +"BLD",5420,"KRN",19,"NM",18,0) +TMG OTHER 1^^0 +"BLD",5420,"KRN",19,"NM",19,0) +TMG PASSWORDS UNMASK^^0 +"BLD",5420,"KRN",19,"NM",20,0) +TMG PHARM EDIT VA PRODUCT^^0 +"BLD",5420,"KRN",19,"NM",21,0) +TMG PHARMACY^^0 +"BLD",5420,"KRN",19,"NM",22,0) +TMG PRINT CONTIGIOUSLY^^0 +"BLD",5420,"KRN",19,"NM",23,0) +TMG REC BROWSE^^0 +"BLD",5420,"KRN",19,"NM",24,0) +TMG REC INQUIRE^^0 +"BLD",5420,"KRN",19,"NM",25,0) +TMG REDIRECT POINTERS^^0 +"BLD",5420,"KRN",19,"NM",26,0) +TMG REFILE UPLOAD^^0 +"BLD",5420,"KRN",19,"NM",27,0) +TMG REGISTER^^0 +"BLD",5420,"KRN",19,"NM",28,0) +TMG RELEASE TRANS ANY USER^^0 +"BLD",5420,"KRN",19,"NM",29,0) +TMG RELEASE TRANS CURRENT USER^^0 +"BLD",5420,"KRN",19,"NM",30,0) +TMG REPRINT TEMPLATE^^0 +"BLD",5420,"KRN",19,"NM",31,0) +TMG RPC CONTEXT SCANNER^^0 +"BLD",5420,"KRN",19,"NM",32,0) +TMG SELECT EDIT RECORDS^^0 +"BLD",5420,"KRN",19,"NM",33,0) +TMG SEQUEL CLEAR IMPORT ERRORS^^0 +"BLD",5420,"KRN",19,"NM",34,0) +TMG SEQUEL DATA IMPORT^^0 +"BLD",5420,"KRN",19,"NM",35,0) +TMG SEQUEL DATA IMPORT CUSTOM^^0 +"BLD",5420,"KRN",19,"NM",36,0) +TMG SEQUEL IMPORT DATES^^0 +"BLD",5420,"KRN",19,"NM",37,0) +TMG SEQUEL IMPORT MENU^^0 +"BLD",5420,"KRN",19,"NM",38,0) +TMG SEQUEL IMPORT SETTINGS^^0 +"BLD",5420,"KRN",19,"NM",39,0) +TMG SEQUEL RPT DOB ERROR^^0 +"BLD",5420,"KRN",19,"NM",40,0) +TMG SEQUEL RPT SSNUM CONFLICTS^^0 +"BLD",5420,"KRN",19,"NM",41,0) +TMG SET PATIENT DEMOGRAPHICS^^0 +"BLD",5420,"KRN",19,"NM",43,0) +TMG SHOW POINTERS IN^^0 +"BLD",5420,"KRN",19,"NM",44,0) +TMG SHOW SENSITIVITY ACCESS^^0 +"BLD",5420,"KRN",19,"NM",45,0) +TMG SHOW XTER^^0 +"BLD",5420,"KRN",19,"NM",46,0) +TMG TEXT MENU^^0 +"BLD",5420,"KRN",19,"NM",47,0) +TMG TRANS REPRINT BATCH^^0 +"BLD",5420,"KRN",19,"NM",48,0) +TMG TRANS REPRINT TEMPLATE^^0 +"BLD",5420,"KRN",19,"NM",49,0) +TMG TRANS SHOW UNSIGNED^^0 +"BLD",5420,"KRN",19,"NM",50,0) +TMG TRANSCRIPTION REPORT^^0 +"BLD",5420,"KRN",19,"NM",51,0) +TMG UPLOAD BATCH DOCUMENTS^^0 +"BLD",5420,"KRN",19,"NM",52,0) +TMG VPE MENU^^0 +"BLD",5420,"KRN",19,"NM",53,0) +TMG WEBSITE EXPORT^^0 +"BLD",5420,"KRN",19,"NM",54,0) +TMG XML EXPORTER^^0 +"BLD",5420,"KRN",19,"NM",55,0) +TMG XUINDEX2^^0 +"BLD",5420,"KRN",19,"NM","B","TMG ADAM",1) + +"BLD",5420,"KRN",19,"NM","B","TMG ADD PATIENT",2) + +"BLD",5420,"KRN",19,"NM","B","TMG ASK SHOW ARRAY NODES",3) + +"BLD",5420,"KRN",19,"NM","B","TMG AUTHOR TRANS COST ANY",4) + +"BLD",5420,"KRN",19,"NM","B","TMG AUTHOR TRANS COST CURRENT",5) + +"BLD",5420,"KRN",19,"NM","B","TMG DEBUGGER",7) + +"BLD",5420,"KRN",19,"NM","B","TMG DOC MENU",8) + +"BLD",5420,"KRN",19,"NM","B","TMG EDIT PATIENT",10) + +"BLD",5420,"KRN",19,"NM","B","TMG EDIT PROGRESS NOTE",11) + +"BLD",5420,"KRN",19,"NM","B","TMG EDIT/ADD PATIENT",12) + +"BLD",5420,"KRN",19,"NM","B","TMG ERROR TRAP CHECK",13) + +"BLD",5420,"KRN",19,"NM","B","TMG MAIN MENU TRANSCRIPTION",14) + +"BLD",5420,"KRN",19,"NM","B","TMG MEDIC CONVERTER",15) + +"BLD",5420,"KRN",19,"NM","B","TMG MGR MENU",16) + +"BLD",5420,"KRN",19,"NM","B","TMG NURSE MENU",17) + +"BLD",5420,"KRN",19,"NM","B","TMG OTHER 1",18) + +"BLD",5420,"KRN",19,"NM","B","TMG PASSWORDS UNMASK",19) + +"BLD",5420,"KRN",19,"NM","B","TMG PHARM EDIT VA PRODUCT",20) + +"BLD",5420,"KRN",19,"NM","B","TMG PHARMACY",21) + +"BLD",5420,"KRN",19,"NM","B","TMG PRINT CONTIGIOUSLY",22) + +"BLD",5420,"KRN",19,"NM","B","TMG REC BROWSE",23) + +"BLD",5420,"KRN",19,"NM","B","TMG REC INQUIRE",24) + +"BLD",5420,"KRN",19,"NM","B","TMG REDIRECT POINTERS",25) + +"BLD",5420,"KRN",19,"NM","B","TMG REFILE UPLOAD",26) + +"BLD",5420,"KRN",19,"NM","B","TMG REGISTER",27) + +"BLD",5420,"KRN",19,"NM","B","TMG RELEASE TRANS ANY USER",28) + +"BLD",5420,"KRN",19,"NM","B","TMG RELEASE TRANS CURRENT USER",29) + +"BLD",5420,"KRN",19,"NM","B","TMG REPRINT TEMPLATE",30) + +"BLD",5420,"KRN",19,"NM","B","TMG RPC CONTEXT SCANNER",31) + +"BLD",5420,"KRN",19,"NM","B","TMG SELECT EDIT RECORDS",32) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL CLEAR IMPORT ERRORS",33) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL DATA IMPORT",34) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL DATA IMPORT CUSTOM",35) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL IMPORT DATES",36) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL IMPORT MENU",37) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL IMPORT SETTINGS",38) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL RPT DOB ERROR",39) + +"BLD",5420,"KRN",19,"NM","B","TMG SEQUEL RPT SSNUM CONFLICTS",40) + +"BLD",5420,"KRN",19,"NM","B","TMG SET PATIENT DEMOGRAPHICS",41) + +"BLD",5420,"KRN",19,"NM","B","TMG SHOW POINTERS IN",43) + +"BLD",5420,"KRN",19,"NM","B","TMG SHOW SENSITIVITY ACCESS",44) + +"BLD",5420,"KRN",19,"NM","B","TMG SHOW XTER",45) + +"BLD",5420,"KRN",19,"NM","B","TMG TEXT MENU",46) + +"BLD",5420,"KRN",19,"NM","B","TMG TRANS REPRINT BATCH",47) + +"BLD",5420,"KRN",19,"NM","B","TMG TRANS REPRINT TEMPLATE",48) + +"BLD",5420,"KRN",19,"NM","B","TMG TRANS SHOW UNSIGNED",49) + +"BLD",5420,"KRN",19,"NM","B","TMG TRANSCRIPTION REPORT",50) + +"BLD",5420,"KRN",19,"NM","B","TMG UPLOAD BATCH DOCUMENTS",51) + +"BLD",5420,"KRN",19,"NM","B","TMG VPE MENU",52) + +"BLD",5420,"KRN",19,"NM","B","TMG WEBSITE EXPORT",53) + +"BLD",5420,"KRN",19,"NM","B","TMG XML EXPORTER",54) + +"BLD",5420,"KRN",19,"NM","B","TMG XUINDEX2",55) + +"BLD",5420,"KRN",19.1,0) +19.1 +"BLD",5420,"KRN",101,0) +101 +"BLD",5420,"KRN",409.61,0) +409.61 +"BLD",5420,"KRN",771,0) +771 +"BLD",5420,"KRN",870,0) +870 +"BLD",5420,"KRN",8989.51,0) +8989.51 +"BLD",5420,"KRN",8989.52,0) +8989.52 +"BLD",5420,"KRN",8994,0) +8994 +"BLD",5420,"KRN",8994,"NM",0) +^9.68A^14^14 +"BLD",5420,"KRN",8994,"NM",1,0) +TMG ADD PATIENT^^0 +"BLD",5420,"KRN",8994,"NM",2,0) +TMG AUTOSIGN TIU DOCUMENT^^0 +"BLD",5420,"KRN",8994,"NM",3,0) +TMG BARCODE DECODE^^0 +"BLD",5420,"KRN",8994,"NM",4,0) +TMG BARCODE ENCODE^^0 +"BLD",5420,"KRN",8994,"NM",5,0) +TMG DOWNLOAD FILE^^0 +"BLD",5420,"KRN",8994,"NM",6,0) +TMG DOWNLOAD FILE DROPBOX^^0 +"BLD",5420,"KRN",8994,"NM",7,0) +TMG GET BLANK TIU DOCUMENT^^0 +"BLD",5420,"KRN",8994,"NM",8,0) +TMG GET DFN^^0 +"BLD",5420,"KRN",8994,"NM",9,0) +TMG GET IMAGE LONG DESCRIPTION^^0 +"BLD",5420,"KRN",8994,"NM",10,0) +TMG GET PATIENT DEMOGRAPHICS^^0 +"BLD",5420,"KRN",8994,"NM",11,0) +TMG SET PATIENT DEMOGRAPHICS^^0 +"BLD",5420,"KRN",8994,"NM",12,0) +TMG UPLOAD FILE^^0 +"BLD",5420,"KRN",8994,"NM",13,0) +TMG UPLOAD FILE DROPBOX^^0 +"BLD",5420,"KRN",8994,"NM",14,0) +TMG CPRS GET URL LIST^^0 +"BLD",5420,"KRN",8994,"NM","B","TMG ADD PATIENT",1) + +"BLD",5420,"KRN",8994,"NM","B","TMG AUTOSIGN TIU DOCUMENT",2) + +"BLD",5420,"KRN",8994,"NM","B","TMG BARCODE DECODE",3) + +"BLD",5420,"KRN",8994,"NM","B","TMG BARCODE ENCODE",4) + +"BLD",5420,"KRN",8994,"NM","B","TMG CPRS GET URL LIST",14) + +"BLD",5420,"KRN",8994,"NM","B","TMG DOWNLOAD FILE",5) + +"BLD",5420,"KRN",8994,"NM","B","TMG DOWNLOAD FILE DROPBOX",6) + +"BLD",5420,"KRN",8994,"NM","B","TMG GET BLANK TIU DOCUMENT",7) + +"BLD",5420,"KRN",8994,"NM","B","TMG GET DFN",8) + +"BLD",5420,"KRN",8994,"NM","B","TMG GET IMAGE LONG DESCRIPTION",9) + +"BLD",5420,"KRN",8994,"NM","B","TMG GET PATIENT DEMOGRAPHICS",10) + +"BLD",5420,"KRN",8994,"NM","B","TMG SET PATIENT DEMOGRAPHICS",11) + +"BLD",5420,"KRN",8994,"NM","B","TMG UPLOAD FILE",12) + +"BLD",5420,"KRN",8994,"NM","B","TMG UPLOAD FILE DROPBOX",13) + +"BLD",5420,"KRN","B",.4,.4) + +"BLD",5420,"KRN","B",.401,.401) + +"BLD",5420,"KRN","B",.402,.402) + +"BLD",5420,"KRN","B",.403,.403) + +"BLD",5420,"KRN","B",.5,.5) + +"BLD",5420,"KRN","B",.84,.84) + +"BLD",5420,"KRN","B",3.6,3.6) + +"BLD",5420,"KRN","B",3.8,3.8) + +"BLD",5420,"KRN","B",9.2,9.2) + +"BLD",5420,"KRN","B",9.8,9.8) + +"BLD",5420,"KRN","B",19,19) + +"BLD",5420,"KRN","B",19.1,19.1) + +"BLD",5420,"KRN","B",101,101) + +"BLD",5420,"KRN","B",409.61,409.61) + +"BLD",5420,"KRN","B",771,771) + +"BLD",5420,"KRN","B",870,870) + +"BLD",5420,"KRN","B",8989.51,8989.51) + +"BLD",5420,"KRN","B",8989.52,8989.52) + +"BLD",5420,"KRN","B",8994,8994) + +"BLD",5420,"QUES",0) +^9.62^^ +"BLD",5420,"REQB",0) +^9.611^^ +"FIA",2005.2) +NETWORK LOCATION +"FIA",2005.2,0) +^MAG(2005.2, +"FIA",2005.2,0,0) +2005.2I +"FIA",2005.2,0,1) +y^y^p^^^^n^^n +"FIA",2005.2,0,10) + +"FIA",2005.2,0,11) + +"FIA",2005.2,0,"RLRO") + +"FIA",2005.2,2005.2) +1 +"FIA",2005.2,2005.2,22700) + +"FIA",2005.2,2005.2,22701) + +"FIA",2005.2,2005.2,22702) + +"FIA",8925.1) +TIU DOCUMENT DEFINITION +"FIA",8925.1,0) +^TIU(8925.1, +"FIA",8925.1,0,0) +8925.1I +"FIA",8925.1,0,1) +n^n^f^^y^^y^a^n +"FIA",8925.1,0,10) + +"FIA",8925.1,0,11) +I X["TMG" +"FIA",8925.1,0,"RLRO") + +"FIA",8925.1,8925.1) +0 +"FIA",8925.1,8925.11) +0 +"FIA",8925.1,8925.111) +0 +"FIA",8925.1,8925.112) +0 +"FIA",8925.1,8925.113) +0 +"FIA",8925.1,8925.114) +0 +"FIA",8925.1,8925.12) +0 +"FIA",8925.1,8925.13) +0 +"FIA",8925.1,8925.14) +0 +"FIA",22706.1) +TMG FDA APPLICATION +"FIA",22706.1,0) +^TMG(22706.1, +"FIA",22706.1,0,0) +22706.1P +"FIA",22706.1,0,1) +y^y^f^^^^n +"FIA",22706.1,0,10) + +"FIA",22706.1,0,11) + +"FIA",22706.1,0,"RLRO") + +"FIA",22706.1,22706.1) +0 +"FIA",22706.2) +TMG FDA DOSAGE FORM +"FIA",22706.2,0) +^TMG(22706.2, +"FIA",22706.2,0,0) +22706.2P +"FIA",22706.2,0,1) +y^y^f^^^^n +"FIA",22706.2,0,10) + +"FIA",22706.2,0,11) + +"FIA",22706.2,0,"RLRO") + +"FIA",22706.2,22706.2) +0 +"FIA",22706.3) +TMG FDA FIRMS +"FIA",22706.3,0) +^TMG(22706.3, +"FIA",22706.3,0,0) +22706.3 +"FIA",22706.3,0,1) +y^y^f^^^^n +"FIA",22706.3,0,10) + +"FIA",22706.3,0,11) + +"FIA",22706.3,0,"RLRO") + +"FIA",22706.3,22706.3) +0 +"FIA",22706.4) +TMG FDA FORMULATION +"FIA",22706.4,0) +^TMG(22706.4, +"FIA",22706.4,0,0) +22706.4P +"FIA",22706.4,0,1) +y^y^f^^^^n +"FIA",22706.4,0,10) + +"FIA",22706.4,0,11) + +"FIA",22706.4,0,"RLRO") + +"FIA",22706.4,22706.4) +0 +"FIA",22706.5) +TMG FDA LISTING +"FIA",22706.5,0) +^TMG(22706.5, +"FIA",22706.5,0,0) +22706.5 +"FIA",22706.5,0,1) +y^y^f^^^^n +"FIA",22706.5,0,10) + +"FIA",22706.5,0,11) + +"FIA",22706.5,0,"RLRO") + +"FIA",22706.5,22706.5) +0 +"FIA",22706.6) +TMG FDA PACKAGES +"FIA",22706.6,0) +^TMG(22706.6, +"FIA",22706.6,0,0) +22706.6P +"FIA",22706.6,0,1) +y^y^f^^^^n +"FIA",22706.6,0,10) + +"FIA",22706.6,0,11) + +"FIA",22706.6,0,"RLRO") + +"FIA",22706.6,22706.6) +0 +"FIA",22706.7) +TMG FDA ROUTES +"FIA",22706.7,0) +^TMG(22706.7, +"FIA",22706.7,0,0) +22706.7P +"FIA",22706.7,0,1) +y^y^f^^^^n +"FIA",22706.7,0,10) + +"FIA",22706.7,0,11) + +"FIA",22706.7,0,"RLRO") + +"FIA",22706.7,22706.7) +0 +"FIA",22706.8) +TMG FDA FORMS VISTA EQUIVALENTS +"FIA",22706.8,0) +^TMG(22706.8, +"FIA",22706.8,0,0) +22706.8 +"FIA",22706.8,0,1) +y^y^f^^^^n +"FIA",22706.8,0,10) + +"FIA",22706.8,0,11) + +"FIA",22706.8,0,"RLRO") + +"FIA",22706.8,22706.8) +0 +"FIA",22706.82) +TMG FDA ROUTES VISTA EQUIVALENTS +"FIA",22706.82,0) +^TMG(22706.82, +"FIA",22706.82,0,0) +22706.82 +"FIA",22706.82,0,1) +y^y^f^^^^n +"FIA",22706.82,0,10) + +"FIA",22706.82,0,11) + +"FIA",22706.82,0,"RLRO") + +"FIA",22706.82,22706.82) +0 +"FIA",22706.9) +TMG FDA IMPORT COMPILED +"FIA",22706.9,0) +^TMG(22706.9, +"FIA",22706.9,0,0) +22706.9P +"FIA",22706.9,0,1) +y^y^f^^^^n +"FIA",22706.9,0,10) + +"FIA",22706.9,0,11) + +"FIA",22706.9,0,"RLRO") + +"FIA",22706.9,22706.9) +0 +"FIA",22706.9,22706.9001) +0 +"FIA",22706.9,22706.914) +0 +"FIA",22706.9,22706.915) +0 +"FIA",22706.9,22706.916) +0 +"INIT") +POSTINST^TMGKIDS +"KRN",.4,1362,-1) +0^7 +"KRN",.4,1362,0) +TMG SENSITIVITY ACCESS^3050202.2147^@^38.1^^@^3070205 +"KRN",.4,1362,"F",2) +.01~50,.01~50,2~ +"KRN",.4,1362,"H") +DG SECURITY LOG LIST +"KRN",.403,99,-1) +0^3 +"KRN",.403,99,0) +TMG REGISTER^@^@^^3050104.2156^^^2^1^0^1 +"KRN",.403,99,40,0) +^.4031I^1^1 +"KRN",.403,99,40,1,0) +1^^1,1 +"KRN",.403,99,40,1,1) +Page 1 +"KRN",.403,99,40,1,40,0) +^.4032IP^367^1 +"KRN",.403,99,40,1,40,367,0) +TMG MAIN 1^1^1,1^d +"KRN",.403,100,-1) +0^2 +"KRN",.403,100,0) +TMG EDIT PROGRESS NOTE^@^@^^3050612.1225^^^8925^0^0^1 +"KRN",.403,100,40,0) +^.4031I^1^1 +"KRN",.403,100,40,1,0) +1^^1,1 +"KRN",.403,100,40,1,1) +Page 1 +"KRN",.403,100,40,1,40,0) +^.4032IP^369^2 +"KRN",.403,100,40,1,40,368,0) +HEADER BLOCK 1^1^1,1^d +"KRN",.403,100,40,1,40,369,0) +Main Block^2^2,1^e +"KRN",.403,101,-1) +0^4 +"KRN",.403,101,0) +TMG UPDATE SETTINGS^@^@^^3060222.1644^^^22711^0^0^1 +"KRN",.403,101,40,0) +^.4031I^1^1 +"KRN",.403,101,40,1,0) +1^^1,1 +"KRN",.403,101,40,1,1) +Page 1 +"KRN",.403,101,40,1,40,0) +^.4032IP^370^1 +"KRN",.403,101,40,1,40,370,0) +TMG UPLOAD SETTINGS BLOCK^1^1,1^e +"KRN",.403,102,-1) +0^5 +"KRN",.403,102,0) +TMG VIEW DRUG^@^@^^3060304.2146^^^50.68^0^0^1 +"KRN",.403,102,40,0) +^.4031I^4^3 +"KRN",.403,102,40,1,0) +1^^1,1^2^ +"KRN",.403,102,40,1,1) +Page 1 +"KRN",.403,102,40,1,40,0) +^.4032IP^371^1 +"KRN",.403,102,40,1,40,371,0) +VIEW DRUG^1^1,1^e +"KRN",.403,102,40,3,0) +2^^1,1^^1 +"KRN",.403,102,40,3,1) +Page 2 +"KRN",.403,102,40,3,40,0) +^.4032IP^372^1 +"KRN",.403,102,40,3,40,372,0) +INGREDIENTS REPEATING^2^1,1^e +"KRN",.403,102,40,3,40,372,2) +6 +"KRN",.403,102,40,4,0) +1.5^^5,7^^^1^15,75 +"KRN",.403,102,40,4,1) +Page 1.5^ACTIVE INGREDIENTS,VIEW DRUG,1 +"KRN",.403,102,40,4,40,0) +^.4032IP^373^1 +"KRN",.403,102,40,4,40,373,0) +VIEW INGREDIENTS^1^2,2^e +"KRN",.403,102,40,4,40,373,2) +^^^^^ +"KRN",.403,103,-1) +0^1 +"KRN",.403,103,0) +TMG EDIT DRUG^@^@^^3070112.2148^^^50^0^0^1 +"KRN",.403,103,40,0) +^.4031I^1^1 +"KRN",.403,103,40,1,0) +1^^1,1 +"KRN",.403,103,40,1,1) +Page 1 +"KRN",.403,103,40,1,40,0) +^.4032IP^374^1 +"KRN",.403,103,40,1,40,374,0) +BLOCK1^1^1,1^e +"KRN",.404,367,0) +TMG MAIN 1^2^ +"KRN",.404,367,40,0) +^.4044I^6^6 +"KRN",.404,367,40,1,0) +1^Patient Edit / Registration^1 +"KRN",.404,367,40,1,2) +^^1,27 +"KRN",.404,367,40,2,0) +2^NAME^3 +"KRN",.404,367,40,2,1) +.01 +"KRN",.404,367,40,2,2) +3,7^30^3,1 +"KRN",.404,367,40,3,0) +3^Soc. Sec. Number^3 +"KRN",.404,367,40,3,1) +.09 +"KRN",.404,367,40,3,2) +5,19^10^5,1 +"KRN",.404,367,40,4,0) +4^DATE OF BIRTH^3 +"KRN",.404,367,40,4,1) +.03 +"KRN",.404,367,40,4,2) +4,16^11^4,1 +"KRN",.404,367,40,5,0) +5^MEDIC ACCOUNT NUMBER^3 +"KRN",.404,367,40,5,1) +22700 +"KRN",.404,367,40,5,2) +6,23^12^6,1 +"KRN",.404,367,40,6,0) +6^ATTENDING PHYSICIAN^3 +"KRN",.404,367,40,6,1) +.1041 +"KRN",.404,367,40,6,2) +14,22^35^14,1 +"KRN",.404,368,0) +HEADER BLOCK 1^8925^ +"KRN",.404,368,40,0) +^.4044I^3^2 +"KRN",.404,368,40,2,0) +2^The Medical Group of Greeneville^1 +"KRN",.404,368,40,2,2) +^^1,1 +"KRN",.404,368,40,3,0) +3^Progress Note Properties Editor^1 +"KRN",.404,368,40,3,2) +^^1,37 +"KRN",.404,369,0) +Main Block^8925 +"KRN",.404,369,40,0) +^.4044I^16^16 +"KRN",.404,369,40,1,0) +1^DOCUMENT TYPE^3^^ +"KRN",.404,369,40,1,1) +.01 +"KRN",.404,369,40,1,2) +2,30^60^2,15 +"KRN",.404,369,40,2,0) +2^PATIENT^3 +"KRN",.404,369,40,2,1) +.02 +"KRN",.404,369,40,2,2) +3,30^30^3,21 +"KRN",.404,369,40,3,0) +4.6^EPISODE DATE/TIME^3 +"KRN",.404,369,40,3,1) +.07 +"KRN",.404,369,40,3,2) +7,30^20^7,11 +"KRN",.404,369,40,4,0) +3^STATUS^3 +"KRN",.404,369,40,4,1) +.05 +"KRN",.404,369,40,4,2) +4,30^30^4,22 +"KRN",.404,369,40,5,0) +5^DATA ENTRY DATE/TIME^3 +"KRN",.404,369,40,5,1) +1201 +"KRN",.404,369,40,5,2) +8,30^20^8,8 +"KRN",.404,369,40,6,0) +6^AUTHOR^3 +"KRN",.404,369,40,6,1) +1202 +"KRN",.404,369,40,6,2) +10,30^35^10,22 +"KRN",.404,369,40,7,0) +7^TRANSCRIPTIONIST/ENTERED BY^3 +"KRN",.404,369,40,7,1) +1302 +"KRN",.404,369,40,7,2) +11,30^35^11,1 +"KRN",.404,369,40,8,0) +4^VISIT LOCATION^3 +"KRN",.404,369,40,8,1) +1211 +"KRN",.404,369,40,8,2) +5,30^21^5,14 +"KRN",.404,369,40,9,0) +4.5^VISIT^3 +"KRN",.404,369,40,9,1) +.03 +"KRN",.404,369,40,9,2) +6,30^20^6,23 +"KRN",.404,369,40,10,0) +8^REPORT TEXT^3 +"KRN",.404,369,40,10,1) +2 +"KRN",.404,369,40,10,2) +16,30^4^16,17 +"KRN",.404,369,40,11,0) +9^*To edit text, press [ENTER] in REPORT TEXT field*^1 +"KRN",.404,369,40,11,2) +^^15,16 +"KRN",.404,369,40,12,0) +10^[TAB] between fields. Enter EXIT in COMMAND: field when done.^1 +"KRN",.404,369,40,12,2) +^^1,7 +"KRN",.404,369,40,13,0) +11^REFERENCE DATE^3^^Reference Date +"KRN",.404,369,40,13,1) +1301 +"KRN",.404,369,40,13,2) +9,30^20^9,14 +"KRN",.404,369,40,14,0) +12^EXPECTED SIGNER^3 +"KRN",.404,369,40,14,1) +1204 +"KRN",.404,369,40,14,2) +12,30^35^12,13 +"KRN",.404,369,40,15,0) +13^SIGNATURE BLOCK NAME^3 +"KRN",.404,369,40,15,1) +1503 +"KRN",.404,369,40,15,2) +14,30^38^14,8 +"KRN",.404,369,40,16,0) +14^SIGNED BY^3 +"KRN",.404,369,40,16,1) +1502 +"KRN",.404,369,40,16,2) +13,30^35^13,19 +"KRN",.404,370,0) +TMG UPLOAD SETTINGS BLOCK^22711^ +"KRN",.404,370,40,0) +^.4044I^10^9 +"KRN",.404,370,40,1,0) +1^Sequel Demographics Import Settings^1 +"KRN",.404,370,40,1,2) +^^1,22 +"KRN",.404,370,40,2,0) +1.1^IMPORT DATAFILE NAME^3 +"KRN",.404,370,40,2,1) +2 +"KRN",.404,370,40,2,2) +4,26^51^4,4 +"KRN",.404,370,40,3,0) +0^IMPORT DATAFILE PATH^3 +"KRN",.404,370,40,3,1) +2.5 +"KRN",.404,370,40,3,2) +3,26^50^3,4 +"KRN",.404,370,40,4,0) +4^IMPORT DATAFILE 2 NAME^3 +"KRN",.404,370,40,4,1) +2.1 +"KRN",.404,370,40,4,2) +5,26^54^5,2 +"KRN",.404,370,40,5,0) +5^ALERT RECIPIENT^3 +"KRN",.404,370,40,5,1) +3 +"KRN",.404,370,40,5,2) +7,33^35^7,16 +"KRN",.404,370,40,6,0) +6^DELETE DATAFILE AFTER IMPORT?^3 +"KRN",.404,370,40,6,1) +5 +"KRN",.404,370,40,6,2) +8,33^3^8,2 +"KRN",.404,370,40,7,0) +7^PICK GENDER FROM NAME?^3 +"KRN",.404,370,40,7,1) +6 +"KRN",.404,370,40,7,2) +9,33^3^9,9 +"KRN",.404,370,40,8,0) +8^IMPORT FREQUENCY (IN HOURS)^3 +"KRN",.404,370,40,8,1) +7 +"KRN",.404,370,40,8,2) +10,33^4^10,4 +"KRN",.404,370,40,10,0) +10^LAST IMPORT DATE^3 +"KRN",.404,370,40,10,1) +4 +"KRN",.404,370,40,10,2) +11,33^20^11,15 +"KRN",.404,370,40,10,13) +SET X=DDSOLD +"KRN",.404,371,0) +VIEW DRUG^50.68 +"KRN",.404,371,40,0) +^.4044I^29^29 +"KRN",.404,371,40,1,0) +1^VIEW DRUG (VA PRODUCT FILE ENTRY)^1 +"KRN",.404,371,40,1,2) +^^1,23 +"KRN",.404,371,40,2,0) +2^NAME^3 +"KRN",.404,371,40,2,1) +.01 +"KRN",.404,371,40,2,2) +2,7^51^2,1 +"KRN",.404,371,40,3,0) +3^VA GENERIC NAME^3 +"KRN",.404,371,40,3,1) +.05 +"KRN",.404,371,40,3,2) +3,18^62^3,1 +"KRN",.404,371,40,4,0) +4^STRENGTH^3 +"KRN",.404,371,40,4,1) +2 +"KRN",.404,371,40,4,2) +4,46^15^4,36 +"KRN",.404,371,40,5,0) +5^DOSAGE FORM^3 +"KRN",.404,371,40,5,1) +1 +"KRN",.404,371,40,5,2) +4,14^20^4,1 +"KRN",.404,371,40,6,0) +6^UNITS^3 +"KRN",.404,371,40,6,1) +3 +"KRN",.404,371,40,6,2) +4,70^10^4,63 +"KRN",.404,371,40,7,0) +7^NATIONAL FORMULARY NAME^3 +"KRN",.404,371,40,7,1) +4 +"KRN",.404,371,40,7,2) +5,26^54^5,1 +"KRN",.404,371,40,8,0) +8^VA PRINT NAME^3 +"KRN",.404,371,40,8,1) +5 +"KRN",.404,371,40,8,2) +6,16^40^6,1 +"KRN",.404,371,40,9,0) +9^VA PRODUCT IDENTIFIER^3 +"KRN",.404,371,40,9,1) +6 +"KRN",.404,371,40,9,2) +7,24^5^7,1 +"KRN",.404,371,40,10,0) +10^TRANSMIT TO CMOP^3 +"KRN",.404,371,40,10,1) +7 +"KRN",.404,371,40,10,2) +7,50^3^7,32 +"KRN",.404,371,40,11,0) +11^VA DISPENSE UNIT^3 +"KRN",.404,371,40,11,1) +8 +"KRN",.404,371,40,11,2) +8,19^10^8,1 +"KRN",.404,371,40,12,0) +12^GCNSEQNO^3 +"KRN",.404,371,40,12,1) +11 +"KRN",.404,371,40,12,2) +9,11^9^9,1 +"KRN",.404,371,40,13,0) +13^PREVIOUS GCNSEQNO^3 +"KRN",.404,371,40,13,1) +12 +"KRN",.404,371,40,13,2) +9,41^9^9,22 +"KRN",.404,371,40,14,0) +14^NDC LINK TO GCNSEQNO^3 +"KRN",.404,371,40,14,1) +13 +"KRN",.404,371,40,14,2) +9,74^4^9,52 +"KRN",.404,371,40,15,0) +15^PRIMARY VA DRUG CLASS^3 +"KRN",.404,371,40,15,1) +15 +"KRN",.404,371,40,15,2) +10,24^5^10,1 +"KRN",.404,371,40,16,0) +16^Select 2nd VA DRUG CLASS^3^^ +"KRN",.404,371,40,16,1) +16 +"KRN",.404,371,40,16,2) +10,60^15^10,34 +"KRN",.404,371,40,17,0) +17^NAT. FORMULARY INDICATOR^3 +"KRN",.404,371,40,17,1) +17 +"KRN",.404,371,40,17,2) +11,27^3^11,1 +"KRN",.404,371,40,18,0) +18^NATIONAL FORMULARY RESTRICTION^3 +"KRN",.404,371,40,18,1) +18 +"KRN",.404,371,40,18,2) +11,66^1^11,34 +"KRN",.404,371,40,19,0) +19^CS FEDERAL SCHEDULE^3 +"KRN",.404,371,40,19,1) +19 +"KRN",.404,371,40,19,2) +8,53^26^8,32 +"KRN",.404,371,40,20,0) +20^SINGLE/MULTI SOURCE PRODUCT^3 +"KRN",.404,371,40,20,1) +20 +"KRN",.404,371,40,20,2) +12,30^13^12,1 +"KRN",.404,371,40,21,0) +21^INACTIVATION DATE^3 +"KRN",.404,371,40,21,1) +21 +"KRN",.404,371,40,21,2) +13,20^11^13,1 +"KRN",.404,371,40,22,0) +22^EXCLUDE DRG-DRG INTERACTION CK^3 +"KRN",.404,371,40,22,1) +23 +"KRN",.404,371,40,22,2) +13,66^3^13,34 +"KRN",.404,371,40,23,0) +23^MAX SINGLE DOSE^3 +"KRN",.404,371,40,23,1) +25 +"KRN",.404,371,40,23,2) +14,18^13^14,1 +"KRN",.404,371,40,24,0) +24^MIN SINGLE DOSE^3 +"KRN",.404,371,40,24,1) +26 +"KRN",.404,371,40,24,2) +14,51^13^14,34 +"KRN",.404,371,40,25,0) +25^MAX DAILY DOSE^3 +"KRN",.404,371,40,25,1) +27 +"KRN",.404,371,40,25,2) +15,17^13^15,1 +"KRN",.404,371,40,26,0) +26^MIN DAILY DOSE^3 +"KRN",.404,371,40,26,1) +28 +"KRN",.404,371,40,26,2) +15,50^13^15,34 +"KRN",.404,371,40,27,0) +27^MAX CUMULATIVE DOSE^3 +"KRN",.404,371,40,27,1) +29 +"KRN",.404,371,40,27,2) +16,22^10^16,1 +"KRN",.404,371,40,28,0) +28^DSS NUMBER^3 +"KRN",.404,371,40,28,1) +30 +"KRN",.404,371,40,28,2) +16,46^6^16,34 +"KRN",.404,371,40,29,0) +29^Select ACTIVE INGREDIENTS (Popup)^3^^ACTIVE INGREDIENTS +"KRN",.404,371,40,29,1) +14 +"KRN",.404,371,40,29,2) +17,36^30^17,1 +"KRN",.404,372,0) +INGREDIENTS REPEATING^50.6814 +"KRN",.404,372,40,0) +^.4044I^6^6 +"KRN",.404,372,40,1,0) +1^^3 +"KRN",.404,372,40,1,1) +.01 +"KRN",.404,372,40,1,2) +4,2^35 +"KRN",.404,372,40,2,0) +2^^3 +"KRN",.404,372,40,2,1) +1 +"KRN",.404,372,40,2,2) +4,39^15 +"KRN",.404,372,40,3,0) +3^^3 +"KRN",.404,372,40,3,1) +2 +"KRN",.404,372,40,3,2) +4,60^10 +"KRN",.404,372,40,4,0) +4^** ACTIVE INGREDIENTS **^1 +"KRN",.404,372,40,4,2) +^^3,2 +"KRN",.404,372,40,5,0) +5^STRENGTH^1 +"KRN",.404,372,40,5,2) +^^3,39 +"KRN",.404,372,40,6,0) +6^UNITS^1 +"KRN",.404,372,40,6,2) +^^3,60 +"KRN",.404,373,0) +VIEW INGREDIENTS^50.6814 +"KRN",.404,373,40,0) +^.4044I^3^3 +"KRN",.404,373,40,1,0) +1^ACTIVE INGREDIENTS^3 +"KRN",.404,373,40,1,1) +.01 +"KRN",.404,373,40,1,2) +1,21^40^1,1 +"KRN",.404,373,40,2,0) +2^STRENGTH^3 +"KRN",.404,373,40,2,1) +1 +"KRN",.404,373,40,2,2) +2,11^45^2,1 +"KRN",.404,373,40,3,0) +3^UNITS^3 +"KRN",.404,373,40,3,1) +2 +"KRN",.404,373,40,3,2) +3,8^30^3,1 +"KRN",.404,374,0) +BLOCK1^50 +"KRN",.404,374,40,0) +^.4044I^11^11 +"KRN",.404,374,40,1,0) +1^GENERIC NAME^3 +"KRN",.404,374,40,1,1) +.01 +"KRN",.404,374,40,1,2) +1,15^40^1,1 +"KRN",.404,374,40,2,0) +2^VA CLASSIFICATION^3 +"KRN",.404,374,40,2,1) +2 +"KRN",.404,374,40,2,2) +2,20^20^2,1 +"KRN",.404,374,40,3,0) +3^PHARMACY ORDERABLE ITEM^3 +"KRN",.404,374,40,3,1) +2.1 +"KRN",.404,374,40,3,2) +3,26^40^3,1 +"KRN",.404,374,40,4,0) +4^NATIONAL DRUG FILE ENTRY^3 +"KRN",.404,374,40,4,1) +20 +"KRN",.404,374,40,4,2) +4,27^51^4,1 +"KRN",.404,374,40,5,0) +5^VA PRODUCT NAME^3 +"KRN",.404,374,40,5,1) +21 +"KRN",.404,374,40,5,2) +5,18^60^5,1 +"KRN",.404,374,40,6,0) +6^PSNDF VA PRODUCT NAME ENTRY^3 +"KRN",.404,374,40,6,1) +22 +"KRN",.404,374,40,6,2) +6,30^50^6,1 +"KRN",.404,374,40,7,0) +7^STRENGTH^3 +"KRN",.404,374,40,7,1) +901 +"KRN",.404,374,40,7,2) +7,11^13^7,1 +"KRN",.404,374,40,8,0) +8^UNIT^3 +"KRN",.404,374,40,8,1) +902 +"KRN",.404,374,40,8,2) +8,7^73^8,1 +"KRN",.404,374,40,9,0) +9^Select POSSIBLE DOSAGES^3 +"KRN",.404,374,40,9,1) +903 +"KRN",.404,374,40,9,2) +9,26^13^9,1 +"KRN",.404,374,40,10,0) +10^CMOP DISPENSE^3 +"KRN",.404,374,40,10,1) +213 +"KRN",.404,374,40,10,2) +10,16^3^10,1 +"KRN",.404,374,40,11,0) +11^CMOP ID^3 +"KRN",.404,374,40,11,1) +27 +"KRN",.404,374,40,11,2) +11,10^5^11,1 +"KRN",19,10024,-1) +0^46 +"KRN",19,10024,0) +TMG TEXT MENU^Text Management Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10024,10,0) +^19.01IP^13^13 +"KRN",19,10024,10,12,0) +10048 +"KRN",19,10024,10,12,"^") +TMG AUTHOR TRANS COST ANY +"KRN",19,10024,99) +60075,58861 +"KRN",19,10024,"U") +TEXT MANAGEMENT MENU +"KRN",19,10026,-1) +0^52 +"KRN",19,10026,0) +TMG VPE MENU^VPE Menu Options^^M^^^^^^^^^y +"KRN",19,10026,10,0) +^19.01IP^14^14 +"KRN",19,10026,10,6,0) +10060^RPTR +"KRN",19,10026,10,6,"^") +TMG REDIRECT POINTERS +"KRN",19,10026,10,7,0) +10061^PTR +"KRN",19,10026,10,7,"^") +TMG SHOW POINTERS IN +"KRN",19,10026,10,8,0) +10062^PRO +"KRN",19,10026,10,8,"^") +TMG XUINDEX2 +"KRN",19,10026,10,9,0) +10063^IDE +"KRN",19,10026,10,9,"^") +TMG DEBUGGER +"KRN",19,10026,10,10,0) +10074^NOD +"KRN",19,10026,10,10,"^") +TMG ASK SHOW ARRAY NODES +"KRN",19,10026,10,11,0) +10075^DUMP +"KRN",19,10026,10,11,"^") +TMG REC INQUIRE +"KRN",19,10026,10,13,0) +10080^SEL +"KRN",19,10026,10,13,"^") +TMG SELECT EDIT RECORDS +"KRN",19,10026,10,14,0) +10081^BRW +"KRN",19,10026,10,14,"^") +TMG REC BROWSE +"KRN",19,10026,99) +60699,74258 +"KRN",19,10026,"U") +VPE MENU OPTIONS +"KRN",19,10032,-1) +0^26 +"KRN",19,10032,0) +TMG REFILE UPLOAD^Refile Uploaded Buffer^^A^^^^^^^^^y^1 +"KRN",19,10032,20) +D REFILE^TMGPUTN0 +"KRN",19,10032,"U") +REFILE UPLOADED BUFFER +"KRN",19,10033,-1) +0^21 +"KRN",19,10033,0) +TMG PHARMACY^TMG Pharmacy Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10033,10,0) +^19.01IP^12^12 +"KRN",19,10033,10,12,0) +10073^ED +"KRN",19,10033,10,12,"^") +TMG PHARM EDIT VA PRODUCT +"KRN",19,10033,99) +60332,54590 +"KRN",19,10033,"U") +TMG PHARMACY MENU +"KRN",19,10034,-1) +0^18 +"KRN",19,10034,0) +TMG OTHER 1^TMG Menu (Other) #1^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10034,10,0) +^19.01IP^21^17 +"KRN",19,10034,10,13,0) +10036^DOC +"KRN",19,10034,10,13,"^") +TMG DOC MENU +"KRN",19,10034,10,15,0) +10041^NS2 +"KRN",19,10034,10,15,"^") +TMG NURSE MENU +"KRN",19,10034,10,17,0) +10040^MGR +"KRN",19,10034,10,17,"^") +TMG MGR MENU +"KRN",19,10034,99) +60913,60478 +"KRN",19,10034,"U") +TMG MENU (OTHER) #1 +"KRN",19,10035,-1) +0^44 +"KRN",19,10035,0) +TMG SHOW SENSITIVITY ACCESS^Show Access to Sensitive Patients^^P^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10035,1,0) +^^2^2^3050202^ +"KRN",19,10035,1,1,0) +This menu option will show a list off the entire sensitivity access log, +"KRN",19,10035,1,2,0) +or all patients. +"KRN",19,10035,60) +DGSL(38.1, +"KRN",19,10035,61) +1 +"KRN",19,10035,62) +0 +"KRN",19,10035,63) +[TMG SENSITIVITY ACCESS] +"KRN",19,10035,64) +.01 +"KRN",19,10035,65) + +"KRN",19,10035,66) + +"KRN",19,10035,67) +ACCESS TO SENSITIVE PATIENTS +"KRN",19,10035,68) +1 +"KRN",19,10035,70) +HOME +"KRN",19,10035,79) +0 +"KRN",19,10035,"U") +SHOW ACCESS TO SENSITIVE PATIE +"KRN",19,10036,-1) +0^8 +"KRN",19,10036,0) +TMG DOC MENU^Doctors Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10036,1,0) +^^1^1^3051027^^ +"KRN",19,10036,1,1,0) +This is a grouping of options that are targeted for physicians +"KRN",19,10036,10,0) +^19.01IP^11^8 +"KRN",19,10036,10,6,0) +10035^SEN +"KRN",19,10036,10,6,"^") +TMG SHOW SENSITIVITY ACCESS +"KRN",19,10036,10,8,0) +10044^Rel +"KRN",19,10036,10,8,"^") +TMG RELEASE TRANS CURRENT USER +"KRN",19,10036,10,9,0) +10047^TE +"KRN",19,10036,10,9,"^") +TMG AUTHOR TRANS COST CURRENT +"KRN",19,10036,10,10,0) +10039^REG +"KRN",19,10036,10,10,"^") +TMG EDIT/ADD PATIENT +"KRN",19,10036,99) +60073,52864 +"KRN",19,10036,99.1) +61064,63680 +"KRN",19,10036,"U") +DOCTORS MENU +"KRN",19,10037,-1) +0^27 +"KRN",19,10037,0) +TMG REGISTER^TMG Register Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10037,10,0) +^19.01IP^10^10 +"KRN",19,10037,10,9,0) +10038^ED +"KRN",19,10037,10,9,"^") +TMG EDIT PATIENT +"KRN",19,10037,99) +59944,71993 +"KRN",19,10037,"U") +TMG REGISTER MENU +"KRN",19,10038,-1) +0^10 +"KRN",19,10038,0) +TMG EDIT PATIENT^View/Edit Patient^^A^^^^^^^^^y^1 +"KRN",19,10038,1,0) +^^1^1^3051027^^ +"KRN",19,10038,1,1,0) +This will edit or add a patient to the system (i.e. register them) +"KRN",19,10038,20) +DO EDITPT^TMGMISC(0) +"KRN",19,10038,"U") +VIEW/EDIT PATIENT +"KRN",19,10039,-1) +0^12 +"KRN",19,10039,0) +TMG EDIT/ADD PATIENT^Edit (or Add) Patient^^A^^^^^^^^^y^1 +"KRN",19,10039,20) +DO EDITPT^TMGMISC(1) +"KRN",19,10039,"U") +EDIT (OR ADD) PATIENT +"KRN",19,10040,-1) +0^16 +"KRN",19,10040,0) +TMG MGR MENU^TMG Manager's Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10040,10,0) +^19.01IP^8^8 +"KRN",19,10040,10,1,0) +10082^1^1 +"KRN",19,10040,10,1,"^") +TMG ADAM +"KRN",19,10040,10,4,0) +10039^4^4 +"KRN",19,10040,10,4,"^") +TMG EDIT/ADD PATIENT +"KRN",19,10040,10,5,0) +10043^5^5 +"KRN",19,10040,10,5,"^") +TMG TRANSCRIPTION REPORT +"KRN",19,10040,10,6,0) +10046^6^6 +"KRN",19,10040,10,6,"^") +TMG PRINT CONTIGIOUSLY +"KRN",19,10040,10,7,0) +10048^7^7 +"KRN",19,10040,10,7,"^") +TMG AUTHOR TRANS COST ANY +"KRN",19,10040,10,8,0) +10045^8^8 +"KRN",19,10040,10,8,"^") +TMG RELEASE TRANS ANY USER +"KRN",19,10040,99) +60715,44542 +"KRN",19,10040,99.1) +61064,63680 +"KRN",19,10040,"U") +TMG MANAGER'S MENU +"KRN",19,10041,-1) +0^17 +"KRN",19,10041,0) +TMG NURSE MENU^Nurse Menu^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10041,10,0) +^19.01IP^13^10 +"KRN",19,10041,10,9,0) +10035^6^6 +"KRN",19,10041,10,9,"^") +TMG SHOW SENSITIVITY ACCESS +"KRN",19,10041,10,10,0) +10039^7^7 +"KRN",19,10041,10,10,"^") +TMG EDIT/ADD PATIENT +"KRN",19,10041,10,11,0) +10045^8^8 +"KRN",19,10041,10,11,"^") +TMG RELEASE TRANS ANY USER +"KRN",19,10041,10,12,0) +10046^9^9 +"KRN",19,10041,10,12,"^") +TMG PRINT CONTIGIOUSLY +"KRN",19,10041,99) +60073,48870 +"KRN",19,10041,99.1) +61064,63680 +"KRN",19,10041,"U") +NURSE MENU +"KRN",19,10042,-1) +0^13 +"KRN",19,10042,0) +TMG ERROR TRAP CHECK^Check Error Trap^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10042,20) +DO ^XTER +"KRN",19,10042,"U") +CHECK ERROR TRAP +"KRN",19,10043,-1) +0^50 +"KRN",19,10043,0) +TMG TRANSCRIPTION REPORT^Productivity Report^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10043,20) +DO RPTASK^TMGTRAN1 +"KRN",19,10043,"U") +PRODUCTIVITY REPORT +"KRN",19,10044,-1) +0^29 +"KRN",19,10044,0) +TMG RELEASE TRANS CURRENT USER^Release (Auto-Complete) Your Transcription^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10044,20) +DO FREECUR^TMGTRAN1 +"KRN",19,10044,"U") +RELEASE (AUTO-COMPLETE) YOUR T +"KRN",19,10045,-1) +0^28 +"KRN",19,10045,0) +TMG RELEASE TRANS ANY USER^Release (Auto-Complete) Any User's Transcription^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10045,20) +DO FREEASK^TMGTRAN1 +"KRN",19,10045,"U") +RELEASE (AUTO-COMPLETE) ANY US +"KRN",19,10046,-1) +0^22 +"KRN",19,10046,0) +TMG PRINT CONTIGIOUSLY^Print Notes Contigiously^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10046,1,0) +^^5^5^3050319^ +"KRN",19,10046,1,1,0) +The menu option will prompt for a patient's name, and then a date range. +"KRN",19,10046,1,2,0) +User will then be asked if notes should be separated onto a fresh page +"KRN",19,10046,1,3,0) +for each separate note (the default is to print them contigiously, i.e. +"KRN",19,10046,1,4,0) +the notes will come one right after another, with the break between notes +"KRN",19,10046,1,5,0) +occuring in the middle of the page). An output device may then be chosen. +"KRN",19,10046,20) +DO CONTPRNT^TMGPRPN +"KRN",19,10046,"U") +PRINT NOTES CONTIGIOUSLY +"KRN",19,10047,-1) +0^5 +"KRN",19,10047,0) +TMG AUTHOR TRANS COST CURRENT^Your Transcription Expenses^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10047,1,0) +^^1^1^3051027^^ +"KRN",19,10047,1,1,0) +This will show the transcription expense for the current user only +"KRN",19,10047,20) +DO RPTCURA^TMGTRAN1 +"KRN",19,10047,"U") +YOUR TRANSCRIPTION EXPENSES +"KRN",19,10048,-1) +0^4 +"KRN",19,10048,0) +TMG AUTHOR TRANS COST ANY^Transcription Expenses Report (Any Author)^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10048,1,0) +^^1^1^3051027^^ +"KRN",19,10048,1,1,0) +This shows the transcription expenses as specified +"KRN",19,10048,20) +DO RPTASKA^TMGTRAN1 +"KRN",19,10048,"U") +TRANSCRIPTION EXPENSES REPORT +"KRN",19,10049,-1) +0^19 +"KRN",19,10049,0) +TMG PASSWORDS UNMASK^Password Snooper^^A^^DG SECURITY OFFICER^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10049,1,0) +^^1^1^3050421^ +"KRN",19,10049,1,1,0) +Will display Access, Verify, and Electronic signiture codes for any user. +"KRN",19,10049,20) +DO PWDSNOOP^TMGTRAN1() +"KRN",19,10049,"U") +PASSWORD SNOOPER +"KRN",19,10050,-1) +0^49 +"KRN",19,10050,0) +TMG TRANS SHOW UNSIGNED^Show All Unsigned Notes^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10050,20) +DO SHOWUNSIGNED^TMGTRAN1 +"KRN",19,10050,"U") +SHOW ALL UNSIGNED NOTES +"KRN",19,10051,-1) +0^47 +"KRN",19,10051,0) +TMG TRANS REPRINT BATCH^Reprint Documents Batch Signed^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10051,20) +DO REPRINTSET^TMGTRNRP +"KRN",19,10051,"U") +REPRINT DOCUMENTS BATCH SIGNED +"KRN",19,10052,-1) +0^45 +"KRN",19,10052,0) +TMG SHOW XTER^Show Error Log^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10052,20) +DO ^XTER +"KRN",19,10052,"U") +SHOW ERROR LOG +"KRN",19,10053,-1) +0^11 +"KRN",19,10053,0) +TMG EDIT PROGRESS NOTE^Edit Progress Note Properties^^C^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10053,1,0) +^19.06^1^1^3080209^^^ +"KRN",19,10053,1,1,0) +This will allow editing of the properties (and the text) of a progress note +"KRN",19,10053,30) +TIU(8925, +"KRN",19,10053,31) +AMEQ +"KRN",19,10053,32) +Enter patient name (^ to quit): +"KRN",19,10053,40) +[TMG EDIT PROGRESS NOTE] +"KRN",19,10053,41) +8925 +"KRN",19,10053,43) +1 +"KRN",19,10053,"U") +EDIT PROGRESS NOTE PROPERTIES +"KRN",19,10054,-1) +0^14 +"KRN",19,10054,0) +TMG MAIN MENU TRANSCRIPTION^Transcription^^M^^^^^^^y^TEXT INTEGRATION UTILITIES^y^1^^^1 +"KRN",19,10054,1,0) +^^1^1^2950818^^^^ +"KRN",19,10054,1,1,0) +Main Text Integration Utilities menu for transcriptionists. +"KRN",19,10054,10,0) +^19.01IP^12^11 +"KRN",19,10054,10,5,0) +10043^5^5 +"KRN",19,10054,10,5,"^") +TMG TRANSCRIPTION REPORT +"KRN",19,10054,10,6,0) +10039^7^7 +"KRN",19,10054,10,6,"^") +TMG EDIT/ADD PATIENT +"KRN",19,10054,10,7,0) +10045^8^8 +"KRN",19,10054,10,7,"^") +TMG RELEASE TRANS ANY USER +"KRN",19,10054,10,8,0) +10050^9^9 +"KRN",19,10054,10,8,"^") +TMG TRANS SHOW UNSIGNED +"KRN",19,10054,10,9,0) +10051^10^10 +"KRN",19,10054,10,9,"^") +TMG TRANS REPRINT BATCH +"KRN",19,10054,10,10,0) +10053^1^1 +"KRN",19,10054,10,10,"^") +TMG EDIT PROGRESS NOTE +"KRN",19,10054,10,11,0) +10048^6^6 +"KRN",19,10054,10,11,"^") +TMG AUTHOR TRANS COST ANY +"KRN",19,10054,10,12,0) +10078^11^11 +"KRN",19,10054,10,12,"^") +TMG TRANS REPRINT TEMPLATE +"KRN",19,10054,20) +D EDITSAVE^TIUEDI2(.DUZ) +"KRN",19,10054,26) +W !!,$$CENTER^TIULS("--- Transcriptionist Menu ---") +"KRN",19,10054,99) +60513,66490 +"KRN",19,10054,99.1) +61064,63680 +"KRN",19,10054,"U") +TRANSCRIPTION +"KRN",19,10056,-1) +0^15 +"KRN",19,10056,0) +TMG MEDIC CONVERTER^Convert Medic Transcription^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10056,20) +DO FULLDIRCVD^TMGMEDIC +"KRN",19,10056,"U") +CONVERT MEDIC TRANSCRIPTION +"KRN",19,10057,-1) +0^54 +"KRN",19,10057,0) +TMG XML EXPORTER^TMG's XML Exporter^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10057,20) +DO EXPORT^TMGXMLEX +"KRN",19,10057,"U") +TMG'S XML EXPORTER +"KRN",19,10058,-1) +0^51 +"KRN",19,10058,0) +TMG UPLOAD BATCH DOCUMENTS^Upload Batch of Documents^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10058,1,0) +^^2^2^3050831^^ +"KRN",19,10058,1,1,0) +Use this option to load a batch of documents, all stored in a common +"KRN",19,10058,1,2,0) +directory +"KRN",19,10058,20) +DO MAIN^TMGUPLD +"KRN",19,10058,"U") +UPLOAD BATCH OF DOCUMENTS +"KRN",19,10060,-1) +0^25 +"KRN",19,10060,0) +TMG REDIRECT POINTERS^REDIRECT RECORD POINTERS^^A^^XUPROGMODE^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10060,1,0) +^^3^3^3051120^^ +"KRN",19,10060,1,1,0) +Ask user for a file to search through, then choose a FROM record. Next a TO +"KRN",19,10060,1,2,0) +record is chosen, and Fileman is used to redirect all pointers to FROM +"KRN",19,10060,1,3,0) +record into pointers to TO record. +"KRN",19,10060,20) +DO ASKMVPTR^TMGFMUT +"KRN",19,10060,"U") +REDIRECT RECORD POINTERS +"KRN",19,10061,-1) +0^43 +"KRN",19,10061,0) +TMG SHOW POINTERS IN^Show Pointers to Record^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10061,1,0) +^^2^2^3051120^^ +"KRN",19,10061,1,1,0) +This will show all instances of a pointer to a given record. +"KRN",19,10061,1,2,0) +Note: This can be a SLOW process to scan the entire database. +"KRN",19,10061,20) +DO ASKPTRIN^TMGFMUT +"KRN",19,10061,"U") +SHOW POINTERS TO RECORD +"KRN",19,10062,-1) +0^55 +"KRN",19,10062,0) +TMG XUINDEX2^Pretty Print Routines^^R^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10062,1,0) +^19.06^2^2^3060101^^ +"KRN",19,10062,1,1,0) +This option will allow the direct printing of %INDEX's structured +"KRN",19,10062,1,2,0) +routine print. +"KRN",19,10062,25) +XCR^XINDX8 +"KRN",19,10062,"U") +PRETTY PRINT ROUTINES +"KRN",19,10063,-1) +0^7 +"KRN",19,10063,0) +TMG DEBUGGER^TMGIDE Debugger^^R^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10063,25) +START^TMGIDE +"KRN",19,10063,"U") +TMGIDE DEBUGGER +"KRN",19,10064,-1) +0^53 +"KRN",19,10064,0) +TMG WEBSITE EXPORT^TMG's Website/HTML TIU DOCUMENTS Exporter^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10064,20) +DO MAKESITE^TMGHTML1() +"KRN",19,10064,"U") +TMG'S WEBSITE/HTML TIU DOCUMEN +"KRN",19,10065,-1) +0^35 +"KRN",19,10065,0) +TMG SEQUEL DATA IMPORT CUSTOM^Custom Import Demographics from Sequel^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10065,20) +DO ASKIMPORT^TMGSEQL1 +"KRN",19,10065,"U") +CUSTOM IMPORT DEMOGRAPHICS FRO +"KRN",19,10066,-1) +0^40 +"KRN",19,10066,0) +TMG SEQUEL RPT SSNUM CONFLICTS^Report conflicting SS numbers^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10066,20) +DO RPTSSNCF^TMGSEQL3 +"KRN",19,10066,"U") +REPORT CONFLICTING SS NUMBERS +"KRN",19,10067,-1) +0^37 +"KRN",19,10067,0) +TMG SEQUEL IMPORT MENU^Import Demographics from Sequel^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10067,10,0) +^19.01IP^7^7 +"KRN",19,10067,10,1,0) +10065 +"KRN",19,10067,10,1,"^") +TMG SEQUEL DATA IMPORT CUSTOM +"KRN",19,10067,10,2,0) +10066^RPT +"KRN",19,10067,10,2,"^") +TMG SEQUEL RPT SSNUM CONFLICTS +"KRN",19,10067,10,3,0) +10068^CLR +"KRN",19,10067,10,3,"^") +TMG SEQUEL CLEAR IMPORT ERRORS +"KRN",19,10067,10,4,0) +10069^ +"KRN",19,10067,10,4,"^") +TMG SEQUEL DATA IMPORT +"KRN",19,10067,10,5,0) +10070 +"KRN",19,10067,10,5,"^") +TMG SEQUEL IMPORT DATES +"KRN",19,10067,10,6,0) +10071^SET +"KRN",19,10067,10,6,"^") +TMG SEQUEL IMPORT SETTINGS +"KRN",19,10067,10,7,0) +10072^DOB +"KRN",19,10067,10,7,"^") +TMG SEQUEL RPT DOB ERROR +"KRN",19,10067,99) +60325,39286 +"KRN",19,10067,"U") +IMPORT DEMOGRAPHICS FROM SEQUE +"KRN",19,10068,-1) +0^33 +"KRN",19,10068,0) +TMG SEQUEL CLEAR IMPORT ERRORS^Clear Demographics import error Alerts^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10068,20) +DO CLEARALL^TMGSEQL3 +"KRN",19,10068,"U") +CLEAR DEMOGRAPHICS IMPORT ERRO +"KRN",19,10069,-1) +0^34 +"KRN",19,10069,0) +TMG SEQUEL DATA IMPORT^Import Sequel Demographics Now^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10069,20) +DO RUNNOW^TMGSEQL1 +"KRN",19,10069,"U") +IMPORT SEQUEL DEMOGRAPHICS NOW +"KRN",19,10070,-1) +0^36 +"KRN",19,10070,0) +TMG SEQUEL IMPORT DATES^Show Sequel Import Dates & Times^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10070,20) +DO SHOWTIME^TMGSEQL3 +"KRN",19,10070,"U") +SHOW SEQUEL IMPORT DATES & TIM +"KRN",19,10071,-1) +0^38 +"KRN",19,10071,0) +TMG SEQUEL IMPORT SETTINGS^Sequel Import Settings^^C^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10071,30) +TMG(22711, +"KRN",19,10071,31) +AEQM +"KRN",19,10071,32) +Press for Settings ( ^ to Quit) +"KRN",19,10071,33) +`1 +"KRN",19,10071,40) +[TMG UPDATE SETTINGS] +"KRN",19,10071,41) +22711 +"KRN",19,10071,43) +1 +"KRN",19,10071,"U") +SEQUEL IMPORT SETTINGS +"KRN",19,10072,-1) +0^39 +"KRN",19,10072,0) +TMG SEQUEL RPT DOB ERROR^Report DOB errors^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10072,20) +DO RPTDOBER^TMGSEQL3 +"KRN",19,10072,"U") +REPORT DOB ERRORS +"KRN",19,10073,-1) +0^20 +"KRN",19,10073,0) +TMG PHARM EDIT VA PRODUCT^Edit VA PRODUCT^^C^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10073,30) +PSNDF(50.68, +"KRN",19,10073,31) +AEQM +"KRN",19,10073,40) +[TMG VIEW DRUG] +"KRN",19,10073,41) +50.68 +"KRN",19,10073,43) +1 +"KRN",19,10073,"U") +EDIT VA PRODUCT +"KRN",19,10074,-1) +0^3 +"KRN",19,10074,0) +TMG ASK SHOW ARRAY NODES^Show Array Nodes^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10074,20) +DO BROWSEASK^TMGMISC +"KRN",19,10074,"U") +SHOW ARRAY NODES +"KRN",19,10075,-1) +0^24 +"KRN",19,10075,0) +TMG REC INQUIRE^Record Dump (Inquire)^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10075,20) +DO ASKDUMP^TMGDEBUG +"KRN",19,10075,"U") +RECORD DUMP (INQUIRE) +"KRN",19,10078,-1) +0^48 +"KRN",19,10078,0) +TMG TRANS REPRINT TEMPLATE^Reprint Documents Stored in Template^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10078,1,0) +^^8^8^3060905^^ +"KRN",19,10078,1,1,0) +To use this menu, first use Fileman to search for documents +"KRN",19,10078,1,2,0) +in file 8925 (TIU DOCUMENTS), using whatever other search +"KRN",19,10078,1,3,0) +criteria desired (i.e. author, patient etc.) Then, when +"KRN",19,10078,1,4,0) +prompted to: +"KRN",19,10078,1,5,0) +STORE RESULTS OF SEARCH IN TEMPLATE: <--- enter a name. +"KRN",19,10078,1,6,0) + +"KRN",19,10078,1,7,0) +Then, when running this function, enter this name again to +"KRN",19,10078,1,8,0) +choose the template, and documents will be reprinted to it. +"KRN",19,10078,20) +DO PRTEMPL^TMGTRNRP +"KRN",19,10078,"U") +REPRINT DOCUMENTS STORED IN TE +"KRN",19,10079,-1) +0^30 +"KRN",19,10079,0) +TMG REPRINT TEMPLATE^REPRINT TEMPLATE^^A^^^^^^^^^y^1 +"KRN",19,10079,20) +DO PRTEMPL^TMGTRNRP +"KRN",19,10079,"U") +REPRINT TEMPLATE +"KRN",19,10080,-1) +0^32 +"KRN",19,10080,0) +TMG SELECT EDIT RECORDS^Select & Edit Records^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10080,1,0) +^^1^1^3061007^^ +"KRN",19,10080,1,1,0) +This function asks for records to browse among, then allows users to browse records, selecting those to be edited. +"KRN",19,10080,20) +DO ASKSELED^TMGSELED +"KRN",19,10080,"U") +SELECT & EDIT RECORDS +"KRN",19,10081,-1) +0^23 +"KRN",19,10081,0) +TMG REC BROWSE^RECORD BROWSE^^A^^^^^^^^FP OF GREENEVILLE (TMG)^y^1 +"KRN",19,10081,1,0) +^^3^3^3070310^^ +"KRN",19,10081,1,1,0) +This option will allow a browse of a record, +"KRN",19,10081,1,2,0) +with ability to follow pointers on to other +"KRN",19,10081,1,3,0) +linked records. +"KRN",19,10081,20) +D ASKBROWS^TMGBROWS +"KRN",19,10081,"U") +RECORD BROWSE +"KRN",19,10082,-1) +0^1 +"KRN",19,10082,0) +TMG ADAM^Adam^^M^^^^^^^^FP OF GREENEVILLE (TMG)^y +"KRN",19,10082,10,0) +^19.01IP^24^11 +"KRN",19,10082,10,9,0) +10024^TX +"KRN",19,10082,10,9,"^") +TMG TEXT MENU +"KRN",19,10082,10,18,0) +10026^VPE +"KRN",19,10082,10,18,"^") +TMG VPE MENU +"KRN",19,10082,10,19,0) +10033^PHAR +"KRN",19,10082,10,19,"^") +TMG PHARMACY +"KRN",19,10082,10,21,0) +10034^Ox +"KRN",19,10082,10,21,"^") +TMG OTHER 1 +"KRN",19,10082,10,22,0) +10039^REG +"KRN",19,10082,10,22,"^") +TMG EDIT/ADD PATIENT +"KRN",19,10082,10,23,0) +10054^TRAN +"KRN",19,10082,10,23,"^") +TMG MAIN MENU TRANSCRIPTION +"KRN",19,10082,10,24,0) +10067^SEQ +"KRN",19,10082,10,24,"^") +TMG SEQUEL IMPORT MENU +"KRN",19,10082,99) +60715,43516 +"KRN",19,10082,99.1) +61064,63680 +"KRN",19,10082,"U") +ADAM +"KRN",19,10084,-1) +0^2 +"KRN",19,10084,0) +TMG ADD PATIENT^TMGADDPATIENT^^^^^^^^^^ +"KRN",19,10084,"U") +TMGADDPATIENT +"KRN",19,10085,-1) +0^41 +"KRN",19,10085,0) +TMG SET PATIENT DEMOGRAPHICS^SET PATIENT DEMOGRAPHICS^^^^^^^^^^ +"KRN",19,10085,"U") +SET PATIENT DEMOGRAPHICS +"KRN",19,10086,-1) +0^31 +"KRN",19,10086,0) +TMG RPC CONTEXT SCANNER^ScanManager 1.0.0.0^^B^^^^^^^^ +"KRN",19,10086,1,0) +^^3^3^3080120^^ +"KRN",19,10086,1,1,0) +This option is required by the Kernel Broker to give +"KRN",19,10086,1,2,0) +access to the RPCs used by the ScanManager app +"KRN",19,10086,1,3,0) +(Scanner.exe) +"KRN",19,10086,"RPC",0) +^19.05P^14^14 +"KRN",19,10086,"RPC",1,0) +TMG UPLOAD FILE +"KRN",19,10086,"RPC",2,0) +TMG DOWNLOAD FILE +"KRN",19,10086,"RPC",3,0) +MAGGADDIMAGE +"KRN",19,10086,"RPC",4,0) +MAG3 TIU IMAGE +"KRN",19,10086,"RPC",5,0) +MAG3 CPRS TIU NOTE +"KRN",19,10086,"RPC",6,0) +TMG GET IMAGE LONG DESCRIPTION +"KRN",19,10086,"RPC",7,0) +TMG GET DFN +"KRN",19,10086,"RPC",8,0) +TMG GET BLANK TIU DOCUMENT +"KRN",19,10086,"RPC",9,0) +TMG AUTOSIGN TIU DOCUMENT +"KRN",19,10086,"RPC",10,0) +TMG GET PATIENT DEMOGRAPHICS +"KRN",19,10086,"RPC",11,0) +TMG SET PATIENT DEMOGRAPHICS +"KRN",19,10086,"RPC",12,0) +TMG ADD PATIENT +"KRN",19,10086,"RPC",13,0) +TMG BARCODE ENCODE +"KRN",19,10086,"RPC",14,0) +TMG BARCODE DECODE +"KRN",19,10086,"U") +SCANMANAGER 1.0.0.0 +"KRN",8994,1767,-1) +0^5 +"KRN",8994,1767,0) +TMG DOWNLOAD FILE^DOWNLOAD^TMGRPC1^4^P^^^1^.5 +"KRN",8994,1767,1,0) +^^5^5^3050926^^ +"KRN",8994,1767,1,1,0) +This RPC will be for requesting a file from the server. +"KRN",8994,1767,1,2,0) + +"KRN",8994,1767,1,3,0) +By tunneling file transfer through the RPCBroker, it allows the server to +"KRN",8994,1767,1,4,0) +control access to files. And it negates need to set up an independant ftp +"KRN",8994,1767,1,5,0) +or filesystem server etc. +"KRN",8994,1767,2,0) +^8994.02A^2^2 +"KRN",8994,1767,2,1,0) +FNAME^1^256^1^2 +"KRN",8994,1767,2,1,1,0) +^^8^8^3050902^^ +"KRN",8994,1767,2,1,1,1,0) +This should be the filename of the requested file. This needs to be in a +"KRN",8994,1767,2,1,1,2,0) +format that can be passed to the host filesystem. +"KRN",8994,1767,2,1,1,3,0) + +"KRN",8994,1767,2,1,1,4,0) +This should be only the filename (not including the path) +"KRN",8994,1767,2,1,1,5,0) + +"KRN",8994,1767,2,1,1,6,0) +For my implementation, I am planning for the server to pass a list of +"KRN",8994,1767,2,1,1,7,0) +available files to the client. The client can then pass these back one at +"KRN",8994,1767,2,1,1,8,0) +a time to get the actual file. +"KRN",8994,1767,2,2,0) +FPATH^1^256^1^1 +"KRN",8994,1767,2,2,1,0) +^^2^2^3050926^^ +"KRN",8994,1767,2,2,1,1,0) +This should be the path up to, but not including, the filename, of the file +"KRN",8994,1767,2,2,1,2,0) +to be requested from the server. +"KRN",8994,1767,2,"B","FNAME",1) + +"KRN",8994,1767,2,"B","FPATH",2) + +"KRN",8994,1767,2,"PARAMSEQ",1,2) + +"KRN",8994,1767,2,"PARAMSEQ",2,1) + +"KRN",8994,1767,3,0) +^8994.03^19^19^3050926^^^ +"KRN",8994,1767,3,1,0) +The return value will be an array, with each node containing 512 +"KRN",8994,1767,3,2,0) +bytes, encoded for ASCII transfer with a Base64 formula (an improvement +"KRN",8994,1767,3,3,0) +on UUENCODE functions) +"KRN",8994,1767,3,4,0) + +"KRN",8994,1767,3,5,0) +GREF(0)=1 <---- 1=valid 0=invalid (failure of load) +"KRN",8994,1767,3,6,0) +GREF(1)=";lakjsdasvoin;lkj32409u234,mnsdfoi239483....." +"KRN",8994,1767,3,7,0) +GREF(2)="987sdf,n09xc,/knm6flkhdgjkhsdo4ioidk,sdf....." +"KRN",8994,1767,3,8,0) +GREF(3)="asdoi,xmnsdkh98xd,.m3ddbdsgkhsdf=cxjkdgm ....." +"KRN",8994,1767,3,9,0) +... +"KRN",8994,1767,3,10,0) + +"KRN",8994,1767,3,11,0) +Note: Here I am showing random ascii characters. But in actuality, each +"KRN",8994,1767,3,12,0) +position will hold only those characters used in the Base64 method. +"KRN",8994,1767,3,13,0) + +"KRN",8994,1767,3,14,0) +On the client RPCBroker end, the result will be stored in a TStringList, +"KRN",8994,1767,3,15,0) +with each line being stored in a separate index (i.e. Strings[i]) +"KRN",8994,1767,3,16,0) + +"KRN",8994,1767,3,17,0) +Notice that when saving on the client side, the zero node,GREF(0), is NOT +"KRN",8994,1767,3,18,0) +part of the file, and should be discarded or otherwise not included in the +"KRN",8994,1767,3,19,0) +save. +"KRN",8994,1768,-1) +0^12 +"KRN",8994,1768,0) +TMG UPLOAD FILE^UPLOAD^TMGRPC1^1^P^^^1^.1 +"KRN",8994,1768,1,0) +^8994.01^2^2^3050928^^^ +"KRN",8994,1768,1,1,0) +This function will accept a binary file uploaded to the server, encoded in a +"KRN",8994,1768,1,2,0) +BASE64 ascii encoding format. +"KRN",8994,1768,2,0) +^8994.02A^4^4 +"KRN",8994,1768,2,1,0) +FPATH^1^1024^1^1 +"KRN",8994,1768,2,1,1,0) +^8994.021^14^14^3050928^^^^ +"KRN",8994,1768,2,1,1,1,0) +This is the path to store the file into. Note that the server will store +"KRN",8994,1768,2,1,1,2,0) +all files relative to an internal (hidden) directory. Thus if the storage +"KRN",8994,1768,2,1,1,3,0) +location is specified to be: +"KRN",8994,1768,2,1,1,4,0) + /ZZ1/002/IMAGE0001.JPG +"KRN",8994,1768,2,1,1,5,0) + +"KRN",8994,1768,2,1,1,6,0) +then the actual storage location might actually be: +"KRN",8994,1768,2,1,1,7,0) + +"KRN",8994,1768,2,1,1,8,0) + /var/local/images/storage/ZZ1/002/IMAGE0001.JPG +"KRN",8994,1768,2,1,1,9,0) + +"KRN",8994,1768,2,1,1,10,0) +The internal (hidden) directory is stored in field #22700 (TMG PRIVATE +"KRN",8994,1768,2,1,1,11,0) +PHYSICAL REFERENCE) of file 2005.2 (NETWORK LOCATION) +"KRN",8994,1768,2,1,1,12,0) + +"KRN",8994,1768,2,1,1,13,0) +Which record of the NETWORK LOCATION file to use is specified as in the input +"KRN",8994,1768,2,1,1,14,0) +parameter LOCIEN for this RPC Call (TMG UPLOAD FILE) +"KRN",8994,1768,2,2,0) +FNAME^1^1024^1^2 +"KRN",8994,1768,2,2,1,0) +^^1^1^3050928^^ +"KRN",8994,1768,2,2,1,1,0) +This is the name of the file to store. It should not include path elements. +"KRN",8994,1768,2,3,0) +LOCIEN^1^16^0^3 +"KRN",8994,1768,2,3,1,0) +^^6^6^3050928^^ +"KRN",8994,1768,2,3,1,1,0) +This is the record number (IEN) from file 2005.2 (NETWORK LOCATION) that the +"KRN",8994,1768,2,3,1,2,0) +file will be uploaded to. +"KRN",8994,1768,2,3,1,3,0) + +"KRN",8994,1768,2,3,1,4,0) +This is required so that a relative root path can be obtained from custom +"KRN",8994,1768,2,3,1,5,0) +field 22700 (TMG PRIVATE PHYSICAL LOCATION). See also description of input +"KRN",8994,1768,2,3,1,6,0) +parameter FPATH. +"KRN",8994,1768,2,4,0) +ARRAY^2^^1^4 +"KRN",8994,1768,2,4,1,0) +^^11^11^3050928^^ +"KRN",8994,1768,2,4,1,1,0) +This will be the array to store the uploaded data into. +"KRN",8994,1768,2,4,1,2,0) +For example: +"KRN",8994,1768,2,4,1,3,0) + +"KRN",8994,1768,2,4,1,4,0) +ARRAY(0)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,5,0) +ARRAY(0)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,6,0) +ARRAY(1)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,7,0) +ARRAY(2)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,8,0) +ARRAY(3)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,9,0) +ARRAY(4)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,10,0) +ARRAY(5)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,4,1,11,0) +ARRAY(6)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1768,2,"B","ARRAY",4) + +"KRN",8994,1768,2,"B","FNAME",2) + +"KRN",8994,1768,2,"B","FPATH",1) + +"KRN",8994,1768,2,"B","LOCIEN",3) + +"KRN",8994,1768,2,"PARAMSEQ",1,1) + +"KRN",8994,1768,2,"PARAMSEQ",2,2) + +"KRN",8994,1768,2,"PARAMSEQ",3,3) + +"KRN",8994,1768,2,"PARAMSEQ",4,4) + +"KRN",8994,1769,-1) +0^9 +"KRN",8994,1769,0) +TMG GET IMAGE LONG DESCRIPTION^GETLONG^TMGRPC1^4^P^^^1^1 +"KRN",8994,1769,1,0) +^8994.01^2^2^3051016^^^ +"KRN",8994,1769,1,1,0) +This RPC will return the LONG DESCRIPTION (field 11) from specified record +"KRN",8994,1769,1,2,0) +in IMAGE file. +"KRN",8994,1769,2,0) +^8994.02A^1^1 +"KRN",8994,1769,2,1,0) +IMAGEIEN^1^6^1^1 +"KRN",8994,1769,2,1,1,0) +^8994.021^3^3^3051016^^^ +"KRN",8994,1769,2,1,1,1,0) +This value should be the IEN for the record in question, from file IMAGE +"KRN",8994,1769,2,1,1,2,0) +(file 2005). If IEN references a non-existing record, then empty result +"KRN",8994,1769,2,1,1,3,0) +will be returned. +"KRN",8994,1769,2,"B","IMAGEIEN",1) + +"KRN",8994,1769,2,"PARAMSEQ",1,1) + +"KRN",8994,1769,3,0) +^^18^18^3051016^^ +"KRN",8994,1769,3,1,0) +This will return the results from the WP field, number 11 (LONG DESCRIPTION) +"KRN",8994,1769,3,2,0) +from the IMAGE file (2005) +"KRN",8994,1769,3,3,0) + +"KRN",8994,1769,3,4,0) +The return format will be as follows: +"KRN",8994,1769,3,5,0) +Array(0)=WP header line. Format is: ^^MaxLine^MaxLine^FMDate/TimeStamp +"KRN",8994,1769,3,6,0) +Array(1)=WP Line 1 +"KRN",8994,1769,3,7,0) +Array(2)=WP LIne 2 +"KRN",8994,1769,3,8,0) +... etc. +"KRN",8994,1769,3,9,0) + +"KRN",8994,1769,3,10,0) +In client, these results could be accesible as follows: +"KRN",8994,1769,3,11,0) + +"KRN",8994,1769,3,12,0) +RPCBroker.Results[0]=WP Header Line +"KRN",8994,1769,3,13,0) +RPCBroker.Results[1]=WP Line 1 +"KRN",8994,1769,3,14,0) +RPCBroker.Results[2]=WP Line 2 +"KRN",8994,1769,3,15,0) +... etc. +"KRN",8994,1769,3,16,0) + +"KRN",8994,1769,3,17,0) +If there is no value for field 11, result will be: +"KRN",8994,1769,3,18,0) +Array(0)="" +"KRN",8994,1770,-1) +0^8 +"KRN",8994,1770,0) +TMG GET DFN^GETDFN^TMGRPC1^1^P^0^^1^1 +"KRN",8994,1770,1,0) +^8994.01^2^2^3070725^^^^ +"KRN",8994,1770,1,1,0) +Used by CPRS customization for looking up a patient, and returning +"KRN",8994,1770,1,2,0) +the DFN (IEN in PATIENT file). +"KRN",8994,1770,2,0) +^8994.02A^9^9 +"KRN",8994,1770,2,1,0) +RECNUM^1^64^0^1 +"KRN",8994,1770,2,1,1,0) +^^2^2^3070725^^ +"KRN",8994,1770,2,1,1,1,0) +This parameter is for a chart or account number in an independent PMS. +"KRN",8994,1770,2,1,1,2,0) +Optional parameter. +"KRN",8994,1770,2,2,0) +PMS^1^16^0^2 +"KRN",8994,1770,2,2,1,0) +^^12^12^3070725^^ +"KRN",8994,1770,2,2,1,1,0) +This is a number indicating which PMS that the RECNUM parameter +"KRN",8994,1770,2,2,1,2,0) +refers to. +"KRN",8994,1770,2,2,1,3,0) + +"KRN",8994,1770,2,2,1,4,0) +Example inputs: +"KRN",8994,1770,2,2,1,5,0) +1 <-- for TMG MEDIC ACCOUNT NUMBER +"KRN",8994,1770,2,2,1,6,0) +2 <-- for SEQUEL ACCOUNT NUMBER +"KRN",8994,1770,2,2,1,7,0) + +"KRN",8994,1770,2,2,1,8,0) +Note: This is an 'optional' parameter, BUT if RECNUM parameter is supplied, +"KRN",8994,1770,2,2,1,9,0) +then this parameter must also be supplied, otherwise RecNum will be ignored. +"KRN",8994,1770,2,2,1,10,0) + +"KRN",8994,1770,2,2,1,11,0) +Note: Dealing with these numbers is hard coded into the RPC server code, +"KRN",8994,1770,2,2,1,12,0) +and adding additional PMS support must be coded into the calls. +"KRN",8994,1770,2,3,0) +LNAME^1^64^^3 +"KRN",8994,1770,2,3,1,0) +^^1^1^3070725^^ +"KRN",8994,1770,2,3,1,1,0) +This is the patient's last name (i.e. family name) +"KRN",8994,1770,2,4,0) +FNAME^1^64^^4 +"KRN",8994,1770,2,4,1,0) +^^1^1^3070725^^ +"KRN",8994,1770,2,4,1,1,0) +This is the patient's first (given) name. +"KRN",8994,1770,2,5,0) +MNAME^1^64^^5 +"KRN",8994,1770,2,5,1,0) +^^1^1^3070725^^ +"KRN",8994,1770,2,5,1,1,0) +This is the patient's middle name, OR middle initial. +"KRN",8994,1770,2,6,0) +DOB^1^32^^6 +"KRN",8994,1770,2,6,1,0) +^^2^2^3070725^^ +"KRN",8994,1770,2,6,1,1,0) +This is the patient's date of birth, in EXTERNAL (i.e. +"KRN",8994,1770,2,6,1,2,0) +user supplied) format. +"KRN",8994,1770,2,7,0) +SEX^1^1^^7 +"KRN",8994,1770,2,7,1,0) +^^3^3^3070725^^ +"KRN",8994,1770,2,7,1,1,0) +This is the patient's sex. Should be: +"KRN",8994,1770,2,7,1,2,0) +M for male +"KRN",8994,1770,2,7,1,3,0) +F for female +"KRN",8994,1770,2,8,0) +SSNUM^1^9^^8 +"KRN",8994,1770,2,8,1,0) +^^6^6^3070725^^ +"KRN",8994,1770,2,8,1,1,0) +This is the patient's Social Security Number (SS Num) +"KRN",8994,1770,2,8,1,2,0) +Should NOT include dashes. +"KRN",8994,1770,2,8,1,3,0) + +"KRN",8994,1770,2,8,1,4,0) +Example: +"KRN",8994,1770,2,8,1,5,0) +123456789 +"KRN",8994,1770,2,8,1,6,0) +NOT: 123-45-6789 +"KRN",8994,1770,2,9,0) +AUTOADD^1^1^^9 +"KRN",8994,1770,2,9,1,0) +^^6^6^3070725^^ +"KRN",8994,1770,2,9,1,1,0) +If this parameter value is 1, then patient will be automatically +"KRN",8994,1770,2,9,1,2,0) +registered if they are not found during lookup. +"KRN",8994,1770,2,9,1,3,0) + +"KRN",8994,1770,2,9,1,4,0) +Examples: +"KRN",8994,1770,2,9,1,5,0) +1 <-- auto add if not found +"KRN",8994,1770,2,9,1,6,0) +0 <-- don't auto add (default value) +"KRN",8994,1770,2,"B","AUTOADD",9) + +"KRN",8994,1770,2,"B","DOB",6) + +"KRN",8994,1770,2,"B","FNAME",4) + +"KRN",8994,1770,2,"B","LNAME",3) + +"KRN",8994,1770,2,"B","MNAME",5) + +"KRN",8994,1770,2,"B","PMS",2) + +"KRN",8994,1770,2,"B","RECNUM",1) + +"KRN",8994,1770,2,"B","SEX",7) + +"KRN",8994,1770,2,"B","SSNUM",8) + +"KRN",8994,1770,2,"PARAMSEQ",1,1) + +"KRN",8994,1770,2,"PARAMSEQ",2,2) + +"KRN",8994,1770,2,"PARAMSEQ",3,3) + +"KRN",8994,1770,2,"PARAMSEQ",4,4) + +"KRN",8994,1770,2,"PARAMSEQ",5,5) + +"KRN",8994,1770,2,"PARAMSEQ",6,6) + +"KRN",8994,1770,2,"PARAMSEQ",7,7) + +"KRN",8994,1770,2,"PARAMSEQ",8,8) + +"KRN",8994,1770,2,"PARAMSEQ",9,9) + +"KRN",8994,1770,3,0) +^8994.03^1^1^3070725^^^^ +"KRN",8994,1770,3,1,0) +This will return the DFN (IEN in PATIENT file), or -1 if not found or error. +"KRN",8994,1771,-1) +0^7 +"KRN",8994,1771,0) +TMG GET BLANK TIU DOCUMENT^BLANKTIU^TMGRPC1^1^P^0^^1^1 +"KRN",8994,1771,1,0) +^8994.01^3^3^3070725^^ +"KRN",8994,1771,1,1,0) +This RPC call will be used to create a new record in file 8925 (TIU DOCUMENT) +"KRN",8994,1771,1,2,0) +that can be used for other purposes. +"KRN",8994,1771,1,3,0) +Note: This will be an UNSIGNED document that will later need to be signed. +"KRN",8994,1771,2,0) +^8994.02A^5^5 +"KRN",8994,1771,2,1,0) +DFN^1^16^1^1 +"KRN",8994,1771,2,1,1,0) +^^2^2^3070725^^ +"KRN",8994,1771,2,1,1,1,0) +This is the IEN in the PATIENT file. I.e. the record number of the patient +"KRN",8994,1771,2,1,1,2,0) +for which the note is being created. +"KRN",8994,1771,2,2,0) +PERSON^1^64^1^2 +"KRN",8994,1771,2,2,1,0) +^^1^1^3070725^^ +"KRN",8994,1771,2,2,1,1,0) +This is the name of the provider of record for the new document. +"KRN",8994,1771,2,3,0) +LOC^1^64^1^3 +"KRN",8994,1771,2,3,1,0) +^^3^3^3070725^^ +"KRN",8994,1771,2,3,1,1,0) +This is the location for the new document. Note this location should be the +"KRN",8994,1771,2,3,1,2,0) +name of a location named in the HOSPITAL LOCATION file (#44). That is, the +"KRN",8994,1771,2,3,1,3,0) +.01 field name, or perhaps the abbreviation for the location if defined. +"KRN",8994,1771,2,4,0) +DOS^1^32^1^4 +"KRN",8994,1771,2,4,1,0) +^^1^1^3070725^^ +"KRN",8994,1771,2,4,1,1,0) +This is the Date of Service for the new document. +"KRN",8994,1771,2,5,0) +TITLE^1^64^1^5 +"KRN",8994,1771,2,5,1,0) +^^4^4^3070725^^ +"KRN",8994,1771,2,5,1,1,0) +This is the title for the new note. +"KRN",8994,1771,2,5,1,2,0) +Note: This must be a title as defined in file 8925.1 (TIU DOCUMENT DEFINITION). +"KRN",8994,1771,2,5,1,3,0) +That is to say, the name of the .01 field, or perhaps any abbreviation +"KRN",8994,1771,2,5,1,4,0) +if defined. +"KRN",8994,1771,2,"B","DFN",1) + +"KRN",8994,1771,2,"B","DOS",4) + +"KRN",8994,1771,2,"B","LOC",3) + +"KRN",8994,1771,2,"B","PERSON",2) + +"KRN",8994,1771,2,"B","TITLE",5) + +"KRN",8994,1771,2,"PARAMSEQ",1,1) + +"KRN",8994,1771,2,"PARAMSEQ",2,2) + +"KRN",8994,1771,2,"PARAMSEQ",3,3) + +"KRN",8994,1771,2,"PARAMSEQ",4,4) + +"KRN",8994,1771,2,"PARAMSEQ",5,5) + +"KRN",8994,1771,3,0) +^^1^1^3070725^^ +"KRN",8994,1771,3,1,0) +Returns the IEN (record number) of a new, blank note in file 8925 +"KRN",8994,1772,-1) +0^2 +"KRN",8994,1772,0) +TMG AUTOSIGN TIU DOCUMENT^AUTOSIGN^TMGRPC1^2^P^0^^1^1 +"KRN",8994,1772,1,0) +^^2^2^3070730^^ +"KRN",8994,1772,1,1,0) +This will allow the auto-signing of a document. It is designed to automatically +"KRN",8994,1772,1,2,0) +complete documents that are added to VistA via scanning. +"KRN",8994,1772,2,0) +^8994.02A^1^1 +"KRN",8994,1772,2,1,0) +DOCIEN^1^16^1^1 +"KRN",8994,1772,2,1,1,0) +^^1^1^3070730^^ +"KRN",8994,1772,2,1,1,1,0) +This is the IEN (internal entry number) of the document to be signed. +"KRN",8994,1772,2,"B","DOCIEN",1) + +"KRN",8994,1772,2,"PARAMSEQ",1,1) + +"KRN",8994,1772,3,0) +^^3^3^3070730^^ +"KRN",8994,1772,3,1,0) +Return value is an array. +"KRN",8994,1772,3,2,0) +Array(0)=1 if success, or -1 if failure. +"KRN",8994,1772,3,3,0) +Errors are returned in Array("DIERR") +"KRN",8994,1773,-1) +0^10 +"KRN",8994,1773,0) +TMG GET PATIENT DEMOGRAPHICS^DFNINFO^TMGRPC1^2^P^^^1^1 +"KRN",8994,1773,1,0) +^^2^2^3070923^^ +"KRN",8994,1773,1,1,0) +This RPC calls returns patient demographic info in a formatted array. +"KRN",8994,1773,1,2,0) +See description of return parameter for details. +"KRN",8994,1773,2,0) +^8994.02A^1^1 +"KRN",8994,1773,2,1,0) +DFN^1^^1^1 +"KRN",8994,1773,2,1,1,0) +^^2^2^3070923^^ +"KRN",8994,1773,2,1,1,1,0) +This is the IEN (internal entry number), aka record number, +"KRN",8994,1773,2,1,1,2,0) +of the patient to get the demographics for. +"KRN",8994,1773,2,"B","DFN",1) + +"KRN",8994,1773,2,"PARAMSEQ",1,1) + +"KRN",8994,1773,3,0) +^^49^49^3070923^^ +"KRN",8994,1773,3,1,0) + ;" The results are in format: KeyName=Value, +"KRN",8994,1773,3,2,0) + ;" There is no set order these will appear. +"KRN",8994,1773,3,3,0) + ;" Here are the KeyName names that will be provided. +"KRN",8994,1773,3,4,0) + ;" If the record has no value, then value will be empty +"KRN",8994,1773,3,5,0) + ;" +"KRN",8994,1773,3,6,0) + ;" IEN=record# +"KRN",8994,1773,3,7,0) + ;" COMBINED_NAME= +"KRN",8994,1773,3,8,0) + ;" LNAME= +"KRN",8994,1773,3,9,0) + ;" FNAME= +"KRN",8994,1773,3,10,0) + ;" MNAME= +"KRN",8994,1773,3,11,0) + ;" PREFIX= +"KRN",8994,1773,3,12,0) + ;" SUFFIX= +"KRN",8994,1773,3,13,0) + ;" DEGREE +"KRN",8994,1773,3,14,0) + ;" DOB= +"KRN",8994,1773,3,15,0) + ;" SEX= +"KRN",8994,1773,3,16,0) + ;" SS_NUM= +"KRN",8994,1773,3,17,0) + ;" ADDRESS_LINE_1= +"KRN",8994,1773,3,18,0) + ;" ADDRESS_LINE_2= +"KRN",8994,1773,3,19,0) + ;" ADDRESS_LINE_3= +"KRN",8994,1773,3,20,0) + ;" CITY= +"KRN",8994,1773,3,21,0) + ;" STATE= +"KRN",8994,1773,3,22,0) + ;" ZIP4= +"KRN",8994,1773,3,23,0) + ;" BAD_ADDRESS= +"KRN",8994,1773,3,24,0) + ;" TEMP_ADDRESS_LINE_1= +"KRN",8994,1773,3,25,0) + ;" TEMP_ADDRESS_LINE_2= +"KRN",8994,1773,3,26,0) + ;" TEMP_ADDRESS_LINE_3= +"KRN",8994,1773,3,27,0) + ;" TEMP_CITY= +"KRN",8994,1773,3,28,0) + ;" TEMP_STATE= +"KRN",8994,1773,3,29,0) + ;" TEMP_ZIP4= +"KRN",8994,1773,3,30,0) + ;" TEMP_STARTING_DATE= +"KRN",8994,1773,3,31,0) + ;" TEMP_ENDING_DATE= +"KRN",8994,1773,3,32,0) + ;" TEMP_ADDRESS_ACTIVE= +"KRN",8994,1773,3,33,0) + ;" CONF_ADDRESS_LINE_1= +"KRN",8994,1773,3,34,0) + ;" CONF_ADDRESS_LINE_2= +"KRN",8994,1773,3,35,0) + ;" CONF_ADDRESS_LINE_3= +"KRN",8994,1773,3,36,0) + ;" CONF_CITY= +"KRN",8994,1773,3,37,0) + ;" CONF_STATE= +"KRN",8994,1773,3,38,0) + ;" CONF_ZIP4= +"KRN",8994,1773,3,39,0) + ;" CONF_STARTING_DATE= +"KRN",8994,1773,3,40,0) + ;" CONF_ENDING_DATE= +"KRN",8994,1773,3,41,0) + ;" CONF_ADDRESS_ACTIVE= +"KRN",8994,1773,3,42,0) + ;" PHONE_RESIDENCE= +"KRN",8994,1773,3,43,0) + ;" PHONE_WORK= +"KRN",8994,1773,3,44,0) + ;" PHONE_CELL= +"KRN",8994,1773,3,45,0) + ;" PHONE_TEMP= +"KRN",8994,1773,3,46,0) + +"KRN",8994,1773,3,47,0) + ;"Note, for the following, there may be multiple entries. # is record number +"KRN",8994,1773,3,48,0) + ;" ALIAS # NAME +"KRN",8994,1773,3,49,0) + ;" ALIAS # SSN +"KRN",8994,1774,-1) +0^11 +"KRN",8994,1774,0) +TMG SET PATIENT DEMOGRAPHICS^STPTINFO^TMGRPC1^1^P^^^1^1 +"KRN",8994,1774,1,0) +^8994.01^1^1^3070926^^^ +"KRN",8994,1774,1,1,0) +This RPC is for setting basic demographics info for a patient. +"KRN",8994,1774,2,0) +^8994.02A^2^2 +"KRN",8994,1774,2,1,0) +DFN^1^^1^1 +"KRN",8994,1774,2,1,1,0) +^^1^1^3070926^^ +"KRN",8994,1774,2,1,1,1,0) +This DFN value is the IEN (internal entry number) of the patient in the PATIENT file. +"KRN",8994,1774,2,2,0) +INFO^2^^1^2 +"KRN",8994,1774,2,2,1,0) +^^47^47^3070926^^ +"KRN",8994,1774,2,2,1,1,0) +This will be the data to set for the specified patient. +"KRN",8994,1774,2,2,1,2,0) +Demographics are passed in a Key=Value format: +"KRN",8994,1774,2,2,1,3,0) + +"KRN",8994,1774,2,2,1,4,0) +Here are the KeyName names that will be provided. +"KRN",8994,1774,2,2,1,5,0) +There is no set order these will appear. +"KRN",8994,1774,2,2,1,6,0) +If the record has no value, then value will be empty +"KRN",8994,1774,2,2,1,7,0) +If a record should be deleted, its value will be @ +"KRN",8994,1774,2,2,1,8,0) + INFO("COMBINED_NAME")= +"KRN",8994,1774,2,2,1,9,0) + INFO("PREFIX")= +"KRN",8994,1774,2,2,1,10,0) + INFO("SUFFIX")= +"KRN",8994,1774,2,2,1,11,0) + INFO("DEGREE")= +"KRN",8994,1774,2,2,1,12,0) + INFO("DOB")= +"KRN",8994,1774,2,2,1,13,0) + INFO("SEX")= +"KRN",8994,1774,2,2,1,14,0) + INFO("SS_NUM")= +"KRN",8994,1774,2,2,1,15,0) + INFO("ADDRESS_LINE_1")= +"KRN",8994,1774,2,2,1,16,0) + INFO("ADDRESS_LINE_2")= +"KRN",8994,1774,2,2,1,17,0) + INFO("ADDRESS_LINE_3")= +"KRN",8994,1774,2,2,1,18,0) + INFO("CITY")= +"KRN",8994,1774,2,2,1,19,0) + INFO("STATE")= +"KRN",8994,1774,2,2,1,20,0) + INFO("ZIP4")= +"KRN",8994,1774,2,2,1,21,0) + INFO("BAD_ADDRESS")= +"KRN",8994,1774,2,2,1,22,0) + INFO("TEMP_ADDRESS_LINE_1")= +"KRN",8994,1774,2,2,1,23,0) + INFO("TEMP_ADDRESS_LINE_2")= +"KRN",8994,1774,2,2,1,24,0) + INFO("TEMP_ADDRESS_LINE_3")= +"KRN",8994,1774,2,2,1,25,0) + INFO("TEMP_CITY")= +"KRN",8994,1774,2,2,1,26,0) + INFO("TEMP_STATE")= +"KRN",8994,1774,2,2,1,27,0) + INFO("TEMP_ZIP4")= +"KRN",8994,1774,2,2,1,28,0) + INFO("TEMP_STARTING_DATE")= +"KRN",8994,1774,2,2,1,29,0) + INFO("TEMP_ENDING_DATE")= +"KRN",8994,1774,2,2,1,30,0) + INFO("TEMP_ADDRESS_ACTIVE")= +"KRN",8994,1774,2,2,1,31,0) + INFO("CONF_ADDRESS_LINE_1")= +"KRN",8994,1774,2,2,1,32,0) + INFO("CONF_ADDRESS_LINE_2")= +"KRN",8994,1774,2,2,1,33,0) + INFO("CONF_ADDRESS_LINE_3")= +"KRN",8994,1774,2,2,1,34,0) + INFO("CONF_CITY")= +"KRN",8994,1774,2,2,1,35,0) + INFO("CONF_STATE")= +"KRN",8994,1774,2,2,1,36,0) + INFO("CONF_ZIP4")= +"KRN",8994,1774,2,2,1,37,0) + INFO("CONF_STARTING_DATE")= +"KRN",8994,1774,2,2,1,38,0) + INFO("CONF_ENDING_DATE")= +"KRN",8994,1774,2,2,1,39,0) + INFO("CONF_ADDRESS_ACTIVE")= +"KRN",8994,1774,2,2,1,40,0) + INFO("PHONE_RESIDENCE")= +"KRN",8994,1774,2,2,1,41,0) + INFO("PHONE_WORK")= +"KRN",8994,1774,2,2,1,42,0) + INFO("PHONE_CELL")= +"KRN",8994,1774,2,2,1,43,0) + INFO("PHONE_TEMP")= +"KRN",8994,1774,2,2,1,44,0) + Note, for the following, there may be multiple entries. # is record number +"KRN",8994,1774,2,2,1,45,0) + If a record should be added, it will be marked +1, +2 etc. +"KRN",8994,1774,2,2,1,46,0) + INFO("ALIAS # NAME")= +"KRN",8994,1774,2,2,1,47,0) + INFO("ALIAS # SSN")= +"KRN",8994,1774,2,"B","DFN",1) + +"KRN",8994,1774,2,"B","INFO",2) + +"KRN",8994,1774,2,"PARAMSEQ",1,1) + +"KRN",8994,1774,2,"PARAMSEQ",2,2) + +"KRN",8994,1774,3,0) +^^4^4^3070926^^ +"KRN",8994,1774,3,1,0) +Return value will be: +"KRN",8994,1774,3,2,0) +1 for success, or +"KRN",8994,1774,3,3,0) +-1^Message for failure +"KRN",8994,1774,3,4,0) + +"KRN",8994,1777,-1) +0^1 +"KRN",8994,1777,0) +TMG ADD PATIENT^PTADD^TMGRPC1^1^^^^1 +"KRN",8994,1777,1,0) +^8994.01^1^1^3071010^^^^ +"KRN",8994,1777,1,1,0) +This RPC is to add a patient. +"KRN",8994,1777,2,0) +^8994.02A^1^1 +"KRN",8994,1777,2,1,0) +INFO^2^^1^1 +"KRN",8994,1777,2,1,1,0) +^8994.021^12^12^3071010^^^^ +"KRN",8994,1777,2,1,1,1,0) + ;" INFO: Format as follows: +"KRN",8994,1777,2,1,1,2,0) + ;" The results are in format: INFO("KeyName")=Value, +"KRN",8994,1777,2,1,1,3,0) + ;" There is no set order these will appear. +"KRN",8994,1777,2,1,1,4,0) + ;" Here are the KeyName names that will be provided. +"KRN",8994,1777,2,1,1,5,0) + ;" If the record has no value, then value will be empty +"KRN",8994,1777,2,1,1,6,0) + ;" If a record should be deleted, its value will be @ +"KRN",8994,1777,2,1,1,7,0) + ;" INFO("COMBINED_NAME")= +"KRN",8994,1777,2,1,1,8,0) + ;" INFO("DOB")= +"KRN",8994,1777,2,1,1,9,0) + ;" INFO("SEX")= +"KRN",8994,1777,2,1,1,10,0) + ;" INFO("SS_NUM")= +"KRN",8994,1777,2,1,1,11,0) + ;" INFO("Veteran")= +"KRN",8994,1777,2,1,1,12,0) + ;" INFO("PtType")= +"KRN",8994,1777,2,"B","INFO",1) + +"KRN",8994,1777,2,"PARAMSEQ",1,1) + +"KRN",8994,1777,3,0) +^8994.03^3^3^3071010^^^ +"KRN",8994,1777,3,1,0) +;"Results: Results passed back in RESULT string: +"KRN",8994,1777,3,2,0) + ;" 1^DFN = success +"KRN",8994,1777,3,3,0) + ;" -1^Message = failure +"KRN",8994,1778,-1) +0^4 +"KRN",8994,1778,0) +TMG BARCODE ENCODE^GETBARCD^TMGRPC1^4^P^^^1^1 +"KRN",8994,1778,1,0) +^^17^17^3071227^^ +"KRN",8994,1778,1,1,0) +This RPC will be for requesting a barcode from the server. +"KRN",8994,1778,1,2,0) +This will return an image containing a DataMatrix 2D +"KRN",8994,1778,1,3,0) +barcode. +"KRN",8994,1778,1,4,0) + +"KRN",8994,1778,1,5,0) +It is dependent on a command to be installed on the +"KRN",8994,1778,1,6,0) +linux host server: libdtmx which may be installed +"KRN",8994,1778,1,7,0) +from www.sourceforge.org. See comments in TMGBARC.m for +"KRN",8994,1778,1,8,0) +details. +"KRN",8994,1778,1,9,0) + +"KRN",8994,1778,1,10,0) +If an image type of other than .png is desired then this +"KRN",8994,1778,1,11,0) +is dependent on "convert" utility being installed on the +"KRN",8994,1778,1,12,0) +linux host server. This is part of the linux ImageMagick +"KRN",8994,1778,1,13,0) +package. +"KRN",8994,1778,1,14,0) + +"KRN",8994,1778,1,15,0) +It will return the barcode in ascii armour encoding, which +"KRN",8994,1778,1,16,0) +must be decoded on the client side. This functionality is +"KRN",8994,1778,1,17,0) +the same as used for TMG UPLOAD and TMG DOWNLOAD of images. +"KRN",8994,1778,2,0) +^8994.02A^2^2 +"KRN",8994,1778,2,1,0) +MESSAGE^1^1024^1^1 +"KRN",8994,1778,2,1,1,0) +^^12^12^3071221^^ +"KRN",8994,1778,2,1,1,1,0) +This should be the message / text / numbers to be +"KRN",8994,1778,2,1,1,2,0) +encoded in the barcode. +"KRN",8994,1778,2,1,1,3,0) + +"KRN",8994,1778,2,1,1,4,0) +I have not explored the limits of what type of chars +"KRN",8994,1778,2,1,1,5,0) +can be stored in the barcode. I think that it does +"KRN",8994,1778,2,1,1,6,0) +NOT allow extended chars or control chars. +"KRN",8994,1778,2,1,1,7,0) + +"KRN",8994,1778,2,1,1,8,0) +I am also not sure of the allowed length. This can +"KRN",8994,1778,2,1,1,9,0) +be explored more later. With some bar code creators, +"KRN",8994,1778,2,1,1,10,0) +if the length exceeds the allowed chars for one 2D +"KRN",8994,1778,2,1,1,11,0) +square, then a second square is created beside the first +"KRN",8994,1778,2,1,1,12,0) +for the extra characters. +"KRN",8994,1778,2,2,0) +OPTION^2^^0^2 +"KRN",8994,1778,2,2,1,0) +^^15^15^3071227^^ +"KRN",8994,1778,2,2,1,1,0) +This array may contain options: +"KRN",8994,1778,2,2,1,2,0) + +"KRN",8994,1778,2,2,1,3,0) +OPTION("IMAGE TYPE")=image type. +"KRN",8994,1778,2,2,1,4,0) + +"KRN",8994,1778,2,2,1,5,0) +Example +"KRN",8994,1778,2,2,1,6,0) +OPTION("IMAGE TYPE")="jpg" <-- image returned in jpg format +"KRN",8994,1778,2,2,1,7,0) +or +"KRN",8994,1778,2,2,1,8,0) +OPTION("IMAGE TYPE")="tiff" <-- image returned in tiff format +"KRN",8994,1778,2,2,1,9,0) + +"KRN",8994,1778,2,2,1,10,0) +Specified image type is NOT case sensitive. +"KRN",8994,1778,2,2,1,11,0) + +"KRN",8994,1778,2,2,1,12,0) +Allowed image types is determined by ImageMagick utility +"KRN",8994,1778,2,2,1,13,0) +'convert' installed on host linux system. +"KRN",8994,1778,2,2,1,14,0) + +"KRN",8994,1778,2,2,1,15,0) + +"KRN",8994,1778,2,"B","MESSAGE",1) + +"KRN",8994,1778,2,"B","OPTION",2) + +"KRN",8994,1778,2,"PARAMSEQ",1,1) + +"KRN",8994,1778,2,"PARAMSEQ",2,2) + +"KRN",8994,1778,3,0) +^^23^23^3071227^^ +"KRN",8994,1778,3,1,0) +By default, the returned image is the created barcode image in .png format. +"KRN",8994,1778,3,2,0) +See OPTION parameter regarding specifying other image formats. +"KRN",8994,1778,3,3,0) + +"KRN",8994,1778,3,4,0) +Regarding the data transfer itself: +"KRN",8994,1778,3,5,0) + The return value will be an array, with each node containing 512 +"KRN",8994,1778,3,6,0) + bytes, encoded for ASCII transfer with a Base64 formula (an improvement +"KRN",8994,1778,3,7,0) + on UUENCODE functions) +"KRN",8994,1778,3,8,0) + +"KRN",8994,1778,3,9,0) + GREF(0)=1 <---- 1=valid 0=invalid (failure of load) +"KRN",8994,1778,3,10,0) + GREF(1)=";lakjsdasvoin;lkj32409u234,mnsdfoi239483....." +"KRN",8994,1778,3,11,0) + GREF(2)="987sdf,n09xc,/knm6flkhdgjkhsdo4ioidk,sdf....." +"KRN",8994,1778,3,12,0) + GREF(3)="asdoi,xmnsdkh98xd,.m3ddbdsgkhsdf=cxjkdgm ....." +"KRN",8994,1778,3,13,0) + ... +"KRN",8994,1778,3,14,0) + +"KRN",8994,1778,3,15,0) + Note: Here I am showing random ascii characters. But in actuality, each +"KRN",8994,1778,3,16,0) + position will hold only those characters used in the Base64 method. +"KRN",8994,1778,3,17,0) + +"KRN",8994,1778,3,18,0) + On the client RPCBroker end, the result will be stored in a TStringList, +"KRN",8994,1778,3,19,0) + with each line being stored in a separate index (i.e. Strings[i]) +"KRN",8994,1778,3,20,0) + +"KRN",8994,1778,3,21,0) + Notice that when saving on the client side, the zero node,GREF(0), is NOT +"KRN",8994,1778,3,22,0) + part of the file, and should be discarded or otherwise not included in the +"KRN",8994,1778,3,23,0) + save. +"KRN",8994,1779,-1) +0^3 +"KRN",8994,1779,0) +TMG BARCODE DECODE^DECODEBC^TMGRPC1^1^^^^1^1 +"KRN",8994,1779,1,0) +^8994.01^5^5^3080102^^^^ +"KRN",8994,1779,1,1,0) +This function will return the text encoded inside +"KRN",8994,1779,1,2,0) +barcode stored on an image that is uploaded to +"KRN",8994,1779,1,3,0) +function. +"KRN",8994,1779,1,4,0) + +"KRN",8994,1779,1,5,0) +Barcode must be in DataMatrix format. +"KRN",8994,1779,2,0) +^8994.02A^2^2 +"KRN",8994,1779,2,1,0) +ARRAY^2^^1^1 +"KRN",8994,1779,2,1,1,0) +^^21^21^3071227^^ +"KRN",8994,1779,2,1,1,1,0) +This will be used for uploading the image that contains +"KRN",8994,1779,2,1,1,2,0) +the barcode for decoding. +"KRN",8994,1779,2,1,1,3,0) + +"KRN",8994,1779,2,1,1,4,0) +Default format for Image is a .png format. See OPTION +"KRN",8994,1779,2,1,1,5,0) +parameter for specifying Image to be in another format. +"KRN",8994,1779,2,1,1,6,0) + +"KRN",8994,1779,2,1,1,7,0) +Barcode should be a DataMatrix barcode. +"KRN",8994,1779,2,1,1,8,0) + +"KRN",8994,1779,2,1,1,9,0) +It is OK for the image to NOT contain a barcode. This +"KRN",8994,1779,2,1,1,10,0) +will cause a null value to be returned. +"KRN",8994,1779,2,1,1,11,0) + +"KRN",8994,1779,2,1,1,12,0) +Array Format: +"KRN",8994,1779,2,1,1,13,0) +For example: +"KRN",8994,1779,2,1,1,14,0) + ARRAY(0)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,15,0) + ARRAY(0)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,16,0) + ARRAY(1)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,17,0) + ARRAY(2)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,18,0) + ARRAY(3)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,19,0) + ARRAY(4)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,20,0) + ARRAY(5)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,1,1,21,0) + ARRAY(6)= "(ascii encoude data in BASE64 format)" +"KRN",8994,1779,2,2,0) +IMGTYPE^1^^1^2 +"KRN",8994,1779,2,2,1,0) +^^10^10^3080102^^ +"KRN",8994,1779,2,2,1,1,0) +This should be the type of the image held in ARRAY +"KRN",8994,1779,2,2,1,2,0) + +"KRN",8994,1779,2,2,1,3,0) +e.g. "jpg", or "JPG", or "tif" etc. +"KRN",8994,1779,2,2,1,4,0) + +"KRN",8994,1779,2,2,1,5,0) +NOTE: do not include the "." i.e. use "jpg", NOT ".jpg" +"KRN",8994,1779,2,2,1,6,0) + +"KRN",8994,1779,2,2,1,7,0) +Specified image type is NOT case sensitive. +"KRN",8994,1779,2,2,1,8,0) + +"KRN",8994,1779,2,2,1,9,0) +Allowed image types is determined by ImageMagick utility +"KRN",8994,1779,2,2,1,10,0) +'convert' installed on host linux system. +"KRN",8994,1779,2,"B","ARRAY",1) + +"KRN",8994,1779,2,"B","IMGTYPE",2) + +"KRN",8994,1779,2,"PARAMSEQ",1,1) + +"KRN",8994,1779,2,"PARAMSEQ",2,2) + +"KRN",8994,1779,3,0) +^8994.03^4^4^3080102^^^^ +"KRN",8994,1779,3,1,0) +Value to be returned will be: +"KRN",8994,1779,3,2,0) + +"KRN",8994,1779,3,3,0) + 1^Decoded Message +"KRN",8994,1779,3,4,0) + 0^Failure Message +"KRN",8994,1780,-1) +0^6 +"KRN",8994,1780,0) +TMG DOWNLOAD FILE DROPBOX^DOWNDROP^TMGRPC1^1^^^^^1 +"KRN",8994,1780,1,0) +^8994.01^3^3^3080131^^^ +"KRN",8994,1780,1,1,0) +This will cause a file to be transferred from the server's +"KRN",8994,1780,1,2,0) +private file storage location into the drop box location. +"KRN",8994,1780,1,3,0) + +"KRN",8994,1780,2,0) +^8994.02A^3^3 +"KRN",8994,1780,2,1,0) +FPATH^1^128^1^1 +"KRN",8994,1780,2,1,1,0) +^^26^26^3080131^^ +"KRN",8994,1780,2,1,1,1,0) +The file path up to, but not including, the filename. This +"KRN",8994,1780,2,1,1,2,0) +is the path that the file is stored at on the server, relative +"KRN",8994,1780,2,1,1,3,0) +to a private server path. +"KRN",8994,1780,2,1,1,4,0) + +"KRN",8994,1780,2,1,1,5,0) +It is NOT the location of the dropbox path. (That is stored in +"KRN",8994,1780,2,1,1,6,0) +field 22702 in file 2005.2) +"KRN",8994,1780,2,1,1,7,0) + +"KRN",8994,1780,2,1,1,8,0) +For security reasons, all path requests will be considered relative to a root path. +"KRN",8994,1780,2,1,1,9,0) + e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"KRN",8994,1780,2,1,1,10,0) + /var/local/Dir1/Dir2/download/SomeFile.jpg +"KRN",8994,1780,2,1,1,11,0) + +"KRN",8994,1780,2,1,1,12,0) + This root path is found in custom field 22701 in file 2005.2 +"KRN",8994,1780,2,1,1,13,0) +Note Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"KRN",8994,1780,2,1,1,14,0) + +"KRN",8994,1780,2,1,1,15,0) +So for input: +"KRN",8994,1780,2,1,1,16,0) + FPATH = /download/ +"KRN",8994,1780,2,1,1,17,0) + FNAME = SomeFile.jpg +"KRN",8994,1780,2,1,1,18,0) + +"KRN",8994,1780,2,1,1,19,0) +And configurations: +"KRN",8994,1780,2,1,1,20,0) + field 22701 = /var/local/Dir1/Dir2 +"KRN",8994,1780,2,1,1,21,0) + field 22702 = /mnt/WinServer/DropBox/ +"KRN",8994,1780,2,1,1,22,0) + +"KRN",8994,1780,2,1,1,23,0) +Then file: +"KRN",8994,1780,2,1,1,24,0) + /var/local/Dir1/dir2/download/SomeFile.jpg +"KRN",8994,1780,2,1,1,25,0) +will be moved to +"KRN",8994,1780,2,1,1,26,0) + /mnt/WinServer/DropBox/SomeFile.jpg +"KRN",8994,1780,2,2,0) +FNAME^1^128^1^2 +"KRN",8994,1780,2,2,1,0) +^8994.021^3^3^3080131^^^ +"KRN",8994,1780,2,2,1,1,0) +This is the filename to be transferred, without any path +"KRN",8994,1780,2,2,1,2,0) +specifications. +"KRN",8994,1780,2,2,1,3,0) +See help for FNAME parameter for more details. +"KRN",8994,1780,2,3,0) +LOCIEN^1^16^0^3 +"KRN",8994,1780,2,3,1,0) +^8994.021^13^13^3080131^^^ +"KRN",8994,1780,2,3,1,1,0) +[optional] -- +"KRN",8994,1780,2,3,1,2,0) + +"KRN",8994,1780,2,3,1,3,0) +This is the IEN from file 2005.2 (network location) to obtain +"KRN",8994,1780,2,3,1,4,0) +folder path and drive information from. +"KRN",8994,1780,2,3,1,5,0) + +"KRN",8994,1780,2,3,1,6,0) +Default value is 1 +"KRN",8994,1780,2,3,1,7,0) + +"KRN",8994,1780,2,3,1,8,0) +Note: For security reasons, all path requests will be considered relative to a root path. +"KRN",8994,1780,2,3,1,9,0) + e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"KRN",8994,1780,2,3,1,10,0) + /var/local/Dir1/Dir2/download/SomeFile.jpg +"KRN",8994,1780,2,3,1,11,0) + This root path is found in custom field 22701 in file 2005.2 +"KRN",8994,1780,2,3,1,12,0) +Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"KRN",8994,1780,2,3,1,13,0) + +"KRN",8994,1780,2,"B","FNAME",2) + +"KRN",8994,1780,2,"B","FPATH",1) + +"KRN",8994,1780,2,"B","LOCIEN",3) + +"KRN",8994,1780,2,"PARAMSEQ",1,1) + +"KRN",8994,1780,2,"PARAMSEQ",2,2) + +"KRN",8994,1780,2,"PARAMSEQ",3,3) + +"KRN",8994,1780,3,0) +^8994.03^5^5^3080131^^^^ +"KRN",8994,1780,3,1,0) +Returns: +"KRN",8994,1780,3,2,0) + 1^Successful Download <-- file is ready in dropbox +"KRN",8994,1780,3,3,0) +or +"KRN",8994,1780,3,4,0) + 0^Error message +"KRN",8994,1780,3,5,0) + +"KRN",8994,1781,-1) +0^13 +"KRN",8994,1781,0) +TMG UPLOAD FILE DROPBOX^UPLDDROP^TMGRPC1^1^^^^^1 +"KRN",8994,1781,1,0) +^8994.01^3^3^3080131^^^ +"KRN",8994,1781,1,1,0) +This will cause a file to be transferred from the drop box +"KRN",8994,1781,1,2,0) +location into the server's private file storage location. +"KRN",8994,1781,1,3,0) + +"KRN",8994,1781,2,0) +^8994.02A^3^3 +"KRN",8994,1781,2,1,0) +FPATH^1^128^1^1 +"KRN",8994,1781,2,1,1,0) +^^29^29^3080131^^ +"KRN",8994,1781,2,1,1,1,0) +The file path up to, but not including, the filename. +"KRN",8994,1781,2,1,1,2,0) + +"KRN",8994,1781,2,1,1,3,0) +This is the path that the server is to store the file in, +"KRN",8994,1781,2,1,1,4,0) +relative to a private server path. +"KRN",8994,1781,2,1,1,5,0) +It is NOT the location of the dropbox path. (That is stored in +"KRN",8994,1781,2,1,1,6,0) +field 22702 in file 2005.2) +"KRN",8994,1781,2,1,1,7,0) + +"KRN",8994,1781,2,1,1,8,0) +For security reasons, all path requests will be considered +"KRN",8994,1781,2,1,1,9,0) +relative to a root path. +"KRN",8994,1781,2,1,1,10,0) + e.g. if user asks to store at /download/SomeFile.jpg, this +"KRN",8994,1781,2,1,1,11,0) + function will store the file at: +"KRN",8994,1781,2,1,1,12,0) + /var/local/Dir1/Dir2/download/SomeFile.jpg +"KRN",8994,1781,2,1,1,13,0) + +"KRN",8994,1781,2,1,1,14,0) + This root path is found in custom field 22701 in file 2005.2 +"KRN",8994,1781,2,1,1,15,0) +Note Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"KRN",8994,1781,2,1,1,16,0) + +"KRN",8994,1781,2,1,1,17,0) +So for input: +"KRN",8994,1781,2,1,1,18,0) + FPATH = /download/ +"KRN",8994,1781,2,1,1,19,0) + FNAME = SomeFile.jpg +"KRN",8994,1781,2,1,1,20,0) + +"KRN",8994,1781,2,1,1,21,0) +And configurations: +"KRN",8994,1781,2,1,1,22,0) + field 22701 = /var/local/Dir1/Dir2 +"KRN",8994,1781,2,1,1,23,0) + field 22702 = /mnt/WinServer/DropBox/ +"KRN",8994,1781,2,1,1,24,0) + +"KRN",8994,1781,2,1,1,25,0) + +"KRN",8994,1781,2,1,1,26,0) +Then file: +"KRN",8994,1781,2,1,1,27,0) + /mnt/WinServer/DropBox/SomeFile.jpg <-- the drop box +"KRN",8994,1781,2,1,1,28,0) +will be moved to +"KRN",8994,1781,2,1,1,29,0) + /var/local/Dir1/dir2/download/SomeFile.jpg <--- the private store location +"KRN",8994,1781,2,2,0) +FNAME^1^128^1^2 +"KRN",8994,1781,2,2,1,0) +^^4^4^3080131^^ +"KRN",8994,1781,2,2,1,1,0) +This is the filename to be transferred, without any path +"KRN",8994,1781,2,2,1,2,0) +specifications. +"KRN",8994,1781,2,2,1,3,0) + +"KRN",8994,1781,2,2,1,4,0) +See help for FNAME parameter for more details. +"KRN",8994,1781,2,3,0) +LOCIEN^1^16^0^3 +"KRN",8994,1781,2,3,1,0) +^8994.021^12^12^3080131^^^ +"KRN",8994,1781,2,3,1,1,0) +[optional] -- +"KRN",8994,1781,2,3,1,2,0) + +"KRN",8994,1781,2,3,1,3,0) +This is the IEN from file 2005.2 (network location) to obtain +"KRN",8994,1781,2,3,1,4,0) +folder path and drive information from. +"KRN",8994,1781,2,3,1,5,0) + +"KRN",8994,1781,2,3,1,6,0) +Default value is 1 +"KRN",8994,1781,2,3,1,7,0) + +"KRN",8994,1781,2,3,1,8,0) +Note: For security reasons, all path requests will be considered relative to a root path. +"KRN",8994,1781,2,3,1,9,0) + e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"KRN",8994,1781,2,3,1,10,0) + /var/local/Dir1/Dir2/download/SomeFile.jpg +"KRN",8994,1781,2,3,1,11,0) + This root path is found in custom field 22701 in file 2005.2 +"KRN",8994,1781,2,3,1,12,0) +Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"KRN",8994,1781,2,"B","FNAME",2) + +"KRN",8994,1781,2,"B","FPATH",1) + +"KRN",8994,1781,2,"B","LOCIEN",3) + +"KRN",8994,1781,2,"PARAMSEQ",1,1) + +"KRN",8994,1781,2,"PARAMSEQ",2,2) + +"KRN",8994,1781,2,"PARAMSEQ",3,3) + +"KRN",8994,1781,3,0) +^^4^4^3080131^^ +"KRN",8994,1781,3,1,0) +Results: +"KRN",8994,1781,3,2,0) + +"KRN",8994,1781,3,3,0) +1^SuccessMessage <-- file uploaded from dropbox +"KRN",8994,1781,3,4,0) +0^FailureMessage +"KRN",8994,1784,-1) +0^14 +"KRN",8994,1784,0) +TMG CPRS GET URL LIST^GETURLS^TMGRPC1^2^P^^^1^1 +"KRN",8994,1784,1,0) +^8994.01^2^2^3080618^^^^ +"KRN",8994,1784,1,1,0) +CPRS can call this to get a list of URL's to display from inside CPRS. +"KRN",8994,1784,1,2,0) +These URL's will be displayed inside custom tabs in CPRS. +"KRN",8994,1784,2,0) +^8994.02A^^0 +"KRN",8994,1784,3,0) +^8994.03^5^5^3080618^^^^ +"KRN",8994,1784,3,1,0) +Results are returned as follows: +"KRN",8994,1784,3,2,0) + RESULT(0)="1^Success" or "0^SomeErrorMessage" +"KRN",8994,1784,3,3,0) + RESULT(1)="CNN^www.cnn.com" ;display www.cnn.com on tab #1, named 'CNN' +"KRN",8994,1784,3,4,0) + RESULT(2)="^about:blank" ;display a blank page on tab #2, with name of '' +"KRN",8994,1784,3,5,0) + RESULT(3)="^" ;hide tab #3, with name of '' +"MBREQ") +0 +"ORD",5,.4) +.4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) +"ORD",5,.4,0) +PRINT TEMPLATE +"ORD",8,.403) +.403;8;;;EDEOUT^DIFROMSO(.403,DA,"",XPDA);FPRE^DIFROMSI(.403,"",XPDA);EPRE^DIFROMSI(.403,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.403,DA,"",XPDA);DEL^DIFROMSK(.403,"",%) +"ORD",8,.403,0) +FORM +"ORD",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 +"PGL",8925.1,0,5,.05) +PERSONAL OWNER^P200'X^VA(200,^0;5^Q +"PGL",8925.1,0,6,.06) +CLASS OWNER^P8930'X^USR(8930,^0;6^Q +"PGL",8925.1,0,7,.07) +STATUS^*P8925.6'X^TIU(8925.6,^0;7^K:'$G(TIUFPRIV) X Q:'$D(X) S DIC("S")="I 1 X $$STATSCRN^TIUFLF5" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X +"PGL",8925.1,1,1,1.01) +UPLOAD TARGET FILE^*P1'^DIC(^1;1^S DIC("S")="I $D(^DIC(+Y,""%"",""B"",""TIU""))" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X +"PGL",8925.113,0,4,.04) +RESULTING STATUS^P8930.6'^USR(8930.6,^0;4^Q +"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") +YES +"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") +YES +"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") +YES +"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") +96 +"RTN","TMGABV") +0^1^B86362 +"RTN","TMGABV",1,0) +TMGABV ;TMG/kst/Abbreviation code ; 03/25/06 +"RTN","TMGABV",2,0) + ;;1.0;TMG-LIB;**1**;12/23/05 +"RTN","TMGABV",3,0) + +"RTN","TMGABV",4,0) + ;" ABBREVIATION code +"RTN","TMGABV",5,0) + +"RTN","TMGABV",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGABV",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGABV",8,0) + ;"12-23-2006 +"RTN","TMGABV",9,0) + +"RTN","TMGABV",10,0) + ;"======================================================================= +"RTN","TMGABV",11,0) + ;" API -- Public Functions. +"RTN","TMGABV",12,0) + ;"======================================================================= +"RTN","TMGABV",13,0) + ;"$$Read(OrigName,LenCat,DefValue) +"RTN","TMGABV",14,0) + ;"Write(OrigName,ShortName,LenCat,AskConfirm) +"RTN","TMGABV",15,0) + ;"Del(OrigName,LenCat,AskConfirm) +"RTN","TMGABV",16,0) + ;"GetAbvr(Name,AskUser,UseSR) +"RTN","TMGABV",17,0) + ;"Fix(ShortName) -- provides a way to fix erroneous abbreviations. +"RTN","TMGABV",18,0) + ;"ShowDiff -- scan and show changes. This is not very useful (a testing function) +"RTN","TMGABV",19,0) + ;"ScanDel(Text) -- scan for text and allow deletions. +"RTN","TMGABV",20,0) + +"RTN","TMGABV",21,0) + ;"======================================================================= +"RTN","TMGABV",22,0) + ;" Private Functions. +"RTN","TMGABV",23,0) + ;"======================================================================= +"RTN","TMGABV",24,0) + ;"CheckDel(longName,DiffArray,DiffStr,lenCat) +"RTN","TMGABV",25,0) + ;"Fix1(ShortName) -- provide a way to fix erroneous abbreviations. +"RTN","TMGABV",26,0) + ;"ShowLinks(ShortName,LenCat,array) -- show a chain of abbreviations. +"RTN","TMGABV",27,0) + ;"GetDiff(longName,LenCat) -- for longName, return what changes for it's abbreviation +"RTN","TMGABV",28,0) + ;"GetDiffStr(longName,shortName) -- given longName and it's shortname abbreviation, return what changes +"RTN","TMGABV",29,0) + ;"ScanAbvs(xstr,showProgress) -- scan abbreviations and execute code +"RTN","TMGABV",30,0) + +"RTN","TMGABV",31,0) + ;"======================================================================= +"RTN","TMGABV",32,0) + ;"======================================================================= +"RTN","TMGABV",33,0) + +"RTN","TMGABV",34,0) +Read(OrigName,LenCat,DefValue) +"RTN","TMGABV",35,0) + ;"Purpose: To read from the ABBREV array and return an abbreviation +"RTN","TMGABV",36,0) + ;"Input: OrigName -- the name to look up +"RTN","TMGABV",37,0) + ;" LenCat -- OPTIONAL. If specified, then results returned from that category +"RTN","TMGABV",38,0) + ;" if LenCat="ALL" then all categories are scanned until some value found. +"RTN","TMGABV",39,0) + ;" DefValue -- OPTIONAL. If specified, a default value if not found +"RTN","TMGABV",40,0) + ;"Results: Returns the found abbreviation, or "" if not found +"RTN","TMGABV",41,0) + +"RTN","TMGABV",42,0) + set DefValue=$get(DefValue) +"RTN","TMGABV",43,0) + new result set result=DefValue +"RTN","TMGABV",44,0) + if $get(OrigName)="" goto RdDone +"RTN","TMGABV",45,0) + if $get(LenCat)'="" do +"RTN","TMGABV",46,0) + . if LenCat="ALL" do +"RTN","TMGABV",47,0) + . . set result=$get(^TMG("ABBREV",OrigName),DefValue) quit:(result'="") +"RTN","TMGABV",48,0) + . . set LenCat="" +"RTN","TMGABV",49,0) + . . for set LenCat=$order(^TMG("ABBREV",LenCat),-1) quit:(+LenCat'=LenCat)!(result'="") do +"RTN","TMGABV",50,0) + . . . set result=$get(^TMG("ABBREV",LenCat,OrigName),DefValue) +"RTN","TMGABV",51,0) + . else do +"RTN","TMGABV",52,0) + . . set result=$get(^TMG("ABBREV",LenCat,OrigName),DefValue) +"RTN","TMGABV",53,0) + else do +"RTN","TMGABV",54,0) + . set result=$get(^TMG("ABBREV",OrigName),DefValue) +"RTN","TMGABV",55,0) +RdDone +"RTN","TMGABV",56,0) + if result'="" do +"RTN","TMGABV",57,0) + . if ($get(TMGDBABV)=1)&(result'=OrigName) do +"RTN","TMGABV",58,0) + . . write OrigName,"-->",!,result," OK" +"RTN","TMGABV",59,0) + . . new % set %=1 do YN^DICN write ! +"RTN","TMGABV",60,0) + . . if %=1 quit +"RTN","TMGABV",61,0) + . . set result="" +"RTN","TMGABV",62,0) + . . if %=-1 quit +"RTN","TMGABV",63,0) + . . if %=2 do Del(OrigNameName,.LenCat,1) +"RTN","TMGABV",64,0) + +"RTN","TMGABV",65,0) + quit result +"RTN","TMGABV",66,0) + +"RTN","TMGABV",67,0) + +"RTN","TMGABV",68,0) +Write(OrigName,ShortName,LenCat,AskConfirm) +"RTN","TMGABV",69,0) + ;"Purpose: To provide a unified writer for ABBREV array +"RTN","TMGABV",70,0) + ;"Input: OrigName -- the longer name that the abbreviation will stand for +"RTN","TMGABV",71,0) + ;" ShortName -- the shorter abbreviation of OrigName +"RTN","TMGABV",72,0) + ;" LenCat -- OPTIONAL -- If supplied, then abbreviation will be stored in this category +"RTN","TMGABV",73,0) + ;" AskConfirm -- OPTIONAL -- if 1 then user asked to confirm save. +"RTN","TMGABV",74,0) + ;"results: none +"RTN","TMGABV",75,0) + ;"Note: Assigning a NULL ShortName is not currently allowed. +"RTN","TMGABV",76,0) + +"RTN","TMGABV",77,0) + if $get(OrigName)="" goto WtDone +"RTN","TMGABV",78,0) + if $get(ShortName)="" goto WtDone +"RTN","TMGABV",79,0) + set AskConfirm=$get(AskConfirm,0) +"RTN","TMGABV",80,0) + if $$Read(OrigName,.LenCat)=ShortName goto WtDone ;"Skip write if already there +"RTN","TMGABV",81,0) + new % set %=1 +"RTN","TMGABV",82,0) + if AskConfirm=1 do +"RTN","TMGABV",83,0) +W1 . write "[",OrigName,"] --> [",ShortName,"]",! +"RTN","TMGABV",84,0) + . write "Save for future use" +"RTN","TMGABV",85,0) + . do YN^DICN write ! +"RTN","TMGABV",86,0) + if %'=1 goto WtDone +"RTN","TMGABV",87,0) + if $get(LenCat)'="" do +"RTN","TMGABV",88,0) + . set ^TMG("ABBREV",LenCat,OrigName)=ShortName +"RTN","TMGABV",89,0) + . set ^TMG("ABBREV",LenCat,"XREF",ShortName)=OrigName +"RTN","TMGABV",90,0) + else do +"RTN","TMGABV",91,0) + . set ^TMG("ABBREV",OrigName)=ShortName +"RTN","TMGABV",92,0) + . set ^TMG("ABBREV","XREF",ShortName)=OrigName +"RTN","TMGABV",93,0) +WtDone quit +"RTN","TMGABV",94,0) + +"RTN","TMGABV",95,0) + +"RTN","TMGABV",96,0) +Del(OrigName,LenCat,AskConfirm) +"RTN","TMGABV",97,0) + ;"Purpose: To delete a value from the ABBREV array +"RTN","TMGABV",98,0) + ;"Input: OrigName -- the name to look up +"RTN","TMGABV",99,0) + ;" LenCat -- OPTIONAL. If specified, then category to delete from +"RTN","TMGABV",100,0) + ;" AskConfirm -- OPTIONAL -- if 1 then user asked to confirm save. +"RTN","TMGABV",101,0) + ;"Results: none +"RTN","TMGABV",102,0) + +"RTN","TMGABV",103,0) + if $get(OrigName)="" goto DelDone +"RTN","TMGABV",104,0) + set AskConfirm=$get(AskConfirm,0) +"RTN","TMGABV",105,0) + new CurValue +"RTN","TMGABV",106,0) + if $get(LenCat)'="" set CurValue=$get(^TMG("ABBREV",LenCat,OrigName)) +"RTN","TMGABV",107,0) + else set CurValue=$get(^TMG("ABBREV",OrigName)) +"RTN","TMGABV",108,0) + new % set %=1 +"RTN","TMGABV",109,0) + if AskConfirm=1 do +"RTN","TMGABV",110,0) + . write "[",OrigName,"] -->",!,"[",CurValue,"]",! +"RTN","TMGABV",111,0) + . write "OK to DELETE" do YN^DICN write ! +"RTN","TMGABV",112,0) + if %'=1 goto DelDone +"RTN","TMGABV",113,0) + if $get(LenCat)'="" do +"RTN","TMGABV",114,0) + . kill ^TMG("ABBREV",LenCat,OrigName) +"RTN","TMGABV",115,0) + . kill ^TMG("ABBREV",LenCat,"XREF",CurValue) +"RTN","TMGABV",116,0) + else do +"RTN","TMGABV",117,0) + . kill ^TMG("ABBREV",OrigName) +"RTN","TMGABV",118,0) + . kill ^TMG("ABBREV","XREF",CurValue) +"RTN","TMGABV",119,0) + if AskConfirm'=1 goto DelDone +"RTN","TMGABV",120,0) + +"RTN","TMGABV",121,0) + ;"Now see if this same problem needs to be fixed in other abbreviations. +"RTN","TMGABV",122,0) + new tempS set tempS=$$GetDiffStr(OrigName,CurValue) +"RTN","TMGABV",123,0) + new DiffArray,count set count=1 +"RTN","TMGABV",124,0) + write "That association had the following difference(s):",! +"RTN","TMGABV",125,0) + for quit:(tempS'["^") do +"RTN","TMGABV",126,0) + . new OneDiff set OneDiff=$piece(tempS,"^",1) +"RTN","TMGABV",127,0) + . set DiffArray(count)=OneDiff,count=count+1 +"RTN","TMGABV",128,0) + . write " ",$piece(OneDiff,">",1)," --> ",$piece(OneDiff,">",2),! +"RTN","TMGABV",129,0) + . set tempS=tempS=$piece(tempS,"^",3,999) +"RTN","TMGABV",130,0) + set DiffArray("MAXNODE")=$$ListCt^TMGMISC("DiffArray") +"RTN","TMGABV",131,0) + set %=1 +"RTN","TMGABV",132,0) + write "Delete all other abbreviations that have these difference(s)" +"RTN","TMGABV",133,0) + do YN^DICN write ! +"RTN","TMGABV",134,0) + if %'=1 goto DelDone +"RTN","TMGABV",135,0) +Del1 new xstr set xstr="do CheckDel(longName,.DiffArray,DiffStr,lenCat)" +"RTN","TMGABV",136,0) + do ScanAbvs(xstr,1) +"RTN","TMGABV",137,0) + +"RTN","TMGABV",138,0) +DelDone quit +"RTN","TMGABV",139,0) + +"RTN","TMGABV",140,0) + +"RTN","TMGABV",141,0) +CheckDel(longName,DiffArray,DiffStr,lenCat) +"RTN","TMGABV",142,0) + ;"Purpose: this is a callback function for a ScanAbvs run +"RTN","TMGABV",143,0) + ;" it will be called for each abbreviation +"RTN","TMGABV",144,0) + ;"Input: DiffArray -- PASS BY REFERENCE. Format: +"RTN","TMGABV",145,0) + ;" DiffArray(1)="Long1>short1" +"RTN","TMGABV",146,0) + ;" DiffArray(2)="Long2>short2" +"RTN","TMGABV",147,0) + ;" DiffArray(3)="Long3>short3" +"RTN","TMGABV",148,0) + ;" DiffArray("MAXNODE")=3 +"RTN","TMGABV",149,0) + ;" DiffStr -- a difference string, as created by $$GetDiff +"RTN","TMGABV",150,0) + ;" lenCat -- the category that eval is from, or "" if none +"RTN","TMGABV",151,0) + +"RTN","TMGABV",152,0) + new shouldDel set shouldDel=1 +"RTN","TMGABV",153,0) + new i for i=1:1:+$get(DiffArray("MAXNODE")) do quit:(shouldDel=0) +"RTN","TMGABV",154,0) + . set shouldDel=DiffStr[DiffArray(i) +"RTN","TMGABV",155,0) + +"RTN","TMGABV",156,0) + if shouldDel=1 do Del(longName,lenCat,0) +"RTN","TMGABV",157,0) + quit +"RTN","TMGABV",158,0) + +"RTN","TMGABV",159,0) + +"RTN","TMGABV",160,0) + +"RTN","TMGABV",161,0) +GetAbvr(Name,AskUser,UseSR) +"RTN","TMGABV",162,0) + ;"Purpose: To get an abbreviation for one word +"RTN","TMGABV",163,0) + ;"Input: Name -- name to shorten +"RTN","TMGABV",164,0) + ;" AskUser -- if 1, then user will be asked to supply abbreviations +"RTN","TMGABV",165,0) + ;" UseSR -- OPTIONAL, default=0. If 0, then ^DIR won't be used +"RTN","TMGABV",166,0) + ;"Note: The name returned here may be longer than desired, no testing of length done. +"RTN","TMGABV",167,0) + ;"Results: Returns abreviated name, or original name if not found, or "" if deleted +"RTN","TMGABV",168,0) + +"RTN","TMGABV",169,0) + set UseSR=$get(UseSR,0) +"RTN","TMGABV",170,0) + +"RTN","TMGABV",171,0) + new result,Y +"RTN","TMGABV",172,0) + set result=$get(Name) +"RTN","TMGABV",173,0) + if Name="" goto GADone +"RTN","TMGABV",174,0) + if $get(AskUser)=1 do +"RTN","TMGABV",175,0) + . write "Enter a shorter form of '"_Name_"' (^ to delete)",! +"RTN","TMGABV",176,0) + . if UseSR do +"RTN","TMGABV",177,0) + . . new DIR +"RTN","TMGABV",178,0) + . . set DIR(0)="F" +"RTN","TMGABV",179,0) + . . set DIR("A")="New Name" +"RTN","TMGABV",180,0) + . . set DIR("B")=result +"RTN","TMGABV",181,0) + . . do ^DIR write ! +"RTN","TMGABV",182,0) + . else do +"RTN","TMGABV",183,0) + . . read "New Name: ",Y:($get(DTIME,3600)),! +"RTN","TMGABV",184,0) + . if Y="^" do quit +"RTN","TMGABV",185,0) + . . write "Delete word from name" +"RTN","TMGABV",186,0) + . . new % set %=1 do YN^DICN write ! +"RTN","TMGABV",187,0) + . . if %=1 set result="" +"RTN","TMGABV",188,0) + . if Y'=result do +"RTN","TMGABV",189,0) + . . do Write(Name,Y,,1) ;"1=> confirm save +"RTN","TMGABV",190,0) + . . set result=Y +"RTN","TMGABV",191,0) + else do +"RTN","TMGABV",192,0) + . set result=$$Read(Name,,Name) +"RTN","TMGABV",193,0) + . if result="^" set result="" do Del(Name) +"RTN","TMGABV",194,0) + . if result="" quit +"RTN","TMGABV",195,0) + . if ($get(TMGDBABV)=1)&(result'=Name) do +"RTN","TMGABV",196,0) + . . write Name,"-->",!,result,!," OK" +"RTN","TMGABV",197,0) + . . new % set %=1 do YN^DICN write ! +"RTN","TMGABV",198,0) + . . if %=1 quit +"RTN","TMGABV",199,0) + . . if %=-1 set result="" quit +"RTN","TMGABV",200,0) + . . if %=2 do +"RTN","TMGABV",201,0) + . . . write "Delete abbreviation" do YN^DICN write ! +"RTN","TMGABV",202,0) + . . . if %=1 do Del(Name) set result="" +"RTN","TMGABV",203,0) + +"RTN","TMGABV",204,0) +GADone +"RTN","TMGABV",205,0) + quit result +"RTN","TMGABV",206,0) + +"RTN","TMGABV",207,0) + +"RTN","TMGABV",208,0) + +"RTN","TMGABV",209,0) +Fix(ShortName,Context) +"RTN","TMGABV",210,0) + ;"Purpose: To provide a way to fix erroneous abbreviations. +"RTN","TMGABV",211,0) + ;"Input: ShortName -- the abbreviation to fix. +"RTN","TMGABV",212,0) + ;" Context -- OPTIONAL. The sentence ShortName is found in. +"RTN","TMGABV",213,0) + ;"Result: Returns new name after fixing mislinked abbreviations, +"RTN","TMGABV",214,0) + ;" or 0 for requested retry +"RTN","TMGABV",215,0) + +"RTN","TMGABV",216,0) + new Menu,Option +"RTN","TMGABV",217,0) + set Context=$get(Context) +"RTN","TMGABV",218,0) + new result set result="" +"RTN","TMGABV",219,0) + +"RTN","TMGABV",220,0) +FL1 if Context="" goto FL2 +"RTN","TMGABV",221,0) + +"RTN","TMGABV",222,0) + set Menu(0)="Pick Which to Fix" +"RTN","TMGABV",223,0) + set Menu(1)=ShortName +"RTN","TMGABV",224,0) + set Menu(2)=Context +"RTN","TMGABV",225,0) + write # +"RTN","TMGABV",226,0) + set Option=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGABV",227,0) + if Option="^" goto FixDone +"RTN","TMGABV",228,0) + +"RTN","TMGABV",229,0) +FL2 if (Option=1)!(Context="") do goto:(Context'="") FL1 goto FixDone +"RTN","TMGABV",230,0) + . set ShortName=$$Fix1(ShortName) +"RTN","TMGABV",231,0) + . if ShortName'="" set result=ShortName +"RTN","TMGABV",232,0) + if (Option=2) do goto FixDone +"RTN","TMGABV",233,0) + . new temp set temp=$$Fix1(Context) +"RTN","TMGABV",234,0) + . set result=0 +"RTN","TMGABV",235,0) + if (Option="^") goto FixDone +"RTN","TMGABV",236,0) + goto FL1 +"RTN","TMGABV",237,0) + +"RTN","TMGABV",238,0) +FixDone +"RTN","TMGABV",239,0) + quit result +"RTN","TMGABV",240,0) + +"RTN","TMGABV",241,0) + +"RTN","TMGABV",242,0) +Fix1(ShortName) +"RTN","TMGABV",243,0) + ;"Purpose: To provide a way to fix erroneous abbreviations. +"RTN","TMGABV",244,0) + ;"Input: ShortName -- the abbreviation to fix. +"RTN","TMGABV",245,0) + ;"Result: Returns new name after fixing mislinked abbreviations. +"RTN","TMGABV",246,0) + +"RTN","TMGABV",247,0) + new array,Option +"RTN","TMGABV",248,0) + new Name,LenCat +"RTN","TMGABV",249,0) + new result set result="" +"RTN","TMGABV",250,0) + new max +"RTN","TMGABV",251,0) +Fix1Loop +"RTN","TMGABV",252,0) + kill array +"RTN","TMGABV",253,0) + do ShowLinks(ShortName,,.array) +"RTN","TMGABV",254,0) + ;"Return Format +"RTN","TMGABV",255,0) + ;" array(x)=ShortName <-- LongerName[TAB]LongerName^LenCat +"RTN","TMGABV",256,0) + +"RTN","TMGABV",257,0) + set max=+$get(array("MAX")) +"RTN","TMGABV",258,0) + kill array("MAX") +"RTN","TMGABV",259,0) + set array(0)="Pick item to DELETE" +"RTN","TMGABV",260,0) + write # +"RTN","TMGABV",261,0) + set Option=$$Menu^TMGUSRIF(.array,"^") +"RTN","TMGABV",262,0) + if Option="^" goto Fix1Done +"RTN","TMGABV",263,0) + set Name=$piece(Option,"^",1) +"RTN","TMGABV",264,0) + set LenCat=$piece(Option,"^",2) +"RTN","TMGABV",265,0) + do Del(Name,LenCat,1) +"RTN","TMGABV",266,0) + goto Fix1Loop +"RTN","TMGABV",267,0) + +"RTN","TMGABV",268,0) +Fix1Done +"RTN","TMGABV",269,0) + new s set s=$get(array(max)) +"RTN","TMGABV",270,0) + set s=$piece(s,$char(9),2) +"RTN","TMGABV",271,0) + set s=$piece(s,"^",1) +"RTN","TMGABV",272,0) + set result=s +"RTN","TMGABV",273,0) + quit result +"RTN","TMGABV",274,0) + +"RTN","TMGABV",275,0) + +"RTN","TMGABV",276,0) + +"RTN","TMGABV",277,0) +ShowLinks(ShortName,LenCat,array) +"RTN","TMGABV",278,0) + ;"Purpose: To show a chain of abbreviations. +"RTN","TMGABV",279,0) + ;"Input: ShortName -- the abbreviation to check. +"RTN","TMGABV",280,0) + ;" LenCat -- the category to look in +"RTN","TMGABV",281,0) + ;" Array -- PASS BY REFERENCE. an OUT PARAMETER. Format +"RTN","TMGABV",282,0) + ;" array("MAX")=maxCount (e.g. 2) +"RTN","TMGABV",283,0) + ;" array(1)=ShortName <-- LongerName[TAB]LongerName^LenCat +"RTN","TMGABV",284,0) + ;" array(2)=ShortName <-- LongerName[TAB]LongerName^LenCat +"RTN","TMGABV",285,0) + +"RTN","TMGABV",286,0) + new i set i="" +"RTN","TMGABV",287,0) + new max set max=$get(array("MAX"),0) +"RTN","TMGABV",288,0) + new value set value="" +"RTN","TMGABV",289,0) + if $get(LenCat)="" do +"RTN","TMGABV",290,0) + . for set i=$order(^TMG("ABBREV",i)) quit:(+i'>0) do +"RTN","TMGABV",291,0) + . . do ShowLinks(ShortName,i,.array) +"RTN","TMGABV",292,0) + . set value=$get(^TMG("ABBREV","XREF",ShortName)) +"RTN","TMGABV",293,0) + else do +"RTN","TMGABV",294,0) + . set value=$get(^TMG("ABBREV",LenCat,"XREF",ShortName)) +"RTN","TMGABV",295,0) + if value'="" do +"RTN","TMGABV",296,0) + . set max=max+1 +"RTN","TMGABV",297,0) + . write max,". ",ShortName," <-- ",value,! +"RTN","TMGABV",298,0) + . set array(max)=ShortName_" <-- "_value_$char(9)_value_"^"_$get(LenCat) +"RTN","TMGABV",299,0) + . set array("MAX")=max +"RTN","TMGABV",300,0) + . do ShowLinks(value,.LenCat,.array) +"RTN","TMGABV",301,0) + +"RTN","TMGABV",302,0) + quit +"RTN","TMGABV",303,0) + +"RTN","TMGABV",304,0) +GetDiff(longName,LenCat) +"RTN","TMGABV",305,0) + ;"Purpose: for a given longName, return what changes for it's abbreviation +"RTN","TMGABV",306,0) + ;"Input: longName -- the original name to search for +"RTN","TMGABV",307,0) + ;" LenCat -- OPTIONAL. Default is "ALL" +"RTN","TMGABV",308,0) + ;"Results: returns difference between longName and its abbreviation, or "" if none. +"RTN","TMGABV",309,0) + ;"Results: DiffLong1>DiffShort1^pos1>pos2^DiffLong2>DiffShort2^pos1>pos2^... +"RTN","TMGABV",310,0) + +"RTN","TMGABV",311,0) + new result set result="" +"RTN","TMGABV",312,0) + set LenCat=$get(LenCat,"ALL") +"RTN","TMGABV",313,0) + new shortName set shortName=$$Read(longName,LenCat) +"RTN","TMGABV",314,0) + if shortName'="" set result=$$GetDiffStr(longName,shortName) +"RTN","TMGABV",315,0) + quit result +"RTN","TMGABV",316,0) + +"RTN","TMGABV",317,0) + +"RTN","TMGABV",318,0) +GetDiffStr(longName,shortName) +"RTN","TMGABV",319,0) + ;"Purpose: for a given longName and it's shortname abbreviation, +"RTN","TMGABV",320,0) + ;" return what changes for it's abbreviation +"RTN","TMGABV",321,0) + ;"Results: returns difference between longName and shortName, or "" if none. +"RTN","TMGABV",322,0) + ;"Results: DiffLong1>DiffShort1^pos1>pos2^DiffLong2>DiffShort2^pos1>pos2^... +"RTN","TMGABV",323,0) + +"RTN","TMGABV",324,0) + new DiffStr set DiffStr="" +"RTN","TMGABV",325,0) + ;"if $get(shortName)="" goto GDSDone +"RTN","TMGABV",326,0) + new longWords,shortWords +"RTN","TMGABV",327,0) + new DivCh set DivCh=" " +"RTN","TMGABV",328,0) + if $length(longName,"/")>3 set DivCh="/" +"RTN","TMGABV",329,0) + do CleaveToArray^TMGSTUTL(longName,DivCh,.longWords) +"RTN","TMGABV",330,0) + do CleaveToArray^TMGSTUTL(shortName,DivCh,.shortWords) +"RTN","TMGABV",331,0) + new temp,i +"RTN","TMGABV",332,0) + set temp=$$DiffWords^TMGSTUTL(.longWords,.shortWords) +"RTN","TMGABV",333,0) + for do quit:(temp="") +"RTN","TMGABV",334,0) + . new origS,destNum +"RTN","TMGABV",335,0) + . set origS=$piece(temp,"^",1) +"RTN","TMGABV",336,0) + . set temp=$piece(temp,"^",3,999) +"RTN","TMGABV",337,0) + . if DiffStr'="" set DiffStr=DiffStr_"^" +"RTN","TMGABV",338,0) + . set DiffStr=DiffStr_origS +"RTN","TMGABV",339,0) +GDSDone quit DiffStr +"RTN","TMGABV",340,0) + +"RTN","TMGABV",341,0) + +"RTN","TMGABV",342,0) +ScanAbvs(xstr,showProgress) +"RTN","TMGABV",343,0) + ;"Purpose: scan abbreviations and execute code +"RTN","TMGABV",344,0) + ;"Input: xstr -- OPTIONAL. m code to execute for each entry.´ +"RTN","TMGABV",345,0) + ;" showProgress -- OPTIONAL. if 1, progress bar is shown. +"RTN","TMGABV",346,0) + ;"Note: The following variables will be defined, for use in xstr: +"RTN","TMGABV",347,0) + ;" longName,shortName,DiffStr,lenCat +"RTN","TMGABV",348,0) + +"RTN","TMGABV",349,0) + new longName,shortName,lenCat,DiffStr +"RTN","TMGABV",350,0) + +"RTN","TMGABV",351,0) + set longName="",lenCat="" +"RTN","TMGABV",352,0) + +"RTN","TMGABV",353,0) + new Itr +"RTN","TMGABV",354,0) + ;"for set longName=$order(^TMG("ABBREV",longName),-1) quit:(+longName>0) do +"RTN","TMGABV",355,0) + set longName=$$ItrAInit^TMGITR($name(^TMG("ABBREV")),.Itr,-1) +"RTN","TMGABV",356,0) + if $get(showProgress)=1 do PrepProgress^TMGITR(.Itr,20,1,"longName") +"RTN","TMGABV",357,0) + if longName'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.longName,-1)>0)!(longName="") +"RTN","TMGABV",358,0) + . new shortName +"RTN","TMGABV",359,0) + . set shortName=$get(^TMG("ABBREV",longName)) +"RTN","TMGABV",360,0) + . set DiffStr=$$GetDiffStr(longName,shortName) +"RTN","TMGABV",361,0) + . if xstr'="" xecute xstr +"RTN","TMGABV",362,0) + +"RTN","TMGABV",363,0) + set lenCat=0 +"RTN","TMGABV",364,0) + for set lenCat=$order(^TMG("ABBREV",lenCat)) quit:(+lenCat'=lenCat) do +"RTN","TMGABV",365,0) + . if $get(showProgress)=1 write ! +"RTN","TMGABV",366,0) + . ;"set longName="" +"RTN","TMGABV",367,0) + . ;"for set longName=$order(^TMG("ABBREV",lenCat,longName),-1) quit:(+longName>0)!(longName="") do +"RTN","TMGABV",368,0) + . set longName=$$ItrAInit^TMGITR($name(^TMG("ABBREV",lenCat)),.Itr,-1) +"RTN","TMGABV",369,0) + . if $get(showProgress)=1 do PrepProgress^TMGITR(.Itr,20,1,"longName") +"RTN","TMGABV",370,0) + . if longName'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.longName,-1)>0)!(longName="") +"RTN","TMGABV",371,0) + . . new shortName set shortName=$get(^TMG("ABBREV",longName)) +"RTN","TMGABV",372,0) + . . set DiffStr=$$GetDiffStr(longName,shortName) +"RTN","TMGABV",373,0) + . . if xstr'="" xecute xstr +"RTN","TMGABV",374,0) + +"RTN","TMGABV",375,0) + quit +"RTN","TMGABV",376,0) + +"RTN","TMGABV",377,0) + +"RTN","TMGABV",378,0) +ShowDiff +"RTN","TMGABV",379,0) + ;"Purpose: scan and show changes +"RTN","TMGABV",380,0) + +"RTN","TMGABV",381,0) + new xstr +"RTN","TMGABV",382,0) + set xstr="write longName,"" --> ["",DiffStr,""] "",shortName,!" +"RTN","TMGABV",383,0) + do ScanAbvs(xstr,1) +"RTN","TMGABV",384,0) + quit +"RTN","TMGABV",385,0) + +"RTN","TMGABV",386,0) + +"RTN","TMGABV",387,0) +ScanDel(Text) +"RTN","TMGABV",388,0) + ;"Purpose: scan for text and allow deletions. +"RTN","TMGABV",389,0) + +"RTN","TMGABV",390,0) + new xstr +"RTN","TMGABV",391,0) + set xstr="if DiffStr[Text do Del(longName,,1)" +"RTN","TMGABV",392,0) + do ScanAbvs(xstr) +"RTN","TMGABV",393,0) + quit +"RTN","TMGABV",394,0) + +"RTN","TMGABV",395,0) + +"RTN","TMGBINF") +0^2^B6621 +"RTN","TMGBINF",1,0) +TMGBINF ;TMG/kst/Binary <--> Global Functions ;03/25/06 +"RTN","TMGBINF",2,0) + ;;1.0;TMG-LIB;**1**;08/20/05 +"RTN","TMGBINF",3,0) + +"RTN","TMGBINF",4,0) + ;"TMG BIN <-->GBL FUNCTIONS +"RTN","TMGBINF",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGBINF",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGBINF",7,0) + ;"8-20-2005 +"RTN","TMGBINF",8,0) + +"RTN","TMGBINF",9,0) + ;"======================================================================= +"RTN","TMGBINF",10,0) + ;" API -- Public Functions. +"RTN","TMGBINF",11,0) + ;"======================================================================= +"RTN","TMGBINF",12,0) + ;"$$BFTG(path,filename,globalRef,incSubscr,width) -- BINARY FILE TO GLOBAL +"RTN","TMGBINF",13,0) + ;"$$GTBF(globalRef,incSubscr,path,filename) -- GLOBAL TO BINARY FILE +"RTN","TMGBINF",14,0) + ;"CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width) -- COPY/RESIZE BINARY GLOBAL. +"RTN","TMGBINF",15,0) + +"RTN","TMGBINF",16,0) + +"RTN","TMGBINF",17,0) + ;"======================================================================= +"RTN","TMGBINF",18,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGBINF",19,0) + ;"======================================================================= +"RTN","TMGBINF",20,0) + ;"$$NEXTNODE(curRef,incSubscr) +"RTN","TMGBINF",21,0) + ;"$$READBG(GRef,incSubscr,pos,count,actualCount) -- STREAM READ FROM BINARY GLOBAL +"RTN","TMGBINF",22,0) + +"RTN","TMGBINF",23,0) + ;"======================================================================= +"RTN","TMGBINF",24,0) + ;"DEPENDENCIES +"RTN","TMGBINF",25,0) + ;"======================================================================= +"RTN","TMGBINF",26,0) + ;"Uses: (No other units) +"RTN","TMGBINF",27,0) + +"RTN","TMGBINF",28,0) + ;"======================================================================= +"RTN","TMGBINF",29,0) + +"RTN","TMGBINF",30,0) +BFTG(path,filename,globalRef,incSubscr,width) +"RTN","TMGBINF",31,0) + ;"SCOPE: PUBLIC +"RTN","TMGBINF",32,0) + ;"Purpose: To load a binary file from the host filesystem into a global, storing +"RTN","TMGBINF",33,0) + ;" the composit bytes as raw binary data. +"RTN","TMGBINF",34,0) + ;" You do not need to open the host file before making this call; it is opened +"RTN","TMGBINF",35,0) + ;" and closed automatically +"RTN","TMGBINF",36,0) + ;"Input: path -- (required) full path, up to but not including the filename +"RTN","TMGBINF",37,0) + ;" filename -- (required) name of the file to open +"RTN","TMGBINF",38,0) + ;" globalRef-- (required) Global reference to WRITE the host binary file to, in fully +"RTN","TMGBINF",39,0) + ;" resolved (closed root) format. This function does NOT kill the global +"RTN","TMGBINF",40,0) + ;" before writing to it. +"RTN","TMGBINF",41,0) + ;" Note: +"RTN","TMGBINF",42,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGBINF",43,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGBINF",44,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGBINF",45,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGBINF",46,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGBINF",47,0) + ;" is always zero. +"RTN","TMGBINF",48,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level. For example, if you +"RTN","TMGBINF",49,0) + ;" pass ^TMP(115,1,1,0) as the global_ref parameter and pass 3 as the +"RTN","TMGBINF",50,0) + ;" inc_subscr parameter, $$BIN2GBL will increment the third subscript, such +"RTN","TMGBINF",51,0) + ;" as ^TMP(115,1,x), but will WRITE notes at the full global reference, such +"RTN","TMGBINF",52,0) + ;" as ^TMP(115,1,x,0). +"RTN","TMGBINF",53,0) + ;" width -- OPTIONAL -- the number of bytes to store per line. Default=512 +"RTN","TMGBINF",54,0) + ;"*** NOTICE: width is not working properly. For now, just don't supply a number. +"RTN","TMGBINF",55,0) + +"RTN","TMGBINF",56,0) + ;"Result: 1=success, 0=failure +"RTN","TMGBINF",57,0) + ;" +"RTN","TMGBINF",58,0) + ;"Example: +"RTN","TMGBINF",59,0) + ;" write $$BFTG(path,file,"^TMP(115,1,1,0)",3) +"RTN","TMGBINF",60,0) + ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..." +"RTN","TMGBINF",61,0) + ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..." +"RTN","TMGBINF",62,0) + ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..." +"RTN","TMGBINF",63,0) + ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..." +"RTN","TMGBINF",64,0) + ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874" <-- not padded with terminal zeros +"RTN","TMGBINF",65,0) + ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255 +"RTN","TMGBINF",66,0) + +"RTN","TMGBINF",67,0) + new result set result=0 ;"default to failure +"RTN","TMGBINF",68,0) + new handle set handle="TMGHANDLE" +"RTN","TMGBINF",69,0) + new abort set abort=0 +"RTN","TMGBINF",70,0) + new blockIn +"RTN","TMGBINF",71,0) + new $ETRAP +"RTN","TMGBINF",72,0) + if $get(globalRef)="" goto BFTGDone +"RTN","TMGBINF",73,0) + +"RTN","TMGBINF",74,0) + new curRef +"RTN","TMGBINF",75,0) + new tempRef set tempRef="^TMP(""BFTG^TMGBINF"","_$J_",1)" +"RTN","TMGBINF",76,0) + ;"if user wants a width other than 512, will have to load into a temporary location, +"RTN","TMGBINF",77,0) + ;"and then copy over to final destination at requested with +"RTN","TMGBINF",78,0) + if +$get(width)>0 set curRef=tempRef +"RTN","TMGBINF",79,0) + else set curRef=globalRef +"RTN","TMGBINF",80,0) + +"RTN","TMGBINF",81,0) + set filename=$get(filename) +"RTN","TMGBINF",82,0) + if filename="" goto BFTGDone +"RTN","TMGBINF",83,0) + +"RTN","TMGBINF",84,0) + set path=$$DEFDIR^%ZISH($get(path)) +"RTN","TMGBINF",85,0) + +"RTN","TMGBINF",86,0) + ;"Note: Each line will 512 bytes long (512 is hard coded into OPEN^%ZISH) +"RTN","TMGBINF",87,0) + do OPEN^%ZISH(handle,path,filename,"RB") ;"B is a 512 block/binary mode +"RTN","TMGBINF",88,0) + if POP write "Error opening file...",! goto BFTGDone +"RTN","TMGBINF",89,0) + set $ETRAP="set abort=1,$ECODE="""" quit" +"RTN","TMGBINF",90,0) + use IO +"RTN","TMGBINF",91,0) + for do quit:($ZEOF)!(abort=1)!(blockIn="") +"RTN","TMGBINF",92,0) + . read blockIn +"RTN","TMGBINF",93,0) + . if (blockIn="") quit +"RTN","TMGBINF",94,0) + . set @curRef=blockIn +"RTN","TMGBINF",95,0) + . set curRef=$$NEXTNODE(curRef,incSubscr) +"RTN","TMGBINF",96,0) + +"RTN","TMGBINF",97,0) + if abort=1 write "Aborted...",! +"RTN","TMGBINF",98,0) + if (abort'=1) set result=1 ;"SUCCESS +"RTN","TMGBINF",99,0) + do CLOSE^%ZISH(handle) +"RTN","TMGBINF",100,0) + +"RTN","TMGBINF",101,0) + if +$get(width)>0 do +"RTN","TMGBINF",102,0) + . do CPYBG(tempRef,3,globalRef,incSubscr,width) +"RTN","TMGBINF",103,0) + . kill @tempRef +"RTN","TMGBINF",104,0) + +"RTN","TMGBINF",105,0) + +"RTN","TMGBINF",106,0) +BFTGDone +"RTN","TMGBINF",107,0) + quit result +"RTN","TMGBINF",108,0) + +"RTN","TMGBINF",109,0) + +"RTN","TMGBINF",110,0) +GTBF(globalRef,incSubscr,path,filename) +"RTN","TMGBINF",111,0) + ;"SCOPE: PUBLIC +"RTN","TMGBINF",112,0) + ;"Purpose: This function will WRITE the values of nodes of a global (at the subscript +"RTN","TMGBINF",113,0) + ;" level you specify) to a host file, in a binary fashion. If the host file already +"RTN","TMGBINF",114,0) + ;" exists, it is truncated to length zero (0) before the copy. +"RTN","TMGBINF",115,0) + ;" Each line of the global is written out, in a serial fashion based on the ordering +"RTN","TMGBINF",116,0) + ;" of the subscripts, with no line terminators written between lines. +"RTN","TMGBINF",117,0) + ;" You do not need to open the host file before making this call; it is opened +"RTN","TMGBINF",118,0) + ;" and closed $$GTBF^TMGBINF +"RTN","TMGBINF",119,0) + ;"Input: +"RTN","TMGBINF",120,0) + ;" globalRef-- Global reference to WRITE the host binary file to, in fully resolved +"RTN","TMGBINF",121,0) + ;" (closed root) format. This function does not kill the global before +"RTN","TMGBINF",122,0) + ;" writing to it. (required) +"RTN","TMGBINF",123,0) + ;" Note: +"RTN","TMGBINF",124,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGBINF",125,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGBINF",126,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGBINF",127,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGBINF",128,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGBINF",129,0) + ;" is always zero. +"RTN","TMGBINF",130,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level. For example, if you +"RTN","TMGBINF",131,0) + ;" pass ^TMP(115,1,1,0) as the global_ref parameter and pass 3 as the +"RTN","TMGBINF",132,0) + ;" inc_subscr parameter, $$BIN2GBL will increment the third subscript, such +"RTN","TMGBINF",133,0) + ;" as ^TMP(115,1,x), but will WRITE notes at the full global reference, such +"RTN","TMGBINF",134,0) + ;" as ^TMP(115,1,x,0). +"RTN","TMGBINF",135,0) + ;" path -- full path, up to but not including the filename (required) +"RTN","TMGBINF",136,0) + ;" filename -- name of the file to open (required) +"RTN","TMGBINF",137,0) + ;"Result: 1=success, 0=failure +"RTN","TMGBINF",138,0) + ;" +"RTN","TMGBINF",139,0) + ;"Example: +"RTN","TMGBINF",140,0) + ;" write $$GTBF(path,file,"^TMP(115,1,1,0)",3) +"RTN","TMGBINF",141,0) + ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..." +"RTN","TMGBINF",142,0) + ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..." +"RTN","TMGBINF",143,0) + ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..." +"RTN","TMGBINF",144,0) + ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..." +"RTN","TMGBINF",145,0) + ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874" +"RTN","TMGBINF",146,0) + ;"Each line would be sent to the output file in turn as a continuous data sequence. +"RTN","TMGBINF",147,0) + ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255 +"RTN","TMGBINF",148,0) + ;" +"RTN","TMGBINF",149,0) + +"RTN","TMGBINF",150,0) + new result set result=0 ;"default to failure +"RTN","TMGBINF",151,0) + new handle set handle="TMGHANDLE" +"RTN","TMGBINF",152,0) + new abort set abort=0 +"RTN","TMGBINF",153,0) + new blockOut +"RTN","TMGBINF",154,0) + new mustExist set mustExist=1 +"RTN","TMGBINF",155,0) + new $ETRAP +"RTN","TMGBINF",156,0) + new curRef set curRef=globalRef +"RTN","TMGBINF",157,0) + +"RTN","TMGBINF",158,0) + set path=$$DEFDIR^%ZISH($get(path)) +"RTN","TMGBINF",159,0) + do OPEN^%ZISH(handle,path,filename,"W") +"RTN","TMGBINF",160,0) + if POP goto GTBFDone +"RTN","TMGBINF",161,0) + set $ETRAP="set abort=1,$ECODE="""" quit" +"RTN","TMGBINF",162,0) + use IO +"RTN","TMGBINF",163,0) + for do quit:(curRef="")!(abort=1) +"RTN","TMGBINF",164,0) + . set blockOut=$get(@curRef) +"RTN","TMGBINF",165,0) + . if (blockOut'="") write blockOut +"RTN","TMGBINF",166,0) + . set $X=0 ;"prevent IO system from 'wrapping' (adding a linefeed) +"RTN","TMGBINF",167,0) + . set curRef=$$NEXTNODE(curRef,incSubscr,mustExist) +"RTN","TMGBINF",168,0) + +"RTN","TMGBINF",169,0) + if (abort'=1) set result=1 ;"SUCCESS +"RTN","TMGBINF",170,0) + do CLOSE^%ZISH(handle) +"RTN","TMGBINF",171,0) + +"RTN","TMGBINF",172,0) +GTBFDone +"RTN","TMGBINF",173,0) + quit result +"RTN","TMGBINF",174,0) + +"RTN","TMGBINF",175,0) + +"RTN","TMGBINF",176,0) +NEXTNODE(curRef,incSubscr,mustExist,incAmount) +"RTN","TMGBINF",177,0) + ;"SCOPE: PUBLIC +"RTN","TMGBINF",178,0) + ;"Purpose: to take a global reference, and increment the node specified by incSubscr +"RTN","TMGBINF",179,0) + ;"Input: curRef -- The reference to alter, e.g. '^TMP(115,1,4,0)' +"RTN","TMGBINF",180,0) + ;" incSubscr--The node to alter, e.g. +"RTN","TMGBINF",181,0) + ;" 1-->^TMG(x,1,4,0) x would be incremented +"RTN","TMGBINF",182,0) + ;" 2-->^TMG(115,x,4,0) x would be incremented +"RTN","TMGBINF",183,0) + ;" 3-->^TMG(115,1,x,0) x would be incremented +"RTN","TMGBINF",184,0) + ;" 4-->^TMG(115,1,4,x) x would be incremented +"RTN","TMGBINF",185,0) + ;" mustExist-- (Option) if >0, then after incrementing, If resulting +"RTN","TMGBINF",186,0) + ;" reference doesn't exist then "" is returned. +"RTN","TMGBINF",187,0) + ;" incAmount -- (Optional) the amount to increment by (default=1) +"RTN","TMGBINF",188,0) + ;"Note: The node that incSubscr references should be numeric (i.e. not a name) +"RTN","TMGBINF",189,0) + ;" otherwise the alpha node will be treated as a 0 +"RTN","TMGBINF",190,0) + ;"result: returns the new reference (or "" if doesn't exist and mustExist>0) +"RTN","TMGBINF",191,0) + +"RTN","TMGBINF",192,0) + new i,result +"RTN","TMGBINF",193,0) + set incAmount=$get(incAmount,1) +"RTN","TMGBINF",194,0) + set result=$qsubscript(curRef,0)_"(" +"RTN","TMGBINF",195,0) + for i=1:1:$qlength(curRef) do +"RTN","TMGBINF",196,0) + . new node +"RTN","TMGBINF",197,0) + . if i'=1 set result=result_"," +"RTN","TMGBINF",198,0) + . set node=$qsubscript(curRef,i) +"RTN","TMGBINF",199,0) + . if i=incSubscr set node=node+incAmount +"RTN","TMGBINF",200,0) + . if (node'=+node) set node=""""_node_"""" +"RTN","TMGBINF",201,0) + . set result=result_node +"RTN","TMGBINF",202,0) + set result=result_")" +"RTN","TMGBINF",203,0) + +"RTN","TMGBINF",204,0) + if $get(mustExist,0)>0 do +"RTN","TMGBINF",205,0) + . if $data(@result)#10=0 set result="" +"RTN","TMGBINF",206,0) + +"RTN","TMGBINF",207,0) + quit result +"RTN","TMGBINF",208,0) + +"RTN","TMGBINF",209,0) + +"RTN","TMGBINF",210,0) +CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width) +"RTN","TMGBINF",211,0) + +"RTN","TMGBINF",212,0) + ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...*** +"RTN","TMGBINF",213,0) + +"RTN","TMGBINF",214,0) + ;"Purpose: COPY/RESIZE BINARY GLOBAL. This can be used to change the number of bytes +"RTN","TMGBINF",215,0) + ;" stored on each line of a binary global array +"RTN","TMGBINF",216,0) + ;"Input: +"RTN","TMGBINF",217,0) + ;" srcGRef-- Global reference of the SOURCE binary global array, in fully resolved +"RTN","TMGBINF",218,0) + ;" (closed root) format. +"RTN","TMGBINF",219,0) + ;" Note: +"RTN","TMGBINF",220,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGBINF",221,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGBINF",222,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGBINF",223,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGBINF",224,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGBINF",225,0) + ;" is always zero. +"RTN","TMGBINF",226,0) + ;" REQUIRED +"RTN","TMGBINF",227,0) + ;" srcIncSubscr-- (required) Identifies the incrementing subscript level, for the source global +"RTN","TMGBINF",228,0) + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and +"RTN","TMGBINF",229,0) + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third +"RTN","TMGBINF",230,0) + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global +"RTN","TMGBINF",231,0) + ;" reference, such as ^TMP(115,1,x,0). +"RTN","TMGBINF",232,0) + ;" REQUIRED +"RTN","TMGBINF",233,0) + ;" dstGRef-- Global reference of the DESTINATION binary global array, in fully resolved +"RTN","TMGBINF",234,0) + ;" (closed root) format. The destination IS NOT KILLED prior to filling with +"RTN","TMGBINF",235,0) + ;" new data +"RTN","TMGBINF",236,0) + ;" Note: +"RTN","TMGBINF",237,0) + ;" At least one subscript must be numeric. (same as note above) +"RTN","TMGBINF",238,0) + ;" REQUIRED +"RTN","TMGBINF",239,0) + ;" dstIncSubscr-- (required) Identifies the incrementing subscript level, for the source global +"RTN","TMGBINF",240,0) + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and +"RTN","TMGBINF",241,0) + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third +"RTN","TMGBINF",242,0) + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global +"RTN","TMGBINF",243,0) + ;" reference, such as ^TMP(115,1,x,0). +"RTN","TMGBINF",244,0) + ;" REQUIRED +"RTN","TMGBINF",245,0) + ;" width-- The number of bytes to store per line in the DESTINATION array. +"RTN","TMGBINF",246,0) + ;" REQUIRED +"RTN","TMGBINF",247,0) + ;" +"RTN","TMGBINF",248,0) + ;"Output: @dstGRef is filled with data +"RTN","TMGBINF",249,0) + ;"Result: None +"RTN","TMGBINF",250,0) + +"RTN","TMGBINF",251,0) + +"RTN","TMGBINF",252,0) + ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...*** +"RTN","TMGBINF",253,0) + +"RTN","TMGBINF",254,0) + new readPos set readPos=1 +"RTN","TMGBINF",255,0) + new bytesRead +"RTN","TMGBINF",256,0) + if $get(srcGRef)="" goto CPYBGDone +"RTN","TMGBINF",257,0) + if $get(dstGRef)="" goto CPYBGDone +"RTN","TMGBINF",258,0) + if $get(srcIncSubscr)="" goto CPYBGDone +"RTN","TMGBINF",259,0) + if $get(dstIncSubscr)="" goto CPYBGDone +"RTN","TMGBINF",260,0) + if $get(width)="" goto CPYBGDone +"RTN","TMGBINF",261,0) + +"RTN","TMGBINF",262,0) + for do quit:(bytesRead=0) +"RTN","TMGBINF",263,0) + . set @dstGRef=$$READBG(srcGRef,srcIncSubscr,readPos,width,.bytesRead) +"RTN","TMGBINF",264,0) + . if (bytesRead=0) kill @dstGRef +"RTN","TMGBINF",265,0) + . set readPos=readPos+bytesRead +"RTN","TMGBINF",266,0) + . set dstGRef=$$NEXTNODE(dstGRef,dstIncSubscr,0,1) +"RTN","TMGBINF",267,0) + +"RTN","TMGBINF",268,0) +CPYBGDone +"RTN","TMGBINF",269,0) + quit +"RTN","TMGBINF",270,0) + +"RTN","TMGBINF",271,0) + +"RTN","TMGBINF",272,0) + +"RTN","TMGBINF",273,0) +READBG(GRef,incSubscr,pos,count,actualCount) +"RTN","TMGBINF",274,0) + ;"SCOPE: PUBLIC +"RTN","TMGBINF",275,0) + ;"Purpose: To read 'count' bytes from binary global '@srcGRef', starting at 'pos' +"RTN","TMGBINF",276,0) + ;"Input: +"RTN","TMGBINF",277,0) + ;" GRef-- Global reference of the binary global array, in fully resolved +"RTN","TMGBINF",278,0) + ;" (closed root) format. +"RTN","TMGBINF",279,0) + ;" Note: +"RTN","TMGBINF",280,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGBINF",281,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGBINF",282,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGBINF",283,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGBINF",284,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGBINF",285,0) + ;" is always zero. +"RTN","TMGBINF",286,0) + ;" REQUIRED +"RTN","TMGBINF",287,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global +"RTN","TMGBINF",288,0) + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and +"RTN","TMGBINF",289,0) + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third +"RTN","TMGBINF",290,0) + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global +"RTN","TMGBINF",291,0) + ;" reference, such as ^TMP(115,1,x,0). +"RTN","TMGBINF",292,0) + ;" REQUIRED +"RTN","TMGBINF",293,0) + ;" Pos-- The position in the binary global to start reading from (0 is first byte), as if +"RTN","TMGBINF",294,0) + ;" entire global array is one long binary stream. E.g. the 913th byte might be +"RTN","TMGBINF",295,0) + ;" actually the 17th byte on the 14th line (if 64 bytes are stored per line). But +"RTN","TMGBINF",296,0) + ;" this is handled transparently and the user need only specify byte #913 etc. +"RTN","TMGBINF",297,0) + ;" . The reading will start at the appropriate point. +"RTN","TMGBINF",298,0) + ;" count-- The number of bytes/characters to read. +"RTN","TMGBINF",299,0) + ;" actualCount-- OPTIONAL. An OUT PARAMETER -- PASS BY REFERENCE +"RTN","TMGBINF",300,0) + ;" This is filled with the actual number of bytes/characters successfully read. +"RTN","TMGBINF",301,0) + ;"Result: a string filled with requested number of bytes/characters +"RTN","TMGBINF",302,0) + +"RTN","TMGBINF",303,0) + new result set result="" +"RTN","TMGBINF",304,0) + new countPerLine +"RTN","TMGBINF",305,0) + new goalLen set goalLen=count +"RTN","TMGBINF",306,0) + new Line,p1 +"RTN","TMGBINF",307,0) + new done +"RTN","TMGBINF",308,0) + if $get(GRef)="" goto ReadBGDone +"RTN","TMGBINF",309,0) + set countPerLine=$length(@GRef) +"RTN","TMGBINF",310,0) + if (countPerLine=0) goto ReadBGDone +"RTN","TMGBINF",311,0) + +"RTN","TMGBINF",312,0) + set Line=pos\countPerLine +"RTN","TMGBINF",313,0) + set p1=pos#countPerLine +"RTN","TMGBINF",314,0) + +"RTN","TMGBINF",315,0) + for do quit:(done=1)!(count<1) +"RTN","TMGBINF",316,0) + . new curRef +"RTN","TMGBINF",317,0) + . set done=0 +"RTN","TMGBINF",318,0) + . set curRef=$$NEXTNODE(GRef,incSubscr,1,Line) +"RTN","TMGBINF",319,0) + . if curRef="" set done=1 quit +"RTN","TMGBINF",320,0) + . set result=result_$extract(@GRef,p1,p1+count-1) +"RTN","TMGBINF",321,0) + . set count=goalLen-$length(result) +"RTN","TMGBINF",322,0) + . if count<1 set done=1 quit +"RTN","TMGBINF",323,0) + . set Line=Line+1 +"RTN","TMGBINF",324,0) + . set p1=1 +"RTN","TMGBINF",325,0) + +"RTN","TMGBINF",326,0) +ReadBGDone +"RTN","TMGBINF",327,0) + set actualCount=$length(result) +"RTN","TMGBINF",328,0) + quit result +"RTN","TMGBINF",329,0) + +"RTN","TMGBINF",330,0) + +"RTN","TMGBROWS") +0^3^B6541 +"RTN","TMGBROWS",1,0) +TMGBROWS ;TMG/kst/Record browser ;03/25/06 +"RTN","TMGBROWS",2,0) + ;;1.0;TMG-LIB;**1**;03/10/07 +"RTN","TMGBROWS",3,0) + +"RTN","TMGBROWS",4,0) + ;" TMG BROWSE RECORDS +"RTN","TMGBROWS",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGBROWS",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGBROWS",7,0) + ;"3-10-2007 +"RTN","TMGBROWS",8,0) + +"RTN","TMGBROWS",9,0) + ;"======================================================================= +"RTN","TMGBROWS",10,0) + ;" API -- Public Functions. +"RTN","TMGBROWS",11,0) + ;"======================================================================= +"RTN","TMGBROWS",12,0) + ;"ASKBROWSE -- browse records, and follow pointers +"RTN","TMGBROWS",13,0) + +"RTN","TMGBROWS",14,0) + ;"======================================================================= +"RTN","TMGBROWS",15,0) + ;" Private Functions. +"RTN","TMGBROWS",16,0) + ;"======================================================================= +"RTN","TMGBROWS",17,0) + ;"Browse(FileNum,IENS,ShowEmpty) --Browse a record, allowing display of +"RTN","TMGBROWS",18,0) + ;" the current record, or follow pointers to other records. +"RTN","TMGBROWS",19,0) + ;"DispRec(FileNum,IEN) -- To display record +"RTN","TMGBROWS",20,0) + +"RTN","TMGBROWS",21,0) + ;"======================================================================= +"RTN","TMGBROWS",22,0) + +"RTN","TMGBROWS",23,0) + +"RTN","TMGBROWS",24,0) +ASKBROWSE +"RTN","TMGBROWS",25,0) + ;"Purpose: To browse records, and follow pointers. +"RTN","TMGBROWS",26,0) + +"RTN","TMGBROWS",27,0) + write !!," -= RECORD BROWSE =-",! +"RTN","TMGBROWS",28,0) + new FIENS,IENS +"RTN","TMGBROWS",29,0) +AL1 +"RTN","TMGBROWS",30,0) + set FIENS=$$AskFIENS^TMGDBAPI() +"RTN","TMGBROWS",31,0) + if (FIENS["?")!(FIENS="^") goto ASKDone +"RTN","TMGBROWS",32,0) + +"RTN","TMGBROWS",33,0) + set FileNum=$piece(FIENS,"^",1) +"RTN","TMGBROWS",34,0) + set IENS=$piece(FIENS,"^",2) +"RTN","TMGBROWS",35,0) + +"RTN","TMGBROWS",36,0) +AL2 +"RTN","TMGBROWS",37,0) + set IENS=$$AskIENS^TMGDBAPI(FileNum,IENS) +"RTN","TMGBROWS",38,0) + if (IENS["?")!(IENS="") goto AL1 +"RTN","TMGBROWS",39,0) + +"RTN","TMGBROWS",40,0) + new % set %=2 +"RTN","TMGBROWS",41,0) + write "Display empty fields" +"RTN","TMGBROWS",42,0) + do YN^DICN +"RTN","TMGBROWS",43,0) + if %=-1 write ! goto ASKDone +"RTN","TMGBROWS",44,0) + +"RTN","TMGBROWS",45,0) + ;"Do the output +"RTN","TMGBROWS",46,0) + write ! do Browse(FileNum,IENS,(%=1)) +"RTN","TMGBROWS",47,0) + set IENS=$piece(IENS,",",2,99) ;"force Pick of new record to dump +"RTN","TMGBROWS",48,0) + if +IENS>0 goto AL2 +"RTN","TMGBROWS",49,0) + goto AL1 +"RTN","TMGBROWS",50,0) + +"RTN","TMGBROWS",51,0) + +"RTN","TMGBROWS",52,0) +ASKDone +"RTN","TMGBROWS",53,0) + quit +"RTN","TMGBROWS",54,0) + +"RTN","TMGBROWS",55,0) + +"RTN","TMGBROWS",56,0) +Browse(FileNum,IENS,ShowEmpty) +"RTN","TMGBROWS",57,0) + ;"Purpose: Browse a record, allowing display of the current record, or +"RTN","TMGBROWS",58,0) + ;" follow pointers to other records. +"RTN","TMGBROWS",59,0) + ;"Input: FileNum -- the number of the file to browse +"RTN","TMGBROWS",60,0) + ;" IENS -- the record number to display (or IENS: #,#,#,) +"RTN","TMGBROWS",61,0) + ;" ShowEmpty -- OPTIONAL; if 1 then empty fields will be displayed +"RTN","TMGBROWS",62,0) + +"RTN","TMGBROWS",63,0) + new FldInfo,field +"RTN","TMGBROWS",64,0) + do GetPtrsOUT^TMGDBAPI(FileNum,.FldInfo) +"RTN","TMGBROWS",65,0) + +"RTN","TMGBROWS",66,0) + if $extract(IENS,$length(IENS))'="," set IENS=IENS_"," +"RTN","TMGBROWS",67,0) + +"RTN","TMGBROWS",68,0) + set field="" +"RTN","TMGBROWS",69,0) + for set field=$order(FldInfo(field)) quit:(field="") do +"RTN","TMGBROWS",70,0) + . new name set name=$$GetFldName^TMGDBAPI(FileNum,field) +"RTN","TMGBROWS",71,0) + . set FldInfo(field,"NAME")=name +"RTN","TMGBROWS",72,0) + +"RTN","TMGBROWS",73,0) + new Menu +"RTN","TMGBROWS",74,0) + new count set count=1 +"RTN","TMGBROWS",75,0) + write "File: ",$$GetFName^TMGDBAPI(FileNum),! +"RTN","TMGBROWS",76,0) + +"RTN","TMGBROWS",77,0) + set Menu(0)="File: "_$$GetFName^TMGDBAPI(FileNum)_" ("_FileNum_"), Record: "_IENS +"RTN","TMGBROWS",78,0) + set field="" +"RTN","TMGBROWS",79,0) + for set field=$order(FldInfo(field)) quit:(field="") do +"RTN","TMGBROWS",80,0) + . new ptr set ptr=$$GET1^DIQ(FileNum,IENS,field,"I") +"RTN","TMGBROWS",81,0) + . new otherName set otherName=$$GET1^DIQ(FileNum,IENS,field) +"RTN","TMGBROWS",82,0) + . if ptr="" quit +"RTN","TMGBROWS",83,0) + . new name set name=$$GetFldName^TMGDBAPI(FileNum,field) +"RTN","TMGBROWS",84,0) + . set Menu(count)="BROWSE: ("_field_") "_name_"--> "_otherName_$char(9)_FldInfo(field)_"|"_ptr +"RTN","TMGBROWS",85,0) + . set count=count+1 +"RTN","TMGBROWS",86,0) + +"RTN","TMGBROWS",87,0) + set Menu(count)="DUMP entire record"_$char(9)_"DUMP" +"RTN","TMGBROWS",88,0) + +"RTN","TMGBROWS",89,0) +M0 write # +"RTN","TMGBROWS",90,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGBROWS",91,0) + +"RTN","TMGBROWS",92,0) + if UsrSlct="DUMP" do DispRec(FileNum,IENS) goto M0 +"RTN","TMGBROWS",93,0) + if UsrSlct["|" do goto M0 +"RTN","TMGBROWS",94,0) + . new newFile set newFile=$piece(UsrSlct,"|",1) +"RTN","TMGBROWS",95,0) + . new IEN set IEN=$piece(UsrSlct,"|",2)_"," +"RTN","TMGBROWS",96,0) + . do Browse(newFile,IEN,.ShowEmpty) +"RTN","TMGBROWS",97,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGBROWS",98,0) + goto M0 +"RTN","TMGBROWS",99,0) + +"RTN","TMGBROWS",100,0) +MenuDone +"RTN","TMGBROWS",101,0) + quit +"RTN","TMGBROWS",102,0) + +"RTN","TMGBROWS",103,0) + +"RTN","TMGBROWS",104,0) +DispRec(FileNum,IEN) +"RTN","TMGBROWS",105,0) + ;"Purpose: To display record +"RTN","TMGBROWS",106,0) + ;"Input: FileNum -- The File number to display +"RTN","TMGBROWS",107,0) + ;" IEN -- the IEN (record number) to display in file. +"RTN","TMGBROWS",108,0) + ;"Results: none +"RTN","TMGBROWS",109,0) + +"RTN","TMGBROWS",110,0) + write "File: ",$$GetFName^TMGDBAPI(FileNum),! +"RTN","TMGBROWS",111,0) + do DumpRec2^TMGDEBUG(FileNum,IEN_",",0) +"RTN","TMGBROWS",112,0) + do PressToCont^TMGUSRIF +"RTN","TMGBROWS",113,0) + +"RTN","TMGBROWS",114,0) + quit +"RTN","TMGBROWS",115,0) + +"RTN","TMGBUTIL") +0^4^B7315 +"RTN","TMGBUTIL",1,0) +TMGBUTIL ;TMG/kst/Binary Global Data Utilities ;03/25/06 +"RTN","TMGBUTIL",2,0) + ;;1.0;TMG-LIB;**1**;08/20/05 +"RTN","TMGBUTIL",3,0) + +"RTN","TMGBUTIL",4,0) + ;"TMG BINARY GLOBAL DATA UTILITY FUNCTIONS +"RTN","TMGBUTIL",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGBUTIL",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGBUTIL",7,0) + ;"8-20-2005 +"RTN","TMGBUTIL",8,0) + +"RTN","TMGBUTIL",9,0) + ;"======================================================================= +"RTN","TMGBUTIL",10,0) + ;" API -- Public Functions. +"RTN","TMGBUTIL",11,0) + ;"======================================================================= +"RTN","TMGBUTIL",12,0) + ;"DISPLAY(globalRef,incSubscr,offset,numLines,bytesPerLine) +"RTN","TMGBUTIL",13,0) + ;"BROWSE(globalRef,incSubscr) +"RTN","TMGBUTIL",14,0) + +"RTN","TMGBUTIL",15,0) + ;"======================================================================= +"RTN","TMGBUTIL",16,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGBUTIL",17,0) + ;"======================================================================= +"RTN","TMGBUTIL",18,0) + +"RTN","TMGBUTIL",19,0) + +"RTN","TMGBUTIL",20,0) + ;"======================================================================= +"RTN","TMGBUTIL",21,0) + ;"DEPENDENCIES +"RTN","TMGBUTIL",22,0) + ;"======================================================================= +"RTN","TMGBUTIL",23,0) + ;"Uses: TMGBINF +"RTN","TMGBUTIL",24,0) + ;" TMGMISC +"RTN","TMGBUTIL",25,0) + ;" TMGSTUTL +"RTN","TMGBUTIL",26,0) + +"RTN","TMGBUTIL",27,0) + ;"======================================================================= +"RTN","TMGBUTIL",28,0) + +"RTN","TMGBUTIL",29,0) +BROWSE(globalRef,incSubscr) +"RTN","TMGBUTIL",30,0) + ;"SCOPE: PUBLIC +"RTN","TMGBUTIL",31,0) + ;"Purpose: to browse a binary set as hex codes +"RTN","TMGBUTIL",32,0) + +"RTN","TMGBUTIL",33,0) + new offset set offset=0 +"RTN","TMGBUTIL",34,0) + new input +"RTN","TMGBUTIL",35,0) + for do quit:(offset="") +"RTN","TMGBUTIL",36,0) + . read "Offset to browse (? for help): ",input:$get(DTIME,3600),! +"RTN","TMGBUTIL",37,0) + . if input="?" write "^ to abort,A=browse up, Z=browse down",! quit +"RTN","TMGBUTIL",38,0) + . if input="^" set offset="" quit +"RTN","TMGBUTIL",39,0) + . if input="" set input="Z" +"RTN","TMGBUTIL",40,0) + . if "Aa"[input set offset=offset-(8*16) +"RTN","TMGBUTIL",41,0) + . if "Zz"[input set offset=offset+(8*16) +"RTN","TMGBUTIL",42,0) + . if $extract(input,1)="$" set input=$$HEX2NUM^TMGMISC(input) +"RTN","TMGBUTIL",43,0) + . if +input=input set offset=input +"RTN","TMGBUTIL",44,0) + . if +offset'=offset set offset="" quit +"RTN","TMGBUTIL",45,0) + . do DISPLAY(globalRef,incSubscr,offset,8,16) +"RTN","TMGBUTIL",46,0) + +"RTN","TMGBUTIL",47,0) + quit +"RTN","TMGBUTIL",48,0) + +"RTN","TMGBUTIL",49,0) + +"RTN","TMGBUTIL",50,0) +DISPLAY(globalRef,incSubscr,offset,numLines,bytesPerLine) +"RTN","TMGBUTIL",51,0) + ;"SCOPE: PUBLIC +"RTN","TMGBUTIL",52,0) + ;"Purpose: to display a binary set as hex codes +"RTN","TMGBUTIL",53,0) + ;"Input: gobalRef -- the reference of the beginning of the block (in closed form) +"RTN","TMGBUTIL",54,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level. For example, if you +"RTN","TMGBUTIL",55,0) + ;" pass ^TMP(115,1,1,0) as the global_ref parameter and pass 3 as the +"RTN","TMGBUTIL",56,0) + ;" inc_subscr parameter, $$BIN2GBL will increment the third subscript, such +"RTN","TMGBUTIL",57,0) + ;" as ^TMP(115,1,x), but will WRITE notes at the full global reference, such +"RTN","TMGBUTIL",58,0) + ;" as ^TMP(115,1,x,0). +"RTN","TMGBUTIL",59,0) + ;" offset -- (OPTIONAL) the bytes offset from the beginning of the +"RTN","TMGBUTIL",60,0) + ;" block to start from. Default=0 +"RTN","TMGBUTIL",61,0) + ;" numLines -- (OPTIONAL) the number of lines to show. Default=8 +"RTN","TMGBUTIL",62,0) + ;" bytesPerLine -- (OPTIONAL) the number of bytes to show per line Default=16 +"RTN","TMGBUTIL",63,0) + ;"Output -- displays the hex bytes to the screen +"RTN","TMGBUTIL",64,0) + ;"Result -- none +"RTN","TMGBUTIL",65,0) + +"RTN","TMGBUTIL",66,0) + ;"Note: each line in the global ref is assumed to hold 512 bytes. +"RTN","TMGBUTIL",67,0) + +"RTN","TMGBUTIL",68,0) + new index,data +"RTN","TMGBUTIL",69,0) + new bytesNeeded +"RTN","TMGBUTIL",70,0) + new atEnd set atEnd=0 +"RTN","TMGBUTIL",71,0) + +"RTN","TMGBUTIL",72,0) + set offset=$get(offset,0) +"RTN","TMGBUTIL",73,0) + set numLines=$get(numLines,8) +"RTN","TMGBUTIL",74,0) + set bytesPerLine=$get(bytesPerLine,16) +"RTN","TMGBUTIL",75,0) + set bytesNeeded=numLines*bytesPerLine +"RTN","TMGBUTIL",76,0) + set index=offset\512 +"RTN","TMGBUTIL",77,0) + +"RTN","TMGBUTIL",78,0) + if index>0 set globalRef=$$NEXTNODE^TMGBINF(globalRef,incSubscr,1,index) +"RTN","TMGBUTIL",79,0) + if (globalRef="") goto DispDone +"RTN","TMGBUTIL",80,0) + set data=$extract($get(@globalRef),(offset#512)+1,512) +"RTN","TMGBUTIL",81,0) + +"RTN","TMGBUTIL",82,0) + for quit:($length(data)'0) do +"RTN","TMGBUTIL",83,0) + . set globalRef=$$NEXTNODE^TMGBINF(globalRef,incSubscr,1,1) +"RTN","TMGBUTIL",84,0) + . if (globalRef="") set atEnd=1 quit +"RTN","TMGBUTIL",85,0) + . new oneLine set oneLine=$get(@globalRef) +"RTN","TMGBUTIL",86,0) + . if oneLine="" set atEnd=1 quit +"RTN","TMGBUTIL",87,0) + . set data=data_$extract(oneLine,1,bytesNeeded-$length(data)) +"RTN","TMGBUTIL",88,0) + +"RTN","TMGBUTIL",89,0) + ;"Now display data +"RTN","TMGBUTIL",90,0) + new dispLine +"RTN","TMGBUTIL",91,0) + new dispOffset set dispOffset=offset +"RTN","TMGBUTIL",92,0) + for quit:($length(data)=0) do +"RTN","TMGBUTIL",93,0) + . set dispLine=$extract(data,1,bytesPerLine) +"RTN","TMGBUTIL",94,0) + . set data=$extract(data,bytesPerLine+1,bytesNeeded) +"RTN","TMGBUTIL",95,0) + . write "$",$$HEXCHR2^TMGMISC(dispOffset,6)," " +"RTN","TMGBUTIL",96,0) + . write $$STRB2H^TMGSTUTL(dispLine,1),! +"RTN","TMGBUTIL",97,0) + . set dispOffset=dispOffset+bytesPerLine +"RTN","TMGBUTIL",98,0) + +"RTN","TMGBUTIL",99,0) + +"RTN","TMGBUTIL",100,0) +DispDone +"RTN","TMGBUTIL",101,0) + quit +"RTN","TMGCHR") +0^5^B22942466 +"RTN","TMGCHR",1,0) +TMGCHR ;TMG/kst/Custom version of CHRISTEN ;03/25/06 +"RTN","TMGCHR",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGCHR",3,0) + +"RTN","TMGCHR",4,0) + ;"CHRISTEN(INFO) This library will provide optional NON-INTERACTIVE versions of standard code. +"RTN","TMGCHR",5,0) + +"RTN","TMGCHR",6,0) + ;"============================================================================= +"RTN","TMGCHR",7,0) + ;"Kevin Toppenberg, MD 11-04 +"RTN","TMGCHR",8,0) + ;" +"RTN","TMGCHR",9,0) + ;"Purpose: +"RTN","TMGCHR",10,0) + ;" +"RTN","TMGCHR",11,0) + ;"This library will provide optional NON-INTERACTIVE versions of standard code. +"RTN","TMGCHR",12,0) + ;" +"RTN","TMGCHR",13,0) + ;"CHRISTEN(INFO) +"RTN","TMGCHR",14,0) + ;" +"RTN","TMGCHR",15,0) + ;"Dependancies: +"RTN","TMGCHR",16,0) + ;" TMGQIO +"RTN","TMGCHR",17,0) + ;"============================================================================= +"RTN","TMGCHR",18,0) + +"RTN","TMGCHR",19,0) +MUDCHR ;ISC-SF/GMB-Christen Site ;04/17/2002 11:48 +"RTN","TMGCHR",20,0) + ;;8.0;MailMan;;Jun 28, 2002 +"RTN","TMGCHR",21,0) + ; Entry points used by MailMan options (not covered by DBIA): +"RTN","TMGCHR",22,0) + ; CHRISTEN XMCHRIS - Edit MailMan Site Parameters +"RTN","TMGCHR",23,0) + ;" +"RTN","TMGCHR",24,0) + ;"K. Toppenberg's changes made November, 2004 +"RTN","TMGCHR",25,0) + ;" +"RTN","TMGCHR",26,0) + ;"Input: +"RTN","TMGCHR",27,0) + ;" Note: INFO variable is completely an OPTIONAL parameter. +"RTN","TMGCHR",28,0) + ;" If not supplied, interactive mode used +"RTN","TMGCHR",29,0) + ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed. +"RTN","TMGCHR",30,0) + ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed. +"RTN","TMGCHR",31,0) + ;" +"RTN","TMGCHR",32,0) + ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied: +"RTN","TMGCHR",33,0) + ;" ---------------------- +"RTN","TMGCHR",34,0) + ;" INFO("DOMAIN") -- Answer for 'DOMAIN' to edit-- should be an existing domain +"RTN","TMGCHR",35,0) + ;" INFO("PARENT") -- Answer for 'PARENT' domain question +"RTN","TMGCHR",36,0) + ;" INFO("TIMEZONE") -- Answer for 'TIME ZONE' question +"RTN","TMGCHR",37,0) + ;" INFO("CONTINUE") -- Answer for "Are you sure you want to change the name of this facility" +"RTN","TMGCHR",38,0) + ;"Output: +"RTN","TMGCHR",39,0) + ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array +"RTN","TMGCHR",40,0) + ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out. +"RTN","TMGCHR",41,0) + ;" INFO("TEXT","LINES")=Number of output lines +"RTN","TMGCHR",42,0) + ;" INFO("TEXT",1)= 1st output line +"RTN","TMGCHR",43,0) + ;" INFO("TEXT",2)= 2nd output line, etc... +"RTN","TMGCHR",44,0) + ; +"RTN","TMGCHR",45,0) + ; +"RTN","TMGCHR",46,0) +CHRISTEN(INFO) ;Set up/Change MailMan Site Parameters +"RTN","TMGCHR",47,0) + ; +"RTN","TMGCHR",48,0) + NEW SILNTOUT SET SILNTOUT=$get(INFO("SILENT-OUTPUT"),0) ;//kt +"RTN","TMGCHR",49,0) + NEW SILENTIN SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT +"RTN","TMGCHR",50,0) + KILL INFO("TEXT") ;//kt +"RTN","TMGCHR",51,0) + +"RTN","TMGCHR",52,0) + N XMREC,XMABORT +"RTN","TMGCHR",53,0) + S XMABORT=0 +"RTN","TMGCHR",54,0) + S XMREC=$G(^XMB(1,1,0)) I '+XMREC,$O(^XMB(1,0)) G E +"RTN","TMGCHR",55,0) + I XMREC="" D +"RTN","TMGCHR",56,0) + . D INIT +"RTN","TMGCHR",57,0) + E D +"RTN","TMGCHR",58,0) + . D CHANGE +"RTN","TMGCHR",59,0) + Q:XMABORT +"RTN","TMGCHR",60,0) + D PARENT +"RTN","TMGCHR",61,0) + D SCRIPT +"RTN","TMGCHR",62,0) + G Q +"RTN","TMGCHR",63,0) + ; +"RTN","TMGCHR",64,0) + ; +"RTN","TMGCHR",65,0) + ;====================================================================== +"RTN","TMGCHR",66,0) +INIT ; Initial Christening +"RTN","TMGCHR",67,0) + N DIC,DIE,Y,DA,XMFDA +"RTN","TMGCHR",68,0) + ; +"RTN","TMGCHR",69,0) + S DIC=4.2 +"RTN","TMGCHR",70,0) + IF SILENTIN=1 DO +"RTN","TMGCHR",71,0) + . S DIC(0)="EM" +"RTN","TMGCHR",72,0) + . SET X=$GET(INFO("DOMAIN")) +"RTN","TMGCHR",73,0) + ELSE DO +"RTN","TMGCHR",74,0) + . S DIC(0)="AEMQ" +"RTN","TMGCHR",75,0) + D ^DIC +"RTN","TMGCHR",76,0) + I Y<1 S XMABORT=1 D E1 Q +"RTN","TMGCHR",77,0) + S XMFDA(4.3,"+1,",.01)=+Y +"RTN","TMGCHR",78,0) + D UPDATE^DIE("","XMFDA") +"RTN","TMGCHR",79,0) + K DIC,Y +"RTN","TMGCHR",80,0) + do InputParent +"RTN","TMGCHR",81,0) + ;"if SILENTIN>0 do ;"Note: Fields 3=PARENT, 1=TIME ZONE +"RTN","TMGCHR",82,0) + ;". set DR="3///"_$get(INFO("PARENT"),"FORUM.VA.GOV") ;"3 '/'s means force the data in +"RTN","TMGCHR",83,0) + ;". set DR=DR_";1///"_$get(INFO("PARENT"),"EST") +"RTN","TMGCHR",84,0) + ;"else do +"RTN","TMGCHR",85,0) + ;". S DR="3//FORUM.VA.GOV;1//EST" ;"2 '/'s means ask user, with default suggestion. +"RTN","TMGCHR",86,0) + ;"S DIE=4.3 ;"MAILMAN SITE PARAMETERS +"RTN","TMGCHR",87,0) + ;"S DA=1 ;"Record#/IEN = 1 +"RTN","TMGCHR",88,0) + ;"D ^DIE ;"Input selected data elements to a given record. (only for existing records) +"RTN","TMGCHR",89,0) + I $D(Y) S XMABORT=1 D E1 +"RTN","TMGCHR",90,0) + Q +"RTN","TMGCHR",91,0) + ; +"RTN","TMGCHR",92,0) + ; +"RTN","TMGCHR",93,0) + ;======================================================================= +"RTN","TMGCHR",94,0) +CHANGE ; +"RTN","TMGCHR",95,0) + N XMSITE,DIE,DA,DR,DIC,X,Yi +"RTN","TMGCHR",96,0) + IF $D(^XMB("NETNAME")) SET XMSITE=^XMB("NETNAME") +"RTN","TMGCHR",97,0) + ELSE IF $D(^XMB("NAME")) SET XMSITE=^XMB("NAME") +"RTN","TMGCHR",98,0) + ELSE IF $D(^DIC(4.2,+XMREC,0)) SET XMSITE=$P(^(0),U) +"RTN","TMGCHR",99,0) + ELSE SET XMSITE=XMREC +"RTN","TMGCHR",100,0) + I $$SURE(XMSITE)=0 S XMABORT=1 Q ; Are you sure? +"RTN","TMGCHR",101,0) + S DIC=4.2 +"RTN","TMGCHR",102,0) + IF SILENTIN=0 DO +"RTN","TMGCHR",103,0) + . S DIC(0)="AEMQ" +"RTN","TMGCHR",104,0) + . S DIC("B")=$S($D(^DIC(4.2,+XMREC,0)):$P(^(0),U),1:XMSITE) +"RTN","TMGCHR",105,0) + ELSE DO +"RTN","TMGCHR",106,0) + . SET DIC(0)="EM" +"RTN","TMGCHR",107,0) + . SET DIC("B")="" +"RTN","TMGCHR",108,0) + . SET X=$GET(INFO("DOMAIN")) +"RTN","TMGCHR",109,0) + D ^DIC +"RTN","TMGCHR",110,0) + I Y=-1 S XMABORT=1 Q +"RTN","TMGCHR",111,0) + I XMSITE'=$P(Y,U,2) D +"RTN","TMGCHR",112,0) + . I +Y=^XMB("NUM") D +"RTN","TMGCHR",113,0) + . . ; The domain name in file 4.2 has been changed. +"RTN","TMGCHR",114,0) + . . ; The pointer to file 4.2 has stayed the same. +"RTN","TMGCHR",115,0) + . . ; The filer won't fire the xrefs, so we need to do it manually +"RTN","TMGCHR",116,0) + . . S (^XMB("NETNAME"),^XMB("NAME"))=$P(Y,U,2) +"RTN","TMGCHR",117,0) + . E D +"RTN","TMGCHR",118,0) + . . N XMFDA +"RTN","TMGCHR",119,0) + . . S XMFDA(4.3,"1,",.01)=+Y +"RTN","TMGCHR",120,0) + . . D FILE^DIE("","XMFDA") +"RTN","TMGCHR",121,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","The domain name for this facility is now: ",^XMB("NETNAME")) +"RTN","TMGCHR",122,0) + E D +"RTN","TMGCHR",123,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","The domain name for this facility remains: ",^XMB("NETNAME")) +"RTN","TMGCHR",124,0) + K DIC,Y +"RTN","TMGCHR",125,0) + do InputParent +"RTN","TMGCHR",126,0) + ;"S DR="3//FORUM.VA.GOV;1//EST" +"RTN","TMGCHR",127,0) + ;"S DIE=4.3,DA=1 +"RTN","TMGCHR",128,0) + ;"D ^DIE +"RTN","TMGCHR",129,0) + Q +"RTN","TMGCHR",130,0) + ; +"RTN","TMGCHR",131,0) + ; +"RTN","TMGCHR",132,0) + ;======================================================================= +"RTN","TMGCHR",133,0) +InputParent +"RTN","TMGCHR",134,0) + if SILENTIN>0 do ;"Note: Fields 3=PARENT, 1=TIME ZONE +"RTN","TMGCHR",135,0) + . set DR="3///"_$get(INFO("PARENT"),"FORUM.VA.GOV") ;"3 '/'s means force the data in +"RTN","TMGCHR",136,0) + . set DR=DR_";1///"_$get(INFO("PARENT"),"EST") +"RTN","TMGCHR",137,0) + else do +"RTN","TMGCHR",138,0) + . S DR="3//FORUM.VA.GOV;1//EST" ;"2 '/'s means ask user, with default suggestion. +"RTN","TMGCHR",139,0) + S DIE=4.3 ;"MAILMAN SITE PARAMETERS +"RTN","TMGCHR",140,0) + S DA=1 ;"Record#/IEN = 1 +"RTN","TMGCHR",141,0) + D ^DIE ;"Input selected data elements to a given record. (only for existing records) +"RTN","TMGCHR",142,0) + quit +"RTN","TMGCHR",143,0) + ; +"RTN","TMGCHR",144,0) + ; +"RTN","TMGCHR",145,0) + ;======================================================================= +"RTN","TMGCHR",146,0) +SURE(XMSITE) ; Function returns 1 if sure; 0 if not +"RTN","TMGCHR",147,0) + N DIR,X,Y +"RTN","TMGCHR",148,0) + N RESULT SET RESULT=0 ; Default to not sure +"RTN","TMGCHR",149,0) + ; +"RTN","TMGCHR",150,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!"," * * * * WARNING * * * *","!","!") +"RTN","TMGCHR",151,0) + DO OUTP^TMGQIO(SILNTOUT,"You are about to change the domain name of this facility","!") +"RTN","TMGCHR",152,0) + DO OUTP^TMGQIO(SILNTOUT,"in the MailMan Site Parameters file.","!") +"RTN","TMGCHR",153,0) + DO OUTP^TMGQIO(SILNTOUT,"Currently, this facility is named: ",XMSITE,"!","!") +"RTN","TMGCHR",154,0) + DO OUTP^TMGQIO(SILNTOUT,"You must be extremely sure before you proceed!","!") +"RTN","TMGCHR",155,0) + DO OUTP^TMGQIO(SILENTIN,"Are you sure you want to change the name of this facility? NO//") +"RTN","TMGCHR",156,0) + DO INP^TMGQIO(.X,SILENTIN,120,$GET(INFO("CONTINUE"))) +"RTN","TMGCHR",157,0) + IF X="" SET X="NO" +"RTN","TMGCHR",158,0) + IF "Yy"[$E(X_"N") SET RESULT=1 ;Yes, I'm sure! +"RTN","TMGCHR",159,0) + Q RESULT +"RTN","TMGCHR",160,0) + ; +"RTN","TMGCHR",161,0) + ; +"RTN","TMGCHR",162,0) +PARENT ; +"RTN","TMGCHR",163,0) + N XMPARENT +"RTN","TMGCHR",164,0) + S XMPARENT=+$G(^XMB("PARENT")) +"RTN","TMGCHR",165,0) + I XMPARENT S XMPARENT=$S($D(^DIC(4.2,XMPARENT,0)):$P(^(0),U),1:0) +"RTN","TMGCHR",166,0) + I XMPARENT'=0 D +"RTN","TMGCHR",167,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!",XMPARENT," has been initialized as your 'parent' domain.") +"RTN","TMGCHR",168,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","(Forum is usually the parent domain, unless this is a subordinate domain.)") +"RTN","TMGCHR",169,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","You may edit the MailMan Site Parameter file to change your parent domain.") +"RTN","TMGCHR",170,0) + E D +"RTN","TMGCHR",171,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!",$C(7),"*** YOUR PARENT DOMAIN HAS NOT BEEN INITIALIZED !!! ***") +"RTN","TMGCHR",172,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","You MUST edit the MailMan Site Parameter file to ENTER your parent domain.") +"RTN","TMGCHR",173,0) + Q +"RTN","TMGCHR",174,0) + ; +"RTN","TMGCHR",175,0) + ; +"RTN","TMGCHR",176,0) +SCRIPT ;RESET AUSTIN SCRIPT +"RTN","TMGCHR",177,0) + ;G SCRIPT^XMYPDOM +"RTN","TMGCHR",178,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","We will not initialize your transmission scripts.") +"RTN","TMGCHR",179,0) + Q +"RTN","TMGCHR",180,0) + ; +"RTN","TMGCHR",181,0) + ; +"RTN","TMGCHR",182,0) + ;======================================================================= +"RTN","TMGCHR",183,0) +Q DO OUTP^TMGQIO(SILNTOUT,"!","!","Use the 'Subroutine editor' option under network management menu to add your") +"RTN","TMGCHR",184,0) + DO OUTP^TMGQIO(SILNTOUT,"!","site passwords to the MINIENGINE script, and the 'Edit a script' option") +"RTN","TMGCHR",185,0) + DO OUTP^TMGQIO(SILNTOUT,"!","to edit any domain scripts that you choose to.") +"RTN","TMGCHR",186,0) + ;D ^XMYPDOM +"RTN","TMGCHR",187,0) + Q +"RTN","TMGCHR",188,0) + ; +"RTN","TMGCHR",189,0) + ; +"RTN","TMGCHR",190,0) + ;====================================================================== +"RTN","TMGCHR",191,0) +PMB S Y=Y+1000 +"RTN","TMGCHR",192,0) + S ^XMB(3.7,.5,2,+Y,1,0)=^TMP("XM",I,1,0) +"RTN","TMGCHR",193,0) + S ^XMB(3.7,.5,2,"B",$E($P(Y(0),U,1),1,30),+Y)="" +"RTN","TMGCHR",194,0) + S ^XMB(3.7,.5,2,+Y,0)=$P(Y(0),U) +"RTN","TMGCHR",195,0) + F J=0:0 DO Q:J'>0 +"RTN","TMGCHR",196,0) + . S J=$O(^TMP("XM",I,1,J)) +"RTN","TMGCHR",197,0) + . Q:J'>0 +"RTN","TMGCHR",198,0) + . S ^XMB(3.7,.5,2,+Y,1,J,0)=J +"RTN","TMGCHR",199,0) + . W "." +"RTN","TMGCHR",200,0) + Q +"RTN","TMGCHR",201,0) + ; +"RTN","TMGCHR",202,0) + ; +"RTN","TMGCHR",203,0) +E DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!") +"RTN","TMGCHR",204,0) + DO OUTP^TMGQIO(SILNTOUT,"There is a FILE INTEGRITY problem in your MailMan Site Parameters file","!") +"RTN","TMGCHR",205,0) + DO OUTP^TMGQIO(SILNTOUT,"There should only be one entry and that entry should be entry number 1.","!") +"RTN","TMGCHR",206,0) +E1 DO OUTP^TMGQIO(SILNTOUT,$C(7),"!") +"RTN","TMGCHR",207,0) + DO OUTP^TMGQIO(SILNTOUT,"Your MailMan site parameters MUST be reviewed.","!") +"RTN","TMGCHR",208,0) +EQ DO OUTP^TMGQIO(SILNTOUT,"Then you can finish the INIT by executing POST^XMYPOST.","!","!") +"RTN","TMGCHR",209,0) + Q +"RTN","TMGCHR",210,0) +E2 DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","You do not yet have an entry in your MailMan Site Parameters File","!") +"RTN","TMGCHR",211,0) + DO OUTP^TMGQIO(SILNTOUT,"Use FileMan to make an entry.","!") +"RTN","TMGCHR",212,0) + G EQ +"RTN","TMGCHR",213,0) + +"RTN","TMGCHR",214,0) + +"RTN","TMGDBAP2") +0^6^B3476 +"RTN","TMGDBAP2",1,0) +TMGDBAP2 ;TMG/kst/Database API library 2 ;03/25/06 +"RTN","TMGDBAP2",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGDBAP2",3,0) + +"RTN","TMGDBAP2",4,0) + +"RTN","TMGDBAP2",5,0) + ;"This module holds moved functions from TMGDBAPI (moved due to size constraints) +"RTN","TMGDBAP2",6,0) + +"RTN","TMGDBAP2",7,0) +ConvertFDA(FDA,MarkerArray) +"RTN","TMGDBAP2",8,0) + ;"Purpose: To convert all the IENS's in a FDA via ConvertIENS +"RTN","TMGDBAP2",9,0) + ;"Input: FDA -- An FDA that need conversion. MUST PASS BY REFERENCE +"RTN","TMGDBAP2",10,0) + ;" Expected FDA is as follows. I.e., expecting that +"RTN","TMGDBAP2",11,0) + ;" there will only be ONE filenumber (the 19.01) part: +"RTN","TMGDBAP2",12,0) + ;" FDA(*) +"RTN","TMGDBAP2",13,0) + ;" }~19.01 +"RTN","TMGDBAP2",14,0) + ;" }~?+4,?+2, +"RTN","TMGDBAP2",15,0) + ;" | }~.01 = DIUSER +"RTN","TMGDBAP2",16,0) + ;" | }~2 = FM2 +"RTN","TMGDBAP2",17,0) + ;" | }~3 = 1 +"RTN","TMGDBAP2",18,0) + ;" | +"RTN","TMGDBAP2",19,0) + ;" }~?+5,?+2, +"RTN","TMGDBAP2",20,0) + ;" | }~.01 = XMMGR +"RTN","TMGDBAP2",21,0) + ;" | }~2 = X2 +"RTN","TMGDBAP2",22,0) + ;" | }~3 = 1 +"RTN","TMGDBAP2",23,0) + ;" | +"RTN","TMGDBAP2",24,0) + ;" }~?+6,?+2, +"RTN","TMGDBAP2",25,0) + ;" }~.01 = DIEDIT +"RTN","TMGDBAP2",26,0) + ;" }~2 = Edit +"RTN","TMGDBAP2",27,0) + ;" }~3 = 2 +"RTN","TMGDBAP2",28,0) + ;" MarkerArray -- see documentation in ConvertIENS +"RTN","TMGDBAP2",29,0) + ;"Output: FDA is changed +"RTN","TMGDBAP2",30,0) + ;"Result: 1=OKToContinue, 0=Abort +"RTN","TMGDBAP2",31,0) + +"RTN","TMGDBAP2",32,0) + +"RTN","TMGDBAP2",33,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",34,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",35,0) + new cAbort set cAbort=0 +"RTN","TMGDBAP2",36,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGDBAP2",37,0) + new cRef set cRef="Ref" +"RTN","TMGDBAP2",38,0) + +"RTN","TMGDBAP2",39,0) + +"RTN","TMGDBAP2",40,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ConvertFDA^TMGDBAPI") +"RTN","TMGDBAP2",41,0) + +"RTN","TMGDBAP2",42,0) + new result set result=1 +"RTN","TMGDBAP2",43,0) + if $data(FDA)=0 set result=0 goto CvFDAQ +"RTN","TMGDBAP2",44,0) + new FileNum +"RTN","TMGDBAP2",45,0) + new Index +"RTN","TMGDBAP2",46,0) + new IENS,OldIENS +"RTN","TMGDBAP2",47,0) + +"RTN","TMGDBAP2",48,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the FDA to convert") +"RTN","TMGDBAP2",49,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("FDA") +"RTN","TMGDBAP2",50,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the MarkerArray") +"RTN","TMGDBAP2",51,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("MarkerArray") +"RTN","TMGDBAP2",52,0) + +"RTN","TMGDBAP2",53,0) + set FileNum=$order(FDA("")) +"RTN","TMGDBAP2",54,0) + if +FileNum=0 set result=0 goto CvFDAQ +"RTN","TMGDBAP2",55,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Looking at filenumber ",FileNum) +"RTN","TMGDBAP2",56,0) + set IENS=$order(FDA(FileNum,"")) +"RTN","TMGDBAP2",57,0) + for do quit:(IENS="") +"RTN","TMGDBAP2",58,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IENS=",IENS) +"RTN","TMGDBAP2",59,0) + . if IENS="" do quit +"RTN","TMGDBAP2",60,0) + . . set result=0 +"RTN","TMGDBAP2",61,0) + . set OldIENS=IENS +"RTN","TMGDBAP2",62,0) + . if $$ConvertIENS(.IENS,.MarkerArray)=0 do quit +"RTN","TMGDBAP2",63,0) + . . set IENS="" +"RTN","TMGDBAP2",64,0) + . . set result=0 +"RTN","TMGDBAP2",65,0) + . if IENS'=OldIENS do +"RTN","TMGDBAP2",66,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Converted to IENS=",IENS) +"RTN","TMGDBAP2",67,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Convert FDA(FileNumber,"""_OldIENS_""") to FDA(Filenumber,"""_IENS_""")") +"RTN","TMGDBAP2",68,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"$data(FDA(FileNum,OLDIENS))=",$data(FDA(FileNum,OldIENS))) +"RTN","TMGDBAP2",69,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is FDA so far") +"RTN","TMGDBAP2",70,0) + . . ;"if TMGDEBUG do ArrayDump^TMGDEBUG("FDA") +"RTN","TMGDBAP2",71,0) + . . merge FDA(FileNum,IENS)=FDA(FileNum,OldIENS) +"RTN","TMGDBAP2",72,0) + . . set IENS=$order(FDA(FileNum,OldIENS)) +"RTN","TMGDBAP2",73,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"killing FDA(FileNumber,"_OldIENS_")") +"RTN","TMGDBAP2",74,0) + . . kill FDA(FileNum,OldIENS) +"RTN","TMGDBAP2",75,0) + . else do +"RTN","TMGDBAP2",76,0) + . . set IENS=$order(FDA(FileNum,OldIENS)) +"RTN","TMGDBAP2",77,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Resulting FDA so far") +"RTN","TMGDBAP2",78,0) + . ;"if TMGDEBUG do ArrayDump^TMGDEBUG("FDA") +"RTN","TMGDBAP2",79,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"-----------------------") +"RTN","TMGDBAP2",80,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"End of cycle. IENS=",IENS) +"RTN","TMGDBAP2",81,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"-----------------------") +"RTN","TMGDBAP2",82,0) + +"RTN","TMGDBAP2",83,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After conversion, here is the FDA.") +"RTN","TMGDBAP2",84,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("FDA") +"RTN","TMGDBAP2",85,0) + +"RTN","TMGDBAP2",86,0) +CvFDAQ +"RTN","TMGDBAP2",87,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ConvertFDA^TMGDBAPI") +"RTN","TMGDBAP2",88,0) + quit result +"RTN","TMGDBAP2",89,0) + +"RTN","TMGDBAP2",90,0) + +"RTN","TMGDBAP2",91,0) +ConvertIENS(IENS,MarkerArray) +"RTN","TMGDBAP2",92,0) + ;"Purpose: to convert an IENS such as "?+4,?+2," into "?+4,12345,", given +"RTN","TMGDBAP2",93,0) + ;" the MarkerArray that corelates "2" to #"12345" +"RTN","TMGDBAP2",94,0) + ;"Input: IENS -- the IENS string to convert. MUST PASS BY REFERENCE +"RTN","TMGDBAP2",95,0) + ;" MarkerArray -- a composite array composed of results returned +"RTN","TMGDBAP2",96,0) + ;" by database server, like below. SHOULD PASS BY REFERENCE +"RTN","TMGDBAP2",97,0) + ;" MarkerArray(*) +"RTN","TMGDBAP2",98,0) + ;" }~2 = 10033 +"RTN","TMGDBAP2",99,0) + ;" }~0 = + +"RTN","TMGDBAP2",100,0) + ;" }~4 = 12345 +"RTN","TMGDBAP2",101,0) + ;" }~0 = + +"RTN","TMGDBAP2",102,0) + ;"Output: IENS will be changed +"RTN","TMGDBAP2",103,0) + ;"Result: 1=OkToContinue, 0=Abort +"RTN","TMGDBAP2",104,0) + +"RTN","TMGDBAP2",105,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",106,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",107,0) + new cAbort set cAbort=0 +"RTN","TMGDBAP2",108,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGDBAP2",109,0) + +"RTN","TMGDBAP2",110,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ConvertIENS^TMGDBAPI") +"RTN","TMGDBAP2",111,0) + +"RTN","TMGDBAP2",112,0) + new result set result=1 +"RTN","TMGDBAP2",113,0) + new S set S="" +"RTN","TMGDBAP2",114,0) + +"RTN","TMGDBAP2",115,0) + if $data(IENS)#10=0 set result=0 goto CvIENSQ +"RTN","TMGDBAP2",116,0) + if $data(MarkerArray)=0 set result=0 goto CvIENSQ +"RTN","TMGDBAP2",117,0) + +"RTN","TMGDBAP2",118,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Initial IENS=",IENS) +"RTN","TMGDBAP2",119,0) + +"RTN","TMGDBAP2",120,0) + new I set I=1 +"RTN","TMGDBAP2",121,0) + for do quit:(I=-1) +"RTN","TMGDBAP2",122,0) + . new Part,RecMarker +"RTN","TMGDBAP2",123,0) + . set Part=$piece(IENS,",",I) +"RTN","TMGDBAP2",124,0) + . ;";"if $get(TMGDEBUG)>0 do DebugWrite^TMGDEBUG(.DBIndent,"Part="_Part_" --> ",0) +"RTN","TMGDBAP2",125,0) + . if Part="" set I=-1 quit +"RTN","TMGDBAP2",126,0) + . set RecMarker=+$translate(Part,"?+","") +"RTN","TMGDBAP2",127,0) + . ;"if $get(TMGDEBUG)>0 do DebugWrite^TMGDEBUG(.DBIndent,"RecMarker="_RecMarker_" --> ",0) +"RTN","TMGDBAP2",128,0) + . new tS set tS=$get(MarkerArray(RecMarker),Part) +"RTN","TMGDBAP2",129,0) + . ;"if $get(TMGDEBUG)>0 do DebugWrite^TMGDEBUG(.DBIndent,"tS="_tS,1) +"RTN","TMGDBAP2",130,0) + . set S=S_tS_"," +"RTN","TMGDBAP2",131,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"S so far=",S) +"RTN","TMGDBAP2",132,0) + . set I=I+1 +"RTN","TMGDBAP2",133,0) + +"RTN","TMGDBAP2",134,0) + set IENS=S +"RTN","TMGDBAP2",135,0) + +"RTN","TMGDBAP2",136,0) +CvIENSQ +"RTN","TMGDBAP2",137,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ConvertIENS^TMGDBAPI") +"RTN","TMGDBAP2",138,0) + quit result +"RTN","TMGDBAP2",139,0) + +"RTN","TMGDBAP2",140,0) + +"RTN","TMGDBAP2",141,0) +SetupFDA(Data,FDA,parentIENS,SrchType,MarkNum,MsgArray,Minimal,RecNum) +"RTN","TMGDBAP2",142,0) + ;"Purpose: to transfer from Data format to FDA format +"RTN","TMGDBAP2",143,0) + ;"Input: Data - Data array should be in format output from GetRInfo +"RTN","TMGDBAP2",144,0) + ;" FDA -- SHOULD BE PASSED BY REFERENCE (to receive results) +"RTN","TMGDBAP2",145,0) + ;" parentIENS -- initial IENS.. the IENS of any PARENT record, or "" if no parent record +"RTN","TMGDBAP2",146,0) + ;" SrchType -- should be "?", "+", or "?+" +"RTN","TMGDBAP2",147,0) + ;" MarkNum -- -- SHOULD BE PASSED BY REFERENCE. A variable to ensure +"RTN","TMGDBAP2",148,0) + ;" "?X" search term always has unique number. On first call, should=0 +"RTN","TMGDBAP2",149,0) + ;" MsgArray -- SHOULD BE PASSED BY REFERENCE. An array that can accept +"RTN","TMGDBAP2",150,0) + ;" messages back from function. +"RTN","TMGDBAP2",151,0) + ;" -- One such type of message is a list of needed hackwrites. +"RTN","TMGDBAP2",152,0) + ;" Format as follows: +"RTN","TMGDBAP2",153,0) + ;" MsgArray(cHack,0,Entries)=2 +"RTN","TMGDBAP2",154,0) + ;" MsgArray(cHack,1)="^VA(;200;?+1;.01;SomeData" +"RTN","TMGDBAP2",155,0) + ;" MsgArray(cHack,1,cFlags)="H" +"RTN","TMGDBAP2",156,0) + ;" MsgArray(cHack,2)="^VA(;200;?+1;.02;SomeMoreData" +"RTN","TMGDBAP2",157,0) + ;" MsgArray(cHack,2,cFlags)="H" +"RTN","TMGDBAP2",158,0) + ;" i.e. MsgArray(cHack,0,Entries)=Number of Entries +"RTN","TMGDBAP2",159,0) + ;" MsgArray(cHack,n) = Global;FileNumber;IENS;FieldNum;Data +"RTN","TMGDBAP2",160,0) + ;" MsgArray(n,cFlags)=User specified Flags for field. +"RTN","TMGDBAP2",161,0) + ;" -- MsgArray(cRef,SubFileNumber)=Reference to Part of Data that created this. +"RTN","TMGDBAP2",162,0) + ;" MsgArray(*) +"RTN","TMGDBAP2",163,0) + ;" }~cRef +"RTN","TMGDBAP2",164,0) + ;" }~1234.21 = "Data(6,".07") +"RTN","TMGDBAP2",165,0) + ;" }~1234.2101 = "Data(6,".07",2,".04") +"RTN","TMGDBAP2",166,0) + ;" Minimal -- OPTIONAL. 1=fill only .01 fields and subfile .01 fields +"RTN","TMGDBAP2",167,0) + ;" RecNum -- OPTIONAL. If FDA is to be setup such that data is put into +"RTN","TMGDBAP2",168,0) + ;" a specified record number, put that number here. +"RTN","TMGDBAP2",169,0) + ;" !!! Note: I believe this is used erroneously here. A record number +"RTN","TMGDBAP2",170,0) + ;" is not specified in the FDA. For calls to UPDATE^DIE to a specific +"RTN","TMGDBAP2",171,0) + ;" record number, the FDA should have an IENS that is like "+1,", and then +"RTN","TMGDBAP2",172,0) + ;" put the desired record number into the IEN_ROOT, like TMGIEN(1)=1234 +"RTN","TMGDBAP2",173,0) + ;" with the "1" matching the "1" in TMGIEN(1) +"RTN","TMGDBAP2",174,0) + ;"Output: FDA is changed if passed by reference. +"RTN","TMGDBAP2",175,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGDBAP2",176,0) + +"RTN","TMGDBAP2",177,0) + ;"Note: input Data array will be formated like this: +"RTN","TMGDBAP2",178,0) + ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGDBAP2",179,0) + ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200," +"RTN","TMGDBAP2",180,0) + ;" Data(0,cRecNum)=2 <-- only if user-specified. +"RTN","TMGDBAP2",181,0) + ;" Data(0,cEntries)=1 +"RTN","TMGDBAP2",182,0) + ;" Data(1,".01")="MyData1" +"RTN","TMGDBAP2",183,0) + ;" Data(1,".01",cMatchValue)="MyData1" +"RTN","TMGDBAP2",184,0) + ;" Data(1,".02")="Bill" +"RTN","TMGDBAP2",185,0) + ;" Data(1,".02",cMatchValue)="John" +"RTN","TMGDBAP2",186,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGDBAP2",187,0) + ;" Data(1,".04")="MyData4" +"RTN","TMGDBAP2",188,0) + ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06" +"RTN","TMGDBAP2",189,0) + ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07" +"RTN","TMGDBAP2",190,0) + ;" Data(1,".07",1,".01")="SubEntry1" +"RTN","TMGDBAP2",191,0) + ;" Data(1,".07",1,".02")="SE1" +"RTN","TMGDBAP2",192,0) + ;" Data(1,".07",1,".03")="'Some Info'" +"RTN","TMGDBAP2",193,0) + ;" Data(1,".07",2,".01")="SubEntry2" +"RTN","TMGDBAP2",194,0) + ;" Data(1,".07",2,".02")="SE2" +"RTN","TMGDBAP2",195,0) + ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04 +"RTN","TMGDBAP2",196,0) + ;" Data(1,".07",2,".04",1,".01")="JD" +"RTN","TMGDBAP2",197,0) + ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGDBAP2",198,0) + ;" ADDENDUM +"RTN","TMGDBAP2",199,0) + ;" Data(1,".01",cFlags)=any flags specified for given field. +"RTN","TMGDBAP2",200,0) + ;" only present if user specified. +"RTN","TMGDBAP2",201,0) + +"RTN","TMGDBAP2",202,0) + ;"Resulting FDA will look like this. +"RTN","TMGDBAP2",203,0) + ;" i.e. FDA(1234,"?+1,10024,",.01)="MyData1" +"RTN","TMGDBAP2",204,0) + ;" i.e. FDA(1234,"?+1,10024,",.02)="Bill" +"RTN","TMGDBAP2",205,0) + ;" i.e. FDA(1234,"?+1,10024,",.03)="MyData3" +"RTN","TMGDBAP2",206,0) + ;" i.e. FDA(1234,"?+1,10024,",.04)="MyData4" +"RTN","TMGDBAP2",207,0) + ;" i.e. FDA(1234,"?+1,10024,",.06)="MyData5" +"RTN","TMGDBAP2",208,0) + ;" i.e. FDA(1234.21,"?+2,?+1,10024,",.01)="SubEntry1" +"RTN","TMGDBAP2",209,0) + ;" i.e. FDA(1234.21,"?+2,?+1,10024,",.02)="SE1" +"RTN","TMGDBAP2",210,0) + ;" i.e. FDA(1234.21,"?+2,?+1,10024,",.03)="'Some Info'" +"RTN","TMGDBAP2",211,0) + ;" i.e. FDA(1234.21,"?+3,?+1,10024,",.01)="SubEntry2" +"RTN","TMGDBAP2",212,0) + ;" i.e. FDA(1234.21,"?+3,?+1,10024,",.02)="SE2" +"RTN","TMGDBAP2",213,0) + ;" i.e. FDA(1234.21,"?+3,?+1,10024,",.03)="'Some Info'" +"RTN","TMGDBAP2",214,0) + ;" i.e. FDA(1234.2101,"?+4,?+3,?+1,10024,",.01)="JD" +"RTN","TMGDBAP2",215,0) + ;" i.e. FDA(1234.2101,"?+4,?+3,?+1,10024,",.02)="DOE,JOHN" +"RTN","TMGDBAP2",216,0) + ;"(OR... reformat of above) +"RTN","TMGDBAP2",217,0) + ;" FDA(*) +"RTN","TMGDBAP2",218,0) + ;" }~1234 +"RTN","TMGDBAP2",219,0) + ;" }~?+1,10024 +"RTN","TMGDBAP2",220,0) + ;" }~.01 = MyData1 +"RTN","TMGDBAP2",221,0) + ;" }~.02 = Bill +"RTN","TMGDBAP2",222,0) + ;" }~.03 = MyData3 +"RTN","TMGDBAP2",223,0) + ;" }~.04 = MyData4 +"RTN","TMGDBAP2",224,0) + ;" }~.06 = MyData5 +"RTN","TMGDBAP2",225,0) + ;" }~1234.21 +"RTN","TMGDBAP2",226,0) + ;" }~?+2,?+1,10024 +"RTN","TMGDBAP2",227,0) + ;" }~.01 = SubEntry1 +"RTN","TMGDBAP2",228,0) + ;" }~.02 = SE1 +"RTN","TMGDBAP2",229,0) + ;" }~.03 = 'Some Info' +"RTN","TMGDBAP2",230,0) + ;" }~?+3,?+1,10024 +"RTN","TMGDBAP2",231,0) + ;" }~.01 = SubEntry2 +"RTN","TMGDBAP2",232,0) + ;" }~.02 = SE2 +"RTN","TMGDBAP2",233,0) + ;" }~.03 = 'Some Info' +"RTN","TMGDBAP2",234,0) + ;" }~1234.2101 +"RTN","TMGDBAP2",235,0) + ;" }~?+4,?+3,?+1,10024 +"RTN","TMGDBAP2",236,0) + ;" }~.01 = JD +"RTN","TMGDBAP2",237,0) + ;" }~.02 = DOE,JOHN +"RTN","TMGDBAP2",238,0) + +"RTN","TMGDBAP2",239,0) + ;"MsgArray will hold the following +"RTN","TMGDBAP2",240,0) + ;" MsgArray(*) +"RTN","TMGDBAP2",241,0) + ;" }~"H" +"RTN","TMGDBAP2",242,0) + ;" }~"Ref" +"RTN","TMGDBAP2",243,0) + ;" }~1234.21 = "Data(6,".07") +"RTN","TMGDBAP2",244,0) + ;" }~1234.2101 = "Data(6,".07",2,".04") +"RTN","TMGDBAP2",245,0) + +"RTN","TMGDBAP2",246,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",247,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",248,0) + new cAbort set cAbort=0 +"RTN","TMGDBAP2",249,0) + new cFile set cFile="FILE" ;"File" +"RTN","TMGDBAP2",250,0) + new cHack set cHack="H" +"RTN","TMGDBAP2",251,0) + new cFlags set cFlags="FLAGS" ;"Flags" +"RTN","TMGDBAP2",252,0) + new cEntries set cEntries="Entries" +"RTN","TMGDBAP2",253,0) + new cNoOverwrite set cNoOverwrite="N" +"RTN","TMGDBAP2",254,0) + +"RTN","TMGDBAP2",255,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SetupFDA^TMGDBAPI") +"RTN","TMGDBAP2",256,0) + +"RTN","TMGDBAP2",257,0) + new result set result=cOKToCont +"RTN","TMGDBAP2",258,0) + new index +"RTN","TMGDBAP2",259,0) + new FieldNum +"RTN","TMGDBAP2",260,0) + new FileNumber +"RTN","TMGDBAP2",261,0) + new SubMarkNum set SubMarkNum=0 +"RTN","TMGDBAP2",262,0) + new IENS set IENS="" +"RTN","TMGDBAP2",263,0) + if $get(RecNum)="" kill RecNum +"RTN","TMGDBAP2",264,0) + +"RTN","TMGDBAP2",265,0) + set FileNumber=$get(Data(0,cFile)) +"RTN","TMGDBAP2",266,0) + if +FileNumber=0 goto SFDAQ +"RTN","TMGDBAP2",267,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNumber=",FileNumber) +"RTN","TMGDBAP2",268,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"parentIENS=",parentIENS) +"RTN","TMGDBAP2",269,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"SrchType=",SrchType) +"RTN","TMGDBAP2",270,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNum=",$get(RecNum)) +"RTN","TMGDBAP2",271,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the Data array to work with:") +"RTN","TMGDBAP2",272,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("Data") +"RTN","TMGDBAP2",273,0) + +"RTN","TMGDBAP2",274,0) + set index=$order(Data(0)) +"RTN","TMGDBAP2",275,0) + ;"Cycle through all entries (i.e. 1, 2, 3) +"RTN","TMGDBAP2",276,0) + for do quit:(index="")!(result=cAbort) +"RTN","TMGDBAP2",277,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"index=",index) +"RTN","TMGDBAP2",278,0) + . set FieldNum=$order(Data(index,"")) +"RTN","TMGDBAP2",279,0) + . ;"Cycle through all fields (i.e. .01, .02, ,1223) +"RTN","TMGDBAP2",280,0) + . for do quit:(FieldNum="")!(result=cAbort) +"RTN","TMGDBAP2",281,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum=",FieldNum) +"RTN","TMGDBAP2",282,0) + . . new NextFieldNum set NextFieldNum=$order(Data(index,FieldNum)) +"RTN","TMGDBAP2",283,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"NextFieldNum=",NextFieldNum) +"RTN","TMGDBAP2",284,0) + . . if ($get(Data(index,FieldNum,cFlags))[cNoOverwrite)&(SrchType["?") do quit +"RTN","TMGDBAP2",285,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"m0") +"RTN","TMGDBAP2",286,0) + . . . set FieldNum=NextFieldNum +"RTN","TMGDBAP2",287,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"NoOverwrite flag found, ignoring current field.") +"RTN","TMGDBAP2",288,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"m1") +"RTN","TMGDBAP2",289,0) + . . if (FieldNum=.01)!(IENS="") do +"RTN","TMGDBAP2",290,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"m2") +"RTN","TMGDBAP2",291,0) + . . . if $data(RecNum)#10=0 do +"RTN","TMGDBAP2",292,0) + . . . . set MarkNum=+$get(MarkNum)+1 +"RTN","TMGDBAP2",293,0) + . . . . set IENS=SrchType_MarkNum_","_$get(parentIENS) +"RTN","TMGDBAP2",294,0) + . . . else do +"RTN","TMGDBAP2",295,0) + . . . . set IENS=$get(RecNum)_","_$get(parentIENS) +"RTN","TMGDBAP2",296,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IENS=",IENS) +"RTN","TMGDBAP2",297,0) + . . if $get(Data(index,FieldNum,cFlags))[cHack do ;"HACK PROCESSING +"RTN","TMGDBAP2",298,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Hack Processing") +"RTN","TMGDBAP2",299,0) + . . . ;"Load hacks into a message array for later processing +"RTN","TMGDBAP2",300,0) + . . . new NumHacks set NumHacks=$get(MsgArray(cHack,0,cEntries))+1 +"RTN","TMGDBAP2",301,0) + . . . new Entry set Entry=Data(index,FieldNum) +"RTN","TMGDBAP2",302,0) + . . . if $get(Data(index,FieldNum,cFlags))[cEncrypt do +"RTN","TMGDBAP2",303,0) + . . . . set Entry=$$EN^XUSHSH(Entry) ;"encrypt data +"RTN","TMGDBAP2",304,0) + . . . new Global set Global=$get(Data(0,cFile,cGlobal)) +"RTN","TMGDBAP2",305,0) + . . . if Global="" do quit +"RTN","TMGDBAP2",306,0) + . . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to local global name for file") +"RTN","TMGDBAP2",307,0) + . . . . set result=cAbort +"RTN","TMGDBAP2",308,0) + . . . set MsgArray(cHack,NumHacks)=Global_";"_FileNumber_";"_IENS_";"_FieldNum_";"_Entry +"RTN","TMGDBAP2",309,0) + . . . set MsgArray(cHack,NumHacks,cFlags)=Data(index,FieldNum,cFlags) +"RTN","TMGDBAP2",310,0) + . . else if $data(Data(index,FieldNum,0,cEntries)) do ;"SUB-FILE PROCESSING +"RTN","TMGDBAP2",311,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Sub-file processing") +"RTN","TMGDBAP2",312,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Addition of subfile entries encountered.") +"RTN","TMGDBAP2",313,0) + . . . new tempData merge tempData=Data(index,FieldNum) +"RTN","TMGDBAP2",314,0) + . . . new SubFileNum set SubFileNum=$get(Data(index,FieldNum,0,cFile),0) +"RTN","TMGDBAP2",315,0) + . . . set MsgArray(cRef,SubFileNum)=$name(Data(index,FieldNum)) +"RTN","TMGDBAP2",316,0) + . . . ;"call self recursively to handle subfile. +"RTN","TMGDBAP2",317,0) + . . . new SubMarkNum set SubMarkNum=MarkNum +"RTN","TMGDBAP2",318,0) + . . . set result=$$SetupFDA(.tempData,.FDA,IENS,SrchType,.SubMarkNum,.MsgArray,.Minimal) +"RTN","TMGDBAP2",319,0) + . . . if SubMarkNum>MarkNum set MarkNum=SubMarkNum +"RTN","TMGDBAP2",320,0) + . . else do ;"THE-USUAL-CASE PROCESSING +"RTN","TMGDBAP2",321,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Processing usual case") +"RTN","TMGDBAP2",322,0) + . . . if (FieldNum=.01)!($get(Minimal)'=1) do +"RTN","TMGDBAP2",323,0) + . . . . new ts set ts="Setting: FDA("_FileNumber_","""_IENS_""","_FieldNum_")="_$get(Data(index,FieldNum)) +"RTN","TMGDBAP2",324,0) + . . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ts=",ts) +"RTN","TMGDBAP2",325,0) + . . . . set FDA(FileNumber,IENS,FieldNum)=$get(Data(index,FieldNum)) +"RTN","TMGDBAP2",326,0) + . . . if $data(Data(index,FieldNum,"WP")) do +"RTN","TMGDBAP2",327,0) + . . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Detected word-processor field") +"RTN","TMGDBAP2",328,0) + . . . . merge FDA(FileNumber,IENS,FieldNum,"WP")=Data(index,FieldNum,"WP") +"RTN","TMGDBAP2",329,0) + . . . . ;"if $get(TMGDEBUG)>0 do +"RTN","TMGDBAP2",330,0) + . . . . ;". new ts set ts="Setting: FDA("_FileNumber_","""_IENS_""","_FieldNum_")=" +"RTN","TMGDBAP2",331,0) + . . . . ;". ;"NOTE: the "TMGFDA" MUST!! match the FDA name passed to UPDATE^DIE, FILE^DIE +"RTN","TMGDBAP2",332,0) + . . . . ;". set ts=ts_$name(TMGFDA(FileNumber,IENS,FieldNum,"WP")) +"RTN","TMGDBAP2",333,0) + . . . . ;". do DebugMsg^TMGDEBUG(.DBIndent,ts) +"RTN","TMGDBAP2",334,0) + . . . . ;"NOTE: the "TMGFDA" MUST!! match the FDA name passed to UPDATE^DIE, FILE^DIE +"RTN","TMGDBAP2",335,0) + . . . . set FDA(FileNumber,IENS,FieldNum)=$name(TMGFDA(FileNumber,IENS,FieldNum,"WP")) +"RTN","TMGDBAP2",336,0) + . . set FieldNum=NextFieldNum +"RTN","TMGDBAP2",337,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"End of field loop") +"RTN","TMGDBAP2",338,0) + . set index=$order(Data(index)) +"RTN","TMGDBAP2",339,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"End of index loop") +"RTN","TMGDBAP2",340,0) + +"RTN","TMGDBAP2",341,0) +SFDAQ +"RTN","TMGDBAP2",342,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is resulting FDA") +"RTN","TMGDBAP2",343,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("FDA") ;"zwr FDA(*) +"RTN","TMGDBAP2",344,0) + +"RTN","TMGDBAP2",345,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SetupFDA^TMGDBAPI") +"RTN","TMGDBAP2",346,0) + quit result +"RTN","TMGDBAP2",347,0) + +"RTN","TMGDBAP2",348,0) + +"RTN","TMGDBAP2",349,0) + +"RTN","TMGDBAP2",350,0) +OverwriteRec(RecNum,Data) +"RTN","TMGDBAP2",351,0) + ;"Purpose: To stuff data from data array into record specified by RecNum. +"RTN","TMGDBAP2",352,0) + ;" This function will not directly put any data into subfiles, but will +"RTN","TMGDBAP2",353,0) + ;" call UploadData to handle this. +"RTN","TMGDBAP2",354,0) + ;"Input: RecNum -- the record number (as returned by GetRecMatch) to put data into +"RTN","TMGDBAP2",355,0) + ;" Data - Should be in format output from GetRInfo +"RTN","TMGDBAP2",356,0) + ;"Output: database will be modified by changing record +"RTN","TMGDBAP2",357,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGDBAP2",358,0) + +"RTN","TMGDBAP2",359,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",360,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",361,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGDBAP2",362,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGDBAP2",363,0) + +"RTN","TMGDBAP2",364,0) + new result set result=cOKToCont +"RTN","TMGDBAP2",365,0) + new Flags +"RTN","TMGDBAP2",366,0) + new FileNumber,FieldNum,SubFileNum +"RTN","TMGDBAP2",367,0) + new FieldFlags +"RTN","TMGDBAP2",368,0) + new tmgFDA,TMGFDA,TMGMsg +"RTN","TMGDBAP2",369,0) + new index +"RTN","TMGDBAP2",370,0) + new IENS set IENS=$get(Data(0,cParentIENS)) +"RTN","TMGDBAP2",371,0) + new FDAIndex +"RTN","TMGDBAP2",372,0) + new MarkerArray +"RTN","TMGDBAP2",373,0) + new MsgArray +"RTN","TMGDBAP2",374,0) + +"RTN","TMGDBAP2",375,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"OverwriteRec^TMGDBAPI") +"RTN","TMGDBAP2",376,0) + if $get(RecNum)=0 set result=cAbort goto OWQuit +"RTN","TMGDBAP2",377,0) + +"RTN","TMGDBAP2",378,0) + set FileNumber=Data(0,cFile) +"RTN","TMGDBAP2",379,0) + set Flags="KE" ;"E=External format values; K=Func locks file during use. +"RTN","TMGDBAP2",380,0) + +"RTN","TMGDBAP2",381,0) + set IENS=$get(Data(0,cParentIENS)) +"RTN","TMGDBAP2",382,0) + +"RTN","TMGDBAP2",383,0) + new MarkNum set MarkNum=0 +"RTN","TMGDBAP2",384,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNum=",RecNum) +"RTN","TMGDBAP2",385,0) + +"RTN","TMGDBAP2",386,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Data") +"RTN","TMGDBAP2",387,0) + +"RTN","TMGDBAP2",388,0) + set result=$$SetupFDA(.Data,.tmgFDA,IENS,"?",.MarkNum,.MsgArray,0,RecNum) +"RTN","TMGDBAP2",389,0) + if result=cAbort goto OWQuit +"RTN","TMGDBAP2",390,0) + set FileNum=$get(Data(0,cFile),0) if FileNum=0 set result=cAbort goto OWQuit +"RTN","TMGDBAP2",391,0) + +"RTN","TMGDBAP2",392,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master MsgArray") +"RTN","TMGDBAP2",393,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("MsgArray") +"RTN","TMGDBAP2",394,0) + +"RTN","TMGDBAP2",395,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master tmgFDA") +"RTN","TMGDBAP2",396,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("tmgFDA") ;"zwr tmgFDA(*) +"RTN","TMGDBAP2",397,0) + +"RTN","TMGDBAP2",398,0) + if $data(tmgFDA)=0 do goto OWPast ;"This can happen with single records with NoOverwrite flag +"RTN","TMGDBAP2",399,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No data to file with fileman, so skipping.") +"RTN","TMGDBAP2",400,0) + +"RTN","TMGDBAP2",401,0) + set FDAIndex=FileNum +"RTN","TMGDBAP2",402,0) + kill TMGFDA +"RTN","TMGDBAP2",403,0) + merge TMGFDA(FDAIndex)=tmgFDA(FDAIndex) +"RTN","TMGDBAP2",404,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Processing "_FDAIndex_" part of tmgFDA") +"RTN","TMGDBAP2",405,0) + ; +"RTN","TMGDBAP2",406,0) + set Flags="E" ;"E=External format values +"RTN","TMGDBAP2",407,0) + ; +"RTN","TMGDBAP2",408,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the TMGFDA to pass to FILE^DIE") +"RTN","TMGDBAP2",409,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGFDA") ;"zwr TMGFDA(*) +"RTN","TMGDBAP2",410,0) + ; +"RTN","TMGDBAP2",411,0) + ;"====================================================== +"RTN","TMGDBAP2",412,0) + ;"Call FILE^DIE +"RTN","TMGDBAP2",413,0) + ;"====================================================== +"RTN","TMGDBAP2",414,0) + if $data(TMGFDA)=0 set result=cAbort quit +"RTN","TMGDBAP2",415,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"TMGDBAPI::FILE^DIE") +"RTN","TMGDBAP2",416,0) + do +"RTN","TMGDBAP2",417,0) + . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGDBAP2",418,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Remember, FILE^DIE is for working with records that already exist.") +"RTN","TMGDBAP2",419,0) + . set ^TMP("TMG",$J,"ErrorTrap")=result +"RTN","TMGDBAP2",420,0) + . set ^TMP("TMG",$J,"Caller")="FILE^DIE" +"RTN","TMGDBAP2",421,0) + . do FILE^DIE(Flags,"TMGFDA","TMGMsg") +"RTN","TMGDBAP2",422,0) + . set result=^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",423,0) + . kill ^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",424,0) + . kill ^TMP("TMG",$J,"Caller") +"RTN","TMGDBAP2",425,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::FILE^DIE") +"RTN","TMGDBAP2",426,0) + ;"====================================================== +"RTN","TMGDBAP2",427,0) + ;"====================================================== +"RTN","TMGDBAP2",428,0) + ;" +"RTN","TMGDBAP2",429,0) + if $data(TMGMsg("DIERR")) do goto OWQuit +"RTN","TMGDBAP2",430,0) + . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAP2",431,0) + . set result=cAbort +"RTN","TMGDBAP2",432,0) + +"RTN","TMGDBAP2",433,0) + if result=cAbort goto OWQuit +"RTN","TMGDBAP2",434,0) + +"RTN","TMGDBAP2",435,0) + kill tmgFDA(FDAIndex) +"RTN","TMGDBAP2",436,0) + set FDAIndex="" ;"I don't want to loop through rest of tmgFDA, will handle below. +"RTN","TMGDBAP2",437,0) + +"RTN","TMGDBAP2",438,0) +OWPast +"RTN","TMGDBAP2",439,0) + set result=$$HandleHacksArray^TMGDBAPI(.MsgArray) +"RTN","TMGDBAP2",440,0) + if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Error in writing record") goto OWQuit +"RTN","TMGDBAP2",441,0) + +"RTN","TMGDBAP2",442,0) + ;"Now we handle possible subfile entries. Info regarding these is in MsgArray +"RTN","TMGDBAP2",443,0) + if $data(MsgArray(cRef))'=0 do +"RTN","TMGDBAP2",444,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Handling subfile entries.") +"RTN","TMGDBAP2",445,0) + . set SubFileNum=$order(MsgArray(cRef,"")) +"RTN","TMGDBAP2",446,0) + . for do quit:(+SubFileNum=0)!(result=cAbort) +"RTN","TMGDBAP2",447,0) + . . if +SubFileNum=0 quit +"RTN","TMGDBAP2",448,0) + . . new SubData,DataP +"RTN","TMGDBAP2",449,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"SubFileNum="_SubFileNum) +"RTN","TMGDBAP2",450,0) + . . set DataP=MsgArray(cRef,SubFileNum) +"RTN","TMGDBAP2",451,0) + . . merge SubData=@DataP +"RTN","TMGDBAP2",452,0) + . . set SubData(0,cParentIENS)=RecNum_","_IENS +"RTN","TMGDBAP2",453,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Sub IENS="_RecNum_","_IENS) +"RTN","TMGDBAP2",454,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DataP="_DataP) +"RTN","TMGDBAP2",455,0) + . . set result=$$UploadData^TMGDBAPI(.SubData) +"RTN","TMGDBAP2",456,0) + . . set SubFileNum=$order(MsgArray(cRef,SubFileNum)) +"RTN","TMGDBAP2",457,0) + +"RTN","TMGDBAP2",458,0) +OWQuit +"RTN","TMGDBAP2",459,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"OverwriteRec^TMGDBAPI") +"RTN","TMGDBAP2",460,0) + quit result +"RTN","TMGDBAP2",461,0) + +"RTN","TMGDBAP2",462,0) + +"RTN","TMGDBAP2",463,0) +GetFileNum(FileName) +"RTN","TMGDBAP2",464,0) + ;"Purpose: Convert a file name into a file number +"RTN","TMGDBAP2",465,0) + ;"Input: The name of a file +"RTN","TMGDBAP2",466,0) + ;"Result: The filenumber, or 0 if not found. +"RTN","TMGDBAP2",467,0) + +"RTN","TMGDBAP2",468,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFileNum^TMGDBAPI") +"RTN","TMGDBAP2",469,0) + new result set result=0 +"RTN","TMGDBAP2",470,0) + +"RTN","TMGDBAP2",471,0) + if $get(FileName)="" goto GtFlNumDone +"RTN","TMGDBAP2",472,0) + +"RTN","TMGDBAP2",473,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"File Name='"_FileName_"'") +"RTN","TMGDBAP2",474,0) + +"RTN","TMGDBAP2",475,0) + if FileName=" " do goto GtFlNumDone +"RTN","TMGDBAP2",476,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No file specifier (either name or number) given!") +"RTN","TMGDBAP2",477,0) + . set result=0 +"RTN","TMGDBAP2",478,0) + +"RTN","TMGDBAP2",479,0) + set DIC=1 ;"File 1=Global file reference (the file listing info for all files) +"RTN","TMGDBAP2",480,0) + set DIC(0)="M" +"RTN","TMGDBAP2",481,0) + set X=FileName ;"i.e. "AGENCY" +"RTN","TMGDBAP2",482,0) + do ^DIC ;"lookup filename Result comes back in Y ... i.e. "4.11^AGENCY" +"RTN","TMGDBAP2",483,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"lookup for filename '"_FileName_"' ==> "_Y) +"RTN","TMGDBAP2",484,0) + set result=$piece(Y,"^",1) +"RTN","TMGDBAP2",485,0) + if result=-1 set result=0 +"RTN","TMGDBAP2",486,0) + +"RTN","TMGDBAP2",487,0) +GtFlNumDone +"RTN","TMGDBAP2",488,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFileNum^TMGDBAPI") +"RTN","TMGDBAP2",489,0) + quit result +"RTN","TMGDBAP2",490,0) + +"RTN","TMGDBAP2",491,0) + +"RTN","TMGDBAP2",492,0) +GetFName(FileNumber) +"RTN","TMGDBAP2",493,0) + ;"Purpose: Convert a file number into a file name +"RTN","TMGDBAP2",494,0) + ;"Input: The number of a file +"RTN","TMGDBAP2",495,0) + ;"Result: The file name, or "" if not found. +"RTN","TMGDBAP2",496,0) + +"RTN","TMGDBAP2",497,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFileName^TMGDBAPI") +"RTN","TMGDBAP2",498,0) + new result set result="" +"RTN","TMGDBAP2",499,0) + +"RTN","TMGDBAP2",500,0) + if $get(FileNumber)=0 goto GtFlNumDone +"RTN","TMGDBAP2",501,0) + +"RTN","TMGDBAP2",502,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"File Number='"_FileNumber_"'") +"RTN","TMGDBAP2",503,0) + +"RTN","TMGDBAP2",504,0) + set result=$get(^DIC(FileNumber,0)) +"RTN","TMGDBAP2",505,0) + if (result="")&(FileNumber[".") do +"RTN","TMGDBAP2",506,0) + . set result=$get(^DD(FileNumber,0)) +"RTN","TMGDBAP2",507,0) + set result=$piece(result,"^",1) +"RTN","TMGDBAP2",508,0) + +"RTN","TMGDBAP2",509,0) +GtFNmDone +"RTN","TMGDBAP2",510,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFileName^TMGDBAPI") +"RTN","TMGDBAP2",511,0) + quit result +"RTN","TMGDBAP2",512,0) + +"RTN","TMGDBAP2",513,0) + +"RTN","TMGDBAP2",514,0) +GetFldName(File,FieldNumber) +"RTN","TMGDBAP2",515,0) + ;"Purpose: Convert a field number into a field name +"RTN","TMGDBAP2",516,0) + ;"Input: File -- name or number of file +"RTN","TMGDBAP2",517,0) + ;" FieldNumber -- the number of the field to convert +"RTN","TMGDBAP2",518,0) + ;"Result: The field name, or "" if not found. +"RTN","TMGDBAP2",519,0) + +"RTN","TMGDBAP2",520,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFldName^TMGDBAPI") +"RTN","TMGDBAP2",521,0) + new result set result="" +"RTN","TMGDBAP2",522,0) + new array +"RTN","TMGDBAP2",523,0) + do GetFieldInfo^TMGDBAPI(.File,.FieldNumber,"array","LABEL") +"RTN","TMGDBAP2",524,0) + set result=$get(array("LABEL")) +"RTN","TMGDBAP2",525,0) + +"RTN","TMGDBAP2",526,0) +GFldNmDone +"RTN","TMGDBAP2",527,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFldName^TMGDBAPI") +"RTN","TMGDBAP2",528,0) + quit result +"RTN","TMGDBAP2",529,0) + +"RTN","TMGDBAP2",530,0) + +"RTN","TMGDBAP2",531,0) +GetFldList(File,pArray) +"RTN","TMGDBAP2",532,0) + ;"Purpose: Get list of all fields for a file. +"RTN","TMGDBAP2",533,0) + ;"Input: File -- File name or number to look query. May be a sub file number +"RTN","TMGDBAP2",534,0) + ;" pArray -- pointer to (i.e. name of) array to put data into +"RTN","TMGDBAP2",535,0) + ;" Any preexisting data in pArray will be killed. +"RTN","TMGDBAP2",536,0) + ;"Output: Array will be fille with info like this: +"RTN","TMGDBAP2",537,0) + ;" example: Array(.01)=""<--- shows that field .01 exists +"RTN","TMGDBAP2",538,0) + ;" Array(1)="" <--- shows that field 1 exists +"RTN","TMGDBAP2",539,0) + ;" Array(2)="" <--- shows that field 2 exists +"RTN","TMGDBAP2",540,0) + ;"Results: 1=OK to continue. 0=error +"RTN","TMGDBAP2",541,0) + +"RTN","TMGDBAP2",542,0) + new result set result=1 +"RTN","TMGDBAP2",543,0) + new FileNumber,FileName +"RTN","TMGDBAP2",544,0) + if ($get(File)="")!($get(pArray)="") set result=0 goto GFdLDone +"RTN","TMGDBAP2",545,0) + kill @pArray +"RTN","TMGDBAP2",546,0) + +"RTN","TMGDBAP2",547,0) + if +File=File do +"RTN","TMGDBAP2",548,0) + . set FileNumber=File +"RTN","TMGDBAP2",549,0) + . set FileName=$$GetFName(File) +"RTN","TMGDBAP2",550,0) + else do +"RTN","TMGDBAP2",551,0) + . set FileName=File +"RTN","TMGDBAP2",552,0) + . set FileNumber=$$GetFileNum(File) +"RTN","TMGDBAP2",553,0) + if FileNumber'>0 do goto GFdLDone +"RTN","TMGDBAP2",554,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGDBAP2",555,0) + . set result=0 +"RTN","TMGDBAP2",556,0) + +"RTN","TMGDBAP2",557,0) + new index set index=$order(^DD(FileNumber,0)) +"RTN","TMGDBAP2",558,0) + if +index>0 for do quit:(+index'>0) +"RTN","TMGDBAP2",559,0) + . set @pArray@(index)="" +"RTN","TMGDBAP2",560,0) + . set index=$order(^DD(FileNumber,index)) +"RTN","TMGDBAP2",561,0) + +"RTN","TMGDBAP2",562,0) +GFdLDone +"RTN","TMGDBAP2",563,0) + quit result +"RTN","TMGDBAP2",564,0) + +"RTN","TMGDBAP2",565,0) + +"RTN","TMGDBAP2",566,0) +SetupFileNum(Data) +"RTN","TMGDBAP2",567,0) + ;"Purpose: To Ensure that Data(0,cFile) contains valid file number +"RTN","TMGDBAP2",568,0) + ;"Input: Data-- should be passed by reference, Array setup by GetRInfo +"RTN","TMGDBAP2",569,0) + ;" Specifically, Data(0,cFile) should have file name OR number +"RTN","TMGDBAP2",570,0) + ;"Output: Data is changed: +"RTN","TMGDBAP2",571,0) + ;" Data(0,cFile)=FileNumber +"RTN","TMGDBAP2",572,0) + ;" Data(0,cFile,cGlobal)=Global reference name ;i.e. "^VA(200)" +"RTN","TMGDBAP2",573,0) + ;" Data(0,cFile,cGlobal,cOpen)=Open Global reference name ;i.e. "^VA(200," +"RTN","TMGDBAP2",574,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGDBAP2",575,0) + +"RTN","TMGDBAP2",576,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",577,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",578,0) + new cAbort set cAbort=0 +"RTN","TMGDBAP2",579,0) + new cFile set cFile="FILE" ;"File" +"RTN","TMGDBAP2",580,0) + new cGlobal set cGlobal="GLOBAL" +"RTN","TMGDBAP2",581,0) + new cOpen set cOpen="OPEN" +"RTN","TMGDBAP2",582,0) + +"RTN","TMGDBAP2",583,0) + new result set result=cOKToCont +"RTN","TMGDBAP2",584,0) + new FileNumber,FileName,File +"RTN","TMGDBAP2",585,0) + +"RTN","TMGDBAP2",586,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SetupFileNum^TMGDBAPI") +"RTN","TMGDBAP2",587,0) + +"RTN","TMGDBAP2",588,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is Data passed to SetupFileNum") +"RTN","TMGDBAP2",589,0) + ;"if TMGDEBUG do ArrayDump^TMGDEBUG("Data") ;"zwr Data(*) +"RTN","TMGDBAP2",590,0) + +"RTN","TMGDBAP2",591,0) + set File=$get(Data(0,cFile)," ") +"RTN","TMGDBAP2",592,0) + if +File'=0 do goto CKFileNum +"RTN","TMGDBAP2",593,0) + . set FileNumber=File +"RTN","TMGDBAP2",594,0) + set FileName=File +"RTN","TMGDBAP2",595,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"File Name='"_FileName_"'") +"RTN","TMGDBAP2",596,0) + +"RTN","TMGDBAP2",597,0) + if FileName=" " do goto SFNDone +"RTN","TMGDBAP2",598,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No file specifier (either name or number) given!") +"RTN","TMGDBAP2",599,0) + . set result=cAbort ;"0=Abort +"RTN","TMGDBAP2",600,0) + +"RTN","TMGDBAP2",601,0) + ;"Note: I could replace this code with GetFileNum(FileName) +"RTN","TMGDBAP2",602,0) + ;"---------------- +"RTN","TMGDBAP2",603,0) + set DIC=1 ;"File 1=Global file reference (the file listing info for all files) +"RTN","TMGDBAP2",604,0) + set DIC(0)="M" +"RTN","TMGDBAP2",605,0) + set X=FileName ;"i.e. "AGENCY" +"RTN","TMGDBAP2",606,0) + do ^DIC ;"lookup filename Result comes back in Y ... i.e. "4.11^AGENCY" +"RTN","TMGDBAP2",607,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"lookup for filename '"_FileName_"' ==> "_Y) +"RTN","TMGDBAP2",608,0) + set FileNumber=$piece(Y,"^",1) +"RTN","TMGDBAP2",609,0) + ;"---------------- +"RTN","TMGDBAP2",610,0) + +"RTN","TMGDBAP2",611,0) +CKFileNum +"RTN","TMGDBAP2",612,0) + set Data(0,cFile)=FileNumber +"RTN","TMGDBAP2",613,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Uploading to File number: "_FileNumber) +"RTN","TMGDBAP2",614,0) + ;"if $data(FileName) if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"('",FileName,"' file)") +"RTN","TMGDBAP2",615,0) + if FileNumber=-1 do goto SFNDone +"RTN","TMGDBAP2",616,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to locate file specified as #"_FileNumber_" or '"_FileName_"'.") +"RTN","TMGDBAP2",617,0) + . set result=cAbort ;"0=Abort +"RTN","TMGDBAP2",618,0) + if $$VFILE^DILFD(FileNumber)=0 do goto SFNDone +"RTN","TMGDBAP2",619,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, #"_FileNumber_", doesn't exist.") +"RTN","TMGDBAP2",620,0) + . set result=cAbort ;"0=Abort +"RTN","TMGDBAP2",621,0) + +"RTN","TMGDBAP2",622,0) + set Global=$get(^DIC(FileNumber,0,"GL"),"INVALID") ;"^DIC is file 1/FILE +"RTN","TMGDBAP2",623,0) + set Data(0,cFile,cGlobal,cOpen)=Global +"RTN","TMGDBAP2",624,0) + ;"Convert global form of ^VA(200, into ^VA(200) +"RTN","TMGDBAP2",625,0) + new Len +"RTN","TMGDBAP2",626,0) + set Len=$length(Global) +"RTN","TMGDBAP2",627,0) + if $extract(Global,Len)="," do +"RTN","TMGDBAP2",628,0) + . set $extract(Global,Len)=")" +"RTN","TMGDBAP2",629,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"The global file to access is: "_Global) +"RTN","TMGDBAP2",630,0) + set Data(0,cFile,cGlobal)=Global +"RTN","TMGDBAP2",631,0) + +"RTN","TMGDBAP2",632,0) +SFNDone +"RTN","TMGDBAP2",633,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SetupFileNum^TMGDBAPI") +"RTN","TMGDBAP2",634,0) + +"RTN","TMGDBAP2",635,0) + quit result +"RTN","TMGDBAP2",636,0) + +"RTN","TMGDBAP2",637,0) + +"RTN","TMGDBAP2",638,0) + +"RTN","TMGDBAP2",639,0) +RecFind(Params) +"RTN","TMGDBAP2",640,0) + ;"Purpose: To look through a file and find matching record +"RTN","TMGDBAP2",641,0) + ;"Input -- Params(cFile)=File name or number +"RTN","TMGDBAP2",642,0) + ;" Params(FieldNumber)=LookupValue +"RTN","TMGDBAP2",643,0) + ;" Params(FieldNumber)=LookupValue +"RTN","TMGDBAP2",644,0) + ;" +"RTN","TMGDBAP2",645,0) + ;" e.g. Params(0,cFile)="PERSON CLASS" +"RTN","TMGDBAP2",646,0) + ;" Params(.01)="Physicians (M.D. and D.O.)" +"RTN","TMGDBAP2",647,0) + ;" Params(1)="Physician/Osteopath" +"RTN","TMGDBAP2",648,0) + ;" Params(2)="Family Practice" +"RTN","TMGDBAP2",649,0) + ;" +"RTN","TMGDBAP2",650,0) + ;"Note: Does not support searching based on subfile data. +"RTN","TMGDBAP2",651,0) + ;"Output -- (via results) +"RTN","TMGDBAP2",652,0) + ;"Result -- Returns record number file, OR 0 if not found +"RTN","TMGDBAP2",653,0) + +"RTN","TMGDBAP2",654,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"RecFind^TMGDBAPI") +"RTN","TMGDBAP2",655,0) + +"RTN","TMGDBAP2",656,0) + if $data(cFile)=0 new cFile set cFile="FILE" +"RTN","TMGDBAP2",657,0) + if $data(cEntries)=0 new cEntries set cEntries="Entries" +"RTN","TMGDBAP2",658,0) + if $data(cMatchValue)=0 new cMatchValue set cMatchValue="MATCHVALUE" +"RTN","TMGDBAP2",659,0) + new result set result=0 +"RTN","TMGDBAP2",660,0) + new Data +"RTN","TMGDBAP2",661,0) + new RecNum +"RTN","TMGDBAP2",662,0) + new FieldNum +"RTN","TMGDBAP2",663,0) + +"RTN","TMGDBAP2",664,0) + set Data(0,cFile)=$get(Params(0,cFile)) +"RTN","TMGDBAP2",665,0) + if Data(0,cFile)="" goto RFDone +"RTN","TMGDBAP2",666,0) + if $$SetupFileNum(.Data)=0 goto RFDone +"RTN","TMGDBAP2",667,0) + set Data(0,cEntries)=1 +"RTN","TMGDBAP2",668,0) + +"RTN","TMGDBAP2",669,0) + set FieldNum=$order(Params(0)) +"RTN","TMGDBAP2",670,0) + for do quit:(+FieldNum=0) +"RTN","TMGDBAP2",671,0) + . if +FieldNum=0 quit +"RTN","TMGDBAP2",672,0) + . set Data(1,FieldNum,cMatchValue)=$get(Params(FieldNum)) +"RTN","TMGDBAP2",673,0) + . set FieldNum=$order(Params(FieldNum)) +"RTN","TMGDBAP2",674,0) + +"RTN","TMGDBAP2",675,0) + if $$GetRecMatch^TMGDBAPI(.Data,.RecNum)=0 goto RFDone +"RTN","TMGDBAP2",676,0) + set result=RecNum +"RTN","TMGDBAP2",677,0) + +"RTN","TMGDBAP2",678,0) +RFDone +"RTN","TMGDBAP2",679,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"RecFind^TMGDBAPI") +"RTN","TMGDBAP2",680,0) + quit result +"RTN","TMGDBAP2",681,0) + +"RTN","TMGDBAP2",682,0) + +"RTN","TMGDBAP2",683,0) + +"RTN","TMGDBAP2",684,0) +FieldCompare(TestField,dbField,Type) +"RTN","TMGDBAP2",685,0) + ;"PURPOSE: To compare two fields and return a comparison code +"RTN","TMGDBAP2",686,0) + ;"INPUT: TestField -- User input to be tested (in "external format"). **Don't pass by Ref** +"RTN","TMGDBAP2",687,0) + ;" dbField -- data from database to be tested. **Don't pass by Ref +"RTN","TMGDBAP2",688,0) + ;" Type -- (Optional) The type of data being compared: +"RTN","TMGDBAP2",689,0) + ;" "NORMAL" or "" -- Simple comparison carried out (i.e. 'if A=B') +"RTN","TMGDBAP2",690,0) + ;" "DATE" -- the two values are date/time values +"RTN","TMGDBAP2",691,0) + ;" "SSNUM"-- the two values are social security numbers +"RTN","TMGDBAP2",692,0) + ;" "SEX" -- the two values are Sex descriptors. +"RTN","TMGDBAP2",693,0) + ;" "NUMBER" -- the two values are numbers +"RTN","TMGDBAP2",694,0) + ;"Results: +"RTN","TMGDBAP2",695,0) + ;" return value = cConflict (0) if entries conflict +"RTN","TMGDBAP2",696,0) + ;" i.e. TestField="John" vs dbField="Bill" +"RTN","TMGDBAP2",697,0) + ;" return value = cFullMatch (1) if entries completely match +"RTN","TMGDBAP2",698,0) + ;" ie. TestField="John" vs dbField="John" +"RTN","TMGDBAP2",699,0) + ;" or TestField="" vs. dbField="" +"RTN","TMGDBAP2",700,0) + ;" return value = cExtraInfo (2) if entries have no conflict, but TestField has extra info. +"RTN","TMGDBAP2",701,0) + ;" i.e. TestField="John" vs. dbField="" +"RTN","TMGDBAP2",702,0) + ;" return value = cdbExtraInfo (3) if entries have no conflict, but dbField has extra info. +"RTN","TMGDBAP2",703,0) + ;" i.e. TestField="" vs. dbField="12345" +"RTN","TMGDBAP2",704,0) + +"RTN","TMGDBAP2",705,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FieldCompare^TMGDBAPI") +"RTN","TMGDBAP2",706,0) + +"RTN","TMGDBAP2",707,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGDBAP2",708,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGDBAP2",709,0) + if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 +"RTN","TMGDBAP2",710,0) + if $data(cdbExtraInfo)#10=0 new cdbExtraInfo set cdbExtraInfo=3 +"RTN","TMGDBAP2",711,0) + +"RTN","TMGDBAP2",712,0) + set TestField=$get(TestField) +"RTN","TMGDBAP2",713,0) + set dbField=$get(dbField) +"RTN","TMGDBAP2",714,0) + set Type=$get(Type) +"RTN","TMGDBAP2",715,0) + +"RTN","TMGDBAP2",716,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TestField=",TestField) +"RTN","TMGDBAP2",717,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"dbField=",dbField) +"RTN","TMGDBAP2",718,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Type=",Type) +"RTN","TMGDBAP2",719,0) + +"RTN","TMGDBAP2",720,0) + new result set result=cConflict +"RTN","TMGDBAP2",721,0) + +"RTN","TMGDBAP2",722,0) + if Type="DATE" do +"RTN","TMGDBAP2",723,0) + . set TestField=$$IDATE^TIULC(TestField) +"RTN","TMGDBAP2",724,0) + . set dbField=$$IDATE^TIULC(dbField) +"RTN","TMGDBAP2",725,0) + else if Type="SSNUM" do +"RTN","TMGDBAP2",726,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Processing SSNUM's") +"RTN","TMGDBAP2",727,0) + . set TestField=$translate(TestField," /-","") ;"Clean delimiters +"RTN","TMGDBAP2",728,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TestField now=",TestField) +"RTN","TMGDBAP2",729,0) + . if TestField["P" set TestField="P" +"RTN","TMGDBAP2",730,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TestField now=",TestField) +"RTN","TMGDBAP2",731,0) + . if dbField["P" set dbField="P" +"RTN","TMGDBAP2",732,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"dbField now=",dbField) +"RTN","TMGDBAP2",733,0) + else if Type="SEX" do +"RTN","TMGDBAP2",734,0) + . if (TestField="m")!(TestField="M") set TestField="MALE" +"RTN","TMGDBAP2",735,0) + . if (TestField="f")!(TestField="F") set TestField="FEMALE" +"RTN","TMGDBAP2",736,0) + +"RTN","TMGDBAP2",737,0) + if TestField'="" do +"RTN","TMGDBAP2",738,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"$data(dbField)=",$data(dbField)) +"RTN","TMGDBAP2",739,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"$get(dbField)='' =",($get(dbField)="")) +"RTN","TMGDBAP2",740,0) + . if ($data(dbField)#10=0)!($get(dbField)="") set result=cExtraInfo +"RTN","TMGDBAP2",741,0) + . else do +"RTN","TMGDBAP2",742,0) + . . if Type="NUMBER" do +"RTN","TMGDBAP2",743,0) + . . . if +TestField=+dbField set result=cFullMatch +"RTN","TMGDBAP2",744,0) + . . else do +"RTN","TMGDBAP2",745,0) + . . . if TestField=dbField set result=cFullMatch +"RTN","TMGDBAP2",746,0) + else do ;"i.e. test case when TestField="" +"RTN","TMGDBAP2",747,0) + . if $get(dbfield)="" set result=cFullMatch +"RTN","TMGDBAP2",748,0) + . else set result=cdbExtraInfo +"RTN","TMGDBAP2",749,0) + +"RTN","TMGDBAP2",750,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGDBAP2",751,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FieldCompare^TMGDBAPI") +"RTN","TMGDBAP2",752,0) + +"RTN","TMGDBAP2",753,0) + quit result +"RTN","TMGDBAP2",754,0) + +"RTN","TMGDBAP2",755,0) + +"RTN","TMGDBAP2",756,0) +EnsureWrite(File,Field,IENS,Value,Flags,MsgArray) +"RTN","TMGDBAP2",757,0) + ;"Purpose: To provide code to that will ensure that data is written to +"RTN","TMGDBAP2",758,0) + ;" the database, but it will not add duplicate records if the value +"RTN","TMGDBAP2",759,0) + ;" is already there. So a FIND is done first, and added if not found. +"RTN","TMGDBAP2",760,0) + ;" Note: This is primarly targeted at adding entries in a subfile. +"RTN","TMGDBAP2",761,0) + ;"Input: File -- File name or number +"RTN","TMGDBAP2",762,0) + ;" Field -- Field name or number +"RTN","TMGDBAP2",763,0) + ;" IENS -- standard IENS string describing IEN in File, or IEN path to subfile +"RTN","TMGDBAP2",764,0) + ;" Value -- The value to be filed +"RTN","TMGDBAP2",765,0) + ;" Flags -- Flags to be passed +"RTN","TMGDBAP2",766,0) + ;" MsgArray -- PASS BY REFERENCE. Messages to pass back out. +"RTN","TMGDBAP2",767,0) + ;"Results : 1=Writen OK, 0=Already present so not written, -1=error +"RTN","TMGDBAP2",768,0) + +"RTN","TMGDBAP2",769,0) + new result set result=-1 +"RTN","TMGDBAP2",770,0) + +"RTN","TMGDBAP2",771,0) + +"RTN","TMGDBAP2",772,0) + quit result +"RTN","TMGDBAP2",773,0) + +"RTN","TMGDBAP2",774,0) + +"RTN","TMGDBAP2",775,0) + +"RTN","TMGDBAP2",776,0) +dbWrite(FDA,Overwrite,TMGIEN,Flags,ErrArray) +"RTN","TMGDBAP2",777,0) + ;"Purpose: To provide a unified interface for writing a FDA to the database +"RTN","TMGDBAP2",778,0) + ;"Input: FDA -- PASS BY REFERENCE. A standard FDA structure. (won't be changed) +"RTN","TMGDBAP2",779,0) + ;" Overwrite -- specifies if records already exist in database +"RTN","TMGDBAP2",780,0) + ;" if = 1, then FILE^DIE used to write into pre-existing records +"RTN","TMGDBAP2",781,0) + ;" if = 0, then UPDATE^DIE used to write new records +"RTN","TMGDBAP2",782,0) + ;" TMGIEN (OPTIONAL)-- an array to receive back records added (only applies if +"RTN","TMGDBAP2",783,0) + ;" Overwrite=0) +"RTN","TMGDBAP2",784,0) + ;" It can also be used to pass info to UPDATE^DIE recarding requested record numbers +"RTN","TMGDBAP2",785,0) + ;" Flags (OPTIONAL) -- Flags to pass to UPDATE^DIE or FILE^DIE. +"RTN","TMGDBAP2",786,0) + ;" default is "E", pass a " " to NOT use "E" +"RTN","TMGDBAP2",787,0) + ;" ErrArray (OPTIONAL) -- an OUT parameter to receive fileman "DIERR" results, if any +"RTN","TMGDBAP2",788,0) + ;"Results -- if error occured +"RTN","TMGDBAP2",789,0) + ;" cOKToCont (i.e. 1) if no error +"RTN","TMGDBAP2",790,0) + ;" cAbort (i.e. 0) if error +"RTN","TMGDBAP2",791,0) + +"RTN","TMGDBAP2",792,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",793,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",794,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGDBAP2",795,0) + +"RTN","TMGDBAP2",796,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"dbWrite^TMGDBAPI") +"RTN","TMGDBAP2",797,0) + +"RTN","TMGDBAP2",798,0) + set Overwrite=$get(Overwrite,0) +"RTN","TMGDBAP2",799,0) + new TMGFDA merge TMGFDA=FDA +"RTN","TMGDBAP2",800,0) + new TMGMsg +"RTN","TMGDBAP2",801,0) + new TMGFlags set TMGFlags=$get(Flags,"E") ;"E=External values +"RTN","TMGDBAP2",802,0) + if TMGFlags=" " set TMGFlags="" +"RTN","TMGDBAP2",803,0) + if (Overwrite=1)&($get(Flags)'="") set TMGFlags=TMGFlags_"K" ;"K means filer does file locking. +"RTN","TMGDBAP2",804,0) + +"RTN","TMGDBAP2",805,0) + new result set result=cOKToCont +"RTN","TMGDBAP2",806,0) + +"RTN","TMGDBAP2",807,0) + if $data(TMGFDA)=0 do goto DBWDone +"RTN","TMGDBAP2",808,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error: No data passed to write!") +"RTN","TMGDBAP2",809,0) + . set result=-1 quit +"RTN","TMGDBAP2",810,0) + else do +"RTN","TMGDBAP2",811,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is TMGFDA to write") +"RTN","TMGDBAP2",812,0) + . ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGFDA") +"RTN","TMGDBAP2",813,0) + +"RTN","TMGDBAP2",814,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TMGFlags=",TMGFlags) +"RTN","TMGDBAP2",815,0) + +"RTN","TMGDBAP2",816,0) + set ^TMP("TMG",$J,"ErrorTrap")=result +"RTN","TMGDBAP2",817,0) + +"RTN","TMGDBAP2",818,0) + ;"====================================================== +"RTN","TMGDBAP2",819,0) + ;"====================================================== +"RTN","TMGDBAP2",820,0) + if Overwrite=1 do ;"i.e. FILE^DIE used to write into pre-existing records +"RTN","TMGDBAP2",821,0) + . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGDBAP2",822,0) + . set ^TMP("TMG",$J,"Caller")="FILE^DIE" +"RTN","TMGDBAP2",823,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Using FILE^DIE to work with preexisting records") +"RTN","TMGDBAP2",824,0) + . do FILE^DIE(TMGFlags,"TMGFDA","TMGMsg") +"RTN","TMGDBAP2",825,0) + else if Overwrite=0 do ;"i.e. UPDATE^DIE used to write new records +"RTN","TMGDBAP2",826,0) + . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGDBAP2",827,0) + . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE" +"RTN","TMGDBAP2",828,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Using UPDATE^DIE to add a new records") +"RTN","TMGDBAP2",829,0) + . do UPDATE^DIE(TMGFlags,"TMGFDA","TMGIEN","TMGMsg") +"RTN","TMGDBAP2",830,0) + ;"====================================================== +"RTN","TMGDBAP2",831,0) + ;"====================================================== +"RTN","TMGDBAP2",832,0) + +"RTN","TMGDBAP2",833,0) + set result=^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",834,0) + kill ^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",835,0) + kill ^TMP("TMG",$J,"Caller") +"RTN","TMGDBAP2",836,0) + +"RTN","TMGDBAP2",837,0) + ;"if ($get(TMGDEBUG)>0)&($data(TMGIEN)) do DebugMsg^TMGDEBUG(.DBIndent,"Here is TMGIEN") +"RTN","TMGDBAP2",838,0) + ;". if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGIEN") +"RTN","TMGDBAP2",839,0) + +"RTN","TMGDBAP2",840,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After database write, here is TMGMsg") +"RTN","TMGDBAP2",841,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMsg") +"RTN","TMGDBAP2",842,0) + +"RTN","TMGDBAP2",843,0) + if $data(TMGMsg("DIERR")) do +"RTN","TMGDBAP2",844,0) + . ;"TMGDEBUG=-1 --> extra quiet mode +"RTN","TMGDBAP2",845,0) + . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAP2",846,0) + . set result=cAbort +"RTN","TMGDBAP2",847,0) + . merge ErrArray("DIERR")=TMGMsg("DIERR") +"RTN","TMGDBAP2",848,0) + +"RTN","TMGDBAP2",849,0) + if result=cAbort do +"RTN","TMGDBAP2",850,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error encountered during write") +"RTN","TMGDBAP2",851,0) + +"RTN","TMGDBAP2",852,0) +DBWDone +"RTN","TMGDBAP2",853,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"dbWrite^TMGDBAPI") +"RTN","TMGDBAP2",854,0) + quit result +"RTN","TMGDBAP2",855,0) + +"RTN","TMGDBAP2",856,0) + +"RTN","TMGDBAP2",857,0) +DelIEN(File,RecNumIEN,ErrArray) +"RTN","TMGDBAP2",858,0) + ;"Purpose: To delete record# RecNumIEN from file FILE +"RTN","TMGDBAP2",859,0) + ;"Input: File -- File name or number to delete from +"RTN","TMGDBAP2",860,0) + ;" RecNumIEN -- the IEN to delete +"RTN","TMGDBAP2",861,0) + ;" ErrArray --OPTIONAL, PASS BY REFERENCE. +"RTN","TMGDBAP2",862,0) + ;" an OUT parameter to receive fileman "DIERR" results, if any +"RTN","TMGDBAP2",863,0) + ;"Output: will cause deletion from database +"RTN","TMGDBAP2",864,0) + ;"Results -- if error occured +"RTN","TMGDBAP2",865,0) + ;" cOKToCont (i.e. 1) if no error +"RTN","TMGDBAP2",866,0) + ;" cAbort (i.e. 0) if error +"RTN","TMGDBAP2",867,0) + +"RTN","TMGDBAP2",868,0) + new TMGFDA,result +"RTN","TMGDBAP2",869,0) + set result=0 +"RTN","TMGDBAP2",870,0) + +"RTN","TMGDBAP2",871,0) + if $get(File)="" goto DIENDone +"RTN","TMGDBAP2",872,0) + if +$get(RecNumIEN)'>0 goto DIENDone +"RTN","TMGDBAP2",873,0) + if +File'>0 set File=$$GetFileNum(File) +"RTN","TMGDBAP2",874,0) + +"RTN","TMGDBAP2",875,0) + set TMGFDA(File,+RecNumIEN_",",.01)="@" +"RTN","TMGDBAP2",876,0) + set result=$$dbWrite(.TMGFDA,1,,,.ErrArray) +"RTN","TMGDBAP2",877,0) + +"RTN","TMGDBAP2",878,0) +DIENDone +"RTN","TMGDBAP2",879,0) + quit result +"RTN","TMGDBAP2",880,0) + +"RTN","TMGDBAP2",881,0) + +"RTN","TMGDBAP2",882,0) +WriteWP(File,RecNumIEN,Field,TMGArray) +"RTN","TMGDBAP2",883,0) + ;"Purpose: To provide a shell around WP^DIE with error trap, error reporting +"RTN","TMGDBAP2",884,0) + ;"Note: This does not support subfiles or multiples. Does not support appending +"RTN","TMGDBAP2",885,0) + ;"Input: File: a number or name +"RTN","TMGDBAP2",886,0) + ;" RecNumIEN: The record number, in File, to use +"RTN","TMGDBAP2",887,0) + ;" Field: a name or number +"RTN","TMGDBAP2",888,0) + ;" TMGArray: The array that contains WP data. Must be in Fileman acceptible format. +"RTN","TMGDBAP2",889,0) + ;"Results -- if error occured +"RTN","TMGDBAP2",890,0) + ;" cOKToCont (i.e. 1) if no error +"RTN","TMGDBAP2",891,0) + ;" cAbort (i.e. 0) if error +"RTN","TMGDBAP2",892,0) + +"RTN","TMGDBAP2",893,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",894,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",895,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGDBAP2",896,0) + +"RTN","TMGDBAP2",897,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"WriteWP^TMGDBAPI") +"RTN","TMGDBAP2",898,0) + +"RTN","TMGDBAP2",899,0) + new IENS +"RTN","TMGDBAP2",900,0) + new TMGMsg +"RTN","TMGDBAP2",901,0) + new FileNumber,FieldNumber +"RTN","TMGDBAP2",902,0) + new result set result=cAbort +"RTN","TMGDBAP2",903,0) + new TMGFlags set TMGFlags="K" +"RTN","TMGDBAP2",904,0) + +"RTN","TMGDBAP2",905,0) + set FileNumber=+$get(File) +"RTN","TMGDBAP2",906,0) + if FileNumber=0 set FileNumber=$$GetFileNum(.File) +"RTN","TMGDBAP2",907,0) + if FileNumber=0 do goto WWPDone +"RTN","TMGDBAP2",908,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.") +"RTN","TMGDBAP2",909,0) + +"RTN","TMGDBAP2",910,0) + set FieldNumber=$get(Field) +"RTN","TMGDBAP2",911,0) + if FieldNumber=0 set FieldNumber=$$GetNumField^TMGDBAPI(.Field) +"RTN","TMGDBAP2",912,0) + if FieldNumber=0 do goto WWPDone +"RTN","TMGDBAP2",913,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert field '"_$get(Field)_", to a number.") +"RTN","TMGDBAP2",914,0) + +"RTN","TMGDBAP2",915,0) + if +$get(RecNumIEN)=0 do goto WWPDone +"RTN","TMGDBAP2",916,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No numeric record number supplied.") +"RTN","TMGDBAP2",917,0) + +"RTN","TMGDBAP2",918,0) + set IENS=RecNumIEN_"," +"RTN","TMGDBAP2",919,0) + +"RTN","TMGDBAP2",920,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNumber=",FileNumber) +"RTN","TMGDBAP2",921,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IENS='",IENS,"'") +"RTN","TMGDBAP2",922,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNumber=",FieldNumber) +"RTN","TMGDBAP2",923,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Flags=",TMGFlags) +"RTN","TMGDBAP2",924,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGArray") +"RTN","TMGDBAP2",925,0) + +"RTN","TMGDBAP2",926,0) + do +"RTN","TMGDBAP2",927,0) + . ;"====================================================== +"RTN","TMGDBAP2",928,0) + . ;"Call WP^DIE +"RTN","TMGDBAP2",929,0) + . ;"====================================================== +"RTN","TMGDBAP2",930,0) + . ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"TMGDBAPI::WP^DIE") +"RTN","TMGDBAP2",931,0) + . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGDBAP2",932,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Remember, WP^DIE files WP data.") +"RTN","TMGDBAP2",933,0) + . set ^TMP("TMG",$J,"ErrorTrap")=result +"RTN","TMGDBAP2",934,0) + . set ^TMP("TMG",$J,"Caller")="WP^DIE" +"RTN","TMGDBAP2",935,0) + . do WP^DIE(FileNumber,IENS,FieldNumber,TMGFlags,"TMGArray","TMGMsg") +"RTN","TMGDBAP2",936,0) + . set result=^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",937,0) + . kill ^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAP2",938,0) + . kill ^TMP("TMG",$J,"Caller") +"RTN","TMGDBAP2",939,0) + . ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::WP^DIE") +"RTN","TMGDBAP2",940,0) + . ;"====================================================== +"RTN","TMGDBAP2",941,0) + . ;"====================================================== +"RTN","TMGDBAP2",942,0) + +"RTN","TMGDBAP2",943,0) + if $data(TMGMsg("DIERR"))'=0 do goto WWPDone +"RTN","TMGDBAP2",944,0) + . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAP2",945,0) + . set result=cAbort +"RTN","TMGDBAP2",946,0) + +"RTN","TMGDBAP2",947,0) + set result=cOKToCont +"RTN","TMGDBAP2",948,0) + +"RTN","TMGDBAP2",949,0) + ;"zbreak WWPDone +"RTN","TMGDBAP2",950,0) + +"RTN","TMGDBAP2",951,0) +WWPDone +"RTN","TMGDBAP2",952,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"WriteWP^TMGDBAPI") +"RTN","TMGDBAP2",953,0) + quit result +"RTN","TMGDBAP2",954,0) + +"RTN","TMGDBAP2",955,0) + +"RTN","TMGDBAP2",956,0) +ReadWP(File,IENS,Field,Array) +"RTN","TMGDBAP2",957,0) + ;"Purpose: To provide a shell for reading a WP with error trap, error reporting +"RTN","TMGDBAP2",958,0) + ;"Input: File: a number or name +"RTN","TMGDBAP2",959,0) + ;" IENS: a standard IENS (i.e. "IEN,parent-IEN,grandparent-IEN,ggparent-IEN," etc. +"RTN","TMGDBAP2",960,0) + ;" Note: can just pass a single IEN (without a terminal ",") +"RTN","TMGDBAP2",961,0) + ;" Field: a name or number +"RTN","TMGDBAP2",962,0) + ;" Array: The array to receive WP data. PASS BY REFERENCE +"RTN","TMGDBAP2",963,0) + ;" returned In Fileman acceptible format. +"RTN","TMGDBAP2",964,0) + ;" Array will be deleted before refilling +"RTN","TMGDBAP2",965,0) + ;"Results -- if error occured +"RTN","TMGDBAP2",966,0) + ;" cOKToCont (i.e. 1) if no error +"RTN","TMGDBAP2",967,0) + ;" cAbort (i.e. 0) if error +"RTN","TMGDBAP2",968,0) + +"RTN","TMGDBAP2",969,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAP2",970,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGDBAP2",971,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGDBAP2",972,0) + +"RTN","TMGDBAP2",973,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ReadWP^TMGDBAPI") +"RTN","TMGDBAP2",974,0) + +"RTN","TMGDBAP2",975,0) + new FileNumber,FieldNumber +"RTN","TMGDBAP2",976,0) + new TMGWP,temp +"RTN","TMGDBAP2",977,0) + new result set result=cOKToCont +"RTN","TMGDBAP2",978,0) + +"RTN","TMGDBAP2",979,0) + if $get(IENS)="" do goto RWPDone +"RTN","TMGDBAP2",980,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Valid IENS not supplied.") +"RTN","TMGDBAP2",981,0) + if $extract(IENS,$length(IENS))'="," set IENS=IENS_"," +"RTN","TMGDBAP2",982,0) + +"RTN","TMGDBAP2",983,0) + if $$SetFileFldNums^TMGDBAPI(.File,.Field,.FileNumber,.FieldNumber)=cAbort goto RWPDone +"RTN","TMGDBAP2",984,0) + +"RTN","TMGDBAP2",985,0) + set temp=$$GET1^DIQ(FileNumber,IENS,FieldNumber,"","TMGWP","TMGMsg") +"RTN","TMGDBAP2",986,0) + +"RTN","TMGDBAP2",987,0) + if $data(TMGMsg) do +"RTN","TMGDBAP2",988,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are TMGMsg entries") +"RTN","TMGDBAP2",989,0) + . ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMsg") +"RTN","TMGDBAP2",990,0) + . if $data(TMGMsg("DIERR"))'=0 do quit +"RTN","TMGDBAP2",991,0) + . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAP2",992,0) + . . set result=cAbort +"RTN","TMGDBAP2",993,0) + if result=cAbort goto RWPDone +"RTN","TMGDBAP2",994,0) + +"RTN","TMGDBAP2",995,0) + kill Array +"RTN","TMGDBAP2",996,0) + merge Array=TMGWP +"RTN","TMGDBAP2",997,0) + +"RTN","TMGDBAP2",998,0) +RWPDone +"RTN","TMGDBAP2",999,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ReadWP^TMGDBAPI") +"RTN","TMGDBAP2",1000,0) + quit result +"RTN","TMGDBAP2",1001,0) + +"RTN","TMGDBAP2",1002,0) +ShowIfError(TMGMsg,PriorErrorFound) +"RTN","TMGDBAP2",1003,0) + ;"Purpose: to show DIERR if preesnt in pTMGMsg +"RTN","TMGDBAP2",1004,0) + ;"Input: pTMGMsg -- PASS BY REFERENCE, holds message route, as set up by Fileman +"RTN","TMGDBAP2",1005,0) + ;" PriorErrroFound -- OPTIONAL, a variable holding if a prior error has been found +"RTN","TMGDBAP2",1006,0) + ;"Output: 1 if ERROR found, 0 otherwise +"RTN","TMGDBAP2",1007,0) + +"RTN","TMGDBAP2",1008,0) + new result set result=0 +"RTN","TMGDBAP2",1009,0) + if $data(TMGMsg("DIERR"))'=0 do +"RTN","TMGDBAP2",1010,0) + . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAP2",1011,0) + . set result=1 +"RTN","TMGDBAP2",1012,0) + quit result +"RTN","TMGDBAP2",1013,0) + +"RTN","TMGDBAP2",1014,0) + +"RTN","TMGDBAP2",1015,0) +DataImport(Info,ProgressFN) +"RTN","TMGDBAP2",1016,0) + ;"Purpose: to provide a generic loading utility. +"RTN","TMGDBAP2",1017,0) + ;" Note: this is more specific than code found in DDMP.m +"RTN","TMGDBAP2",1018,0) + ;"Assumptions: that all data for one record is found on one line, with a given +"RTN","TMGDBAP2",1019,0) + ;" number of columns for each field. +"RTN","TMGDBAP2",1020,0) + ;"Input: Info, an array with relevent info. PASS BY REFERENCE +"RTN","TMGDBAP2",1021,0) + ;" Format as follows: +"RTN","TMGDBAP2",1022,0) + ;" Info("HFS DIR")= +"RTN","TMGDBAP2",1023,0) + ;" Info("HFS FILE")= +"RTN","TMGDBAP2",1024,0) + ;" Info("DEST FILE")= +"RTN","TMGDBAP2",1025,0) + ;" Info(x)=field# (or "IEN" if data should be used to determine record number +"RTN","TMGDBAP2",1026,0) + ;" Info(x,"START")=starting column +"RTN","TMGDBAP2",1027,0) + ;" Info(x,"END")=ending column +"RTN","TMGDBAP2",1028,0) + ;" ProgressFN: optional. If not "", then this will be XECUTED after each line +"RTN","TMGDBAP2",1029,0) + ;"Result: 1 if OK to continue, 0 if error +"RTN","TMGDBAP2",1030,0) + +"RTN","TMGDBAP2",1031,0) + ;"Note: input Data array will be formated like this: +"RTN","TMGDBAP2",1032,0) + ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGDBAP2",1033,0) + ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200," +"RTN","TMGDBAP2",1034,0) + ;" Data(0,cRecNum)=2 <-- only if user-specified. +"RTN","TMGDBAP2",1035,0) + ;" Data(0,cEntries)=1 +"RTN","TMGDBAP2",1036,0) + ;" Data(1,".01")="MyData1" +"RTN","TMGDBAP2",1037,0) + ;" Data(1,".01",cMatchValue)="MyData1" +"RTN","TMGDBAP2",1038,0) + ;" Data(1,".02")="Bill" +"RTN","TMGDBAP2",1039,0) + ;" Data(1,".02",cMatchValue)="John" +"RTN","TMGDBAP2",1040,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGDBAP2",1041,0) + ;" Data(1,".04")="MyData4" +"RTN","TMGDBAP2",1042,0) + ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06" +"RTN","TMGDBAP2",1043,0) + ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07" +"RTN","TMGDBAP2",1044,0) + ;" Data(1,".07",1,".01")="SubEntry1" +"RTN","TMGDBAP2",1045,0) + ;" Data(1,".07",1,".02")="SE1" +"RTN","TMGDBAP2",1046,0) + ;" Data(1,".07",1,".03")="'Some Info'" +"RTN","TMGDBAP2",1047,0) + ;" Data(1,".07",2,".01")="SubEntry2" +"RTN","TMGDBAP2",1048,0) + ;" Data(1,".07",2,".02")="SE2" +"RTN","TMGDBAP2",1049,0) + ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04 +"RTN","TMGDBAP2",1050,0) + ;" Data(1,".07",2,".04",1,".01")="JD" +"RTN","TMGDBAP2",1051,0) + ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGDBAP2",1052,0) + ;" ADDENDUM +"RTN","TMGDBAP2",1053,0) + ;" Data(1,".01",cFlags)=any flags specified for given field. +"RTN","TMGDBAP2",1054,0) + ;" only present if user specified. +"RTN","TMGDBAP2",1055,0) + +"RTN","TMGDBAP2",1056,0) + new cFile set cFile="FILE" +"RTN","TMGDBAP2",1057,0) + new cRecNum set cRecNum="RECNUM" +"RTN","TMGDBAP2",1058,0) + new result set result=1 +"RTN","TMGDBAP2",1059,0) + +"RTN","TMGDBAP2",1060,0) + new GRef set GRef=$name(^TMP("TMG","DATAIMPORT",$J)) +"RTN","TMGDBAP2",1061,0) + new GRef1 set GRef1=$name(@GRef@(1)) ;"I have to use this to load file +"RTN","TMGDBAP2",1062,0) + kill @GRef +"RTN","TMGDBAP2",1063,0) + +"RTN","TMGDBAP2",1064,0) + new result +"RTN","TMGDBAP2",1065,0) + new dir set dir=$get(Info("HFS DIR")) +"RTN","TMGDBAP2",1066,0) + new HFSfile set HFSfile=$get(Info("HFS FILE")) +"RTN","TMGDBAP2",1067,0) + set result=$$FTG^%ZISH(dir,HFSfile,GRef1,4) +"RTN","TMGDBAP2",1068,0) + if result=0 goto DIDone +"RTN","TMGDBAP2",1069,0) + new file set file=$get(Info("DEST FILE")) +"RTN","TMGDBAP2",1070,0) + if +file=0 set file=$$GetFileNum(file) +"RTN","TMGDBAP2",1071,0) + +"RTN","TMGDBAP2",1072,0) + new index +"RTN","TMGDBAP2",1073,0) + set index=$order(@GRef@("")) +"RTN","TMGDBAP2",1074,0) + for do quit:(+index=0)!(result=0) +"RTN","TMGDBAP2",1075,0) + . new RecData,FDA +"RTN","TMGDBAP2",1076,0) + . set RecData(0,cFile)=file +"RTN","TMGDBAP2",1077,0) + . new line set line=$get(@GRef@(index)) +"RTN","TMGDBAP2",1078,0) + . new fields set fields=$order(Info("")) +"RTN","TMGDBAP2",1079,0) + . new IEN set IEN="" +"RTN","TMGDBAP2",1080,0) + . for do quit:(+fields=0)!(result=0) +"RTN","TMGDBAP2",1081,0) + . . new fieldNum set fieldNum=$get(Info(fields)) ;"could be number or 'IEN' +"RTN","TMGDBAP2",1082,0) + . . new oneField +"RTN","TMGDBAP2",1083,0) + . . set oneField=$extract(line,$get(Info(fields,"START")),$get(Info(fields,"END"))) +"RTN","TMGDBAP2",1084,0) + . . set oneField=$$Trim^TMGSTUTL(oneField) +"RTN","TMGDBAP2",1085,0) + . . if fieldNum="IEN" do +"RTN","TMGDBAP2",1086,0) + . . . set RecData(0,cRecNum)=fieldNum +"RTN","TMGDBAP2",1087,0) + . . . set IEN=fieldNum +"RTN","TMGDBAP2",1088,0) + . . else do +"RTN","TMGDBAP2",1089,0) + . . . set RecData(1,fieldNum)=oneField +"RTN","TMGDBAP2",1090,0) + . . set fields=$order(Info(fields)) +"RTN","TMGDBAP2",1091,0) + . new MarkNum set MarkNum=0 +"RTN","TMGDBAP2",1092,0) + . new MsgArray +"RTN","TMGDBAP2",1093,0) + . set result=$$SetupFDA(.RecData,.FDA,,"+",.MarkNum,.MsgArray,IEN) +"RTN","TMGDBAP2",1094,0) + . if result=0 quit +"RTN","TMGDBAP2",1095,0) + . set result=$$dbWrite(.FDA,0,," ") +"RTN","TMGDBAP2",1096,0) + . if result=0 quit +"RTN","TMGDBAP2",1097,0) + . if $get(ProgressFN)'="" do +"RTN","TMGDBAP2",1098,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGDBAP2",1099,0) + . . xecute ProgressFN +"RTN","TMGDBAP2",1100,0) + . set index=$order(@GRef@(index)) +"RTN","TMGDBAP2",1101,0) + +"RTN","TMGDBAP2",1102,0) +DIDone +"RTN","TMGDBAP2",1103,0) + kill @GRef +"RTN","TMGDBAP2",1104,0) + quit result +"RTN","TMGDBAP2",1105,0) + +"RTN","TMGDBAP2",1106,0) + +"RTN","TMGDBAP2",1107,0) +Set1(File,IEN,Field,Value,Flag) +"RTN","TMGDBAP2",1108,0) + ;"Purpose: to be the reverse of GET1^DIQ (i.e. a setter instead of a getter) +"RTN","TMGDBAP2",1109,0) + ;" It will set the value for 1 field in 1 record in 1 file. +"RTN","TMGDBAP2",1110,0) + ;" Note: only to be used in existing files. +"RTN","TMGDBAP2",1111,0) + ;"Input: File -- the Filename or number +"RTN","TMGDBAP2",1112,0) + ;" IEN -- the record number to set into +"RTN","TMGDBAP2",1113,0) + ;" Field -- the field name or number +"RTN","TMGDBAP2",1114,0) + ;" Value -- the value to set it to (WP not currently supported) +"RTN","TMGDBAP2",1115,0) + ;" Flag -- OPTIONAL. Combinations of below: +"RTN","TMGDBAP2",1116,0) + ;" 'I' -- values are in internal format +"RTN","TMGDBAP2",1117,0) + ;" 'E' -- values are in external format (this is the DEFAULT) +"RTN","TMGDBAP2",1118,0) + ;"Results: 1 if OKtoCont, 0 if error +"RTN","TMGDBAP2",1119,0) + +"RTN","TMGDBAP2",1120,0) + new FileNumber,FieldNumber +"RTN","TMGDBAP2",1121,0) + new result set result=0 ;"default to error +"RTN","TMGDBAP2",1122,0) + +"RTN","TMGDBAP2",1123,0) + ;"new tempDebug set tempDebug=$get(TMGDEBUG) +"RTN","TMGDBAP2",1124,0) + ;"set TMGDEBUG=-1 ;"Extra quiet mode +"RTN","TMGDBAP2",1125,0) + +"RTN","TMGDBAP2",1126,0) + if $$SetFileFldNums^TMGDBAPI(.File,.Field,.FileNumber,.FieldNumber)=0 goto S1Done +"RTN","TMGDBAP2",1127,0) + if (+FileNumber=0)!(+FieldNumber=0) goto S1Done +"RTN","TMGDBAP2",1128,0) + if ($get(Value)="")!(+IEN=0) goto S1Done +"RTN","TMGDBAP2",1129,0) + +"RTN","TMGDBAP2",1130,0) + new result set result=1 ;"default to success. +"RTN","TMGDBAP2",1131,0) + +"RTN","TMGDBAP2",1132,0) + new TMGFDA,FMFlag,TMGMSG +"RTN","TMGDBAP2",1133,0) + set FMFlag="E" +"RTN","TMGDBAP2",1134,0) + if $get(Flag)["I" set FMFlag="" +"RTN","TMGDBAP2",1135,0) + set FMFlag=FMFlag_"K" +"RTN","TMGDBAP2",1136,0) + set TMGFDA(FileNumber,IEN_",",FieldNumber)=Value +"RTN","TMGDBAP2",1137,0) + do FILE^DIE(FMFlag,"TMGFDA","TMGMSG") +"RTN","TMGDBAP2",1138,0) + if $data(TMGMSG("DIERR"))'=0 do goto S1Done +"RTN","TMGDBAP2",1139,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGDBAP2",1140,0) + +"RTN","TMGDBAP2",1141,0) +S1Done +"RTN","TMGDBAP2",1142,0) + ;"set TMGDEBUG=tempDebug +"RTN","TMGDBAP2",1143,0) + quit result +"RTN","TMGDBAP2",1144,0) + +"RTN","TMGDBAP2",1145,0) + +"RTN","TMGDBAP2",1146,0) +GetValidInput(File,Field) +"RTN","TMGDBAP2",1147,0) + ;"Purpose: Gets a valid input for field in file, asking user from console +"RTN","TMGDBAP2",1148,0) + ;"Input: File: File number or name of file to use +"RTN","TMGDBAP2",1149,0) + ;" Field: Field number or name in file. +"RTN","TMGDBAP2",1150,0) + ;"Results: returns valid input, or "" +"RTN","TMGDBAP2",1151,0) + +"RTN","TMGDBAP2",1152,0) + new FileNum,FldNum +"RTN","TMGDBAP2",1153,0) + new DIR,X,Y +"RTN","TMGDBAP2",1154,0) + set Y="" +"RTN","TMGDBAP2",1155,0) + +"RTN","TMGDBAP2",1156,0) + set FileNum=+$get(File) +"RTN","TMGDBAP2",1157,0) + if FileNum=0 set FileNum=$$GetFileNum^TMGDBAPI(.File) +"RTN","TMGDBAP2",1158,0) + if FileNum=0 goto GVIDone +"RTN","TMGDBAP2",1159,0) + +"RTN","TMGDBAP2",1160,0) + set FldNum=$get(Field) +"RTN","TMGDBAP2",1161,0) + if FldNum=0 set FldNum=$$GetNumField^TMGDBAPI(FileNum,.Field) +"RTN","TMGDBAP2",1162,0) + if FldNum=0 goto GVIDone +"RTN","TMGDBAP2",1163,0) + +"RTN","TMGDBAP2",1164,0) + set DIR(0)=FileNum_","_FldNum +"RTN","TMGDBAP2",1165,0) + do ^DIR write ! +"RTN","TMGDBAP2",1166,0) +GVIDone +"RTN","TMGDBAP2",1167,0) + quit Y +"RTN","TMGDBAP2",1168,0) + +"RTN","TMGDBAP2",1169,0) + +"RTN","TMGDBAP2",1170,0) +AskFIENS() +"RTN","TMGDBAP2",1171,0) + ;"Purpose: Ask user to pick a file number, then pick a record +"RTN","TMGDBAP2",1172,0) + ;" from that file. This supports selection of subfiles. +"RTN","TMGDBAP2",1173,0) + ;"Input: none +"RTN","TMGDBAP2",1174,0) + ;"Results: format-- File^IENS, or ^ if abort +"RTN","TMGDBAP2",1175,0) + new result set result="^" +"RTN","TMGDBAP2",1176,0) + +"RTN","TMGDBAP2",1177,0) + new DIR,X,Y +"RTN","TMGDBAP2",1178,0) + set DIR(0)="F" +"RTN","TMGDBAP2",1179,0) + set DIR("A")="Select FILE (or SUBFILE)" +"RTN","TMGDBAP2",1180,0) + set DIR("?")="Answer with FILE NUMBER or NAME, or SUBFILE NUMBER" +"RTN","TMGDBAP2",1181,0) + set DIR("PRE")="D ASKSCRN^TMGDBAPI" +"RTN","TMGDBAP2",1182,0) + do ^DIR +"RTN","TMGDBAP2",1183,0) + set Y=+Y +"RTN","TMGDBAP2",1184,0) + if Y>0 set result=Y_"^"_$$AskIENS(Y) +"RTN","TMGDBAP2",1185,0) + +"RTN","TMGDBAP2",1186,0) + quit result +"RTN","TMGDBAP2",1187,0) + +"RTN","TMGDBAP2",1188,0) +ASKSCRN +"RTN","TMGDBAP2",1189,0) + ;"Purpose: an Input transform for AskFIENS +"RTN","TMGDBAP2",1190,0) + ;"Input: (global) X -- the user's response in ^DIR +"RTN","TMGDBAP2",1191,0) + ;" (global) DTOUT -- this will be defined if the read timed out. +"RTN","TMGDBAP2",1192,0) + ;"Output: If X is changed, it will be as if user entered in new X +"RTN","TMGDBAP2",1193,0) + ;" If X is killed, it will be as if user entered an illegal value. +"RTN","TMGDBAP2",1194,0) + +"RTN","TMGDBAP2",1195,0) + if $data(DTOUT) quit +"RTN","TMGDBAP2",1196,0) + if +X=X do +"RTN","TMGDBAP2",1197,0) + . if $data(^DD(X,0))=0 kill X quit +"RTN","TMGDBAP2",1198,0) + . if $data(^DIC(X,0)) write " ",$piece(^DIC(X,0),"^",1)," " quit +"RTN","TMGDBAP2",1199,0) + . ;"Here we deal with subfiles +"RTN","TMGDBAP2",1200,0) + . new temp,i,filenum +"RTN","TMGDBAP2",1201,0) + . set filenum=X +"RTN","TMGDBAP2",1202,0) + . set X="" +"RTN","TMGDBAP2",1203,0) + . for i=100:-1:0 do quit:(filenum=0) +"RTN","TMGDBAP2",1204,0) + . . set temp(i)=filenum +"RTN","TMGDBAP2",1205,0) + . . set X=X_filenum_"," +"RTN","TMGDBAP2",1206,0) + . . set filenum=+$get(^DD(filenum,0,"UP")) +"RTN","TMGDBAP2",1207,0) + . new indent set indent=5 +"RTN","TMGDBAP2",1208,0) + . new indentS set $piece(indentS," ",75)=" " +"RTN","TMGDBAP2",1209,0) + . write ! +"RTN","TMGDBAP2",1210,0) + . set i="" +"RTN","TMGDBAP2",1211,0) + . for set i=$order(temp(i)) quit:(i="") do +"RTN","TMGDBAP2",1212,0) + . . set filenum=+$get(temp(i)) quit:(filenum=0) +"RTN","TMGDBAP2",1213,0) + . . write $extract(indentS,1,indent) +"RTN","TMGDBAP2",1214,0) + . . if $data(^DIC(filenum,0)) do +"RTN","TMGDBAP2",1215,0) + . . . write $piece(^DIC(filenum,0),"^",1)," (FILE #",filenum,")",! +"RTN","TMGDBAP2",1216,0) + . . else write "+--SUBFILE# ",filenum,! +"RTN","TMGDBAP2",1217,0) + . . set indent=indent+3 +"RTN","TMGDBAP2",1218,0) + else do ;"check validity of FILE NAME +"RTN","TMGDBAP2",1219,0) + . if X="" quit +"RTN","TMGDBAP2",1220,0) + . new filenum +"RTN","TMGDBAP2",1221,0) + . set filenum=$order(^DIC("B",X,"")) +"RTN","TMGDBAP2",1222,0) + . if +filenum>0 set X=+filenum_"," quit +"RTN","TMGDBAP2",1223,0) + . set filenum=$$GetFileNum(X) +"RTN","TMGDBAP2",1224,0) + . if +filenum>0 set X=+filenum_"," quit +"RTN","TMGDBAP2",1225,0) + . new DIC,Y +"RTN","TMGDBAP2",1226,0) + . set DIC=1 set DIC(0)="EQM" +"RTN","TMGDBAP2",1227,0) + . do ^DIC w ! +"RTN","TMGDBAP2",1228,0) + . if +Y>0 set X=+Y quit +"RTN","TMGDBAP2",1229,0) + . set X=0 +"RTN","TMGDBAP2",1230,0) + +"RTN","TMGDBAP2",1231,0) + if $get(X)="" set X=0 +"RTN","TMGDBAP2",1232,0) + quit +"RTN","TMGDBAP2",1233,0) + +"RTN","TMGDBAP2",1234,0) + +"RTN","TMGDBAP2",1235,0) +AskIENS(FileNum,IENS) +"RTN","TMGDBAP2",1236,0) + ;"Purpose: To ask user to select a record in File indicated by FileNum. +"RTN","TMGDBAP2",1237,0) + ;" If FileNum is a subfile number, then the user will be asked +"RTN","TMGDBAP2",1238,0) + ;" for records to drill down to desired record, and return values +"RTN","TMGDBAP2",1239,0) + ;" as an IENS. +"RTN","TMGDBAP2",1240,0) + ;"Input: FileNum: A file number or subfile number +"RTN","TMGDBAP2",1241,0) + ;" IENS: OPTIONAL. Allows for supplying a partial IENS supplying a +"RTN","TMGDBAP2",1242,0) + ;" partial path. E.g. if a full IENS to FileNum +"RTN","TMGDBAP2",1243,0) + ;" would be '2,3,4455,' and if the IENS supplied is +"RTN","TMGDBAP2",1244,0) + ;" '3,4455,' then only the missing IEN (in this case 2) +"RTN","TMGDBAP2",1245,0) + ;" would be asked. +"RTN","TMGDBAP2",1246,0) + ;"Results: Returns IENS. format: IEN in file,IEN in parentfile,IEN in grandparentfile, ... , +"RTN","TMGDBAP2",1247,0) + ;" Note: IENS will contain '?' if there is a problem, +"RTN","TMGDBAP2",1248,0) + ;" or "" if FileNum is invalid +"RTN","TMGDBAP2",1249,0) + +"RTN","TMGDBAP2",1250,0) + new array +"RTN","TMGDBAP2",1251,0) + do GetRefArray(FileNum,.array) +"RTN","TMGDBAP2",1252,0) + new resultIENS set resultIENS="" +"RTN","TMGDBAP2",1253,0) + set IENS=$get(IENS) +"RTN","TMGDBAP2",1254,0) + +"RTN","TMGDBAP2",1255,0) + new DANum set DANum=1 +"RTN","TMGDBAP2",1256,0) + new TMGDA,numIENS +"RTN","TMGDBAP2",1257,0) + set numIENS=$length(IENS,",") +"RTN","TMGDBAP2",1258,0) + new i,abort set i="",abort=0 +"RTN","TMGDBAP2",1259,0) + for set i=$order(array(i),-1) quit:(i="")!abort do +"RTN","TMGDBAP2",1260,0) + . new DIC,X,Y,DA +"RTN","TMGDBAP2",1261,0) + . new tempIEN set tempIEN=+$piece(IENS,",",numIENS-DANum) +"RTN","TMGDBAP2",1262,0) + . if tempIEN'>0 do +"RTN","TMGDBAP2",1263,0) + . . set DIC=$get(array(i,"GL")),DIC(0)="AEQM" +"RTN","TMGDBAP2",1264,0) + . . if DIC'="" write !,"Select entry in file# ",array(i,"FILE NUM") +"RTN","TMGDBAP2",1265,0) + . . do ^DIC write ! +"RTN","TMGDBAP2",1266,0) + . else set Y=tempIEN +"RTN","TMGDBAP2",1267,0) + . if +Y'>0 set resultIENS="?,"_resultIENS,abort=1 quit +"RTN","TMGDBAP2",1268,0) + . set TMGDA(DANum)=+Y,DANum=DANum+1 +"RTN","TMGDBAP2",1269,0) + . set resultIENS=+Y_","_resultIENS +"RTN","TMGDBAP2",1270,0) + +"RTN","TMGDBAP2",1271,0) + quit resultIENS +"RTN","TMGDBAP2",1272,0) + +"RTN","TMGDBAP2",1273,0) + +"RTN","TMGDBAP2",1274,0) +GetRefArray(FileNum,array) +"RTN","TMGDBAP2",1275,0) + ;"Purpose: To return an array containing global references that can +"RTN","TMGDBAP2",1276,0) + ;" be passed to ^DIC, for given file or subfile number +"RTN","TMGDBAP2",1277,0) + ;"Input: FileNum: A file number or subfile number +"RTN","TMGDBAP2",1278,0) + ;" array: PASS BY REFERENCE. See format below +"RTN","TMGDBAP2",1279,0) + ;"Results: none, but array is filled with result. Format (example): +"RTN","TMGDBAP2",1280,0) + ;" array(1,"FILE NUM")=2.011 <--- sub sub file +"RTN","TMGDBAP2",1281,0) + ;" array(1,"GL")="^DPT(TMGDA(1),""DE"",TMGDA(2),""1""," +"RTN","TMGDBAP2",1282,0) + ;" array(2,"FILE NUM")=2.001 <---- sub file +"RTN","TMGDBAP2",1283,0) + ;" array(2,"GL")="^DPT(TMGDA(1),""DE""," +"RTN","TMGDBAP2",1284,0) + ;" array(3,"FILE NUM")=2 <---- parent file +"RTN","TMGDBAP2",1285,0) + ;" array(3,"GL")="^DPT(" +"RTN","TMGDBAP2",1286,0) + ;"Note: To use the references stored in "GL", then the IEN for +"RTN","TMGDBAP2",1287,0) + ;" each step should be stored in TMGDA(x) +"RTN","TMGDBAP2",1288,0) + +"RTN","TMGDBAP2",1289,0) + new i +"RTN","TMGDBAP2",1290,0) + for i=1:1 quit:(+$get(FileNum)=0) do +"RTN","TMGDBAP2",1291,0) + . set array(i,"FILE NUM")=FileNum +"RTN","TMGDBAP2",1292,0) + . if $data(^DD(FileNum,0,"UP")) do +"RTN","TMGDBAP2",1293,0) + . . new parentFlNum,field +"RTN","TMGDBAP2",1294,0) + . . set parentFlNum=+$get(^DD(FileNum,0,"UP")) +"RTN","TMGDBAP2",1295,0) + . . if parentFlNum=0 quit ;"really should be an abort +"RTN","TMGDBAP2",1296,0) + . . set field=$order(^DD(parentFlNum,"SB",FileNum,"")) +"RTN","TMGDBAP2",1297,0) + . . if field="" quit ;"really should be an abort +"RTN","TMGDBAP2",1298,0) + . . new node set node=$piece($piece($get(^DD(parentFlNum,field,0)),"^",4),";",1) +"RTN","TMGDBAP2",1299,0) + . . set array(i,"NODE IN PARENT")=node +"RTN","TMGDBAP2",1300,0) + . else do +"RTN","TMGDBAP2",1301,0) + . . set array(i,"GL")=$get(^DIC(FileNum,0,"GL")) +"RTN","TMGDBAP2",1302,0) + . set FileNum=+$get(^DD(FileNum,0,"UP")) +"RTN","TMGDBAP2",1303,0) + +"RTN","TMGDBAP2",1304,0) + set i="" set i=$order(array(i),-1) +"RTN","TMGDBAP2",1305,0) + set array(i,"ref")=$get(array(i,"GL"))_"TMGDA(1)," +"RTN","TMGDBAP2",1306,0) + new DANum set DANum=2 +"RTN","TMGDBAP2",1307,0) + for set i=$order(array(i),-1) quit:(i="") do +"RTN","TMGDBAP2",1308,0) + . new ref +"RTN","TMGDBAP2",1309,0) + . set ref=$get(array(i+1,"ref"))_""""_$get(array(i,"NODE IN PARENT"))_"""," +"RTN","TMGDBAP2",1310,0) + . kill array(i+1,"ref"),array(i,"NODE IN PARENT") +"RTN","TMGDBAP2",1311,0) + . set array(i,"GL")=ref +"RTN","TMGDBAP2",1312,0) + . set array(i,"ref")=ref_"TMGDA("_DANum_")," +"RTN","TMGDBAP2",1313,0) + . set DANum=DANum+1 +"RTN","TMGDBAP2",1314,0) + kill array(1,"ref") +"RTN","TMGDBAP2",1315,0) + quit +"RTN","TMGDBAP2",1316,0) + +"RTN","TMGDBAP2",1317,0) +FIENS2Root(FIENS) +"RTN","TMGDBAP2",1318,0) + ;"Purpose: to convert a Files^IENS string into a root reference +"RTN","TMGDBAP2",1319,0) + ;"Input: FIENS: format: FileNumber^StandardIENS +"RTN","TMGDBAP2",1320,0) + ;"Output: A global root in open format +"RTN","TMGDBAP2",1321,0) + quit +"RTN","TMGDBAP2",1322,0) + +"RTN","TMGDBAP2",1323,0) + +"RTN","TMGDBAP2",1324,0) +GetRef(file,IENS,field) +"RTN","TMGDBAP2",1325,0) + ;"Purpose: to return the global reference for a given record +"RTN","TMGDBAP2",1326,0) + ;"Input: file -- File or subfile number +"RTN","TMGDBAP2",1327,0) + ;" IENS -- an IEN, or an IENS for record +"RTN","TMGDBAP2",1328,0) + ;" field -- OPTIONAL. +"RTN","TMGDBAP2",1329,0) + ;"Results: if field is NOT supplied, or +"RTN","TMGDBAP2",1330,0) + ;" OPEN global ref +"RTN","TMGDBAP2",1331,0) + ;" if field IS supplied +"RTN","TMGDBAP2",1332,0) + ;" CLOSED global ref@piece +"RTN","TMGDBAP2",1333,0) + ;" e.g. ^TMG(22706.9,3,2,IEN,0)@1 <-- note 'IEN' placeholder +"RTN","TMGDBAP2",1334,0) + +"RTN","TMGDBAP2",1335,0) + ;"Note: This function really needs to be fleshed out some more... +"RTN","TMGDBAP2",1336,0) + ;"Note: this only will work for normal files, or subfiles ONE (1) level deep... +"RTN","TMGDBAP2",1337,0) + +"RTN","TMGDBAP2",1338,0) + new ref set ref="" +"RTN","TMGDBAP2",1339,0) + new parentFile set parentFile=$$IsSubFile^TMGDBAPI(file) +"RTN","TMGDBAP2",1340,0) + if parentFile=0 goto GRF1 ;"handle non-subfiles separately. +"RTN","TMGDBAP2",1341,0) + +"RTN","TMGDBAP2",1342,0) + set fieldInParent=$piece(parentFile,"^",2) +"RTN","TMGDBAP2",1343,0) + set ref=$get(^DIC(+parentFile,0,"GL")) +"RTN","TMGDBAP2",1344,0) + new IENinParent set IENinParent=$piece(IENS,",",2) +"RTN","TMGDBAP2",1345,0) + set ref=ref_IENinParent_"," +"RTN","TMGDBAP2",1346,0) + new storeLoc set storeLoc=$piece($get(^DD(+parentFile,fieldInParent,0)),"^",4) +"RTN","TMGDBAP2",1347,0) + ;"Note: works only with storeLoc in Node;Piece format... not all fields follow this... +"RTN","TMGDBAP2",1348,0) + set ref=ref_+storeLoc_"," +"RTN","TMGDBAP2",1349,0) + new IENinSubRec set IENinSubRec=$piece(IENS,",",1) +"RTN","TMGDBAP2",1350,0) + if IENinSubRec="" set IENinSubRec="IEN" +"RTN","TMGDBAP2",1351,0) + set ref=ref_IENinSubRec_"," +"RTN","TMGDBAP2",1352,0) + +"RTN","TMGDBAP2",1353,0) + if $get(field)="" goto GRF2 ;"done +"RTN","TMGDBAP2",1354,0) + set storeLoc=$piece($get(^DD(file,field,0)),"^",4) +"RTN","TMGDBAP2",1355,0) + set ref=ref_+storeLoc_")@"_$piece(storeLoc,";",2) +"RTN","TMGDBAP2",1356,0) + goto GRF2 +"RTN","TMGDBAP2",1357,0) + +"RTN","TMGDBAP2",1358,0) +GRF1 +"RTN","TMGDBAP2",1359,0) + set ref=$get(^DIC(file,0,"GL")) +"RTN","TMGDBAP2",1360,0) + set ref=ref_+IENS_"," +"RTN","TMGDBAP2",1361,0) + if $get(field)="" goto GRF2 ;"done +"RTN","TMGDBAP2",1362,0) + new storeLoc set storeLoc=$piece($get(^DD(file,field,0)),"^",4) +"RTN","TMGDBAP2",1363,0) + set ref=ref_+storeLoc_")@"_$piece(storeLoc,";",2) +"RTN","TMGDBAP2",1364,0) + ;"Note: works only with storeLoc in Node;Piece format... not all fields follow this... +"RTN","TMGDBAP2",1365,0) +GRF2 +"RTN","TMGDBAP2",1366,0) + quit ref +"RTN","TMGDBAP2",1367,0) + +"RTN","TMGDBAP2",1368,0) +TrimFDA(FDA,Quiet) +"RTN","TMGDBAP2",1369,0) + ;"Purpose: To take an FDA, and compare it to data already present in the +"RTN","TMGDBAP2",1370,0) + ;" record specified by the FDA. If any values already in the record +"RTN","TMGDBAP2",1371,0) + ;" match those in the FDA, then those entries will be removed from the +"RTN","TMGDBAP2",1372,0) + ;" FDA array. +"RTN","TMGDBAP2",1373,0) + ;"Input: FDA -- PASS BY REFERENCE. A standard Fileman FDA. +"RTN","TMGDBAP2",1374,0) + ;" Quiet -- OPTIONAL. If 1, then error messages will be supressed +"RTN","TMGDBAP2",1375,0) + ;" (These would be messages generated on READING existing +"RTN","TMGDBAP2",1376,0) + ;" data, not writing new data.) +"RTN","TMGDBAP2",1377,0) + ;" default value=1 +"RTN","TMGDBAP2",1378,0) + ;"Output: Values from FDA may be removed. +"RTN","TMGDBAP2",1379,0) + ;"Results: final IENS (i.e. '+1,3,' --> '5,3,' if prev value found) +"RTN","TMGDBAP2",1380,0) + ;"Note: match will be made base on INTERNAL, or EXTERNAL forms +"RTN","TMGDBAP2",1381,0) + ;"Note: Fields should be specified by numbers, NOT NAMES. +"RTN","TMGDBAP2",1382,0) + +"RTN","TMGDBAP2",1383,0) + new tempIENS set tempIENS="" +"RTN","TMGDBAP2",1384,0) + if $data(FDA)'>0 goto TFDDone +"RTN","TMGDBAP2",1385,0) + new TMGDATA,TMGMSG +"RTN","TMGDBAP2",1386,0) + new file,IENS +"RTN","TMGDBAP2",1387,0) + set file=$order(FDA("")) +"RTN","TMGDBAP2",1388,0) + set IENS=$order(FDA(file,"")) +"RTN","TMGDBAP2",1389,0) + set tempIENS=IENS +"RTN","TMGDBAP2",1390,0) + set Quiet=$get(Quiet,1) +"RTN","TMGDBAP2",1391,0) + +"RTN","TMGDBAP2",1392,0) + new fieldsS set fieldsS="" +"RTN","TMGDBAP2",1393,0) + new field set field="" +"RTN","TMGDBAP2",1394,0) + for set field=$order(FDA(file,IENS,field)) quit:(field="") do +"RTN","TMGDBAP2",1395,0) + . set fieldsS=fieldsS_field_";" +"RTN","TMGDBAP2",1396,0) + +"RTN","TMGDBAP2",1397,0) + new parentFile set parentFile=$$IsSubFile^TMGDBAPI(file) +"RTN","TMGDBAP2",1398,0) + if parentFile=0 goto TFD0 ;"handle non-subfiles separately. +"RTN","TMGDBAP2",1399,0) + +"RTN","TMGDBAP2",1400,0) + ;"e.g. FDA(22706.9001,"+1,3",.01)=1 +"RTN","TMGDBAP2",1401,0) + ;" FDA(22706.9001,"+1,3",.02)=2 +"RTN","TMGDBAP2",1402,0) + ;"Note: The .01 field is used to find a matching subrecord, which is then +"RTN","TMGDBAP2",1403,0) + ;" check for preexisting data. If multiple matches for .01 are found, +"RTN","TMGDBAP2",1404,0) + ;" then the process is aborted, and the FDA will NOT BE TRIMMED. +"RTN","TMGDBAP2",1405,0) + +"RTN","TMGDBAP2",1406,0) + set $piece(tempIENS,",",1)="" ;"leave first piece blank in IENS +"RTN","TMGDBAP2",1407,0) + new value set value=$get(FDA(file,IENS,.01)) +"RTN","TMGDBAP2",1408,0) + +"RTN","TMGDBAP2",1409,0) + ;"new i for i=1:1:$length(fieldsS,",") do ;"append 'E' to each field number +"RTN","TMGDBAP2",1410,0) + ;". new field set field=$piece(fieldsS,";",i) +"RTN","TMGDBAP2",1411,0) + ;". set field=field_"E" +"RTN","TMGDBAP2",1412,0) + ;". set $piece(fieldsS,";",i)=field +"RTN","TMGDBAP2",1413,0) + ;" +"RTN","TMGDBAP2",1414,0) + ;"new TMGFIND +"RTN","TMGDBAP2",1415,0) + ;" +"RTN","TMGDBAP2",1416,0) + ;"I can't get this part to work... so will work around +"RTN","TMGDBAP2",1417,0) + ;"do FIND^DIC(file,tempIENS,fieldsS,"BMU",value,"*",,,,"TMGFIND","TMGMSG") +"RTN","TMGDBAP2",1418,0) + ;"do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGDBAP2",1419,0) + ;"if +$get(TMGFIND(0))'=1 goto TFDDone ;"abort +"RTN","TMGDBAP2",1420,0) + ;"merge TMGDATA(file,IENS)=TMGDATA("ID",1) +"RTN","TMGDBAP2",1421,0) + ;"goto TFD1 +"RTN","TMGDBAP2",1422,0) + +"RTN","TMGDBAP2",1423,0) + new ref set ref=$$GetRef(file,tempIENS,.01) ;"returns ref with 'IEN' built in... +"RTN","TMGDBAP2",1424,0) + new ref2 set ref2=$$CREF^DILF($piece(ref,"IEN",1)) +"RTN","TMGDBAP2",1425,0) + new ref3 set ref3=$piece(ref,"@",1) +"RTN","TMGDBAP2",1426,0) + new p set p=$piece(ref,"@",2) +"RTN","TMGDBAP2",1427,0) + new found set found=0 +"RTN","TMGDBAP2",1428,0) + new IEN set IEN=0 +"RTN","TMGDBAP2",1429,0) + for set IEN=$order(@ref2@(IEN)) quit:(+IEN'>0)!(found>0) do +"RTN","TMGDBAP2",1430,0) + . new valueFound set valueFound=$piece($get(@ref3),"^",p) +"RTN","TMGDBAP2",1431,0) + . if valueFound=value set found=IEN +"RTN","TMGDBAP2",1432,0) + if found=0 set tempIENS=IENS goto TFDDone +"RTN","TMGDBAP2",1433,0) + set tempIENS=found_tempIENS +"RTN","TMGDBAP2",1434,0) +TFD0 +"RTN","TMGDBAP2",1435,0) + do GETS^DIQ(file,tempIENS,fieldsS,"EI","TMGDATA","TMGMSG") +"RTN","TMGDBAP2",1436,0) + if 'Quiet do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGDBAP2",1437,0) + +"RTN","TMGDBAP2",1438,0) +TFD1 +"RTN","TMGDBAP2",1439,0) + for set field=$order(FDA(file,IENS,field)) quit:(field="") do +"RTN","TMGDBAP2",1440,0) + . new found set found=0 +"RTN","TMGDBAP2",1441,0) + . new FDAvalue set FDAvalue=$get(FDA(file,IENS,field)) +"RTN","TMGDBAP2",1442,0) + . if $get(TMGDATA(file,tempIENS,field,"I"))=FDAvalue set found=1 +"RTN","TMGDBAP2",1443,0) + . if $get(TMGDATA(file,tempIENS,field,"E"))=FDAvalue set found=1 +"RTN","TMGDBAP2",1444,0) + . if (FDAvalue="@")&($data(TMGDATA(file,tempIENS,field))=0) set found=1 +"RTN","TMGDBAP2",1445,0) + . if found=1 kill FDA(file,IENS,field) +"RTN","TMGDBAP2",1446,0) + goto TFDDone +"RTN","TMGDBAP2",1447,0) +TFDDone +"RTN","TMGDBAP2",1448,0) + quit tempIENS +"RTN","TMGDBAP2",1449,0) + +"RTN","TMGDBAP2",1450,0) + +"RTN","TMGDBAP2",1451,0) + +"RTN","TMGDBAP2",1452,0) +GetPtrsOUT(File,Info) +"RTN","TMGDBAP2",1453,0) + ;"Purpose: to get a list of pointers out from the file. +"RTN","TMGDBAP2",1454,0) + ;"Input: File -- File Name or Number of file to investigate +"RTN","TMGDBAP2",1455,0) + ;" Info -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGDBAP2",1456,0) + ;" Info(Field#)=PointedToFileNum +"RTN","TMGDBAP2",1457,0) + ;" Info(Field#,"GL")=an open global ref to pointed-to file +"RTN","TMGDBAP2",1458,0) + ;"results: none +"RTN","TMGDBAP2",1459,0) + +"RTN","TMGDBAP2",1460,0) + if $get(File)="" goto GPODone +"RTN","TMGDBAP2",1461,0) + if +File'=File set File=$$GetFileNum(File) +"RTN","TMGDBAP2",1462,0) + new field set field=0 +"RTN","TMGDBAP2",1463,0) + new done set done=0 +"RTN","TMGDBAP2",1464,0) + for set field=$order(^DD(File,field)) quit:(+field'>0)!(done=1) do +"RTN","TMGDBAP2",1465,0) + . new array +"RTN","TMGDBAP2",1466,0) + . do FIELD^DID(File,field,"N","POINTER","array") +"RTN","TMGDBAP2",1467,0) + . if $get(array("POINTER"))="" quit +"RTN","TMGDBAP2",1468,0) + . if array("POINTER")[";" quit +"RTN","TMGDBAP2",1469,0) + . set Info(field,"GL")=array("POINTER") +"RTN","TMGDBAP2",1470,0) + . new temp set temp=$piece($get(^DD(File,field,0)),"^",2) +"RTN","TMGDBAP2",1471,0) + . set temp=+$piece(temp,"P",2) +"RTN","TMGDBAP2",1472,0) + . set Info(field)=temp +"RTN","TMGDBAP2",1473,0) + . if $data(array) write field," " zwr array +"RTN","TMGDBAP2",1474,0) +GPODone +"RTN","TMGDBAP2",1475,0) + quit +"RTN","TMGDBAP2",1476,0) + +"RTN","TMGDBAPI") +0^7^B13065932 +"RTN","TMGDBAPI",1,0) +TMGDBAPI ;TMG/kst/Database API library ;03/25/06 +"RTN","TMGDBAPI",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGDBAPI",3,0) + +"RTN","TMGDBAPI",4,0) + ;"TMG DATABASE API FUNCTIONS +"RTN","TMGDBAPI",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGDBAPI",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGDBAPI",7,0) + ;"7-12-2005 +"RTN","TMGDBAPI",8,0) + +"RTN","TMGDBAPI",9,0) + ;"======================================================================= +"RTN","TMGDBAPI",10,0) + ;" API -- Public Functions. +"RTN","TMGDBAPI",11,0) + ;"======================================================================= +"RTN","TMGDBAPI",12,0) + ;"$$GetNumField^TMGDBAPI(FileNumber,FieldName) ;Convert Field Name to Field Number +"RTN","TMGDBAPI",13,0) + ;"$$GetFileNum^TMGDBAPI(FileName) ;Convert File Name to File Number +"RTN","TMGDBAPI",14,0) + ;"$$SetFileFldNums^TMGDBAPI(File,Field,FileNumber,FieldNumber) ;do both functions above at once. +"RTN","TMGDBAPI",15,0) + ;"$$GetFName^TMGDBAPI(FileNumber) ;Convert File Number to File Name +"RTN","TMGDBAPI",16,0) + ;"$$GetFldName^TMGDBAPI(File,FieldNumber) ;Convert Field Number to Field Name +"RTN","TMGDBAPI",17,0) + ;"$$GetFldList^TMGDBAPI(File,pArray) ;Get list of all fields for a file. +"RTN","TMGDBAPI",18,0) + ;"FieldExists^TMGDBAPI(FileNumber,Field) +"RTN","TMGDBAPI",19,0) + ;"SetFieldInfo^TMGDBAPI(File,Field,Array) +"RTN","TMGDBAPI",20,0) + ;"GetFieldInfo^TMGDBAPI(FileNumber,Field,VarOutP) +"RTN","TMGDBAPI",21,0) + ;"GetSubFileNumber^TMGDBAPI(FileNumber,Field) +"RTN","TMGDBAPI",22,0) + ;"$$IsSubFile^TMGDBAPI(File) +"RTN","TMGDBAPI",23,0) + ;"GetSubFInfo^TMGDBAPI(SubFileNum,Array) +"RTN","TMGDBAPI",24,0) + ;"GetRecMatch^TMGDBAPI(Data,RecNumIEN) +"RTN","TMGDBAPI",25,0) + ;"CompRec^TMGDBAPI(FileNumber,dbRec,TestRec) +"RTN","TMGDBAPI",26,0) + ;"UploadData^TMGDBAPI(DaDIta,RecNumIEN) +"RTN","TMGDBAPI",27,0) + ;"ValueLookup^TMGDBAPI(Params) +"RTN","TMGDBAPI",28,0) + ;"FileUtility^TMGDBAPI(Params) +"RTN","TMGDBAPI",29,0) + ;"AddRec^TMGDBAPI(Data) +"RTN","TMGDBAPI",30,0) + ;"OverwriteRec^TMGDBAPI(RecNum,Data) +"RTN","TMGDBAPI",31,0) + ;"SetupFileNum^TMGDBAPI(Data) +"RTN","TMGDBAPI",32,0) + ;"RecFind^TMGDBAPI(Params) +"RTN","TMGDBAPI",33,0) + ;"FieldCompare^TMGDBAPI(TestField,dbField,Type) +"RTN","TMGDBAPI",34,0) + ;"$$dbWrite^TMGDBAPI(FDA,Overwrite,TMGIDE,Flags,ErrArray) +"RTN","TMGDBAPI",35,0) + ;"$$DelIEN^TMGDBAPI(File,RecNumIEN,ErrArray) +"RTN","TMGDBAPI",36,0) + ;"$$WriteWP^TMGDBAPI(File,RecNumIEN,Field,Array) +"RTN","TMGDBAPI",37,0) + ;"$$ReadWP^TMGDBAPI(File,IENS,Field,Array) +"RTN","TMGDBAPI",38,0) + ;"$$ShowIfError^TMGDBAPI(TMGMsg,PriorErrorFund) +"RTN","TMGDBAPI",39,0) + ;"$$GetValidInput^TMGDBAPI(File,Field) -- Get a valid input for field in file, asking user +"RTN","TMGDBAPI",40,0) + ;"$$AskFIENS^TMGDBAPI() -- pick a (sub)file number, then pick a record from that file. +"RTN","TMGDBAPI",41,0) + ;"$$AskIENS^TMGDBAPI(FileNum) -- return IENS for File (or subfile) number +"RTN","TMGDBAPI",42,0) + ;"GetRef^TMGDBAPI(file,IENS,field) -- to return the global reference for a given record +"RTN","TMGDBAPI",43,0) + ;"GetPtrsOUT^TMGDBAPI(FileNum,Info) -- get a list of pointers out from the file. +"RTN","TMGDBAPI",44,0) + ;"$$TrimFDA^TMGDBAPI(FDA,Quiet) -- Trim FDA of any data already present in the database +"RTN","TMGDBAPI",45,0) + +"RTN","TMGDBAPI",46,0) + ;"======================================================================= +"RTN","TMGDBAPI",47,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGDBAPI",48,0) + ;"======================================================================= +"RTN","TMGDBAPI",49,0) + ;"ConvertFDA(FDA,MarkerArray) +"RTN","TMGDBAPI",50,0) + ;"ConvertIENS(IENS,MarkerArray) +"RTN","TMGDBAPI",51,0) + ;"SetupFDA(Data,FDA,IENS,SrchType,MarkNum,MsgArray,Minimal,RecNum) +"RTN","TMGDBAPI",52,0) + ;"HackWrite(GlobalP,FileNumber,IENS,FieldNum,Data) +"RTN","TMGDBAPI",53,0) + ;"HandleHacksArray(MsgArray) +"RTN","TMGDBAPI",54,0) + ;"GetRefArray(FileNum,array) +"RTN","TMGDBAPI",55,0) + +"RTN","TMGDBAPI",56,0) + ;"======================================================================= +"RTN","TMGDBAPI",57,0) + ;"DEPENDENCIES +"RTN","TMGDBAPI",58,0) + ;"TMGDEBUG +"RTN","TMGDBAPI",59,0) + ;"TMGUSRIF +"RTN","TMGDBAPI",60,0) + ;"TMGSTUTL +"RTN","TMGDBAPI",61,0) + ;"======================================================================= +"RTN","TMGDBAPI",62,0) + +"RTN","TMGDBAPI",63,0) + ;"======================================================================= +"RTN","TMGDBAPI",64,0) + +"RTN","TMGDBAPI",65,0) + ;"FORMAT OF DATA ARRAY +"RTN","TMGDBAPI",66,0) + +"RTN","TMGDBAPI",67,0) + ;" cNull="(none)" +"RTN","TMGDBAPI",68,0) + ;" cRecNum="RECNUM" +"RTN","TMGDBAPI",69,0) + ;" cOutput="OUTVAR" +"RTN","TMGDBAPI",70,0) + ;" cGlobal="GLOBAL" +"RTN","TMGDBAPI",71,0) + ;" cEntries="Entries" +"RTN","TMGDBAPI",72,0) + ;" cFlags="FLAGS" +"RTN","TMGDBAPI",73,0) + ;" cParentIENS="ParentIENS" +"RTN","TMGDBAPI",74,0) + +"RTN","TMGDBAPI",75,0) + ;"The Data array will be filed with data. (An example) +"RTN","TMGDBAPI",76,0) + ;" Data(0,"FILE")="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGDBAPI",77,0) + ;" Data(0,"FILE",cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200," +"RTN","TMGDBAPI",78,0) + ;" Data(0,cRecNum)=2 <-- only if user-specified. +"RTN","TMGDBAPI",79,0) + ;" Data(0,cEntries)=1 +"RTN","TMGDBAPI",80,0) + ;" Data(1,".01")="MyData1" +"RTN","TMGDBAPI",81,0) + ;" Data(1,".01","MATCHVALUE")="MyData1" +"RTN","TMGDBAPI",82,0) + ;" Data(1,".01",cFlags)=any flags given (only present if user specified) +"RTN","TMGDBAPI",83,0) + ;" Data(1,".02")="Bill" +"RTN","TMGDBAPI",84,0) + ;" Data(1,".02","MATCHVALUE")="John" +"RTN","TMGDBAPI",85,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGDBAPI",86,0) + ;" Data(1,".03",cFlags)=any flags given (only present if user specified) +"RTN","TMGDBAPI",87,0) + ;" Data(1,".04")="MyData4" +"RTN","TMGDBAPI",88,0) + ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06" +"RTN","TMGDBAPI",89,0) + ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07" +"RTN","TMGDBAPI",90,0) + ;" Data(1,".07",0,cParentIENS)=",10033," +"RTN","TMGDBAPI",91,0) + ;" Data(1,".07",1,".01")="SubEntry1" +"RTN","TMGDBAPI",92,0) + ;" Data(1,".07",1,".02")="SE1" +"RTN","TMGDBAPI",93,0) + ;" Data(1,".07",1,".03")="'Some Info'" +"RTN","TMGDBAPI",94,0) + ;" Data(1,".07",2,".01")="SubEntry2" +"RTN","TMGDBAPI",95,0) + ;" Data(1,".07",2,".02")="SE2" +"RTN","TMGDBAPI",96,0) + ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04 +"RTN","TMGDBAPI",97,0) + ;" Data(1,".07",2,".04",0,cParentIENS)=",3,10033," +"RTN","TMGDBAPI",98,0) + ;" Data(1,".07",2,".04",1,".01")="JD" +"RTN","TMGDBAPI",99,0) + ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGDBAPI",100,0) + +"RTN","TMGDBAPI",101,0) + ;"======================================================================= +"RTN","TMGDBAPI",102,0) + ;"======================================================================= +"RTN","TMGDBAPI",103,0) + +"RTN","TMGDBAPI",104,0) +GetNumField(FileNumber,FieldName) +"RTN","TMGDBAPI",105,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",106,0) + ;"Purpose: Given file and the name of a field, this will return the field NUMBER +"RTN","TMGDBAPI",107,0) + ;"Input: FileNumber. Number of file, i.e. "4.11" +"RTN","TMGDBAPI",108,0) + ;" FieldName: the name of a field, i.e. "NAME" spelling must exactly match +"RTN","TMGDBAPI",109,0) + ;"Output: Returns field number, i.e. ".01" or 0 if not found +"RTN","TMGDBAPI",110,0) + +"RTN","TMGDBAPI",111,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",112,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",113,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",114,0) + +"RTN","TMGDBAPI",115,0) + new result +"RTN","TMGDBAPI",116,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetNumField^TMGDBAPI") +"RTN","TMGDBAPI",117,0) + +"RTN","TMGDBAPI",118,0) + set result=$$FLDNUM^DILFD(FileNumber,FieldName) +"RTN","TMGDBAPI",119,0) + +"RTN","TMGDBAPI",120,0) + if result'=0 goto GNMFDone +"RTN","TMGDBAPI",121,0) + +"RTN","TMGDBAPI",122,0) + ;"-------------------------- +"RTN","TMGDBAPI",123,0) + ;"The below is a manual method +"RTN","TMGDBAPI",124,0) + +"RTN","TMGDBAPI",125,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Having difficulty finding field name (? due to security ?). Doing Manual Check.") +"RTN","TMGDBAPI",126,0) + +"RTN","TMGDBAPI",127,0) + new FoundField +"RTN","TMGDBAPI",128,0) + new Index +"RTN","TMGDBAPI",129,0) + new result set result=cAbort +"RTN","TMGDBAPI",130,0) + set U=$get(U,"^") ;"Setup up U if doesn't yet exist +"RTN","TMGDBAPI",131,0) + +"RTN","TMGDBAPI",132,0) + if $$VFILE^DILFD(FileNumber)=0 do goto GNMFDone +"RTN","TMGDBAPI",133,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, #"_FileNumber_", doesn't exist.") +"RTN","TMGDBAPI",134,0) + +"RTN","TMGDBAPI",135,0) + set Index="" +"RTN","TMGDBAPI",136,0) +GNmLoop set Index=$order(^DD(FileNumber,Index)) +"RTN","TMGDBAPI",137,0) + if Index="" goto GNMFDone +"RTN","TMGDBAPI",138,0) + if $data(^DD(FileNumber,Index,0))=0 goto GNMFDone +"RTN","TMGDBAPI",139,0) + set FoundField=$piece(^DD(FileNumber,Index,0),"^",1) +"RTN","TMGDBAPI",140,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Comparing fields: '",FoundField,"' vs. '",FieldName,"'") +"RTN","TMGDBAPI",141,0) + if FieldName=FoundField do goto GNMFDone +"RTN","TMGDBAPI",142,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Match!") +"RTN","TMGDBAPI",143,0) + . set result=Index +"RTN","TMGDBAPI",144,0) + goto GNmLoop +"RTN","TMGDBAPI",145,0) + +"RTN","TMGDBAPI",146,0) +GNMFDone +"RTN","TMGDBAPI",147,0) + if result=cAbort do +"RTN","TMGDBAPI",148,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Unable to convert '",FieldName,"' in file '",FileNumber,"' to a field number. Check for Field name typo") +"RTN","TMGDBAPI",149,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetNumField^TMGDBAPI") +"RTN","TMGDBAPI",150,0) + +"RTN","TMGDBAPI",151,0) + quit result +"RTN","TMGDBAPI",152,0) + +"RTN","TMGDBAPI",153,0) +SetFileFldNums(File,Field,FileNumber,FieldNumber) +"RTN","TMGDBAPI",154,0) + ;"Purpose: To provide a generic shell to ensure that File and Field numbers are in place +"RTN","TMGDBAPI",155,0) + ;"Input: File -- File number or name +"RTN","TMGDBAPI",156,0) + ;" Field -- field number or name +"RTN","TMGDBAPI",157,0) + ;" FileNumber -- PASS BY REFERENCE -- an out parameter +"RTN","TMGDBAPI",158,0) + ;" FieldNum -- PASS BY REFERENCE -- an out parameter +"RTN","TMGDBAPI",159,0) + ;"Results: cOKToCont(1) if ok, otherwise cAbort(0) if error +"RTN","TMGDBAPI",160,0) + ;"Output -- FileNumber and FieldNumber are filled in. +"RTN","TMGDBAPI",161,0) + +"RTN","TMGDBAPI",162,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",163,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",164,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",165,0) + +"RTN","TMGDBAPI",166,0) + new result set result=cOKToCont +"RTN","TMGDBAPI",167,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SetFileFldNums^TMGDBAPI") +"RTN","TMGDBAPI",168,0) + +"RTN","TMGDBAPI",169,0) + set FileNumber=+$get(File) +"RTN","TMGDBAPI",170,0) + if FileNumber=0 set FileNumber=$$GetFileNum(.File) +"RTN","TMGDBAPI",171,0) + if FileNumber=0 do goto SFFNDone +"RTN","TMGDBAPI",172,0) + . set result=cAbort +"RTN","TMGDBAPI",173,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.") +"RTN","TMGDBAPI",174,0) + +"RTN","TMGDBAPI",175,0) + set FieldNumber=$get(Field) +"RTN","TMGDBAPI",176,0) + if FieldNumber=0 set FieldNumber=$$GetNumField(FileNumber,.Field) +"RTN","TMGDBAPI",177,0) + if FieldNumber=0 do goto SFFNDone +"RTN","TMGDBAPI",178,0) + . set result=cAbort +"RTN","TMGDBAPI",179,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert field '"_$get(Field)_", to a number.") +"RTN","TMGDBAPI",180,0) + +"RTN","TMGDBAPI",181,0) +SFFNDone +"RTN","TMGDBAPI",182,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SetFileFldNums^TMGDBAPI") +"RTN","TMGDBAPI",183,0) + quit result +"RTN","TMGDBAPI",184,0) + +"RTN","TMGDBAPI",185,0) + +"RTN","TMGDBAPI",186,0) +FieldExists(FileNumber,Field) +"RTN","TMGDBAPI",187,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",188,0) + ;"Purpose: To ensure that a field exists -- even if hidden by security measures +"RTN","TMGDBAPI",189,0) + ;"Input: FileNumber: File to check +"RTN","TMGDBAPI",190,0) + ;" Field: the field number (or name) to check +"RTN","TMGDBAPI",191,0) + ;"Result: 1 if field exists, 0 if doesn't, 2 if exists but is hidden to user +"RTN","TMGDBAPI",192,0) + +"RTN","TMGDBAPI",193,0) + new result,FieldNumber +"RTN","TMGDBAPI",194,0) + if +Field=0 set FieldNumber=$$GetNumField(FileNumber,Field) +"RTN","TMGDBAPI",195,0) + else set FieldNumber=Field +"RTN","TMGDBAPI",196,0) + +"RTN","TMGDBAPI",197,0) + set result=$$VFIELD^DILFD(FileNumber,FieldNumber) +"RTN","TMGDBAPI",198,0) + if result=1 goto FExsDone +"RTN","TMGDBAPI",199,0) + +"RTN","TMGDBAPI",200,0) + ;"Try a low-level data dictionary eval to see if really does exist, but is hidden +"RTN","TMGDBAPI",201,0) + if $data(^DD(FileNumber,FieldNumber,0))'=0 set result=2 +"RTN","TMGDBAPI",202,0) + +"RTN","TMGDBAPI",203,0) +FExsDone +"RTN","TMGDBAPI",204,0) + quit result +"RTN","TMGDBAPI",205,0) + +"RTN","TMGDBAPI",206,0) + +"RTN","TMGDBAPI",207,0) + +"RTN","TMGDBAPI",208,0) +GetSubFileNumber(FileNumber,Field) +"RTN","TMGDBAPI",209,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",210,0) + ;"Purpose: If FieldNumber is a 'multiple' field, then this function should return 'subfile' +"RTN","TMGDBAPI",211,0) + ;" number of the sub file. +"RTN","TMGDBAPI",212,0) + ;"Input:FileNumber-- the file number (or sub file number) that field exists in +"RTN","TMGDBAPI",213,0) + ;" Field-- the field number (or name) in file to lookup +"RTN","TMGDBAPI",214,0) + ;"Result: Returns sub file number, or 0 if not found or invalid +"RTN","TMGDBAPI",215,0) + +"RTN","TMGDBAPI",216,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",217,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",218,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",219,0) + +"RTN","TMGDBAPI",220,0) + new Info +"RTN","TMGDBAPI",221,0) + new result set result=cAbort +"RTN","TMGDBAPI",222,0) + new Output +"RTN","TMGDBAPI",223,0) + +"RTN","TMGDBAPI",224,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetSubFileNumber^TMGDBAPI") +"RTN","TMGDBAPI",225,0) + +"RTN","TMGDBAPI",226,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNumber=",FileNumber) +"RTN","TMGDBAPI",227,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Field=",Field) +"RTN","TMGDBAPI",228,0) + +"RTN","TMGDBAPI",229,0) + ;"First, verify file (or subfile) exists +"RTN","TMGDBAPI",230,0) + if $$VFILE^DILFD(FileNumber)=0 do goto GSFDone ;"abort +"RTN","TMGDBAPI",231,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"File number '"_FileNumber_"' is not valid.") +"RTN","TMGDBAPI",232,0) + +"RTN","TMGDBAPI",233,0) + ;"Next, ensure Field exists in file +"RTN","TMGDBAPI",234,0) + if $$FieldExists(FileNumber,Field)=0 do goto GSFDone ;"abort +"RTN","TMGDBAPI",235,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Field number '"_Field_"' is not valid.") +"RTN","TMGDBAPI",236,0) + +"RTN","TMGDBAPI",237,0) + ;"Next, ensure field is a multiple and get field info. +"RTN","TMGDBAPI",238,0) + do GetFieldInfo(FileNumber,Field,"Output") +"RTN","TMGDBAPI",239,0) + if $data(Output("MULTIPLE-VALUED"))=0 do goto GSFDone ;"abort +"RTN","TMGDBAPI",240,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Field '"_Field_"' in File '"_FileNumber_"' is not a subfile.") +"RTN","TMGDBAPI",241,0) + +"RTN","TMGDBAPI",242,0) + ;"Now actually get subfile number +"RTN","TMGDBAPI",243,0) + if $data(Output("SPECIFIER"))=0 do goto GSFDone ;"abort +"RTN","TMGDBAPI",244,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find 'Specifier' (subfile number)") +"RTN","TMGDBAPI",245,0) + set result=+Output("SPECIFIER") +"RTN","TMGDBAPI",246,0) + +"RTN","TMGDBAPI",247,0) + ;"Now actually get subfile number +"RTN","TMGDBAPI",248,0) + ;"set Info=$get(^DD(FileNumber,Field,0),0) +"RTN","TMGDBAPI",249,0) + ;"if Info=0 do goto GSFDone +"RTN","TMGDBAPI",250,0) + ;". do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get information from data dictionary.") +"RTN","TMGDBAPI",251,0) + ;"set result=+$piece(Info,"^",2) +"RTN","TMGDBAPI",252,0) + +"RTN","TMGDBAPI",253,0) +GSFDone +"RTN","TMGDBAPI",254,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"SubFile number is: ",result) +"RTN","TMGDBAPI",255,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetSubFileNumber^TMGDBAPI") +"RTN","TMGDBAPI",256,0) + quit result +"RTN","TMGDBAPI",257,0) + +"RTN","TMGDBAPI",258,0) + +"RTN","TMGDBAPI",259,0) +IsSubFile(File) +"RTN","TMGDBAPI",260,0) + ;"Purpose: to return if file is actually a subfile +"RTN","TMGDBAPI",261,0) + ;"Input: File -- File name or number +"RTN","TMGDBAPI",262,0) + ;"Results: Parent file number^Field in Parent File +"RTN","TMGDBAPI",263,0) + ;" or 0 if not a subfile. +"RTN","TMGDBAPI",264,0) + +"RTN","TMGDBAPI",265,0) + new result +"RTN","TMGDBAPI",266,0) + if +File'=File set File=$$GetFileNum(File) +"RTN","TMGDBAPI",267,0) + set result=+$get(^DD(File,0,"UP")) +"RTN","TMGDBAPI",268,0) + if result'>0 goto ISFDone +"RTN","TMGDBAPI",269,0) + +"RTN","TMGDBAPI",270,0) + ;"Now find which field this sub file is in its parent +"RTN","TMGDBAPI",271,0) + new fldInParent set fldInParent=0 +"RTN","TMGDBAPI",272,0) + new field set field=0 +"RTN","TMGDBAPI",273,0) + new done set done=0 +"RTN","TMGDBAPI",274,0) + for set field=$order(^DD(result,field)) quit:(+field'>0)!(done=1) do +"RTN","TMGDBAPI",275,0) + . new fldInfo set fldInfo=$piece($get(^DD(result,field,0)),"^",2) +"RTN","TMGDBAPI",276,0) + . if +fldInfo=File set fldInParent=field set done=1 +"RTN","TMGDBAPI",277,0) + if fldInParent>0 set result=result_"^"_fldInParent +"RTN","TMGDBAPI",278,0) +ISFDone +"RTN","TMGDBAPI",279,0) + quit result +"RTN","TMGDBAPI",280,0) + +"RTN","TMGDBAPI",281,0) + +"RTN","TMGDBAPI",282,0) +GetSubFInfo(SubFileNum,Array) +"RTN","TMGDBAPI",283,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",284,0) + ;"Purpose: To take a subfile NUMBER, and return information about it. +"RTN","TMGDBAPI",285,0) + ;"Input: SubFileNum-- the sub file number +"RTN","TMGDBAPI",286,0) + ;" Array -- PASS BY REFERENCE. An array to receive results. +"RTN","TMGDBAPI",287,0) + ;" any preexisting data is deleted. +"RTN","TMGDBAPI",288,0) + ;"Output Array is formated as follows: +"RTN","TMGDBAPI",289,0) + ;" Array("SUBFILE","NUMBER")=file number of this sub file. +"RTN","TMGDBAPI",290,0) + ;" Array("SUBFILE","NAME")=file name of this sub file. +"RTN","TMGDBAPI",291,0) + ;" Array("PARENT","NUMBER")=parent file number +"RTN","TMGDBAPI",292,0) + ;" Array("PARENT","NAME")=parent file name +"RTN","TMGDBAPI",293,0) + ;" Array("PARENT","GL")=global reference of parent, in open format<-- only valid if parent isn't also a subfile +"RTN","TMGDBAPI",294,0) + ;" Array("FIELD IN PARENT","NUMBER")=field number of subfile in parent +"RTN","TMGDBAPI",295,0) + ;" Array("FIELD IN PARENT","NAME")=filed name of subfile in parent +"RTN","TMGDBAPI",296,0) + ;" Array("FIELD IN PARENT","LOC")=node and piece where subfile is stored +"RTN","TMGDBAPI",297,0) + ;" Array("FIELD IN PARENT","CODE")=code giving subfile's attributes. +"RTN","TMGDBAPI",298,0) + ;"Result: 1 if found info, or 0 if not found or invalid +"RTN","TMGDBAPI",299,0) + +"RTN","TMGDBAPI",300,0) + new result set result=0 +"RTN","TMGDBAPI",301,0) + if '$get(SubFileNum) goto GSPDone +"RTN","TMGDBAPI",302,0) + kill Array +"RTN","TMGDBAPI",303,0) + set Array("SUBFILE","NUMBER")=SubFileNum +"RTN","TMGDBAPI",304,0) + set Array("SUBFILE","NAME")=$piece($get(^DD(SubFileNum,0)),"^",1) +"RTN","TMGDBAPI",305,0) + new parent +"RTN","TMGDBAPI",306,0) + set parent=+$get(^DD(SubFileNum,0,"UP")) +"RTN","TMGDBAPI",307,0) + if parent=0 goto GSPDone +"RTN","TMGDBAPI",308,0) + set Array("PARENT","NUMBER")=parent +"RTN","TMGDBAPI",309,0) + set Array("PARENT","NAME")=$order(^DD(parent,0,"NM","")) +"RTN","TMGDBAPI",310,0) + set Array("PARENT","GL")=$get(^DIC(parent,0,"GL")) +"RTN","TMGDBAPI",311,0) + new i set i=$order(^DD(parent,"")) +"RTN","TMGDBAPI",312,0) + for do quit:(i="")!(result=1) ;"scan all fields for a match +"RTN","TMGDBAPI",313,0) + . quit:(i="") +"RTN","TMGDBAPI",314,0) + . new node,num +"RTN","TMGDBAPI",315,0) + . set node=$get(^DD(parent,i,0)) +"RTN","TMGDBAPI",316,0) + . if +$piece(node,"^",2)=SubFileNum do quit +"RTN","TMGDBAPI",317,0) + . . set Array("FIELD IN PARENT","NUMBER")=i +"RTN","TMGDBAPI",318,0) + . . set Array("FIELD IN PARENT","NAME")=$piece(node,"^",1) +"RTN","TMGDBAPI",319,0) + . . set Array("FIELD IN PARENT","LOC")=$piece(node,"^",4) +"RTN","TMGDBAPI",320,0) + . . set Array("FIELD IN PARENT","CODE")=$piece(node,"^",2) +"RTN","TMGDBAPI",321,0) + . . set result=1 +"RTN","TMGDBAPI",322,0) + . set i=$order(^DD(parent,i)) +"RTN","TMGDBAPI",323,0) + +"RTN","TMGDBAPI",324,0) +GSPDone +"RTN","TMGDBAPI",325,0) + quit result +"RTN","TMGDBAPI",326,0) + +"RTN","TMGDBAPI",327,0) + +"RTN","TMGDBAPI",328,0) + +"RTN","TMGDBAPI",329,0) +GetFieldInfo(FileNumber,Field,VarOutP,InfoS) +"RTN","TMGDBAPI",330,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",331,0) + ;"Purpose: To get Field info, +"RTN","TMGDBAPI",332,0) + ;"Input: FileNumber: File or subfile number +"RTN","TMGDBAPI",333,0) + ;" Field: Field name or number +"RTN","TMGDBAPI",334,0) + ;" VarOutP -- the NAME of the variable to put result into. +"RTN","TMGDBAPI",335,0) + ;" InfoS -- [OPTIONAL] -- additional attributes of field info to be looked up +"RTN","TMGDBAPI",336,0) + ;" (as allowed by FIELD^DID). Multiple items should be +"RTN","TMGDBAPI",337,0) + ;" separated by a semicolon (';') +"RTN","TMGDBAPI",338,0) + ;" e.g. "TITLE;LABEL;POINTER" +"RTN","TMGDBAPI",339,0) + ;"Output: Data is put into VarOutP (any thing in VarOutP is erased first +"RTN","TMGDBAPI",340,0) + ;" i.e. @VarOutP@("MULTIPLE-VALUED")=X +"RTN","TMGDBAPI",341,0) + ;" i.e. @VarOutP@("SPECIFIER")=Y +"RTN","TMGDBAPI",342,0) + ;" i.e. @VarOutP@("TYPE")=Z +"RTN","TMGDBAPI",343,0) + ;" i.e. @VarOutP@("StoreLoc")="0;1" <-- not from fileman output (i.e. extra info) +"RTN","TMGDBAPI",344,0) + ;" (if additional attributes were specified, they will also be in array) +"RTN","TMGDBAPI",345,0) + ;"Result: none +"RTN","TMGDBAPI",346,0) + +"RTN","TMGDBAPI",347,0) + kill @VarOutP ;"erase any old information +"RTN","TMGDBAPI",348,0) + +"RTN","TMGDBAPI",349,0) + if +Field=0 set Field=$$GetNumField(FileNumber,Field) +"RTN","TMGDBAPI",350,0) + set @VarOutP@("StoreLoc")=$piece($get(^DD(FileNumber,Field,0)),"^",4) +"RTN","TMGDBAPI",351,0) + +"RTN","TMGDBAPI",352,0) + new Attribs set Attribs="MULTIPLE-VALUED;SPECIFIER;TYPE" +"RTN","TMGDBAPI",353,0) + if $data(InfoS) set Attribs=Attribs_";"_InfoS +"RTN","TMGDBAPI",354,0) + ;"Next, check if field is a multiple and get field info. +"RTN","TMGDBAPI",355,0) + do FIELD^DID(FileNumber,Field,,Attribs,VarOutP,"TMGMsg") +"RTN","TMGDBAPI",356,0) + if $data(TMGMsg) do +"RTN","TMGDBAPI",357,0) + . if $data(TMGMsg("DIERR"))'=0 do quit +"RTN","TMGDBAPI",358,0) + . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAPI",359,0) + +"RTN","TMGDBAPI",360,0) +GFIDone +"RTN","TMGDBAPI",361,0) + quit +"RTN","TMGDBAPI",362,0) + +"RTN","TMGDBAPI",363,0) + +"RTN","TMGDBAPI",364,0) + +"RTN","TMGDBAPI",365,0) +HackWrite(GlobalP,FileNumber,IENS,FieldNum,Data) +"RTN","TMGDBAPI",366,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",367,0) + ;"Purpse: To force data into a field -- using low level 'hack' method +"RTN","TMGDBAPI",368,0) + ;"Input: GlobalP -- the NAME of the global to put this into, i.e. "^VA(200," +"RTN","TMGDBAPI",369,0) + ;" FileNumber- the file number +"RTN","TMGDBAPI",370,0) + ;" IENS -- the standard API IENS +"RTN","TMGDBAPI",371,0) + ;" FieldNum the field to put this into +"RTN","TMGDBAPI",372,0) + ;" Data -- the value to put in +"RTN","TMGDBAPI",373,0) + ;"Note: This can be used to put a value of "@" into a field +"RTN","TMGDBAPI",374,0) + ;"Result: 1 if ok to continue, 0=abort +"RTN","TMGDBAPI",375,0) + ;"!!!NOTICE: This is a very low level means of accessing the database. +"RTN","TMGDBAPI",376,0) + ;" The built in data verifiers, indexers etc etc will not be made aware of +"RTN","TMGDBAPI",377,0) + ;" changes made to the database through this method. USE ONLY WITH CAUTION. +"RTN","TMGDBAPI",378,0) + +"RTN","TMGDBAPI",379,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",380,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",381,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",382,0) + +"RTN","TMGDBAPI",383,0) + new result set result=cAbort +"RTN","TMGDBAPI",384,0) + +"RTN","TMGDBAPI",385,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"HackWrite^TMGDBAPI") +"RTN","TMGDBAPI",386,0) + +"RTN","TMGDBAPI",387,0) + if '$data(GlobalP) goto HWDone +"RTN","TMGDBAPI",388,0) + if '$data(FileNumber) goto HWDone +"RTN","TMGDBAPI",389,0) + if '$data(IENS) goto HWDone +"RTN","TMGDBAPI",390,0) + if '$data(FieldNum) goto HWDone +"RTN","TMGDBAPI",391,0) + if '$data(Data) goto HWDone +"RTN","TMGDBAPI",392,0) + +"RTN","TMGDBAPI",393,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"GlobalP: ",GlobalP) +"RTN","TMGDBAPI",394,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"File:",FileNumber) +"RTN","TMGDBAPI",395,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IENS:",IENS) +"RTN","TMGDBAPI",396,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum:",FieldNum) +"RTN","TMGDBAPI",397,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Data:",Data) +"RTN","TMGDBAPI",398,0) + +"RTN","TMGDBAPI",399,0) + new DDInfo +"RTN","TMGDBAPI",400,0) + new FieldInfo +"RTN","TMGDBAPI",401,0) + new Index,Part +"RTN","TMGDBAPI",402,0) + new OldData +"RTN","TMGDBAPI",403,0) + new RecNum +"RTN","TMGDBAPI",404,0) + +"RTN","TMGDBAPI",405,0) + ;"Get info from data dictionary r.e. where actual fields are stored in files. +"RTN","TMGDBAPI",406,0) + set DDInfo=$get(^DD(FileNumber,FieldNum,0)) +"RTN","TMGDBAPI",407,0) + if '$data(DDInfo) goto HWDone +"RTN","TMGDBAPI",408,0) + set FieldInfo=$piece(DDInfo,"^",4) +"RTN","TMGDBAPI",409,0) + if '$data(FieldInfo),(FieldInfo="") goto HWDone +"RTN","TMGDBAPI",410,0) + set Index=$piece(FieldInfo,";",1) +"RTN","TMGDBAPI",411,0) + set Part=$piece(FieldInfo,";",2) +"RTN","TMGDBAPI",412,0) + +"RTN","TMGDBAPI",413,0) + ;"Convert global form of ^VA(200, into ^VA(200) +"RTN","TMGDBAPI",414,0) + new Len +"RTN","TMGDBAPI",415,0) + set Len=$length(GlobalP) +"RTN","TMGDBAPI",416,0) + if $extract(GlobalP,Len)="," do +"RTN","TMGDBAPI",417,0) + . set $extract(GlobalP,Len)=")" +"RTN","TMGDBAPI",418,0) + +"RTN","TMGDBAPI",419,0) + set RecNum=$piece(IENS,",",1) +"RTN","TMGDBAPI",420,0) + if $piece(IENS,",",2)'="" do goto HWDone +"RTN","TMGDBAPI",421,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Hack writing to subfiles not supported") +"RTN","TMGDBAPI",422,0) + if $data(@GlobalP@(RecNum,Index))=0 goto HWDone +"RTN","TMGDBAPI",423,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part) +"RTN","TMGDBAPI",424,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"That line is now: ",@GlobalP@(RecNum,Index)) +"RTN","TMGDBAPI",425,0) + set OldData=$piece(@GlobalP@(RecNum,Index),"^",Part) +"RTN","TMGDBAPI",426,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"And that data item is now: '",OldData,"'") +"RTN","TMGDBAPI",427,0) + if Data'=OldData do +"RTN","TMGDBAPI",428,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Performing hack write") +"RTN","TMGDBAPI",429,0) + . set $piece(@GlobalP@(RecNum,Index),"^",Part)=Data +"RTN","TMGDBAPI",430,0) + . ;"Give Message +"RTN","TMGDBAPI",431,0) + . new Text +"RTN","TMGDBAPI",432,0) + . set Text(0)=" Caution" +"RTN","TMGDBAPI",433,0) + . set Text(1)="Yikes!" +"RTN","TMGDBAPI",434,0) + . set Text(2)=" " +"RTN","TMGDBAPI",435,0) + . set Text(3)="We just bypassed all safety measures, " +"RTN","TMGDBAPI",436,0) + . set Text(4)="and wrote directly to the database." +"RTN","TMGDBAPI",437,0) + . set Text(5)="Make sure you know what you are doing!!" +"RTN","TMGDBAPI",438,0) + . set Text(6)=" " +"RTN","TMGDBAPI",439,0) + . set Text(7)="File: "_FileNumber +"RTN","TMGDBAPI",440,0) + . set Text(8)="Field: "_FieldNum +"RTN","TMGDBAPI",441,0) + . set Text(9)="Prior value: '"_OldData_"'" +"RTN","TMGDBAPI",442,0) + . set Text(10)="New value: '"_Data_"'" +"RTN","TMGDBAPI",443,0) + . set Text(11)=" " +"RTN","TMGDBAPI",444,0) + . set Text(12)="(This was caused by using Flags='H' in" +"RTN","TMGDBAPI",445,0) + . set Text(13)="the XML script.)" +"RTN","TMGDBAPI",446,0) + . do PopupArray^TMGUSRIF(5,45,.Text) +"RTN","TMGDBAPI",447,0) + else do +"RTN","TMGDBAPI",448,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No need for hackwrite... the data is already what we want.") +"RTN","TMGDBAPI",449,0) + +"RTN","TMGDBAPI",450,0) +HWDone +"RTN","TMGDBAPI",451,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"HackWrite^TMGDBAPI") +"RTN","TMGDBAPI",452,0) + quit +"RTN","TMGDBAPI",453,0) + +"RTN","TMGDBAPI",454,0) + +"RTN","TMGDBAPI",455,0) +HandleHacksArray(MsgArray) +"RTN","TMGDBAPI",456,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",457,0) + ;"Purpose: To cycle through an array of hackwrites and process each one. +"RTN","TMGDBAPI",458,0) + ;"Input: HacksArray. Best if passed by reference +"RTN","TMGDBAPI",459,0) + ;" Expected format of array: +"RTN","TMGDBAPI",460,0) + ;" MsgArray(cHack,0,cEntries)=Number of Entries +"RTN","TMGDBAPI",461,0) + ;" MsgArray(cHack,n) = Global;FileNumber;IENS;FieldNum;Data +"RTN","TMGDBAPI",462,0) + ;" MsgArray(cHack,n,cFlags)=User specified Flags for field. +"RTN","TMGDBAPI",463,0) + ;"Output: database is changed +"RTN","TMGDBAPI",464,0) + ;"Result: 1 if ok to continue, 0=abort +"RTN","TMGDBAPI",465,0) + ;"!!!NOTICE: This is a very low level means of accessing the database. +"RTN","TMGDBAPI",466,0) + ;" The built in data verifiers, indexers etc etc will not be made aware of +"RTN","TMGDBAPI",467,0) + ;" changes made to the database through this method. USE ONLY WITH CAUTION. +"RTN","TMGDBAPI",468,0) + +"RTN","TMGDBAPI",469,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",470,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",471,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",472,0) + new cHack set cHack="H" +"RTN","TMGDBAPI",473,0) + new cEntries set cEntries="Entries" +"RTN","TMGDBAPI",474,0) + +"RTN","TMGDBAPI",475,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"HandleHacksArray^TMGDBAPI") +"RTN","TMGDBAPI",476,0) + +"RTN","TMGDBAPI",477,0) + new result set result=cOKToCont +"RTN","TMGDBAPI",478,0) + new index set index=1 +"RTN","TMGDBAPI",479,0) + new GlobalP,FileNum,IENS,FieldNum,Data +"RTN","TMGDBAPI",480,0) + new s +"RTN","TMGDBAPI",481,0) + +"RTN","TMGDBAPI",482,0) + for index=1:1:$get(MsgArray(cHack,0,cEntries)) do quit:(s="")!(result=cAbort) +"RTN","TMGDBAPI",483,0) + . set s=$get(MsgArray(cHack,index)) if s="" quit +"RTN","TMGDBAPI",484,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Processing: ",s) +"RTN","TMGDBAPI",485,0) + . set GlobalP=$piece(s,";",1) +"RTN","TMGDBAPI",486,0) + . set FileNum=$piece(s,";",2) +"RTN","TMGDBAPI",487,0) + . set IENS=$piece(s,";",3) +"RTN","TMGDBAPI",488,0) + . set FieldNum=$piece(s,";",4) +"RTN","TMGDBAPI",489,0) + . set Data=$piece(s,";",5) +"RTN","TMGDBAPI",490,0) + . set result=$$HackWrite(GlobalP,FileNum,IENS,FieldNum,Data) +"RTN","TMGDBAPI",491,0) + +"RTN","TMGDBAPI",492,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"HandleHacksArray^TMGDBAPI") +"RTN","TMGDBAPI",493,0) + quit result +"RTN","TMGDBAPI",494,0) + +"RTN","TMGDBAPI",495,0) + +"RTN","TMGDBAPI",496,0) +GetRecMatch(Data,RecNumIEN) +"RTN","TMGDBAPI",497,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",498,0) + ;"Purpose: Take Data array from DoUpload, and search in database +"RTN","TMGDBAPI",499,0) + ;" for a prior matching record +"RTN","TMGDBAPI",500,0) + ;"Input: Data - Data array will contain all the information that is to be uploaded +"RTN","TMGDBAPI",501,0) + ;" Fields that should be specifically matched will have "MATCHTHIS" fields. +"RTN","TMGDBAPI",502,0) + ;" A field may have a "MATCHTHIS" node meaning that the value +"RTN","TMGDBAPI",503,0) + ;" specified should be searched for. +"RTN","TMGDBAPI",504,0) + ;" Or, rarely, one may want to specifically search for a different +"RTN","TMGDBAPI",505,0) + ;" search value. This is stored in a "MATCHVALUE" node. This +"RTN","TMGDBAPI",506,0) + ;" node is ignored if "MATCHTHIS" node is present. +"RTN","TMGDBAPI",507,0) + ;" The .01 field always is used for searching. If not present, then +"RTN","TMGDBAPI",508,0) + ;" a "MATCHTHIS" node is assumed. +"RTN","TMGDBAPI",509,0) + ;" Example array: +"RTN","TMGDBAPI",510,0) + ;" Data(0,"FILE")="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGDBAPI",511,0) + ;" Data(1,".01")="BILL" +"RTN","TMGDBAPI",512,0) + ;" Data(1,".01","MATCHVALUE")="JOHN" <-- optional search value +"RTN","TMGDBAPI",513,0) + ;" Data(1,".01","MATCHTHIS")=1 +"RTN","TMGDBAPI",514,0) + ;" Data(1,".02")="Sue" +"RTN","TMGDBAPI",515,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGDBAPI",516,0) + ;" Data(1,".03",cFlags)=any flags given (only present if user specified) +"RTN","TMGDBAPI",517,0) + ;" RecNumIEN -- MUST PASS BY REFERENCE. An OUT parameter to receive results +"RTN","TMGDBAPI",518,0) + ;"Output: Returns answer in RecNumIEN (record number in file) if found, or 0 otherwise +"RTN","TMGDBAPI",519,0) + ;"Result: 1=OKToContinue, 0=Abort +"RTN","TMGDBAPI",520,0) + ;"Note: +"RTN","TMGDBAPI",521,0) + ;" * Data in Multiple fields are NOT used for matching. +"RTN","TMGDBAPI",522,0) + ;" * I am not going to support matching for subrecords (i.e. SubEntry stuff above) +"RTN","TMGDBAPI",523,0) + ;" * If data passed is a subset of a larger data group (i.e. when this function +"RTN","TMGDBAPI",524,0) + ;" is called recursively to handle a subfile), then an entry will be placed +"RTN","TMGDBAPI",525,0) + ;" in the Data(0,cParentIENS) that will specify the RecNumIEN of the parent record +"RTN","TMGDBAPI",526,0) + ;" holding this subfile. +"RTN","TMGDBAPI",527,0) + +"RTN","TMGDBAPI",528,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",529,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",530,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",531,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGDBAPI",532,0) + +"RTN","TMGDBAPI",533,0) + new FileNumber,FieldNum +"RTN","TMGDBAPI",534,0) + set RecNumIEN=0 +"RTN","TMGDBAPI",535,0) + new IENS,Fields,Flags +"RTN","TMGDBAPI",536,0) + new MatchValue set MatchValue="" +"RTN","TMGDBAPI",537,0) + new FieldMatch set FieldMatch="" +"RTN","TMGDBAPI",538,0) + new ScreenCode +"RTN","TMGDBAPI",539,0) + new Matches,NumMatches +"RTN","TMGDBAPI",540,0) + new TMGMsg +"RTN","TMGDBAPI",541,0) + new result set result=cOKToCont +"RTN","TMGDBAPI",542,0) + new index +"RTN","TMGDBAPI",543,0) + new SlimData ;"Will hold just those fields that should be matched against +"RTN","TMGDBAPI",544,0) + new OneMatch +"RTN","TMGDBAPI",545,0) + +"RTN","TMGDBAPI",546,0) + set IENS=$get(Data(0,cParentIENS)) +"RTN","TMGDBAPI",547,0) + if IENS'="" if $extract(IENS,1)'="," do +"RTN","TMGDBAPI",548,0) + . set IENS=","_IENS +"RTN","TMGDBAPI",549,0) + +"RTN","TMGDBAPI",550,0) + set Fields="@" +"RTN","TMGDBAPI",551,0) + ;"Setup specifier to tell which fields to return info on +"RTN","TMGDBAPI",552,0) + new done set done=0 +"RTN","TMGDBAPI",553,0) + set index=0 +"RTN","TMGDBAPI",554,0) + for set index=$order(Data(index)) quit:(index="")!done do +"RTN","TMGDBAPI",555,0) + . set FieldNum="" +"RTN","TMGDBAPI",556,0) + . for set FieldNum=$order(Data(index,FieldNum)) quit:(+FieldNum=0) do +"RTN","TMGDBAPI",557,0) + . . if $get(Data(index,FieldNum,"MATCHTHIS"))=1 do +"RTN","TMGDBAPI",558,0) + . . . set FieldMatch=$get(Data(index,FieldNum)) +"RTN","TMGDBAPI",559,0) + . . else set FieldMatch=$get(Data(index,FieldNum,"MATCHVALUE")) +"RTN","TMGDBAPI",560,0) + . . if FieldNum=".01" do +"RTN","TMGDBAPI",561,0) + . . . if FieldMatch="" set FieldMatch=$get(Data(index,.01)) +"RTN","TMGDBAPI",562,0) + . . . set MatchValue=FieldMatch +"RTN","TMGDBAPI",563,0) + . . if FieldMatch'="" do +"RTN","TMGDBAPI",564,0) + . . . set Fields=Fields_";"_FieldNum +"RTN","TMGDBAPI",565,0) + . . . set SlimData(FieldNum)=FieldMatch +"RTN","TMGDBAPI",566,0) + . . . set FieldMatch="" +"RTN","TMGDBAPI",567,0) + . set done=1 ;"Force handling only 1 entry (i.e. #1), then quit after first cycle. +"RTN","TMGDBAPI",568,0) + +"RTN","TMGDBAPI",569,0) + set FileNumber=$get(Data(0,"FILE")) +"RTN","TMGDBAPI",570,0) + set ScreenCode="" +"RTN","TMGDBAPI",571,0) + set Flags="" +"RTN","TMGDBAPI",572,0) + +"RTN","TMGDBAPI",573,0) + ;"====================================================== +"RTN","TMGDBAPI",574,0) + ;"Call FIND^DIC +"RTN","TMGDBAPI",575,0) + ;"====================================================== +"RTN","TMGDBAPI",576,0) + ;"Params: +"RTN","TMGDBAPI",577,0) + ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS +"RTN","TMGDBAPI",578,0) + do FIND^DIC(FileNumber,$get(IENS),Fields,Flags,MatchValue,"*",,ScreenCode,,"Matches","TMGMsg") +"RTN","TMGDBAPI",579,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::FIND^DIC") +"RTN","TMGDBAPI",580,0) + ;"====================================================== +"RTN","TMGDBAPI",581,0) + ;"====================================================== +"RTN","TMGDBAPI",582,0) + +"RTN","TMGDBAPI",583,0) + if $data(TMGMsg) do +"RTN","TMGDBAPI",584,0) + . if $data(TMGMsg("DIERR"))'=0 do quit +"RTN","TMGDBAPI",585,0) + . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAPI",586,0) + . . set result=cAbort +"RTN","TMGDBAPI",587,0) + if result=cAbort goto GRMQuit +"RTN","TMGDBAPI",588,0) + +"RTN","TMGDBAPI",589,0) + if $data(Matches("DILIST"))=0 goto GRMQuit ;"keep RecNumIEN default of 0 +"RTN","TMGDBAPI",590,0) + set NumMatches=$piece(Matches("DILIST",0),"^",1) +"RTN","TMGDBAPI",591,0) + if NumMatches=0 goto GRMQuit ;"keep RecNumIEN default of 0 +"RTN","TMGDBAPI",592,0) + +"RTN","TMGDBAPI",593,0) + for index=1:1:NumMatches do quit:RecNumIEN'=0 ;"Note: FIRST match returned. +"RTN","TMGDBAPI",594,0) + . kill OneMatch +"RTN","TMGDBAPI",595,0) + . merge OneMatch=Matches("DILIST","ID",index) +"RTN","TMGDBAPI",596,0) + . if $$CompRec(FileNumber,.OneMatch,.SlimData) set RecNumIEN=Matches("DILIST",2,index) +"RTN","TMGDBAPI",597,0) + +"RTN","TMGDBAPI",598,0) +GRMQuit +"RTN","TMGDBAPI",599,0) + quit result +"RTN","TMGDBAPI",600,0) + +"RTN","TMGDBAPI",601,0) + +"RTN","TMGDBAPI",602,0) +CompRec(FileNumber,dbRec,TestRec) +"RTN","TMGDBAPI",603,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",604,0) + ;"Purpose: To compare data from the database against a test match +"RTN","TMGDBAPI",605,0) + ;"Input: FileNumber: the file data is from +"RTN","TMGDBAPI",606,0) + ;" dbRec, an array of data from the database in the following format +"RTN","TMGDBAPI",607,0) + ;" dbRec(.01)="JOHNS,BILL" +"RTN","TMGDBAPI",608,0) + ;" dbRec(.02)="MALE" +"RTN","TMGDBAPI",609,0) + ;" dbRec(.03)="01/20/1957" +"RTN","TMGDBAPI",610,0) + ;" dbRec(.07)="(123) 555-1212" +"RTN","TMGDBAPI",611,0) + ;" TestRec, an array of data to test for match with, in same format +"RTN","TMGDBAPI",612,0) + ;" as above. Note: there may well be less entries in this array +"RTN","TMGDBAPI",613,0) + ;" than in the dbRec +"RTN","TMGDBAPI",614,0) + ;" TestRec(.01)="JOHNS,BILL" +"RTN","TMGDBAPI",615,0) + ;" TestRec(.03)="01/20/1957" +"RTN","TMGDBAPI",616,0) + ;"Output: 1 if all values in TestRec=dbRec. 0=conflict +"RTN","TMGDBAPI",617,0) + ;" Note: values in dbRec that don't have a corresponding entry in TestRec +"RTN","TMGDBAPI",618,0) + ;" are ignored. +"RTN","TMGDBAPI",619,0) + +"RTN","TMGDBAPI",620,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",621,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",622,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",623,0) + +"RTN","TMGDBAPI",624,0) + new result set result=cOKToCont +"RTN","TMGDBAPI",625,0) + new index set index="" +"RTN","TMGDBAPI",626,0) + new FieldType,TMGFDA,TMGMsg +"RTN","TMGDBAPI",627,0) + new dbIDT,testIDT ;" IDT = internal form of date/time +"RTN","TMGDBAPI",628,0) + +"RTN","TMGDBAPI",629,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CompRec^TMGDBAPI") +"RTN","TMGDBAPI",630,0) + +"RTN","TMGDBAPI",631,0) + if TMGDEBUG do +"RTN","TMGDBAPI",632,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is records to be compared") +"RTN","TMGDBAPI",633,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"dbRec:") +"RTN","TMGDBAPI",634,0) + . do ArrayDump^TMGDEBUG("dbRec") ;"zwr dbRec(*) +"RTN","TMGDBAPI",635,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TestRec:") +"RTN","TMGDBAPI",636,0) + . do ArrayDump^TMGDEBUG("TestRec") ;"zwr TestRec(*) +"RTN","TMGDBAPI",637,0) + +"RTN","TMGDBAPI",638,0) +CRLoop +"RTN","TMGDBAPI",639,0) + set index=$order(TestRec(index)) +"RTN","TMGDBAPI",640,0) + if index="" goto CRDone +"RTN","TMGDBAPI",641,0) + if $data(dbRec(index))=0 goto CRLoop +"RTN","TMGDBAPI",642,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Comparing field ",index) +"RTN","TMGDBAPI",643,0) + kill TMGFDA,TMGMsg +"RTN","TMGDBAPI",644,0) + do FIELD^DID(FileNumber,index,,"TYPE","TMGFDA","TMGMsg") +"RTN","TMGDBAPI",645,0) + if $get(TMGFDA("TYPE"))="DATE/TIME" do goto CRDone:'result +"RTN","TMGDBAPI",646,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Doing special date comparison") +"RTN","TMGDBAPI",647,0) + . set X=TestRec(index) +"RTN","TMGDBAPI",648,0) + . do ^%DT ;"convert date/time into internal format +"RTN","TMGDBAPI",649,0) + . set testIDT=Y +"RTN","TMGDBAPI",650,0) + . set X=dbRec(index) +"RTN","TMGDBAPI",651,0) + . do ^%DT ;"convert date/time into internal format +"RTN","TMGDBAPI",652,0) + . set dbIDT=Y +"RTN","TMGDBAPI",653,0) + . if testIDT'=dbIDT do +"RTN","TMGDBAPI",654,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Dates not equal: ",TestRec(index)," vs, ",dbRec(index)) +"RTN","TMGDBAPI",655,0) + . . set result=cAbort +"RTN","TMGDBAPI",656,0) + else if TestRec(index)'=dbRec(index) do goto CRDone ;"Note: simple '=' compare +"RTN","TMGDBAPI",657,0) + . set result=cAbort +"RTN","TMGDBAPI",658,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Fields are equal") +"RTN","TMGDBAPI",659,0) + goto CRLoop +"RTN","TMGDBAPI",660,0) +CRDone +"RTN","TMGDBAPI",661,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Leaving CompRec. Result=",result," (0 if conflict)") +"RTN","TMGDBAPI",662,0) + +"RTN","TMGDBAPI",663,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CompRec^TMGDBAPI") +"RTN","TMGDBAPI",664,0) + quit result +"RTN","TMGDBAPI",665,0) + +"RTN","TMGDBAPI",666,0) + +"RTN","TMGDBAPI",667,0) +UploadData(Data,RecNumIEN) +"RTN","TMGDBAPI",668,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",669,0) + ;"Purpose: Do actual upload of Data, given in specific format +"RTN","TMGDBAPI",670,0) + ;"Note: This function may be called recursively by subfiles +"RTN","TMGDBAPI",671,0) + ;"Input: Data -- data in format show at TOP OF THIS FILE +"RTN","TMGDBAPI",672,0) + ;" Note: If this function is being passed recursively, then the data +"RTN","TMGDBAPI",673,0) + ;" passed is probably just a subpart that corresponds to the subfile +"RTN","TMGDBAPI",674,0) + ;" RecNumIEN -- OPTIONAL pameter. May be used to specify the +"RTN","TMGDBAPI",675,0) + ;" record to force data into. If passed by reference, then +"RTN","TMGDBAPI",676,0) + ;" record number (IEN) where data was placed is passed back. +"RTN","TMGDBAPI",677,0) + ;" Use of this parameter only makes sense when filing the highest +"RTN","TMGDBAPI",678,0) + ;" level file. (When filing subfiles recursively, then the parent +"RTN","TMGDBAPI",679,0) + ;" record number is stored in (0,cParentIENS)=",10033," e.g.) +"RTN","TMGDBAPI",680,0) + ;"Output: Information will be put into global database, based on +"RTN","TMGDBAPI",681,0) + ;" entries in Data. +"RTN","TMGDBAPI",682,0) + ;" Record number (IEN) of record will be put into RecNumIEN (or 0 if error) +"RTN","TMGDBAPI",683,0) + ;"Result: Returns success 1=OK to continue. 0=Abort +"RTN","TMGDBAPI",684,0) + +"RTN","TMGDBAPI",685,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",686,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",687,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",688,0) + new cEntries set cEntries="Entries" +"RTN","TMGDBAPI",689,0) + +"RTN","TMGDBAPI",690,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"UploadData^TMGDBAPI") +"RTN","TMGDBAPI",691,0) + +"RTN","TMGDBAPI",692,0) + new result set result=cOKToCont +"RTN","TMGDBAPI",693,0) + new NumEntries +"RTN","TMGDBAPI",694,0) + new index +"RTN","TMGDBAPI",695,0) + +"RTN","TMGDBAPI",696,0) + set RecNumIEN=$get(RecNumIEN,0) ;"See if user-specified IEN was given. +"RTN","TMGDBAPI",697,0) + +"RTN","TMGDBAPI",698,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNumIEN=",RecNumIEN) +"RTN","TMGDBAPI",699,0) + +"RTN","TMGDBAPI",700,0) + if RecNumIEN'=0 do goto UDDone:(result=cAbort) +"RTN","TMGDBAPI",701,0) + . new Params,MyOutVar +"RTN","TMGDBAPI",702,0) + . set Params("FILE")=$get(Data(0,"FILE")) +"RTN","TMGDBAPI",703,0) + . set Params(cRecNum)=RecNumIEN +"RTN","TMGDBAPI",704,0) + . set Params(cField)=".01" +"RTN","TMGDBAPI",705,0) + . set Params(cOutput)="MyOutVar" +"RTN","TMGDBAPI",706,0) + . set result=$$ValueLookup(.Params) ;"result=0 (cAbort) if unsuccessful lookup +"RTN","TMGDBAPI",707,0) + . if result=cAbort do +"RTN","TMGDBAPI",708,0) + . . if $data(PriorErrorFound)=0 new PriorErrorFound +"RTN","TMGDBAPI",709,0) + . . new s set s="Unable to overwrite data into record#"_RecNumIEN_" because that record does not already exist.\n" +"RTN","TMGDBAPI",710,0) + . . set s=s_"Will try to put data into a new record, which may not be record#"_RecNumIEN +"RTN","TMGDBAPI",711,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,s) +"RTN","TMGDBAPI",712,0) + . . set result=cOKToCont +"RTN","TMGDBAPI",713,0) + . . set PriorErrorFound=0 ;"clear errors and continue program. +"RTN","TMGDBAPI",714,0) + . . set RecNumIEN=0 +"RTN","TMGDBAPI",715,0) + +"RTN","TMGDBAPI",716,0) + set NumEntries=$get(Data(0,cEntries)) +"RTN","TMGDBAPI",717,0) + for index=1:1:NumEntries do quit:(result=cAbort) +"RTN","TMGDBAPI",718,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting loop to process all uploadData entries. Entry=",index) +"RTN","TMGDBAPI",719,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNumIEN=",RecNumIEN) +"RTN","TMGDBAPI",720,0) + . new tData ;"Create a tData array that has only 1 entry in it. +"RTN","TMGDBAPI",721,0) + . merge tData(0)=Data(0) +"RTN","TMGDBAPI",722,0) + . set tData(0,cEntries)=1 +"RTN","TMGDBAPI",723,0) + . merge tData(1)=Data(index) +"RTN","TMGDBAPI",724,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"This is entry to process") +"RTN","TMGDBAPI",725,0) + . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("tData") +"RTN","TMGDBAPI",726,0) + . if RecNumIEN=0 set result=$$GetRecMatch(.tData,.RecNumIEN) ;"if no prior record, returns 0 +"RTN","TMGDBAPI",727,0) + . if result=cAbort quit ;//kt added 1/6/05 +"RTN","TMGDBAPI",728,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Using RecNumIEN=",RecNumIEN) +"RTN","TMGDBAPI",729,0) + . ; +"RTN","TMGDBAPI",730,0) + . if RecNumIEN=0 do quit:(result=cAbort) +"RTN","TMGDBAPI",731,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling AddRec") +"RTN","TMGDBAPI",732,0) + . . new AddRecNum +"RTN","TMGDBAPI",733,0) + . . set AddRecNum=$$AddRec(.tData) +"RTN","TMGDBAPI",734,0) + . . if AddRecNum=0 do quit +"RTN","TMGDBAPI",735,0) + . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error adding a record.") +"RTN","TMGDBAPI",736,0) + . . . set result=cAbort +"RTN","TMGDBAPI",737,0) + . else do quit:(result=cAbort) +"RTN","TMGDBAPI",738,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling Overwriterec") +"RTN","TMGDBAPI",739,0) + . . set result=$$OverwriteRec(RecNumIEN,.tData) +"RTN","TMGDBAPI",740,0) + . . set RecNumIEN=0 ;"We won't to file any more into that record num, force search next cycle. +"RTN","TMGDBAPI",741,0) + . . if result=cAbort do quit +"RTN","TMGDBAPI",742,0) + . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error modifying an existing record.") +"RTN","TMGDBAPI",743,0) + +"RTN","TMGDBAPI",744,0) +UDDone +"RTN","TMGDBAPI",745,0) + ;"if (result'=cAbort) set result=(RecNumIEN>0) +"RTN","TMGDBAPI",746,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Result = ",result) +"RTN","TMGDBAPI",747,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"UploadData^TMGDBAPI") +"RTN","TMGDBAPI",748,0) + quit result +"RTN","TMGDBAPI",749,0) + +"RTN","TMGDBAPI",750,0) + +"RTN","TMGDBAPI",751,0) + +"RTN","TMGDBAPI",752,0) +ValueLookup(Params) +"RTN","TMGDBAPI",753,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",754,0) + ;"Purpose: To look for a value of a given value in a given record in given file. +"RTN","TMGDBAPI",755,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGDBAPI",756,0) + ;" Params("FILE")="NEW PERSON" in our example +"RTN","TMGDBAPI",757,0) + ;" Params(cRecNum)="1" in example +"RTN","TMGDBAPI",758,0) + ;" Params(cField)=".01" in our example (could be Name of field) +"RTN","TMGDBAPI",759,0) + ;" Params(cOutput)="MyVar" +"RTN","TMGDBAPI",760,0) + ;"Output: MyVar is loaded with data, i.e.: +"RTN","TMGDBAPI",761,0) + ;" MyVar("FILE")=200 +"RTN","TMGDBAPI",762,0) + ;" MyVar(cGlobal)="^VA(200)" +"RTN","TMGDBAPI",763,0) + ;" MyVar(cGlobal,cOpen)="^VA(200," +"RTN","TMGDBAPI",764,0) + ;" MyVar(cRecNum)=1 +"RTN","TMGDBAPI",765,0) + ;" MyVar(cField)=.01 +"RTN","TMGDBAPI",766,0) + ;" MyVar(cValue)=xxx <-- the looked-up value +"RTN","TMGDBAPI",767,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=unsuccessful lookup +"RTN","TMGDBAPI",768,0) + ;"Note: I am getting values by directly looking into database, rather than use +"RTN","TMGDBAPI",769,0) + ;" the usual lookup commands. I am doing this so that there will be no +"RTN","TMGDBAPI",770,0) + ;" 'hidden' data, based on security etc. +"RTN","TMGDBAPI",771,0) + ;" **I need to check, but this probably means that the data returned will be +"RTN","TMGDBAPI",772,0) + ;" in INTERNAL FILEMAN FORMAT (i.e. time values are encoded etc.) +"RTN","TMGDBAPI",773,0) + +"RTN","TMGDBAPI",774,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",775,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",776,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",777,0) + new cField set cField="FIELD" ;"Field" +"RTN","TMGDBAPI",778,0) + new cNull set cNull="(none)" +"RTN","TMGDBAPI",779,0) + new cRecNum set cRecNum="RECNUM" ;"RecNum +"RTN","TMGDBAPI",780,0) + new cOutput set cOutput="OUTVAR" ;"OutVar" +"RTN","TMGDBAPI",781,0) + new cGlobal set cGlobal="GLOBAL" +"RTN","TMGDBAPI",782,0) + new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue" +"RTN","TMGDBAPI",783,0) + new cOpen set cOpen="OPEN" +"RTN","TMGDBAPI",784,0) + +"RTN","TMGDBAPI",785,0) + +"RTN","TMGDBAPI",786,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ValueLookup^TMGDBAPI") +"RTN","TMGDBAPI",787,0) + new result set result=cAbort +"RTN","TMGDBAPI",788,0) + +"RTN","TMGDBAPI",789,0) + new Data +"RTN","TMGDBAPI",790,0) + new DDInfo +"RTN","TMGDBAPI",791,0) + new FieldInfo +"RTN","TMGDBAPI",792,0) + new Index,Part +"RTN","TMGDBAPI",793,0) + +"RTN","TMGDBAPI",794,0) + new Field set Field=$get(Params(cField),cNull) +"RTN","TMGDBAPI",795,0) + new RecNum set RecNum=$get(Params(cRecNum),cNull) +"RTN","TMGDBAPI",796,0) + new OutVarP set OutVarP=$get(Params(cOutput),cNull) +"RTN","TMGDBAPI",797,0) + if (RecNum=cNull),(OutVarP=cNull) goto DVLUDone +"RTN","TMGDBAPI",798,0) + kill @OutVarP ;"--ensure old variables in output variable are removed. +"RTN","TMGDBAPI",799,0) + +"RTN","TMGDBAPI",800,0) + set Data(0,"FILE")=$get(Params("FILE")) +"RTN","TMGDBAPI",801,0) + set result=$$SetupFileNum(.Data) +"RTN","TMGDBAPI",802,0) + if result=cAbort goto DVLUDone +"RTN","TMGDBAPI",803,0) + new FileNum set FileNum=$get(Data(0,"FILE"),cNull) +"RTN","TMGDBAPI",804,0) + new GlobalP set GlobalP=$get(Data(0,"FILE",cGlobal),cNull) +"RTN","TMGDBAPI",805,0) + if (FileNum=cNull),(GlobalP=cNull) goto DVLUDone +"RTN","TMGDBAPI",806,0) + new FieldNum set FieldNum=$$GetNumField(FileNum,Field) +"RTN","TMGDBAPI",807,0) + if FieldNum=0 goto DVLUDone +"RTN","TMGDBAPI",808,0) + +"RTN","TMGDBAPI",809,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"GlobalP: ",GlobalP) +"RTN","TMGDBAPI",810,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"File: ",FileNum) +"RTN","TMGDBAPI",811,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Rec#: ",RecNum) +"RTN","TMGDBAPI",812,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum: ",FieldNum) +"RTN","TMGDBAPI",813,0) + +"RTN","TMGDBAPI",814,0) + ;"Get info from data dictionary r.e. where actual fields are stored in files. +"RTN","TMGDBAPI",815,0) + set DDInfo=$get(^DD(FileNum,FieldNum,0)) +"RTN","TMGDBAPI",816,0) + if $data(DDInfo)=0 goto HWDone +"RTN","TMGDBAPI",817,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DDInfo='",DDInfo,"', $data(DDInfo)=",$data(DDinfo)) +"RTN","TMGDBAPI",818,0) + set FieldInfo=$piece(DDInfo,"^",4) +"RTN","TMGDBAPI",819,0) + if '$data(FieldInfo),(FieldInfo="") goto DVLUDone +"RTN","TMGDBAPI",820,0) + set Index=$piece(FieldInfo,";",1) +"RTN","TMGDBAPI",821,0) + set Part=$piece(FieldInfo,";",2) +"RTN","TMGDBAPI",822,0) + +"RTN","TMGDBAPI",823,0) + if $data(@GlobalP@(RecNum,Index))=0 goto DVLUDone +"RTN","TMGDBAPI",824,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part) +"RTN","TMGDBAPI",825,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"That line is now: ",@GlobalP@(RecNum,Index)) +"RTN","TMGDBAPI",826,0) + set Data=$piece(@GlobalP@(RecNum,Index),"^",Part) +"RTN","TMGDBAPI",827,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"And our value is: ",Data) +"RTN","TMGDBAPI",828,0) + +"RTN","TMGDBAPI",829,0) + kill @OutVarP +"RTN","TMGDBAPI",830,0) + set @OutVarP@("FILE")=FileNum +"RTN","TMGDBAPI",831,0) + set @OutVarP@(cRecNum)=RecNum +"RTN","TMGDBAPI",832,0) + set @OutVarP@(cField)=FieldNum +"RTN","TMGDBAPI",833,0) + set @OutVarP@(cValue)=Data +"RTN","TMGDBAPI",834,0) + set @OutVarP@(cGlobal)=GlobalP +"RTN","TMGDBAPI",835,0) + set @OutVarP@(cGlobal,cOpen)=$get(Data(0,"FILE",cGlobal,cOpen)) +"RTN","TMGDBAPI",836,0) + +"RTN","TMGDBAPI",837,0) + set result=cOKToCont +"RTN","TMGDBAPI",838,0) + +"RTN","TMGDBAPI",839,0) +DVLUDone +"RTN","TMGDBAPI",840,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ValueLookup^TMGDBAPI") +"RTN","TMGDBAPI",841,0) + quit result +"RTN","TMGDBAPI",842,0) + +"RTN","TMGDBAPI",843,0) + +"RTN","TMGDBAPI",844,0) +FileUtility(Params) +"RTN","TMGDBAPI",845,0) + ;"PUBLIC FUNCTION +"RTN","TMGDBAPI",846,0) + ;"Purpose: To provide file access/manipulation utilities to script user +"RTN","TMGDBAPI",847,0) + ;"syntax: +"RTN","TMGDBAPI",848,0) + ;" +"RTN","TMGDBAPI",849,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGDBAPI",850,0) + ;" Params("FILE")="NEW PERSON" for example +"RTN","TMGDBAPI",851,0) + ;" File: The name of the file to act upon. +"RTN","TMGDBAPI",852,0) + ;" File may have subnodes (i.e. "NEW PERSON|ALIAS|TITLE") +"RTN","TMGDBAPI",853,0) + ;" **BUT**, any deletion or set values will only work on top level (i.e. "NEW PERSON") +"RTN","TMGDBAPI",854,0) + ;" Params(cFn)="info" or "delete", or "set" [OPTIONAL] +"RTN","TMGDBAPI",855,0) + ;" Fn="delete" If Field is not specified: +"RTN","TMGDBAPI",856,0) + ;" Will cause record RecNum to be deleted. +"RTN","TMGDBAPI",857,0) + ;" MyOutVar("DELETED")=RecNum of deleted record, or +"RTN","TMGDBAPI",858,0) + ;" 0 if not found. +"RTN","TMGDBAPI",859,0) + ;" If Field IS specified: +"RTN","TMGDBAPI",860,0) + ;" Will delete the value in field, in record RecNum +"RTN","TMGDBAPI",861,0) + ;" Note: delete is intended only for the highest-level records +"RTN","TMGDBAPI",862,0) + ;" (i.e. not subfiels, or multiple fields) +"RTN","TMGDBAPI",863,0) + ;" Note: delete method uses ^DIK to delete the record +"RTN","TMGDBAPI",864,0) + ;" Fn="info" Will just fill in info below. +"RTN","TMGDBAPI",865,0) + ;" If Fn not specified, this is default +"RTN","TMGDBAPI",866,0) + ;" Fn="set" Will put Value into Field, in RecNum, in File (all required) +"RTN","TMGDBAPI",867,0) + ;" Params(cRecNum)="1" for example +"RTN","TMGDBAPI",868,0) + ;" RecNum: [OPTIONAL] Specifies which record to act on. If not +"RTN","TMGDBAPI",869,0) + ;" specified, then just file info is returned. +"RTN","TMGDBAPI",870,0) + ;" Params(cField)=".01" for example (could be Name of field) +"RTN","TMGDBAPI",871,0) + ;" Field: [OPTIONAL] Specifies which field to act on. +"RTN","TMGDBAPI",872,0) + ;" Params(cOutput)="MyVar" +"RTN","TMGDBAPI",873,0) + ;" OutVar: Needed to get information back from function (but still Optional) +"RTN","TMGDBAPI",874,0) + ;" Gives name of variable to put info into. +"RTN","TMGDBAPI",875,0) + ;"Output: MyVar is loaded with data, i.e. +"RTN","TMGDBAPI",876,0) + ;" i.e. MyOutVar("FILE")=Filenumber +"RTN","TMGDBAPI",877,0) + ;" MyOutVar("FILE","FILE")=SubFilenumber <-- only if subnodes input in File name (e.g."ALIAS") +"RTN","TMGDBAPI",878,0) + ;" MyOutVar("FILE","FILE","FILE")=SubSubFilenumber <-- only if subnodes input in File name (e.g."TITLE") +"RTN","TMGDBAPI",879,0) + ;" MyOutVar("GLOBAL")="^VA(200)" +"RTN","TMGDBAPI",880,0) + ;" MyOutVar("GLOBAL, OPEN")="^VA(200," +"RTN","TMGDBAPI",881,0) + ;" MyOutVar("RECNUM")=record number +"RTN","TMGDBAPI",882,0) + ;" MyOutVar("FIELD")=Filenumber +"RTN","TMGDBAPI",883,0) + ;" MyOutVar("VALUE")=xxxx <=== value of field (PRIOR TO deletion, if deleted) +"RTN","TMGDBAPI",884,0) + ;" MyOutVar("NEXTREC")=record number after RecNum, or "" if none +"RTN","TMGDBAPI",885,0) + ;" MyOutVar("PREVREC")=record number before RecNum, or "" if none +"RTN","TMGDBAPI",886,0) + ;" MyOutVar("FN")=the function executed +"RTN","TMGDBAPI",887,0) + ;" MyOutVar("NUMRECS")=Number of records in file PRIOR to any deletions +"RTN","TMGDBAPI",888,0) + ;" MyOutVar("FIRSTREC")=Rec number of first record in file +"RTN","TMGDBAPI",889,0) + ;" MyOutVar("LASTREC")=Rec number of last record in file +"RTN","TMGDBAPI",890,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort +"RTN","TMGDBAPI",891,0) + ;"Note: I am getting values by directly looking into database, rather than use +"RTN","TMGDBAPI",892,0) + ;" the usual lookup commands. I am doing this so that there will be no +"RTN","TMGDBAPI",893,0) + ;" 'hidden' data, based on security etc. +"RTN","TMGDBAPI",894,0) + +"RTN","TMGDBAPI",895,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",896,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",897,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",898,0) + new cField set cField="FIELD" ;"Field" +"RTN","TMGDBAPI",899,0) + new cNull set cNull="(none)" +"RTN","TMGDBAPI",900,0) + new cRecNum set cRecNum="RECNUM" ;"RecNum +"RTN","TMGDBAPI",901,0) + new cRecord set cRecord="RECORD" ;"Record" +"RTN","TMGDBAPI",902,0) + new cOutput set cOutput="OUTVAR" ;"OutVar" +"RTN","TMGDBAPI",903,0) + new cGlobal set cGlobal="GLOBAL" +"RTN","TMGDBAPI",904,0) + new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue" +"RTN","TMGDBAPI",905,0) + new cOpen set cOpen="OPEN" +"RTN","TMGDBAPI",906,0) + new cInfo set cInfo="INFO" ;"Info +"RTN","TMGDBAPI",907,0) + if $data(cNodeDiv)#10=0 new cNodeDiv set cNodeDiv="|" +"RTN","TMGDBAPI",908,0) + new cDelete set cDelete="DELETE" ;"Delete +"RTN","TMGDBAPI",909,0) + new cNextRec set cNextRec="NEXTREC" +"RTN","TMGDBAPI",910,0) + new cPrev set cPrev="PREV" +"RTN","TMGDBAPI",911,0) + new cNumRecs set cNumRecs="NUMRECS" +"RTN","TMGDBAPI",912,0) + new cFirstRec set cFirstRec="FIRSTREC" +"RTN","TMGDBAPI",913,0) + new cLastRec set cLastRec="LASTREC" +"RTN","TMGDBAPI",914,0) + +"RTN","TMGDBAPI",915,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoFileUtility^TMGDBAPI") +"RTN","TMGDBAPI",916,0) + new result set result=cAbort +"RTN","TMGDBAPI",917,0) + +"RTN","TMGDBAPI",918,0) + new Data +"RTN","TMGDBAPI",919,0) + new DDInfo +"RTN","TMGDBAPI",920,0) + new FieldInfo +"RTN","TMGDBAPI",921,0) + new Index,Part +"RTN","TMGDBAPI",922,0) + new DummyOut +"RTN","TMGDBAPI",923,0) + +"RTN","TMGDBAPI",924,0) + new OutVarP set OutVarP=$get(Params(cOutput),cNull) +"RTN","TMGDBAPI",925,0) + ;"if (OutVarP=cNull) goto DFUTDone +"RTN","TMGDBAPI",926,0) + if (OutVarP=cNull) do +"RTN","TMGDBAPI",927,0) + . set OutVarP="DummyOut" +"RTN","TMGDBAPI",928,0) + +"RTN","TMGDBAPI",929,0) + kill @OutVarP ;"--ensure old variables in output variable are removed. +"RTN","TMGDBAPI",930,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Output variable=",OutVarP) +"RTN","TMGDBAPI",931,0) + +"RTN","TMGDBAPI",932,0) + new RecNum set RecNum=$get(Params(cRecNum)) +"RTN","TMGDBAPI",933,0) + set @OutVarP@(cRecNum)=RecNum +"RTN","TMGDBAPI",934,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"RecNum=",RecNum) +"RTN","TMGDBAPI",935,0) + +"RTN","TMGDBAPI",936,0) + new Fn set Fn=$get(Params(cFn),cInfo) +"RTN","TMGDBAPI",937,0) + set Fn=$$UP^XLFSTR(Fn) +"RTN","TMGDBAPI",938,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Action Fn=",Fn) +"RTN","TMGDBAPI",939,0) + +"RTN","TMGDBAPI",940,0) + new Value set Value=$get(Params(cValue)) +"RTN","TMGDBAPI",941,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Value=",Value) +"RTN","TMGDBAPI",942,0) + +"RTN","TMGDBAPI",943,0) + new FileN set FileN=$get(Params("FILE")) +"RTN","TMGDBAPI",944,0) + +"RTN","TMGDBAPI",945,0) + new SpliceArray +"RTN","TMGDBAPI",946,0) + if FileN[cNodeDiv do ;"Parse 'NEW PERSON|ALIAS|TITLE' into 'NEW PERSON', 'ALIAS', 'TITLE' +"RTN","TMGDBAPI",947,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Multiple nodes found for file name. Processing...") +"RTN","TMGDBAPI",948,0) + . do CleaveToArray^TMGSTUTL(FileN,cNodeDiv,.SpliceArray) +"RTN","TMGDBAPI",949,0) + . set FileN=$get(SpliceArray(1)) +"RTN","TMGDBAPI",950,0) + set Data(0,"FILE")=FileN +"RTN","TMGDBAPI",951,0) + set result=$$SetupFileNum(.Data) if result=cAbort goto DFUTDone +"RTN","TMGDBAPI",952,0) + new FileNum set FileNum=$get(Data(0,"FILE"),cNull) +"RTN","TMGDBAPI",953,0) + set @OutVarP@("FILE")=FileNum +"RTN","TMGDBAPI",954,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNum=",FileNum) +"RTN","TMGDBAPI",955,0) + +"RTN","TMGDBAPI",956,0) + new index set index=2 +"RTN","TMGDBAPI",957,0) + new GlobalP set GlobalP=$name(@OutVarP@("FILE")) +"RTN","TMGDBAPI",958,0) + if $data(SpliceArray(index)) do +"RTN","TMGDBAPI",959,0) + . for index=index:1 do quit:index="" +"RTN","TMGDBAPI",960,0) + . . set FileN=SpliceArray(index) +"RTN","TMGDBAPI",961,0) + . . set FileNum=$$GetSubFileNumber(FileNum,FileN) +"RTN","TMGDBAPI",962,0) + . . if +FileNum'=0 set @GlobalP@("FILE")=FileNum +"RTN","TMGDBAPI",963,0) + . . set GlobalP=$name(@GlobalP@("FILE")) +"RTN","TMGDBAPI",964,0) + . . set index=$order(SpliceArray(index)) +"RTN","TMGDBAPI",965,0) + +"RTN","TMGDBAPI",966,0) + new GlobalP set GlobalP=$get(Data(0,"FILE",cGlobal),cNull) +"RTN","TMGDBAPI",967,0) + if (FileNum=cNull),(GlobalP=cNull) goto DFUTDone +"RTN","TMGDBAPI",968,0) + set @OutVarP@(cGlobal)=GlobalP +"RTN","TMGDBAPI",969,0) + set @OutVarP@(cGlobal,cOpen)=$get(Data(0,"FILE",cGlobal,cOpen)) +"RTN","TMGDBAPI",970,0) + +"RTN","TMGDBAPI",971,0) + ;"If we've gotten this far, will consider the function a success +"RTN","TMGDBAPI",972,0) + set result=cOKToCont +"RTN","TMGDBAPI",973,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Setting fn result to success") +"RTN","TMGDBAPI",974,0) + +"RTN","TMGDBAPI",975,0) + new FieldN set FieldN=$get(Params(cField)) +"RTN","TMGDBAPI",976,0) + new FieldNum +"RTN","TMGDBAPI",977,0) + if (+FieldN=0)&(FieldN'="") do +"RTN","TMGDBAPI",978,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldN=",FieldN) +"RTN","TMGDBAPI",979,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FileNum=",FileNum) +"RTN","TMGDBAPI",980,0) + . set FieldNum=$$GetNumField(FileNum,FieldN) +"RTN","TMGDBAPI",981,0) + else do +"RTN","TMGDBAPI",982,0) + . if FieldN +"RTN","TMGDBAPI",983,0) + . set FieldNum=FieldN +"RTN","TMGDBAPI",984,0) + set @OutVarP@(cField)=FieldNum +"RTN","TMGDBAPI",985,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldNum=",FieldNum) +"RTN","TMGDBAPI",986,0) + +"RTN","TMGDBAPI",987,0) + if $data(@GlobalP@(0))=0 goto DFUTDone +"RTN","TMGDBAPI",988,0) + new NumRecs set NumRecs=$piece(@GlobalP@(0),"^",4) +"RTN","TMGDBAPI",989,0) + new LastRec set LastRec=$piece(@GlobalP@(0),"^",3) +"RTN","TMGDBAPI",990,0) + set @OutVarP@(cNumRecs)=NumRecs +"RTN","TMGDBAPI",991,0) + set @OutVarP@(cLastRec)=LastRec +"RTN","TMGDBAPI",992,0) + new RecI set RecI=LastRec +"RTN","TMGDBAPI",993,0) + new PrevRec +"RTN","TMGDBAPI",994,0) + for do quit:(RecI="")!(RecI=0) ;"Scan backwards to find first record +"RTN","TMGDBAPI",995,0) + . set PrevRec=$order(@GlobalP@(RecI),-1) +"RTN","TMGDBAPI",996,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"PrevRec=",PrevRec," RecI=",RecI) +"RTN","TMGDBAPI",997,0) + . if (PrevRec="")!(PrevRec=0) do +"RTN","TMGDBAPI",998,0) + . . set @OutVarP@(cFirstRec)=RecI +"RTN","TMGDBAPI",999,0) + . set RecI=PrevRec +"RTN","TMGDBAPI",1000,0) + +"RTN","TMGDBAPI",1001,0) + if FieldNum="" do goto DFUTDone +"RTN","TMGDBAPI",1002,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No field name specified") +"RTN","TMGDBAPI",1003,0) + . if (Fn=cDelete)&(RecNum'="") do +"RTN","TMGDBAPI",1004,0) + . . set DIK=$get(Data(0,"FILE",cGlobal,cOpen)) +"RTN","TMGDBAPI",1005,0) + . . set DA=RecNum +"RTN","TMGDBAPI",1006,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Deleting one record (number: ",RecNum,") from File number",FileNum) +"RTN","TMGDBAPI",1007,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Notice: deleting record does not clear any pointers to deleted records") +"RTN","TMGDBAPI",1008,0) + . . do ^DIK +"RTN","TMGDBAPI",1009,0) + +"RTN","TMGDBAPI",1010,0) + ;"Get info from data dictionary r.e. where actual fields are stored in files. +"RTN","TMGDBAPI",1011,0) + set DDInfo=$get(^DD(FileNum,FieldNum,0)) +"RTN","TMGDBAPI",1012,0) + if '$data(DDInfo) goto HWDone +"RTN","TMGDBAPI",1013,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DDInfo=",DDInfo) +"RTN","TMGDBAPI",1014,0) + set FieldInfo=$piece(DDInfo,"^",4) +"RTN","TMGDBAPI",1015,0) + if '$data(FieldInfo),(FieldInfo="") goto DFUTDone +"RTN","TMGDBAPI",1016,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"FieldInfo=",FieldInfo) +"RTN","TMGDBAPI",1017,0) + set Index=$piece(FieldInfo,";",1) +"RTN","TMGDBAPI",1018,0) + set Part=$piece(FieldInfo,";",2) +"RTN","TMGDBAPI",1019,0) + +"RTN","TMGDBAPI",1020,0) + if RecNum="" goto DFUTDone +"RTN","TMGDBAPI",1021,0) + if $data(@GlobalP@(RecNum,Index))=0 goto DFUTDone +"RTN","TMGDBAPI",1022,0) + +"RTN","TMGDBAPI",1023,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"I think the correct data place is: ",GlobalP,"(",RecNum,",",Index,") at piece: ",Part) +"RTN","TMGDBAPI",1024,0) + new Temp set Temp=@GlobalP@(RecNum,Index) +"RTN","TMGDBAPI",1025,0) + set @OutVarP@(cValue)=$piece(Temp,"^",Part) +"RTN","TMGDBAPI",1026,0) + kill Temp +"RTN","TMGDBAPI",1027,0) + set @OutVarP@(cNextRec)=$order(@GlobalP@(RecNum)) +"RTN","TMGDBAPI",1028,0) + set @OutVarP@(cPrev)=$order(@GlobalP@(RecNum),-1) +"RTN","TMGDBAPI",1029,0) + +"RTN","TMGDBAPI",1030,0) + if Fn=cDelete do +"RTN","TMGDBAPI",1031,0) + . set $piece(@GlobalP@(RecNum,Index),"^",Part)="" +"RTN","TMGDBAPI",1032,0) + +"RTN","TMGDBAPI",1033,0) + if Fn=cSet do +"RTN","TMGDBAPI",1034,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Performing a hack write. CAUTION!") +"RTN","TMGDBAPI",1035,0) + . set $piece(@GlobalP@(RecNum,Index),"^",Part)=Value +"RTN","TMGDBAPI",1036,0) + +"RTN","TMGDBAPI",1037,0) + set result=cOKToCont +"RTN","TMGDBAPI",1038,0) + +"RTN","TMGDBAPI",1039,0) +DFUTDone +"RTN","TMGDBAPI",1040,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Fn result=",result) +"RTN","TMGDBAPI",1041,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DoFileUtility^TMGDBAPI") +"RTN","TMGDBAPI",1042,0) + quit result +"RTN","TMGDBAPI",1043,0) + +"RTN","TMGDBAPI",1044,0) + +"RTN","TMGDBAPI",1045,0) + +"RTN","TMGDBAPI",1046,0) +AddRec(Data) +"RTN","TMGDBAPI",1047,0) + ;"Purpose: Use info from data array to create a MINIMAL new record in database +"RTN","TMGDBAPI",1048,0) + ;" This record will have only it's .01 field, and any multiple +"RTN","TMGDBAPI",1049,0) + ;" subfiles will have only their .01 fields also. +"RTN","TMGDBAPI",1050,0) + ;"Input: Data - Data array should be in format output from GetRInfo +"RTN","TMGDBAPI",1051,0) + ;"Output: data base will be modified by adding record +"RTN","TMGDBAPI",1052,0) + ;"Assumption: That a matching record does not already exist in database +"RTN","TMGDBAPI",1053,0) + ;"Returns: RecNum of added record, or 0 if error (0=abort) +"RTN","TMGDBAPI",1054,0) + +"RTN","TMGDBAPI",1055,0) + ;"NOTE!!! -- As I review this code, does it really return record number added??? +"RTN","TMGDBAPI",1056,0) + +"RTN","TMGDBAPI",1057,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGDBAPI",1058,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGDBAPI",1059,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",1060,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGDBAPI",1061,0) + +"RTN","TMGDBAPI",1062,0) + +"RTN","TMGDBAPI",1063,0) + new tmgFDA,TMGFDA ;"Fileman Data Array +"RTN","TMGDBAPI",1064,0) + new IENS ;"Internal Entry Number String +"RTN","TMGDBAPI",1065,0) + new RecNum ;"Internal number entry array +"RTN","TMGDBAPI",1066,0) + new Flags +"RTN","TMGDBAPI",1067,0) + new TMGMsg +"RTN","TMGDBAPI",1068,0) + new FileNum +"RTN","TMGDBAPI",1069,0) + new result set result=cAbort +"RTN","TMGDBAPI",1070,0) + new FDAIndex +"RTN","TMGDBAPI",1071,0) + new MarkerArray +"RTN","TMGDBAPI",1072,0) + new MsgArray +"RTN","TMGDBAPI",1073,0) + +"RTN","TMGDBAPI",1074,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddRec^TMGDBAPI") +"RTN","TMGDBAPI",1075,0) + +"RTN","TMGDBAPI",1076,0) + set IENS=$get(Data(0,cParentIENS)) +"RTN","TMGDBAPI",1077,0) + +"RTN","TMGDBAPI",1078,0) + new MarkNum set MarkNum=0 +"RTN","TMGDBAPI",1079,0) + set result=$$SetupFDA(.Data,.tmgFDA,IENS,"+",.MarkNum,.MsgArray) +"RTN","TMGDBAPI",1080,0) + if result=cAbort goto SkRDone +"RTN","TMGDBAPI",1081,0) + set FileNum=$get(Data(0,"FILE"),0) +"RTN","TMGDBAPI",1082,0) + if FileNum=0 set result=cAbort goto SkRDone +"RTN","TMGDBAPI",1083,0) + +"RTN","TMGDBAPI",1084,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master MsgArray") +"RTN","TMGDBAPI",1085,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("MsgArray") +"RTN","TMGDBAPI",1086,0) + +"RTN","TMGDBAPI",1087,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is master tmgFDA") +"RTN","TMGDBAPI",1088,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("tmgFDA") ;"zwr tmgFDA(*) +"RTN","TMGDBAPI",1089,0) + +"RTN","TMGDBAPI",1090,0) + set FDAIndex=FileNum +"RTN","TMGDBAPI",1091,0) + for do quit:(FDAIndex="")!(result=cAbort) +"RTN","TMGDBAPI",1092,0) + . kill TMGFDA +"RTN","TMGDBAPI",1093,0) + . merge TMGFDA(FDAIndex)=tmgFDA(FDAIndex) +"RTN","TMGDBAPI",1094,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting cycle with "_FDAIndex_" part.") +"RTN","TMGDBAPI",1095,0) + . ; +"RTN","TMGDBAPI",1096,0) + . set Flags="E" ;"E=External format values +"RTN","TMGDBAPI",1097,0) + . ; +"RTN","TMGDBAPI",1098,0) + . set result=$$ConvertFDA(.TMGFDA,.MarkerArray) +"RTN","TMGDBAPI",1099,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"AFTER CONVERSION, Here is the FDA to pass to UPDATE^DIE") +"RTN","TMGDBAPI",1100,0) + . if TMGDEBUG do ArrayDump^TMGDEBUG("TMGFDA") ;"zwr TMGFDA(*) +"RTN","TMGDBAPI",1101,0) + . ; +"RTN","TMGDBAPI",1102,0) + . ;"====================================================== +"RTN","TMGDBAPI",1103,0) + . ;"Call UPDATE^DIE +"RTN","TMGDBAPI",1104,0) + . ;"====================================================== +"RTN","TMGDBAPI",1105,0) + . if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"TMGDBAPI::UPDATE^DIE") +"RTN","TMGDBAPI",1106,0) + . if $data(TMGFDA)'=0 do +"RTN","TMGDBAPI",1107,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Flags=",Flags) +"RTN","TMGDBAPI",1108,0) + . . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGDBAPI",1109,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Remember, UPDATE^DIE adds new entries in files or subfiles.") +"RTN","TMGDBAPI",1110,0) + . . set ^TMP("TMG",$J,"ErrorTrap")=result +"RTN","TMGDBAPI",1111,0) + . . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE" +"RTN","TMGDBAPI",1112,0) + . . do UPDATE^DIE(Flags,"TMGFDA","RecNum","TMGMsg") +"RTN","TMGDBAPI",1113,0) + . . set result=^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAPI",1114,0) + . . kill ^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGDBAPI",1115,0) + . . kill ^TMP("TMG",$J,"Caller") +"RTN","TMGDBAPI",1116,0) + . if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGDBAPI::UPDATE^DIE") +"RTN","TMGDBAPI",1117,0) + . ;"====================================================== +"RTN","TMGDBAPI",1118,0) + . ;"====================================================== +"RTN","TMGDBAPI",1119,0) + . ; +"RTN","TMGDBAPI",1120,0) + . if $data(RecNum) do +"RTN","TMGDBAPI",1121,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is RecNum array after update/filing") +"RTN","TMGDBAPI",1122,0) + . . if TMGDEBUG do ArrayDump^TMGDEBUG("RecNum") ;"zwr RecNum(*) +"RTN","TMGDBAPI",1123,0) + . . merge MarkerArray=RecNum +"RTN","TMGDBAPI",1124,0) + . . if result=cAbort do +"RTN","TMGDBAPI",1125,0) + . . . new index +"RTN","TMGDBAPI",1126,0) + . . . set index=$order(RecNum("")) +"RTN","TMGDBAPI",1127,0) + . . . set result=$get(RecNum(index)) +"RTN","TMGDBAPI",1128,0) + . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Output Record#=",result) +"RTN","TMGDBAPI",1129,0) + . else do +"RTN","TMGDBAPI",1130,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After update/filing, RecNum array is empty!") +"RTN","TMGDBAPI",1131,0) + . ; +"RTN","TMGDBAPI",1132,0) + . if $data(TMGMsg("DIERR")) do quit +"RTN","TMGDBAPI",1133,0) + . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGDBAPI",1134,0) + . . if $data(RecNum(1)) do +"RTN","TMGDBAPI",1135,0) + . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Trying to ignore error") +"RTN","TMGDBAPI",1136,0) + . . . set PriorErrorFound=0 +"RTN","TMGDBAPI",1137,0) + . . else do +"RTN","TMGDBAPI",1138,0) + . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Unable to ignore error") +"RTN","TMGDBAPI",1139,0) + . . . set result=cAbort +"RTN","TMGDBAPI",1140,0) + . do +"RTN","TMGDBAPI",1141,0) + . . new tI set tI=FDAIndex +"RTN","TMGDBAPI",1142,0) + . . set FDAIndex=$order(tmgFDA(FDAIndex)) +"RTN","TMGDBAPI",1143,0) + . . kill tmgFDA(tI) +"RTN","TMGDBAPI",1144,0) + +"RTN","TMGDBAPI",1145,0) + if result=cAbort do goto SkRDone +"RTN","TMGDBAPI",1146,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error encountered, dropping out.") +"RTN","TMGDBAPI",1147,0) + +"RTN","TMGDBAPI",1148,0) + set result=$$HandleHacksArray(.MsgArray) +"RTN","TMGDBAPI",1149,0) + +"RTN","TMGDBAPI",1150,0) + if result=cAbort goto SkRDone +"RTN","TMGDBAPI",1151,0) + +"RTN","TMGDBAPI",1152,0) +SkRDone +"RTN","TMGDBAPI",1153,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddRec^TMGDBAPI") +"RTN","TMGDBAPI",1154,0) + quit result +"RTN","TMGDBAPI",1155,0) + +"RTN","TMGDBAPI",1156,0) + +"RTN","TMGDBAPI",1157,0) + +"RTN","TMGDBAPI",1158,0) + ;"========================================================= +"RTN","TMGDBAPI",1159,0) + ;" Error trap routine +"RTN","TMGDBAPI",1160,0) + ;"========================================================= +"RTN","TMGDBAPI",1161,0) +ErrTrp +"RTN","TMGDBAPI",1162,0) + new cAbort set cAbort=0 +"RTN","TMGDBAPI",1163,0) + set $etrap="",$ecode="" +"RTN","TMGDBAPI",1164,0) + new Caller +"RTN","TMGDBAPI",1165,0) + set Caller=$get(^TMP("TMG",$J,"Caller"),"?") +"RTN","TMGDBAPI",1166,0) + do ShowError^TMGDEBUG(.PriorErrorFound,"Error trapped. Caller was: ",Caller) +"RTN","TMGDBAPI",1167,0) + if $data(TMGMsg) do ShowDIERR^TMGDEBUG(TMGMsg) +"RTN","TMGDBAPI",1168,0) + set ^TMP("TMG",$J,"ErrorTrap")=cAbort +"RTN","TMGDBAPI",1169,0) + quit +"RTN","TMGDBAPI",1170,0) + ;"========================================================= +"RTN","TMGDBAPI",1171,0) + ;" End of Error trap routine +"RTN","TMGDBAPI",1172,0) + ;"========================================================= +"RTN","TMGDBAPI",1173,0) + +"RTN","TMGDBAPI",1174,0) + ;"======================================================== +"RTN","TMGDBAPI",1175,0) + ;"The following routines were moved to shorten module length +"RTN","TMGDBAPI",1176,0) + +"RTN","TMGDBAPI",1177,0) +ConvertFDA(FDA,MarkerArray) +"RTN","TMGDBAPI",1178,0) + goto ConvertFDA+1^TMGDBAP2 +"RTN","TMGDBAPI",1179,0) + +"RTN","TMGDBAPI",1180,0) +ConvertIENS(IENS,MarkerArray) +"RTN","TMGDBAPI",1181,0) + goto ConvertIENS+1^TMGDBAP2 +"RTN","TMGDBAPI",1182,0) + +"RTN","TMGDBAPI",1183,0) +SetupFDA(Data,FDA,parentIENS,SrchType,MarkNum,MsgArray,Minimal,RecNum) +"RTN","TMGDBAPI",1184,0) + goto SetupFDA+1^TMGDBAP2 +"RTN","TMGDBAPI",1185,0) + +"RTN","TMGDBAPI",1186,0) +OverwriteRec(RecNum,Data) +"RTN","TMGDBAPI",1187,0) + goto OverwriteRec+1^TMGDBAP2 +"RTN","TMGDBAPI",1188,0) + +"RTN","TMGDBAPI",1189,0) +GetFileNum(FileName) +"RTN","TMGDBAPI",1190,0) + goto GetFileNum+1^TMGDBAP2 +"RTN","TMGDBAPI",1191,0) + +"RTN","TMGDBAPI",1192,0) +GetFName(FileNumber) +"RTN","TMGDBAPI",1193,0) + goto GetFName+1^TMGDBAP2 +"RTN","TMGDBAPI",1194,0) + +"RTN","TMGDBAPI",1195,0) +GetFldName(File,FieldNumber) +"RTN","TMGDBAPI",1196,0) + goto GetFldName+1^TMGDBAP2 +"RTN","TMGDBAPI",1197,0) + +"RTN","TMGDBAPI",1198,0) +GetFldList(File,pArray) +"RTN","TMGDBAPI",1199,0) + goto GetFldList+1^TMGDBAP2 +"RTN","TMGDBAPI",1200,0) + +"RTN","TMGDBAPI",1201,0) +SetupFileNum(Data) +"RTN","TMGDBAPI",1202,0) + goto SetupFileNum+1^TMGDBAP2 +"RTN","TMGDBAPI",1203,0) + +"RTN","TMGDBAPI",1204,0) +RecFind(Params) +"RTN","TMGDBAPI",1205,0) + goto RecFind+1^TMGDBAP2 +"RTN","TMGDBAPI",1206,0) + +"RTN","TMGDBAPI",1207,0) +FieldCompare(TestField,dbField,Type) +"RTN","TMGDBAPI",1208,0) + goto FieldCompare+1^TMGDBAP2 +"RTN","TMGDBAPI",1209,0) + +"RTN","TMGDBAPI",1210,0) +EnsureWrite(File,Field,IENS,Value,Flags,MsgArray) +"RTN","TMGDBAPI",1211,0) + goto EnsureWrite+1^TMGDBAP2 +"RTN","TMGDBAPI",1212,0) + +"RTN","TMGDBAPI",1213,0) +dbWrite(FDA,Overwrite,TMGIEN,Flags,ErrArray) +"RTN","TMGDBAPI",1214,0) + goto dbWrite+1^TMGDBAP2 +"RTN","TMGDBAPI",1215,0) + +"RTN","TMGDBAPI",1216,0) +DelIEN(File,RecNumIEN,ErrArray) +"RTN","TMGDBAPI",1217,0) + goto DelIEN+1^TMGDBAP2 +"RTN","TMGDBAPI",1218,0) + +"RTN","TMGDBAPI",1219,0) +WriteWP(File,RecNumIEN,Field,TMGArray) +"RTN","TMGDBAPI",1220,0) + goto WriteWP+1^TMGDBAP2 +"RTN","TMGDBAPI",1221,0) + +"RTN","TMGDBAPI",1222,0) +ReadWP(File,IENS,Field,Array) +"RTN","TMGDBAPI",1223,0) + goto ReadWP+1^TMGDBAP2 +"RTN","TMGDBAPI",1224,0) + +"RTN","TMGDBAPI",1225,0) +ShowIfError(TMGMsg,PriorErrorFound) +"RTN","TMGDBAPI",1226,0) + goto ShowIfError+1^TMGDBAP2 +"RTN","TMGDBAPI",1227,0) + +"RTN","TMGDBAPI",1228,0) +DataImport(Info,ProgressFN) +"RTN","TMGDBAPI",1229,0) + goto DataImport+1^TMGDBAP2 +"RTN","TMGDBAPI",1230,0) + +"RTN","TMGDBAPI",1231,0) +Set1(File,IEN,Field,Value,Flag) +"RTN","TMGDBAPI",1232,0) + goto Set1+1^TMGDBAP2 +"RTN","TMGDBAPI",1233,0) + +"RTN","TMGDBAPI",1234,0) +GetValidInput(File,Field) +"RTN","TMGDBAPI",1235,0) + goto GetValidInput+1^TMGDBAP2 +"RTN","TMGDBAPI",1236,0) + +"RTN","TMGDBAPI",1237,0) +AskFIENS() +"RTN","TMGDBAPI",1238,0) + goto AskFIENS+1^TMGDBAP2 +"RTN","TMGDBAPI",1239,0) + +"RTN","TMGDBAPI",1240,0) +ASKSCRN +"RTN","TMGDBAPI",1241,0) + goto ASKSCRN+1^TMGDBAP2 +"RTN","TMGDBAPI",1242,0) + +"RTN","TMGDBAPI",1243,0) +AskIENS(FileNum,IENS) +"RTN","TMGDBAPI",1244,0) + goto AskIENS+1^TMGDBAP2 +"RTN","TMGDBAPI",1245,0) + +"RTN","TMGDBAPI",1246,0) +GetRefArray(FileNum,array) +"RTN","TMGDBAPI",1247,0) + goto GetRefArray+1^TMGDBAP2 +"RTN","TMGDBAPI",1248,0) + +"RTN","TMGDBAPI",1249,0) +FIENS2Root(FIENS) +"RTN","TMGDBAPI",1250,0) + goto FIENS2Root+1^TMGDBAP2 +"RTN","TMGDBAPI",1251,0) + +"RTN","TMGDBAPI",1252,0) +GetRef(file,IENS,field) +"RTN","TMGDBAPI",1253,0) + goto GetRef+1^TMGDBAP2 +"RTN","TMGDBAPI",1254,0) + +"RTN","TMGDBAPI",1255,0) +TrimFDA(FDA,Quiet) +"RTN","TMGDBAPI",1256,0) + goto TrimFDA+1^TMGDBAP2 +"RTN","TMGDBAPI",1257,0) + +"RTN","TMGDBAPI",1258,0) +GetPtrsOUT(File,Info) +"RTN","TMGDBAPI",1259,0) + goto GetPtrsOUT+1^TMGDBAP2 +"RTN","TMGDBAPI",1260,0) + +"RTN","TMGDEBUG") +0^8^B10834 +"RTN","TMGDEBUG",1,0) +TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06 +"RTN","TMGDEBUG",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGDEBUG",3,0) + +"RTN","TMGDEBUG",4,0) + +"RTN","TMGDEBUG",5,0) + +"RTN","TMGDEBUG",6,0) + ;"TMG DEBUG UTILITIES +"RTN","TMGDEBUG",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGDEBUG",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGDEBUG",9,0) + ;"7-12-2005 +"RTN","TMGDEBUG",10,0) + +"RTN","TMGDEBUG",11,0) + ;"======================================================================= +"RTN","TMGDEBUG",12,0) + ;" API -- Public Functions. +"RTN","TMGDEBUG",13,0) + ;"======================================================================= +"RTN","TMGDEBUG",14,0) + ;"$$GetDebugMode^TMGDEBUG(DefVal) +"RTN","TMGDEBUG",15,0) + ;"OpenDefLogFile^TMGDEBUG +"RTN","TMGDEBUG",16,0) + ;"OpenLogFile^TMGDEBUG(DefPath,DefName) +"RTN","TMGDEBUG",17,0) + ;"DebugMsg^TMGDEBUG(DBIndent,Msg,A,B,C,D,E,F,G,H,I,J,K,L) +"RTN","TMGDEBUG",18,0) + ;"DebugWrite^TMGDEBUG(DBIndent,s,AddNewline) +"RTN","TMGDEBUG",19,0) + ;"DebugIndent^TMGDEBUG(Num) +"RTN","TMGDEBUG",20,0) + ;"ArrayDump^TMGDEBUG(ArrayP,index,indent) +"RTN","TMGDEBUG",21,0) + ;"ASKANODES +"RTN","TMGDEBUG",22,0) + ;"ArrayNodes(pArray) +"RTN","TMGDEBUG",23,0) + ;"DebugEntry^TMGDEBUG((DBIndent,ProcName) +"RTN","TMGDEBUG",24,0) + ;"DebugExit^TMGDEBUG(DBIndent,ProcName) +"RTN","TMGDEBUG",25,0) + ;"ShowError^TMGDEBUG(PriorErrorFound,Error) +"RTN","TMGDEBUG",26,0) + ;"$$GetErrStr^TMGDEBUG(ErrArray) +"RTN","TMGDEBUG",27,0) + ;"ShowIfDIERR^TMGDEBUG(ErrMsg,PriorErrorFound) ;really same as below +"RTN","TMGDEBUG",28,0) + ;"ShowDIERR^TMGDEBUG(ErrMsg,PriorErrorFound) +"RTN","TMGDEBUG",29,0) + ;"ExpandLine(Pos) +"RTN","TMGDEBUG",30,0) + ;"ASKDUMP -- A record dumper -- a little different from Fileman Inquire +"RTN","TMGDEBUG",31,0) + ;"DumpRec(FileNum,IEN) -- dump (display) a record, using Fileman functionality. +"RTN","TMGDEBUG",32,0) + ;"DumpRec2(FileNum,IEN,ShowEmpty) -- dump (display) a record, NOT Fileman's Inquire code +"RTN","TMGDEBUG",33,0) + +"RTN","TMGDEBUG",34,0) + ;"======================================================================= +"RTN","TMGDEBUG",35,0) + ;"Private API functions +"RTN","TMGDEBUG",36,0) + +"RTN","TMGDEBUG",37,0) + ;"DumpRec2(FileNum,IEN,ShowEmpty) +"RTN","TMGDEBUG",38,0) + ;"WriteRLabel(IEN,Ender) +"RTN","TMGDEBUG",39,0) + ;"WriteFLabel(Label,Field,Type,Ender) +"RTN","TMGDEBUG",40,0) + ;"WriteLine(Line) +"RTN","TMGDEBUG",41,0) + +"RTN","TMGDEBUG",42,0) + ;"======================================================================= +"RTN","TMGDEBUG",43,0) + ;"DEPENDENCIES +"RTN","TMGDEBUG",44,0) + ;" TMGUSRIF +"RTN","TMGDEBUG",45,0) + +"RTN","TMGDEBUG",46,0) + ;"Note: This module accesses custom file 22711, TMG UPLOAD SETTINGS +"RTN","TMGDEBUG",47,0) + ;" It is OK if this file does not exist (i.e. on other computer systems.) However, the function +"RTN","TMGDEBUG",48,0) + ;" OpenDefLogFile will fail to find a default specified file, and would not open a log file. +"RTN","TMGDEBUG",49,0) + ;" Nothing is PUT INTO this file in this module. So new global would NOT be created. +"RTN","TMGDEBUG",50,0) + ;"======================================================================= +"RTN","TMGDEBUG",51,0) + ;"======================================================================= +"RTN","TMGDEBUG",52,0) + +"RTN","TMGDEBUG",53,0) +GetDebugMode(DefVal) +"RTN","TMGDEBUG",54,0) + ;"Purpose: to ask if debug output desired +"RTN","TMGDEBUG",55,0) + ;"Input: DefVal [optional] -- Default choice +"RTN","TMGDEBUG",56,0) + ;"result: returns values as below +"RTN","TMGDEBUG",57,0) + ;" 0, cdbNone - no debug +"RTN","TMGDEBUG",58,0) + ;" 1, cdbToScrn - Debug output to screen +"RTN","TMGDEBUG",59,0) + ;" 2, cdbToFile - Debug output to file +"RTN","TMGDEBUG",60,0) + ;" 3, cdbToTail - Debug output to X tail dialog box. +"RTN","TMGDEBUG",61,0) + ;" Note: 2-2-06 I am adding a mode (-1) which is EXTRA QUIET (used initially in ShowError) +"RTN","TMGDEBUG",62,0) + ;"Note: This does not set up output streams etc, just gets preference. +"RTN","TMGDEBUG",63,0) + +"RTN","TMGDEBUG",64,0) + new cdbNone set cdbNone=0 +"RTN","TMGDEBUG",65,0) + new cdbAbort set cdbAbort=0 +"RTN","TMGDEBUG",66,0) + new cdbToScrn set cdbToScrn=1 ;"was 2 +"RTN","TMGDEBUG",67,0) + new cdbToFile set cdbToFile=2 ;"was 3 +"RTN","TMGDEBUG",68,0) + new cdbToTail set cdbToTail=3 ;"was 4 +"RTN","TMGDEBUG",69,0) + +"RTN","TMGDEBUG",70,0) + new Input +"RTN","TMGDEBUG",71,0) + new result set result=cdbNone ;"the default +"RTN","TMGDEBUG",72,0) + new Default set Default=$get(DefVal,3) +"RTN","TMGDEBUG",73,0) + +"RTN","TMGDEBUG",74,0) + write !,"Select debug output option:",! +"RTN","TMGDEBUG",75,0) + write " '^'. Abort",! +"RTN","TMGDEBUG",76,0) + write " 0. NO debug output",! +"RTN","TMGDEBUG",77,0) + write " 1. Show debug output on screen",! +"RTN","TMGDEBUG",78,0) + write " 2. Send debug output to file",! +"RTN","TMGDEBUG",79,0) + if $get(DispMode(cDialog)) do +"RTN","TMGDEBUG",80,0) + . write " 3. Show debug output in X tail dialog box.",! +"RTN","TMGDEBUG",81,0) + +"RTN","TMGDEBUG",82,0) + write "Enter option number ("_Default_"): " +"RTN","TMGDEBUG",83,0) + read Input,! +"RTN","TMGDEBUG",84,0) + +"RTN","TMGDEBUG",85,0) + if Input="" do +"RTN","TMGDEBUG",86,0) + . write "Defaulting to: ",Default,! +"RTN","TMGDEBUG",87,0) + . set Input=Default +"RTN","TMGDEBUG",88,0) + +"RTN","TMGDEBUG",89,0) + if Input="^" set result=cdbAbort +"RTN","TMGDEBUG",90,0) + if Input=0 set result=cdbNone +"RTN","TMGDEBUG",91,0) + if Input=1 set result=cdbToScrn +"RTN","TMGDEBUG",92,0) + if Input=2 set result=cdbToFile +"RTN","TMGDEBUG",93,0) + if Input=3 set result=cdbToTail +"RTN","TMGDEBUG",94,0) + +"RTN","TMGDEBUG",95,0) +GDMDone +"RTN","TMGDEBUG",96,0) + quit result +"RTN","TMGDEBUG",97,0) + +"RTN","TMGDEBUG",98,0) +OpenDefLogFile +"RTN","TMGDEBUG",99,0) + ;"Purpose: To open a default log file for debug output +"RTN","TMGDEBUG",100,0) + ;"Results: none +"RTN","TMGDEBUG",101,0) + +"RTN","TMGDEBUG",102,0) + new DefPath,DefName +"RTN","TMGDEBUG",103,0) + +"RTN","TMGDEBUG",104,0) + set DefPath=$piece($get(^TMG(22711,1,2)),"^",1) +"RTN","TMGDEBUG",105,0) + set DefName=$piece($get(^TMG(22711,1,1)),"^",1) +"RTN","TMGDEBUG",106,0) + +"RTN","TMGDEBUG",107,0) + do OpenLogFile(.DefPath,.DefName) +"RTN","TMGDEBUG",108,0) + +"RTN","TMGDEBUG",109,0) + quit +"RTN","TMGDEBUG",110,0) + +"RTN","TMGDEBUG",111,0) + +"RTN","TMGDEBUG",112,0) +OpenLogFile(DefPath,DefName) +"RTN","TMGDEBUG",113,0) + ;"Purpose: To open a log file for debug output +"RTN","TMGDEBUG",114,0) + ;"Input: DefPath -- the default path, like this: "/tmp/" <-- note trailing '/' +"RTN","TMGDEBUG",115,0) + ;" DefName -- default file name (without path). e.g. "LogFile.tmp" +"RTN","TMGDEBUG",116,0) + ;"Results: None +"RTN","TMGDEBUG",117,0) + +"RTN","TMGDEBUG",118,0) + new DebugFPath set DebugFPath=$get(DefPath,"/tmp/") +"RTN","TMGDEBUG",119,0) + new DebugFName set DebugFName=$get(DefName,"M_DebugLog.tmp") +"RTN","TMGDEBUG",120,0) + if $get(TMGDEBUG)>1 do +"RTN","TMGDEBUG",121,0) + . write "Note: Sending debug output to file: ",DebugFPath,DebugFName,! +"RTN","TMGDEBUG",122,0) + +"RTN","TMGDEBUG",123,0) + ;"new DebugFile -- don't NEW here, needs to be global-scope +"RTN","TMGDEBUG",124,0) + set DebugFile=DebugFPath_DebugFName +"RTN","TMGDEBUG",125,0) + new FileSpec set FileSpec(DebugFile)="" +"RTN","TMGDEBUG",126,0) + +"RTN","TMGDEBUG",127,0) + if +$piece($get(^TMG(22711,1,1)),"^",2)'=1 do +"RTN","TMGDEBUG",128,0) + . ;"kill any pre-existing log +"RTN","TMGDEBUG",129,0) + . new result +"RTN","TMGDEBUG",130,0) + . set result=$$DEL^%ZISH(DebugFPath,$name(FileSpec)) ;"delete any preexisting one. +"RTN","TMGDEBUG",131,0) + +"RTN","TMGDEBUG",132,0) + open DebugFile +"RTN","TMGDEBUG",133,0) + use $PRINCIPAL +"RTN","TMGDEBUG",134,0) + +"RTN","TMGDEBUG",135,0) + quit +"RTN","TMGDEBUG",136,0) + +"RTN","TMGDEBUG",137,0) + +"RTN","TMGDEBUG",138,0) +DebugMsg(DBIndent,Msg,A,B,C,D,E,F,G,H,I,J,K,L) +"RTN","TMGDEBUG",139,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",140,0) + ;"Purpose: a debugging message output procedure +"RTN","TMGDEBUG",141,0) + ;"Input:DBIndent -- the value of indentation expected +"RTN","TMGDEBUG",142,0) + ;" Msg -- a string or value to show as message +"RTN","TMGDEBUG",143,0) + ;" A..L -- extra values to show. +"RTN","TMGDEBUG",144,0) + ;" +"RTN","TMGDEBUG",145,0) + if $get(TMGDEBUG,0)=0 quit +"RTN","TMGDEBUG",146,0) + set cTrue=$get(cTrue,1) +"RTN","TMGDEBUG",147,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGDEBUG",148,0) + +"RTN","TMGDEBUG",149,0) + set Msg=$get(Msg) +"RTN","TMGDEBUG",150,0) + set Msg=Msg_$get(A) +"RTN","TMGDEBUG",151,0) + set Msg=Msg_$get(B) +"RTN","TMGDEBUG",152,0) + set Msg=Msg_$get(C) +"RTN","TMGDEBUG",153,0) + set Msg=Msg_$get(D) +"RTN","TMGDEBUG",154,0) + set Msg=Msg_$get(E) +"RTN","TMGDEBUG",155,0) + set Msg=Msg_$get(F) +"RTN","TMGDEBUG",156,0) + set Msg=Msg_$get(G) +"RTN","TMGDEBUG",157,0) + set Msg=Msg_$get(H) +"RTN","TMGDEBUG",158,0) + set Msg=Msg_$get(I) +"RTN","TMGDEBUG",159,0) + set Msg=Msg_$get(J) +"RTN","TMGDEBUG",160,0) + set Msg=Msg_$get(K) +"RTN","TMGDEBUG",161,0) + set Msg=Msg_$get(L) +"RTN","TMGDEBUG",162,0) + do DebugIndent(DBIndent) +"RTN","TMGDEBUG",163,0) + do DebugWrite(DBIndent,.Msg,cTrue) +"RTN","TMGDEBUG",164,0) + +"RTN","TMGDEBUG",165,0) + quit +"RTN","TMGDEBUG",166,0) + +"RTN","TMGDEBUG",167,0) + +"RTN","TMGDEBUG",168,0) +DebugWrite(DBIndent,s,AddNewline) +"RTN","TMGDEBUG",169,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",170,0) + ;"Purpose: to write debug output. Having the proc separate will allow +"RTN","TMGDEBUG",171,0) + ;" easier dump to file etc. +"RTN","TMGDEBUG",172,0) + ;"Input:DBIndent, the amount of indentation expected for output. +"RTN","TMGDEBUG",173,0) + ;" s -- the text to write +"RTN","TMGDEBUG",174,0) + ;" AddNewline -- boolean, 1 if ! (i.e. newline) should be written after s +"RTN","TMGDEBUG",175,0) + +"RTN","TMGDEBUG",176,0) + ;"Relevant DEBUG values +"RTN","TMGDEBUG",177,0) + ;" cdbNone - no debug (0) +"RTN","TMGDEBUG",178,0) + ;" cdbToScrn - Debug output to screen (1) +"RTN","TMGDEBUG",179,0) + ;" cdbToFile - Debug output to file (2) +"RTN","TMGDEBUG",180,0) + ;" cdbToTail - Debug output to X tail dialog box. (3) +"RTN","TMGDEBUG",181,0) + ;"Note: If above values are not defined, then functionality will be ignored. +"RTN","TMGDEBUG",182,0) + +"RTN","TMGDEBUG",183,0) + +"RTN","TMGDEBUG",184,0) + set cdbNone=$get(cdbNone,0) +"RTN","TMGDEBUG",185,0) + set cdbToScrn=$get(cdbToScrn,1) +"RTN","TMGDEBUG",186,0) + set cdbToFile=$get(cdbToFile,2) +"RTN","TMGDEBUG",187,0) + set cdbToTail=$get(cdbToTail,3) +"RTN","TMGDEBUG",188,0) + set TMGDEBUG=$get(TMGDEBUG,cdbNone) +"RTN","TMGDEBUG",189,0) + if $get(TMGDEBUG)=cdbNone quit +"RTN","TMGDEBUG",190,0) + +"RTN","TMGDEBUG",191,0) + if (TMGDEBUG=$get(cdbToFile))!(TMGDEBUG=$get(cdbToTail)) do +"RTN","TMGDEBUG",192,0) + . if $data(DebugFile) use DebugFile +"RTN","TMGDEBUG",193,0) + +"RTN","TMGDEBUG",194,0) + new ch,chN,l,i +"RTN","TMGDEBUG",195,0) + set l=$length(s) +"RTN","TMGDEBUG",196,0) + for i=1:1:l do +"RTN","TMGDEBUG",197,0) + . set ch=$extract(s,i) +"RTN","TMGDEBUG",198,0) + . set chN=$ascii(ch) +"RTN","TMGDEBUG",199,0) + . if (chN<32)&(chN'=13) write "<",chN,">" +"RTN","TMGDEBUG",200,0) + . else write ch +"RTN","TMGDEBUG",201,0) + ;"write s +"RTN","TMGDEBUG",202,0) + +"RTN","TMGDEBUG",203,0) + set cTrue=$get(cTrue,1) +"RTN","TMGDEBUG",204,0) + if $get(AddNewline)=cTrue write ! +"RTN","TMGDEBUG",205,0) + +"RTN","TMGDEBUG",206,0) + if (TMGDEBUG=$get(cdbToFile))!(TMGDEBUG=$get(cdbToTail)) do +"RTN","TMGDEBUG",207,0) + . use $PRINCIPAL +"RTN","TMGDEBUG",208,0) + +"RTN","TMGDEBUG",209,0) + quit +"RTN","TMGDEBUG",210,0) + +"RTN","TMGDEBUG",211,0) + +"RTN","TMGDEBUG",212,0) +DebugIndent(DBIndentForced) +"RTN","TMGDEBUG",213,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",214,0) + ;"Purpose: to provide a unified indentation for debug messages +"RTN","TMGDEBUG",215,0) + ;"Input: DBIndent = number of indentations +"RTN","TMGDEBUG",216,0) + ;" Forced = 1 if to indent regardless of DEBUG mode +"RTN","TMGDEBUG",217,0) + +"RTN","TMGDEBUG",218,0) + set Forced=$get(Forced,0) +"RTN","TMGDEBUG",219,0) + +"RTN","TMGDEBUG",220,0) + if ($get(TMGDEBUG,0)=0)&(Forced=0) quit +"RTN","TMGDEBUG",221,0) + new i +"RTN","TMGDEBUG",222,0) + for i=1:1:DBIndent do +"RTN","TMGDEBUG",223,0) + . if Forced do DebugWrite(DBIndent," ") +"RTN","TMGDEBUG",224,0) + . else do DebugWrite(DBIndent,". ") +"RTN","TMGDEBUG",225,0) + quit +"RTN","TMGDEBUG",226,0) + +"RTN","TMGDEBUG",227,0) + +"RTN","TMGDEBUG",228,0) + +"RTN","TMGDEBUG",229,0) +ArrayDump(ArrayP,TMGIDX,indent,flags) +"RTN","TMGDEBUG",230,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",231,0) + ;"Purpose: to get a custom version of GTM's "zwr" command +"RTN","TMGDEBUG",232,0) + ;"Input: Uses global scope var DBIndent (if defined) +"RTN","TMGDEBUG",233,0) + ;" ArrayP: NAME of global or variable to display, i.e. "^VA(200)", "MyVar" +"RTN","TMGDEBUG",234,0) + ;" TMGIDX: initial index (i.e. 5 if wanting to start with ^VA(200,5) -- Optional +"RTN","TMGDEBUG",235,0) + ;" indent: spacing from left margin to begin with. (A number. Each count is 2 spaces) +"RTN","TMGDEBUG",236,0) + ;" OPTIONAL: indent may be an array, with information about columns +"RTN","TMGDEBUG",237,0) + ;" to skip. For example: +"RTN","TMGDEBUG",238,0) + ;" indent=3, indent(2)=0 --> show | for columns 1 & 3, but NOT 2 +"RTN","TMGDEBUG",239,0) + ;" flags: OPTIONAL. "F"-> flat (don't use tre structure) +"RTN","TMGDEBUG",240,0) + ;"Result: none +"RTN","TMGDEBUG",241,0) + +"RTN","TMGDEBUG",242,0) + ;"--Leave out, this calls itself recursively! do DebugEntry("ArrayDump") +"RTN","TMGDEBUG",243,0) + ;"--Leave out, this calls itself recursively! do DebugMsg^TMGDEBUG("ArrayP=",ArrayP,", TMGIDX=",index) +"RTN","TMGDEBUG",244,0) + +"RTN","TMGDEBUG",245,0) + if $data(ArrayP)=0 quit +"RTN","TMGDEBUG",246,0) + +"RTN","TMGDEBUG",247,0) + if $get(flags)["F" do goto ADDone +"RTN","TMGDEBUG",248,0) + . new ref set ref=ArrayP +"RTN","TMGDEBUG",249,0) + . new nNums set nNums=$qlength(ref) +"RTN","TMGDEBUG",250,0) + . new lValue set lValue=$qsubscript(ref,nNums) +"RTN","TMGDEBUG",251,0) + . write ref,"=""",$get(@ref),"""",! +"RTN","TMGDEBUG",252,0) + . for set ref=$query(@ref) quit:(ref="")!($qsubscript(ref,nNums)'=lValue) do +"RTN","TMGDEBUG",253,0) + . . write ref,"=""",$get(@ref),"""",! +"RTN","TMGDEBUG",254,0) + +"RTN","TMGDEBUG",255,0) + ;"Note: I need to do some validation to ensure ArrayP doesn't have any null nodes. +"RTN","TMGDEBUG",256,0) + new X set X="SET TEMP=$GET("_ArrayP_")" +"RTN","TMGDEBUG",257,0) + set X=$$UP^XLFSTR(X) +"RTN","TMGDEBUG",258,0) + do ^DIM ;"a method to ensure ArrayP doesn't have an invalid reference. +"RTN","TMGDEBUG",259,0) + if $get(X)="" quit +"RTN","TMGDEBUG",260,0) + +"RTN","TMGDEBUG",261,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGDEBUG",262,0) + set cTrue=$get(cTrue,1) +"RTN","TMGDEBUG",263,0) + set cFalse=$get(cFalse,0) +"RTN","TMGDEBUG",264,0) + +"RTN","TMGDEBUG",265,0) + ;"Force this function to output, even if TMGDEBUG is not defined. +"RTN","TMGDEBUG",266,0) + ;"if $data(TMGDEBUG)=0 new TMGDEBUG ;"//kt 1-16-06, doesn't seem to be working +"RTN","TMGDEBUG",267,0) + new TMGDEBUG ;"//kt added 1-16-06 +"RTN","TMGDEBUG",268,0) + set TMGDEBUG=1 +"RTN","TMGDEBUG",269,0) + +"RTN","TMGDEBUG",270,0) + new ChildP,TMGi +"RTN","TMGDEBUG",271,0) + +"RTN","TMGDEBUG",272,0) + set TMGIDX=$get(TMGIDX,"") +"RTN","TMGDEBUG",273,0) + set indent=$get(indent,0) +"RTN","TMGDEBUG",274,0) + new SavIndex set SavIndex=TMGIDX +"RTN","TMGDEBUG",275,0) + +"RTN","TMGDEBUG",276,0) + do DebugIndent(DBIndent) +"RTN","TMGDEBUG",277,0) + +"RTN","TMGDEBUG",278,0) + if indent>0 do +"RTN","TMGDEBUG",279,0) + . for TMGi=1:1:indent-1 do +"RTN","TMGDEBUG",280,0) + . . new s set s="" +"RTN","TMGDEBUG",281,0) + . . if $get(indent(TMGi),-1)=0 set s=" " +"RTN","TMGDEBUG",282,0) + . . else set s="| " +"RTN","TMGDEBUG",283,0) + . . do DebugWrite(DBIndent,s) +"RTN","TMGDEBUG",284,0) + . do DebugWrite(DBIndent,"}~") +"RTN","TMGDEBUG",285,0) + +"RTN","TMGDEBUG",286,0) + if TMGIDX'="" do +"RTN","TMGDEBUG",287,0) + . if $data(@ArrayP@(TMGIDX))#10=1 do +"RTN","TMGDEBUG",288,0) + . . new s set s=@ArrayP@(TMGIDX) +"RTN","TMGDEBUG",289,0) + . . if s="" set s="""""" +"RTN","TMGDEBUG",290,0) + . . new qt set qt="" +"RTN","TMGDEBUG",291,0) + . . if +TMGIDX'=TMGIDX set qt="""" +"RTN","TMGDEBUG",292,0) + . . do DebugWrite(DBIndent,qt_TMGIDX_qt_" = "_s,cTrue) +"RTN","TMGDEBUG",293,0) + . else do +"RTN","TMGDEBUG",294,0) + . . do DebugWrite(DBIndent,TMGIDX,1) +"RTN","TMGDEBUG",295,0) + . set ArrayP=$name(@ArrayP@(TMGIDX)) +"RTN","TMGDEBUG",296,0) + else do +"RTN","TMGDEBUG",297,0) + . ;"do DebugWrite(DBIndent,ArrayP_"(*)",cFalse) +"RTN","TMGDEBUG",298,0) + . do DebugWrite(DBIndent,ArrayP,cFalse) +"RTN","TMGDEBUG",299,0) + . if $data(@ArrayP)#10=1 do +"RTN","TMGDEBUG",300,0) + . . do DebugWrite(0,"="_$get(@ArrayP),cFalse) +"RTN","TMGDEBUG",301,0) + . do DebugWrite(0,"",cTrue) +"RTN","TMGDEBUG",302,0) + +"RTN","TMGDEBUG",303,0) + set TMGIDX=$order(@ArrayP@("")) +"RTN","TMGDEBUG",304,0) + if TMGIDX="" goto ADDone +"RTN","TMGDEBUG",305,0) + set indent=indent+1 +"RTN","TMGDEBUG",306,0) + +"RTN","TMGDEBUG",307,0) + for do quit:TMGIDX="" +"RTN","TMGDEBUG",308,0) + . new tTMGIDX set tTMGIDX=$order(@ArrayP@(TMGIDX)) +"RTN","TMGDEBUG",309,0) + . if tTMGIDX="" set indent(indent)=0 +"RTN","TMGDEBUG",310,0) + . new tIndent merge tIndent=indent +"RTN","TMGDEBUG",311,0) + . do ArrayDump(ArrayP,TMGIDX,.tIndent) ;"Call self recursively +"RTN","TMGDEBUG",312,0) + . set TMGIDX=$order(@ArrayP@(TMGIDX)) +"RTN","TMGDEBUG",313,0) + +"RTN","TMGDEBUG",314,0) + ;"Put in a blank space at end of subbranch +"RTN","TMGDEBUG",315,0) + do DebugIndent(DBIndent) +"RTN","TMGDEBUG",316,0) + +"RTN","TMGDEBUG",317,0) + if indent>0 do +"RTN","TMGDEBUG",318,0) + . for TMGi=1:1:indent-1 do +"RTN","TMGDEBUG",319,0) + . . new s set s="" +"RTN","TMGDEBUG",320,0) + . . if $get(indent(TMGi),-1)=0 set s=" " +"RTN","TMGDEBUG",321,0) + . . else set s="| " +"RTN","TMGDEBUG",322,0) + . . do DebugWrite(DBIndent,s) +"RTN","TMGDEBUG",323,0) + . do DebugWrite(DBIndent," ",1) +"RTN","TMGDEBUG",324,0) + +"RTN","TMGDEBUG",325,0) +ADDone +"RTN","TMGDEBUG",326,0) + ;"--Leave out, this calls itself recursively! do DebugExit("ArrayDump") +"RTN","TMGDEBUG",327,0) + quit +"RTN","TMGDEBUG",328,0) + +"RTN","TMGDEBUG",329,0) + +"RTN","TMGDEBUG",330,0) +ASKANODES +"RTN","TMGDEBUG",331,0) + ;"Purpose: to ask user for the name of an array, then display nodes +"RTN","TMGDEBUG",332,0) + +"RTN","TMGDEBUG",333,0) + new name +"RTN","TMGDEBUG",334,0) + write ! +"RTN","TMGDEBUG",335,0) + read "Enter name of array to display nodes in: ",name,! +"RTN","TMGDEBUG",336,0) + if name="^" set name="" +"RTN","TMGDEBUG",337,0) + if name'="" do ArrayNodes(name) +"RTN","TMGDEBUG",338,0) + quit +"RTN","TMGDEBUG",339,0) + +"RTN","TMGDEBUG",340,0) + +"RTN","TMGDEBUG",341,0) +ArrayNodes(pArray) +"RTN","TMGDEBUG",342,0) + ;"Purpose: To display all the nodes of the given array +"RTN","TMGDEBUG",343,0) + ;"Input: pArray -- NAME OF array to display +"RTN","TMGDEBUG",344,0) + +"RTN","TMGDEBUG",345,0) + new TMGi +"RTN","TMGDEBUG",346,0) + +"RTN","TMGDEBUG",347,0) + write pArray,! +"RTN","TMGDEBUG",348,0) + set TMGi=$order(@pArray@("")) +"RTN","TMGDEBUG",349,0) + if TMGi'="" for do quit:(TMGi="") +"RTN","TMGDEBUG",350,0) + . write " +--(",TMGi,")",! +"RTN","TMGDEBUG",351,0) + . set TMGi=$order(@pArray@(TMGi)) +"RTN","TMGDEBUG",352,0) + +"RTN","TMGDEBUG",353,0) + quit +"RTN","TMGDEBUG",354,0) + +"RTN","TMGDEBUG",355,0) +DebugEntry(DBIndent,ProcName) +"RTN","TMGDEBUG",356,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",357,0) + ;"Purpose: A way to show when entering a procedure, in debug mode +"RTN","TMGDEBUG",358,0) + ;"Input: DBIndent, a variable to keep track of indentation amount--PASS BY REFERENCE +"RTN","TMGDEBUG",359,0) + ;" ProcName: any arbitrary name to show when decreasing indent amount. +"RTN","TMGDEBUG",360,0) + +"RTN","TMGDEBUG",361,0) + set ProcName=$get(ProcName,"?") +"RTN","TMGDEBUG",362,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGDEBUG",363,0) + do DebugMsg(DBIndent,ProcName_" {") +"RTN","TMGDEBUG",364,0) + set DBIndent=DBIndent+1 +"RTN","TMGDEBUG",365,0) + quit +"RTN","TMGDEBUG",366,0) + +"RTN","TMGDEBUG",367,0) + +"RTN","TMGDEBUG",368,0) +DebugExit(DBIndent,ProcName) +"RTN","TMGDEBUG",369,0) + ;"PUBLIC FUNCTION +"RTN","TMGDEBUG",370,0) + ;"Purpose: A way to show when leaving a procedure, in debug mode +"RTN","TMGDEBUG",371,0) + ;"Input: DBIndent, a variable to keep track of indentation amount--PASS BY REFERENCE +"RTN","TMGDEBUG",372,0) + ;" ProcName: any arbitrary name to show when decreasing indent amount. +"RTN","TMGDEBUG",373,0) + +"RTN","TMGDEBUG",374,0) + ;"write "DBIndent=",DBIndent,! +"RTN","TMGDEBUG",375,0) + ;"write "ProcName=",ProcName,! +"RTN","TMGDEBUG",376,0) + set ProcName=$get(ProcName,"?") +"RTN","TMGDEBUG",377,0) + set DBIndent=$get(DBIndent)-1 +"RTN","TMGDEBUG",378,0) + if DBIndent<0 set DBIndent=0 +"RTN","TMGDEBUG",379,0) + do DebugMsg(DBIndent,"} //"_ProcName) +"RTN","TMGDEBUG",380,0) + +"RTN","TMGDEBUG",381,0) + quit +"RTN","TMGDEBUG",382,0) + +"RTN","TMGDEBUG",383,0) + +"RTN","TMGDEBUG",384,0) + +"RTN","TMGDEBUG",385,0) + +"RTN","TMGDEBUG",386,0) +ShowError(PriorErrorFound,Error) +"RTN","TMGDEBUG",387,0) + ;"Purpose: to output an error message +"RTN","TMGDEBUG",388,0) + ;"Input: [OPTIONAL] PriorErrorFound -- var to see if an error already shown. +"RTN","TMGDEBUG",389,0) + ;" if not passed, then default value used ('no prior error') +"RTN","TMGDEBUG",390,0) + ;" Error -- a string to display +"RTN","TMGDEBUG",391,0) + ;"results: none +"RTN","TMGDEBUG",392,0) + +"RTN","TMGDEBUG",393,0) + if $get(TMGDEBUG)=-1 quit ;"EXTRA QUIET mode --> skip entirely +"RTN","TMGDEBUG",394,0) + +"RTN","TMGDEBUG",395,0) + if $get(TMGDEBUG)>0 do DebugEntry(.DBIndent,"ShowError") +"RTN","TMGDEBUG",396,0) + if $get(TMGDEBUG)>0 do DebugMsg(.DBIndent,"Error msg=",Error) +"RTN","TMGDEBUG",397,0) + +"RTN","TMGDEBUG",398,0) + if $get(PriorErrorFound,0) do goto ShErrQuit ;"Remove to show cascading errors +"RTN","TMGDEBUG",399,0) + . if $get(TMGDEBUG)>0 do DebugMsg(.DBIndent,"Prior error found, so won't show this error.") +"RTN","TMGDEBUG",400,0) + +"RTN","TMGDEBUG",401,0) + if $data(DBIndent)=0 new DBIndent ;"If it wasn't global before, keep it that way. +"RTN","TMGDEBUG",402,0) + new SaveIndent set SaveIndent=$get(DBIndent) +"RTN","TMGDEBUG",403,0) + set DBIndent=1 +"RTN","TMGDEBUG",404,0) + do PopupBox^TMGUSRIF(" ERROR . . .",Error) +"RTN","TMGDEBUG",405,0) + set PriorErrorFound=1 +"RTN","TMGDEBUG",406,0) + set DBIndent=SaveIndent +"RTN","TMGDEBUG",407,0) + +"RTN","TMGDEBUG",408,0) +ShErrQuit +"RTN","TMGDEBUG",409,0) + if $get(TMGDEBUG)>0 do DebugExit(.DBIndent,"ShowError") +"RTN","TMGDEBUG",410,0) + +"RTN","TMGDEBUG",411,0) + quit +"RTN","TMGDEBUG",412,0) + +"RTN","TMGDEBUG",413,0) + +"RTN","TMGDEBUG",414,0) +GetErrStr(ErrArray) +"RTN","TMGDEBUG",415,0) + ;"Purpose: convert a standard DIERR array into a string for output +"RTN","TMGDEBUG",416,0) + ;"Input: ErrArray -- PASS BY REFERENCE. example: +"RTN","TMGDEBUG",417,0) + ;" array("DIERR")="1^1" +"RTN","TMGDEBUG",418,0) + ;" array("DIERR",1)=311 +"RTN","TMGDEBUG",419,0) + ;" array("DIERR",1,"PARAM",0)=3 +"RTN","TMGDEBUG",420,0) + ;" array("DIERR",1,"PARAM","FIELD")=.02 +"RTN","TMGDEBUG",421,0) + ;" array("DIERR",1,"PARAM","FILE")=2 +"RTN","TMGDEBUG",422,0) + ;" array("DIERR",1,"PARAM","IENS")="+1," +"RTN","TMGDEBUG",423,0) + ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers." +"RTN","TMGDEBUG",424,0) + ;" array("DIERR","E",311,1)="" +"RTN","TMGDEBUG",425,0) + ;"Results: returns one long equivalent string from above array. +"RTN","TMGDEBUG",426,0) + +"RTN","TMGDEBUG",427,0) + new ErrStr +"RTN","TMGDEBUG",428,0) + new TMGIDX +"RTN","TMGDEBUG",429,0) + new ErrNum +"RTN","TMGDEBUG",430,0) + +"RTN","TMGDEBUG",431,0) + set ErrStr="" +"RTN","TMGDEBUG",432,0) + for ErrNum=1:1:+$get(ErrArray("DIERR")) do +"RTN","TMGDEBUG",433,0) + . set ErrStr=ErrStr_"Fileman says: '" +"RTN","TMGDEBUG",434,0) + . if ErrNum'=1 set ErrStr=ErrStr_"(Error# "_ErrNum_") " +"RTN","TMGDEBUG",435,0) + . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT","")) +"RTN","TMGDEBUG",436,0) + . if TMGIDX'="" for do quit:(TMGIDX="") +"RTN","TMGDEBUG",437,0) + . . set ErrStr=ErrStr_$get(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX))_" " +"RTN","TMGDEBUG",438,0) + . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX)) +"RTN","TMGDEBUG",439,0) + . if $get(ErrArray("DIERR",ErrNum,"PARAM",0))>0 do +"RTN","TMGDEBUG",440,0) + . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",0)) +"RTN","TMGDEBUG",441,0) + . . set ErrStr=ErrStr_"Details: " +"RTN","TMGDEBUG",442,0) + . . for do quit:(TMGIDX="") +"RTN","TMGDEBUG",443,0) + . . . if TMGIDX="" quit +"RTN","TMGDEBUG",444,0) + . . . set ErrStr=ErrStr_"["_TMGIDX_"]="_$get(ErrArray("DIERR",1,"PARAM",TMGIDX))_" " +"RTN","TMGDEBUG",445,0) + . . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",TMGIDX)) +"RTN","TMGDEBUG",446,0) + +"RTN","TMGDEBUG",447,0) + quit ErrStr +"RTN","TMGDEBUG",448,0) + +"RTN","TMGDEBUG",449,0) + +"RTN","TMGDEBUG",450,0) + +"RTN","TMGDEBUG",451,0) +ShowIfDIERR(ErrMsg,PriorErrorFound) ;"really same as below +"RTN","TMGDEBUG",452,0) + goto SEL1 +"RTN","TMGDEBUG",453,0) + +"RTN","TMGDEBUG",454,0) +ShowDIERR(ErrMsg,PriorErrorFound) +"RTN","TMGDEBUG",455,0) + ;"Purpose: To provide a standard output mechanism for the fileman DIERR message +"RTN","TMGDEBUG",456,0) + ;"Input: ErrMsg -- PASS BY REFERENCE. a standard error message array, as +"RTN","TMGDEBUG",457,0) + ;" put out by fileman calls +"RTN","TMGDEBUG",458,0) + ;" PriorErrorFound -- OPTIONAL variable to keep track if prior error found. +"RTN","TMGDEBUG",459,0) + ;" Note -- can also be used as ErrorFound (i.e. set to 1 if error found) +"RTN","TMGDEBUG",460,0) + ;"Output -- none +"RTN","TMGDEBUG",461,0) + ;"Result -- none +"RTN","TMGDEBUG",462,0) + +"RTN","TMGDEBUG",463,0) +SEL1 +"RTN","TMGDEBUG",464,0) + if $get(TMGDEBUG)=-1 quit ;"EXTRA QUIET mode --> skip entirely +"RTN","TMGDEBUG",465,0) + +"RTN","TMGDEBUG",466,0) + if $get(TMGDEBUG)>0 do DebugEntry(.DBIndent,"ShowDIERR") +"RTN","TMGDEBUG",467,0) + +"RTN","TMGDEBUG",468,0) + if $data(ErrMsg("DIERR")) do +"RTN","TMGDEBUG",469,0) + . if $get(TMGDEBUG)>0 do DebugMsg(.DBIndent,"Error message found. Here is array:") +"RTN","TMGDEBUG",470,0) + . if $get(TMGDEBUG) do ArrayDump("ErrMsg") +"RTN","TMGDEBUG",471,0) + . new ErrStr +"RTN","TMGDEBUG",472,0) + . set ErrStr=$$GetErrStr(.ErrMsg) +"RTN","TMGDEBUG",473,0) + . do ShowError(.PriorErrorFound,.ErrStr) +"RTN","TMGDEBUG",474,0) + +"RTN","TMGDEBUG",475,0) + if $get(TMGDEBUG)>0 do DebugExit(.DBIndent,"ShowDIERR") +"RTN","TMGDEBUG",476,0) + quit +"RTN","TMGDEBUG",477,0) + +"RTN","TMGDEBUG",478,0) +ExpandLine(Pos) +"RTN","TMGDEBUG",479,0) + ;"Purpose: to expand a line of code, found at position "Pos", using ^XINDX8 functionality +"RTN","TMGDEBUG",480,0) + ;"Input: Pos: a position as returned by $ZPOS (e.g. G+5^DIS, or +23^DIS) +"RTN","TMGDEBUG",481,0) + ;"Output: Writes to the currently selecte IO device and expansion of one line of code +"RTN","TMGDEBUG",482,0) + ;"Note: This is used for taking the very long lines of code, as found in Fileman, and +"RTN","TMGDEBUG",483,0) + ;" convert them to a format with one command on each line. +"RTN","TMGDEBUG",484,0) + ;" Note: it appears to do syntax checking and shows ERROR if syntax is not per VA +"RTN","TMGDEBUG",485,0) + ;" conventions--such as commands must be UPPERCASE etc. +"RTN","TMGDEBUG",486,0) + +"RTN","TMGDEBUG",487,0) + ;"--- copied and modified from XINDX8.m --- +"RTN","TMGDEBUG",488,0) + +"RTN","TMGDEBUG",489,0) + kill ^UTILITY($J) +"RTN","TMGDEBUG",490,0) + +"RTN","TMGDEBUG",491,0) + new label,offset,RTN,dmod +"RTN","TMGDEBUG",492,0) + do ParsePos^TMGMISC(Pos,.label,.offset,.RTN,.dmod) +"RTN","TMGDEBUG",493,0) + if label'="" do ;"change position from one relative to label into one relative to top of file +"RTN","TMGDEBUG",494,0) + . new CodeArray +"RTN","TMGDEBUG",495,0) + . set Pos=$$ConvertPos^TMGMISC(Pos,"CodeArray") +"RTN","TMGDEBUG",496,0) + . do ParsePos^TMGMISC(Pos,.label,.offset,.RTN,.dmod) +"RTN","TMGDEBUG",497,0) + +"RTN","TMGDEBUG",498,0) + if RTN="" goto ELDone +"RTN","TMGDEBUG",499,0) + +"RTN","TMGDEBUG",500,0) + do BUILD^XINDX7 +"RTN","TMGDEBUG",501,0) + set ^UTILITY($J,RTN)="" +"RTN","TMGDEBUG",502,0) + do LOAD^XINDEX +"RTN","TMGDEBUG",503,0) + set CCN=0 +"RTN","TMGDEBUG",504,0) + for I=1:1:+^UTILITY($J,1,RTN,0,0) S CCN=CCN+$L(^UTILITY($J,1,RTN,0,I,0))+2 +"RTN","TMGDEBUG",505,0) + set ^UTILITY($J,1,RTN,0)=CCN +"RTN","TMGDEBUG",506,0) + ;"do ^XINDX8 -- included below +"RTN","TMGDEBUG",507,0) + +"RTN","TMGDEBUG",508,0) + new Q,DDOT,LO,PG,LIN,ML,IDT +"RTN","TMGDEBUG",509,0) + new tIOSL set tIOSL=IOSL +"RTN","TMGDEBUG",510,0) + set IOSL=999999 ;"really long 'page length' prevents header printout (and error) +"RTN","TMGDEBUG",511,0) + +"RTN","TMGDEBUG",512,0) + set Q="""" +"RTN","TMGDEBUG",513,0) + set DDOT=0 +"RTN","TMGDEBUG",514,0) + set LO=0 +"RTN","TMGDEBUG",515,0) + set PG=+$G(PG) +"RTN","TMGDEBUG",516,0) + +"RTN","TMGDEBUG",517,0) + set LC=offset +"RTN","TMGDEBUG",518,0) + if $D(^UTILITY($J,1,RTN,0,LC)) do +"RTN","TMGDEBUG",519,0) + . S LIN=^(LC,0),ML=0,IDT=10 +"RTN","TMGDEBUG",520,0) + . set LO=LC-1 +"RTN","TMGDEBUG",521,0) + . D CD^XINDX8 +"RTN","TMGDEBUG",522,0) + +"RTN","TMGDEBUG",523,0) + K AGR,EOC,IDT,JJ,LO,ML,OLD,SAV,TY +"RTN","TMGDEBUG",524,0) + +"RTN","TMGDEBUG",525,0) + set IOSL=tIOSL ;"restore saved IOSL +"RTN","TMGDEBUG",526,0) +ELDone +"RTN","TMGDEBUG",527,0) + quit +"RTN","TMGDEBUG",528,0) + +"RTN","TMGDEBUG",529,0) + +"RTN","TMGDEBUG",530,0) +DumpRec(FileNum,IEN) +"RTN","TMGDEBUG",531,0) + ;"Purpose: to dump (display) a record, using Fileman functionality. +"RTN","TMGDEBUG",532,0) + ;"Input: FileNum -- the number of the file to dump from +"RTN","TMGDEBUG",533,0) + ;" IEN -- the record number to display +"RTN","TMGDEBUG",534,0) + ;"Note: this code is modified from INQ^DII +"RTN","TMGDEBUG",535,0) + +"RTN","TMGDEBUG",536,0) + new DIC,X,Y,DI,DPP,DK,DICSS +"RTN","TMGDEBUG",537,0) + +"RTN","TMGDEBUG",538,0) + set X=FileNum,Y=X +"RTN","TMGDEBUG",539,0) + +"RTN","TMGDEBUG",540,0) + set DI=$get(^DIC(FileNum,0,"GL")) if DI="" quit +"RTN","TMGDEBUG",541,0) + set DPP(1)=FileNum_"^^^@" +"RTN","TMGDEBUG",542,0) + set DK=FileNum +"RTN","TMGDEBUG",543,0) + +"RTN","TMGDEBUG",544,0) + K ^UTILITY($J),^(U,$J),DIC,DIQ,DISV,DIBT,DICS +"RTN","TMGDEBUG",545,0) + +"RTN","TMGDEBUG",546,0) + set DIK=1 +"RTN","TMGDEBUG",547,0) + set ^UTILITY(U,$J,DIK,IEN)="" ;"<-- note, to have multiple IEN's shown, iterate via DIK +"RTN","TMGDEBUG",548,0) + +"RTN","TMGDEBUG",549,0) + do S^DII ;"Jump into Fileman code. +"RTN","TMGDEBUG",550,0) + +"RTN","TMGDEBUG",551,0) + quit +"RTN","TMGDEBUG",552,0) + +"RTN","TMGDEBUG",553,0) + +"RTN","TMGDEBUG",554,0) +xASKDUMP +"RTN","TMGDEBUG",555,0) + ;"Purpose: A record dumper -- a little different from Fileman Inquire +"RTN","TMGDEBUG",556,0) + +"RTN","TMGDEBUG",557,0) + new DIC,X,Y +"RTN","TMGDEBUG",558,0) + new FileNum,IEN +"RTN","TMGDEBUG",559,0) + new UseDefault set UseDefault=1 +"RTN","TMGDEBUG",560,0) + +"RTN","TMGDEBUG",561,0) + ;"Pick file to dump from +"RTN","TMGDEBUG",562,0) +xASK1 set DIC=1 +"RTN","TMGDEBUG",563,0) + set DIC(0)="AEQM" +"RTN","TMGDEBUG",564,0) + if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called +"RTN","TMGDEBUG",565,0) + . do ^DICRW ;" has default value of user's last response +"RTN","TMGDEBUG",566,0) + else do ^DIC ;doesn't have default value... +"RTN","TMGDEBUG",567,0) + if +Y'>0 write ! goto xASKDone +"RTN","TMGDEBUG",568,0) + set FileNum=+Y +"RTN","TMGDEBUG",569,0) + +"RTN","TMGDEBUG",570,0) + ;"Pick record to dump +"RTN","TMGDEBUG",571,0) +xASKLOOP kill DIC,X +"RTN","TMGDEBUG",572,0) + set DIC=+FileNum +"RTN","TMGDEBUG",573,0) + set DIC(0)="AEQM" +"RTN","TMGDEBUG",574,0) + do ^DIC write ! +"RTN","TMGDEBUG",575,0) + if +Y'>0 set UseDefault=0 goto xASK1 +"RTN","TMGDEBUG",576,0) + set IEN=+Y +"RTN","TMGDEBUG",577,0) + +"RTN","TMGDEBUG",578,0) + new % set %=2 +"RTN","TMGDEBUG",579,0) + write "Display empty fields" +"RTN","TMGDEBUG",580,0) + do YN^DICN +"RTN","TMGDEBUG",581,0) + if %=-1 write ! goto xASKDone +"RTN","TMGDEBUG",582,0) + +"RTN","TMGDEBUG",583,0) + new %ZIS +"RTN","TMGDEBUG",584,0) + set %ZIS("A")="Enter Output Device: " +"RTN","TMGDEBUG",585,0) + set %ZIS("B")="HOME" +"RTN","TMGDEBUG",586,0) + do ^%ZIS ;"standard device call +"RTN","TMGDEBUG",587,0) + if POP do goto xASKDone +"RTN","TMGDEBUG",588,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output. Aborting.") +"RTN","TMGDEBUG",589,0) + use IO +"RTN","TMGDEBUG",590,0) + +"RTN","TMGDEBUG",591,0) + ;"Do the output +"RTN","TMGDEBUG",592,0) + write ! +"RTN","TMGDEBUG",593,0) + do DumpRec2(FileNum,IEN,(%=1)) +"RTN","TMGDEBUG",594,0) + +"RTN","TMGDEBUG",595,0) + ;" Close the output device +"RTN","TMGDEBUG",596,0) + do ^%ZISC +"RTN","TMGDEBUG",597,0) + +"RTN","TMGDEBUG",598,0) + new temp +"RTN","TMGDEBUG",599,0) + read "Press [ENTER] to continue...",temp:$get(DTIME,3600),! +"RTN","TMGDEBUG",600,0) + +"RTN","TMGDEBUG",601,0) + goto xASKLOOP +"RTN","TMGDEBUG",602,0) + +"RTN","TMGDEBUG",603,0) +xASKDone +"RTN","TMGDEBUG",604,0) + quit +"RTN","TMGDEBUG",605,0) + +"RTN","TMGDEBUG",606,0) +ASKDUMP +"RTN","TMGDEBUG",607,0) + ;"Purpose: A record dumper -- a little different from Fileman Inquire +"RTN","TMGDEBUG",608,0) + +"RTN","TMGDEBUG",609,0) + write !!," -= RECORD DUMPER =-",! +"RTN","TMGDEBUG",610,0) + new FIENS,IENS +"RTN","TMGDEBUG",611,0) +AL1 +"RTN","TMGDEBUG",612,0) + set FIENS=$$AskFIENS^TMGDBAPI() +"RTN","TMGDEBUG",613,0) + if (FIENS["?")!(FIENS="^") goto ASKDone +"RTN","TMGDEBUG",614,0) + +"RTN","TMGDEBUG",615,0) + set FileNum=$piece(FIENS,"^",1) +"RTN","TMGDEBUG",616,0) + set IENS=$piece(FIENS,"^",2) +"RTN","TMGDEBUG",617,0) + +"RTN","TMGDEBUG",618,0) +AL2 +"RTN","TMGDEBUG",619,0) + set IENS=$$AskIENS^TMGDBAPI(FileNum,IENS) +"RTN","TMGDEBUG",620,0) + if (IENS["?")!(IENS="") goto AL1 +"RTN","TMGDEBUG",621,0) + +"RTN","TMGDEBUG",622,0) + new % set %=2 +"RTN","TMGDEBUG",623,0) + write "Display empty fields" +"RTN","TMGDEBUG",624,0) + do YN^DICN +"RTN","TMGDEBUG",625,0) + if %=-1 write ! goto ASKDone +"RTN","TMGDEBUG",626,0) + +"RTN","TMGDEBUG",627,0) + new %ZIS +"RTN","TMGDEBUG",628,0) + set %ZIS("A")="Enter Output Device: " +"RTN","TMGDEBUG",629,0) + set %ZIS("B")="HOME" +"RTN","TMGDEBUG",630,0) + do ^%ZIS ;"standard device call +"RTN","TMGDEBUG",631,0) + if POP do goto ASKDone +"RTN","TMGDEBUG",632,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output. Aborting.") +"RTN","TMGDEBUG",633,0) + use IO +"RTN","TMGDEBUG",634,0) + +"RTN","TMGDEBUG",635,0) + ;"Do the output +"RTN","TMGDEBUG",636,0) + write ! do DumpRec2(FileNum,IENS,(%=1)) +"RTN","TMGDEBUG",637,0) + +"RTN","TMGDEBUG",638,0) + ;" Close the output device +"RTN","TMGDEBUG",639,0) + do ^%ZISC +"RTN","TMGDEBUG",640,0) + +"RTN","TMGDEBUG",641,0) + do PressToCont^TMGUSRIF +"RTN","TMGDEBUG",642,0) + ;"new temp +"RTN","TMGDEBUG",643,0) + ;"read "Press [ENTER] to continue...",temp:$get(DTIME,3600),! +"RTN","TMGDEBUG",644,0) + +"RTN","TMGDEBUG",645,0) + set IENS=$piece(IENS,",",2,99) ;"force Pick of new record to dump +"RTN","TMGDEBUG",646,0) + if +IENS>0 goto AL2 +"RTN","TMGDEBUG",647,0) + goto AL1 +"RTN","TMGDEBUG",648,0) + +"RTN","TMGDEBUG",649,0) +ASKDone +"RTN","TMGDEBUG",650,0) + quit +"RTN","TMGDEBUG",651,0) + +"RTN","TMGDEBUG",652,0) + +"RTN","TMGDEBUG",653,0) +DumpRec2(FileNum,IENS,ShowEmpty,FieldsArray) +"RTN","TMGDEBUG",654,0) + ;"Purpose: to dump (display) a record, NOT using ^DII (Fileman's Inquire code) +"RTN","TMGDEBUG",655,0) + ;"Input: FileNum -- the number of the file to dump from +"RTN","TMGDEBUG",656,0) + ;" IENS -- the record number to display (or IENS: #,#,#,) +"RTN","TMGDEBUG",657,0) + ;" ShowEmpty -- OPTIONAL; if 1 then empty fields will be displayed +"RTN","TMGDEBUG",658,0) + ;" FieldsArray -- OPTIONAL. PASS BY REFERENCE. +"RTN","TMGDEBUG",659,0) + ;" Allows user to specify which fields to show. Format: +"RTN","TMGDEBUG",660,0) + ;" FieldsArray(FieldtoShow)="" <-- FieldtoShow is name or number +"RTN","TMGDEBUG",661,0) + ;" FieldsArray(FieldtoShow)="" <-- FieldtoShow is name or number +"RTN","TMGDEBUG",662,0) + ;" Default is an empty array, in which all fields are considered +"RTN","TMGDEBUG",663,0) + +"RTN","TMGDEBUG",664,0) + new Fields +"RTN","TMGDEBUG",665,0) + set Fields("*")="" +"RTN","TMGDEBUG",666,0) + new flags set flags="i" +"RTN","TMGDEBUG",667,0) + if $get(ShowEmpty)=1 set flags=flags_"b" +"RTN","TMGDEBUG",668,0) + +"RTN","TMGDEBUG",669,0) + write "Record# ",IENS,! +"RTN","TMGDEBUG",670,0) + +"RTN","TMGDEBUG",671,0) + new field,fieldName +"RTN","TMGDEBUG",672,0) + if $data(FieldsArray)=0 do +"RTN","TMGDEBUG",673,0) + . set field=$order(^DD(FileNum,0)) +"RTN","TMGDEBUG",674,0) + . if +field>0 for do quit:(+field'>0) +"RTN","TMGDEBUG",675,0) + . . set fieldName=$piece(^DD(FileNum,field,0),"^",1) +"RTN","TMGDEBUG",676,0) + . . set Fields("TAG NAME",field)=fieldName_"("_field_")" +"RTN","TMGDEBUG",677,0) + . . set field=$order(^DD(FileNum,field)) +"RTN","TMGDEBUG",678,0) + else do ;"Handle case of showing ONLY requested fields +"RTN","TMGDEBUG",679,0) + . new temp set temp="" +"RTN","TMGDEBUG",680,0) + . for set temp=$order(FieldsArray(temp)) quit:(temp="") do +"RTN","TMGDEBUG",681,0) + . . if +temp=temp do +"RTN","TMGDEBUG",682,0) + . . . set field=+temp +"RTN","TMGDEBUG",683,0) + . . . set fieldName=$piece(^DD(FileNum,field,0),"^",1) +"RTN","TMGDEBUG",684,0) + . . else do +"RTN","TMGDEBUG",685,0) + . . . set fieldName=temp +"RTN","TMGDEBUG",686,0) + . . . if $$SetFileFldNums^TMGDBAPI(FileNum,fieldName,,.field)=0 quit +"RTN","TMGDEBUG",687,0) + . . set Fields("TAG NAME",field)=fieldName_"("_field_")" +"RTN","TMGDEBUG",688,0) + . ;"Now exclude those fields not specifically included +"RTN","TMGDEBUG",689,0) + . set field=0 +"RTN","TMGDEBUG",690,0) + . for set field=$order(^DD(FileNum,field)) quit:(+field'>0) do +"RTN","TMGDEBUG",691,0) + . . if $data(Fields("TAG NAME",field))'=0 quit +"RTN","TMGDEBUG",692,0) + . . set fieldName=$piece(^DD(FileNum,field,0),"^",1) +"RTN","TMGDEBUG",693,0) + . . set Fields("Field Exclude",field)="" +"RTN","TMGDEBUG",694,0) + +"RTN","TMGDEBUG",695,0) + new RFn,FFn,LFn,WPLFn +"RTN","TMGDEBUG",696,0) + set RFn="WriteRLabel^TMGDEBUG" +"RTN","TMGDEBUG",697,0) + set FFn="WriteFLabel^TMGDEBUG" +"RTN","TMGDEBUG",698,0) + set LFn="WriteLine^TMGDEBUG" +"RTN","TMGDEBUG",699,0) + set WPLFn="WriteWPLine^TMGDEBUG" +"RTN","TMGDEBUG",700,0) + +"RTN","TMGDEBUG",701,0) + ;"write "Using flags (options): ",flags,! +"RTN","TMGDEBUG",702,0) + +"RTN","TMGDEBUG",703,0) + if +IENS=IENS do +"RTN","TMGDEBUG",704,0) + . do Write1Rec^TMGXMLE2(FileNum,IENS,.Fields,flags,,,"",RFn,FFn,LFn,WPLFn) +"RTN","TMGDEBUG",705,0) + else do ;"dump a subfile record +"RTN","TMGDEBUG",706,0) + . do Write1Rec^TMGXMLE2(FileNum,+IENS,.Fields,flags,,IENS,"",RFn,FFn,LFn,WPLFn) +"RTN","TMGDEBUG",707,0) + +"RTN","TMGDEBUG",708,0) + quit +"RTN","TMGDEBUG",709,0) + +"RTN","TMGDEBUG",710,0) + +"RTN","TMGDEBUG",711,0) +WriteRLabel(IEN,Ender) +"RTN","TMGDEBUG",712,0) + ;"Purpose: To actually write out labels for record starting and ending. +"RTN","TMGDEBUG",713,0) + ;" IEN -- the IEN (record number) of the record +"RTN","TMGDEBUG",714,0) + ;" Ender -- OPTIONAL if 1, then ends field. +"RTN","TMGDEBUG",715,0) + ;"Results: none. +"RTN","TMGDEBUG",716,0) + ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2 +"RTN","TMGDEBUG",717,0) + +"RTN","TMGDEBUG",718,0) + if +$get(Ender)>0 write ! +"RTN","TMGDEBUG",719,0) + else write " Multiple Entry #",IEN,"",! +"RTN","TMGDEBUG",720,0) + +"RTN","TMGDEBUG",721,0) + quit +"RTN","TMGDEBUG",722,0) + +"RTN","TMGDEBUG",723,0) + +"RTN","TMGDEBUG",724,0) +WriteFLabel(Label,Field,Type,Ender) +"RTN","TMGDEBUG",725,0) + ;"Purpose: This is the code that actually does writing of labels etc for output +"RTN","TMGDEBUG",726,0) + ;" This is a CUSTOM CALL BACK function called by Write1Fld^TMGXMLE2 +"RTN","TMGDEBUG",727,0) + ;"Input: Label -- OPTIONAL -- Name of label, to write after 'label=' +"RTN","TMGDEBUG",728,0) + ;" Field -- OPTIONAL -- Name of field, to write after 'id=' +"RTN","TMGDEBUG",729,0) + ;" Type -- OPTIONAL -- Typeof field, to write after 'type=' +"RTN","TMGDEBUG",730,0) + ;" Ender -- OPTIONAL if 1, then ends field. +"RTN","TMGDEBUG",731,0) + ;"Results: none. +"RTN","TMGDEBUG",732,0) + ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2 +"RTN","TMGDEBUG",733,0) + +"RTN","TMGDEBUG",734,0) + ;"To write out or +"RTN","TMGDEBUG",735,0) + +"RTN","TMGDEBUG",736,0) + if +$get(Ender)>0 do +"RTN","TMGDEBUG",737,0) + . write ! +"RTN","TMGDEBUG",738,0) + else do +"RTN","TMGDEBUG",739,0) + . new s set s=Field +"RTN","TMGDEBUG",740,0) + . if $get(Field)'="" write $$RJ^XLFSTR(.s,6," "),"-" +"RTN","TMGDEBUG",741,0) + . if $get(Label)'="" write Label," " +"RTN","TMGDEBUG",742,0) + . ;"if $get(Type)'="" write "type=""",Type,""" " +"RTN","TMGDEBUG",743,0) + . write ": " +"RTN","TMGDEBUG",744,0) + +"RTN","TMGDEBUG",745,0) + quit +"RTN","TMGDEBUG",746,0) + +"RTN","TMGDEBUG",747,0) + +"RTN","TMGDEBUG",748,0) +WriteLine(Line) +"RTN","TMGDEBUG",749,0) + ;"Purpose: To actually write out labels for record starting and ending. +"RTN","TMGDEBUG",750,0) + ;"Input: Line -- The line of text to be written out. +"RTN","TMGDEBUG",751,0) + ;"Results: none. +"RTN","TMGDEBUG",752,0) + ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2 +"RTN","TMGDEBUG",753,0) + +"RTN","TMGDEBUG",754,0) + write line +"RTN","TMGDEBUG",755,0) + quit +"RTN","TMGDEBUG",756,0) + +"RTN","TMGDEBUG",757,0) + +"RTN","TMGDEBUG",758,0) +WriteWPLine(Line) +"RTN","TMGDEBUG",759,0) + ;"Purpose: To actually write out line from WP field +"RTN","TMGDEBUG",760,0) + ;"Input: Line -- The line of text to be written out. +"RTN","TMGDEBUG",761,0) + ;"Results: none. +"RTN","TMGDEBUG",762,0) + ;"Note: Used by DumpRec2 above, with callback from TMGXMLE2 +"RTN","TMGDEBUG",763,0) + +"RTN","TMGDEBUG",764,0) + write line,! +"RTN","TMGDEBUG",765,0) + quit +"RTN","TMGDEBUG",766,0) + +"RTN","TMGDIA3") +0^9^B1371075 +"RTN","TMGDIA3",1,0) +TMGDIA3 ;TMG/kst/Custom version of DIA3 ;03/25/06 +"RTN","TMGDIA3",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIA3",3,0) + +"RTN","TMGDIA3",4,0) + +"RTN","TMGDIA3",5,0) +DIA3 ;SFISC/GFT-UPDATE POINTERS, CHECK CODE IN INPUT STRING, CHECK FILE ACCESS ;9/7/94 09:57 +"RTN","TMGDIA3",6,0) + ;;22.0;VA FileMan;;Mar 30, 1999 +"RTN","TMGDIA3",7,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIA3",8,0) + +"RTN","TMGDIA3",9,0) + ;"************************************************************************* +"RTN","TMGDIA3",10,0) + ;"* Custom version of Fileman code, for customization +"RTN","TMGDIA3",11,0) + ;"* Also includes code from DITP.m +"RTN","TMGDIA3",12,0) + ;"************************************************************************* +"RTN","TMGDIA3",13,0) + +"RTN","TMGDIA3",14,0) +FIXPT(DIFLG,DIFILE,DIDELIEN,DIPTIEN) +"RTN","TMGDIA3",15,0) + ;"Purpose: DELETE OR REPOINT POINTERS +"RTN","TMGDIA3",16,0) + ;"Note: In V21, will just delete pointers. Later, DIPTIEN will be record to repoint to. +"RTN","TMGDIA3",17,0) + ;"Input: DIFLG="D" (delete) ;" ADDED "R" (replace) //kt +"RTN","TMGDIA3",18,0) + ;" DIFILE=File# previously pointed to +"RTN","TMGDIA3",19,0) + ;" DIDELIEN=Record# previously pointed to +"RTN","TMGDIA3",20,0) + ;" DIPTIEN=New pointed-to record(future) ;"//KT fixed to do now. +"RTN","TMGDIA3",21,0) + ;" ;"//e.g. if wanting to replace all pointers to file#50, record#20 to record#40 (must be in file#50) +"RTN","TMGDIA3",22,0) + ;" ;"// then DIFILE=50, DIDELIEN=20, DIPTIEN=40 +"RTN","TMGDIA3",23,0) + ;"Output: +"RTN","TMGDIA3",24,0) + ;"Result: none +"RTN","TMGDIA3",25,0) + +"RTN","TMGDIA3",26,0) + ;"Note: sample of array passed to P^DITP +"RTN","TMGDIA3",27,0) + ;" 23510 is $J +"RTN","TMGDIA3",28,0) + ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*)) +"RTN","TMGDIA3",29,0) + ;" 1646 is IEN to be substituted for all 47's +"RTN","TMGDIA3",30,0) + ;" +"RTN","TMGDIA3",31,0) + ;" First part of array is list of all files & fields that point to file +"RTN","TMGDIA3",32,0) + ;" ---------------- +"RTN","TMGDIA3",33,0) + ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'" +"RTN","TMGDIA3",34,0) + ;" ... +"RTN","TMGDIA3",35,0) + ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV" +"RTN","TMGDIA3",36,0) + ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V" +"RTN","TMGDIA3",37,0) + ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V" +"RTN","TMGDIA3",38,0) + ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX" +"RTN","TMGDIA3",39,0) + ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX" +"RTN","TMGDIA3",40,0) + ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'" +"RTN","TMGDIA3",41,0) + ;" +"RTN","TMGDIA3",42,0) + ;" Second part of array is list of changes that should be made. Only 1 change shown here. +"RTN","TMGDIA3",43,0) + ;" ---------------- +"RTN","TMGDIA3",44,0) + ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG(" +"RTN","TMGDIA3",45,0) + ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG(" +"RTN","TMGDIA3",46,0) + +"RTN","TMGDIA3",47,0) + new %X,%Y,X,Y +"RTN","TMGDIA3",48,0) + ;"new DIPTIEN ;//kt allow input value to be used. +"RTN","TMGDIA3",49,0) + new DIFIXPT,DIFIXPTC,DIFIXPTH +"RTN","TMGDIA3",50,0) + do if $G(X)]"" do BLD^DIALOG(201,X) quit ;"BUILD FILEMAN DIALOG +"RTN","TMGDIA3",51,0) + . set X="DIFLG" quit:(($G(DIFLG)'="D")&($G(DIFLG)'="R")) ;"//kt added "R" +"RTN","TMGDIA3",52,0) + . set X="DIDELIEN" Q:'$G(DIDELIEN) +"RTN","TMGDIA3",53,0) + . set X="DIFILE" Q:'$G(DIFILE) Q:$G(^DIC(DIFILE,0,"GL"))="" +"RTN","TMGDIA3",54,0) + . set X="DIPTIEN" +"RTN","TMGDIA3",55,0) + . if (DIFLG="R"),$G(DIPTIEN) do quit:(Y="") +"RTN","TMGDIA3",56,0) + . . set Y=$get(^DIC(DIFILE,0,"GL")) ;"//kt changed ^DD to ^DIC +"RTN","TMGDIA3",57,0) + . . quit:Y="" +"RTN","TMGDIA3",58,0) + . . if '$data(@(Y_DIPTIEN_",0)")) set Y="" quit +"RTN","TMGDIA3",59,0) + . kill X +"RTN","TMGDIA3",60,0) + . quit +"RTN","TMGDIA3",61,0) + set DIPTIEN=+$G(DIPTIEN) +"RTN","TMGDIA3",62,0) + set (DIFIXPT,DIFIXPTC)=1 +"RTN","TMGDIA3",63,0) + new %,BY,D,DHD,DHIT,DIA,DIC,DISTOP,DL,DR,DTO,FLDS,FR,IOP,L,TO,X,Y,Z +"RTN","TMGDIA3",64,0) + kill ^UTILITY("DIT",$J),^TMP("DIFIXPT",$J) +"RTN","TMGDIA3",65,0) + set (DIFILE,DIA("P"),Y)=+DIFILE +"RTN","TMGDIA3",66,0) + set (DIA,DTO)=^DIC(DIFILE,0,"GL") +"RTN","TMGDIA3",67,0) + set DIA(1)=DIDELIEN +"RTN","TMGDIA3",68,0) + do PTS^DIT +"RTN","TMGDIA3",69,0) + set ^UTILITY("DIT",$J,0)=0 +"RTN","TMGDIA3",70,0) + goto:$D(^(0))<9 QFIXPT +"RTN","TMGDIA3",71,0) + set ^UTILITY("DIT",$J,DIA(1))=DIPTIEN_";"_$E(DIA,2,999) +"RTN","TMGDIA3",72,0) + set ^UTILITY("DIT",$J,DIA(1)_";"_$E(DIA,2,999))=DIPTIEN_";"_$E(DIA,2,999) +"RTN","TMGDIA3",73,0) + +"RTN","TMGDIA3",74,0) + zwr ^UTILITY("DIT",$J,*) +"RTN","TMGDIA3",75,0) + ;"do P^DITP +"RTN","TMGDIA3",76,0) + ;"do P +"RTN","TMGDIA3",77,0) + +"RTN","TMGDIA3",78,0) +QFIXPT +"RTN","TMGDIA3",79,0) + K ^UTILITY("DIT",$J),DIFLG,DIFILE,DIDELIEN,DIIOP,DIPTIEN +"RTN","TMGDIA3",80,0) + quit +"RTN","TMGDIA3",81,0) + ; +"RTN","TMGDIA3",82,0) + +"RTN","TMGDIA3",83,0) + ;"************************************************************************* +"RTN","TMGDIA3",84,0) + ;"* Code below from DITP.m +"RTN","TMGDIA3",85,0) + ;"************************************************************************* +"RTN","TMGDIA3",86,0) + +"RTN","TMGDIA3",87,0) +PTS ; +"RTN","TMGDIA3",88,0) + D WAIT^DICD +"RTN","TMGDIA3",89,0) + kill IOP +"RTN","TMGDIA3",90,0) +P kill DR,D,DL,X +"RTN","TMGDIA3",91,0) + set (BY,FR,TO)="" +"RTN","TMGDIA3",92,0) + set X=$O(^UTILITY("DIT",$J,0,0)) +"RTN","TMGDIA3",93,0) + if X="" do quit ;"<--- exit point from loop +"RTN","TMGDIA3",94,0) + . K ^UTILITY("DIT",$J),DIA,DHD,DR,DISTOP,BY,TO,FR,FLDS,L +"RTN","TMGDIA3",95,0) + set Y=^(X) ;"get value of entry e.g. 50^905^P50'X +"RTN","TMGDIA3",96,0) + set L=$P(Y,U,2) ;"L= field# +"RTN","TMGDIA3",97,0) + set DL=1 +"RTN","TMGDIA3",98,0) + set DL(1)=L +"RTN","TMGDIA3",99,0) + set DL(1)=DL(1)_"////^S X=$S($D(DE(DQ))[0:"""",$D(^UTILITY(""DIT"",$J,DE(DQ)))-1:"""",^(DE(DQ)):" +"RTN","TMGDIA3",100,0) + set DL(1)=DL(1)_$S($P(Y,U,3)'["V":"+",1:"") +"RTN","TMGDIA3",101,0) + set DL(1)=DL(1)_"^(DE(DQ)),1:""@"") I X]"""",$G(DIFIXPT)=1 D PTRPT^TMGDIA3" +"RTN","TMGDIA3",102,0) + kill ^(X) ;"delete entry from top of list +"RTN","TMGDIA3",103,0) + set L=$P(^DD(+Y,L,0),U,4) ;"+Y=File#, L=Field# --> L set to 4th piece of data dictionary entry, e.g. '8;6' +"RTN","TMGDIA3",104,0) + set %=$P(L,";",2) ;"e.g. %=6 +"RTN","TMGDIA3",105,0) + set L=""""_$P(L,";",1)_"""" ;"e.g. L="8" +"RTN","TMGDIA3",106,0) + set DHD=$P(^(0),U) ;"DHD--> header for EN1^DIP +"RTN","TMGDIA3",107,0) + if % set %="$P(^("_L_"),U,"_% ;"--> e.g. set %='$P(^(8),U,8 +"RTN","TMGDIA3",108,0) + else set %="$E(^("_L_"),"_+$E(%,2,9)_","_$P(%,",",2) +"RTN","TMGDIA3",109,0) + set L=L_")):"""","_%_")?."" "":"""",'$D(^UTILITY(""DIT"",$J,"_$S($P(Y,U,3)'["V":"+",1:"")_%_"))):"""",1:D" +"RTN","TMGDIA3",110,0) +UP set D(DL)=+Y ;"+Y = File# +"RTN","TMGDIA3",111,0) + set %=+Y ;"+Y = File# +"RTN","TMGDIA3",112,0) + if $D(^DD(%,0,"UP")) do goto UP +"RTN","TMGDIA3",113,0) + . set DL=DL+1 +"RTN","TMGDIA3",114,0) + . set Y=^("UP") +"RTN","TMGDIA3",115,0) + . set (DL(DL),%)=$O(^DD(Y,"SB",%,0))_"///" +"RTN","TMGDIA3",116,0) + . set X(DL)=""""_$P($P(^DD(Y,+%,0),U,4),";")_"""" +"RTN","TMGDIA3",117,0) + . set BY=+%_","_BY +"RTN","TMGDIA3",118,0) + set DHD=$O(^("NM",0))_" entries whose '"_DHD_"' pointers have been changed" +"RTN","TMGDIA3",119,0) + if '$D(^DIC(%,0,"GL")) goto P +"RTN","TMGDIA3",120,0) + set DIC=^("GL") +"RTN","TMGDIA3",121,0) + set Y="S X=$S('$D("_DIC_"D0," +"RTN","TMGDIA3",122,0) + for X=0:1:DL-1 do +"RTN","TMGDIA3",123,0) + . set DR(X+1,D(DL-X))=DL(DL-X) +"RTN","TMGDIA3",124,0) + . if X set Y=Y_X(DL+1-X)_",D"_X_"," +"RTN","TMGDIA3",125,0) + set DIA("P")=% +"RTN","TMGDIA3",126,0) + set %=$L(BY,",") +"RTN","TMGDIA3",127,0) + if %>2 set BY=$P(BY,",",%-2)_",.01,"_BY +"RTN","TMGDIA3",128,0) + set BY=BY_Y_L_X_")" +"RTN","TMGDIA3",129,0) + set L=0 +"RTN","TMGDIA3",130,0) + set FLDS="" +"RTN","TMGDIA3",131,0) + set DISTOP=0 +"RTN","TMGDIA3",132,0) + set DHIT="G LOOP^DIA2" +"RTN","TMGDIA3",133,0) + set %ZIS="" +"RTN","TMGDIA3",134,0) + do EN1^DIP +"RTN","TMGDIA3",135,0) + if $G(DIFIXPT)=1 goto P +"RTN","TMGDIA3",136,0) + set IOP=$G(IO) +"RTN","TMGDIA3",137,0) + goto P +"RTN","TMGDIA3",138,0) + ; +"RTN","TMGDIA3",139,0) + +"RTN","TMGDIA3",140,0) +PTRPT +"RTN","TMGDIA3",141,0) + quit:'$G(DIFIXPTC) +"RTN","TMGDIA3",142,0) + new I,J,X +"RTN","TMGDIA3",143,0) + for I=1:1:DL do +"RTN","TMGDIA3",144,0) + . set J="" +"RTN","TMGDIA3",145,0) + . for set J=$order(DR(I,J)) quit:J="" do +"RTN","TMGDIA3",146,0) + . . if DR(I,J)["///" do +"RTN","TMGDIA3",147,0) + . . . set X=$P($G(DR(I,J)),"///",1) +"RTN","TMGDIA3",148,0) + . . . if X]"" do +"RTN","TMGDIA3",149,0) + . . . . new s +"RTN","TMGDIA3",150,0) + . . . . set s=^TMP("DIFIXPT",$J,DIFIXPTC) +"RTN","TMGDIA3",151,0) + . . . . set s=s_$S(I>1:" entry:"_$S(I=DL:$G(DA),1:$G(DA(DL-I))),1:"") +"RTN","TMGDIA3",152,0) + . . . . set s=s_$S(I=DL:" field:",1:" mult.fld:") +"RTN","TMGDIA3",153,0) + . . . . set s=s_X +"RTN","TMGDIA3",154,0) + . . . . set ^TMP("DIFIXPT",$J,DIFIXPTC)=s +"RTN","TMGDIA3",155,0) + Q +"RTN","TMGDIA3",156,0) + +"RTN","TMGDIS") +0^10^B118560815 +"RTN","TMGDIS",1,0) +TMGDIS ;TMG/kst/Custom version of DIS ;03/25/06 +"RTN","TMGDIS",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIS",3,0) + +"RTN","TMGDIS",4,0) + +"RTN","TMGDIS",5,0) +DIS ;"SFISC/GFT-GATHER SEARCH CRITERIA ;05:52 PM 27 Mar 2002 +"RTN","TMGDIS",6,0) + ;";22.0;VA FileMan;**6,97**;Mar 30, 1999 +"RTN","TMGDIS",7,0) + ;"Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIS",8,0) + ;" +"RTN","TMGDIS",9,0) + ;"Purpose: to GATHER SEARCH CRITERIA +"RTN","TMGDIS",10,0) + ;" +"RTN","TMGDIS",11,0) + kill ^UTILITY($J) +"RTN","TMGDIS",12,0) + kill DC +"RTN","TMGDIS",13,0) + ;"Note: Stores coded search values +"RTN","TMGDIS",14,0) + ;"Example +"RTN","TMGDIS",15,0) + ;"DC(1)="14,.01^=105" <-- field 14, sub field .01 '=' IEN 105 (in pointed to file) +"RTN","TMGDIS",16,0) + ;"DC(2)="14,2^=44" <-- field 14, sub field 2 '=' IEN 44 (in pointed to file) +"RTN","TMGDIS",17,0) + ;" +"RTN","TMGDIS",18,0) + ;"Example +"RTN","TMGDIS",19,0) + ;"DC(1)="14,-1^[""ACETA""" <-- field 14 is a multiple, '-' --> ? 1 is field '[' ACETA +"RTN","TMGDIS",20,0) + ;"DC(2)="14,-2^[""%""" <-- field 14 is a multiple, '-' --> ? 2 is field '[' % +"RTN","TMGDIS",21,0) + ;" +"RTN","TMGDIS",22,0) + ;"Example +"RTN","TMGDIS",23,0) + ;"DC=6 +"RTN","TMGDIS",24,0) + ;"DC(1) = 14,.01^=105 <-- field 14, sub field .01 '=' IEN 105 (in pointed to file) +"RTN","TMGDIS",25,0) + ;"DC(2) = 14,-2^["%" <-- field 14 is a multiple, '-' --> ? 2 is field '[' % +"RTN","TMGDIS",26,0) + ;" note field 2 is a pointer, so perhaps '-' means non-exact match +"RTN","TMGDIS",27,0) + ;"DC(3) = 14,1^["1" <-- field 14 is a multiple, 1 is field '[' ACETA +"RTN","TMGDIS",28,0) + ;" note field 1 is free text, so perhaps '-' not needed +"RTN","TMGDIS",29,0) + ;"DC(4) = 1^=211 <-- field 1 '=' IEN 211 +"RTN","TMGDIS",30,0) + ;"DC(5) = .01^["A" <-- field .01 '[' A +"RTN","TMGDIS",31,0) + ;"Values of O with above example +"RTN","TMGDIS",32,0) + ;"O=0 +"RTN","TMGDIS",33,0) + ;"O(1) = VA PRODUCT ACTIVE INGREDIENTS EQUALS 105^ACETAMINOPHEN +"RTN","TMGDIS",34,0) + ;"O(2) = VA PRODUCT UNITS CONTAINS "%" +"RTN","TMGDIS",35,0) + ;"O(3) = VA PRODUCT STRENGTH CONTAINS "1" +"RTN","TMGDIS",36,0) + ;"O(4) = DOSAGE FORM EQUALS 211^BAG +"RTN","TMGDIS",37,0) + ;"O(5) = NAME CONTAINS "A" +"RTN","TMGDIS",38,0) + +"RTN","TMGDIS",39,0) + kill DIS,%ZIS +"RTN","TMGDIS",40,0) + kill O ;"Note: Stores file & field names and values to search for ('Oh', not 'zero') +"RTN","TMGDIS",41,0) + ;"Example: +"RTN","TMGDIS",42,0) + ;"O=0 +"RTN","TMGDIS",43,0) + ;"O(1) = VA PRODUCT ACTIVE INGREDIENTS CONTAINS (case-insensitive) "ACETAMINOPHEN" +"RTN","TMGDIS",44,0) + ;"O(2) = VA PRODUCT ACTIVE INGREDIENTS CONTAINS (case-insensitive) "CAFF" +"RTN","TMGDIS",45,0) + ;"O(3) = VA GENERIC NAME CONTAINS "A" +"RTN","TMGDIS",46,0) + ;"Note: +"RTN","TMGDIS",47,0) + ;" Each node (i.e. (1),(2) etc) contains a separate search item. +"RTN","TMGDIS",48,0) + ;" +"RTN","TMGDIS",49,0) + ;"Another example +"RTN","TMGDIS",50,0) + ;"O="EQUALS" +"RTN","TMGDIS",51,0) + ;"O(1)="VA PRODUCT ACTIVE INGREDIENTS EQUALS 105^ACETAMINOPHEN" +"RTN","TMGDIS",52,0) + ;"O(2)="VA PRODUCT UNITS EQUALS 44^%" +"RTN","TMGDIS",53,0) + ;" +"RTN","TMGDIS",54,0) + ;"Note: +"RTN","TMGDIS",55,0) + ;" In above examples, +"RTN","TMGDIS",56,0) + ;" O(1) --> VA PRODUCT is file name, ACTIVE INGREDIENTS is .01 field +"RTN","TMGDIS",57,0) + ;" of ACTIVE INGREDIENTS multiple +"RTN","TMGDIS",58,0) + ;" 105 is IEN of ACETAMINOPHEN +"RTN","TMGDIS",59,0) + ;" EQUALS is chosen comparator +"RTN","TMGDIS",60,0) + ;" O(2)--> VA PRODUCT is file name, UNITS is field 2 of ACTIVE INGREDIENTS multiple +"RTN","TMGDIS",61,0) + ;" 44 is IEN of unit '%' +"RTN","TMGDIS",62,0) + ;" EQUALS is chosen comparator +"RTN","TMGDIS",63,0) + ;" The value in O (e.g. 'EQUALS') is later killed, so not used in actual search. +"RTN","TMGDIS",64,0) + +"RTN","TMGDIS",65,0) + kill N,R +"RTN","TMGDIS",66,0) + do ^DICRW ;"get file to search in, return global open ref in DIC +"RTN","TMGDIS",67,0) + if '$data(DIC)!$data(DTOUT) goto Q +"RTN","TMGDIS",68,0) +EN ; +"RTN","TMGDIS",69,0) + if DIC set DIC=$G(^DIC(DIC,0,"GL")) +"RTN","TMGDIS",70,0) + if DIC="" quit +"RTN","TMGDIS",71,0) + kill DI,DX,DY,I,J,DL,DC,DA,DTOUT,^UTILITY($J) +"RTN","TMGDIS",72,0) + if '$data(@(DIC_"0)")) goto Q +"RTN","TMGDIS",73,0) + set (R,DI,I(0))=DIC +"RTN","TMGDIS",74,0) + set DL=1 ;"DL=indent amount from left margin. +"RTN","TMGDIS",75,0) + set DC=1 ;"DC=search element i.e. 1=A,2=B,3=C etc. +"RTN","TMGDIS",76,0) + set DY=999 +"RTN","TMGDIS",77,0) + set N=0 +"RTN","TMGDIS",78,0) + set Q="""" +"RTN","TMGDIS",79,0) + set DV="" +"RTN","TMGDIS",80,0) +R ; +"RTN","TMGDIS",81,0) + ;"set J(N) and DK<--file NUMBER, R<--file NAME +"RTN","TMGDIS",82,0) + if +R=R set (J(N),DK)=R,R="" +"RTN","TMGDIS",83,0) + else set @("(J(N),DK)=+$piece("_R_"0),U,2)"),R=$piece(^(0),U) +"RTN","TMGDIS",84,0) +F ; +"RTN","TMGDIS",85,0) + if DC>58 goto UP +"RTN","TMGDIS",86,0) + write ! +"RTN","TMGDIS",87,0) + kill X,DIC,P +"RTN","TMGDIS",88,0) + do W ;"Write label to screen line -A-, or -B- etc. +"RTN","TMGDIS",89,0) + set DIC(0)="EZ" +"RTN","TMGDIS",90,0) + set C="," +"RTN","TMGDIS",91,0) + set DIC="^DD("_DK_C +"RTN","TMGDIS",92,0) + set DIC("W")="SET %=$PIECE(^(0),U,2) WRITE:% $SELECT($PIECE(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"")" +"RTN","TMGDIS",93,0) + set DIC("S")="IF $PIECE(^(0),U,2)'[""m"""_$select($data(DICS):" "_DICS,1:""),DU="" +"RTN","TMGDIS",94,0) + write "SEARCH FOR "_R_" "_$piece(^DD(DK,0),U)_": " +"RTN","TMGDIS",95,0) + read X:DTIME ;"ask user for filed to search in, from specified file +"RTN","TMGDIS",96,0) + set:'$T DTOUT=1 +"RTN","TMGDIS",97,0) + if X=U!'$T goto Q +"RTN","TMGDIS",98,0) + if X?1"[".E goto TEM^TMGDIS2 +"RTN","TMGDIS",99,0) + do +"RTN","TMGDIS",100,0) + . new DISVX +"RTN","TMGDIS",101,0) + . set DISVX=X +"RTN","TMGDIS",102,0) + . do ^DIC ;"search for field, based on user input. +"RTN","TMGDIS",103,0) + . if Y=-1 set X=DISVX +"RTN","TMGDIS",104,0) + if '(Y>0) goto HARD +"RTN","TMGDIS",105,0) + kill P +"RTN","TMGDIS",106,0) + set DE=Y(0) +"RTN","TMGDIS",107,0) + set O(DC)=$piece(DE,U) +"RTN","TMGDIS",108,0) + set DU=+Y ;"DU = field number +"RTN","TMGDIS",109,0) + set Z=$piece(DE,U,3) ;"pointers or set data +"RTN","TMGDIS",110,0) + set E=$piece(DE,U,2) ;"field info codes, poss with subfile # +"RTN","TMGDIS",111,0) + goto G +"RTN","TMGDIS",112,0) + +"RTN","TMGDIS",113,0) + ;"========================================== +"RTN","TMGDIS",114,0) +HARD if X="" goto UP +"RTN","TMGDIS",115,0) + if X?."?" goto F +"RTN","TMGDIS",116,0) + if X=U!($data(DTOUT)) goto Q +"RTN","TMGDIS",117,0) + goto COMP^TMGDIS2 +"RTN","TMGDIS",118,0) + quit +"RTN","TMGDIS",119,0) + +"RTN","TMGDIS",120,0) + ;"========================================== +"RTN","TMGDIS",121,0) +G ; +"RTN","TMGDIS",122,0) + kill X,DIC +"RTN","TMGDIS",123,0) + set DIC="^DOPT(""DIS""," ;"file containing "equals","contains","greater than" etc. +"RTN","TMGDIS",124,0) + set DIC(0)="QEZ" +"RTN","TMGDIS",125,0) + if E["B" set X="" goto OK ;"'B'->field is a BOOLEAN COMPUTED field, so skip +"RTN","TMGDIS",126,0) + if 'E goto G2KT +"RTN","TMGDIS",127,0) + set N(DL)=N +"RTN","TMGDIS",128,0) + set N=N+1 +"RTN","TMGDIS",129,0) + set DV(DL)=DV +"RTN","TMGDIS",130,0) + set DL(DL)=DK +"RTN","TMGDIS",131,0) + set DK=+E +"RTN","TMGDIS",132,0) + set J(N)=DK +"RTN","TMGDIS",133,0) + set X=$piece($piece(DE,U,4),";") ;"4th piece of 0 node holds storage location +"RTN","TMGDIS",134,0) + set I(N)=$select(+X=X:X,1:""""_X_"""") +"RTN","TMGDIS",135,0) + set Y(0)=^DD(DK,.01,0) +"RTN","TMGDIS",136,0) + set DL=DL+1 ;"indent further +"RTN","TMGDIS",137,0) + goto WP:$piece(Y(0),U,2)["W" +"RTN","TMGDIS",138,0) + set DV=DV_+Y_"," +"RTN","TMGDIS",139,0) + goto F ;"loop back to get more field info. +"RTN","TMGDIS",140,0) + ;" +"RTN","TMGDIS",141,0) +G2KT if E["P" set P=+Y_U_Y(0),X="(#"_+Y_")" goto HARD +"RTN","TMGDIS",142,0) +C do W ;"Write label to screen line -A-, or -B- etc. +"RTN","TMGDIS",143,0) + read "CONDITION: ",X:DTIME +"RTN","TMGDIS",144,0) + set:'$T DTOUT=1 +"RTN","TMGDIS",145,0) + if X[U!'$T goto Q +"RTN","TMGDIS",146,0) + set DN=$select("'-"[$E(X):"'",1:"") ;"if NOT logic, DN="'" +"RTN","TMGDIS",147,0) + set X=$E(X,DN]""+1,99) ;"remove 'NOT' symbol, if present +"RTN","TMGDIS",148,0) + do ^DIC +"RTN","TMGDIS",149,0) + if Y<0 goto Q:X[U goto B:X="" goto DISCDIQQQ:X["?" goto C +"RTN","TMGDIS",150,0) + set O=$piece("NOT ",U,DN]"")_$piece(Y,U,2) +"RTN","TMGDIS",151,0) + if +Y=1 set X=DN_"?."" """ set O(DC)=O(DC)_" "_O goto OK +"RTN","TMGDIS",152,0) + set DQ=Y +"RTN","TMGDIS",153,0) + do W ;"Write label to screen line -A-, or -B- etc. +"RTN","TMGDIS",154,0) + write O +"RTN","TMGDIS",155,0) + if '((E["D")&(Y-3)) goto TMG1 +"RTN","TMGDIS",156,0) + read " DATE: ",X:DTIME +"RTN","TMGDIS",157,0) + set:'$T DTOUT=1 +"RTN","TMGDIS",158,0) + if X=U!'$T goto Q +"RTN","TMGDIS",159,0) + set %DT="TE" +"RTN","TMGDIS",160,0) + do ^%DT +"RTN","TMGDIS",161,0) + set X=Y_U_X +"RTN","TMGDIS",162,0) + if Y<0 goto X +"RTN","TMGDIS",163,0) + xecute ^DD("DD") +"RTN","TMGDIS",164,0) + set Y=X_U_Y +"RTN","TMGDIS",165,0) + goto GOT +"RTN","TMGDIS",166,0) + ; +"RTN","TMGDIS",167,0) +TMG1 ;"POINTERS +"RTN","TMGDIS",168,0) +PT if $data(P),+DQ=5 do goto Q:U[X!'$T do ^DIC goto GOT:Y>0,PT +"RTN","TMGDIS",169,0) + . kill DIC,DIS($char(DC+64)_DL) +"RTN","TMGDIS",170,0) + . set DIC=U_$piece(P,U,4) +"RTN","TMGDIS",171,0) + . set DIC(0)="EMQ" +"RTN","TMGDIS",172,0) + . set DU=+P +"RTN","TMGDIS",173,0) + . write " "_$piece(@(DIC_"0)"),U)_": " +"RTN","TMGDIS",174,0) + . read X:DTIME +"RTN","TMGDIS",175,0) + . set:'$T DTOUT=1 +"RTN","TMGDIS",176,0) + read ": ",Y:DTIME +"RTN","TMGDIS",177,0) + if '$T set DTOUT=1 goto Q +"RTN","TMGDIS",178,0) + goto X:Y="" +"RTN","TMGDIS",179,0) + if Y[U,$piece(DE,U,4)'[";E" goto Q +"RTN","TMGDIS",180,0) + if +DQ=3 set X="I X?"_Y do ^DIM goto GOT:$data(X) set Y="?" +"RTN","TMGDIS",181,0) + goto DISDIQQQ:Y?."?" +"RTN","TMGDIS",182,0) +SET if E["S" do if '$data(X) kill DIS(U,DC) goto DISDIQQQ +"RTN","TMGDIS",183,0) + . if +DQ=5!(Y["""") do kill:D="" X quit +"RTN","TMGDIS",184,0) + . . set Y=":"_Y +"RTN","TMGDIS",185,0) + . . new TMGQUIT set TMGQUIT=0 +"RTN","TMGDIS",186,0) + . . ;"for X=1:1 do if D[Y write $piece(D,Y,2,9) set Y=$piece(D,":")_U_$piece(D,":",2) Q +"RTN","TMGDIS",187,0) + . . for X=1:1 do quit:TMGQUIT=1 +"RTN","TMGDIS",188,0) + . . . set D=$piece(Z,";",X) +"RTN","TMGDIS",189,0) + . . . if D="" set TMGQUIT=1 quit +"RTN","TMGDIS",190,0) + . . . if D[Y do +"RTN","TMGDIS",191,0) + . . . . write $piece(D,Y,2,9) +"RTN","TMGDIS",192,0) + . . . . set Y=$piece(D,":")_U_$piece(D,":",2) +"RTN","TMGDIS",193,0) + . . . . set TMGQUIT=1 +"RTN","TMGDIS",194,0) +N . new N,%,C +"RTN","TMGDIS",195,0) + . write !?7 +"RTN","TMGDIS",196,0) + . set N="DE"_DN_$E(" [?<=>",DQ)_""""_Y_"""" +"RTN","TMGDIS",197,0) + . new TMGQUIT set TMGQUIT=0 +"RTN","TMGDIS",198,0) + . for X=1:1 do quit:TMGQUIT=1 +"RTN","TMGDIS",199,0) + . . set D=$piece(Z,";",X) +"RTN","TMGDIS",200,0) + . . set DE=$piece(D,":",2) +"RTN","TMGDIS",201,0) + . . if D="" set TMGQUIT=1 +"RTN","TMGDIS",202,0) + . . set DIS(U,DC,$piece(D,":"))=DE +"RTN","TMGDIS",203,0) + . . if @N do +"RTN","TMGDIS",204,0) + . . . set:'$data(%) %="[ Will match" +"RTN","TMGDIS",205,0) + . . . write % +"RTN","TMGDIS",206,0) + . . . set C=$G(C)+1 +"RTN","TMGDIS",207,0) + . . . set %="'"_DE_"'" +"RTN","TMGDIS",208,0) + . . . write:C>1 "," +"RTN","TMGDIS",209,0) + . . . write " " +"RTN","TMGDIS",210,0) + . . . write:$X+$L(%)>73 !?7 +"RTN","TMGDIS",211,0) + . if '$data(%) kill X Q +"RTN","TMGDIS",212,0) + . write:C>1 "and " +"RTN","TMGDIS",213,0) + . write %_" ]" +"RTN","TMGDIS",214,0) +T if DQ["THAN",+$piece(Y,U)'=$piece(Y,U) goto X +"RTN","TMGDIS",215,0) +QUOTE if DQ#3=2 do ;"Equals or Contains +"RTN","TMGDIS",216,0) + . write:$piece(Y,U)[""""&($L($piece(Y,U))>1) " (Your answer includes quotes)" +"RTN","TMGDIS",217,0) + . set $piece(Y,U)=""""_$$CONVQQ^DILIBF($piece(Y,U))_"""" +"RTN","TMGDIS",218,0) + . if $piece(Y,U)?.E2A.E do +"RTN","TMGDIS",219,0) + . . set DIS("XFORM",DC)="$$UP^DILIBF(;)" +"RTN","TMGDIS",220,0) + . . set O=O_" (case-insensitive)" +"RTN","TMGDIS",221,0) + . . set $piece(Y,U)=$$UP^DILIBF($piece(Y,U)) +"RTN","TMGDIS",222,0) +GOT set X=DN_$E(" [?<=>",DQ)_$piece(Y,U) +"RTN","TMGDIS",223,0) + if E["D" do +"RTN","TMGDIS",224,0) + . set Y=$piece(Y,U,3)_U_$piece(Y,U,2) +"RTN","TMGDIS",225,0) + . if $piece(Y,U)'["." do +"RTN","TMGDIS",226,0) + . . set %=$piece("^^^^ any time during^ the entire day",U,DQ) +"RTN","TMGDIS",227,0) + . . if %]"" do +"RTN","TMGDIS",228,0) + . . . set DIS("XFORM",DC)="$piece(;,""."")" +"RTN","TMGDIS",229,0) + . . . set O=O_% +"RTN","TMGDIS",230,0) + set O(DC)=O(DC)_" "_O_" "_Y +"RTN","TMGDIS",231,0) +OK set DC(DC)=DV_DU_U_X +"RTN","TMGDIS",232,0) + set %=DL-1_U_(N#100) +"RTN","TMGDIS",233,0) + if DL>1,O(DC)'[R set O(DC)=R_" "_O(DC) +"RTN","TMGDIS",234,0) + if DU["W" set %=DL-2_U_(N#100-1) +"RTN","TMGDIS",235,0) + set DX(DC)=% +"RTN","TMGDIS",236,0) + set DC=DC+1 ;"Inc logical part (i.e. 'A'->'B'->'C'->D) +"RTN","TMGDIS",237,0) + if DC=27 set DC=33 +"RTN","TMGDIS",238,0) +B goto F:(DU'["W"&(DC<59)) +"RTN","TMGDIS",239,0) +UP if '(DC>1) goto Q +"RTN","TMGDIS",240,0) + if DL<$select('$data(DIARF0):2,1:2) goto ^TMGDIS0 ;"done with entering conditions +"RTN","TMGDIS",241,0) + set DL=DL-1 +"RTN","TMGDIS",242,0) + set DV=DV(DL) +"RTN","TMGDIS",243,0) + set DK=DL(DL) +"RTN","TMGDIS",244,0) + set N=N(DL) +"RTN","TMGDIS",245,0) + set R=$select($data(R(DL)):R(DL),1:R) +"RTN","TMGDIS",246,0) + kill R(DL) +"RTN","TMGDIS",247,0) + set %=N +"RTN","TMGDIS",248,0) + for set %=$O(I(%)) set:%="" %=-1 goto F:%<0 kill I(%),J(%) +"RTN","TMGDIS",249,0) + for do if %<0 goto F +"RTN","TMGDIS",250,0) + . set %=$O(I(%)) +"RTN","TMGDIS",251,0) + . if %="" set %=-1 +"RTN","TMGDIS",252,0) + . if %<0 quit +"RTN","TMGDIS",253,0) + . kill I(%),J(%) +"RTN","TMGDIS",254,0) +Q if '$data(DIARU) goto Q^TMGDIS2 +"RTN","TMGDIS",255,0) + goto ^TMGDIS2 +"RTN","TMGDIS",256,0) + +"RTN","TMGDIS",257,0) + ;"========================================== +"RTN","TMGDIS",258,0) +WP set DIC("S")="if Y<3" +"RTN","TMGDIS",259,0) + set DU=+Y_"W" +"RTN","TMGDIS",260,0) + goto C +"RTN","TMGDIS",261,0) + +"RTN","TMGDIS",262,0) + ;"========================================== +"RTN","TMGDIS",263,0) +X ; +"RTN","TMGDIS",264,0) + write $char(7),"??",!! +"RTN","TMGDIS",265,0) + goto B +"RTN","TMGDIS",266,0) + +"RTN","TMGDIS",267,0) + ;"========================================== +"RTN","TMGDIS",268,0) +W write !?DL*2,"-"_$char(DC+64)_"- " +"RTN","TMGDIS",269,0) + quit +"RTN","TMGDIS",270,0) + +"RTN","TMGDIS",271,0) + ;"========================================== +"RTN","TMGDIS",272,0) +ENS ;" ENTRY POINT FOR RE-DOING THE SORT USING AN EXISTING SORT TEMPLATE +"RTN","TMGDIS",273,0) + goto EN^DIS3 +"RTN","TMGDIS",274,0) + +"RTN","TMGDIS",275,0) + +"RTN","TMGDIS",276,0) + +"RTN","TMGDIS",277,0) + ;" --- COPIED FROM DIQQQ.M to allow goto to return to this file, not ^DIS. +"RTN","TMGDIS",278,0) +DISDIQQQ ; +"RTN","TMGDIS",279,0) + write !?8,"ENTER A VALUE WHICH '"_O(DC)_"'" +"RTN","TMGDIS",280,0) + write !?8,"MUST "_$P("NOT ",U,DN]"") +"RTN","TMGDIS",281,0) + write $piece("^CONTAIN^MATCH^BE LESS THAN^EQUAL^EXCEED^FOLLOW",U,+DQ) +"RTN","TMGDIS",282,0) + write ", IN ORDER FOR TRUTH CONDITION -"_$char(DC+64)_"- TO BE TRUE",! +"RTN","TMGDIS",283,0) + write:+DQ=3 ?8,"(I.E., ENTER WHAT WOULD FOLLOW THE MUMPS '?' OPERATOR)",! +"RTN","TMGDIS",284,0) + if E["S" write !,"Use EXTERNAL VALUE (from list on the right)" D EN^DIQQ1(DK,DU,"?") +"RTN","TMGDIS",285,0) + write ! +"RTN","TMGDIS",286,0) + goto F +"RTN","TMGDIS",287,0) + +"RTN","TMGDIS",288,0) + ;" --- COPIED FROM DIQQQ.M to allow goto to return to this file, not ^DIS +"RTN","TMGDIS",289,0) +DISCDIQQ ; +"RTN","TMGDIS",290,0) + write !,"YOU CAN NEGATE ANY OF THESE CONDITIONS BY PRECEDING THEM WITH ""'"" OR ""-""" +"RTN","TMGDIS",291,0) + write !,"SO THAT ""'NULL'"" MEANS ""NOT NULL""",! +"RTN","TMGDIS",292,0) + goto C +"RTN","TMGDIS",293,0) + ; +"RTN","TMGDIS",294,0) + +"RTN","TMGDIS0") +0^11^B39243874 +"RTN","TMGDIS0",1,0) +TMGDIS0 ;TMG/kst/Custom version of DIS0 ;03/25/06 +"RTN","TMGDIS0",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIS0",3,0) + +"RTN","TMGDIS0",4,0) + +"RTN","TMGDIS0",5,0) + +"RTN","TMGDIS0",6,0) +DIS0 ;SFISC/GFT-SEARCH, IF STATEMENT AND MULTIPLE COMBO'S ;2/24/93 13:51 +"RTN","TMGDIS0",7,0) + ;;22.0;VA FileMan;;Mar 30, 1999 +"RTN","TMGDIS0",8,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIS0",9,0) + ; +"RTN","TMGDIS0",10,0) + ;"Purpose: to SEARCH, IF STATEMENT AND MULTIPLE COMBO'S +"RTN","TMGDIS0",11,0) + ;" i.e. determine combination of search terms, logic etc. +"RTN","TMGDIS0",12,0) + +"RTN","TMGDIS0",13,0) + ;"Note: At this point, user query for search conditions has been completed +"RTN","TMGDIS0",14,0) + ;"There are no calls back to ^DIS (from this module) +"RTN","TMGDIS0",15,0) + ;" ^DIS2 does go back to ^DIS +"RTN","TMGDIS0",16,0) + ;"From this module, the program execution flow will go to ^DIS1 +"RTN","TMGDIS0",17,0) + +"RTN","TMGDIS0",18,0) + write ! +"RTN","TMGDIS0",19,0) + +"RTN","TMGDIS0",20,0) + ;"See format description in TMGDIS.m +"RTN","TMGDIS0",21,0) + write !,"here is 'O'",! ;"//kt temp +"RTN","TMGDIS0",22,0) + zwr O(*) ;"//kt temp +"RTN","TMGDIS0",23,0) + write !,"here is 'DC'",! ;"//kt temp +"RTN","TMGDIS0",24,0) + zwr DC(*) ;"//kt temp +"RTN","TMGDIS0",25,0) + w !!;"//kt temp +"RTN","TMGDIS0",26,0) + +"RTN","TMGDIS0",27,0) + kill R,N,DL,DE,DJ +"RTN","TMGDIS0",28,0) + set O=0 +"RTN","TMGDIS0",29,0) + set E=$data(DC(2)) ;"E=1 if multiple search times, other with 0 +"RTN","TMGDIS0",30,0) + set N="IF: A// " +"RTN","TMGDIS0",31,0) + set DE=$select(E:"IF: ",1:N) +"RTN","TMGDIS0",32,0) + set DL=0 +"RTN","TMGDIS0",33,0) + set C="," +"RTN","TMGDIS0",34,0) +R write !,DE +"RTN","TMGDIS0",35,0) + kill DV +"RTN","TMGDIS0",36,0) + read X:DTIME ;"query user for logic search, e.g. 'A&B&C' +"RTN","TMGDIS0",37,0) + set:'$T DTOUT=1 +"RTN","TMGDIS0",38,0) + goto Q:X[U!'$T ;"quit if ^ or timeout. +"RTN","TMGDIS0",39,0) + if X="" do goto 1:DL goto BAD:E goto L +"RTN","TMGDIS0",40,0) + . set DV=1,DU=X +"RTN","TMGDIS0",41,0) + . quit:DL +"RTN","TMGDIS0",42,0) + . set DQ="TYPE '^' TO EXIT" +"RTN","TMGDIS0",43,0) + . set Y="^1^" +"RTN","TMGDIS0",44,0) + . set DL=1 +"RTN","TMGDIS0",45,0) + . quit:E ;"don't do ASKQ if multiple logic items, goto 1 +"RTN","TMGDIS0",46,0) + . do ASKQ +"RTN","TMGDIS0",47,0) + set Y=U +"RTN","TMGDIS0",48,0) + set P=0 +"RTN","TMGDIS0",49,0) + set DU="" +"RTN","TMGDIS0",50,0) + set D="" +"RTN","TMGDIS0",51,0) + set DL=DL+1 +"RTN","TMGDIS0",52,0) +P set P=P+1 +"RTN","TMGDIS0",53,0) + set DQ=$E(X,P) ;"DQ is parsed logic term (e.g. 'A', or '&', or 'B' etc.) +"RTN","TMGDIS0",54,0) + if DQ="" goto BAD:Y=U,L +"RTN","TMGDIS0",55,0) + if DQ?.A set DV=$A(DQ)-64 if $data(DC(DV)) do ASKQ goto CHK ;"end of CHK loops back to P +"RTN","TMGDIS0",56,0) + goto P:"&+ "[DQ +"RTN","TMGDIS0",57,0) + if DU="","'-"[DQ set DU="'" goto P +"RTN","TMGDIS0",58,0) +BAD write $char(7)," <",DQ,">??" +"RTN","TMGDIS0",59,0) + kill DJ(DL),DE(DL) +"RTN","TMGDIS0",60,0) + set DL=DL-1 +"RTN","TMGDIS0",61,0) + goto R +"RTN","TMGDIS0",62,0) + +"RTN","TMGDIS0",63,0) + ;"========================================== +"RTN","TMGDIS0",64,0) +ASKQ set J=DC(DV) +"RTN","TMGDIS0",65,0) + set %=J["?."" """ +"RTN","TMGDIS0",66,0) + set I=J["^'"+(DU["'")#2 +"RTN","TMGDIS0",67,0) + if J["W^" do quit +"RTN","TMGDIS0",68,0) + . set DV(DV)=$select(I:2-%,1:%+%+1) +"RTN","TMGDIS0",69,0) + . S:% DC(DV)=$E(J,1,$length(J)-5)_"=""""" +"RTN","TMGDIS0",70,0) + . quit +"RTN","TMGDIS0",71,0) + set:$piece(J,U,1)[C DV(DV)=J?.E1",.01^".E&%+(I+%#2) +"RTN","TMGDIS0",72,0) + quit +"RTN","TMGDIS0",73,0) + +"RTN","TMGDIS0",74,0) + ;"========================================== +"RTN","TMGDIS0",75,0) +CHK set %=$F(Y,U_DV) +"RTN","TMGDIS0",76,0) + if % do goto BAD +"RTN","TMGDIS0",77,0) + . set %=$piece($E(Y,%),U,1)'=DU +"RTN","TMGDIS0",78,0) + . set DQ=""""_DQ_""" AND """_$E("'",%)_DQ_""" IS "_$piece("REDUNDANT^CONTRADICTORY",U,%+1) +"RTN","TMGDIS0",79,0) + set %=1 +"RTN","TMGDIS0",80,0) + set Y=Y_DV_DU_U +"RTN","TMGDIS0",81,0) + set DU="" +"RTN","TMGDIS0",82,0) + set J=$piece(DC(DV),U,1) +"RTN","TMGDIS0",83,0) + goto P:J'[C +"RTN","TMGDIS0",84,0) + for Z=2:1 if $piece(J,C,Z,99)'[C set J=$piece(J,C,1,Z-1)_C Q +"RTN","TMGDIS0",85,0) + if J=D do +"RTN","TMGDIS0",86,0) + . do SAMEQ +"RTN","TMGDIS0",87,0) + . S:%=1 DJ(DL,DV)=DX(DV) +"RTN","TMGDIS0",88,0) + set D=J +"RTN","TMGDIS0",89,0) + set DJ=DV +"RTN","TMGDIS0",90,0) + goto P:%>0 +"RTN","TMGDIS0",91,0) + +"RTN","TMGDIS0",92,0) + ;"========================================== +"RTN","TMGDIS0",93,0) +Q goto Q^TMGDIS2 +"RTN","TMGDIS0",94,0) + +"RTN","TMGDIS0",95,0) + ;"========================================== +"RTN","TMGDIS0",96,0) +SAMEQ if J<0,$piece(DY(-J),U,3)="" Q +"RTN","TMGDIS0",97,0) + write !?8,"CONDITION -"_$char(DV+64) +"RTN","TMGDIS0",98,0) + write "- WILL APPLY TO THE SAME MULTIPLE AS CONDITION -" +"RTN","TMGDIS0",99,0) + write $char(DJ+64)_"-",!?8,"...OK" +"RTN","TMGDIS0",100,0) + goto YN^DICN +"RTN","TMGDIS0",101,0) + +"RTN","TMGDIS0",102,0) + ;"========================================== +"RTN","TMGDIS0",103,0) +L set P=O +"RTN","TMGDIS0",104,0) + set DL(DL)=Y +"RTN","TMGDIS0",105,0) + set DE="OR: " +"RTN","TMGDIS0",106,0) + for %=2:1 do quit:X="" +"RTN","TMGDIS0",107,0) + . set X=$piece(Y,U,%) +"RTN","TMGDIS0",108,0) + . quit:X="" +"RTN","TMGDIS0",109,0) + . set O=O+1 +"RTN","TMGDIS0",110,0) + . new tempS1,tempS2 +"RTN","TMGDIS0",111,0) + . set tempS2=$select($data(DJ(DL,+X)):" together with ",1:" and ") +"RTN","TMGDIS0",112,0) + . set tempS=$select(%>2:tempS2,O=1:"",1:" Or ") +"RTN","TMGDIS0",113,0) + . set tempS=tempS_$piece("not ",U,X["'") +"RTN","TMGDIS0",114,0) + . set tempS=tempS_O(+X) +"RTN","TMGDIS0",115,0) + . set ^UTILITY($J,O,0)=tempS +"RTN","TMGDIS0",116,0) + write:$X>18 ! +"RTN","TMGDIS0",117,0) + write " " +"RTN","TMGDIS0",118,0) + for %=P+1:1 quit:'$data(^UTILITY($J,%,0)) do +"RTN","TMGDIS0",119,0) + . set X=^(0) +"RTN","TMGDIS0",120,0) + . write:$length(X)+$X>77 !?13 +"RTN","TMGDIS0",121,0) + . write " "_$piece(X,U) +"RTN","TMGDIS0",122,0) + . if $piece(X,U,2)'="" write " ("_$piece(X,U,2)_")" +"RTN","TMGDIS0",123,0) + set DV=0 +"RTN","TMGDIS0",124,0) +DV set DV=$O(DV(DV)) +"RTN","TMGDIS0",125,0) + set:DV="" DV=-1 +"RTN","TMGDIS0",126,0) + goto:DV'>0 R:E,1 +"RTN","TMGDIS0",127,0) + goto DV:$data(DJ(DL,DV)) +"RTN","TMGDIS0",128,0) + set I=$piece(DC(DV),U,1) +"RTN","TMGDIS0",129,0) + set D=DK +"RTN","TMGDIS0",130,0) + set DN=0 +"RTN","TMGDIS0",131,0) + set Y="DO YOU WANT THIS SEARCH SPECIFICATION TO BE CONSIDERED TRUE FOR CONDITION -"_$char(DV+64)_"-" +"RTN","TMGDIS0",132,0) +G set DN=DN+1 +"RTN","TMGDIS0",133,0) + set P=$piece(I,C,1) +"RTN","TMGDIS0",134,0) + set I=$piece(I,C,2,99) +"RTN","TMGDIS0",135,0) + goto W:P["W",DV:I="" +"RTN","TMGDIS0",136,0) + if P<0 do goto G:'$piece(J,U,3) +"RTN","TMGDIS0",137,0) + . set J=DY(-P) +"RTN","TMGDIS0",138,0) + . set D=+J +"RTN","TMGDIS0",139,0) + . set R=" '"_$piece(^DIC(D,0),U,1)_"' ENTRIES " +"RTN","TMGDIS0",140,0) + else do +"RTN","TMGDIS0",141,0) + . set D=+$piece(^DD(D,P,0),U,2) +"RTN","TMGDIS0",142,0) + . set R=" '"_$O(^DD(D,0,"NM",0))_"' MULTIPLES " +"RTN","TMGDIS0",143,0) +HOW write !!,Y,!?8,"1) WHEN AT LEAST ONE OF THE"_R_"SATISFIES IT" +"RTN","TMGDIS0",144,0) + write !?8,"2) WHEN ALL OF THE"_R_"SATISFY IT" +"RTN","TMGDIS0",145,0) + set X=2 +"RTN","TMGDIS0",146,0) + if DV(DV) do +"RTN","TMGDIS0",147,0) + . write !?8,"3) WHEN ALL OF THE"_R_"SATISFY IT,",!?16,"OR WHEN THERE ARE NO"_R +"RTN","TMGDIS0",148,0) + . set X=3 +"RTN","TMGDIS0",149,0) + write !?4,"CHOOSE 1-"_X_": " +"RTN","TMGDIS0",150,0) + if DV(DV)>1 do +"RTN","TMGDIS0",151,0) + . write 3 +"RTN","TMGDIS0",152,0) + . set %1=3 +"RTN","TMGDIS0",153,0) + else do +"RTN","TMGDIS0",154,0) + . write 1 +"RTN","TMGDIS0",155,0) + . set %1=1 +"RTN","TMGDIS0",156,0) + read "// ",%:DTIME,! +"RTN","TMGDIS0",157,0) + set:'$T DTOUT=1 +"RTN","TMGDIS0",158,0) + set:%="" %=%1 +"RTN","TMGDIS0",159,0) + kill %1 +"RTN","TMGDIS0",160,0) + goto Q:%=U!'$T +"RTN","TMGDIS0",161,0) + goto HOW:%>X!'% +"RTN","TMGDIS0",162,0) + if %>1 do +"RTN","TMGDIS0",163,0) + . set DE(DL,DV,DN)=% +"RTN","TMGDIS0",164,0) + . set O=O+1 +"RTN","TMGDIS0",165,0) + . set ^UTILITY($J,O,0)=" for all"_R_$piece(", or when no"_R_"exist",U,%>2) +"RTN","TMGDIS0",166,0) + goto G +"RTN","TMGDIS0",167,0) + +"RTN","TMGDIS0",168,0) + ;"========================================== +"RTN","TMGDIS0",169,0) +W if DV(DV)-2 set DE(DL,DV,DN)=DV(DV) goto DV +"RTN","TMGDIS0",170,0) + write !!,Y,!?7,"WHEN THERE IS NO '"_$piece(^DD(D,+P,0),U,1)_"' TEXT AT ALL" +"RTN","TMGDIS0",171,0) + set %=1 +"RTN","TMGDIS0",172,0) + do YN^DICN +"RTN","TMGDIS0",173,0) + goto Q:%<0 +"RTN","TMGDIS0",174,0) + goto W:'% +"RTN","TMGDIS0",175,0) + set DE(DL,DV,DN)=4-% +"RTN","TMGDIS0",176,0) + goto DV +"RTN","TMGDIS0",177,0) + +"RTN","TMGDIS0",178,0) + ;"========================================== +"RTN","TMGDIS0",179,0) +1 kill O,DX,Y +"RTN","TMGDIS0",180,0) + goto ^TMGDIS1 +"RTN","TMGDIS1") +0^12^B43572349 +"RTN","TMGDIS1",1,0) +TMGDIS1 ;TMG/kst/Custom version of DIS1 ;03/25/06 +"RTN","TMGDIS1",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIS1",3,0) + +"RTN","TMGDIS1",4,0) + +"RTN","TMGDIS1",5,0) + +"RTN","TMGDIS1",6,0) +DIS1 ;SFISC/GFT-BUILD DIS-ARRAY ;09:04 AM 21 Aug 2002 +"RTN","TMGDIS1",7,0) + ;;22.0;VA FileMan;**6,77,97,113**;Mar 30, 1999 +"RTN","TMGDIS1",8,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIS1",9,0) + +"RTN","TMGDIS1",10,0) + ;"Purpose: BUILD DIS-ARRAY +"RTN","TMGDIS1",11,0) + ;"From here program execution flow goes only to ^DIS2 +"RTN","TMGDIS1",12,0) + ;" ^DIS can goto ^DIS (starting back at beginning) +"RTN","TMGDIS1",13,0) + +"RTN","TMGDIS1",14,0) + kill DIS0 +"RTN","TMGDIS1",15,0) + if $data(DL)#2 set DIS0=DL +"RTN","TMGDIS1",16,0) + set DL(0)="" +"RTN","TMGDIS1",17,0) + write ! +"RTN","TMGDIS1",18,0) + goto 1:$data(DE)>1!$data(DJ) +"RTN","TMGDIS1",19,0) + if DL=1 do +"RTN","TMGDIS1",20,0) + . set DL(0)=DL(1) +"RTN","TMGDIS1",21,0) + . set DL=0 +"RTN","TMGDIS1",22,0) + . kill DL(1) +"RTN","TMGDIS1",23,0) + else for P=2:1 do quit:Y="" +"RTN","TMGDIS1",24,0) + . set Y=$piece(DL(1),U,P) +"RTN","TMGDIS1",25,0) + . quit:Y="" +"RTN","TMGDIS1",26,0) + . set Y=U_Y_U,X=2 +"RTN","TMGDIS1",27,0) + . do 2 +"RTN","TMGDIS1",28,0) + for X=1:1 quit:'$data(DL(X)) do +"RTN","TMGDIS1",29,0) + . for Y=X+1:1 quit:'$data(DL(Y)) do +"RTN","TMGDIS1",30,0) + . . if DL(X)=DL(Y)!(DL(Y)?.P) do +"RTN","TMGDIS1",31,0) + . . . set DL=DL-1 +"RTN","TMGDIS1",32,0) + . . . kill DL(Y) +"RTN","TMGDIS1",33,0) + . . . for P=Y:1:DL do +"RTN","TMGDIS1",34,0) + . . . . set DL(P)=DL(P+1) +"RTN","TMGDIS1",35,0) + . . . . kill DL(P+1) +"RTN","TMGDIS1",36,0) +1 do ENT +"RTN","TMGDIS1",37,0) + goto ^TMGDIS2:'$data(DIAR) +"RTN","TMGDIS1",38,0) + goto DIS^TMGDIS2 +"RTN","TMGDIS1",39,0) + +"RTN","TMGDIS1",40,0) + ;"========================================== +"RTN","TMGDIS1",41,0) + ;"========================================== +"RTN","TMGDIS1",42,0) +ENT set DK(0)=DK +"RTN","TMGDIS1",43,0) + set Z="D0," +"RTN","TMGDIS1",44,0) + for DQ=0:1:DL do +"RTN","TMGDIS1",45,0) + . kill R,M +"RTN","TMGDIS1",46,0) + . do +"RTN","TMGDIS1",47,0) + . . new I set I="" +"RTN","TMGDIS1",48,0) + . . for set I=$O(DI(I)) quit:'I kill DI(I) +"RTN","TMGDIS1",49,0) + . . quit +"RTN","TMGDIS1",50,0) + . set X=0 +"RTN","TMGDIS1",51,0) + . set DQ(0)=DQ +"RTN","TMGDIS1",52,0) + . set R=-1 +"RTN","TMGDIS1",53,0) + . do MAKE +"RTN","TMGDIS1",54,0) + . set %=0 +"RTN","TMGDIS1",55,0) + . for do quit:R="" +"RTN","TMGDIS1",56,0) + . . set R=$O(R(R)) +"RTN","TMGDIS1",57,0) + . . quit:R="" +"RTN","TMGDIS1",58,0) + . . if R(R)<2 set DIS(R)=DIS(R)_" KILL D" +"RTN","TMGDIS1",59,0) + set R=-1 +"RTN","TMGDIS1",60,0) + quit +"RTN","TMGDIS1",61,0) + +"RTN","TMGDIS1",62,0) + ;"========================================== +"RTN","TMGDIS1",63,0) +2 if X'>DL quit:DL(X)'[Y set X=X+1 goto 2 +"RTN","TMGDIS1",64,0) + set DL(0)=U_$piece(Y,U,2)_DL(0) +"RTN","TMGDIS1",65,0) + set P=P-1 +"RTN","TMGDIS1",66,0) +22 set X=X-1 +"RTN","TMGDIS1",67,0) + set DQ=$F(DL(X),Y) +"RTN","TMGDIS1",68,0) + set DL(X)=$extract(DL(X),1,DQ-$L(Y))_$extract(DL(X),DQ,999) +"RTN","TMGDIS1",69,0) + goto 22:X>1 +"RTN","TMGDIS1",70,0) + quit +"RTN","TMGDIS1",71,0) + +"RTN","TMGDIS1",72,0) + ;"========================================== +"RTN","TMGDIS1",73,0) +C set Y=Y_$S(DV="'":" if 'X",1:" I "_$$XFORM("X")_DV) +"RTN","TMGDIS1",74,0) + do SD +"RTN","TMGDIS1",75,0) +MAKE set DC=DI +"RTN","TMGDIS1",76,0) + set DQ=+DQ +"RTN","TMGDIS1",77,0) + set X=X+1 +"RTN","TMGDIS1",78,0) + set Y=$piece(DL(DQ),U,X+1) +"RTN","TMGDIS1",79,0) + quit:Y="" +"RTN","TMGDIS1",80,0) + set S=+Y +"RTN","TMGDIS1",81,0) + set DN=$extract("'",Y["'") +"RTN","TMGDIS1",82,0) + set Y=DC(S) +"RTN","TMGDIS1",83,0) + set D=0,DL=0 +"RTN","TMGDIS1",84,0) + if $data(DJ(DQ,S)) do +"RTN","TMGDIS1",85,0) + . set D=$piece(DJ(DQ,S),U,2) +"RTN","TMGDIS1",86,0) + . set DL=+DJ(DQ,S) +"RTN","TMGDIS1",87,0) + . if $data(DI(DL)) set DC=DI(DL) +"RTN","TMGDIS1",88,0) + set DQ=DQ(DL) +"RTN","TMGDIS1",89,0) + set Z=$piece(Z,",",1,D+D+1)_"," +"RTN","TMGDIS1",90,0) + set DU=$piece($piece(Y,U),",",DL+1,99) +"RTN","TMGDIS1",91,0) + set O=DK(DL) +"RTN","TMGDIS1",92,0) + set DV=DN_$piece(Y,U,2) +"RTN","TMGDIS1",93,0) + if DV?1"''".E set DV=$extract(DV,3,999) +"RTN","TMGDIS1",94,0) +LEV set DL=DL+1 +"RTN","TMGDIS1",95,0) + set DN=$S($data(DE(+DQ,X,DL)):DE(+DQ,X,DL),1:1) +"RTN","TMGDIS1",96,0) + set:$G(DI(DL-1))]"" DI(DL)=DI(DL-1) +"RTN","TMGDIS1",97,0) + if DU<0 goto X:$data(DY(-DU)) set Y=DA(-DU) goto C +"RTN","TMGDIS1",98,0) + set N=$piece(^DD(O,+DU,0),U,4) +"RTN","TMGDIS1",99,0) + set DE=$piece(N,";",1) +"RTN","TMGDIS1",100,0) + set Y=$piece(N,";",2) +"RTN","TMGDIS1",101,0) + if Y="" set Y="D"_D goto M +"RTN","TMGDIS1",102,0) + if $piece(^(0),U,2)["C" set Y=$piece(^(0),U,5,99) goto C +"RTN","TMGDIS1",103,0) + set:+DE'=DE DE=""""_DE_"""" +"RTN","TMGDIS1",104,0) + set Z=Z_DE +"RTN","TMGDIS1",105,0) + set E="$G("_DC_Z_"))" +"RTN","TMGDIS1",106,0) + if Y set Y="$piece("_E_",U,"_Y_")" goto M +"RTN","TMGDIS1",107,0) + if Y'=0 do goto M +"RTN","TMGDIS1",108,0) + . set Y=$extract(Y,2,99) +"RTN","TMGDIS1",109,0) + . set:$piece(Y,",",2)=+Y Y=+Y +"RTN","TMGDIS1",110,0) + . set Y="$extract("_E_","_Y_")" +"RTN","TMGDIS1",111,0) + for Y=65:1 set M=DQ_$C(Y) quit:'$data(DIS(M)) +"RTN","TMGDIS1",112,0) + set D=D+1 +"RTN","TMGDIS1",113,0) + set Y="set D"_D_"=+$O("_DC_Z_",0)) X DIS("""_M_""") if $T" +"RTN","TMGDIS1",114,0) + do SD +"RTN","TMGDIS1",115,0) + if $data(DIAR) set DIAR(DIARF,DQ)="X DIS("""_M_"A"")" +"RTN","TMGDIS1",116,0) + set DQ=M +"RTN","TMGDIS1",117,0) + set DIS(DQ)="F X DIS("""_DQ_"A"") X:D"_D_"'>0 ""IF "_(DN=3)_""" Q:"_$extract("'",DN>1)_"$T set D"_D_"=$O("_DC_Z_",D"_D_")) Q:D"_D_"'>0" +"RTN","TMGDIS1",118,0) +WP set DQ=DQ_"A",DQ(DL)=DQ +"RTN","TMGDIS1",119,0) + if DU'["," set DIS(DQ)="if "_$$XFORM("$G(^(D"_D_",0))")_DV goto MAKE +"RTN","TMGDIS1",120,0) + set O=+$piece(^(0),U,2) +"RTN","TMGDIS1",121,0) + set DK(DL)=O +"RTN","TMGDIS1",122,0) + set Z=Z_",D"_D_"," +"RTN","TMGDIS1",123,0) +N set DU=$piece(DU,",",2,99) +"RTN","TMGDIS1",124,0) + goto LEV +"RTN","TMGDIS1",125,0) + +"RTN","TMGDIS1",126,0) + ;"========================================== +"RTN","TMGDIS1",127,0) +M do +"RTN","TMGDIS1",128,0) +VARPOINT . if $piece(^DD(O,+DU,0),U,2)["V" do quit +"RTN","TMGDIS1",129,0) + . . set Y="if "_$$XFORM("$$EXTERNAL^DIDU("_O_","_+DU_","""","_Y_")") +"RTN","TMGDIS1",130,0) + . ;"--following line modified per GFT to fix search with output transform on pointer, jas 2005-03-23--; +"RTN","TMGDIS1",131,0) +OUTX . if $data(^(2)),$piece(^(0),U,2)'["D",DV'["=" do quit +"RTN","TMGDIS1",132,0) + . . set M=0,Y="set Y="_Y_" "_$$OVFL(^(2))_" if "_$$XFORM("Y") +"RTN","TMGDIS1",133,0) +SET . if $data(DIS(U,S)) do quit +"RTN","TMGDIS1",134,0) + . . set Y="set Y="_Y_" if $S(Y="""":"""",$D(DIS(U,"_S_",Y)):DIS(U,"_S_",Y),1:"""")" +"RTN","TMGDIS1",135,0) + . set M=Y +"RTN","TMGDIS1",136,0) + . set Y="if "_$$XFORM(Y) +"RTN","TMGDIS1",137,0) + set Y=Y_DV +"RTN","TMGDIS1",138,0) + do SD +"RTN","TMGDIS1",139,0) + goto MAKE +"RTN","TMGDIS1",140,0) + +"RTN","TMGDIS1",141,0) + ;"========================================== +"RTN","TMGDIS1",142,0) +XFORM(Y) if '$data(DIS("XFORM",S)) quit Y +"RTN","TMGDIS1",143,0) + quit $piece(DIS("XFORM",S),";")_Y_$piece(DIS("XFORM",S),";",2) +"RTN","TMGDIS1",144,0) + +"RTN","TMGDIS1",145,0) + ;"========================================== +"RTN","TMGDIS1",146,0) +SD if $data(R(DQ)),R(DQ)>1 set Y="kill D "_Y_" set:$T D=1" +"RTN","TMGDIS1",147,0) + if '$data(DIS(DQ)) set DIS(DQ)=Y quit +"RTN","TMGDIS1",148,0) + if $L($G(DL(DQ)))*8+$L(DIS(DQ))+$L(Y)>180 do +"RTN","TMGDIS1",149,0) + . set Y=$$OVFL(Y)_" if $T" +"RTN","TMGDIS1",150,0) + . if $L(Y)+$L(DIS(DQ))>235 do +"RTN","TMGDIS1",151,0) + . . set DIS(DQ)=$$OVFL(DIS(DQ))_" if " +"RTN","TMGDIS1",152,0) + set DIS(DQ)=DIS(DQ)_" "_Y +"RTN","TMGDIS1",153,0) + quit +"RTN","TMGDIS1",154,0) + +"RTN","TMGDIS1",155,0) + ;"========================================== +"RTN","TMGDIS1",156,0) +OVFL(Y) new I,% +"RTN","TMGDIS1",157,0) + for I=1:1 do quit:'$data(DIS(%)) +"RTN","TMGDIS1",158,0) + . set %=DQ_"@"_I +"RTN","TMGDIS1",159,0) + set DIS(%)=Y +"RTN","TMGDIS1",160,0) + quit "X DIS("""_%_""")" +"RTN","TMGDIS1",161,0) + +"RTN","TMGDIS1",162,0) + ;"========================================== +"RTN","TMGDIS1",163,0) +X set D=DY(-DU) +"RTN","TMGDIS1",164,0) + set O=+D +"RTN","TMGDIS1",165,0) + set DC=U_$piece(D,U,2) +"RTN","TMGDIS1",166,0) + for %=66:1 set M=DQ_$C(%) quit:'$data(DIS(M)) +"RTN","TMGDIS1",167,0) + if $piece(D,U,3) do +"RTN","TMGDIS1",168,0) + . set M=DQ_U_$piece(D,U,3) +"RTN","TMGDIS1",169,0) + . set Y="set DIXX="""_M_""" "_$piece("X ""if 0"" ^I 1 ",U,DN=3+1)_$piece(D,U,4,99)_" if $T" +"RTN","TMGDIS1",170,0) + . set R(M)=DN +"RTN","TMGDIS1",171,0) + else do +"RTN","TMGDIS1",172,0) + . set Y=$piece(D,U,4,99)_" set D0=D(0) X DIS("""_M_""") set D0=I(0,0) if $T" +"RTN","TMGDIS1",173,0) + do SD +"RTN","TMGDIS1",174,0) + set DQ=M +"RTN","TMGDIS1",175,0) + set DI(DL)=DC +"RTN","TMGDIS1",176,0) + set DK(DL)=+D +"RTN","TMGDIS1",177,0) + set DQ(DL)=DQ +"RTN","TMGDIS1",178,0) + set D=0 +"RTN","TMGDIS1",179,0) + set Z="D0," +"RTN","TMGDIS1",180,0) + goto N +"RTN","TMGDIS1",181,0) + +"RTN","TMGDIS1",182,0) + ;-- DIS1 -- Downloaded 25Mar05 from M2Web, vista.vmth.ucdavis.edu +"RTN","TMGDIS2") +0^13^B21503917 +"RTN","TMGDIS2",1,0) +TMGDIS2 ;TMG/kst/Custom version of DIS2 ;03/25/06 +"RTN","TMGDIS2",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIS2",3,0) + +"RTN","TMGDIS2",4,0) + +"RTN","TMGDIS2",5,0) + +"RTN","TMGDIS2",6,0) +DIS2 ;SFISC/GFT-SEARCH, TEMPLATES & COMPUTED FIELDS ;5:49 AM 2 Jun 1999 +"RTN","TMGDIS2",7,0) + ;;22.0;VA FileMan;**6**;Mar 30, 1999 +"RTN","TMGDIS2",8,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIS2",9,0) + ; +"RTN","TMGDIS2",10,0) + +"RTN","TMGDIS2",11,0) + ;"Purpose: SEARCH, TEMPLATES & COMPUTED FIELDS +"RTN","TMGDIS2",12,0) + ;"Note: Program execution can loop all the way back to ^DIS +"RTN","TMGDIS2",13,0) + +"RTN","TMGDIS2",14,0) + kill DISV +"RTN","TMGDIS2",15,0) + goto G:'DUZ +"RTN","TMGDIS2",16,0) +0 do +"RTN","TMGDIS2",17,0) + . new DIS,DIS0,DA,DC,DE,DJ,DL +"RTN","TMGDIS2",18,0) + . do S3^DIBT1 +"RTN","TMGDIS2",19,0) + . Q +"RTN","TMGDIS2",20,0) + kill DIRUT,DIROUT +"RTN","TMGDIS2",21,0) + if $D(DTOUT)!($D(DUOUT)) goto Q +"RTN","TMGDIS2",22,0) + if X="" goto G:'$D(DIAR) +"RTN","TMGDIS2",23,0) + if Y<0 goto Q:X=U,0 +"RTN","TMGDIS2",24,0) + if $D(DIARU),DIARU-Y=0 do goto 0 +"RTN","TMGDIS2",25,0) + . write $C(7),!,"Archivers must not store results in the default template" +"RTN","TMGDIS2",26,0) + set (DIARI,DISV)=+Y +"RTN","TMGDIS2",27,0) + set A=$D(^DIBT(DISV,"DL")) +"RTN","TMGDIS2",28,0) + set:$D(DIS0)#2 ^("DL")=DIS0 +"RTN","TMGDIS2",29,0) + set:$D(DA)#2 ^("DA")=DA +"RTN","TMGDIS2",30,0) + set:$D(DJ)#2 ^("DJ")=DJ +"RTN","TMGDIS2",31,0) + if $D(DIAR),'$D(DIARU) set $P(^DIAR(1.11,DIARC,0),U,3)=DISV +"RTN","TMGDIS2",32,0) + set Z=-1,DIS0="^DIBT(+Y," +"RTN","TMGDIS2",33,0) + for P="DIS","DA","DC","DE","DJ","DL" do +"RTN","TMGDIS2",34,0) + . set %Y=DIS0_""""_P_"""," +"RTN","TMGDIS2",35,0) + . set %X=P_"(" +"RTN","TMGDIS2",36,0) + . do %XY^%RCR +"RTN","TMGDIS2",37,0) + set %X="^UTILITY($J," +"RTN","TMGDIS2",38,0) + set %Y="^DIBT(DISV,""O""," +"RTN","TMGDIS2",39,0) + set @(%X_"0)=U") +"RTN","TMGDIS2",40,0) + do %XY^%RCR +"RTN","TMGDIS2",41,0) +G new DISTXT +"RTN","TMGDIS2",42,0) + set %X="^UTILITY($J," +"RTN","TMGDIS2",43,0) + set %Y="DISTXT(" +"RTN","TMGDIS2",44,0) + do %XY^%RCR +"RTN","TMGDIS2",45,0) + write ! +"RTN","TMGDIS2",46,0) + set Y=DI +"RTN","TMGDIS2",47,0) + do Q +"RTN","TMGDIS2",48,0) + set DIC=Y +"RTN","TMGDIS2",49,0) + goto EN1^DIP:$D(SF)!$D(L)&'$D(DIAR),EN^DIP +"RTN","TMGDIS2",50,0) + +"RTN","TMGDIS2",51,0) + ;"========================================== +"RTN","TMGDIS2",52,0) +TEM ; +"RTN","TMGDIS2",53,0) + kill DIC +"RTN","TMGDIS2",54,0) + set X=$P($extract(X,2,99),"]",1) +"RTN","TMGDIS2",55,0) + set DIC="^DIBT(" +"RTN","TMGDIS2",56,0) + set DIC(0)="EQ" +"RTN","TMGDIS2",57,0) + set DIC("S")="if "_$select($D(DIAR):"$P(^(0),U,8)",1:"'$P(^(0),U,8)")_",$P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))" +"RTN","TMGDIS2",58,0) + set DIC("W")="X ""for %=1:1 Q:'$D(^DIBT(Y,""""O"""",%,0)) write !?9 set I=^(0) W:$L(I)+$X>79 !?9 write I""" +"RTN","TMGDIS2",59,0) + do ^DIC +"RTN","TMGDIS2",60,0) + kill DIC +"RTN","TMGDIS2",61,0) + goto F^TMGDIS:Y<0 +"RTN","TMGDIS2",62,0) + set P="DIS" +"RTN","TMGDIS2",63,0) + set Z=-1 +"RTN","TMGDIS2",64,0) + set %X="^DIBT(+Y,P," +"RTN","TMGDIS2",65,0) + set %Y="DIS(" +"RTN","TMGDIS2",66,0) + do %XY^%RCR +"RTN","TMGDIS2",67,0) + set %Y="^UTILITY($J," +"RTN","TMGDIS2",68,0) + set P="O" +"RTN","TMGDIS2",69,0) + do %XY^%RCR +"RTN","TMGDIS2",70,0) + goto DIS2 +"RTN","TMGDIS2",71,0) + +"RTN","TMGDIS2",72,0) + ;"========================================== +"RTN","TMGDIS2",73,0) +COMP ; +"RTN","TMGDIS2",74,0) + set E=X +"RTN","TMGDIS2",75,0) + set DICMX="X DIS(DIXX)" +"RTN","TMGDIS2",76,0) + set DICOMP=N_"?" +"RTN","TMGDIS2",77,0) + set DQI="Y(" +"RTN","TMGDIS2",78,0) + set DA="DIS("""_$C(DC+64)_DL_"""," +"RTN","TMGDIS2",79,0) + if '$D(O(DC))#2 set O(DC)=X +"RTN","TMGDIS2",80,0) + goto COLON:X?.E1":" +"RTN","TMGDIS2",81,0) + if X?.E1":.01",'$D(O(DC))#2 set O(DC)=$extract(X,1,$L(X)-4) +"RTN","TMGDIS2",82,0) + do EN^DICOMP +"RTN","TMGDIS2",83,0) + do XA +"RTN","TMGDIS2",84,0) + goto X^TMGDIS:'$D(X) +"RTN","TMGDIS2",85,0) + goto X^TMGDIS:Y["m" ;"if Y["m" set X=E_":" goto COMP +"RTN","TMGDIS2",86,0) + set DA(DC)=X +"RTN","TMGDIS2",87,0) + set DU=-DC +"RTN","TMGDIS2",88,0) + set E=$extract("B",Y["B")_$extract("D",Y["D") +"RTN","TMGDIS2",89,0) + goto G^TMGDIS +"RTN","TMGDIS2",90,0) + +"RTN","TMGDIS2",91,0) + ;"========================================== +"RTN","TMGDIS2",92,0) +XA set %=0 +"RTN","TMGDIS2",93,0) + for do Q:%="" +"RTN","TMGDIS2",94,0) + . set %=$O(X(%)) +"RTN","TMGDIS2",95,0) + . Q:%="" +"RTN","TMGDIS2",96,0) + . set @(DA_%_")")=X(%) +"RTN","TMGDIS2",97,0) + set %=-1 +"RTN","TMGDIS2",98,0) + quit +"RTN","TMGDIS2",99,0) + +"RTN","TMGDIS2",100,0) + ;"========================================== +"RTN","TMGDIS2",101,0) +COLON do ^DICOMPW +"RTN","TMGDIS2",102,0) + goto X^TMGDIS:'$D(X) +"RTN","TMGDIS2",103,0) + do XA +"RTN","TMGDIS2",104,0) + set R(DL)=R +"RTN","TMGDIS2",105,0) + set N(DL)=N +"RTN","TMGDIS2",106,0) + set N=+Y +"RTN","TMGDIS2",107,0) + set DY=DY+1 +"RTN","TMGDIS2",108,0) + set DV(DL)=DV +"RTN","TMGDIS2",109,0) + set DL(DL)=DK +"RTN","TMGDIS2",110,0) + set DL=DL+1 +"RTN","TMGDIS2",111,0) + set DV=DV_-DY_C +"RTN","TMGDIS2",112,0) + set DY(DY)=DP_U_$select(Y["m":DC_"."_DL,1:"")_U_X +"RTN","TMGDIS2",113,0) + set R=U_$P(DP,U,2) +"RTN","TMGDIS2",114,0) + kill X +"RTN","TMGDIS2",115,0) + goto R^TMGDIS +"RTN","TMGDIS2",116,0) + +"RTN","TMGDIS2",117,0) + ;"========================================== +"RTN","TMGDIS2",118,0) +Q ; +"RTN","TMGDIS2",119,0) + kill DIC,DA,DX,O,D,DC,DI,DK,DL,DQ,DU,DV,E,DE +"RTN","TMGDIS2",120,0) + kill DJ,N,P,Z,R,DY,DTOUT,DIRUT,DUOUT,DIROUT +"RTN","TMGDIS2",121,0) + kill ^UTILITY($J) +"RTN","TMGDIS2",122,0) + quit +"RTN","TMGDIS2",123,0) + +"RTN","TMGDIS2",124,0) + ;"========================================== +"RTN","TMGDIS2",125,0) +DIS ;"PUT SET LOGIC INTO DIS FOR SUBFILE +"RTN","TMGDIS2",126,0) + set %X="" +"RTN","TMGDIS2",127,0) + for %Y=1:1 do Q:'%X +"RTN","TMGDIS2",128,0) + . set %X=$O(DIS(%X)) +"RTN","TMGDIS2",129,0) + . quit:'%X +"RTN","TMGDIS2",130,0) + . set %=$select($D(DIAR(DIARF,%X)):DIAR(DIARF,%X),1:DIS(%X)) +"RTN","TMGDIS2",131,0) + . set:%["X DIS(" %=$P(%,"X DIS(")_"X DIFG("_DIARF_","_$P(%,"X DIS(",2) +"RTN","TMGDIS2",132,0) + . set ^DIAR(1.11,DIARC,"S",%Y,0)=%X +"RTN","TMGDIS2",133,0) + . set ^(1)=% +"RTN","TMGDIS2",134,0) + if %Y>1 do +"RTN","TMGDIS2",135,0) + . set %Y=%Y-1 +"RTN","TMGDIS2",136,0) + . set ^DIAR(1.11,DIARC,"S",0)="^1.1132^"_%Y_U_%Y +"RTN","TMGDIS2",137,0) + goto ^TMGDIS2 +"RTN","TMGDIS3") +0^14^B3848644 +"RTN","TMGDIS3",1,0) +TMGDIS3 ;TMG/kst/Custom version of DIS3 ;03/25/06 +"RTN","TMGDIS3",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDIS3",3,0) + +"RTN","TMGDIS3",4,0) + +"RTN","TMGDIS3",5,0) +DIS3 ;SFISC/SEARCH - PROGRAMMER ENTRY POINT ;12/16/93 13:16 +"RTN","TMGDIS3",6,0) + ;;22.0;VA FileMan;;Mar 30, 1999 +"RTN","TMGDIS3",7,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGDIS3",8,0) + +"RTN","TMGDIS3",9,0) +EN ; +"RTN","TMGDIS3",10,0) + new DIQUIET,DIFM +"RTN","TMGDIS3",11,0) + set L=$G(L) +"RTN","TMGDIS3",12,0) + set DIFM=+L +"RTN","TMGDIS3",13,0) + do CLEAN^DIEFU,INIT^DIP +"RTN","TMGDIS3",14,0) + set:$G(DIC) DIC=$G(^DIC(DIC,0,"GL")) +"RTN","TMGDIS3",15,0) + goto QER1:$G(DIC)="" +"RTN","TMGDIS3",16,0) + new DK +"RTN","TMGDIS3",17,0) + set DK=+$P($G(@(DIC_"0)")),U,2) +"RTN","TMGDIS3",18,0) + goto QER1:'DK +"RTN","TMGDIS3",19,0) + new DISV,Y +"RTN","TMGDIS3",20,0) + do +"RTN","TMGDIS3",21,0) + . new DIC,X,DIS +"RTN","TMGDIS3",22,0) + . set Y=-1,DIS=$G(DISTEMP) +"RTN","TMGDIS3",23,0) + . quit:DIS="" +"RTN","TMGDIS3",24,0) + . set X=$S($E(DIS)="[":$P($E(DIS,2,99),"]"),1:DIS) +"RTN","TMGDIS3",25,0) + . set DIC="^DIBT(" +"RTN","TMGDIS3",26,0) + . set DIC(0)="Q" +"RTN","TMGDIS3",27,0) + . set DIC("S")="I '$P(^(0),U,8),$P(^(0),U,4)=DK,$P(^(0),U,5)=DUZ!'$P(^(0),U,5),$D(^(""DIS""))" +"RTN","TMGDIS3",28,0) + . do ^DIC +"RTN","TMGDIS3",29,0) + . Q +"RTN","TMGDIS3",30,0) + set DISV=+Y +"RTN","TMGDIS3",31,0) + if Y<0 set DIC="DISTEMP" goto QER +"RTN","TMGDIS3",32,0) + new DISTXT +"RTN","TMGDIS3",33,0) + set %X="^DIBT(DISV,""DIS"",",%Y="DIS(" +"RTN","TMGDIS3",34,0) + do %XY^%RCR +"RTN","TMGDIS3",35,0) + set %X="^DIBT(DISV,""O"",",%Y="DISTXT(" +"RTN","TMGDIS3",36,0) + do %XY^%RCR +"RTN","TMGDIS3",37,0) + kill ^DIBT(DISV,1) +"RTN","TMGDIS3",38,0) + do EN1^DIP +"RTN","TMGDIS3",39,0) + goto EXIT +"RTN","TMGDIS3",40,0) + +"RTN","TMGDIS3",41,0) + ;"========================================== +"RTN","TMGDIS3",42,0) +QER1 set DIC="DIC" +"RTN","TMGDIS3",43,0) +QER do BLD^DIALOG(201,DIC) +"RTN","TMGDIS3",44,0) + do:'$G(DIQUIET) MSG^DIALOG() +"RTN","TMGDIS3",45,0) + do Q^DIP +"RTN","TMGDIS3",46,0) +EXIT kill DIC,DISTEMP +"RTN","TMGDIS3",47,0) + Q +"RTN","TMGDIS3",48,0) + ;"DIALOG #201 'The input variable...is missing or invalid.' +"RTN","TMGDRUG") +0^15^B5590 +"RTN","TMGDRUG",1,0) +TMGDRUG ;TMG/kst/Code for setting up Drugs/Pharmacy ;03/25/06 +"RTN","TMGDRUG",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGDRUG",3,0) + +"RTN","TMGDRUG",4,0) + ;"TMG FUNCTIONS FOR SETTING UP DRUGS/PHARMACY +"RTN","TMGDRUG",5,0) + +"RTN","TMGDRUG",6,0) + ;"======================================================================= +"RTN","TMGDRUG",7,0) + ;" API -- Public Functions. +"RTN","TMGDRUG",8,0) + ;"======================================================================= +"RTN","TMGDRUG",9,0) + ;"SetupDF -- Set up the Drug File +"RTN","TMGDRUG",10,0) + ;"MakeExList +"RTN","TMGDRUG",11,0) + +"RTN","TMGDRUG",12,0) + ;"======================================================================= +"RTN","TMGDRUG",13,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGDRUG",14,0) + ;"======================================================================= +"RTN","TMGDRUG",15,0) + ;"MakeSubExClass(ParentClass) +"RTN","TMGDRUG",16,0) + ;"CodeInCode(TextCode,RefCode) +"RTN","TMGDRUG",17,0) + ;"ClassInClass(ClassIEN,TextCode,RefClassIEN) Purpose: To return if a class is either equal to, or a child of a Ref Class +"RTN","TMGDRUG",18,0) + ;"DrugInClass(DrugIEN,TextCode,ClassIEN Purpose: To see if a drug is in a given class +"RTN","TMGDRUG",19,0) + ;"ShowClHeirarchy(ClassIEN) +"RTN","TMGDRUG",20,0) + ;"GetClHeirarchy(ClassIEN,Array) +"RTN","TMGDRUG",21,0) + ;"ShowClass(DrugIEN) +"RTN","TMGDRUG",22,0) + ;"ShowRxInClass(ClassIEN) Purpose: to show all drugs in given class +"RTN","TMGDRUG",23,0) + ;"IsClassNull(DrugIEN) +"RTN","TMGDRUG",24,0) + ;"IsClassExcluded(ClassIEN) Purpose: To see is class is in an excluded class +"RTN","TMGDRUG",25,0) + ;"TestExclusions +"RTN","TMGDRUG",26,0) + ;"IsRxExcluded(DrugIEN) Purpose: To see if drug is in excluded catagory +"RTN","TMGDRUG",27,0) + ;"ShowDrugs +"RTN","TMGDRUG",28,0) + ;"ShowNCDrugs +"RTN","TMGDRUG",29,0) + ;"ShowExDrugs +"RTN","TMGDRUG",30,0) + ;"SURxArray Purpose: To set up the drug file such that the drugs are orderable in CPRS +"RTN","TMGDRUG",31,0) + ;"MakePO(ShortName) ;Make a Pharmacy Orderable Item +"RTN","TMGDRUG",32,0) + +"RTN","TMGDRUG",33,0) + ;"======================================================================= +"RTN","TMGDRUG",34,0) + ;"======================================================================= +"RTN","TMGDRUG",35,0) + +"RTN","TMGDRUG",36,0) +MakeExList +"RTN","TMGDRUG",37,0) + ;"Purpose: To create an array of drug classes that are not desired +"RTN","TMGDRUG",38,0) + ;"Output: Stores result in ^TMP("TMGPSExclude",*) +"RTN","TMGDRUG",39,0) + +"RTN","TMGDRUG",40,0) + new ClassIEN,LastClass +"RTN","TMGDRUG",41,0) + new Backup set Backup=0 +"RTN","TMGDRUG",42,0) + new result set result=1 +"RTN","TMGDRUG",43,0) + set LastClass="" +"RTN","TMGDRUG",44,0) + kill ^TMP("TMGPSExclude") +"RTN","TMGDRUG",45,0) + new TempI set TempI=0 +"RTN","TMGDRUG",46,0) + set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE +"RTN","TMGDRUG",47,0) + for do quit:(ClassIEN="") +"RTN","TMGDRUG",48,0) + . if ClassIEN="" quit +"RTN","TMGDRUG",49,0) + . new Node set Node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",50,0) + . new Code set Code=$piece(Node,"^",1) +"RTN","TMGDRUG",51,0) + . new Parent set Parent=+$piece(Node,"^",3) +"RTN","TMGDRUG",52,0) + . if Parent=0 do quit:(ClassIEN="") +"RTN","TMGDRUG",53,0) + . . set result=$$MakeSubExClass(ClassIEN) +"RTN","TMGDRUG",54,0) + . . if result=0 set ClassIEN="" +"RTN","TMGDRUG",55,0) + . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN)) +"RTN","TMGDRUG",56,0) + . else set Backup=0 +"RTN","TMGDRUG",57,0) + +"RTN","TMGDRUG",58,0) + write "Here are the excluded IEN's from file 50.605",! +"RTN","TMGDRUG",59,0) + zwr ^TMP("TMGPSExclude",*) +"RTN","TMGDRUG",60,0) + +"RTN","TMGDRUG",61,0) + write "Goodbye!",! +"RTN","TMGDRUG",62,0) + quit +"RTN","TMGDRUG",63,0) + +"RTN","TMGDRUG",64,0) + +"RTN","TMGDRUG",65,0) + +"RTN","TMGDRUG",66,0) +MakeSubExClass(ParentClass,ChildDetail) +"RTN","TMGDRUG",67,0) + ;"Purpose: To review the elements on one class, to see if they need to be excluded +"RTN","TMGDRUG",68,0) + ;"Input: ParentClass -- The parent class of the class to be reviewed. +"RTN","TMGDRUG",69,0) + ;" ChildDetail -- OPTIONAL, default=0 +"RTN","TMGDRUG",70,0) + ;" If 1, then show children of Parent Class +"RTN","TMGDRUG",71,0) + ;" if 0, just show ParentClass (<--Default Value) +"RTN","TMGDRUG",72,0) + ;"Output: Stores result in ^TMP("TMGPSExclude",*) +"RTN","TMGDRUG",73,0) + ;"Result: 1 if OK to continue, 0 if aborted. +"RTN","TMGDRUG",74,0) + +"RTN","TMGDRUG",75,0) + new ClassIEN,LastClass +"RTN","TMGDRUG",76,0) + new Backup set Backup=0 +"RTN","TMGDRUG",77,0) + set LastClass="" +"RTN","TMGDRUG",78,0) + new result set result=1 +"RTN","TMGDRUG",79,0) + set ChildDetail=$get(ChildDetail,0) +"RTN","TMGDRUG",80,0) + if '$data(ParentClass) set result=0 goto MSECDone +"RTN","TMGDRUG",81,0) + if $$IsClassExcluded(ParentClass) goto MSECDone +"RTN","TMGDRUG",82,0) + +"RTN","TMGDRUG",83,0) + set ClassIEN=ParentClass ;"In file order, children come after parent. +"RTN","TMGDRUG",84,0) + for do quit:(+ClassIEN=0) ;"Cycle, looking for children. +"RTN","TMGDRUG",85,0) + . if +ClassIEN=0 quit +"RTN","TMGDRUG",86,0) + . new AskThisOne set AskThisOne=0 ;"default=no show +"RTN","TMGDRUG",87,0) + . new Node set Node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",88,0) + . new Code set Code=$piece(Node,"^",1) +"RTN","TMGDRUG",89,0) + . new Class set Class=$piece(Node,"^",2) +"RTN","TMGDRUG",90,0) + . new Parent set Parent=+$piece(Node,"^",3) +"RTN","TMGDRUG",91,0) + . new Type set Type=$piece(Node,"^",4) +"RTN","TMGDRUG",92,0) + . if ChildDetail=0 do ;" just show parent +"RTN","TMGDRUG",93,0) + . . if ClassIEN=ParentClass set AskThisOne=1 +"RTN","TMGDRUG",94,0) + . else do +"RTN","TMGDRUG",95,0) + . . set AskThisOne=1 +"RTN","TMGDRUG",96,0) + . . if ClassIEN=ParentClass set AskThisOne=0 ;"(don't show parent) +"RTN","TMGDRUG",97,0) + . . if ($$ClassInClass(ClassIEN,,ParentClass)=0) do +"RTN","TMGDRUG",98,0) + . . . set AskThisOne=0 ;"(don't show if not in parent's class) +"RTN","TMGDRUG",99,0) + . . . set ClassIEN="" ;"as so as we get to an entry in the list that is not in parent, then we can escape +"RTN","TMGDRUG",100,0) + . if AskThisOne do +"RTN","TMGDRUG",101,0) + . . write "---------------------------------------------------",! +"RTN","TMGDRUG",102,0) + . . write Class," (",Code,")",! +"RTN","TMGDRUG",103,0) + . . write "---------------------------------------------------",! +"RTN","TMGDRUG",104,0) + . . new ref set ref="^PS(50.605,"_i_",1)" +"RTN","TMGDRUG",105,0) + . . do WriteWP^TMGSTUTL(ref) +"RTN","TMGDRUG",106,0) + . . new Exclude set Exclude="" +"RTN","TMGDRUG",107,0) + . . for do quit:(Exclude="") +"RTN","TMGDRUG",108,0) + . . . write Class," (",Code,")",! +"RTN","TMGDRUG",109,0) + . . . read "Exclude this drug class (and any derivative subclasses)? (? for help) NO//",Exclude:$get(DTIME,3600),! +"RTN","TMGDRUG",110,0) + . . . if Exclude="" set Exclude="NO" +"RTN","TMGDRUG",111,0) + . . . if Exclude["?" do quit +"RTN","TMGDRUG",112,0) + . . . . Write "^ to abort",! +"RTN","TMGDRUG",113,0) + . . . . write "^SUB to explore subclasses",! +"RTN","TMGDRUG",114,0) + . . . . Write "^BACKUP to backup to previous category.",! +"RTN","TMGDRUG",115,0) + . . . . write !,"Here is a list:",!! +"RTN","TMGDRUG",116,0) + . . . . do ShowRxInClass(ClassIEN) +"RTN","TMGDRUG",117,0) + . . . . write "End of list for: " +"RTN","TMGDRUG",118,0) + . . . if Exclude="^SUB" do quit +"RTN","TMGDRUG",119,0) + . . . . set result=$$MakeSubExClass(ClassIEN,1) +"RTN","TMGDRUG",120,0) + . . . if Exclude="^BACKUP" do quit +"RTN","TMGDRUG",121,0) + . . . . if LastClass'="" set ClassIEN=LastClass,Backup=1,Exclude="" +"RTN","TMGDRUG",122,0) + . . . if Exclude="^" set ClassIEN="",Exclude="",result=0 quit +"RTN","TMGDRUG",123,0) + . . . if '("YyYESYes"[Exclude) write ! set Exclude="" quit +"RTN","TMGDRUG",124,0) + . . . set Exclude="" +"RTN","TMGDRUG",125,0) + . . . write "OK... excluding.",!! +"RTN","TMGDRUG",126,0) + . . . new TempI set TempI=$get(^TMP("TMGPSExclude",0,"Max"),0) +"RTN","TMGDRUG",127,0) + . . . set TempI=TempI+1 +"RTN","TMGDRUG",128,0) + . . . set ^TMP("TMGPSExclude",TempI)=ClassIEN +"RTN","TMGDRUG",129,0) + . . . set ^TMP("TMGPSExclude",TempI,"CLASS")=Class +"RTN","TMGDRUG",130,0) + . . . set ^TMP("TMGPSExclude",TempI,"CLASS","CODE")=Code +"RTN","TMGDRUG",131,0) + . . . set ^TMP("TMGPSExclude",0,ClassIEN)="" +"RTN","TMGDRUG",132,0) + . . . set ^TMP("TMGPSExclude",0,"Max")=TempI +"RTN","TMGDRUG",133,0) + . . set LastClass=ClassIEN +"RTN","TMGDRUG",134,0) + . if ClassIEN="" quit +"RTN","TMGDRUG",135,0) + . if Backup=0 set ClassIEN=$order(^PS(50.605,ClassIEN)) +"RTN","TMGDRUG",136,0) + . else set Backup=0 +"RTN","TMGDRUG",137,0) + . if ChildDetail=0 set ClassIEN="" +"RTN","TMGDRUG",138,0) +MSECDone +"RTN","TMGDRUG",139,0) + quit result +"RTN","TMGDRUG",140,0) + +"RTN","TMGDRUG",141,0) + +"RTN","TMGDRUG",142,0) +CodeInCode(TextCode,RefCode) +"RTN","TMGDRUG",143,0) + ;"Purpose: To see if Text Code is in reference code +"RTN","TMGDRUG",144,0) + ;" e.g. is AX050 "in" AX00 --> yes +"RTN","TMGDRUG",145,0) + ;"Result: 1 = match present, 0 = no match +"RTN","TMGDRUG",146,0) + +"RTN","TMGDRUG",147,0) + set RefCode=$$Trim^TMGSTUTL(RefCode,"0") ;"convert AX000 -> AX +"RTN","TMGDRUG",148,0) + new CompCode set CompCode=$extract(TextCode,1,$length(RefCode)) +"RTN","TMGDRUG",149,0) + quit (CompCode=RefCode) +"RTN","TMGDRUG",150,0) + +"RTN","TMGDRUG",151,0) + +"RTN","TMGDRUG",152,0) +ClassInClass(ClassIEN,TextCode,RefClassIEN) +"RTN","TMGDRUG",153,0) + ;"Purpose: To return if a class is either equal to, or a child of a Ref Class +"RTN","TMGDRUG",154,0) + ;"Input: ClassIEN: an IEN from file 50.605 to test +"RTN","TMGDRUG",155,0) + ;" TextCode: OPTIONAL Text code for drug class, from field #2 in DRUG file #50 +"RTN","TMGDRUG",156,0) + ;" Note: this is the text code for RefClassIEN, not for ClassIEN +"RTN","TMGDRUG",157,0) + ;" RefClassIEN: an IEN from file 50.605 to test against +"RTN","TMGDRUG",158,0) + ;"Results: 1 if ClassIEN=RefClassIEN, or is child of RefClassIEN +"RTN","TMGDRUG",159,0) + ;" 0 otherwise +"RTN","TMGDRUG",160,0) + +"RTN","TMGDRUG",161,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ClassInClass") +"RTN","TMGDRUG",162,0) + +"RTN","TMGDRUG",163,0) + new result set result=0 +"RTN","TMGDRUG",164,0) + set TextCode=$get(TextCode) +"RTN","TMGDRUG",165,0) + if +$get(RefClassIEN)=0 goto CICDone +"RTN","TMGDRUG",166,0) + if +$get(ClassIEN)=0 goto CICDone +"RTN","TMGDRUG",167,0) + new node set node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",168,0) + new RefCode set RefCode=$piece(node,"^",1) +"RTN","TMGDRUG",169,0) + +"RTN","TMGDRUG",170,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Class #",ClassIEN," in Class #",RefClassIEN,"?") +"RTN","TMGDRUG",171,0) + +"RTN","TMGDRUG",172,0) + if ClassIEN=RefClassIEN set result=1 goto CICDone +"RTN","TMGDRUG",173,0) + if (TextCode'="")&($$CodeInCode(TextCode,RefCode)) set result=1 goto CICDone +"RTN","TMGDRUG",174,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"looking at node: ",node) +"RTN","TMGDRUG",175,0) + if node'="" do +"RTN","TMGDRUG",176,0) + . new code set code=$piece(node,"^",1) +"RTN","TMGDRUG",177,0) + . new ParentClass set ParentClass=$piece(node,"^",3) +"RTN","TMGDRUG",178,0) + . if ParentClass=ClassIEN set ParentClass=0 ;"I found one cyclic reference->endless loop. Avoid that. +"RTN","TMGDRUG",179,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"parent class=",ParentClass) +"RTN","TMGDRUG",180,0) + . if +ParentClass'=0 do +"RTN","TMGDRUG",181,0) + . . if ParentClass=RefClassIEN set result=1 +"RTN","TMGDRUG",182,0) + . . else do +"RTN","TMGDRUG",183,0) + . . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"calling recursively ClassInClass(",ParentClass,",",RefClassIEN,")") +"RTN","TMGDRUG",184,0) + . . . set result=$$ClassInClass(ParentClass,TextCode,RefClassIEN) +"RTN","TMGDRUG",185,0) + +"RTN","TMGDRUG",186,0) +CICDone +"RTN","TMGDRUG",187,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGDRUG",188,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ClassInClass") +"RTN","TMGDRUG",189,0) + quit result +"RTN","TMGDRUG",190,0) + +"RTN","TMGDRUG",191,0) + +"RTN","TMGDRUG",192,0) +DrugInClass(DrugIEN,TextCode,ClassIEN) +"RTN","TMGDRUG",193,0) + ;"Purpose: To see if a drug is in a given class +"RTN","TMGDRUG",194,0) + ;"Input: DrugIEN: The IEN of a drug in file#50 +"RTN","TMGDRUG",195,0) + ;" TextCode: Text code for drug class, from field #2 in DRUG file #50 +"RTN","TMGDRUG",196,0) + ;" ClassIEN: the IEN of a drug class in file #50.605 +"RTN","TMGDRUG",197,0) + ;"Note: If drug is in a class that is a child of ClassIEN, then +"RTN","TMGDRUG",198,0) + ;" the drug will be considered to be that class. +"RTN","TMGDRUG",199,0) + ;"Result: 0 if not in class, 1 if is in class, or child of class. +"RTN","TMGDRUG",200,0) + +"RTN","TMGDRUG",201,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DrugInClass") +"RTN","TMGDRUG",202,0) + +"RTN","TMGDRUG",203,0) + new result set result=0 +"RTN","TMGDRUG",204,0) + if $get(DrugIEN)="" goto DICDone +"RTN","TMGDRUG",205,0) + if $get(^PSDRUG(DrugIEN,0))="" goto DICDone +"RTN","TMGDRUG",206,0) + +"RTN","TMGDRUG",207,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is Drug #",DrugIEN," in Class #",ClassIEN,"?") +"RTN","TMGDRUG",208,0) + +"RTN","TMGDRUG",209,0) + new node set node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",210,0) + new RefCode set RefCode=$piece(node,"^",1) +"RTN","TMGDRUG",211,0) + if $$CodeInCode(TextCode,RefCode) set result=1 goto DICDone +"RTN","TMGDRUG",212,0) + +"RTN","TMGDRUG",213,0) + new DrugClass +"RTN","TMGDRUG",214,0) + set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6) ;"field #25,NATIONAL DRUG CLASS +"RTN","TMGDRUG",215,0) + set result=$$ClassInClass(DrugClass,TextCode,ClassIEN) +"RTN","TMGDRUG",216,0) + +"RTN","TMGDRUG",217,0) +DICDone +"RTN","TMGDRUG",218,0) + ;"write "DrugInClass result=",result,! +"RTN","TMGDRUG",219,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGDRUG",220,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DrugInClass") +"RTN","TMGDRUG",221,0) + quit result +"RTN","TMGDRUG",222,0) + +"RTN","TMGDRUG",223,0) +ShowClHeirarchy(ClassIEN) +"RTN","TMGDRUG",224,0) + new ParentClass,indent +"RTN","TMGDRUG",225,0) + set indent="" +"RTN","TMGDRUG",226,0) + if (+ClassIEN'=0) for do quit:(+ClassIEN=0) +"RTN","TMGDRUG",227,0) + . new Curnode +"RTN","TMGDRUG",228,0) + . set Curnode=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",229,0) + . write indent,"Class ",ClassIEN," (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),! +"RTN","TMGDRUG",230,0) + . new node set node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",231,0) + . set ParentClass=$piece(node,"^",3) +"RTN","TMGDRUG",232,0) + . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. +"RTN","TMGDRUG",233,0) + . set ClassIEN=ParentClass +"RTN","TMGDRUG",234,0) + . set indent=indent_". " +"RTN","TMGDRUG",235,0) + +"RTN","TMGDRUG",236,0) + quit +"RTN","TMGDRUG",237,0) + +"RTN","TMGDRUG",238,0) + +"RTN","TMGDRUG",239,0) +ShowClass(DrugIEN) +"RTN","TMGDRUG",240,0) + ;"Purpose: To show a given drug's class, and parent classes +"RTN","TMGDRUG",241,0) + new DrugClass +"RTN","TMGDRUG",242,0) + set DrugClass=$piece($get(^PSDRUG(DrugIEN,"ND")),"^",6) +"RTN","TMGDRUG",243,0) + new ParentClass set ParentClass=0 +"RTN","TMGDRUG",244,0) + new TextCode,node,Name +"RTN","TMGDRUG",245,0) + set node=$get(^PSDRUG(DrugIEN,0)) +"RTN","TMGDRUG",246,0) + set TextCode=$piece(node,"^",2) +"RTN","TMGDRUG",247,0) + set Name=$piece(node,"^",1) +"RTN","TMGDRUG",248,0) + +"RTN","TMGDRUG",249,0) + write "Drug: ",Name," [",TextCode,"]",! +"RTN","TMGDRUG",250,0) + +"RTN","TMGDRUG",251,0) + if (+DrugClass'=0) for do quit:(+DrugClass=0) +"RTN","TMGDRUG",252,0) + . new Curnode +"RTN","TMGDRUG",253,0) + . set Curnode=$get(^PS(50.605,DrugClass,0)) +"RTN","TMGDRUG",254,0) + . write "Class (",$piece(Curnode,"^",1),") ",$piece(Curnode,"^",2),! +"RTN","TMGDRUG",255,0) + . new node set node=$get(^PS(50.605,DrugClass,0)) +"RTN","TMGDRUG",256,0) + . set ParentClass=$piece(node,"^",3) +"RTN","TMGDRUG",257,0) + . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. +"RTN","TMGDRUG",258,0) + . set DrugClass=ParentClass +"RTN","TMGDRUG",259,0) + else do +"RTN","TMGDRUG",260,0) + . write "Drug class pointer is null",! +"RTN","TMGDRUG",261,0) + . write "Free text drug class is",$piece($get(^PSDRUG(DrugIEN,0)),"^",2),! +"RTN","TMGDRUG",262,0) + +"RTN","TMGDRUG",263,0) + quit +"RTN","TMGDRUG",264,0) + +"RTN","TMGDRUG",265,0) + +"RTN","TMGDRUG",266,0) +ShowRxInClass(ClassIEN) +"RTN","TMGDRUG",267,0) + ;"Purpose: to show all drugs in given class +"RTN","TMGDRUG",268,0) + +"RTN","TMGDRUG",269,0) + new i,name +"RTN","TMGDRUG",270,0) + +"RTN","TMGDRUG",271,0) + set i=$order(^PSDRUG(0)) +"RTN","TMGDRUG",272,0) + for do quit:(i="") +"RTN","TMGDRUG",273,0) + . if i="" quit +"RTN","TMGDRUG",274,0) + . set Name=$piece($get(^PSDRUG(i,0)),"^",1) +"RTN","TMGDRUG",275,0) + . if Name'="" do +"RTN","TMGDRUG",276,0) + . . new TextCode +"RTN","TMGDRUG",277,0) + . . set TextCode=$piece($get(^PSDRUG(i,0)),"^",2) ;"field #2,VA CLASSIFICATION +"RTN","TMGDRUG",278,0) + . . if $$DrugInClass(i,TextCode,ClassIEN)=1 write " -- ",Name,! +"RTN","TMGDRUG",279,0) + . set i=$order(^PSDRUG(i)) +"RTN","TMGDRUG",280,0) + +"RTN","TMGDRUG",281,0) +SRICDone +"RTN","TMGDRUG",282,0) + write ! +"RTN","TMGDRUG",283,0) + quit +"RTN","TMGDRUG",284,0) + +"RTN","TMGDRUG",285,0) + +"RTN","TMGDRUG",286,0) +IsClassNull(DrugIEN) +"RTN","TMGDRUG",287,0) + ;"Purpose: to return if Drug has no assigned class +"RTN","TMGDRUG",288,0) + +"RTN","TMGDRUG",289,0) + new result,node,class +"RTN","TMGDRUG",290,0) + set node=$get(^PSDRUG(DrugIEN,"ND")) +"RTN","TMGDRUG",291,0) + set class=+$piece(node,"^",6) +"RTN","TMGDRUG",292,0) + set result=(class=0) +"RTN","TMGDRUG",293,0) + quit result +"RTN","TMGDRUG",294,0) + +"RTN","TMGDRUG",295,0) + +"RTN","TMGDRUG",296,0) +IsClassExcluded(ClassIEN) +"RTN","TMGDRUG",297,0) + ;"Purpose: To see is class is in an excluded class, based on exclusions stored +"RTN","TMGDRUG",298,0) + ;" in ^TMP("TMGPSExclude") +"RTN","TMGDRUG",299,0) + ;"Input: ClassIEN -- Class to check if excluded. +"RTN","TMGDRUG",300,0) + ;"Result: 1 if class is in an already excluded class. +"RTN","TMGDRUG",301,0) + +"RTN","TMGDRUG",302,0) + new i,result +"RTN","TMGDRUG",303,0) + set result=0 +"RTN","TMGDRUG",304,0) + +"RTN","TMGDRUG",305,0) + set i=$order(^TMP("TMGPSExclude",0)) +"RTN","TMGDRUG",306,0) + if i'="" for do quit:(i="")!(result=1) +"RTN","TMGDRUG",307,0) + . new ExClass +"RTN","TMGDRUG",308,0) + . set ExClass=$get(^TMP("TMGPSExclude",i)) +"RTN","TMGDRUG",309,0) + . set result=$$ClassInClass(ClassIEN,,ExClass) +"RTN","TMGDRUG",310,0) + . set i=$order(^TMP("TMGPSExclude",i)) +"RTN","TMGDRUG",311,0) + +"RTN","TMGDRUG",312,0) + quit result +"RTN","TMGDRUG",313,0) + +"RTN","TMGDRUG",314,0) +TestExclusions +"RTN","TMGDRUG",315,0) + new ClassIEN +"RTN","TMGDRUG",316,0) + +"RTN","TMGDRUG",317,0) + set ClassIEN=$order(^PS(50.605,0)) ;"file# 50.605 = VA DRUG CLASS CODE +"RTN","TMGDRUG",318,0) + for do quit:(+ClassIEN=0) +"RTN","TMGDRUG",319,0) + . new Node set Node=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGDRUG",320,0) + . new Code set Code=$piece(Node,"^",1) +"RTN","TMGDRUG",321,0) + . new Class set Class=$piece(Node,"^",2) +"RTN","TMGDRUG",322,0) + . new Parent set Parent=+$piece(Node,"^",3) +"RTN","TMGDRUG",323,0) + . new Type set Type=$piece(Node,"^",4) +"RTN","TMGDRUG",324,0) + . write ClassIEN," (",Code,"): " +"RTN","TMGDRUG",325,0) + . if $$IsClassExcluded(ClassIEN)=1 do +"RTN","TMGDRUG",326,0) + . . write "Excluded:",! +"RTN","TMGDRUG",327,0) + . . ;"do ShowClHeirarchy(ClassIEN) +"RTN","TMGDRUG",328,0) + . else write "OK",! +"RTN","TMGDRUG",329,0) + . set ClassIEN=$order(^PS(50.605,ClassIEN)) +"RTN","TMGDRUG",330,0) + +"RTN","TMGDRUG",331,0) + quit +"RTN","TMGDRUG",332,0) + +"RTN","TMGDRUG",333,0) +IsRxExcluded(DrugIEN) +"RTN","TMGDRUG",334,0) + ;"Purpose: To see if drug is in excluded catagory +"RTN","TMGDRUG",335,0) + ;"Input: DrugIEN -- an IEN from file #50 +"RTN","TMGDRUG",336,0) + ;"Note: This assumes that an exclusion array has been created in +"RTN","TMGDRUG",337,0) + ;" ^TMP("TMGPSExclude"), as setup by MakeExList() +"RTN","TMGDRUG",338,0) + ;"Result: 1 if drug is not wanted (i.e. is excluded) +"RTN","TMGDRUG",339,0) + ;" 0 otherwise +"RTN","TMGDRUG",340,0) + +"RTN","TMGDRUG",341,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"IsRxExcluded") +"RTN","TMGDRUG",342,0) + +"RTN","TMGDRUG",343,0) + new result set result=0 +"RTN","TMGDRUG",344,0) + new i +"RTN","TMGDRUG",345,0) + new TextCode +"RTN","TMGDRUG",346,0) + +"RTN","TMGDRUG",347,0) + set TextCode=$piece($get(^PSDRUG(DrugIEN,0)),"^",2) ;"field #2,VA CLASSIFICATION (text field) +"RTN","TMGDRUG",348,0) + +"RTN","TMGDRUG",349,0) + if $$IsClassNull(DrugIEN)&(TextCode="") do goto IREDone +"RTN","TMGDRUG",350,0) + . set result=1 +"RTN","TMGDRUG",351,0) + . write "Excluding drug #`",DrugIEN," due to null class, and empty class code.",! +"RTN","TMGDRUG",352,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug is excluded because of no assigned class") +"RTN","TMGDRUG",353,0) + +"RTN","TMGDRUG",354,0) + if +$get(DrugIEN)=0 goto IREDone +"RTN","TMGDRUG",355,0) + set i=$order(^TMP("TMGPSExclude",0)) +"RTN","TMGDRUG",356,0) + for do quit:(i="")!(result=1) +"RTN","TMGDRUG",357,0) + . if i="" quit +"RTN","TMGDRUG",358,0) + . new ExClass +"RTN","TMGDRUG",359,0) + . set ExClass=$get(^TMP("TMGPSExclude",i)) +"RTN","TMGDRUG",360,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Is drug #",DrugIEN," is class named '",^TMP("TMGPSExclude",i,"CLASS"),"'?") +"RTN","TMGDRUG",361,0) + . set result=$$DrugInClass(DrugIEN,TextCode,ExClass) +"RTN","TMGDRUG",362,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"The value of result returned from DrugInClass=",result) +"RTN","TMGDRUG",363,0) + . set i=$order(^TMP("TMGPSExclude",i)) +"RTN","TMGDRUG",364,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"next exclusion class i=",i," result=",result) +"RTN","TMGDRUG",365,0) + +"RTN","TMGDRUG",366,0) +IREDone +"RTN","TMGDRUG",367,0) + ;"write "IsRxExcluded result=",result,! +"RTN","TMGDRUG",368,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGDRUG",369,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"IsRxExcluded") +"RTN","TMGDRUG",370,0) + +"RTN","TMGDRUG",371,0) + quit result +"RTN","TMGDRUG",372,0) + +"RTN","TMGDRUG",373,0) + +"RTN","TMGDRUG",374,0) +ShowDrugs +"RTN","TMGDRUG",375,0) + new i +"RTN","TMGDRUG",376,0) + +"RTN","TMGDRUG",377,0) + set i=$order(^PSDRUG(0)) +"RTN","TMGDRUG",378,0) + for do quit:(i="") +"RTN","TMGDRUG",379,0) + . if i="" quit +"RTN","TMGDRUG",380,0) + . new Name +"RTN","TMGDRUG",381,0) + . set Name=$piece($get(^PSDRUG(i,0)),"^",1) +"RTN","TMGDRUG",382,0) + . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) +"RTN","TMGDRUG",383,0) + . if Name'="" do +"RTN","TMGDRUG",384,0) + . . write $piece(Name," ",1)," -- ",Class,! +"RTN","TMGDRUG",385,0) + . set i=$order(^PSDRUG(i)) +"RTN","TMGDRUG",386,0) + +"RTN","TMGDRUG",387,0) + quit +"RTN","TMGDRUG",388,0) + +"RTN","TMGDRUG",389,0) +ShowNCDrugs +"RTN","TMGDRUG",390,0) + ;"Show all drugs that do not have an assigned class. +"RTN","TMGDRUG",391,0) + +"RTN","TMGDRUG",392,0) + new i,count +"RTN","TMGDRUG",393,0) + set count=0 +"RTN","TMGDRUG",394,0) + +"RTN","TMGDRUG",395,0) + set i=$order(^PSDRUG(0)) +"RTN","TMGDRUG",396,0) + for do quit:(i="") +"RTN","TMGDRUG",397,0) + . if i="" quit +"RTN","TMGDRUG",398,0) + . new Name,node +"RTN","TMGDRUG",399,0) + . set node=$get(^PSDRUG(i,0)) +"RTN","TMGDRUG",400,0) + . set Name=$piece(node,"^",1) +"RTN","TMGDRUG",401,0) + . new TextCode set TextCode=$piece(node,"^",2) +"RTN","TMGDRUG",402,0) + . new Class set Class=$piece($get(^PSDRUG(i,"ND")),"^",6) +"RTN","TMGDRUG",403,0) + . if (Name'="")&(TextCode="")&(+Class=0) do +"RTN","TMGDRUG",404,0) + . . write "`#",i," ",Name," -- TextCode='",TextCode,"' ClassIEN=",Class,! +"RTN","TMGDRUG",405,0) + . . set count=count+1 +"RTN","TMGDRUG",406,0) + . set i=$order(^PSDRUG(i)) +"RTN","TMGDRUG",407,0) + +"RTN","TMGDRUG",408,0) + write count," drugs with no class assigned.",! +"RTN","TMGDRUG",409,0) + write "Goodbye.",! +"RTN","TMGDRUG",410,0) + quit +"RTN","TMGDRUG",411,0) + +"RTN","TMGDRUG",412,0) + +"RTN","TMGDRUG",413,0) + +"RTN","TMGDRUG",414,0) +ShowExDrugs +"RTN","TMGDRUG",415,0) + ;"Purpose: Show those members of file 50 that should be excluded +"RTN","TMGDRUG",416,0) + +"RTN","TMGDRUG",417,0) + new DBIndent +"RTN","TMGDRUG",418,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ShowExDrugs") +"RTN","TMGDRUG",419,0) + +"RTN","TMGDRUG",420,0) + new i +"RTN","TMGDRUG",421,0) + +"RTN","TMGDRUG",422,0) + write "This will show all entries in File#50 that should be excluded based",! +"RTN","TMGDRUG",423,0) + write "on exclusion list in ^TMP(""TMGPSExclude"")",!! +"RTN","TMGDRUG",424,0) + +"RTN","TMGDRUG",425,0) + new Y,DIC,DIR +"RTN","TMGDRUG",426,0) + set DIR(0)="Y",DIR("B")="NO" +"RTN","TMGDRUG",427,0) + set DIR("A")="Store values into a Search Template (for later Fileman use)? " +"RTN","TMGDRUG",428,0) + do ^DIR +"RTN","TMGDRUG",429,0) + if Y=1 do +"RTN","TMGDRUG",430,0) + . set DIC=.401 ;"SORT TEMPLATE, ^DIBT +"RTN","TMGDRUG",431,0) + . set DIC(0)="MAQE" +"RTN","TMGDRUG",432,0) + . do ^DIC +"RTN","TMGDRUG",433,0) + . if +Y kill ^DIBT(+Y,1) +"RTN","TMGDRUG",434,0) + +"RTN","TMGDRUG",435,0) + set i=$order(^PSDRUG(0)) +"RTN","TMGDRUG",436,0) + for do quit:(i="") +"RTN","TMGDRUG",437,0) + . if i="" quit +"RTN","TMGDRUG",438,0) + . new Name +"RTN","TMGDRUG",439,0) + . set Name=$piece($get(^PSDRUG(i,0)),"^",1) +"RTN","TMGDRUG",440,0) + . new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) +"RTN","TMGDRUG",441,0) + . if (Name'="") do +"RTN","TMGDRUG",442,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name) +"RTN","TMGDRUG",443,0) + . . if ($$IsRxExcluded(i)=1) do +"RTN","TMGDRUG",444,0) + . . . write "`",i,": ",Name," -- ",Class,! +"RTN","TMGDRUG",445,0) + . . . if +Y do +"RTN","TMGDRUG",446,0) + . . . . set ^DIBT(+Y,1,i)="" ;"stuff valus into SORT TEMPLATE, IEN=805 (this is a hack) +"RTN","TMGDRUG",447,0) + . . else do +"RTN","TMGDRUG",448,0) + . . . ;write "Not #",i," ",Name,! +"RTN","TMGDRUG",449,0) + . set i=$order(^PSDRUG(i)) +"RTN","TMGDRUG",450,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i) +"RTN","TMGDRUG",451,0) + . ;new cont read "Press Key to Continue",*cont:3600,! +"RTN","TMGDRUG",452,0) + . ;if $char(cont)="^" set i="" +"RTN","TMGDRUG",453,0) + +"RTN","TMGDRUG",454,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ShowExDrugs") +"RTN","TMGDRUG",455,0) + +"RTN","TMGDRUG",456,0) + write !,"goodbye...",! +"RTN","TMGDRUG",457,0) + quit +"RTN","TMGDRUG",458,0) + +"RTN","TMGDRUG",459,0) + +"RTN","TMGDRUG",460,0) + +"RTN","TMGDRUG",461,0) +SURxArray ;"Set Up Rx array +"RTN","TMGDRUG",462,0) + ;"Purpose: To set up the drug file such that the drugs are orderable in CPRS +"RTN","TMGDRUG",463,0) + ;"Note: In the first part of this function, is will group similar drugs into an +"RTN","TMGDRUG",464,0) + ;" array like this: +"RTN","TMGDRUG",465,0) + ;" Array("SILDENAFIL",DrugIEN1)="(full drug name)" +"RTN","TMGDRUG",466,0) + ;" Array("SILDENAFIL",DrugIEN2)="(full drug name)" +"RTN","TMGDRUG",467,0) + ;" Array("SILDENAFIL",DrugIEN3)="(full drug name)" +"RTN","TMGDRUG",468,0) + ;" Array("AMOXICILLIN",DrugIEN1)="(full drug name)" +"RTN","TMGDRUG",469,0) + ;" Array("AMOXICILLIN",DrugIEN2)="(full drug name)" +"RTN","TMGDRUG",470,0) + ;" Array("AMOXICILLIN",DrugIEN3)="(full drug name)" +"RTN","TMGDRUG",471,0) + +"RTN","TMGDRUG",472,0) + new DBIndent +"RTN","TMGDRUG",473,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SURxArray") +"RTN","TMGDRUG",474,0) + +"RTN","TMGDRUG",475,0) + new i +"RTN","TMGDRUG",476,0) + new count set count=0 +"RTN","TMGDRUG",477,0) + new Class set Class="" +"RTN","TMGDRUG",478,0) + +"RTN","TMGDRUG",479,0) + if $data(^TMP("TMGPSExclude"))=0 do MakeExList +"RTN","TMGDRUG",480,0) + kill ^TMP("TMGPSUSE") +"RTN","TMGDRUG",481,0) + +"RTN","TMGDRUG",482,0) + set i=$order(^PSDRUG(0)) +"RTN","TMGDRUG",483,0) + for do quit:(i="") +"RTN","TMGDRUG",484,0) + . if i="" quit +"RTN","TMGDRUG",485,0) + . set count=count+1 +"RTN","TMGDRUG",486,0) + . new Name +"RTN","TMGDRUG",487,0) + . set Name=$piece($get(^PSDRUG(i,0)),"^",1) +"RTN","TMGDRUG",488,0) + . new temp set temp=$$UP^XLFSTR($extract(Name,1,2)) +"RTN","TMGDRUG",489,0) + . if temp="ZZ" set Name="" +"RTN","TMGDRUG",490,0) + . ;"new Class set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip +"RTN","TMGDRUG",491,0) + . set Class="zzz" +"RTN","TMGDRUG",492,0) + . if (Name'="")&(Class'="") do +"RTN","TMGDRUG",493,0) + . . set Class=$piece($get(^PSDRUG(i,0)),"^",2) ;"Some bad drugs have no class--> skip +"RTN","TMGDRUG",494,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Considering: ",Name) +"RTN","TMGDRUG",495,0) + . . if ($$IsRxExcluded(i)=0) do +"RTN","TMGDRUG",496,0) + . . . ;"quit ;"temp +"RTN","TMGDRUG",497,0) + . . . write Name," -- ",Class,! +"RTN","TMGDRUG",498,0) + . . . new NamePiece,pi +"RTN","TMGDRUG",499,0) + . . . for pi=1:1 do quit:(NamePiece="")!(+NamePiece>0) +"RTN","TMGDRUG",500,0) + . . . . set NamePiece=$piece(Name," ",pi) +"RTN","TMGDRUG",501,0) + . . . new ShortName set ShortName=$piece(Name," ",1,pi-1) +"RTN","TMGDRUG",502,0) + . . . if ShortName'="" do +"RTN","TMGDRUG",503,0) + . . . . write "Converted '",Name,"' --> ",ShortName,! +"RTN","TMGDRUG",504,0) + . . . . set ^TMP("TMGPSUSE",ShortName,i)=Name +"RTN","TMGDRUG",505,0) + . . . else write "Couldn't convert: ",Name,! +"RTN","TMGDRUG",506,0) + . . else write "Excluded: ",Name,! +"RTN","TMGDRUG",507,0) + . else if (Name'="") write "Skipped `",i," due to no class: ",Name," class=[",Class,"]",! +"RTN","TMGDRUG",508,0) + . set i=$order(^PSDRUG(i)) +"RTN","TMGDRUG",509,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Next i=",i) +"RTN","TMGDRUG",510,0) + +"RTN","TMGDRUG",511,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SURxArray") +"RTN","TMGDRUG",512,0) + +"RTN","TMGDRUG",513,0) + write "Processed ",count," records.",! +"RTN","TMGDRUG",514,0) + write "Done. Goodbye.",! +"RTN","TMGDRUG",515,0) + +"RTN","TMGDRUG",516,0) + quit +"RTN","TMGDRUG",517,0) + +"RTN","TMGDRUG",518,0) +MakePO(ShortName) ;Make a Pharmacy Orderable Item +"RTN","TMGDRUG",519,0) + ;"Purpose: To take one entry from the Rx Array (as set up by SURxArray) +"RTN","TMGDRUG",520,0) + ;" and create a fully linked PHARMACY ORDERABLE ITEM entry (File 50.7). +"RTN","TMGDRUG",521,0) + ;"Note: When the PHARMACY ORDERABLE ITEM record is created, records that match +"RTN","TMGDRUG",522,0) + ;" are also created in the ORDERABLE ITEM file (101.43), and the QUICK VIEW +"RTN","TMGDRUG",523,0) + ;" file (101.44)--although the display text in the QUICK VIEW file must be set. +"RTN","TMGDRUG",524,0) + ;"Steps: 1. +"RTN","TMGDRUG",525,0) + +"RTN","TMGDRUG",526,0) + +"RTN","TMGDRUG",527,0) + +"RTN","TMGEDIT") +0^17^B4891 +"RTN","TMGEDIT",1,0) +TMGEDIT ;TMG/kst/Interface to allow use of linux editor in Fileman ;03/25/06 +"RTN","TMGEDIT",2,0) + ;;1.0;TMG-LIB;**1**;01/01/06 +"RTN","TMGEDIT",3,0) + +"RTN","TMGEDIT",4,0) + ;"TMG EDITOR FUNCTIONS +"RTN","TMGEDIT",5,0) + +"RTN","TMGEDIT",6,0) + ;"======================================================================= +"RTN","TMGEDIT",7,0) + ;" API -- Public Functions. +"RTN","TMGEDIT",8,0) + ;"======================================================================= +"RTN","TMGEDIT",9,0) + ;"$$EDIT(Editor) +"RTN","TMGEDIT",10,0) + +"RTN","TMGEDIT",11,0) + ;"======================================================================= +"RTN","TMGEDIT",12,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGEDIT",13,0) + ;"======================================================================= +"RTN","TMGEDIT",14,0) + +"RTN","TMGEDIT",15,0) + +"RTN","TMGEDIT",16,0) + ;"======================================================================= +"RTN","TMGEDIT",17,0) + ;"======================================================================= +"RTN","TMGEDIT",18,0) + +"RTN","TMGEDIT",19,0) +EDIT(Editor) +"RTN","TMGEDIT",20,0) + ;"Purpose: This will be a shell for a linux editor +"RTN","TMGEDIT",21,0) + ;"Input: Editor -- the name of the linux editor to use (i.e. vim, joe, pico etc) +"RTN","TMGEDIT",22,0) + ;" Allowed values: joe,vim,pico +"RTN","TMGEDIT",23,0) + ;"Note: When this function gets called, VistA sets up some variables +"RTN","TMGEDIT",24,0) + ;" first to tell what should be edited etc. +"RTN","TMGEDIT",25,0) + ;" DIC=The global root of the WP field where the text to be edited is +"RTN","TMGEDIT",26,0) + ;" stored (or where new text should be stored) +"RTN","TMGEDIT",27,0) + ;" e.g. "^TMG(22702,27,DV," +"RTN","TMGEDIT",28,0) + ;" (DV is also predefined, so reference to DV in DIC is covered.) +"RTN","TMGEDIT",29,0) + ;" There are other variables set up re margins etc. I will be ignoring these. +"RTN","TMGEDIT",30,0) + ;"Results: none +"RTN","TMGEDIT",31,0) + +"RTN","TMGEDIT",32,0) + new result set result=0 +"RTN","TMGEDIT",33,0) + new GlobalP +"RTN","TMGEDIT",34,0) + +"RTN","TMGEDIT",35,0) + ;"By limiting value to certain values, it prevents a rouge user from putting a wedged +"RTN","TMGEDIT",36,0) + ;"linux command into "Editor" and executing a system command through zsystem. +"RTN","TMGEDIT",37,0) + set Editor=$get(Editor,"rvim") +"RTN","TMGEDIT",38,0) + if (Editor'="rvim")&(Editor'="joe")&(Editor'="pico") goto EditAbort +"RTN","TMGEDIT",39,0) + +"RTN","TMGEDIT",40,0) + ;"Only allow users with programmer access to use joe +"RTN","TMGEDIT",41,0) + if (Editor="joe") do if result=1 goto EditAbort +"RTN","TMGEDIT",42,0) + . new AccessCode +"RTN","TMGEDIT",43,0) + . set AccessCode=$piece(^VA(200,DUZ,0),"^",4) +"RTN","TMGEDIT",44,0) + . if AccessCode'="@" do +"RTN","TMGEDIT",45,0) + . . write !!,"*** Sorry. Insufficient security clearance to use insecure 'joe' editor. ***",! +"RTN","TMGEDIT",46,0) + . . write "Please enter 'User's Toolbox', then 'Edit User Characteristics' at a menu",! +"RTN","TMGEDIT",47,0) + . . write " option to change PREFERRED EDITOR to something other than JOE.",!! +"RTN","TMGEDIT",48,0) + . . set result=1 +"RTN","TMGEDIT",49,0) + +"RTN","TMGEDIT",50,0) + new EditErrFile set EditErrFile="/tmp/trashjoeoutput.txt" +"RTN","TMGEDIT",51,0) + +"RTN","TMGEDIT",52,0) + set GlobalP=$extract(DIC,1,$length(DIC)-1)_")" ;"convert to closed form +"RTN","TMGEDIT",53,0) + new Filename set Filename=$$UNIQUE^%ZISUTL("/tmp/vistaedit.tmp") +"RTN","TMGEDIT",54,0) + set result=$$WP2HFSfp^TMGIOUTL(GlobalP,Filename) +"RTN","TMGEDIT",55,0) + if result=0 goto EditDone +"RTN","TMGEDIT",56,0) + +"RTN","TMGEDIT",57,0) + +"RTN","TMGEDIT",58,0) + new HookCmd +"RTN","TMGEDIT",59,0) + set HookCmd=Editor_" "_Filename_" 2>"_EditErrFile ;"use NULL instead?? +"RTN","TMGEDIT",60,0) + zsystem HookCmd +"RTN","TMGEDIT",61,0) + set result=$ZSYSTEM&255 ;"get result of execution. (low byte only). 0=success +"RTN","TMGEDIT",62,0) + if result>0 goto EditDone +"RTN","TMGEDIT",63,0) + +"RTN","TMGEDIT",64,0) + ;"read file back into global WP +"RTN","TMGEDIT",65,0) + set result=$$HFS2WPfp^TMGIOUTL(Filename,GlobalP) +"RTN","TMGEDIT",66,0) + ;"if result=1 do +"RTN","TMGEDIT",67,0) + +"RTN","TMGEDIT",68,0) +EditDone +"RTN","TMGEDIT",69,0) + new temp set temp=$$DelFile^TMGIOUTL(Filename) +"RTN","TMGEDIT",70,0) + set temp=$$DelFile^TMGIOUTL(Filename_"~") ;"joe editor copies output to filename~ as a backup +"RTN","TMGEDIT",71,0) + set temp=$$DelFile^TMGIOUTL(EditErrFile) +"RTN","TMGEDIT",72,0) +EditAbort +"RTN","TMGEDIT",73,0) + quit +"RTN","TMGEDIT",74,0) + +"RTN","TMGEDIT",75,0) + +"RTN","TMGEDIT",76,0) + +"RTN","TMGEDIT",77,0) +LinuxEdit(Editor,FullPathName) +"RTN","TMGEDIT",78,0) + ;"Purpose: This will be a shell for a linux editor +"RTN","TMGEDIT",79,0) + ;"Input: Editor -- the name of the linux editor to use (i.e. vim, joe, pico etc) +"RTN","TMGEDIT",80,0) + ;" Allowed values: joe,vim,pico +"RTN","TMGEDIT",81,0) + ;" FullPathName -- the path name on the Linux HFS to edit. +"RTN","TMGEDIT",82,0) + ;"Results: none +"RTN","TMGEDIT",83,0) + +"RTN","TMGEDIT",84,0) + new result set result=0 +"RTN","TMGEDIT",85,0) + new GlobalP +"RTN","TMGEDIT",86,0) + +"RTN","TMGEDIT",87,0) + ;"By limiting value to certain values, it prevents a rouge user from putting a wedged +"RTN","TMGEDIT",88,0) + ;"linux command into "Editor" and executing a system command through zsystem. +"RTN","TMGEDIT",89,0) + set Editor=$get(Editor,"rvim") +"RTN","TMGEDIT",90,0) + if (Editor'="rvim")&(Editor'="joe")&(Editor'="pico") goto LEditAbort +"RTN","TMGEDIT",91,0) + +"RTN","TMGEDIT",92,0) + ;"Only allow users with programmer access to use joe +"RTN","TMGEDIT",93,0) + if (Editor="joe") do if result=1 goto EditAbort +"RTN","TMGEDIT",94,0) + . new AccessCode +"RTN","TMGEDIT",95,0) + . set AccessCode=$piece(^VA(200,DUZ,0),"^",4) +"RTN","TMGEDIT",96,0) + . if AccessCode'="@" do +"RTN","TMGEDIT",97,0) + . . write !!,"*** Sorry. Insufficient security clearance to use insecure 'joe' editor. ***",! +"RTN","TMGEDIT",98,0) + . . write "Please enter 'User's Toolbox', then 'Edit User Characteristics' at a menu",! +"RTN","TMGEDIT",99,0) + . . write " option to change PREFERRED EDITOR to something other than JOE.",!! +"RTN","TMGEDIT",100,0) + . . set result=1 +"RTN","TMGEDIT",101,0) + +"RTN","TMGEDIT",102,0) + ;"new EditErrFile set EditErrFile="/tmp/trashjoeoutput.txt" +"RTN","TMGEDIT",103,0) + +"RTN","TMGEDIT",104,0) + new Filename set Filename=FullPathName +"RTN","TMGEDIT",105,0) + +"RTN","TMGEDIT",106,0) + new HookCmd +"RTN","TMGEDIT",107,0) + ;"set HookCmd=Editor_" "_Filename_" 2>"_EditErrFile ;"use NULL instead?? +"RTN","TMGEDIT",108,0) + set HookCmd=Editor_" "_Filename +"RTN","TMGEDIT",109,0) + zsystem HookCmd +"RTN","TMGEDIT",110,0) + set result=$ZSYSTEM&255 ;"get result of execution. (low byte only). 0=success +"RTN","TMGEDIT",111,0) + if result>0 goto LEditDone +"RTN","TMGEDIT",112,0) + +"RTN","TMGEDIT",113,0) + +"RTN","TMGEDIT",114,0) +LEditDone +"RTN","TMGEDIT",115,0) + ;"set temp=$$DelFile^TMGIOUTL(Filename_"~") ;"joe editor copies output to filename~ as a backup +"RTN","TMGEDIT",116,0) + ;"set temp=$$DelFile^TMGIOUTL(EditErrFile) +"RTN","TMGEDIT",117,0) +LEditAbort +"RTN","TMGEDIT",118,0) + quit +"RTN","TMGEDIT",119,0) + +"RTN","TMGEDIT",120,0) + +"RTN","TMGFMUT") +0^20^B7306 +"RTN","TMGFMUT",1,0) +TMGFMUT ;TMG/kst/Fileman utility functions ;03/25/06 +"RTN","TMGFMUT",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGFMUT",3,0) + +"RTN","TMGFMUT",4,0) + ;"TMG FILEMAN-UTILITY FUNCTIONS +"RTN","TMGFMUT",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGFMUT",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGFMUT",7,0) + ;"7-12-2005 +"RTN","TMGFMUT",8,0) + +"RTN","TMGFMUT",9,0) + ;"======================================================================= +"RTN","TMGFMUT",10,0) + ;" API -- Public Functions. +"RTN","TMGFMUT",11,0) + ;"======================================================================= +"RTN","TMGFMUT",12,0) + ;"$$PTRLINKS +"RTN","TMGFMUT",13,0) + ;"$$FilePtrs(File,OutVarP) +"RTN","TMGFMUT",14,0) + ;"DispArray(ArrayP,DispdList,indentDepth,MaxDepth) +"RTN","TMGFMUT",15,0) + ;"ASKPTRIN +"RTN","TMGFMUT",16,0) + ;"ASKMVPTR +"RTN","TMGFMUT",17,0) + ;"QTMVPTR(Info,PFn) --quietly redirect pointers. +"RTN","TMGFMUT",18,0) + ;"QTMMVPTR(Info,ShowProgress) --quietly redirect multiple pointers at once. +"RTN","TMGFMUT",19,0) + ;"$$PtrsIn(File,IEN,Array) +"RTN","TMGFMUT",20,0) + ;"$$PtrsMIn(IENArray,Array,ShowProgress) +"RTN","TMGFMUT",21,0) + ;"$$PossPtrs(File,Array) +"RTN","TMGFMUT",22,0) + +"RTN","TMGFMUT",23,0) + ;"======================================================================= +"RTN","TMGFMUT",24,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGFMUT",25,0) + ;"======================================================================= +"RTN","TMGFMUT",26,0) + ;"ScanFile(FInfo,IEN,Array) +"RTN","TMGFMUT",27,0) + ;"ScanMFile(FInfoArray,IENArray,Array,ShowProgress) +"RTN","TMGFMUT",28,0) + ;"HandleSubFile(SearchValue,FileArray,Array,IENS,Ref) +"RTN","TMGFMUT",29,0) + ;"HandleMSubFile(IENArray,FileArray,Array,IENS,Ref) +"RTN","TMGFMUT",30,0) + +"RTN","TMGFMUT",31,0) + ;"======================================================================= +"RTN","TMGFMUT",32,0) + ;"DEPENDENCIES +"RTN","TMGFMUT",33,0) + ;"======================================================================= +"RTN","TMGFMUT",34,0) + ;"TMGDBAPI +"RTN","TMGFMUT",35,0) + ;"======================================================================= +"RTN","TMGFMUT",36,0) + +"RTN","TMGFMUT",37,0) + +"RTN","TMGFMUT",38,0) +PTRLINKS +"RTN","TMGFMUT",39,0) + ;"Purpose: To examine the Fileman data dictionary for a specified file +"RTN","TMGFMUT",40,0) + ;" Then tell any pointers out to other files. If found, then display +"RTN","TMGFMUT",41,0) + ;" this 'dependency'. Then follow trail to that file, and show it's +"RTN","TMGFMUT",42,0) + ;" 'dependency'. Trail will be followed up to N levels deep (set=6 here) +"RTN","TMGFMUT",43,0) + ;"Results: 1=OKToContinue, 0=failure +"RTN","TMGFMUT",44,0) + +"RTN","TMGFMUT",45,0) + new File,Info,DispdList +"RTN","TMGFMUT",46,0) + new result +"RTN","TMGFMUT",47,0) + +"RTN","TMGFMUT",48,0) + write "Display pointer dependencies between files.",!! +"RTN","TMGFMUT",49,0) + read "Enter file name or number to explore (^ to abort): ",File,! +"RTN","TMGFMUT",50,0) + if File="^" goto PTDone +"RTN","TMGFMUT",51,0) + set result=$$FilePtrs(File,"Info") +"RTN","TMGFMUT",52,0) + if result=0 write "Error. Aborting. Sorry about that...",!! goto PTDone +"RTN","TMGFMUT",53,0) + +"RTN","TMGFMUT",54,0) + do DispArray("Info",.DispdList,0,6) ;"force max depth=6 +"RTN","TMGFMUT",55,0) + +"RTN","TMGFMUT",56,0) +PTDone +"RTN","TMGFMUT",57,0) + quit result +"RTN","TMGFMUT",58,0) + +"RTN","TMGFMUT",59,0) + +"RTN","TMGFMUT",60,0) +FilePtrs(File,OutVarP) +"RTN","TMGFMUT",61,0) + ;"For File, create array listing those fields with pointers to other files +"RTN","TMGFMUT",62,0) + ;"Input: File -- can be file name or number to explore +"RTN","TMGFMUT",63,0) + ;" OutVarP -- the name of array to put results into +"RTN","TMGFMUT",64,0) + ;"Output: Values are put into @OutVarP as follows: +"RTN","TMGFMUT",65,0) + ;" @OutVarP@(FileNum,"FILE NAME")=File Name +"RTN","TMGFMUT",66,0) + ;" @OutVarP@(FileNum,FieldNum)=Field Number +"RTN","TMGFMUT",67,0) + ;" @OutVarP@(FileNum,FieldNum,"FIELD NAME")=Field Name +"RTN","TMGFMUT",68,0) + ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","GREF")=Open format global reference +"RTN","TMGFMUT",69,0) + ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","FILE NAME")=File name pointed to +"RTN","TMGFMUT",70,0) + ;" @OutVarP@(FileNum,FieldNum,"POINTS TO","FILE NUMBER")=File number pointed to +"RTN","TMGFMUT",71,0) + ;" @OutVarP@(FileNum,FieldNum,"X GET")=Code to xecute to get value +"RTN","TMGFMUT",72,0) + ;" e.g. SET TMGVALUE=$PIECE($GET(^VA(200,TMGIEN,.11),"^",5))" +"RTN","TMGFMUT",73,0) + ;" note: TMGIEN is IEN to lookup, and result is in TMGVALUE +"RTN","TMGFMUT",74,0) + ;" @OutVarP@(FileNum,FieldNum,"X SET")=Code to xecute to set value +"RTN","TMGFMUT",75,0) + ;" e.g. SET TMGVALUE=$PIECE(^VA(200,TMGIEN,.11),"^",5)=TMGVALUE" +"RTN","TMGFMUT",76,0) + ;" ** For subfiles ** ... +"RTN","TMGFMUT",77,0) + ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"FIELD NAME")=Field Name +"RTN","TMGFMUT",78,0) + ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","GREF")=Open format global reference +"RTN","TMGFMUT",79,0) + ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","FILE NAME")=File name pointed to +"RTN","TMGFMUT",80,0) + ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"POINTS TO","FILE NUMBER")=File number pointed to +"RTN","TMGFMUT",81,0) + ;" @OutVarP@(FileNum,FieldNum,"SUBFILE",FileNum,FieldNum,"X GET")=Code to xecute to get value +"RTN","TMGFMUT",82,0) + ;" e.g. SET TMGVALUE=$PIECE($GET(^VA(200,TMGIEN,TMGIEN(1),.11),"^",5))" +"RTN","TMGFMUT",83,0) + ;" note: TMGIEN is IEN to lookup, and result is in TMGVALUE +"RTN","TMGFMUT",84,0) + ;" @OutVarP@(FileNum,FieldNum,"X SET")=Code to xecute to set value +"RTN","TMGFMUT",85,0) + ;" e.g. SET TMGVALUE=$PIECE(^VA(200,TMGIEN,TMGIEN(1),.11),"^",5)=TMGVALUE" +"RTN","TMGFMUT",86,0) + ;" ... etc. +"RTN","TMGFMUT",87,0) + ;"Results: 1=OKToContinue, 0=failure +"RTN","TMGFMUT",88,0) + +"RTN","TMGFMUT",89,0) + new TMGptrArray +"RTN","TMGFMUT",90,0) + new result +"RTN","TMGFMUT",91,0) + new index +"RTN","TMGFMUT",92,0) + new FileNum,FileName +"RTN","TMGFMUT",93,0) + +"RTN","TMGFMUT",94,0) + set result=$$GetFldList^TMGDBAPI(.File,"TMGptrArray") +"RTN","TMGFMUT",95,0) + if result=0 goto FPtrDone +"RTN","TMGFMUT",96,0) + set result=($get(OutVarP)'="") +"RTN","TMGFMUT",97,0) + if result=0 goto FPtrDone +"RTN","TMGFMUT",98,0) + if +$get(File)=0 do +"RTN","TMGFMUT",99,0) + . set FileNum=$$GetFileNum^TMGDBAPI(.File) +"RTN","TMGFMUT",100,0) + . set FileName=$get(File) +"RTN","TMGFMUT",101,0) + else do +"RTN","TMGFMUT",102,0) + . set FileNum=+File +"RTN","TMGFMUT",103,0) + . set FileName=$$GetFName^TMGDBAPI(FileNum) +"RTN","TMGFMUT",104,0) + set result=(FileNum'=0) +"RTN","TMGFMUT",105,0) + if result=0 goto FPtrDone +"RTN","TMGFMUT",106,0) + +"RTN","TMGFMUT",107,0) + set index=$order(TMGptrArray("")) +"RTN","TMGFMUT",108,0) + for do quit:(result=0)!(index="") +"RTN","TMGFMUT",109,0) + . new fieldnum,TMGFldInfo +"RTN","TMGFMUT",110,0) + . set fieldnum=index +"RTN","TMGFMUT",111,0) + . if +fieldnum=0 set result=0 quit +"RTN","TMGFMUT",112,0) + . do FIELD^DID(FileNum,fieldnum,,"POINTER;MULTIPLE-VALUED","TMGFldInfo","TMGMsg") +"RTN","TMGFMUT",113,0) + . if $data(TMGMsg) do set result=0 quit +"RTN","TMGFMUT",114,0) + . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMsg") +"RTN","TMGFMUT",115,0) + . . if $data(TMGMsg("DIERR"))'=0 do quit +"RTN","TMGFMUT",116,0) + . . . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGFMUT",117,0) + . if $get(TMGFldInfo("MULTIPLE-VALUED"))=1 do +"RTN","TMGFMUT",118,0) + . . ;" handle subfiles via a recursive call +"RTN","TMGFMUT",119,0) + . . new subfile,subArrayP +"RTN","TMGFMUT",120,0) + . . set subfile=$$GetSubFileNumber^TMGDBAPI(FileNum,fieldnum) +"RTN","TMGFMUT",121,0) + . . if subfile=0 quit +"RTN","TMGFMUT",122,0) + . . set subArrayP=$name(@OutVarP@(FileNum,fieldnum,"SUBFILE")) +"RTN","TMGFMUT",123,0) + . . ;"set subArrayP=OutVarP +"RTN","TMGFMUT",124,0) + . . set result=$$FilePtrs(subfile,subArrayP) +"RTN","TMGFMUT",125,0) + . if $get(TMGFldInfo("POINTER"))'="" do +"RTN","TMGFMUT",126,0) + . . if +TMGFldInfo("POINTER")>0 quit ;"screen out computed nodes. +"RTN","TMGFMUT",127,0) + . . if TMGFldInfo("POINTER")[":" quit ;"screen out set type fields +"RTN","TMGFMUT",128,0) + . . new gref,node0 +"RTN","TMGFMUT",129,0) + . . set gref=TMGFldInfo("POINTER") +"RTN","TMGFMUT",130,0) + . . set @OutVarP@(FileNum,"FILE NAME")=FileName +"RTN","TMGFMUT",131,0) + . . set @OutVarP@(FileNum,fieldnum,"FIELD NAME")=$$GetFldName^TMGDBAPI(FileNum,fieldnum) +"RTN","TMGFMUT",132,0) + . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","GREF")=gref +"RTN","TMGFMUT",133,0) + . . set gref="^"_gref_"0)" +"RTN","TMGFMUT",134,0) + . . ;"write "index=",index," gref=",gref,! +"RTN","TMGFMUT",135,0) + . . set node0=$get(@gref) +"RTN","TMGFMUT",136,0) + . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","FILE NAME")=$piece(node0,"^",1) +"RTN","TMGFMUT",137,0) + . . set @OutVarP@(FileNum,fieldnum,"POINTS TO","FILE NUMBER")=+$piece(node0,"^",2) +"RTN","TMGFMUT",138,0) + . . new DD set DD=$get(^DD(FileNum,fieldnum,0)) quit:(DD="") +"RTN","TMGFMUT",139,0) + . . new nodepce set nodepce=$piece(DD,"^",4) quit:(nodepce="") +"RTN","TMGFMUT",140,0) + . . new node set node=+$piece(nodepce,";",1) quit:(node="") +"RTN","TMGFMUT",141,0) + . . new pce set pce=+$piece(nodepce,";",2) quit:(pce'>0) +"RTN","TMGFMUT",142,0) + . . new thisGL set thisGL=$get(^DIC(FileNum,0,"GL")) +"RTN","TMGFMUT",143,0) + . . new getCode,setCode +"RTN","TMGFMUT",144,0) + . . if thisGL="" do quit:(thisGL="") +"RTN","TMGFMUT",145,0) + . . . ;"Note: I am only going to support 1 sub level. More--> brain hurts! +"RTN","TMGFMUT",146,0) + . . . new upNum set upNum=$get(^DD(FileNum,0,"UP")) +"RTN","TMGFMUT",147,0) + . . . if upNum="" quit +"RTN","TMGFMUT",148,0) + . . . set thisGL=$get(^DIC(upNum,0,"GL")) +"RTN","TMGFMUT",149,0) + . . . if thisGL="" quit ;"happens with sub-sub.. nodes. +"RTN","TMGFMUT",150,0) + . . . set getCode="SET TMGVALUE=$PIECE($GET("_thisGL_"TMGIEN,TMGIEN(1),"_node_")),""^"","_pce_")" +"RTN","TMGFMUT",151,0) + . . . set setCode="SET $PIECE("_thisGL_"TMGIEN,TMGIEN(1),"_node_"),""^"","_pce_")=TMGVALUE" +"RTN","TMGFMUT",152,0) + . . else do +"RTN","TMGFMUT",153,0) + . . . set getCode="SET TMGVALUE=$PIECE($GET("_thisGL_"TMGIEN,"_node_")),""^"","_pce_")" +"RTN","TMGFMUT",154,0) + . . . set setCode="SET $PIECE("_thisGL_"TMGIEN,"_node_"),""^"","_pce_")=TMGVALUE" +"RTN","TMGFMUT",155,0) + . . set @OutVarP@(FileNum,fieldnum,"X GET")=getCode +"RTN","TMGFMUT",156,0) + . . set @OutVarP@(FileNum,fieldnum,"X SET")=setCode +"RTN","TMGFMUT",157,0) + . set index=$order(TMGptrArray(index)) +"RTN","TMGFMUT",158,0) + +"RTN","TMGFMUT",159,0) +FPtrDone +"RTN","TMGFMUT",160,0) + quit result +"RTN","TMGFMUT",161,0) + +"RTN","TMGFMUT",162,0) +DispArray(ArrayP,DispdList,indentDepth,MaxDepth) +"RTN","TMGFMUT",163,0) + ;"Purpose: Display array created by FilePtrs (see format there) +"RTN","TMGFMUT",164,0) + ;"Input: ArrayP : name of array containing information +"RTN","TMGFMUT",165,0) + ;" DispdList : array (pass by reference) contining list of files already displayed +"RTN","TMGFMUT",166,0) + ;" DispdList("TIU DOCUMENT")="" +"RTN","TMGFMUT",167,0) + ;" DispdList("PATIENT")="" etc. +"RTN","TMGFMUT",168,0) + ;" indentDepth : Number of indents deep this function is. Default=0 +"RTN","TMGFMUT",169,0) + ;" MaxDepth : maximum number of indents deep allowed. +"RTN","TMGFMUT",170,0) + +"RTN","TMGFMUT",171,0) + new i,fieldnum,file,FileName +"RTN","TMGFMUT",172,0) + set indentDepth=+$get(indentDepth,0) +"RTN","TMGFMUT",173,0) + new indentS set indentS="" +"RTN","TMGFMUT",174,0) + for i=1:1:(indentDepth) s indentS=indentS_". " +"RTN","TMGFMUT",175,0) + +"RTN","TMGFMUT",176,0) + set file=$order(@ArrayP@("")) +"RTN","TMGFMUT",177,0) + set FileName=$get(@ArrayP@(file,"FILE NAME")) +"RTN","TMGFMUT",178,0) + set DispdList(FileName)="" +"RTN","TMGFMUT",179,0) + if FileName'="" write indentS,"FILE: ",FileName,! +"RTN","TMGFMUT",180,0) + set fieldnum=$order(@ArrayP@(file,"")) +"RTN","TMGFMUT",181,0) + for do quit:(+fieldnum=0) +"RTN","TMGFMUT",182,0) + . if +fieldnum=0 quit +"RTN","TMGFMUT",183,0) + . new p2FName +"RTN","TMGFMUT",184,0) + . set p2FName=$get(@ArrayP@(file,fieldnum,"POINTS TO","FILE NAME")) +"RTN","TMGFMUT",185,0) + . write indentS,"field: ",$get(@ArrayP@(file,fieldnum,"FIELD NAME")),"--> file: ",p2FName +"RTN","TMGFMUT",186,0) + . if $data(DispdList(p2FName))=0 do +"RTN","TMGFMUT",187,0) + . . set DispdList(p2FName)="" +"RTN","TMGFMUT",188,0) + . . if indentDepth0 goto APTDone +"RTN","TMGFMUT",216,0) + set DIC=File +"RTN","TMGFMUT",217,0) + do ^DIC +"RTN","TMGFMUT",218,0) + set IEN=+Y +"RTN","TMGFMUT",219,0) + if IEN'>0 goto APTDone +"RTN","TMGFMUT",220,0) + new TMGTIME set TMGTIME=$H +"RTN","TMGFMUT",221,0) + ;"set PFn="w TMGCODE,"" "",((TMGCUR/TMGTOTAL)*100)\1,""%"",!" +"RTN","TMGFMUT",222,0) + set PFn="do ProgressBar^TMGUSRIF(TMGCUR,""File: ""_$P(TMGCODE,""^"",1),1,TMGTOTAL)" +"RTN","TMGFMUT",223,0) + write !!,"Starting File Scan for instances of pointers (references) to this record.",!! +"RTN","TMGFMUT",224,0) + set result=$$PtrsIn(File,IEN,.Array,PFn) +"RTN","TMGFMUT",225,0) + if result=0 write !,"There was some problem. Sorry.",!! goto APTDone +"RTN","TMGFMUT",226,0) + +"RTN","TMGFMUT",227,0) + if $data(Array) do +"RTN","TMGFMUT",228,0) + . write !,"Done. Here are results:",! +"RTN","TMGFMUT",229,0) + . write "Format is: ",! +"RTN","TMGFMUT",230,0) + . write " Array(File#,IEN,0)=LastCount",! +"RTN","TMGFMUT",231,0) + . write " Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef",! +"RTN","TMGFMUT",232,0) + . write " Description of parts:",! +"RTN","TMGFMUT",233,0) + . write " ----------------------",! +"RTN","TMGFMUT",234,0) + . write " File# -- the file the found entry exists it (may be a subfile number)",! +"RTN","TMGFMUT",235,0) + . write " IEN -- the record number in file",! +"RTN","TMGFMUT",236,0) + . write " Note: IEN here is different from the IEN passed in as a parameter",! +"RTN","TMGFMUT",237,0) + . write " FullRef -- the is the full reference to the found value. e.g.",! +"RTN","TMGFMUT",238,0) + . write " set value=$piece(@FullRef,""^"",piece)",! +"RTN","TMGFMUT",239,0) + . write " piece -- piece where value is stored in the node that is specified by FullRef",! +"RTN","TMGFMUT",240,0) + . write " IENS -- this is provided only for matches in subfiles. ",! +"RTN","TMGFMUT",241,0) + . write " It is the IENS that may be used in database calls",! +"RTN","TMGFMUT",242,0) + . write " TopGlobalRef -- this is the global reference for file. If the match is in a",! +"RTN","TMGFMUT",243,0) + . write " subfile, then this is the global reference of the parent file ",! +"RTN","TMGFMUT",244,0) + . write " (or the highest grandparent file if the parent file itself is",! +"RTN","TMGFMUT",245,0) + . write " a subfile)",! +"RTN","TMGFMUT",246,0) + . zwr Array(*) +"RTN","TMGFMUT",247,0) + . write "---------------------------",! +"RTN","TMGFMUT",248,0) + . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! +"RTN","TMGFMUT",249,0) + else write !,"No pointers to that record found.",! +"RTN","TMGFMUT",250,0) + +"RTN","TMGFMUT",251,0) +APTDone +"RTN","TMGFMUT",252,0) + quit +"RTN","TMGFMUT",253,0) + +"RTN","TMGFMUT",254,0) + +"RTN","TMGFMUT",255,0) +ASKMVPTR +"RTN","TMGFMUT",256,0) + ;"Purpose: An interface shell toRedirect any pointer. +"RTN","TMGFMUT",257,0) + ;" Will ask for name of a file, and then a record in that file. +"RTN","TMGFMUT",258,0) + ;" Will then pass information to fileman function to move pointers. +"RTN","TMGFMUT",259,0) + +"RTN","TMGFMUT",260,0) + ;"Note: Example of array passed to P^DITP +"RTN","TMGFMUT",261,0) + ;" 23510 is $J +"RTN","TMGFMUT",262,0) + ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*)) +"RTN","TMGFMUT",263,0) + ;" 1646 is IEN to be substituted for all 47's +"RTN","TMGFMUT",264,0) + ;" +"RTN","TMGFMUT",265,0) + ;" First part of array is list of all files & fields that point to file +"RTN","TMGFMUT",266,0) + ;" ---------------- +"RTN","TMGFMUT",267,0) + ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'" +"RTN","TMGFMUT",268,0) + ;" ... +"RTN","TMGFMUT",269,0) + ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV" +"RTN","TMGFMUT",270,0) + ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V" +"RTN","TMGFMUT",271,0) + ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V" +"RTN","TMGFMUT",272,0) + ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX" +"RTN","TMGFMUT",273,0) + ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX" +"RTN","TMGFMUT",274,0) + ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'" +"RTN","TMGFMUT",275,0) + ;" +"RTN","TMGFMUT",276,0) + ;" Second part of array is list of changes that should be made. Only 1 change shown here. +"RTN","TMGFMUT",277,0) + ;" ---------------- +"RTN","TMGFMUT",278,0) + ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG(" +"RTN","TMGFMUT",279,0) + ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG(" +"RTN","TMGFMUT",280,0) + +"RTN","TMGFMUT",281,0) + new File,fromIEN,toIEN,Array,PFn,result +"RTN","TMGFMUT",282,0) + new PossPtrs +"RTN","TMGFMUT",283,0) + +"RTN","TMGFMUT",284,0) + write !,"Pointer Redirection Utility",! +"RTN","TMGFMUT",285,0) + write "Will change pointers to FROM to TO value",! +"RTN","TMGFMUT",286,0) + +"RTN","TMGFMUT",287,0) + kill DIC +"RTN","TMGFMUT",288,0) + set DIC("A")="Select File holding records being pointed to: " +"RTN","TMGFMUT",289,0) + set DIC="^DIC(" +"RTN","TMGFMUT",290,0) + set DIC(0)="MAQE" +"RTN","TMGFMUT",291,0) + d ^DIC ;"Get File to search +"RTN","TMGFMUT",292,0) + set File=+Y +"RTN","TMGFMUT",293,0) + if File'>0 goto AMPTDone +"RTN","TMGFMUT",294,0) + +"RTN","TMGFMUT",295,0) + ;"Get list of files/fields with pointers in +"RTN","TMGFMUT",296,0) + set result=$$PossPtrs(File,.PossPtrs) if result=0 goto AMPTDone +"RTN","TMGFMUT",297,0) + if $data(PossPtrs)'>0 goto AMPTDone +"RTN","TMGFMUT",298,0) + +"RTN","TMGFMUT",299,0) + set DIC=File +"RTN","TMGFMUT",300,0) + set DIC("A")="Select Original (i.e OLD) Record: " +"RTN","TMGFMUT",301,0) + do ^DIC ;"get FROM record in File +"RTN","TMGFMUT",302,0) + set fromIEN=+Y +"RTN","TMGFMUT",303,0) + if fromIEN'>0 goto AMPTDone +"RTN","TMGFMUT",304,0) + +"RTN","TMGFMUT",305,0) + set DIC("A")="Select New Record: " +"RTN","TMGFMUT",306,0) + do ^DIC ;"get FROM record in File +"RTN","TMGFMUT",307,0) + set toIEN=+Y +"RTN","TMGFMUT",308,0) + if toIEN'>0 goto AMPTDone +"RTN","TMGFMUT",309,0) + +"RTN","TMGFMUT",310,0) + ;"set PFn="w TMGCODE,"" "",((TMGCUR/TMGTOTAL)*100)\1,""%"",!" +"RTN","TMGFMUT",311,0) + ;"new TMGTIME set TMGTIME=$H +"RTN","TMGFMUT",312,0) + set PFn="do ProgressBar^TMGUSRIF(TMGCUR,""Scanning File: ""_$P(TMGCODE,""^"",1),1,TMGTOTAL)" +"RTN","TMGFMUT",313,0) + write !!,"Starting File Scan for instances of pointers (references) to this record.",!! +"RTN","TMGFMUT",314,0) + set result=$$PtrsIn(File,fromIEN,.Array,PFn) if result=0 goto AMPTDone +"RTN","TMGFMUT",315,0) + +"RTN","TMGFMUT",316,0) + ;" write !,"Here are possible pointers in (file level)",! +"RTN","TMGFMUT",317,0) + ;" if $data(PossPtrs) zwr PossPtrs(*) +"RTN","TMGFMUT",318,0) + +"RTN","TMGFMUT",319,0) + ;" write !,"Here are actual pointers in",! +"RTN","TMGFMUT",320,0) + ;" if $data(Array) zwr Array(*) +"RTN","TMGFMUT",321,0) + +"RTN","TMGFMUT",322,0) + ;"Now convert to FileMan Format. +"RTN","TMGFMUT",323,0) + kill ^UTILITY("DIT",$J) +"RTN","TMGFMUT",324,0) + do Prep4FM(.Array) +"RTN","TMGFMUT",325,0) + +"RTN","TMGFMUT",326,0) + if $data(^UTILITY("DIT",$J)) do +"RTN","TMGFMUT",327,0) + . merge ^UTILITY("DIT",$J,0)=PossPtrs +"RTN","TMGFMUT",328,0) + . ;"write !,"here are results",! +"RTN","TMGFMUT",329,0) + . ;" zwr ^UTILITY("DIT",$J,*) +"RTN","TMGFMUT",330,0) + . set DIR(0)="Y",DIR("B")="YES" +"RTN","TMGFMUT",331,0) + . set DIR("A")="Ask Fileman to redirect pointers?" +"RTN","TMGFMUT",332,0) + . set DIR("?")="Enter YES if you want Fileman to change all instances of the FROM record into the TO record." +"RTN","TMGFMUT",333,0) + . do ^DIR ;"get user response +"RTN","TMGFMUT",334,0) + . if +Y'=1 quit +"RTN","TMGFMUT",335,0) + . write "YES",! +"RTN","TMGFMUT",336,0) + . do PTS^DITP +"RTN","TMGFMUT",337,0) + else do +"RTN","TMGFMUT",338,0) + . write "No matches found...",!! +"RTN","TMGFMUT",339,0) + +"RTN","TMGFMUT",340,0) +AMPTDone +"RTN","TMGFMUT",341,0) + quit +"RTN","TMGFMUT",342,0) + +"RTN","TMGFMUT",343,0) + +"RTN","TMGFMUT",344,0) +QTMVPTR(Info,PFn) ;"NOTE: this function hasn't been debugged/tested yet +"RTN","TMGFMUT",345,0) + ;"Purpose: An interface to quietly redirect any pointer. +"RTN","TMGFMUT",346,0) + ;"Input: Info, an array containing info for redirecting pointers. +"RTN","TMGFMUT",347,0) + ;" Format: Note: File can be file name or number. +"RTN","TMGFMUT",348,0) + ;" Info(File,OldIEN)=newIEN +"RTN","TMGFMUT",349,0) + ;" Info(File,OldIEN)=newIEN1 +"RTN","TMGFMUT",350,0) + ;" Info(File,OldIEN)=newIEN +"RTN","TMGFMUT",351,0) + ;" PFn: OPTIONAL, a progress function (must be a complete M expression) +"RTN","TMGFMUT",352,0) + ;"Output: all pointers in linked files to OldIEN will be changed to newIEN +"RTN","TMGFMUT",353,0) + ;"Results: none +"RTN","TMGFMUT",354,0) + +"RTN","TMGFMUT",355,0) + ;"Note: Example of array passed to P^DITP +"RTN","TMGFMUT",356,0) + ;" 23510 is $J +"RTN","TMGFMUT",357,0) + ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*)) +"RTN","TMGFMUT",358,0) + ;" 1646 is IEN to be substituted for all 47's +"RTN","TMGFMUT",359,0) + ;" +"RTN","TMGFMUT",360,0) + ;" First part of array is list of all files & fields that point to file +"RTN","TMGFMUT",361,0) + ;" ---------------- +"RTN","TMGFMUT",362,0) + ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'" +"RTN","TMGFMUT",363,0) + ;" ... +"RTN","TMGFMUT",364,0) + ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV" +"RTN","TMGFMUT",365,0) + ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V" +"RTN","TMGFMUT",366,0) + ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V" +"RTN","TMGFMUT",367,0) + ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX" +"RTN","TMGFMUT",368,0) + ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX" +"RTN","TMGFMUT",369,0) + ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'" +"RTN","TMGFMUT",370,0) + ;" +"RTN","TMGFMUT",371,0) + ;" Second part of array is list of changes that should be made. Only 1 change shown here. +"RTN","TMGFMUT",372,0) + ;" ---------------- +"RTN","TMGFMUT",373,0) + ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG(" +"RTN","TMGFMUT",374,0) + ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG(" +"RTN","TMGFMUT",375,0) + +"RTN","TMGFMUT",376,0) + new File,Array,result +"RTN","TMGFMUT",377,0) + set PFn=$get(PFn) +"RTN","TMGFMUT",378,0) + new Itr,File +"RTN","TMGFMUT",379,0) + +"RTN","TMGFMUT",380,0) + ;"Cycle through all files to be changed. +"RTN","TMGFMUT",381,0) + set File=$$ItrAInit^TMGITR("Info",.Itr) +"RTN","TMGFMUT",382,0) + if File'="" for do quit:($$ItrANext^TMGITR(.Itr,.File)="") +"RTN","TMGFMUT",383,0) + . new PossPtrs +"RTN","TMGFMUT",384,0) + . if +File'=File set File=$$GetFileNum^TMGDBAPI(File) ;Convert File Name to File Number +"RTN","TMGFMUT",385,0) + . ;"Get list of files/fields with pointers in +"RTN","TMGFMUT",386,0) + . set result=$$PossPtrs(File,.PossPtrs) if result=0 quit +"RTN","TMGFMUT",387,0) + . if $data(PossPtrs)'>0 quit +"RTN","TMGFMUT",388,0) + . kill ^UTILITY("DIT",$J) +"RTN","TMGFMUT",389,0) + . new fromIEN,toIEN,fromItr +"RTN","TMGFMUT",390,0) + . set fromIEN=+$$ItrAInit^TMGITR($name(Info(File)),.fromItr) +"RTN","TMGFMUT",391,0) + . new done2 set done2=0 +"RTN","TMGFMUT",392,0) + . ;"Cycle through all records to be changed. +"RTN","TMGFMUT",393,0) + . if fromIEN'=0 for do quit:(+$$ItrANext^TMGITR(.fromItr,.fromIEN)=0)!(done2=1) +"RTN","TMGFMUT",394,0) + . . set toIEN=$get(Info(File,fromIEN)) +"RTN","TMGFMUT",395,0) + . . set result=$$PtrsIn(File,fromIEN,.Array,PFn) if result=0 set done2=1 +"RTN","TMGFMUT",396,0) + . . do Prep4FM(.Array) +"RTN","TMGFMUT",397,0) + . if $data(^UTILITY("DIT",$J))=0 quit +"RTN","TMGFMUT",398,0) + . merge ^UTILITY("DIT",$J,0)=PossPtrs +"RTN","TMGFMUT",399,0) + . do PTS^DITP ;"Note: call separately for each file specified. +"RTN","TMGFMUT",400,0) + +"RTN","TMGFMUT",401,0) +QMPTDone +"RTN","TMGFMUT",402,0) + quit +"RTN","TMGFMUT",403,0) + +"RTN","TMGFMUT",404,0) + +"RTN","TMGFMUT",405,0) +QTMMVPTR(Info,ShowProgress) ;"NOTE: this function hasn't been debugged/tested yet +"RTN","TMGFMUT",406,0) + ;"Purpose: An interface to quietly redirect multiple pointer. +"RTN","TMGFMUT",407,0) + ;"NOTE: This functions differes from QTMVPTR in that it can look for all IEN's +"RTN","TMGFMUT",408,0) + ;" for a given file at once, speeding database access. +"RTN","TMGFMUT",409,0) + ;"Input: Info, an array containing info for redirecting pointers. +"RTN","TMGFMUT",410,0) + ;" Format: Note: File can be file name or number. +"RTN","TMGFMUT",411,0) + ;" Info(File,OldIEN)=newIEN +"RTN","TMGFMUT",412,0) + ;" Info(File,OldIEN)=newIEN1 +"RTN","TMGFMUT",413,0) + ;" Info(File,OldIEN)=newIEN +"RTN","TMGFMUT",414,0) + ;" ShowProgress: if 1, progress bar shown +"RTN","TMGFMUT",415,0) + ;"Output: all pointers in linked files to OldIEN will be changed to newIEN +"RTN","TMGFMUT",416,0) + ;"Results: none +"RTN","TMGFMUT",417,0) + +"RTN","TMGFMUT",418,0) + ;"Note: Example of array passed to P^DITP +"RTN","TMGFMUT",419,0) + ;" 23510 is $J +"RTN","TMGFMUT",420,0) + ;" 47 is IEN to be deleted in file 50 (stored at ^PSDRUG(*)) +"RTN","TMGFMUT",421,0) + ;" 1646 is IEN to be substituted for all 47's +"RTN","TMGFMUT",422,0) + ;" +"RTN","TMGFMUT",423,0) + ;" First part of array is list of all files & fields that point to file +"RTN","TMGFMUT",424,0) + ;" ---------------- +"RTN","TMGFMUT",425,0) + ;" ^UTILITY("DIT",23510,0,1)="727.819^67^P50'" +"RTN","TMGFMUT",426,0) + ;" ... +"RTN","TMGFMUT",427,0) + ;" ^UTILITY("DIT",23510,0,54)="801.43^.02^RV" +"RTN","TMGFMUT",428,0) + ;" ^UTILITY("DIT",23510,0,55)="810.31^.04^V" +"RTN","TMGFMUT",429,0) + ;" ^UTILITY("DIT",23510,0,56)="810.32^.01^V" +"RTN","TMGFMUT",430,0) + ;" ^UTILITY("DIT",23510,0,57)="811.52^.01^MVX" +"RTN","TMGFMUT",431,0) + ;" ^UTILITY("DIT",23510,0,58)="811.902^.01^MVX" +"RTN","TMGFMUT",432,0) + ;" ^UTILITY("DIT",23510,0,59)="9009032.4^.05^P50'" +"RTN","TMGFMUT",433,0) + ;" +"RTN","TMGFMUT",434,0) + ;" Second part of array is list of changes that should be made. Only 1 change shown here. +"RTN","TMGFMUT",435,0) + ;" ---------------- +"RTN","TMGFMUT",436,0) + ;" ^UTILITY("DIT",23510,47)="1646;PSDRUG(" +"RTN","TMGFMUT",437,0) + ;" ^UTILITY("DIT",23510,"47;PSDRUG(")="1646;PSDRUG(" +"RTN","TMGFMUT",438,0) + +"RTN","TMGFMUT",439,0) + new ToFile,Array,result +"RTN","TMGFMUT",440,0) + set PFn=$get(PFn) +"RTN","TMGFMUT",441,0) + new Itr +"RTN","TMGFMUT",442,0) + +"RTN","TMGFMUT",443,0) + ;"Cycle through all files to be changed. +"RTN","TMGFMUT",444,0) + set ToFile=$$ItrAInit^TMGITR("Info",.Itr) +"RTN","TMGFMUT",445,0) + if ToFile'="" for do quit:($$ItrANext^TMGITR(.Itr,.ToFile)="") +"RTN","TMGFMUT",446,0) + . new PossPtrs +"RTN","TMGFMUT",447,0) + . if +ToFile'=ToFile set ToFile=$$GetFileNum^TMGDBAPI(ToFile) ;"Convert File Name to File Number +"RTN","TMGFMUT",448,0) + . ;"Get list of files/fields with pointers in +"RTN","TMGFMUT",449,0) + . set result=$$PossPtrs(ToFile,.PossPtrs) if result=0 quit +"RTN","TMGFMUT",450,0) + . if $data(PossPtrs)'>0 quit +"RTN","TMGFMUT",451,0) + . kill ^UTILITY("DIT",$J) +"RTN","TMGFMUT",452,0) + . ;"new fromIEN,toIEN,fromItr +"RTN","TMGFMUT",453,0) + . ;"set fromIEN=+$$ItrAInit^TMGITR($name(Info(ToFile)),.fromItr) +"RTN","TMGFMUT",454,0) + . new IENArray set IENArray=ToFile +"RTN","TMGFMUT",455,0) + . merge IENArray=Info(ToFile) +"RTN","TMGFMUT",456,0) + . set IENArray=ToFile +"RTN","TMGFMUT",457,0) + . set result=$$PtrsMIn(.IENArray,.Array,.ShowProgress) +"RTN","TMGFMUT",458,0) + . new toFile2,toIEN,fromFile,fromIEN,Array2 +"RTN","TMGFMUT",459,0) + . set toFile2="" +"RTN","TMGFMUT",460,0) + . for set toFile2=$order(Array(toFile2)) quit:(toFile2="") do +"RTN","TMGFMUT",461,0) + . . set toIEN="" +"RTN","TMGFMUT",462,0) + . . for set toIEN=$order(Array(toFile2,toIEN)) quit:(toIEN="") do +"RTN","TMGFMUT",463,0) + . . . set fromFile="" +"RTN","TMGFMUT",464,0) + . . . for set fromFile=$order(Array(toFile2,toIEN,fromFile)) quit:(fromFile="") do +"RTN","TMGFMUT",465,0) + . . . . set fromIEN="" +"RTN","TMGFMUT",466,0) + . . . . for set fromIEN=$order(Array(toFile2,toIEN,fromFile,fromIEN)) quit:(fromIEN="") do +"RTN","TMGFMUT",467,0) + . . . . . merge Array2(fromFile,fromIEN)=Array(toFile2,toIEN,fromFile,fromIEN) +"RTN","TMGFMUT",468,0) + . set toFile2="" +"RTN","TMGFMUT",469,0) + . for set toFile2=$order(Array2(toFile2)) quit:(toFile2="") do +"RTN","TMGFMUT",470,0) + . . do MPrep4FM(toFile2,.Array2) +"RTN","TMGFMUT",471,0) + . . if $data(^UTILITY("DIT",$J))=0 quit +"RTN","TMGFMUT",472,0) + . . merge ^UTILITY("DIT",$J,0)=PossPtrs +"RTN","TMGFMUT",473,0) + . . do PTS^DITP ;"Note: call separately for each file specified. +"RTN","TMGFMUT",474,0) + +"RTN","TMGFMUT",475,0) +QMMPTDone +"RTN","TMGFMUT",476,0) + quit +"RTN","TMGFMUT",477,0) + +"RTN","TMGFMUT",478,0) + +"RTN","TMGFMUT",479,0) +Prep4FM(Array) +"RTN","TMGFMUT",480,0) + ;"Purpose: to convert Array with redirection info into format for Fileman +"RTN","TMGFMUT",481,0) + ;"Input: Array -- PASS BY REFERENCE. An array as created by PtrsIn() +"RTN","TMGFMUT",482,0) + ;"Output: Data will be put into ^UTILITY('DIT',$J) +"RTN","TMGFMUT",483,0) + ;"Results: none +"RTN","TMGFMUT",484,0) + +"RTN","TMGFMUT",485,0) + ;"Now convert to FileMan Format. +"RTN","TMGFMUT",486,0) + new iFile,iIEN,count,index,toRef +"RTN","TMGFMUT",487,0) + set iFile=$order(Array("")) +"RTN","TMGFMUT",488,0) + if +iFile'=0 for do quit:(+iFile=0) +"RTN","TMGFMUT",489,0) + . set iIEN=$order(Array(iFile,"")) +"RTN","TMGFMUT",490,0) + . if +iIEN'=0 for do quit:(+iIEN=0) +"RTN","TMGFMUT",491,0) + . . set count=+$get(Array(iFile,iIEN,0)) +"RTN","TMGFMUT",492,0) + . . for index=1:1:count do +"RTN","TMGFMUT",493,0) + . . . set toRef=$piece($get(Array(iFile,iIEN,count)),";",4) +"RTN","TMGFMUT",494,0) + . . . set toRef=$extract(toRef,2,999) +"RTN","TMGFMUT",495,0) + . . . set ^UTILITY("DIT",$J,fromIEN)=toIEN_";"_toRef +"RTN","TMGFMUT",496,0) + . . . set ^UTILITY("DIT",$J,""_fromIEN_";"_toRef_"")=""_toIEN_";"_toRef_"" +"RTN","TMGFMUT",497,0) + . . set iIEN=$order(Array(iFile,iIEN)) +"RTN","TMGFMUT",498,0) + . set iFile=$order(Array(iFile)) +"RTN","TMGFMUT",499,0) + +"RTN","TMGFMUT",500,0) + quit +"RTN","TMGFMUT",501,0) + +"RTN","TMGFMUT",502,0) + +"RTN","TMGFMUT",503,0) +MPrep4FM(fromFile,Array) +"RTN","TMGFMUT",504,0) + ;"Purpose: to convert Array with redirection info into format for Fileman +"RTN","TMGFMUT",505,0) + ;"Input: fromFile -- the FromFileNum -- Note: should be called once for +"RTN","TMGFMUT",506,0) + ;" each File number +"RTN","TMGFMUT",507,0) + ;" Array -- PASS BY REFERENCE. An array as created by PtrsMIn() +"RTN","TMGFMUT",508,0) + ;" Array(FromFile#,fromIEN,0)=LastCount +"RTN","TMGFMUT",509,0) + ;" Array(FromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",510,0) + ;"Output: Data will be put into ^UTILITY('DIT',$J) +"RTN","TMGFMUT",511,0) + ;"Results: none +"RTN","TMGFMUT",512,0) + +"RTN","TMGFMUT",513,0) + ;"Now convert to FileMan Format. +"RTN","TMGFMUT",514,0) + new fromIEN set fromIEN="" +"RTN","TMGFMUT",515,0) + for set fromIEN=$order(Array(fromFile,fromIEN)) quit:(+fromIEN'>0) do +"RTN","TMGFMUT",516,0) + . new count +"RTN","TMGFMUT",517,0) + . set count=+$get(Array(fromFile,fromIEN,0)) +"RTN","TMGFMUT",518,0) + . new index for index=1:1:count do +"RTN","TMGFMUT",519,0) + . . new toRef +"RTN","TMGFMUT",520,0) + . . set toRef=$piece($get(Array(fromFile,fromIEN,count)),";",4) +"RTN","TMGFMUT",521,0) + . . set toRef=$extract(toRef,2,999) +"RTN","TMGFMUT",522,0) + . . set ^UTILITY("DIT",$J,fromIEN)=toIEN_";"_toRef +"RTN","TMGFMUT",523,0) + . . set ^UTILITY("DIT",$J,""_fromIEN_";"_toRef_"")=""_toIEN_";"_toRef_"" +"RTN","TMGFMUT",524,0) + +"RTN","TMGFMUT",525,0) + quit +"RTN","TMGFMUT",526,0) + +"RTN","TMGFMUT",527,0) + +"RTN","TMGFMUT",528,0) +PtrsIn(File,IEN,Array,PrgsFn) +"RTN","TMGFMUT",529,0) + ;"SCOPE: PUBLIC +"RTN","TMGFMUT",530,0) + ;"Purpose: Create a list of incoming pointers to a given record in given file +"RTN","TMGFMUT",531,0) + ;"Input: File: The file to investigate (Number or Name) +"RTN","TMGFMUT",532,0) + ;" IEN: IEN of record to +"RTN","TMGFMUT",533,0) + ;" Array -- PASS BY REFERENCE. An array to receive results back. +"RTN","TMGFMUT",534,0) + ;" any prexisting data in Array is killed before filling +"RTN","TMGFMUT",535,0) + ;" PrgsFn: OPTIONAL -- +"RTN","TMGFMUT",536,0) + ;" because this search process can be quite lengthy, +"RTN","TMGFMUT",537,0) + ;" an optional line of M code may be given here that will be executed +"RTN","TMGFMUT",538,0) + ;" before each file is scanned. The following variables will be defined: +"RTN","TMGFMUT",539,0) + ;" TMGCODE -- will hold code of current file being scanned. +"RTN","TMGFMUT",540,0) + ;" TMGTOTAL -- will hold total number of records to scan +"RTN","TMGFMUT",541,0) + ;" TMGCUR -- will hold count of current record being scanned. +"RTN","TMGFMUT",542,0) + ;"Output: Array is filled with format as follows: +"RTN","TMGFMUT",543,0) + ;" Array(File#,IEN,0)=LastCount +"RTN","TMGFMUT",544,0) + ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",545,0) + ;" Description of parts: +"RTN","TMGFMUT",546,0) + ;" ---------------------- +"RTN","TMGFMUT",547,0) + ;" File# -- the file the found entry exists it (may be a subfile number) +"RTN","TMGFMUT",548,0) + ;" IEN -- the record number in file +"RTN","TMGFMUT",549,0) + ;" Note: IEN here is different from the IEN passed in as a parameter +"RTN","TMGFMUT",550,0) + ;" FullRef -- the is the full reference to the found value. e.g. +"RTN","TMGFMUT",551,0) + ;" set value=$piece(@FullRef,"^",piece) +"RTN","TMGFMUT",552,0) + ;" piece -- the piece where value is stored in the node that is specified by FullRef +"RTN","TMGFMUT",553,0) + ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls +"RTN","TMGFMUT",554,0) + ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then +"RTN","TMGFMUT",555,0) + ;" this is the global reference of the parent file (or the highest grandparent file if +"RTN","TMGFMUT",556,0) + ;" the parent file itself is a subfile, etc.) +"RTN","TMGFMUT",557,0) + ;" +"RTN","TMGFMUT",558,0) + ;"Result: 1 if results found, 0 if error occurred. +"RTN","TMGFMUT",559,0) + ;"NOTE: This function manually scans through potentially HUGE numbers of records-->BE PATIENT! +"RTN","TMGFMUT",560,0) + +"RTN","TMGFMUT",561,0) + kill Array +"RTN","TMGFMUT",562,0) + new result set result=0 +"RTN","TMGFMUT",563,0) + new FileNum +"RTN","TMGFMUT",564,0) + set IEN=+$get(IEN) +"RTN","TMGFMUT",565,0) + if IEN=0 goto FPIDone ;"NOTE: IEN doesn't have to point to a valid record. +"RTN","TMGFMUT",566,0) + if $data(File)#10=0 goto FPIDone +"RTN","TMGFMUT",567,0) + if +File=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number +"RTN","TMGFMUT",568,0) + else set FileNum=File +"RTN","TMGFMUT",569,0) + if +FileNum=0 goto FPIDone +"RTN","TMGFMUT",570,0) + +"RTN","TMGFMUT",571,0) + new PossArray,TMGCODE +"RTN","TMGFMUT",572,0) + if $$PossPtrs(File,.PossArray)=0 goto FPIDone +"RTN","TMGFMUT",573,0) + +"RTN","TMGFMUT",574,0) + ;"Count number of records to scan +"RTN","TMGFMUT",575,0) + new TMGCUR set TMGCUR=0 +"RTN","TMGFMUT",576,0) + new TMGTOTAL set TMGTOTAL=0 +"RTN","TMGFMUT",577,0) + do +"RTN","TMGFMUT",578,0) + . new temp set temp=$order(PossArray("")) +"RTN","TMGFMUT",579,0) + . if temp'="" for do quit:(temp="") +"RTN","TMGFMUT",580,0) + . . new code set code=PossArray(temp) +"RTN","TMGFMUT",581,0) + . . new ref set ref=$get(^DIC(+code,0,"GL")) +"RTN","TMGFMUT",582,0) + . . set ref=$$CREF^DILF(ref) ;"convert open to closed format +"RTN","TMGFMUT",583,0) + . . new NumRecs +"RTN","TMGFMUT",584,0) + . . if ref'="" set NumRecs=+$piece(@ref@(0),"^",4) +"RTN","TMGFMUT",585,0) + . . else set NumRecs=10000 ;"some arbitrary guess of #recs in a subfile +"RTN","TMGFMUT",586,0) + . . set TMGTOTAL=TMGTOTAL+1 +"RTN","TMGFMUT",587,0) + . . set TMGTOTAL(TMGTOTAL)=NumRecs +"RTN","TMGFMUT",588,0) + . . set temp=$order(PossArray(temp)) +"RTN","TMGFMUT",589,0) + . set temp=$order(TMGTOTAL("")) +"RTN","TMGFMUT",590,0) + . set TMGTOTAL=1 +"RTN","TMGFMUT",591,0) + . if temp'="" for do quit:(temp="") +"RTN","TMGFMUT",592,0) + . . set TMGTOTAL=TMGTOTAL+TMGTOTAL(temp) +"RTN","TMGFMUT",593,0) + . . set temp=$order(TMGTOTAL(temp)) +"RTN","TMGFMUT",594,0) + . if TMGTOTAL=0 set TMGTOTAL=1 ;"avoid div by zero issues. +"RTN","TMGFMUT",595,0) + +"RTN","TMGFMUT",596,0) + new count set count=1 +"RTN","TMGFMUT",597,0) + new index set index=$order(PossArray("")) +"RTN","TMGFMUT",598,0) + if index'="" for do quit:(index="") +"RTN","TMGFMUT",599,0) + . set TMGCUR=TMGCUR+TMGTOTAL(count) +"RTN","TMGFMUT",600,0) + . set count=count+1 +"RTN","TMGFMUT",601,0) + . set TMGCODE=PossArray(index) +"RTN","TMGFMUT",602,0) + . if $get(PrgsFn)'="" do +"RTN","TMGFMUT",603,0) + . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGFMUT",604,0) + . . xecute PrgsFn +"RTN","TMGFMUT",605,0) + . do ScanFile(TMGCODE,IEN,.Array) +"RTN","TMGFMUT",606,0) + . set index=$order(PossArray(index)) +"RTN","TMGFMUT",607,0) + +"RTN","TMGFMUT",608,0) + set result=1 +"RTN","TMGFMUT",609,0) +FPIDone +"RTN","TMGFMUT",610,0) + quit result +"RTN","TMGFMUT",611,0) + +"RTN","TMGFMUT",612,0) + +"RTN","TMGFMUT",613,0) +PtrsMIn(IENArray,Array,ShowProgress) +"RTN","TMGFMUT",614,0) + ;"SCOPE: PUBLIC +"RTN","TMGFMUT",615,0) + ;"Purpose: Create a list of incoming pointers to an array of records in given file +"RTN","TMGFMUT",616,0) + ;"NOTE: this function differes from PtrsIn because is allows multiple input IEN's +"RTN","TMGFMUT",617,0) + ;"Input: IENArray: PASS BY REFERENCE. Array of IENs of record in ToFile. Format: +"RTN","TMGFMUT",618,0) + ;" IENArray=SourceFile# +"RTN","TMGFMUT",619,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",620,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",621,0) + ;" Array -- PASS BY REFERENCE. An array to receive results back. Format below. +"RTN","TMGFMUT",622,0) + ;" any prexisting data in Array is killed before filling +"RTN","TMGFMUT",623,0) + ;" ShowProgress: if 1, progress bar shown +"RTN","TMGFMUT",624,0) + ;"Output: Array is filled with format as follows: +"RTN","TMGFMUT",625,0) + ;" Array(ToFile#,ToIEN,FromFile#,fromIEN,0)=LastCount +"RTN","TMGFMUT",626,0) + ;" Array(ToFile#,ToIEN,FromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",627,0) + ;" Description of parts: +"RTN","TMGFMUT",628,0) + ;" ---------------------- +"RTN","TMGFMUT",629,0) + ;" ToFile# -- the file containing the target IEN record +"RTN","TMGFMUT",630,0) + ;" ToIEN --the IEN in ToFile +"RTN","TMGFMUT",631,0) + ;" FromFile# -- the file the found entry exists it (may be a subfile number) +"RTN","TMGFMUT",632,0) + ;" fromIEN -- the record number in file +"RTN","TMGFMUT",633,0) + ;" Note: IEN here is different from the IEN passed in as a parameter +"RTN","TMGFMUT",634,0) + ;" FullRef -- the is the full reference to the found value. e.g. +"RTN","TMGFMUT",635,0) + ;" set value=$piece(@FullRef,"^",piece) +"RTN","TMGFMUT",636,0) + ;" piece -- the piece where value is stored in the node that is specified by FullRef +"RTN","TMGFMUT",637,0) + ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls +"RTN","TMGFMUT",638,0) + ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then +"RTN","TMGFMUT",639,0) + ;" this is the global reference of the parent file (or the highest grandparent file if +"RTN","TMGFMUT",640,0) + ;" the parent file itself is a subfile, etc.) +"RTN","TMGFMUT",641,0) + ;" +"RTN","TMGFMUT",642,0) + ;"Result: 1 if results found, 0 if error occurred. +"RTN","TMGFMUT",643,0) + ;"NOTE: This function manually scans through potentially HUGE numbers of records-->BE PATIENT! +"RTN","TMGFMUT",644,0) + +"RTN","TMGFMUT",645,0) + kill Array +"RTN","TMGFMUT",646,0) + new result set result=0 +"RTN","TMGFMUT",647,0) + new FileNum +"RTN","TMGFMUT",648,0) + set ToFile=$get(IENArray) if ToFile="" goto FMPIDone +"RTN","TMGFMUT",649,0) + if +ToFile=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number +"RTN","TMGFMUT",650,0) + else set FileNum=ToFile +"RTN","TMGFMUT",651,0) + if +FileNum=0 goto FMPIDone +"RTN","TMGFMUT",652,0) + +"RTN","TMGFMUT",653,0) + new PossArray +"RTN","TMGFMUT",654,0) + if $$PossPtrs(FileNum,.PossArray)=0 goto FMPIDone +"RTN","TMGFMUT",655,0) + +"RTN","TMGFMUT",656,0) + new FInfoArray +"RTN","TMGFMUT",657,0) + new index set index="" +"RTN","TMGFMUT",658,0) + for set index=$order(PossArray(index)) quit:(index="") do +"RTN","TMGFMUT",659,0) + . new tempS set tempS=$get(PossArray(index)) +"RTN","TMGFMUT",660,0) + . new fromFile set fromFile=$piece(tempS,"^",1) +"RTN","TMGFMUT",661,0) + . new fromField set fromField=$piece(tempS,"^",2) +"RTN","TMGFMUT",662,0) + . new fldCode set fldCode=$piece(tempS,"^",3) +"RTN","TMGFMUT",663,0) + . set FInfoArray(fromFile,fromField)=fldCode +"RTN","TMGFMUT",664,0) + +"RTN","TMGFMUT",665,0) + do ScanMFile(.FInfoArray,.IENArray,.Array,.ShowProgress) +"RTN","TMGFMUT",666,0) + +"RTN","TMGFMUT",667,0) + set result=1 +"RTN","TMGFMUT",668,0) +FMPIDone +"RTN","TMGFMUT",669,0) + quit result +"RTN","TMGFMUT",670,0) + +"RTN","TMGFMUT",671,0) + +"RTN","TMGFMUT",672,0) +ScanFile(FInfo,IEN,Array) +"RTN","TMGFMUT",673,0) + ;"SCOPE: PUBLIC +"RTN","TMGFMUT",674,0) + ;"Purpose: To scan one file (from array setup by PossPtrs) for actual pointers to IEN +"RTN","TMGFMUT",675,0) + ;"Input: FInfo : OtherFile#^Field#^FieldCode(piece#2 of 0 node of ^DD entry for field) +"RTN","TMGFMUT",676,0) + ;"Examples of possible inputs follow: +"RTN","TMGFMUT",677,0) + ;"50^62.05^*P50'" +"RTN","TMGFMUT",678,0) + ;"695^.01^RP50'" +"RTN","TMGFMUT",679,0) + ;"801.43^.02^RV" +"RTN","TMGFMUT",680,0) + ;"810.31^.04^V" +"RTN","TMGFMUT",681,0) + ;"811.902^.01^MVX" +"RTN","TMGFMUT",682,0) + +"RTN","TMGFMUT",683,0) + ;"NOTE: Idea for future enhancement: Allow FInfo to hold a list rather than just one value. +"RTN","TMGFMUT",684,0) + ;" This would be for instances where multiple fields in given record need to be searched +"RTN","TMGFMUT",685,0) + ;" This might speed up database access times. +"RTN","TMGFMUT",686,0) + +"RTN","TMGFMUT",687,0) + ;" IEN : the IEN that pointers should point to, to be considered a match. +"RTN","TMGFMUT",688,0) + ;" Array : PASS BY REFERENCE. An array to receive results. +"RTN","TMGFMUT",689,0) + ;"Output: Format of Array output: +"RTN","TMGFMUT",690,0) + ;" Array(File#,IEN,0)=LastCount +"RTN","TMGFMUT",691,0) + ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",692,0) + ;" Description of parts: +"RTN","TMGFMUT",693,0) + ;" ---------------------- +"RTN","TMGFMUT",694,0) + ;" File# -- the file the found entry exists it (may be a subfile number) +"RTN","TMGFMUT",695,0) + ;" IEN -- the record number in file +"RTN","TMGFMUT",696,0) + ;" Note: IEN here is different from the IEN passed in as a parameter +"RTN","TMGFMUT",697,0) + ;" FullRef -- the is the full reference to the found value. e.g. +"RTN","TMGFMUT",698,0) + ;" set value=$piece(@FullRef,"^",piece) +"RTN","TMGFMUT",699,0) + ;" piece -- the piece where value is stored in the node that is specified by FullRef +"RTN","TMGFMUT",700,0) + ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls +"RTN","TMGFMUT",701,0) + ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then +"RTN","TMGFMUT",702,0) + ;" this is the global reference of the parent file (or the highest grandparent file if +"RTN","TMGFMUT",703,0) + ;" the parent file itself is a subfile, etc.) +"RTN","TMGFMUT",704,0) + ;" +"RTN","TMGFMUT",705,0) + ;"result : none +"RTN","TMGFMUT",706,0) + +"RTN","TMGFMUT",707,0) + new File set File=$piece(FInfo,"^",1) if File="" goto SFDone +"RTN","TMGFMUT",708,0) + new Field set Field=$piece(FInfo,"^",2) if Field="" goto SFDone +"RTN","TMGFMUT",709,0) + new Code set Code=$piece(FInfo,"^",3) if Code="" goto SFDone +"RTN","TMGFMUT",710,0) + new count +"RTN","TMGFMUT",711,0) + if '((Code["P")!(Code["V")) goto SFDone +"RTN","TMGFMUT",712,0) + new GRef +"RTN","TMGFMUT",713,0) + new znode set znode=$get(^DD(File,Field,0)) +"RTN","TMGFMUT",714,0) + new loc set loc=$piece(znode,"^",4) +"RTN","TMGFMUT",715,0) + new node set node=$piece(loc,";",1) +"RTN","TMGFMUT",716,0) + new pce set pce=$piece(loc,";",2) +"RTN","TMGFMUT",717,0) + if +$$IsSubFile^TMGDBAPI(File) do +"RTN","TMGFMUT",718,0) + . new FileArray,i,k,FNum,SubInfo +"RTN","TMGFMUT",719,0) + . set i=0 +"RTN","TMGFMUT",720,0) + . set FileArray(0)=0 +"RTN","TMGFMUT",721,0) + . set FileArray(i,"PARENT","LOC")=loc +"RTN","TMGFMUT",722,0) + . set FNum=File +"RTN","TMGFMUT",723,0) + . for do quit:(+FNum=0) ;"setup array describing subfile's inheritence +"RTN","TMGFMUT",724,0) + . . set i=i+1 +"RTN","TMGFMUT",725,0) + . . set FileArray(i)=FNum +"RTN","TMGFMUT",726,0) + . . if i=1 set FileArray(0,"FILE")=FNum +"RTN","TMGFMUT",727,0) + . . if $$GetSubFInfo^TMGDBAPI(FNum,.SubInfo) do +"RTN","TMGFMUT",728,0) + . . . set FileArray(i,"PARENT","LOC")=SubInfo("FIELD IN PARENT","LOC") +"RTN","TMGFMUT",729,0) + . . . set GRef=$get(SubInfo("PARENT","GL")) ;"<-- only valid for highest ancestor +"RTN","TMGFMUT",730,0) + . . else do +"RTN","TMGFMUT",731,0) + . . . set (FileArray(0,"TOP GL"),FileArray(i,"PARENT","GL"))=$get(^DIC(FNum,0,"GL")) +"RTN","TMGFMUT",732,0) + . . set FNum=$$IsSubFile^TMGDBAPI(FNum) +"RTN","TMGFMUT",733,0) + . do HandleSubFile(IEN,.FileArray,.Array) +"RTN","TMGFMUT",734,0) + else do +"RTN","TMGFMUT",735,0) + . set GRef=$get(^DIC(File,0,"GL")) +"RTN","TMGFMUT",736,0) + . new ORef set ORef=GRef +"RTN","TMGFMUT",737,0) + . set GRef=$$CREF^DILF(GRef) ;"convert open to closed format +"RTN","TMGFMUT",738,0) + . new index set index=$order(@GRef@(0)) +"RTN","TMGFMUT",739,0) + . if index'="" for do quit:(index="") +"RTN","TMGFMUT",740,0) + . . new value set value=$get(@GRef@(index,node)) +"RTN","TMGFMUT",741,0) + . . if $piece(value,"^",pce)=IEN do +"RTN","TMGFMUT",742,0) + . . . set Array(File,index,0)=1 +"RTN","TMGFMUT",743,0) + . . . set Array(File,index,1)=$name(@GRef@(index,node))_";"_pce_";"_""_";"_ORef +"RTN","TMGFMUT",744,0) + . . set index=$order(@GRef@(index)) +"RTN","TMGFMUT",745,0) + +"RTN","TMGFMUT",746,0) +SFDone +"RTN","TMGFMUT",747,0) + quit +"RTN","TMGFMUT",748,0) + +"RTN","TMGFMUT",749,0) + +"RTN","TMGFMUT",750,0) +ScanMFile(FInfoArray,IENArray,Array,ShowProgress) +"RTN","TMGFMUT",751,0) + ;"SCOPE: PUBLIC +"RTN","TMGFMUT",752,0) + ;"Purpose: To scan multiple file (from array setup by PossPtrs) for actual pointers to IENs +"RTN","TMGFMUT",753,0) + ;"Input: FInfoArray : PASS BY REFERENCE. Format: +"RTN","TMGFMUT",754,0) + ;" FInfoArray(OtherFile,Field)=FieldCode(piece#2 of 0 node of ^DD entry for field) +"RTN","TMGFMUT",755,0) + ;" Examples of possible inputs follow: +"RTN","TMGFMUT",756,0) + ;" FInfoArray(50,62.05)="*P50'" +"RTN","TMGFMUT",757,0) + ;" FInfoArray(695,.01)="RP50'" +"RTN","TMGFMUT",758,0) + ;" FInfoArray(801.43,.02)="RV" +"RTN","TMGFMUT",759,0) + ;" FInfoArray(810.31,.04)="V" +"RTN","TMGFMUT",760,0) + ;" FInfoArray(811.902,.01)="MVX" +"RTN","TMGFMUT",761,0) + ;" IENArray : PASS BY REFERENCE. IEN's that pointers should point TO, to be considered a match. +"RTN","TMGFMUT",762,0) + ;" Format: IENArray=SourceFile +"RTN","TMGFMUT",763,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",764,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",765,0) + ;" Array : PASS BY REFERENCE. AN OUT PARAMETER. Format: +"RTN","TMGFMUT",766,0) + ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,0)=LastCount +"RTN","TMGFMUT",767,0) + ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",768,0) + ;" Description of parts: +"RTN","TMGFMUT",769,0) + ;" ---------------------- +"RTN","TMGFMUT",770,0) + ;" ToFile# -- the file containing the target IEN record +"RTN","TMGFMUT",771,0) + ;" ToIEN --the IEN in ToFile +"RTN","TMGFMUT",772,0) + ;" fromFile# -- the file the found entry exists it (may be a subfile number) +"RTN","TMGFMUT",773,0) + ;" fromIEN -- the record number in file +"RTN","TMGFMUT",774,0) + ;" Note: IEN here is different from the IEN passed in as a parameter +"RTN","TMGFMUT",775,0) + ;" FullRef -- the is the full reference to the found value. e.g. +"RTN","TMGFMUT",776,0) + ;" set value=$piece(@FullRef,"^",piece) +"RTN","TMGFMUT",777,0) + ;" piece -- the piece where value is stored in the node that is specified by FullRef +"RTN","TMGFMUT",778,0) + ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls +"RTN","TMGFMUT",779,0) + ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then +"RTN","TMGFMUT",780,0) + ;" this is the global reference of the parent file (or the highest grandparent file if +"RTN","TMGFMUT",781,0) + ;" the parent file itself is a subfile, etc.) +"RTN","TMGFMUT",782,0) + ;" ShowProgress: if 1, progress bar shown +"RTN","TMGFMUT",783,0) + ;" +"RTN","TMGFMUT",784,0) + ;"result : none +"RTN","TMGFMUT",785,0) + +"RTN","TMGFMUT",786,0) + new ToFile set ToFile=+$get(IENArray) +"RTN","TMGFMUT",787,0) + set ShowProgress=$get(ShowProgress,0) +"RTN","TMGFMUT",788,0) + new abort set abort=0 +"RTN","TMGFMUT",789,0) + set fromFile="" +"RTN","TMGFMUT",790,0) + for set fromFile=$order(FInfoArray(fromFile)) quit:(fromFile="")!abort do +"RTN","TMGFMUT",791,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGFMUT",792,0) + . write !,"Processing File#: ",fromFile,! +"RTN","TMGFMUT",793,0) + . new Field set Field="" +"RTN","TMGFMUT",794,0) + . for set Field=$order(FInfoArray(fromFile,Field)) quit:(Field="") do +"RTN","TMGFMUT",795,0) + . . write " Field#: ",Field,! +"RTN","TMGFMUT",796,0) + . . new Code set Code=$get(FInfoArray(fromFile,Field)) if Code="" quit +"RTN","TMGFMUT",797,0) + . . new count +"RTN","TMGFMUT",798,0) + . . if '((Code["P")!(Code["V")) goto SFDone +"RTN","TMGFMUT",799,0) + . . new GRef +"RTN","TMGFMUT",800,0) + . . new znode set znode=$get(^DD(fromFile,Field,0)) +"RTN","TMGFMUT",801,0) + . . new loc set loc=$piece(znode,"^",4) +"RTN","TMGFMUT",802,0) + . . new node set node=$piece(loc,";",1) +"RTN","TMGFMUT",803,0) + . . new pce set pce=$piece(loc,";",2) +"RTN","TMGFMUT",804,0) + . . if +$$IsSubFile^TMGDBAPI(fromFile) do +"RTN","TMGFMUT",805,0) + . . . new FileArray,i,k,FNum,SubInfo +"RTN","TMGFMUT",806,0) + . . . set i=0 +"RTN","TMGFMUT",807,0) + . . . set FileArray(0)=0 +"RTN","TMGFMUT",808,0) + . . . set FileArray(i,"PARENT","LOC")=loc +"RTN","TMGFMUT",809,0) + . . . set FNum=fromFile +"RTN","TMGFMUT",810,0) + . . . for do quit:(+FNum=0) ;"setup array describing subfile's inheritence +"RTN","TMGFMUT",811,0) + . . . . set i=i+1 +"RTN","TMGFMUT",812,0) + . . . . set FileArray(i)=FNum +"RTN","TMGFMUT",813,0) + . . . . if i=1 set FileArray(0,"FILE")=FNum +"RTN","TMGFMUT",814,0) + . . . . if $$GetSubFInfo^TMGDBAPI(FNum,.SubInfo) do +"RTN","TMGFMUT",815,0) + . . . . . set FileArray(i,"PARENT","LOC")=SubInfo("FIELD IN PARENT","LOC") +"RTN","TMGFMUT",816,0) + . . . . . set GRef=$get(SubInfo("PARENT","GL")) ;"<-- only valid for highest ancestor +"RTN","TMGFMUT",817,0) + . . . . else do +"RTN","TMGFMUT",818,0) + . . . . . set (FileArray(0,"TOP GL"),FileArray(i,"PARENT","GL"))=$get(^DIC(FNum,0,"GL")) +"RTN","TMGFMUT",819,0) + . . . . set FNum=$$IsSubFile^TMGDBAPI(FNum) +"RTN","TMGFMUT",820,0) + . . . do HandleMSubFile(.IENArray,.FileArray,.Array) +"RTN","TMGFMUT",821,0) + . . else do +"RTN","TMGFMUT",822,0) + . . . set GRef=$get(^DIC(fromFile,0,"GL")) +"RTN","TMGFMUT",823,0) + . . . new ORef set ORef=GRef +"RTN","TMGFMUT",824,0) + . . . set GRef=$$CREF^DILF(GRef) ;"convert open to closed format +"RTN","TMGFMUT",825,0) + . . . new Itr,fromIEN +"RTN","TMGFMUT",826,0) + . . . set fromIEN=$$ItrAInit^TMGITR(GRef,.Itr) +"RTN","TMGFMUT",827,0) + . . . if ShowProgress=1 do PrepProgress^TMGITR(.Itr,20,1,"fromIEN") +"RTN","TMGFMUT",828,0) + . . . if fromIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.fromIEN)="")!abort +"RTN","TMGFMUT",829,0) + . . . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGFMUT",830,0) + . . . . ;"for set fromIEN=$order(@GRef@(fromIEN)) quit:(fromIEN="") do +"RTN","TMGFMUT",831,0) + . . . . new valueS set valueS=$get(@GRef@(fromIEN,node)) +"RTN","TMGFMUT",832,0) + . . . . new ToIEN set ToIEN=$piece(valueS,"^",pce) +"RTN","TMGFMUT",833,0) + . . . . if $data(IENArray(ToIEN))>0 do +"RTN","TMGFMUT",834,0) + . . . . . new lastCount set lastCount=+$get(Array(ToFile,ToIEN,fromFile,fromIEN,0))+1 +"RTN","TMGFMUT",835,0) + . . . . . set Array(ToFile,ToIEN,fromFile,fromIEN,0)=lastCount +"RTN","TMGFMUT",836,0) + . . . . . set Array(ToFile,ToIEN,fromFile,fromIEN,lastCount)=$name(@GRef@(fromIEN,node))_";"_pce_";"_""_";"_ORef +"RTN","TMGFMUT",837,0) + +"RTN","TMGFMUT",838,0) +SMFDone +"RTN","TMGFMUT",839,0) + quit +"RTN","TMGFMUT",840,0) + +"RTN","TMGFMUT",841,0) + +"RTN","TMGFMUT",842,0) +HandleSubFile(SearchValue,FileArray,Array,IENS,Ref) +"RTN","TMGFMUT",843,0) + ;"Purpose: To provide a means of recursively handling subfiles, searching for SearchValue. +"RTN","TMGFMUT",844,0) + ;"Input: SearchValue -- the value to be searched for, in INTERNAL format. +"RTN","TMGFMUT",845,0) + ;" File Array -- PASS BY REFERENCE An array that describes the parent file numbers +"RTN","TMGFMUT",846,0) + ;" and storage locations. Example: +"RTN","TMGFMUT",847,0) + ;" FileArra(0,"TOP GL")="^XTV(8989.3," +"RTN","TMGFMUT",848,0) + ;" FileArra(0,"FILE")=8989.33211 +"RTN","TMGFMUT",849,0) + ;" FileArra(0)=0 +"RTN","TMGFMUT",850,0) + ;" FileArra(0,"PARENT","LOC")="0;1" <-- for FileArray(0) node, stores node;piece +"RTN","TMGFMUT",851,0) + ;" FileArra(1)=8989.33211 +"RTN","TMGFMUT",852,0) + ;" FileArra(1,"PARENT","LOC")="1;0" <--- 1 is storage node +"RTN","TMGFMUT",853,0) + ;" FileArra(2)=8989.3321 +"RTN","TMGFMUT",854,0) + ;" FileArra(2,"PARENT","LOC")="1;0" <--- 1 is storage node +"RTN","TMGFMUT",855,0) + ;" FileArra(3)=8989.332 +"RTN","TMGFMUT",856,0) + ;" FileArra(3,"PARENT","LOC")="ABPKG;0" <--- "ABPKG" is storage node +"RTN","TMGFMUT",857,0) + ;" FileArra(4)=8989.3 +"RTN","TMGFMUT",858,0) + ;" FileArra(4,"PARENT","GL")="^XTV(8989.3," +"RTN","TMGFMUT",859,0) + ;" Array -- PASS BY REFERENCE. An array the receives any search matches. +"RTN","TMGFMUT",860,0) + ;" Format is as follows +"RTN","TMGFMUT",861,0) + ;" Array(File#,IEN,0)=LastCount +"RTN","TMGFMUT",862,0) + ;" Array(File#,IEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",863,0) + ;" +"RTN","TMGFMUT",864,0) + ;" IENS -- OPTIONAL -- used by this function internally during recursive calls +"RTN","TMGFMUT",865,0) + ;" Ref -- OPTIONAL -- used by this function internally during recursive calls +"RTN","TMGFMUT",866,0) + +"RTN","TMGFMUT",867,0) + new index,s,IEN,CRef,pce,node +"RTN","TMGFMUT",868,0) + set index=$order(FileArray(""),-1) +"RTN","TMGFMUT",869,0) + set s=$get(FileArray(index,"PARENT","LOC")) +"RTN","TMGFMUT",870,0) + set node=$piece(s,";",1) +"RTN","TMGFMUT",871,0) + set pce=+$piece(s,";",2) +"RTN","TMGFMUT",872,0) + if s'="" do +"RTN","TMGFMUT",873,0) + . if +node'=node set node=""""_node_"""" +"RTN","TMGFMUT",874,0) + . set s=node_"," +"RTN","TMGFMUT",875,0) + else do +"RTN","TMGFMUT",876,0) + . set s=$get(FileArray(index,"PARENT","GL")) +"RTN","TMGFMUT",877,0) + . set node="" +"RTN","TMGFMUT",878,0) + set Ref=$get(Ref)_s +"RTN","TMGFMUT",879,0) + if Ref="" goto HSFDone +"RTN","TMGFMUT",880,0) + set CRef=$$CREF^DILF(Ref) +"RTN","TMGFMUT",881,0) + new subFArray +"RTN","TMGFMUT",882,0) + merge subFArray=FileArray +"RTN","TMGFMUT",883,0) + kill subFArray(index) ;"trim top entry from list/array +"RTN","TMGFMUT",884,0) + if index>0 do +"RTN","TMGFMUT",885,0) + . set IEN=$order(@CRef@(0)) +"RTN","TMGFMUT",886,0) + . if +IEN>0 for do quit:(+IEN=0) +"RTN","TMGFMUT",887,0) + . . new subRef,subIENS +"RTN","TMGFMUT",888,0) + . . set subRef=Ref_IEN_"," +"RTN","TMGFMUT",889,0) + . . set subIENS=IEN_","_$get(IENS) +"RTN","TMGFMUT",890,0) + . . do HandleSubFile(SearchValue,.subFArray,.Array,.subIENS,subRef) +"RTN","TMGFMUT",891,0) + . . set IEN=$order(@CRef@(IEN)) +"RTN","TMGFMUT",892,0) + else do +"RTN","TMGFMUT",893,0) + . if (pce>0) do ;"Here is were the actual comparison to SearchValue occurs +"RTN","TMGFMUT",894,0) + . . set subRef=$$CREF^DILF(subRef) +"RTN","TMGFMUT",895,0) + . . new p,t set (p,t)=0 +"RTN","TMGFMUT",896,0) + . . for set t=$find(subRef,",",t) set:(t>0) p=t quit:(t=0) ;"find pos of last parameter +"RTN","TMGFMUT",897,0) + . . ;"new ORef set ORef=$extract(subRef,1,p-1) +"RTN","TMGFMUT",898,0) + . . set IEN=$piece($extract(subRef,p,99),")",1) +"RTN","TMGFMUT",899,0) + . . new value set value=$get(@subRef@(node)) +"RTN","TMGFMUT",900,0) + . . set value=$piece(value,"^",pce) +"RTN","TMGFMUT",901,0) + . . set value=$piece(value,";",1) ;"I think VARIABLE pointers format is: IEN;file# +"RTN","TMGFMUT",902,0) + . . if value=SearchValue do +"RTN","TMGFMUT",903,0) + . . . new tFile set tFile=$get(FileArray(0,"FILE"),"?") +"RTN","TMGFMUT",904,0) + . . . new count set count=$get(Array(tFile,IEN,0))+1 +"RTN","TMGFMUT",905,0) + . . . set Array(tFile,IEN,0)=count +"RTN","TMGFMUT",906,0) + . . . set Array(tFile,IEN,count)=$name(@subRef@(node))_";"_pce_";"_""_$get(IENS)_""_";"_$get(FileArray(0,"TOP GL")) +"RTN","TMGFMUT",907,0) + +"RTN","TMGFMUT",908,0) +HSFDone +"RTN","TMGFMUT",909,0) + quit +"RTN","TMGFMUT",910,0) + +"RTN","TMGFMUT",911,0) + +"RTN","TMGFMUT",912,0) +HandleMSubFile(IENArray,FileArray,Array,IENS,Ref) +"RTN","TMGFMUT",913,0) + ;"Purpose: To provide a means of recursively handling subfiles, searching for SearchValue. +"RTN","TMGFMUT",914,0) + ;"Input: IENArray : PASS BY REFERENCE. IEN's to search for in INTERNAL format. +"RTN","TMGFMUT",915,0) + ;" Format: IENArray=SourceFile +"RTN","TMGFMUT",916,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",917,0) + ;" IENArray(IEN)="" +"RTN","TMGFMUT",918,0) + ;" File Array -- PASS BY REFERENCE An array that describes the parent file numbers +"RTN","TMGFMUT",919,0) + ;" and storage locations. Example: +"RTN","TMGFMUT",920,0) + ;" FileArray(0,"TOP GL")="^XTV(8989.3," +"RTN","TMGFMUT",921,0) + ;" FileArray(0,"FILE")=8989.33211 +"RTN","TMGFMUT",922,0) + ;" FileArray(0)=0 +"RTN","TMGFMUT",923,0) + ;" FileArray(0,"PARENT","LOC")="0;1" <-- for FileArray(0) node, stores node;piece +"RTN","TMGFMUT",924,0) + ;" FileArray(1)=8989.33211 +"RTN","TMGFMUT",925,0) + ;" FileArray(1,"PARENT","LOC")="1;0" <--- 1 is storage node +"RTN","TMGFMUT",926,0) + ;" FileArray(2)=8989.3321 +"RTN","TMGFMUT",927,0) + ;" FileArray(2,"PARENT","LOC")="1;0" <--- 1 is storage node +"RTN","TMGFMUT",928,0) + ;" FileArray(3)=8989.332 +"RTN","TMGFMUT",929,0) + ;" FileArray(3,"PARENT","LOC")="ABPKG;0" <--- "ABPKG" is storage node +"RTN","TMGFMUT",930,0) + ;" FileArray(4)=8989.3 +"RTN","TMGFMUT",931,0) + ;" FileArray(4,"PARENT","GL")="^XTV(8989.3," +"RTN","TMGFMUT",932,0) + ;" Array : PASS BY REFERENCE. AN OUT PARAMETER. Format: +"RTN","TMGFMUT",933,0) + ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,0)=LastCount +"RTN","TMGFMUT",934,0) + ;" Array(ToFile#,ToIEN,fromFile#,fromIEN,count)=FullRef;piece;IENS;TopGlobalRef +"RTN","TMGFMUT",935,0) + ;" Description of parts: +"RTN","TMGFMUT",936,0) + ;" ---------------------- +"RTN","TMGFMUT",937,0) + ;" ToFile# -- the file containing the target IEN record +"RTN","TMGFMUT",938,0) + ;" ToIEN --the IEN in ToFile +"RTN","TMGFMUT",939,0) + ;" fromFile# -- the file the found entry exists it (may be a subfile number) +"RTN","TMGFMUT",940,0) + ;" fromIEN -- the record number in file +"RTN","TMGFMUT",941,0) + ;" Note: IEN here is different from the IEN passed in as a parameter +"RTN","TMGFMUT",942,0) + ;" FullRef -- the is the full reference to the found value. e.g. +"RTN","TMGFMUT",943,0) + ;" set value=$piece(@FullRef,"^",piece) +"RTN","TMGFMUT",944,0) + ;" piece -- the piece where value is stored in the node that is specified by FullRef +"RTN","TMGFMUT",945,0) + ;" IENS -- this is provided only for matches in subfiles. It is the IENS that may be used in database calls +"RTN","TMGFMUT",946,0) + ;" TopGlobalRef -- this is the global reference for file. If the match is in a subfile, then +"RTN","TMGFMUT",947,0) + ;" this is the global reference of the parent file (or the highest grandparent file if +"RTN","TMGFMUT",948,0) + ;" the parent file itself is a subfile, etc.) +"RTN","TMGFMUT",949,0) + ;" +"RTN","TMGFMUT",950,0) + ;" IENS -- OPTIONAL -- used by this function internally during recursive calls +"RTN","TMGFMUT",951,0) + ;" Ref -- OPTIONAL -- used by this function internally during recursive calls +"RTN","TMGFMUT",952,0) + +"RTN","TMGFMUT",953,0) + new ToFile set ToFile=$get(IENArray) +"RTN","TMGFMUT",954,0) + new index,s,IEN,CRef,pce,node +"RTN","TMGFMUT",955,0) + set index=$order(FileArray(""),-1) +"RTN","TMGFMUT",956,0) + set s=$get(FileArray(index,"PARENT","LOC")) +"RTN","TMGFMUT",957,0) + set node=$piece(s,";",1) +"RTN","TMGFMUT",958,0) + set pce=+$piece(s,";",2) +"RTN","TMGFMUT",959,0) + if s'="" do +"RTN","TMGFMUT",960,0) + . if +node'=node set node=""""_node_"""" +"RTN","TMGFMUT",961,0) + . set s=node_"," +"RTN","TMGFMUT",962,0) + else do +"RTN","TMGFMUT",963,0) + . set s=$get(FileArray(index,"PARENT","GL")) +"RTN","TMGFMUT",964,0) + . set node="" +"RTN","TMGFMUT",965,0) + set Ref=$get(Ref)_s +"RTN","TMGFMUT",966,0) + if Ref="" goto HSFDone +"RTN","TMGFMUT",967,0) + set CRef=$$CREF^DILF(Ref) +"RTN","TMGFMUT",968,0) + new subFArray +"RTN","TMGFMUT",969,0) + merge subFArray=FileArray +"RTN","TMGFMUT",970,0) + kill subFArray(index) ;"trim top entry from list/array +"RTN","TMGFMUT",971,0) + if index>0 do +"RTN","TMGFMUT",972,0) + . set fromIEN=0 +"RTN","TMGFMUT",973,0) + . for set fromIEN=$order(@CRef@(fromIEN)) quit:(+fromIEN=0) do +"RTN","TMGFMUT",974,0) + . . new subRef,subIENS +"RTN","TMGFMUT",975,0) + . . set subRef=Ref_fromIEN_"," +"RTN","TMGFMUT",976,0) + . . set subIENS=fromIEN_","_$get(IENS) +"RTN","TMGFMUT",977,0) + . . do HandleMSubFile(.IENArray,.subFArray,.Array,.subIENS,subRef) +"RTN","TMGFMUT",978,0) + else do +"RTN","TMGFMUT",979,0) + . if (pce>0) do ;"Here is were the actual comparison to SearchValue occurs +"RTN","TMGFMUT",980,0) + . . set subRef=$$CREF^DILF(subRef) +"RTN","TMGFMUT",981,0) + . . new p,t set (p,t)=0 +"RTN","TMGFMUT",982,0) + . . for set t=$find(subRef,",",t) set:(t>0) p=t quit:(t=0) ;"find pos of last parameter +"RTN","TMGFMUT",983,0) + . . ;"new ORef set ORef=$extract(subRef,1,p-1) +"RTN","TMGFMUT",984,0) + . . set fromIEN=$piece($extract(subRef,p,99),")",1) +"RTN","TMGFMUT",985,0) + . . new valueS set valueS=$get(@subRef@(node)) +"RTN","TMGFMUT",986,0) + . . set valueS=$piece(valueS,"^",pce) +"RTN","TMGFMUT",987,0) + . . new ToIEN set ToIEN=$piece(valueS,";",1) ;"I think VARIABLE pointers format is: IEN;file# +"RTN","TMGFMUT",988,0) + . . if $data(IENArray(ToIEN))>0 do +"RTN","TMGFMUT",989,0) + . . . new fromFile set fromFile=$get(FileArray(0,"FILE"),"?") +"RTN","TMGFMUT",990,0) + . . . new count set count=$get(Array(ToFile,ToIEN,fromFile,fromIEN,0))+1 +"RTN","TMGFMUT",991,0) + . . . set Array(ToFile,ToIEN,fromFile,fromIEN,0)=count +"RTN","TMGFMUT",992,0) + . . . set Array(ToFile,ToIEN,fromFile,fromIEN,count)=$name(@subRef@(node))_";"_pce_";"_""_$get(IENS)_""_";"_$get(FileArray(0,"TOP GL")) +"RTN","TMGFMUT",993,0) + +"RTN","TMGFMUT",994,0) +HMSFDone +"RTN","TMGFMUT",995,0) + quit +"RTN","TMGFMUT",996,0) + +"RTN","TMGFMUT",997,0) + +"RTN","TMGFMUT",998,0) +PossPtrs(File,Array) +"RTN","TMGFMUT",999,0) + ;"SCOPE: PUBLIC +"RTN","TMGFMUT",1000,0) + ;"Purpose: to create a list of all possible pointers to a specified file, i.e. all other fields/fields +"RTN","TMGFMUT",1001,0) + ;" that point to the specified file. +"RTN","TMGFMUT",1002,0) + ;"Input: File: The file to investigate (Number or Name) +"RTN","TMGFMUT",1003,0) + ;" Array -- PASS BY REFERENCE. An array to receive results back. +"RTN","TMGFMUT",1004,0) + ;" any prexisting data in Array is killed before filling +"RTN","TMGFMUT",1005,0) + ;"Output: Array is filled with format as follows: +"RTN","TMGFMUT",1006,0) + ;" Array(1)=OtherFile#^Field#^FieldCode(piece#2 of 0 node of ^DD entry for field) +"RTN","TMGFMUT",1007,0) + ;" Array(2)=OtherFile#^Field#^FieldCode +"RTN","TMGFMUT",1008,0) + ;"Result: 1 if results found, 0 if error occurred. +"RTN","TMGFMUT",1009,0) + +"RTN","TMGFMUT",1010,0) + kill Array +"RTN","TMGFMUT",1011,0) + new result set result=0 +"RTN","TMGFMUT",1012,0) + new FileNum +"RTN","TMGFMUT",1013,0) + if $data(File)#10=0 goto PPtrsDone +"RTN","TMGFMUT",1014,0) + if +File=0 set FileNum=$$GetFileNum^TMGDBAPI(File) ;"Convert File Name to File Number +"RTN","TMGFMUT",1015,0) + else set FileNum=File +"RTN","TMGFMUT",1016,0) + if +FileNum=0 goto PPtrsDone +"RTN","TMGFMUT",1017,0) + +"RTN","TMGFMUT",1018,0) + new count set count=1 +"RTN","TMGFMUT",1019,0) + new PtrFile set PtrFile=$order(^DD(FileNum,0,"PT","")) +"RTN","TMGFMUT",1020,0) + if PtrFile'="" for do quit:(PtrFile="") +"RTN","TMGFMUT",1021,0) + . new PtrField set PtrField=$order(^DD(FileNum,0,"PT",PtrFile,"")) +"RTN","TMGFMUT",1022,0) + . if PtrField'="" for do quit:(PtrField="") +"RTN","TMGFMUT",1023,0) + . . new s set s=PtrFile_"^"_PtrField +"RTN","TMGFMUT",1024,0) + . . set s=s_"^"_$piece($get(^DD(PtrFile,PtrField,0)),"^",2) +"RTN","TMGFMUT",1025,0) + . . set Array(count)=s +"RTN","TMGFMUT",1026,0) + . . set count=count+1 +"RTN","TMGFMUT",1027,0) + . . set PtrField=$order(^DD(FileNum,0,"PT",PtrFile,PtrField)) +"RTN","TMGFMUT",1028,0) + . set PtrFile=$order(^DD(FileNum,0,"PT",PtrFile)) +"RTN","TMGFMUT",1029,0) + +"RTN","TMGFMUT",1030,0) + set result=1 +"RTN","TMGFMUT",1031,0) +PPtrsDone +"RTN","TMGFMUT",1032,0) + quit result +"RTN","TMGFMUT",1033,0) + +"RTN","TMGFMUT",1034,0) + +"RTN","TMGFMUT",1035,0) + ;"Note: Not fully debugged yet..." +"RTN","TMGFMUT",1036,0) +SAFEKILL(Array,ShowProgress) +"RTN","TMGFMUT",1037,0) + ;"Purpose: to safely kill records, including removing any pointers TO them +"RTN","TMGFMUT",1038,0) + ;"input: pArray -- PASS BY REFERENCE. Expected input Format: +"RTN","TMGFMUT",1039,0) + ;" Array(File,IEN)=0 +"RTN","TMGFMUT",1040,0) + ;" Array(File,IEN)=0 +"RTN","TMGFMUT",1041,0) + ;" ShowProgress: if 1, progress bar shown +"RTN","TMGFMUT",1042,0) + ;"Output: all pointers in linked files to OldIEN will be changed to newIEN +"RTN","TMGFMUT",1043,0) + ;"Results: none +"RTN","TMGFMUT",1044,0) + +"RTN","TMGFMUT",1045,0) + do QTMMVPTR(.Array,.ShowProgress) +"RTN","TMGFMUT",1046,0) + quit +"RTN","TMGFMUT",1047,0) + +"RTN","TMGFMUT",1048,0) + +"RTN","TMGFMUT",1049,0) +ASKKILL +"RTN","TMGFMUT",1050,0) + ;"Purpose: to interact with user and safely kill records +"RTN","TMGFMUT",1051,0) + ;"Input: none. +"RTN","TMGFMUT",1052,0) + ;"Output: Records and pointers may be deleted +"RTN","TMGFMUT",1053,0) + ;"Results: none +"RTN","TMGFMUT",1054,0) + +"RTN","TMGFMUT",1055,0) + new DIC,File,X,Y +"RTN","TMGFMUT",1056,0) + new fromIEN,toIEN +"RTN","TMGFMUT",1057,0) + new delArray +"RTN","TMGFMUT",1058,0) + +"RTN","TMGFMUT",1059,0) + kill DIC +"RTN","TMGFMUT",1060,0) + set DIC("A")="Select file to delete from: " +"RTN","TMGFMUT",1061,0) + set DIC="^DIC(" +"RTN","TMGFMUT",1062,0) + set DIC(0)="MAQE" +"RTN","TMGFMUT",1063,0) + d ^DIC ;"Get File to search +"RTN","TMGFMUT",1064,0) + set File=+Y +"RTN","TMGFMUT",1065,0) + if File'>0 goto ASKKDone +"RTN","TMGFMUT",1066,0) + +"RTN","TMGFMUT",1067,0) + new Menu,UsrSlct +"RTN","TMGFMUT",1068,0) + set Menu(0)="Pick Option for Selecting Record(s) to Safely Delete" +"RTN","TMGFMUT",1069,0) + set Menu(1)="Manually pick Record(s)"_$char(9)_"ManualPick" +"RTN","TMGFMUT",1070,0) + set Menu(2)="Select a SET (aka SORT TEMPLATE) Contianing Many Records"_$char(9)_"PickSet" +"RTN","TMGFMUT",1071,0) + +"RTN","TMGFMUT",1072,0) +M1 write # +"RTN","TMGFMUT",1073,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGFMUT",1074,0) + +"RTN","TMGFMUT",1075,0) + if UsrSlct="ManualPick" goto ManualPick +"RTN","TMGFMUT",1076,0) + if UsrSlct="PickSet" goto PickSet +"RTN","TMGFMUT",1077,0) + if UsrSlct="^" goto ASKKDone +"RTN","TMGFMUT",1078,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGFMUT",1079,0) + goto M1 +"RTN","TMGFMUT",1080,0) + +"RTN","TMGFMUT",1081,0) +ManualPick +"RTN","TMGFMUT",1082,0) + set DIC=File +"RTN","TMGFMUT",1083,0) + set DIC("A")="Select record to delete: " +"RTN","TMGFMUT",1084,0) + do ^DIC ;"get FROM record in File +"RTN","TMGFMUT",1085,0) + write ! +"RTN","TMGFMUT",1086,0) + set fromIEN=+Y +"RTN","TMGFMUT",1087,0) + if fromIEN'>0 goto ASKGo +"RTN","TMGFMUT",1088,0) + set delArray(File,fromIEN)=0 +"RTN","TMGFMUT",1089,0) + new % set %=2 +"RTN","TMGFMUT",1090,0) + write "Pick another record" do YN^DICN write ! +"RTN","TMGFMUT",1091,0) + if %=1 goto ManualPick +"RTN","TMGFMUT",1092,0) + if %=-1 goto ASKKDone +"RTN","TMGFMUT",1093,0) + goto ASKGo +"RTN","TMGFMUT",1094,0) + +"RTN","TMGFMUT",1095,0) +PickSet new IENArray +"RTN","TMGFMUT",1096,0) + if $$GetTemplateRecs^TMGXMLUI(File,"IENArray","",1)=0 goto ASKKDone +"RTN","TMGFMUT",1097,0) + ;"Output: Data is put into pRecs like this: @pRecs@(IEN)="" +"RTN","TMGFMUT",1098,0) + +"RTN","TMGFMUT",1099,0) + new IEN set IEN="" +"RTN","TMGFMUT",1100,0) + for set IEN=$order(IENArray(IEN)) quit:(IEN="") do +"RTN","TMGFMUT",1101,0) + . set delArray(File,IEN)=0 +"RTN","TMGFMUT",1102,0) + +"RTN","TMGFMUT",1103,0) +ASKGo +"RTN","TMGFMUT",1104,0) + if $data(delArray)=0 goto ASKKDone +"RTN","TMGFMUT",1105,0) + +"RTN","TMGFMUT",1106,0) + ;"Get list of files/fields with pointers in +"RTN","TMGFMUT",1107,0) + set result=$$PossPtrs(File,.PossPtrs) if result=0 goto ASKKDone +"RTN","TMGFMUT",1108,0) + if $data(PossPtrs)'>0 goto DelRecs +"RTN","TMGFMUT",1109,0) + +"RTN","TMGFMUT",1110,0) + do SAFEKILL(.delArray,1) +"RTN","TMGFMUT",1111,0) + +"RTN","TMGFMUT",1112,0) +DelRecs ;"Now that pointers to records are deleted, it is safe to remove records themselves +"RTN","TMGFMUT",1113,0) + +"RTN","TMGFMUT",1114,0) + set IEN="" +"RTN","TMGFMUT",1115,0) + new abort set abort=0 +"RTN","TMGFMUT",1116,0) + for set IEN=$order(IENArray(IEN)) quit:(IEN="")!(abort=1) do +"RTN","TMGFMUT",1117,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGFMUT",1118,0) + . new TMGFDA,TMGMSG +"RTN","TMGFMUT",1119,0) + . set TMGFDA(File,IEN_",",.01)="@" +"RTN","TMGFMUT",1120,0) + . do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGFMUT",1121,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGFMUT",1122,0) + +"RTN","TMGFMUT",1123,0) +ASKKDone +"RTN","TMGFMUT",1124,0) + quit +"RTN","TMGFMUT",1125,0) + +"RTN","TMGFMUT",1126,0) + +"RTN","TMGFMUT",1127,0) + +"RTN","TMGFMUT",1128,0) +VerifyPtrs(File,pArray,Verbose,AutoFix) +"RTN","TMGFMUT",1129,0) + ;"Purpose: to scan a file for pointers OUT that are bad/invalid +"RTN","TMGFMUT",1130,0) + ;"Input: File : file Name or Number to scan +"RTN","TMGFMUT",1131,0) + ;" pArray : PASS BY NAME, an OUT PARAMETER. Format: +"RTN","TMGFMUT",1132,0) + ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr +"RTN","TMGFMUT",1133,0) + ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr +"RTN","TMGFMUT",1134,0) + ;" Verbose: OPTIONAL. If 1, then errors immediately written out. +"RTN","TMGFMUT",1135,0) + ;" AutoFix: OPTIONAL. If 1, then bad pointers are deleted. +"RTN","TMGFMUT",1136,0) + ;"Results: None +"RTN","TMGFMUT",1137,0) + +"RTN","TMGFMUT",1138,0) + new PtrsOUT +"RTN","TMGFMUT",1139,0) + new pPtrsOUT set pPtrsOUT="PtrsOUT" +"RTN","TMGFMUT",1140,0) + new fileNum +"RTN","TMGFMUT",1141,0) + if +File=File set fileNum=+File +"RTN","TMGFMUT",1142,0) + else set fileNum=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGFMUT",1143,0) + set Verbose=+$get(Verbose) +"RTN","TMGFMUT",1144,0) + set AutoFix=+$get(AutoFix) +"RTN","TMGFMUT",1145,0) + +"RTN","TMGFMUT",1146,0) + if $$FilePtrs(fileNum,pPtrsOUT)=0 goto VPtrDone +"RTN","TMGFMUT",1147,0) + +"RTN","TMGFMUT",1148,0) + new Itr,Itr2,TMGIEN,fieldNum +"RTN","TMGFMUT",1149,0) + new TMGVALUE,code +"RTN","TMGFMUT",1150,0) + new abort set abort=0 +"RTN","TMGFMUT",1151,0) + new $etrap set $etrap="set Y=""(Invalid M code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGFMUT",1152,0) + +"RTN","TMGFMUT",1153,0) + do DoVerify(File,pArray,Verbose,AutoFix) ;" Split out code to call it to call itself reentrantly +"RTN","TMGFMUT",1154,0) + +"RTN","TMGFMUT",1155,0) +VPtrDone +"RTN","TMGFMUT",1156,0) + quit +"RTN","TMGFMUT",1157,0) + +"RTN","TMGFMUT",1158,0) + +"RTN","TMGFMUT",1159,0) +DoVerify(fileNum,pArray,Verbose,AutoFix,IENS,pTMGIEN) +"RTN","TMGFMUT",1160,0) + ;"Purpose: Function allow VerifyPtrs to call reentrantly +"RTN","TMGFMUT",1161,0) + ;"Input: File : file Name or Number to scan +"RTN","TMGFMUT",1162,0) + ;" pArray : PASS BY NAME, an OUT PARAMETER. Format: +"RTN","TMGFMUT",1163,0) + ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr +"RTN","TMGFMUT",1164,0) + ;" @pArray@(FileNum,IEN,FieldNum)=ValueOfBadPtr +"RTN","TMGFMUT",1165,0) + ;" Verbose: OPTIONAL. If 1, then errors immediately written out. +"RTN","TMGFMUT",1166,0) + ;" AutoFix: OPTIONAL. If 1, then bad pointers are deleted. +"RTN","TMGFMUT",1167,0) + ;" IENS: OPTIONAL. If fileNum is a sub-file, then must supply +"RTN","TMGFMUT",1168,0) + ;" to give location of subfile in parent file. +"RTN","TMGFMUT",1169,0) + ;" pTMGIEN: "TMGIEN", or "TMGIEN(1)" etc. +"RTN","TMGFMUT",1170,0) + ;"Results: None +"RTN","TMGFMUT",1171,0) + ;"NOTICE: right now this MUST first be called from VerifyPtrs because +"RTN","TMGFMUT",1172,0) + ;" I have not moved some NEW commandes etc from there to here. +"RTN","TMGFMUT",1173,0) + ;" So this function depends on it's variables with global scope. +"RTN","TMGFMUT",1174,0) + +"RTN","TMGFMUT",1175,0) + set IENS=$get(IENS) +"RTN","TMGFMUT",1176,0) + set pTMGIEN=$get(pTMGIEN,"TMGIEN") +"RTN","TMGFMUT",1177,0) + set @pTMGIEN=$$ItrInit^TMGITR(fileNum,.Itr,.IENS) +"RTN","TMGFMUT",1178,0) + if IENS="" do PrepProgress^TMGITR(.Itr,20,0,pTMGIEN) ;" no bar for subfiles +"RTN","TMGFMUT",1179,0) + if @pTMGIEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.@pTMGIEN)'>0)!abort +"RTN","TMGFMUT",1180,0) + . set fieldNum=$$ItrAInit^TMGITR($name(@pPtrsOUT@(fileNum)),.Itr2) +"RTN","TMGFMUT",1181,0) + . if fieldNum'="" for do quit:(+$$ItrANext^TMGITR(.Itr2,.fieldNum)'>0)!abort +"RTN","TMGFMUT",1182,0) + . . if (@pTMGIEN#10=0),$$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGFMUT",1183,0) + . . ;"Line below handles subfiles +"RTN","TMGFMUT",1184,0) + . . if $data(@pPtrsOUT@(fileNum,fieldNum,"SUBFILE")) do quit +"RTN","TMGFMUT",1185,0) + . . . new subFile set subFile=$order(@pPtrsOUT@(fileNum,fieldNum,"SUBFILE","")) +"RTN","TMGFMUT",1186,0) + . . . set IENS=IENS_@pTMGIEN_"," +"RTN","TMGFMUT",1187,0) + . . . do DoVerify(subFile,$name(@pArray@("SUBFILE")),.Verbose,.AutoFix,IENS,$name(@pTMGIEN@(1))) +"RTN","TMGFMUT",1188,0) + . . ;"Otherwise, the usual case.... +"RTN","TMGFMUT",1189,0) + . . set code=$get(PtrsOUT(fileNum,fieldNum,"X GET")) +"RTN","TMGFMUT",1190,0) + . . if code="" quit +"RTN","TMGFMUT",1191,0) + . . xecute code +"RTN","TMGFMUT",1192,0) + . . if TMGVALUE="" quit +"RTN","TMGFMUT",1193,0) + . . set TMGVALUE=+TMGVALUE +"RTN","TMGFMUT",1194,0) + . . if TMGVALUE'>0 do quit +"RTN","TMGFMUT",1195,0) + . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)=TMGVALUE +"RTN","TMGFMUT",1196,0) + . . . new setCode set setCode=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(setCode="") +"RTN","TMGFMUT",1197,0) + . . . new priorValue set priorValue=TMGVALUE +"RTN","TMGFMUT",1198,0) + . . . set TMGVALUE="" +"RTN","TMGFMUT",1199,0) + . . . if 'AutoFix quit +"RTN","TMGFMUT",1200,0) + . . . xecute setCode +"RTN","TMGFMUT",1201,0) + . . . if 'Verbose quit +"RTN","TMGFMUT",1202,0) + . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Bad Pointer value=[",priorValue,"]",! +"RTN","TMGFMUT",1203,0) + . . . write " fixed...",! +"RTN","TMGFMUT",1204,0) + . . ;"if (fileNum=2)&(TMGVALUE=777) do quit ;"TEMP!!!! +"RTN","TMGFMUT",1205,0) + . . ;". set code=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(code="") +"RTN","TMGFMUT",1206,0) + . . ;". set TMGVALUE=69 +"RTN","TMGFMUT",1207,0) + . . ;". xecute code +"RTN","TMGFMUT",1208,0) + . . new PtToGref set PtToGref="^"_$get(PtrsOUT(fileNum,fieldNum,"POINTS TO","GREF")) +"RTN","TMGFMUT",1209,0) + . . if PtToGref="" do quit +"RTN","TMGFMUT",1210,0) + . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)="??No reference for pointed to file??" +"RTN","TMGFMUT",1211,0) + . . . if 'Verbose quit +"RTN","TMGFMUT",1212,0) + . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Pointer value=[",TMGVALUE,"] but 'No reference for pointed to file (??)'",! +"RTN","TMGFMUT",1213,0) + . . set PtToGref=PtToGref_TMGVALUE_")" +"RTN","TMGFMUT",1214,0) + . . if $data(@PtToGref)'>0 do quit +"RTN","TMGFMUT",1215,0) + . . . set @pArray@(fileNum,@pTMGIEN,fieldNum)=TMGVALUE +"RTN","TMGFMUT",1216,0) + . . . new setCode set setCode=$get(PtrsOUT(fileNum,fieldNum,"X SET")) quit:(setCode="") +"RTN","TMGFMUT",1217,0) + . . . new priorValue set priorValue=TMGVALUE +"RTN","TMGFMUT",1218,0) + . . . set TMGVALUE="" +"RTN","TMGFMUT",1219,0) + . . . if 'AutoFix quit +"RTN","TMGFMUT",1220,0) + . . . xecute setCode +"RTN","TMGFMUT",1221,0) + . . . if 'Verbose quit +"RTN","TMGFMUT",1222,0) + . . . write !,"File=",fileNum,"; IEN=",@pTMGIEN,"; Field=",fieldNum,"; Bad Pointer value=[",priorValue,"]",! +"RTN","TMGFMUT",1223,0) + . . . write " fixed...",! +"RTN","TMGFMUT",1224,0) + if IENS="" do ProgressDone^TMGITR(.Itr) +"RTN","TMGFMUT",1225,0) + quit +"RTN","TMGFMUT",1226,0) + +"RTN","TMGFMUT",1227,0) + +"RTN","TMGFMUT",1228,0) +ASKVFYPT ;"ASK VERIFY POINTERS +"RTN","TMGFMUT",1229,0) + ;"Ask user to pick file, then verify pointers for that file. +"RTN","TMGFMUT",1230,0) + +"RTN","TMGFMUT",1231,0) + write "NOTICE: this function caused corruption of the database from",! +"RTN","TMGFMUT",1232,0) + write " deletion of pointers incorrectly. Until this function",! +"RTN","TMGFMUT",1233,0) + write " (ASKVFYPT^TMGFMUT) is fixed, it may not be used.",!,! +"RTN","TMGFMUT",1234,0) + do PressToCont^TMGUSRIF +"RTN","TMGFMUT",1235,0) + goto ASKDone +"RTN","TMGFMUT",1236,0) + +"RTN","TMGFMUT",1237,0) + +"RTN","TMGFMUT",1238,0) + new DIC,X,Y +"RTN","TMGFMUT",1239,0) + new FileNum,IEN +"RTN","TMGFMUT",1240,0) + new UseDefault set UseDefault=1 +"RTN","TMGFMUT",1241,0) + +"RTN","TMGFMUT",1242,0) + ;"Pick file to dump from +"RTN","TMGFMUT",1243,0) +ASK1 set DIC=1 +"RTN","TMGFMUT",1244,0) + set DIC(0)="AEQM" +"RTN","TMGFMUT",1245,0) + set DIC("A")="SELECT FILE TO VERIFY POINTERS IN: " +"RTN","TMGFMUT",1246,0) + if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called +"RTN","TMGFMUT",1247,0) + . do ^DICRW ;" has default value of user's last response +"RTN","TMGFMUT",1248,0) + else do ^DIC ;doesn't have default value... +"RTN","TMGFMUT",1249,0) + write ! +"RTN","TMGFMUT",1250,0) + if +Y'>0 write ! goto ASKDone +"RTN","TMGFMUT",1251,0) + set FileNum=+Y +"RTN","TMGFMUT",1252,0) + +"RTN","TMGFMUT",1253,0) + new BadPtrs +"RTN","TMGFMUT",1254,0) + new AutoFix,Verbose,% +"RTN","TMGFMUT",1255,0) + set %=2 +"RTN","TMGFMUT",1256,0) + write "View details of scan" do YN^DICN write ! +"RTN","TMGFMUT",1257,0) + if %=-1 goto ASKDone +"RTN","TMGFMUT",1258,0) + set Verbose=(%=1) +"RTN","TMGFMUT",1259,0) + +"RTN","TMGFMUT",1260,0) + set %=2 +"RTN","TMGFMUT",1261,0) + write "Auto-delete bad pointers (i.e. 0 value, or pointers to empty records)" +"RTN","TMGFMUT",1262,0) + do YN^DICN write ! +"RTN","TMGFMUT",1263,0) + if %=-1 goto ASKDone +"RTN","TMGFMUT",1264,0) + set AutoFix=(%=1) +"RTN","TMGFMUT",1265,0) + +"RTN","TMGFMUT",1266,0) + do VerifyPtrs(FileNum,"BadPtrs",Verbose,AutoFix) +"RTN","TMGFMUT",1267,0) + +"RTN","TMGFMUT",1268,0) + if $data(BadPtrs) do +"RTN","TMGFMUT",1269,0) + . new % set %=2 +"RTN","TMGFMUT",1270,0) + . write "View array of bad pointers" do YN^DICN write ! +"RTN","TMGFMUT",1271,0) + . if %'=1 quit +"RTN","TMGFMUT",1272,0) + . do ArrayDump^TMGDEBUG("BadPtrs") +"RTN","TMGFMUT",1273,0) + else write "No bad pointers. Great!",! +"RTN","TMGFMUT",1274,0) + +"RTN","TMGFMUT",1275,0) + do PressToCont^TMGUSRIF +"RTN","TMGFMUT",1276,0) + +"RTN","TMGFMUT",1277,0) +ASKDone +"RTN","TMGFMUT",1278,0) + quit +"RTN","TMGGDFN") +0^21^B101576 +"RTN","TMGGDFN",1,0) +TMGGDFN ;TMG/kst-Get A Patient's IEN (DFN) ;01/01/04 +"RTN","TMGGDFN",2,0) + ;;1.0;TMG-LIB;**1**;06/04/08 +"RTN","TMGGDFN",3,0) + +"RTN","TMGGDFN",4,0) + ;"TMG GET DFN (TMGGDFN) +"RTN","TMGGDFN",5,0) + ;" +"RTN","TMGGDFN",6,0) + ;"Purpose: This module will provide functionality for getting a DFN +"RTN","TMGGDFN",7,0) + ;" (which is the database record number) for a given patient. +"RTN","TMGGDFN",8,0) + ;" If the patient has not been encountered before, then the patient +"RTN","TMGGDFN",9,0) + ;" will be added to the database. +"RTN","TMGGDFN",10,0) + +"RTN","TMGGDFN",11,0) + ;"======================================================================= +"RTN","TMGGDFN",12,0) + ;" API -- Public Functions. +"RTN","TMGGDFN",13,0) + ;"======================================================================= +"RTN","TMGGDFN",14,0) + ;"$$GetDFN(Info) +"RTN","TMGGDFN",15,0) + +"RTN","TMGGDFN",16,0) + ;"======================================================================= +"RTN","TMGGDFN",17,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGGDFN",18,0) + ;"======================================================================= +"RTN","TMGGDFN",19,0) + ;"Pat2Entry(Patient,Entry) convert a named-node entry, into numeric 'Entry' array: +"RTN","TMGGDFN",20,0) + ;"LookupPatient(Entry) +"RTN","TMGGDFN",21,0) + ;"SSNumLookup(SSNum) +"RTN","TMGGDFN",22,0) + ;"PMSNumLookup(PMSNum) +"RTN","TMGGDFN",23,0) + ;"ParadigmNumLookup(PMSNum) +"RTN","TMGGDFN",24,0) + ;"Compare(TestData,dbData,EntryNum) +"RTN","TMGGDFN",25,0) + ;"CompEntry(TestData,dbDataEntry) +"RTN","TMGGDFN",26,0) + ;"$$AddToPat(DFN,Entry) +"RTN","TMGGDFN",27,0) + ;"$$AddNewPt(Entry) +"RTN","TMGGDFN",28,0) + +"RTN","TMGGDFN",29,0) + +"RTN","TMGGDFN",30,0) + ;"======================================================================= +"RTN","TMGGDFN",31,0) + ;"PRIVATE FUNCTIONS +"RTN","TMGGDFN",32,0) + ;"======================================================================= +"RTN","TMGGDFN",33,0) + ;"SSNum2Lookup(SSNum) <--- depreciated +"RTN","TMGGDFN",34,0) + +"RTN","TMGGDFN",35,0) + +"RTN","TMGGDFN",36,0) +GetDFN(Patient) +"RTN","TMGGDFN",37,0) + ;"Purpose: This code is to ensure that a patient is registered +"RTN","TMGGDFN",38,0) + ;" It is intended for use during upload of old records +"RTN","TMGGDFN",39,0) + ;" from another EMR. As each dictation is processed, +"RTN","TMGGDFN",40,0) + ;" this function will be called with the header info. +"RTN","TMGGDFN",41,0) + ;" If the patient is already registered, then this function +"RTN","TMGGDFN",42,0) + ;" will have no effect other than to return the DFN. +"RTN","TMGGDFN",43,0) + ;" Otherwise, the patient will be registered. +"RTN","TMGGDFN",44,0) + ;" ??? *I'll have this function used another way as well: If +"RTN","TMGGDFN",45,0) + ;" only the TMGPTNUM is passed, it will load valid values +"RTN","TMGGDFN",46,0) + ;" into TMGNAME etc., which can be passed back to the calling +"RTN","TMGGDFN",47,0) + ;" function (providing that values were passed by reference) +"RTN","TMGGDFN",48,0) + ;"Input: Patient: Array is loaded with Patient, like this: +"RTN","TMGGDFN",49,0) + ;" Patient("SSNUM")="123-45-6789" +"RTN","TMGGDFN",50,0) + ;" Patient("NAME")="DOE,JOHN" +"RTN","TMGGDFN",51,0) + ;" Patient("DOB")="01-04-69" +"RTN","TMGGDFN",52,0) + ;" Patient("PATIENTNUM")="12345677" <-- Medic account number +"RTN","TMGGDFN",53,0) + ;" Patient("SEQUELNUM")="234567890" <-- SequelMedSystems Account number +"RTN","TMGGDFN",54,0) + ;" Patient("PARADIGMNUM")="234567890" <-- Pardigm Account number +"RTN","TMGGDFN",55,0) + ;" Patient("SEX")="M" +"RTN","TMGGDFN",56,0) + ;" Patient("ALIAS")="DOE,JOHNNY" +"RTN","TMGGDFN",57,0) + ;" -Note: The following are optional, only used if adding a patient +"RTN","TMGGDFN",58,0) + ;" If adding a patient, and these are not supplied, then defaults of +"RTN","TMGGDFN",59,0) + ;" Not a veteran, NON-VETERAN type, Not service connected are used +"RTN","TMGGDFN",60,0) + ;" Patient("VETERAN")= VETERAN Y/N --For my purposes, use NO -- optional +"RTN","TMGGDFN",61,0) + ;" Patient("PT_TYPE")= "SERVICE CONNECTED?" -- required field -- optional +"RTN","TMGGDFN",62,0) + ;" Patient("SERVICE_CONNECTED")= "TYPE" - required field -- optional +"RTN","TMGGDFN",63,0) + +"RTN","TMGGDFN",64,0) + ;" (TMGFREG) Also, variable with global scope, TMGFREG, is used +"RTN","TMGGDFN",65,0) + ;" if TMGFREG=1, and patient is not found, then +"RTN","TMGGDFN",66,0) + ;" patient will be automatically registered as a new patient. +"RTN","TMGGDFN",67,0) + ;" +"RTN","TMGGDFN",68,0) + ;"Output: The patient's info is used to register the patient, if they are +"RTN","TMGGDFN",69,0) + ;" are not already registered +"RTN","TMGGDFN",70,0) + ;"Result: RETURNS DFN (patient internal entry number), or -1 if not found or added. +"RTN","TMGGDFN",71,0) + ;"------------------------------------------------------------------------------ +"RTN","TMGGDFN",72,0) + +"RTN","TMGGDFN",73,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDFN^TMGGDFN") +"RTN","TMGGDFN",74,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Patient' passed for processing:") +"RTN","TMGGDFN",75,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Patient") +"RTN","TMGGDFN",76,0) + +"RTN","TMGGDFN",77,0) + new result,Entry +"RTN","TMGGDFN",78,0) + do Pat2Entry(.Patient,.Entry) +"RTN","TMGGDFN",79,0) + set result=$$LookupPatient(.Entry) +"RTN","TMGGDFN",80,0) + if result>0 goto ERDone +"RTN","TMGGDFN",81,0) + ;"1-18-2005 I am going to stop adding patients automatically--I think it +"RTN","TMGGDFN",82,0) + ;" will make duplicate entries. I should have all patients in now... +"RTN","TMGGDFN",83,0) + ;"10-15-2005 I will allow the patient to be added automatically if the variable +"RTN","TMGGDFN",84,0) + ;" with global scope TMGFREG=1 (stands for: TMG FORCE REGISTRATION) +"RTN","TMGGDFN",85,0) + ;" At this time, this will only be set from ERRORS^TMGUPLD +"RTN","TMGGDFN",86,0) + set result=-1 ;"signal failure as default +"RTN","TMGGDFN",87,0) + if $get(TMGFREG)=1 do ;"Allowed gobal-scope variable to force add. +"RTN","TMGGDFN",88,0) + . set result=$$AddNewPt(.Entry) +"RTN","TMGGDFN",89,0) + . if result'>0 set result=-1 +"RTN","TMGGDFN",90,0) + +"RTN","TMGGDFN",91,0) +ERDone +"RTN","TMGGDFN",92,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Resulting DFN (patient record number/IEN)=",result) +"RTN","TMGGDFN",93,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDFN^TMGGDFN") +"RTN","TMGGDFN",94,0) + +"RTN","TMGGDFN",95,0) + quit result ;"result=DFN +"RTN","TMGGDFN",96,0) + +"RTN","TMGGDFN",97,0) + +"RTN","TMGGDFN",98,0) + ;"====================================================================== +"RTN","TMGGDFN",99,0) + +"RTN","TMGGDFN",100,0) +Pat2Entry(Patient,Entry) +"RTN","TMGGDFN",101,0) + ;"Purpose: to convert a named-node entry, into numeric 'Entry' array: +"RTN","TMGGDFN",102,0) + ;"Input: Patient: PASS BY REFERENCE. Array loaded with patient info: +"RTN","TMGGDFN",103,0) + ;" Patient("SSNUM")="123-45-6789" +"RTN","TMGGDFN",104,0) + ;" Patient("NAME")="DOE,JOHN" +"RTN","TMGGDFN",105,0) + ;" Patient("DOB")="01-04-69" +"RTN","TMGGDFN",106,0) + ;" Patient("PATIENTNUM")="12345677" <-- Medic account number +"RTN","TMGGDFN",107,0) + ;" Patient("SEQUELNUM")="234567890" <-- SequelMedSystems Account number +"RTN","TMGGDFN",108,0) + ;" Patient("PARADIGMNUM")="234567890" <-- Pardigm Account number +"RTN","TMGGDFN",109,0) + ;" Patient("SEX")="M" +"RTN","TMGGDFN",110,0) + ;" Patient("ALIAS")="DOE,JOHNNY" +"RTN","TMGGDFN",111,0) + ;" -Note: The following are optional, only used if adding a patient +"RTN","TMGGDFN",112,0) + ;" If adding a patient, and these are not supplied, then defaults of +"RTN","TMGGDFN",113,0) + ;" Not a veteran, NON-VETERAN type, Not service connected are used +"RTN","TMGGDFN",114,0) + ;" Patient("VETERAN")= VETERAN Y/N --For my purposes, use NO -- optional +"RTN","TMGGDFN",115,0) + ;" Patient("PT_TYPE")= "SERVICE CONNECTED?" -- required field -- optional +"RTN","TMGGDFN",116,0) + ;" Patient("SERVICE_CONNECTED")= "TYPE" - required field -- optional +"RTN","TMGGDFN",117,0) + ;" Entry; PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGGDFN",118,0) + ;"Results: None +"RTN","TMGGDFN",119,0) + +"RTN","TMGGDFN",120,0) + if $data(Patient("NAME")) set Entry(.01)=$get(Patient("NAME")) +"RTN","TMGGDFN",121,0) + if $data(Patient("SEX")) set Entry(.02)=$get(Patient("SEX")) +"RTN","TMGGDFN",122,0) + if $data(Patient("DOB")) set Entry(.03)=$get(Patient("DOB")) +"RTN","TMGGDFN",123,0) + if $data(Patient("SSNUM")) set Entry(.09)=$get(Patient("SSNUM")) +"RTN","TMGGDFN",124,0) + if $data(Patient("PATIENTNUM")) set Entry(22700)=$get(Patient("PATIENTNUM")) +"RTN","TMGGDFN",125,0) + if $data(Patient("PMS ACCOUNT NUM")) set Entry(22701)=$get(Patient("PMS ACCOUNT NUM")) +"RTN","TMGGDFN",126,0) + if $data(Patient("SEQUELNUM")) set Entry(22701)=$get(Patient("SEQUELNUM")) +"RTN","TMGGDFN",127,0) + if $data(Patient("PARADIGMNUM")) set Entry(22702)=$get(Patient("PARADIGM")) +"RTN","TMGGDFN",128,0) + if $data(Patient("ALIAS")) set Entry(10,.01)=$get(Patient("ALIAS")) +"RTN","TMGGDFN",129,0) + +"RTN","TMGGDFN",130,0) + if $data(Patient("VETERAN")) set Entry(1901)=Patient("VETERAN") +"RTN","TMGGDFN",131,0) + if $data(Patient("PT_TYPE")) set Entry(.301)=Patient("PT_TYPE") +"RTN","TMGGDFN",132,0) + if $data(Patient("SERVICE_CONNECTED")) set Entry(391)=Patient("SERVICE_CONNECTED") +"RTN","TMGGDFN",133,0) + +"RTN","TMGGDFN",134,0) + quit +"RTN","TMGGDFN",135,0) + +"RTN","TMGGDFN",136,0) + +"RTN","TMGGDFN",137,0) +LookupPatient(Entry) +"RTN","TMGGDFN",138,0) + ;"Purpose: Search for Patient (an existing entry in the database) +"RTN","TMGGDFN",139,0) + ;"Input: Entry -- Array is loaded with info, like this: +"RTN","TMGGDFN",140,0) + ;" set Entry(.01)=Name +"RTN","TMGGDFN",141,0) + ;" set Entry(.02)=Sex +"RTN","TMGGDFN",142,0) + ;" set Entry(.03)=DOB +"RTN","TMGGDFN",143,0) + ;" set Entry(.09)=SSNum +"RTN","TMGGDFN",144,0) + ;" set Entry(22700)=PtNum +"RTN","TMGGDFN",145,0) + ;" set Entry(22701)=SequelSystems PMS AccountNumber +"RTN","TMGGDFN",146,0) + ;" set Entry(22702)=Paradigm PMS AccountNumber +"RTN","TMGGDFN",147,0) + ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found +"RTN","TMGGDFN",148,0) + ;"NOTE: For now, I am ignoring any passed Alias info. +"RTN","TMGGDFN",149,0) + ;"------------------------------------------------------------------------------ +"RTN","TMGGDFN",150,0) + +"RTN","TMGGDFN",151,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"LookupPatient^TMGGDFN") +"RTN","TMGGDFN",152,0) + +"RTN","TMGGDFN",153,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGGDFN",154,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGGDFN",155,0) + if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 +"RTN","TMGGDFN",156,0) + if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 +"RTN","TMGGDFN",157,0) + +"RTN","TMGGDFN",158,0) + new Missing set Missing=0 +"RTN","TMGGDFN",159,0) + new BailOut set BailOut=0 +"RTN","TMGGDFN",160,0) + new result set result=0 ;"set default to no match, or conflict found +"RTN","TMGGDFN",161,0) + new TMGErrMsg,TMGOutput +"RTN","TMGGDFN",162,0) + new RecComp +"RTN","TMGGDFN",163,0) + +"RTN","TMGGDFN",164,0) + ;"If can find patient by SSNum, then don't look any further (if successful) +"RTN","TMGGDFN",165,0) + if +$get(Entry(.09))>0 set result=$$SSNumLookup(Entry(.09)) +"RTN","TMGGDFN",166,0) + if result>0 goto LUDone +"RTN","TMGGDFN",167,0) + +"RTN","TMGGDFN",168,0) + ;"If can find patient by SequelMedSystem account number, then don't look any further (if successful) +"RTN","TMGGDFN",169,0) + if (+$get(Entry(22701))>0),$$FieldExists(22701) set result=$$PMSNumLookup(Entry(22701)) +"RTN","TMGGDFN",170,0) + if result>0 goto LUDone +"RTN","TMGGDFN",171,0) + +"RTN","TMGGDFN",172,0) + ;"If can find patient by Paradigm account number, then don't look any further (if successful) +"RTN","TMGGDFN",173,0) + if (+$get(Entry(22702))>0),$$FieldExists(22702) set result=$$ParadigmNumLookup(Entry(22702)) +"RTN","TMGGDFN",174,0) + if result>0 goto LUDone +"RTN","TMGGDFN",175,0) + +"RTN","TMGGDFN",176,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Entry' passed for processing:") +"RTN","TMGGDFN",177,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") +"RTN","TMGGDFN",178,0) + +"RTN","TMGGDFN",179,0) + ;"Below specifies fields to get back. Note: file 2 is PATIENT file. +"RTN","TMGGDFN",180,0) + new Value set Value=$get(Entry(.01)) +"RTN","TMGGDFN",181,0) + +"RTN","TMGGDFN",182,0) + ;"========================================================= +"RTN","TMGGDFN",183,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGGDFN",184,0) + ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",185,0) + do +"RTN","TMGGDFN",186,0) + . new File set File=2 +"RTN","TMGGDFN",187,0) + . new IENS set IENS="" +"RTN","TMGGDFN",188,0) + . new Fields set Fields="@;.01;.02;.03;.09" +"RTN","TMGGDFN",189,0) + . if $$FieldExists(22700) set Fields=Fields_";22700" +"RTN","TMGGDFN",190,0) + . ;"new Fields set Fields=".01" +"RTN","TMGGDFN",191,0) + . new Flags set Flags="M" +"RTN","TMGGDFN",192,0) + . new MatchValue set MatchValue=Value +"RTN","TMGGDFN",193,0) + . new Number set Number="*" ;"i.e. max number to return *=all entries. +"RTN","TMGGDFN",194,0) + . new Indexes set Indexes="" +"RTN","TMGGDFN",195,0) + . new ScreenCode set ScreenCode="" ;"option screening M code +"RTN","TMGGDFN",196,0) + . new Ident set Ident="" ;"optional text to accompany each found entry +"RTN","TMGGDFN",197,0) + . new OutVarP set OutVarP="TMGOutput" +"RTN","TMGGDFN",198,0) + . new ErrVarP set ErrVarP="TMGErrMsg" +"RTN","TMGGDFN",199,0) + . ;"if $get(TMGDEBUG)>0 do +"RTN","TMGGDFN",200,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent,"Here is search data:") +"RTN","TMGGDFN",201,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," File='",File,"'") +"RTN","TMGGDFN",202,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," IENS='",IENS,"'") +"RTN","TMGGDFN",203,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," Fields='",Fields,"'") +"RTN","TMGGDFN",204,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," Flags='",Flags,"'") +"RTN","TMGGDFN",205,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," MatchValue='",MatchValue,"'") +"RTN","TMGGDFN",206,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," Number='",Number,"'") +"RTN","TMGGDFN",207,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," Indexes='",Indexes,"'") +"RTN","TMGGDFN",208,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," ScreenCode='",ScreenCode,"'") +"RTN","TMGGDFN",209,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," Ident='",Ident,"'") +"RTN","TMGGDFN",210,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," OutVarP='",OutVarP,"'") +"RTN","TMGGDFN",211,0) + . ;". do DebugMsg^TMGDEBUG(.DBIndent," ErrVarP='",ErrVarP,"'") +"RTN","TMGGDFN",212,0) + . do FIND^DIC(File,IENS,Fields,Flags,MatchValue,Number,Indexes,ScreenCode,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",213,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGGDFN",214,0) + ;"========================================================= +"RTN","TMGGDFN",215,0) + +"RTN","TMGGDFN",216,0) + ;"----------------------------------------------------------- +"RTN","TMGGDFN",217,0) + ;"Here is an example of the output of FIND^DIC(): +"RTN","TMGGDFN",218,0) + ;"TMGOutput("DILIST",0)="2^*^0^" <-2 matches +"RTN","TMGGDFN",219,0) + ;"TMGOutput("DILIST",0,"MAP")=".01^.02^.03^.09^22700" +"RTN","TMGGDFN",220,0) + ;"TMGOutput("DILIST",2,1)=16 +"RTN","TMGGDFN",221,0) + ;"TMGOutput("DILIST",2,2)=2914 +"RTN","TMGGDFN",222,0) + ;"TMGOutput("DILIST","ID",1,.01)="VIRIATO,ENEAS" +"RTN","TMGGDFN",223,0) + ;"TMGOutput("DILIST","ID",1,.02)="MALE" +"RTN","TMGGDFN",224,0) + ;"TMGOutput("DILIST","ID",1,.03)="01/20/1957" +"RTN","TMGGDFN",225,0) + ;"TMGOutput("DILIST","ID",1,.09)=123237654 +"RTN","TMGGDFN",226,0) + ;"TMGOutput("DILIST","ID",1,22700)=3542340 +"RTN","TMGGDFN",227,0) + ;"TMGOutput("DILIST","ID",2,.01)="VOID,BURT" +"RTN","TMGGDFN",228,0) + ;"TMGOutput("DILIST","ID",2,.02)="FEMALE" +"RTN","TMGGDFN",229,0) + ;"TMGOutput("DILIST","ID",2,.03)="" +"RTN","TMGGDFN",230,0) + ;"TMGOutput("DILIST","ID",2,.09)="" +"RTN","TMGGDFN",231,0) + ;"TMGOutput("DILIST","ID",1,22700)=000455454 +"RTN","TMGGDFN",232,0) + ;"----------------------------------------------- +"RTN","TMGGDFN",233,0) + +"RTN","TMGGDFN",234,0) + ;"if ($get(TMGDEBUG)>0) do +"RTN","TMGGDFN",235,0) + ;". if $data(TMGOutput)>0 do ArrayDump^TMGDEBUG("TMGOutput") +"RTN","TMGGDFN",236,0) + ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGOutput found.") +"RTN","TMGGDFN",237,0) + ;". if $data(TMGErrMsg)>0 do ArrayDump^TMGDEBUG("TMGErrMsg") +"RTN","TMGGDFN",238,0) + ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGErrMsg found") +"RTN","TMGGDFN",239,0) + +"RTN","TMGGDFN",240,0) + if $data(TMGErrMsg("DIERR")) do ShowDIERR^TMGDEBUG(.TMGErrMsg,.PriorErrorFound) +"RTN","TMGGDFN",241,0) + +"RTN","TMGGDFN",242,0) + if $data(TMGOutput)'=0 do +"RTN","TMGGDFN",243,0) + . new NumMatch,Num +"RTN","TMGGDFN",244,0) + . set NumMatch=+$PIECE(TMGOutput("DILIST",0),"^",1) ;"Get first part of entry like this: '8^*^0^' <-8 matches +"RTN","TMGGDFN",245,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,NumMatch," matches found in database") +"RTN","TMGGDFN",246,0) + . for Num=1:1:NumMatch do ;"Compare all entries found. If NumMatch=0-->no 1st loop +"RTN","TMGGDFN",247,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting loop #",Num) +"RTN","TMGGDFN",248,0) + . . set RecComp=$$Compare(.Entry,.TMGOutput,Num) +"RTN","TMGGDFN",249,0) + . . if (RecComp=cInsufficient)&(NumMatch=1) do +"RTN","TMGGDFN",250,0) + . . . ;"Fileman has said there is 1 (and only 1) match. +"RTN","TMGGDFN",251,0) + . . . ;"Even if the supplied info is lacking, it is still a match. +"RTN","TMGGDFN",252,0) + . . . ;"We still needed to call $$Compare to check for cExtraInfo +"RTN","TMGGDFN",253,0) + . . . set RecComp=cFullMatch +"RTN","TMGGDFN",254,0) + . . if (RecComp=cFullMatch)!(RecComp=cExtraInfo) do +"RTN","TMGGDFN",255,0) + . . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Great! A match!") +"RTN","TMGGDFN",256,0) + . . . set result=TMGOutput("DILIST",2,Num) ;"This is DFN (record) number +"RTN","TMGGDFN",257,0) + . . . if RecComp=cExtraInfo do +"RTN","TMGGDFN",258,0) + . . . . new temp set temp=$$AddToPat(result,.Entry) +"RTN","TMGGDFN",259,0) + . . . set Num=NumMatch+1 ;"some value to abort loop +"RTN","TMGGDFN",260,0) + . . ;"else if (RecComp=cInsufficient) do DebugMsg^TMGDEBUG(.DBIndent,"Entry #",Num," insufficient data for match") +"RTN","TMGGDFN",261,0) + . . ;"else if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Entry #",Num," conflicts") +"RTN","TMGGDFN",262,0) + +"RTN","TMGGDFN",263,0) +LUDone; +"RTN","TMGGDFN",264,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Result (patient DFN#)=",result) +"RTN","TMGGDFN",265,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"LookupPatient^TMGGDFN") +"RTN","TMGGDFN",266,0) + +"RTN","TMGGDFN",267,0) + quit result ;" return patient internal entry number (DFN) +"RTN","TMGGDFN",268,0) + +"RTN","TMGGDFN",269,0) +FieldExists(FieldNum) +"RTN","TMGGDFN",270,0) + ;"Purpose: to ensure a given field exists in File 2 +"RTN","TMGGDFN",271,0) + ;"Input: FieldNum: NUMBER of field in file 2 +"RTN","TMGGDFN",272,0) + ;"Output: 1=field exists, 0=doesn't exist +"RTN","TMGGDFN",273,0) + +"RTN","TMGGDFN",274,0) + quit ($data(^DD(2,FieldNum,0))'=0) +"RTN","TMGGDFN",275,0) + +"RTN","TMGGDFN",276,0) +ExtraLookup(Entry,Intensity) +"RTN","TMGGDFN",277,0) + ;"Purpose: Search for Patient (an existing entry in the database) +"RTN","TMGGDFN",278,0) + ;"Input: Entry -- Array is loaded with info, like this: +"RTN","TMGGDFN",279,0) + ;" Entry(.01)=Name +"RTN","TMGGDFN",280,0) + ;" Entry(.02)=Sex +"RTN","TMGGDFN",281,0) + ;" Entry(.03)=DOB +"RTN","TMGGDFN",282,0) + ;" Entry(.09)=SSNum +"RTN","TMGGDFN",283,0) + ;" Entry(22701)=SequelMedSystem Account Number +"RTN","TMGGDFN",284,0) + ;" Intensity -- How intense to search. +"RTN","TMGGDFN",285,0) + ;" NOTE: Because this returns the FIRST match, is it advised that this function +"RTN","TMGGDFN",286,0) + ;" be run with intensity 1 first, then 2-->3-->4 +"RTN","TMGGDFN",287,0) + ;"Result: returns FIRST matching DFN (patient internal entry number), or 0 if none found +"RTN","TMGGDFN",288,0) + ;"NOTE: For now, I am ignoring any passed Alias info. +"RTN","TMGGDFN",289,0) + +"RTN","TMGGDFN",290,0) + ;"Note: I am assuming that LookupPatient(Entry) has been called, and failed. +"RTN","TMGGDFN",291,0) + ;" Thus I am not going to compare SSNums, Medic or SequelMed's account numbers. +"RTN","TMGGDFN",292,0) + ;"------------------------------------------------------------------------------ +"RTN","TMGGDFN",293,0) + +"RTN","TMGGDFN",294,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGGDFN",295,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGGDFN",296,0) + if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 +"RTN","TMGGDFN",297,0) + if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 +"RTN","TMGGDFN",298,0) + set Intensity=$get(Intensity,1) +"RTN","TMGGDFN",299,0) + if Intensity=1 set Threshold=1 ;"(exact match) +"RTN","TMGGDFN",300,0) + if Intensity=2 set Threshold=.75 ;"(probable match) +"RTN","TMGGDFN",301,0) + if Intensity=3 set Threshold=.5 ;"(possible match) +"RTN","TMGGDFN",302,0) + if Intensity=4 set Threshold=.25 ;"(doubtful match) +"RTN","TMGGDFN",303,0) + +"RTN","TMGGDFN",304,0) + new Missing set Missing=0 +"RTN","TMGGDFN",305,0) + new BailOut set BailOut=0 +"RTN","TMGGDFN",306,0) + new result set result=0 ;"set default to no match, or conflict found +"RTN","TMGGDFN",307,0) + new TMGErrMsg,TMGOutput +"RTN","TMGGDFN",308,0) + new RecComp +"RTN","TMGGDFN",309,0) + +"RTN","TMGGDFN",310,0) + ;"If can find patient by SSNum, then don't look any further (if successful) +"RTN","TMGGDFN",311,0) + if +$get(Entry(.09))>0 set result=$$SSNumLookup(Entry(.09)) +"RTN","TMGGDFN",312,0) + if result>0 goto LUDone +"RTN","TMGGDFN",313,0) + +"RTN","TMGGDFN",314,0) + ;"If can find patient by SequelMedSystem account number, then don't look any further (if successful) +"RTN","TMGGDFN",315,0) + if (+$get(Entry(22701))>0),$$FieldExists(22701) set result=$$PMSNumLookup(Entry(22701)) if result>0 goto LUDone +"RTN","TMGGDFN",316,0) + +"RTN","TMGGDFN",317,0) + ;"If can find patient by Paradigm account number, then don't look any further (if successful) +"RTN","TMGGDFN",318,0) + if (+$get(Entry(22702))>0),$$FieldExists(22702) set result=$$ParadigmNumLookup(Entry(22702)) +"RTN","TMGGDFN",319,0) + if result>0 goto LUDone +"RTN","TMGGDFN",320,0) + +"RTN","TMGGDFN",321,0) + new SearchName set SearchName=$get(Entry(.01)) +"RTN","TMGGDFN",322,0) + if SearchName="" goto XLUDone +"RTN","TMGGDFN",323,0) + set SearchName=$$FormatName^TMGMISC(SearchName,1) +"RTN","TMGGDFN",324,0) + do STDNAME^XLFNAME(.SearchName,"C",.TMGErrMsg) ;"parse into component array +"RTN","TMGGDFN",325,0) + if Intensity>0 kill SearchName("SUFFIX") +"RTN","TMGGDFN",326,0) + if Intensity>1 kill SearchName("MIDDLE") +"RTN","TMGGDFN",327,0) + if Intensity>2 set SearchName("GIVEN")=$EXTRACT(SearchName("GIVEN"),1,3) +"RTN","TMGGDFN",328,0) + if Intensity>3 do +"RTN","TMGGDFN",329,0) + . set SearchName("GIVEN")=$EXTRACT(SearchName("GIVEN"),1,1) +"RTN","TMGGDFN",330,0) + . set SearchName("FAMILY")=$EXTRACT(SearchName("FAMILY"),1,3) +"RTN","TMGGDFN",331,0) + +"RTN","TMGGDFN",332,0) + set SearchName=$$BLDNAME^XLFNAME(.SearchName) +"RTN","TMGGDFN",333,0) + +"RTN","TMGGDFN",334,0) + +"RTN","TMGGDFN",335,0) + ;"========================================================= +"RTN","TMGGDFN",336,0) + ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",337,0) + do +"RTN","TMGGDFN",338,0) + . new Fields set Fields="@;.01;.02;.03" +"RTN","TMGGDFN",339,0) + . do FIND^DIC(2,"",Fields,"M",SearchName,"*","","","","TMGOutput","TMGErrMsg") +"RTN","TMGGDFN",340,0) + ;"========================================================= +"RTN","TMGGDFN",341,0) + +"RTN","TMGGDFN",342,0) + if $data(TMGErrMsg("DIERR")) goto XLUDone +"RTN","TMGGDFN",343,0) + +"RTN","TMGGDFN",344,0) + if $data(TMGOutput)'=0 do +"RTN","TMGGDFN",345,0) + . new NumMatch,Num +"RTN","TMGGDFN",346,0) + . set NumMatch=+$get(TMGOutput("DILIST",0),0) ;"Get first part of entry like this: '8^*^0^' <-8 matches +"RTN","TMGGDFN",347,0) + . for Num=1:1:NumMatch do ;"Compare all entries found. If NumMatch=0-->no 1st loop +"RTN","TMGGDFN",348,0) + . . new dbDataEntry +"RTN","TMGGDFN",349,0) + . . merge dbDataEntry=TMGOutput("DILIST","ID",Num) +"RTN","TMGGDFN",350,0) + . . set RecComp=$$XCompEntry(.Entry,.dbDataEntry,.Threshold) +"RTN","TMGGDFN",351,0) + . . if (RecComp=cInsufficient)&(NumMatch=1) do +"RTN","TMGGDFN",352,0) + . . . ;"Fileman has said there is 1 (and only 1) match. +"RTN","TMGGDFN",353,0) + . . . ;"Even if the supplied info is lacking, it is still a match. +"RTN","TMGGDFN",354,0) + . . . set RecComp=cFullMatch +"RTN","TMGGDFN",355,0) + . . if (RecComp=cFullMatch)!(RecComp=cExtraInfo) do +"RTN","TMGGDFN",356,0) + . . . set result=$get(TMGOutput("DILIST",2,Num),0) ;"This is DFN (record) number +"RTN","TMGGDFN",357,0) + . . . set Num=NumMatch+1 ;"some value to abort loop +"RTN","TMGGDFN",358,0) + +"RTN","TMGGDFN",359,0) +XLUDone; +"RTN","TMGGDFN",360,0) + quit result ;" return patient internal entry number (DFN) +"RTN","TMGGDFN",361,0) + +"RTN","TMGGDFN",362,0) + +"RTN","TMGGDFN",363,0) +XCompEntry(TestData,dbDataEntry,Threshold) ; +"RTN","TMGGDFN",364,0) + ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. +"RTN","TMGGDFN",365,0) + ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data +"RTN","TMGGDFN",366,0) + ;" See CompEntry for Format +"RTN","TMGGDFN",367,0) + ;" dbDataEntry -- array derived from output from FIND^DIC. See CompEntry for Format +"RTN","TMGGDFN",368,0) + ;" Threshold -- OPTIONAL --How strict to be during the comparison +"RTN","TMGGDFN",369,0) + ;" default is 1. +"RTN","TMGGDFN",370,0) + ;" e.g. 0.5 --> comparison value must >= 0.5 +"RTN","TMGGDFN",371,0) + ;" Valid values are: .25, .5, .75, 1 +"RTN","TMGGDFN",372,0) + ;"Results: +"RTN","TMGGDFN",373,0) + ;" return value = cConflict (0) if entries conflict +"RTN","TMGGDFN",374,0) + ;" return value = cFullMatch (1) if entries match (to the degreee specified by Threshold) +"RTN","TMGGDFN",375,0) + ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. +"RTN","TMGGDFN",376,0) + ;" return value = cInsufficient (3) Insufficient data to make match, but no conflict. +"RTN","TMGGDFN",377,0) + ;"Note: This function IS DIFFERENT then CompEntry (which this was originally copied from) +"RTN","TMGGDFN",378,0) + ;" --It's purpose is to look for matches after a partial fileman search, +"RTN","TMGGDFN",379,0) + ;" Smi,Jo for Smith,John +"RTN","TMGGDFN",380,0) + +"RTN","TMGGDFN",381,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGGDFN",382,0) + if $data(cConsistent)#10=0 new cConsistent set cConsistent=0.5 +"RTN","TMGGDFN",383,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGGDFN",384,0) + set Threshold=$get(Threshold,1) +"RTN","TMGGDFN",385,0) + if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 +"RTN","TMGGDFN",386,0) + +"RTN","TMGGDFN",387,0) + new tD,dbD +"RTN","TMGGDFN",388,0) + new CResult set CResult=cFullMatch ;"set default to match +"RTN","TMGGDFN",389,0) + new result set result=cFullMatch ;"default is Success. +"RTN","TMGGDFN",390,0) + new WorstScore set WorstScore=1 +"RTN","TMGGDFN",391,0) + new Extra set Extra=0 ;"0=false +"RTN","TMGGDFN",392,0) + +"RTN","TMGGDFN",393,0) + if $data(TestData(.01))#10'=0 do +"RTN","TMGGDFN",394,0) + . set tD=$get(TestData(.01)) ;"field .01 = NAME +"RTN","TMGGDFN",395,0) + . set dbD=$get(dbDataEntry(.01)) +"RTN","TMGGDFN",396,0) + . set result=$$CompName^TMGMISC(tD,dbD) +"RTN","TMGGDFN",397,0) + if result=cConflict goto CmpEDone +"RTN","TMGGDFN",398,0) + if resultWorstScore set result=WorstScore +"RTN","TMGGDFN",416,0) + set result=(result'success +"RTN","TMGGDFN",424,0) + if ($data(TestData(.01))#10=0)&($data(TestData(.03))=0) set result=cInsufficient +"RTN","TMGGDFN",425,0) + +"RTN","TMGGDFN",426,0) +XCmpEDone +"RTN","TMGGDFN",427,0) + +"RTN","TMGGDFN",428,0) + quit result +"RTN","TMGGDFN",429,0) + +"RTN","TMGGDFN",430,0) + +"RTN","TMGGDFN",431,0) + +"RTN","TMGGDFN",432,0) +SSNumLookup(SSNum) +"RTN","TMGGDFN",433,0) + ;"PURPOSE: To lookup patient by social security number +"RTN","TMGGDFN",434,0) + ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found +"RTN","TMGGDFN",435,0) + ;" +"RTN","TMGGDFN",436,0) + new result set result=0 +"RTN","TMGGDFN",437,0) + +"RTN","TMGGDFN",438,0) + new DIC +"RTN","TMGGDFN",439,0) + set DIC=2 +"RTN","TMGGDFN",440,0) + set DIC(0)="M" +"RTN","TMGGDFN",441,0) + set X=SSNum +"RTN","TMGGDFN",442,0) + do ^DIC +"RTN","TMGGDFN",443,0) + if +Y>0 set result=+Y +"RTN","TMGGDFN",444,0) + quit result +"RTN","TMGGDFN",445,0) + +"RTN","TMGGDFN",446,0) + +"RTN","TMGGDFN",447,0) +SSNum2Lookup(SSNum) +"RTN","TMGGDFN",448,0) + ;"NOTICE: I have learned to be more effecient, so will not use this function anymore +"RTN","TMGGDFN",449,0) + ;" Will use SSNumLookup instead +"RTN","TMGGDFN",450,0) + +"RTN","TMGGDFN",451,0) + ;"PURPOSE: To lookup patient by social security number +"RTN","TMGGDFN",452,0) + ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found +"RTN","TMGGDFN",453,0) + ;" +"RTN","TMGGDFN",454,0) + +"RTN","TMGGDFN",455,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SSNLookup^TMGGDFN") +"RTN","TMGGDFN",456,0) + +"RTN","TMGGDFN",457,0) + new result set result=0 ;"set default to no match, or conflict found +"RTN","TMGGDFN",458,0) + new TMGErrMsg,TMGOutput +"RTN","TMGGDFN",459,0) + +"RTN","TMGGDFN",460,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Entry' passed for processing:") +"RTN","TMGGDFN",461,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") +"RTN","TMGGDFN",462,0) + +"RTN","TMGGDFN",463,0) + ;"Below specifies fields to get back. Note: file 2 is PATIENT file. +"RTN","TMGGDFN",464,0) + new Value set Value=$get(SSNum) +"RTN","TMGGDFN",465,0) + +"RTN","TMGGDFN",466,0) + ;"========================================================= +"RTN","TMGGDFN",467,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGGDFN",468,0) + ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",469,0) + do +"RTN","TMGGDFN",470,0) + . new File set File=2 +"RTN","TMGGDFN",471,0) + . new IENS set IENS="" +"RTN","TMGGDFN",472,0) + . new Fields set Fields="@;.01;.02;.03;.09" +"RTN","TMGGDFN",473,0) + . if $$FieldExists(22700) set Fields=Fields_";22700" +"RTN","TMGGDFN",474,0) + . new Flags set Flags="M" +"RTN","TMGGDFN",475,0) + . new MatchValue set MatchValue=Value +"RTN","TMGGDFN",476,0) + . new Number set Number="*" ;"i.e. max number to return *=all entries. +"RTN","TMGGDFN",477,0) + . new Indexes set Indexes="" +"RTN","TMGGDFN",478,0) + . new ScreenCode set ScreenCode="" ;"option screening M code +"RTN","TMGGDFN",479,0) + . new Ident set Ident="" ;"optional text to accompany each found entry +"RTN","TMGGDFN",480,0) + . new OutVarP set OutVarP="TMGOutput" +"RTN","TMGGDFN",481,0) + . new ErrVarP set ErrVarP="TMGErrMsg" +"RTN","TMGGDFN",482,0) + . do FIND^DIC(File,IENS,Fields,Flags,MatchValue,Number,Indexes,ScreenCode,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",483,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGGDFN",484,0) + ;"========================================================= +"RTN","TMGGDFN",485,0) + +"RTN","TMGGDFN",486,0) + ;"if ($get(TMGDEBUG)>0) do +"RTN","TMGGDFN",487,0) + ;". if $data(TMGOutput)>0 do ArrayDump^TMGDEBUG("TMGOutput") +"RTN","TMGGDFN",488,0) + ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGOutput found.") +"RTN","TMGGDFN",489,0) + ;". if $data(TMGErrMsg)>0 do ArrayDump^TMGDEBUG("TMGErrMsg") +"RTN","TMGGDFN",490,0) + ;". else do DebugMsg^TMGDEBUG(.DBIndent,"No TMGErrMsg found") +"RTN","TMGGDFN",491,0) + +"RTN","TMGGDFN",492,0) + if $data(TMGErrMsg("DIERR")) do ShowDIERR^TMGDEBUG(.TMGErrMsg,.PriorErrorFound) +"RTN","TMGGDFN",493,0) + +"RTN","TMGGDFN",494,0) + if $data(TMGOutput)'=0 do +"RTN","TMGGDFN",495,0) + . new NumMatch,Num +"RTN","TMGGDFN",496,0) + . set NumMatch=+$PIECE(TMGOutput("DILIST",0),"^",1) ;"Get first part of entry like this: '8^*^0^' <-8 matches +"RTN","TMGGDFN",497,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,NumMatch," matches found in database") +"RTN","TMGGDFN",498,0) + . if NumMatch>0 set result=$get(TMGOutput("DILIST",2,1)) +"RTN","TMGGDFN",499,0) + +"RTN","TMGGDFN",500,0) +SSLUDone +"RTN","TMGGDFN",501,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Result (patient DFN#)=",result) +"RTN","TMGGDFN",502,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SSNLookup^TMGGDFN") +"RTN","TMGGDFN",503,0) + +"RTN","TMGGDFN",504,0) + quit result ;" return patient internal entry number (DFN) +"RTN","TMGGDFN",505,0) + +"RTN","TMGGDFN",506,0) + +"RTN","TMGGDFN",507,0) +PMSNumLookup(PMSNum) +"RTN","TMGGDFN",508,0) + ;"PURPOSE: To lookup patient by SequelSystem account number +"RTN","TMGGDFN",509,0) + ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found +"RTN","TMGGDFN",510,0) + ;" +"RTN","TMGGDFN",511,0) + +"RTN","TMGGDFN",512,0) + new result set result=0 ;"set default to no match, or conflict found +"RTN","TMGGDFN",513,0) + new TMGErrMsg,TMGOutput +"RTN","TMGGDFN",514,0) + +"RTN","TMGGDFN",515,0) + ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",516,0) + ;"Uses custom TMGS index. +"RTN","TMGGDFN",517,0) + do FIND^DIC(2,"",".01","",PMSNum,"*","TMGS","","","TMGOutput","TMGErrMsg") +"RTN","TMGGDFN",518,0) + +"RTN","TMGGDFN",519,0) + if '$data(TMGErrMsg("DIERR")) set result=$get(TMGOutput("DILIST",2,1),0) +"RTN","TMGGDFN",520,0) + quit result ;" return patient internal entry number (DFN) +"RTN","TMGGDFN",521,0) + +"RTN","TMGGDFN",522,0) + +"RTN","TMGGDFN",523,0) +ParadigmNumLookup(PMSNum) +"RTN","TMGGDFN",524,0) + ;"PURPOSE: To lookup patient by Paradigm account number +"RTN","TMGGDFN",525,0) + ;"Result: RETURNS DFN (patient internal entry number), or 0 if not found +"RTN","TMGGDFN",526,0) + +"RTN","TMGGDFN",527,0) + new result set result=0 ;"set default to no match, or conflict found +"RTN","TMGGDFN",528,0) + new TMGErrMsg,TMGOutput +"RTN","TMGGDFN",529,0) + +"RTN","TMGGDFN",530,0) + ;"FIND^DIC(File,IENStr,Fields,Flags,Value,Number,Indexes,Screen,Ident,OutVarP,ErrVarP) +"RTN","TMGGDFN",531,0) + ;"Uses custom TMGS index. +"RTN","TMGGDFN",532,0) + do FIND^DIC(2,"",".01","",PMSNum,"*","TMGP","","","TMGOutput","TMGErrMsg") +"RTN","TMGGDFN",533,0) + +"RTN","TMGGDFN",534,0) + if '$data(TMGErrMsg("DIERR")) set result=$get(TMGOutput("DILIST",2,1),0) +"RTN","TMGGDFN",535,0) + quit result ;" return patient internal entry number (DFN) +"RTN","TMGGDFN",536,0) + +"RTN","TMGGDFN",537,0) + +"RTN","TMGGDFN",538,0) +Compare(TestData,dbData,EntryNum) ; +"RTN","TMGGDFN",539,0) + ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. +"RTN","TMGGDFN",540,0) + ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data +"RTN","TMGGDFN",541,0) + ;" Format is: +"RTN","TMGGDFN",542,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",543,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",544,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",545,0) + ;" dbData -- array returned from FIND^DIC. +"RTN","TMGGDFN",546,0) + ;" EntryNum -- Entry number in dbData +"RTN","TMGGDFN",547,0) + ;"Results: +"RTN","TMGGDFN",548,0) + ;" return value = cConflict (0) if entries conflict +"RTN","TMGGDFN",549,0) + ;" return value = cFullMatch (1) if entries completely match +"RTN","TMGGDFN",550,0) + ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. +"RTN","TMGGDFN",551,0) + ;" return value = cInsufficient (3) Insufficient data to make match, but no conflict. +"RTN","TMGGDFN",552,0) + ;"Note: The following data sets will be sufficient for a match: +"RTN","TMGGDFN",553,0) + ;" 1. SSNumber (not a P/pseudo value) +"RTN","TMGGDFN",554,0) + ;" 2. Patient Identifier (field 22700) +"RTN","TMGGDFN",555,0) + ;" 3. Name, DOB +"RTN","TMGGDFN",556,0) + +"RTN","TMGGDFN",557,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"Compare^TMGGDFN") +"RTN","TMGGDFN",558,0) + +"RTN","TMGGDFN",559,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGGDFN",560,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGGDFN",561,0) + if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 +"RTN","TMGGDFN",562,0) + if $data(cInsufficient)#10=0 new cInsufficient set cInsufficient=3 +"RTN","TMGGDFN",563,0) + +"RTN","TMGGDFN",564,0) + new dbDataEntry,result +"RTN","TMGGDFN",565,0) + +"RTN","TMGGDFN",566,0) + ;"First, ensure no conflict between TestData and dbData +"RTN","TMGGDFN",567,0) + merge dbDataEntry=dbData("DILIST","ID",EntryNum) +"RTN","TMGGDFN",568,0) + set result=$$CompEntry(.TestData,.dbDataEntry) +"RTN","TMGGDFN",569,0) + if result=cConflict goto CompDone +"RTN","TMGGDFN",570,0) + +"RTN","TMGGDFN",571,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No conflict found so far") +"RTN","TMGGDFN",572,0) + +"RTN","TMGGDFN",573,0) + if $get(TestData(.01))="" kill TestData(.01) +"RTN","TMGGDFN",574,0) + if $get(TestData(.03))="" kill TestData(.03) +"RTN","TMGGDFN",575,0) + if $get(TestData(.09))="" kill TestData(.09) +"RTN","TMGGDFN",576,0) + if $get(TestData(22700))="" kill TestData(22700) +"RTN","TMGGDFN",577,0) + if $get(TestData(22701))="" kill TestData(22701) +"RTN","TMGGDFN",578,0) + +"RTN","TMGGDFN",579,0) + ;"OK, no conflict. But is there sufficient data for a match? +"RTN","TMGGDFN",580,0) + if (+$get(TestData(.09))>0)&($get(TestData(.09))'["P") goto CompDone ;".09=SSNum --> success +"RTN","TMGGDFN",581,0) + if ($data(TestData(22700))#10'=0) goto CompDone ;"22700=Pt. Identifier --> success +"RTN","TMGGDFN",582,0) + if ($data(TestData(.01))#10'=0)&($data(TestData(.03))) goto CompDone ;"Name & DOB-->success +"RTN","TMGGDFN",583,0) + +"RTN","TMGGDFN",584,0) + ;"If here, then we don't have enough data for a match +"RTN","TMGGDFN",585,0) + set result=cInsufficient +"RTN","TMGGDFN",586,0) + +"RTN","TMGGDFN",587,0) +CompDone +"RTN","TMGGDFN",588,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGGDFN",589,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"Compare^TMGGDFN") +"RTN","TMGGDFN",590,0) + quit result +"RTN","TMGGDFN",591,0) + +"RTN","TMGGDFN",592,0) + +"RTN","TMGGDFN",593,0) +CompEntry(TestData,dbDataEntry) ; +"RTN","TMGGDFN",594,0) + ;"PURPOSE: To compare two entries for certain fields, and return a comparison code. +"RTN","TMGGDFN",595,0) + ;"INPUT: TestData -- array holding uploaded data, that is being tested against preexisting data +"RTN","TMGGDFN",596,0) + ;" Format is: +"RTN","TMGGDFN",597,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",598,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",599,0) + ;" TestData(FieldNumber)=Value +"RTN","TMGGDFN",600,0) + ;" dbDataEntry -- array derived from output from FIND^DIC. +"RTN","TMGGDFN",601,0) + ;" Format is: +"RTN","TMGGDFN",602,0) + ;" dbDataEntry(FieldNumber)=Value +"RTN","TMGGDFN",603,0) + ;" dbDataEntry(FieldNumber)=Value +"RTN","TMGGDFN",604,0) + ;" dbDataEntry(FieldNumber)=Value +"RTN","TMGGDFN",605,0) + ;" EntryNum -- Entry number in dbDataEntry +"RTN","TMGGDFN",606,0) + ;"Results: +"RTN","TMGGDFN",607,0) + ;" return value = cConflict (0) if entries conflict +"RTN","TMGGDFN",608,0) + ;" return value = cFullMatch (1) if entries completely match +"RTN","TMGGDFN",609,0) + ;" return value = cExtraInfo (2) if entries have no conflict, but tEntry has extra info. +"RTN","TMGGDFN",610,0) + +"RTN","TMGGDFN",611,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CompEntry^TMGGDFN") +"RTN","TMGGDFN",612,0) + +"RTN","TMGGDFN",613,0) + if $data(cConflict)#10=0 new cConflict set cConflict=0 +"RTN","TMGGDFN",614,0) + if $data(cFullMatch)#10=0 new cFullMatch set cFullMatch=1 +"RTN","TMGGDFN",615,0) + if $data(cExtraInfo)#10=0 new cExtraInfo set cExtraInfo=2 +"RTN","TMGGDFN",616,0) + +"RTN","TMGGDFN",617,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'TestData' passed for processing:") +"RTN","TMGGDFN",618,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TestData") +"RTN","TMGGDFN",619,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'dbDataEntry' passed for processing:") +"RTN","TMGGDFN",620,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("dbDataEntry") +"RTN","TMGGDFN",621,0) + +"RTN","TMGGDFN",622,0) + new tD,dbD +"RTN","TMGGDFN",623,0) + new CResult set CResult=cFullMatch ;"set default to match (so data won't be entered into database) +"RTN","TMGGDFN",624,0) + new result set result=cFullMatch ;"default is Success. +"RTN","TMGGDFN",625,0) + new Extra set Extra=0 ;"0=false +"RTN","TMGGDFN",626,0) + +"RTN","TMGGDFN",627,0) + ;"I am not going to test field .01 (NAME) because Fileman has already done this, and +"RTN","TMGGDFN",628,0) + ;" feels that the names it has returned are compatible. +"RTN","TMGGDFN",629,0) + ;" I was having a problem with input like this: +"RTN","TMGGDFN",630,0) + ;" TestData(.01)="DOE,JOHN" +"RTN","TMGGDFN",631,0) + ;" dbDataEntry(.01)="DOE,JOHN J" +"RTN","TMGGDFN",632,0) + ;" And this was failing the match. It shouldn't have. +"RTN","TMGGDFN",633,0) + ;"if $data(TestData(.01))#10'=0 do +"RTN","TMGGDFN",634,0) + ;". set tD=$get(TestData(.01)) ;"field .01 = NAME +"RTN","TMGGDFN",635,0) + ;". set dbD=$get(dbDataEntry(.01)) +"RTN","TMGGDFN",636,0) + ;". set result=$$FieldCompare^TMGDBAPI(tD,dbD) +"RTN","TMGGDFN",637,0) + ;"if result=cConflict goto CmpEDone +"RTN","TMGGDFN",638,0) + ;"if result=cExtraInfo set Extra=1 +"RTN","TMGGDFN",639,0) + +"RTN","TMGGDFN",640,0) + if $data(TestData(.09))#10'=0 do +"RTN","TMGGDFN",641,0) + . set tD=$get(TestData(.09)) ;"field .09 = SSNUM +"RTN","TMGGDFN",642,0) + . set dbD=$get(dbDataEntry(.09)) +"RTN","TMGGDFN",643,0) + . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"SSNUM") +"RTN","TMGGDFN",644,0) + if result=cConflict goto CmpEDone +"RTN","TMGGDFN",645,0) + if result=cExtraInfo set Extra=1 +"RTN","TMGGDFN",646,0) + +"RTN","TMGGDFN",647,0) + if $data(TestData(.02))#10'=0 do +"RTN","TMGGDFN",648,0) + . set tD=$get(TestData(.02)) ;"field .02 = SEX +"RTN","TMGGDFN",649,0) + . set dbD=$get(dbDataEntry(.02)) +"RTN","TMGGDFN",650,0) + . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"SEX") +"RTN","TMGGDFN",651,0) + if result=cConflict goto CmpEDone +"RTN","TMGGDFN",652,0) + if result=cExtraInfo set Extra=1 +"RTN","TMGGDFN",653,0) + +"RTN","TMGGDFN",654,0) + if $data(TestData(.03))#10'=0 do +"RTN","TMGGDFN",655,0) + . set tD=$get(TestData(.03)) ;"field .03 = DOB +"RTN","TMGGDFN",656,0) + . set dbD=$get(dbDataEntry(.03)) +"RTN","TMGGDFN",657,0) + . set result=$$FieldCompare^TMGDBAPI(tD,dbD,"DATE") +"RTN","TMGGDFN",658,0) + if result=cConflict goto CmpEDone +"RTN","TMGGDFN",659,0) + if result=cExtraInfo set Extra=1 +"RTN","TMGGDFN",660,0) + +"RTN","TMGGDFN",661,0) + ;"if $data(TestData(22700))#10'=0 do +"RTN","TMGGDFN",662,0) + ;". set tD=$get(TestData(22700)) ;"field 22700 = Patient ID number +"RTN","TMGGDFN",663,0) + ;". set dbD=$get(dbDataEntry(22700)) +"RTN","TMGGDFN",664,0) + ;". set result=$$FieldCompare^TMGDBAPI(tD,dbD,"NUMBER") +"RTN","TMGGDFN",665,0) + ;"if result=cConflict goto CmpEDone +"RTN","TMGGDFN",666,0) + ;"if result=cExtraInfo set Extra=1 +"RTN","TMGGDFN",667,0) + +"RTN","TMGGDFN",668,0) + ;"If we are here, then there is no conflict. +"RTN","TMGGDFN",669,0) + set result=cFullMatch +"RTN","TMGGDFN",670,0) + ;"If extra info present, reflect this in result +"RTN","TMGGDFN",671,0) + if Extra=1 set result=cExtraInfo +"RTN","TMGGDFN",672,0) + +"RTN","TMGGDFN",673,0) +CmpEDone +"RTN","TMGGDFN",674,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGGDFN",675,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CompEntry^TMGGDFN") +"RTN","TMGGDFN",676,0) + +"RTN","TMGGDFN",677,0) + quit result +"RTN","TMGGDFN",678,0) + +"RTN","TMGGDFN",679,0) +AddToPat(PatIEN,Entry) +"RTN","TMGGDFN",680,0) + ;"PURPOSE: Stuffs Entry into record number PatIEN (RecNum must already exist) +"RTN","TMGGDFN",681,0) + ;"INPUT: PatIEN -- the record number, in file 2, that is to be updated +"RTN","TMGGDFN",682,0) + ;" Entry -- the record to put in +"RTN","TMGGDFN",683,0) + ;" Format is: +"RTN","TMGGDFN",684,0) + ;" Entry(FieldNumber)=Value +"RTN","TMGGDFN",685,0) + ;" Entry(FieldNumber)=Value +"RTN","TMGGDFN",686,0) + ;" Entry(FieldNumber)=Value +"RTN","TMGGDFN",687,0) + ;" The following FieldNumbers will be used if avail. +"RTN","TMGGDFN",688,0) + ;" .01,.02,.03,.09,22700 +"RTN","TMGGDFN",689,0) + ;"Results: cOKToCont (1) or cAbort(0) +"RTN","TMGGDFN",690,0) + +"RTN","TMGGDFN",691,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGGDFN",692,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGGDFN",693,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGGDFN",694,0) + +"RTN","TMGGDFN",695,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddToPat^TMGGDFN") +"RTN","TMGGDFN",696,0) + +"RTN","TMGGDFN",697,0) + new TMGFDA,TMGMsg +"RTN","TMGGDFN",698,0) + new result set result=cOKToCont +"RTN","TMGGDFN",699,0) + +"RTN","TMGGDFN",700,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is Entry passed for processing") +"RTN","TMGGDFN",701,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") +"RTN","TMGGDFN",702,0) + +"RTN","TMGGDFN",703,0) + if $get(Entry(.01))'="" set TMGFDA(2,PatIEN_",",.01)=Entry(.01) ;"field .01 = NAME +"RTN","TMGGDFN",704,0) + if $get(Entry(.02))'="" set TMGFDA(2,PatIEN_",",.02)=Entry(.02) ;"field .02 = SEX +"RTN","TMGGDFN",705,0) + if $get(Entry(.03))'="" set TMGFDA(2,PatIEN_",",.03)=Entry(.03) ;"field .03 = DOB +"RTN","TMGGDFN",706,0) + if $get(Entry(.09))'=""&($get(Entry(.09))'["P") do +"RTN","TMGGDFN",707,0) + . set TMGFDA(2,PatIEN_",",.09)=Entry(.09) ;"field .09 = SSNUM +"RTN","TMGGDFN",708,0) + if $get(Entry(22700))'="" set TMGFDA(2,PatIEN_",",22700)=Entry(22700) ;"field 22700 = Patient Medic ID Num (custom field) +"RTN","TMGGDFN",709,0) + +"RTN","TMGGDFN",710,0) + set result=$$dbWrite^TMGDBAPI(.TMGFDA,1) +"RTN","TMGGDFN",711,0) + if result=cAbort goto ATRDone +"RTN","TMGGDFN",712,0) + +"RTN","TMGGDFN",713,0) +ATRDone +"RTN","TMGGDFN",714,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddToPat") +"RTN","TMGGDFN",715,0) + quit result +"RTN","TMGGDFN",716,0) + +"RTN","TMGGDFN",717,0) + +"RTN","TMGGDFN",718,0) + +"RTN","TMGGDFN",719,0) +AddNewPt(Entry,ErrArray) +"RTN","TMGGDFN",720,0) + ;"Purpose: Create a new entry in file 2 (Patient File) +"RTN","TMGGDFN",721,0) + ;"Input: 'Entry' array should be set up prior to calling. See those items expected below +"RTN","TMGGDFN",722,0) + ;" Entry(.01)=Patient Name +"RTN","TMGGDFN",723,0) + ;" Entry(.03)=DOB +"RTN","TMGGDFN",724,0) + ;" Entry(.09)=SS Num +"RTN","TMGGDFN",725,0) + ;" Entry(22700)=Medic Pt Identifier -- optional +"RTN","TMGGDFN",726,0) + ;" Entry(1901)=field 1901 = VETERAN Y/N --For my purposes, use NO -- optional +"RTN","TMGGDFN",727,0) + ;" Entry(.301)=field .301 = "SERVICE CONNECTED?" -- required field -- optional +"RTN","TMGGDFN",728,0) + ;" Entry(391)=field 391 = "TYPE" - required field -- optional +"RTN","TMGGDFN",729,0) + +"RTN","TMGGDFN",730,0) + ;" ErrArray (OPTIONAL) -- PASS BY REFERENCE. An OUT parameter to receive +"RTN","TMGGDFN",731,0) + ;" Fileman "DIERR" message, if any +"RTN","TMGGDFN",732,0) + ;" Note: To use this, and have the function not display the Fileman +"RTN","TMGGDFN",733,0) + ;" Error to the screen, ** must SET ErrArray=-1 (-1 = extra quiet mode) +"RTN","TMGGDFN",734,0) + ;" If TMGDEBUG is defined, then this quit mode described above will NOT be used, +"RTN","TMGGDFN",735,0) + ;" and existing values for TMGDEBUG will be used. +"RTN","TMGGDFN",736,0) + ;"Output: Returns internal entry number (DFN) if successful, otherwise 0 +"RTN","TMGGDFN",737,0) + ;"Note: The following data sets must be available for a patient to be entered: +"RTN","TMGGDFN",738,0) + ;" Patient name (.01) -- always required +"RTN","TMGGDFN",739,0) + ;" Patient sex (.02) -- always required +"RTN","TMGGDFN",740,0) + ;" And ONE of the following... +"RTN","TMGGDFN",741,0) + ;" 1. SSNumber (.09) (not a P/pseudo value) +"RTN","TMGGDFN",742,0) + ;" 2. Patient Identifier (field 22700) +"RTN","TMGGDFN",743,0) + ;" 3. DOB (.03) +"RTN","TMGGDFN",744,0) + ;"Results: returns the DFN of the added record, or 0 if not added/error +"RTN","TMGGDFN",745,0) + +"RTN","TMGGDFN",746,0) + +"RTN","TMGGDFN",747,0) + ;"if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"AddNewPt^TMGGDFN") +"RTN","TMGGDFN",748,0) + +"RTN","TMGGDFN",749,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGGDFN",750,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGGDFN",751,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGGDFN",752,0) + +"RTN","TMGGDFN",753,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is the 'Entry' passed for processing:") +"RTN","TMGGDFN",754,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Entry") +"RTN","TMGGDFN",755,0) + +"RTN","TMGGDFN",756,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGGDFN",757,0) + new result set result=cOKToCont ;"default it success. +"RTN","TMGGDFN",758,0) + +"RTN","TMGGDFN",759,0) + if ($Data(Entry(.09))#10'=0) do ;"Kill SSNum if it isn't in right format +"RTN","TMGGDFN",760,0) + . set Entry(.09)=$translate(Entry(.09),"- ","") +"RTN","TMGGDFN",761,0) + . if Entry(.09)'?9N0.1"P" kill Entry(.09) +"RTN","TMGGDFN",762,0) + +"RTN","TMGGDFN",763,0) + if ($Data(Entry(.01))#10=0) goto ANPDone ;"Abort +"RTN","TMGGDFN",764,0) + if ($Data(Entry(.03))#10'=0) goto ANPOK ;"OK to make record +"RTN","TMGGDFN",765,0) + if ($Data(Entry(.09))#10'=0) goto ANPOK ;"OK to make record +"RTN","TMGGDFN",766,0) + if ($Data(Entry(22700))#10'=0) goto ANPOK ;"OK to make record +"RTN","TMGGDFN",767,0) + +"RTN","TMGGDFN",768,0) + ;"If we get to this point, then insufficient data to add record... so abort +"RTN","TMGGDFN",769,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Not enough info to create unique patient record.") +"RTN","TMGGDFN",770,0) + set result=cAbort +"RTN","TMGGDFN",771,0) + goto ANPDone ;"Abort +"RTN","TMGGDFN",772,0) + +"RTN","TMGGDFN",773,0) +ANPOK +"RTN","TMGGDFN",774,0) + ;"Note: the "2" means file 2 (PATIENT file), and "+1" means "add entry" +"RTN","TMGGDFN",775,0) + set TMGFDA(2,"+1,",.096)="`"_DUZ ;"field .096 = WHO ENTERED PATIENT (`DUZ=current user) +"RTN","TMGGDFN",776,0) + set TMGFDA(2,"+1,",.01)=Entry(.01) ;"field .01 = NAME +"RTN","TMGGDFN",777,0) + if $data(Entry(.02)) set TMGFDA(2,"+1,",.02)=Entry(.02) ;"field .02 = SEX +"RTN","TMGGDFN",778,0) + if $data(Entry(.03)) set TMGFDA(2,"+1,",.03)=Entry(.03) ;"field .03 = DOB +"RTN","TMGGDFN",779,0) + if +$get(Entry(.09))>0 set TMGFDA(2,"+1,",.09)=Entry(.09) ;"field .09 = SSNUM +"RTN","TMGGDFN",780,0) + if $data(Entry(22700)),$$FieldExists(22700) set TMGFDA(2,"+1,",22700)=Entry(22700) ;"field 22700 = Patient ID Num (custom field) +"RTN","TMGGDFN",781,0) + ;"These fields below *USED TO BE* required. I changed the filemans status for these fields to NOT required +"RTN","TMGGDFN",782,0) + if $data(Entry(1901)) set TMGFDA(2,"+1,",1901)=Entry(1901) +"RTN","TMGGDFN",783,0) + else set TMGFDA(2,"+1,",1901)="NO" ;"field 1901 = VETERAN Y/N --For my purposes, use NO +"RTN","TMGGDFN",784,0) + if $data(Entry(.301)) set TMGFDA(2,"+1,",.301)=Entry(.301) +"RTN","TMGGDFN",785,0) + else set TMGFDA(2,"+1,",.301)="NO" ;"field .301 = SERVICE CONNECTED? -- required field +"RTN","TMGGDFN",786,0) + if $data(Entry(391)) set TMGFDA(2,"+1,",391)=Entry(391) +"RTN","TMGGDFN",787,0) + else set TMGFDA(2,"+1,",391)="NON-VETERAN (OTHER)" ;"field 391 = "TYPE" - required field +"RTN","TMGGDFN",788,0) + +"RTN","TMGGDFN",789,0) + if $data(TMGDEBUG)=0 new TMGDEBUG +"RTN","TMGGDFN",790,0) + set TMGDEBUG=$get(ErrArray,0) +"RTN","TMGGDFN",791,0) + +"RTN","TMGGDFN",792,0) + ;"set result=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN,,.ErrArray) +"RTN","TMGGDFN",793,0) + do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGGDFN",794,0) + if $data(TMGMSG("DIERR")) do +"RTN","TMGGDFN",795,0) + . ;"TMGDEBUG=-1 --> extra quiet mode +"RTN","TMGGDFN",796,0) + . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGGDFN",797,0) + . merge ErrArray("DIERR")=TMGMSG("DIERR") +"RTN","TMGGDFN",798,0) + . set result=cAbort +"RTN","TMGGDFN",799,0) + +"RTN","TMGGDFN",800,0) + if result=cAbort goto ANPDone +"RTN","TMGGDFN",801,0) + +"RTN","TMGGDFN",802,0) + set result=+$get(TMGIEN(1)) ;"result is the added patient's IEN +"RTN","TMGGDFN",803,0) + if result'>0 goto ANPDone +"RTN","TMGGDFN",804,0) + +"RTN","TMGGDFN",805,0) + ;"Add subfile entry for Alias if an alias was specified. +"RTN","TMGGDFN",806,0) + if $data(Entry(10,.01)) do ;"field 10 in file 2 = ALIAS, .01 subfield=ALIAS +"RTN","TMGGDFN",807,0) + . kill TMGFDA,TMGMsg,TMGIEN,tempresult +"RTN","TMGGDFN",808,0) + . set TMGFDA(2.01,"+1,"_result_",",.01)=Entry(10,.01) +"RTN","TMGGDFN",809,0) + . ;"set tempresult=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN,,.ErrArray) +"RTN","TMGGDFN",810,0) + . do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGGDFN",811,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGGDFN",812,0) + . . ;"TMGDEBUG=-1 --> extra quiet mode +"RTN","TMGGDFN",813,0) + . . if $get(TMGDEBUG)>-1 do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGGDFN",814,0) + . . merge ErrArray("DIERR")=TMGMSG("DIERR") +"RTN","TMGGDFN",815,0) + +"RTN","TMGGDFN",816,0) + ;"Now, manually add a record in the file 9000001 (^AUPNPAT) with IEN (stored in result) +"RTN","TMGGDFN",817,0) + ;"This is done because some PATIENT fields don't point to the PATIENT file, but instead +"RTN","TMGGDFN",818,0) + ;" point to the PATIENT/IHS file (9000001), which in turn points to the PATIENT file. +"RTN","TMGGDFN",819,0) + set ^AUPNPAT(result,0)=result +"RTN","TMGGDFN",820,0) + set ^AUPNPAT("B",result,result)="" +"RTN","TMGGDFN",821,0) + if $data(Entry(.09)) do +"RTN","TMGGDFN",822,0) + . set ^AUPNPAT(result,41,0)="^9000001.41P^1^1" +"RTN","TMGGDFN",823,0) + . set ^AUPNPAT(result,41,1,0)="1^"_Entry(.09) +"RTN","TMGGDFN",824,0) + +"RTN","TMGGDFN",825,0) +ANPDone +"RTN","TMGGDFN",826,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result / IEN of added record=",result) +"RTN","TMGGDFN",827,0) + ;"if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"AddNewPt^TMGGDFN") +"RTN","TMGGDFN",828,0) + quit result +"RTN","TMGGDFN",829,0) + +"RTN","TMGGDFN",830,0) + +"RTN","TMGGDFN",831,0) + +"RTN","TMGGDFN",832,0) + +"RTN","TMGGDFN",833,0) + +"RTN","TMGHTML1") +0^22^B6207 +"RTN","TMGHTML1",1,0) +TMGHTML1 ;TMG/kst/HTML Mini-chart creator ;03/25/06 +"RTN","TMGHTML1",2,0) + ;;1.0;TMG-LIB;**1**;01/10/06 +"RTN","TMGHTML1",3,0) + +"RTN","TMGHTML1",4,0) + ;"TMG HTML EXPORT FUNCTION +"RTN","TMGHTML1",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGHTML1",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGHTML1",7,0) + ;"1-10-2006 +"RTN","TMGHTML1",8,0) + +"RTN","TMGHTML1",9,0) + ;"======================================================================= +"RTN","TMGHTML1",10,0) + ;" API -- Public Functions. +"RTN","TMGHTML1",11,0) + ;"======================================================================= +"RTN","TMGHTML1",12,0) + +"RTN","TMGHTML1",13,0) + ;"======================================================================= +"RTN","TMGHTML1",14,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGHTML1",15,0) + ;"======================================================================= +"RTN","TMGHTML1",16,0) + ;"DumpNtes(List,FPath,OutArray) +"RTN","TMGHTML1",17,0) + ;"MakeFName(IEN) +"RTN","TMGHTML1",18,0) + ;"GetTemplateRecs(pRecs,Template) +"RTN","TMGHTML1",19,0) + ;"Write1Note(IEN) +"RTN","TMGHTML1",20,0) + +"RTN","TMGHTML1",21,0) + +"RTN","TMGHTML1",22,0) + ;"======================================================================= +"RTN","TMGHTML1",23,0) + ;"Dependencies (duplicates shown in parenthesies) +"RTN","TMGHTML1",24,0) + ;"======================================================================= +"RTN","TMGHTML1",25,0) + ;"^TMGMISC +"RTN","TMGHTML1",26,0) + +"RTN","TMGHTML1",27,0) +MAKESITE(FPath,Template) +"RTN","TMGHTML1",28,0) + ;"Purpose: To create an interlinked site with specified notes. +"RTN","TMGHTML1",29,0) + ;"Input: FPath OPTIONAL -- if not provided, user will be asked +"RTN","TMGHTML1",30,0) + ;" This is the directory where output is to be sent +"RTN","TMGHTML1",31,0) + ;" Input OPTIONAL -- if not provided, user will be asked +"RTN","TMGHTML1",32,0) + ;" This is the name of the search/sort template holding +"RTN","TMGHTML1",33,0) + ;" a list of IENs to output +"RTN","TMGHTML1",34,0) + ;"Output: files are written to file system +"RTN","TMGHTML1",35,0) + ;"Result: none. +"RTN","TMGHTML1",36,0) + +"RTN","TMGHTML1",37,0) + +"RTN","TMGHTML1",38,0) + if $get(FPath)="" do +"RTN","TMGHTML1",39,0) + . write !!,"This will export TIU DOCUMENT records to an interlinked website.",!! +"RTN","TMGHTML1",40,0) + . read "Enter destination directory path: ",FPath,! +"RTN","TMGHTML1",41,0) + if FPath="^" goto MSDone +"RTN","TMGHTML1",42,0) + +"RTN","TMGHTML1",43,0) + ;"Create core index.htm +"RTN","TMGHTML1",44,0) + ;"---------------------- +"RTN","TMGHTML1",45,0) + if $$OpenIO(FPath,"index.htm")=0 do goto MSDone +"RTN","TMGHTML1",46,0) + . write "Error. Aborting.",! +"RTN","TMGHTML1",47,0) + new offset +"RTN","TMGHTML1",48,0) + for offset=1:1 do quit:(s["{^}") +"RTN","TMGHTML1",49,0) + . set s=$piece($TEXT(IndexDat+offset),";;",2) +"RTN","TMGHTML1",50,0) + . quit:(s["{^}") +"RTN","TMGHTML1",51,0) + . write s,! +"RTN","TMGHTML1",52,0) + do ^%ZISC ;" Close the output device +"RTN","TMGHTML1",53,0) + +"RTN","TMGHTML1",54,0) + ;"Create core intro.htm +"RTN","TMGHTML1",55,0) + ;"---------------------- +"RTN","TMGHTML1",56,0) + if $$OpenIO(FPath,"intro.htm")=0 do goto MSDone +"RTN","TMGHTML1",57,0) + . write "Error. Aborting.",! +"RTN","TMGHTML1",58,0) + new offset +"RTN","TMGHTML1",59,0) + for offset=1:1 do quit:(s["{^}") +"RTN","TMGHTML1",60,0) + . set s=$piece($TEXT(IntroDat+offset),";;",2) +"RTN","TMGHTML1",61,0) + . quit:(s["{^}") +"RTN","TMGHTML1",62,0) + . write s,! +"RTN","TMGHTML1",63,0) + do ^%ZISC ;" Close the output device +"RTN","TMGHTML1",64,0) + +"RTN","TMGHTML1",65,0) + ;"Create individual files with notes. +"RTN","TMGHTML1",66,0) + ;"----------------------------------- +"RTN","TMGHTML1",67,0) + new OutArray +"RTN","TMGHTML1",68,0) + do WriteTemplate(.FPath,.Template,.OutArray) +"RTN","TMGHTML1",69,0) + +"RTN","TMGHTML1",70,0) + +"RTN","TMGHTML1",71,0) + ;"Create toc.htm-- the table of contents. +"RTN","TMGHTML1",72,0) + ;"--------------------------------------- +"RTN","TMGHTML1",73,0) + if $$OpenIO(FPath,"toc.htm")=0 do goto MSDone +"RTN","TMGHTML1",74,0) + . write "Error. Aborting.",! +"RTN","TMGHTML1",75,0) + do MakeTOC(.OutArray) +"RTN","TMGHTML1",76,0) + do ^%ZISC ;" Close the output device +"RTN","TMGHTML1",77,0) + +"RTN","TMGHTML1",78,0) +MSDone +"RTN","TMGHTML1",79,0) + write "Good bye.",!! +"RTN","TMGHTML1",80,0) + quit +"RTN","TMGHTML1",81,0) + +"RTN","TMGHTML1",82,0) +WriteTemplate(FPath,Template,OutArray) +"RTN","TMGHTML1",83,0) + ;"Purpose: To write out notes listed in Template to directory FPath +"RTN","TMGHTML1",84,0) + ;"Input: FPath -- The name of the directory to put the output files to +"RTN","TMGHTML1",85,0) + ;" Template -- OPTIONAL -- the name of a search/sort template that contains +"RTN","TMGHTML1",86,0) + ;" list of IENS's to output +"RTN","TMGHTML1",87,0) + ;" If not supplied, user will be asked for name. +"RTN","TMGHTML1",88,0) + ;" OutArray -- An OUT parameter. PASS BY REFERENCE +"RTN","TMGHTML1",89,0) + ;" An array to receive results of names written. See WriteList for format +"RTN","TMGHTML1",90,0) + ;"Output: files are written to directory +"RTN","TMGHTML1",91,0) + ;"Result: none +"RTN","TMGHTML1",92,0) + +"RTN","TMGHTML1",93,0) + new List,count +"RTN","TMGHTML1",94,0) + set count=$$GetTemplateRecs("List",.Template) +"RTN","TMGHTML1",95,0) + +"RTN","TMGHTML1",96,0) + new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)" +"RTN","TMGHTML1",97,0) + +"RTN","TMGHTML1",98,0) + if count>0 do +"RTN","TMGHTML1",99,0) + . do WriteList(.List,FPath,.OutArray,PrgsFn) +"RTN","TMGHTML1",100,0) + +"RTN","TMGHTML1",101,0) + quit +"RTN","TMGHTML1",102,0) + +"RTN","TMGHTML1",103,0) + +"RTN","TMGHTML1",104,0) +WriteList(List,FPath,OutArray,PrgCallback) +"RTN","TMGHTML1",105,0) + ;"Purpose: To write out all notes given in List to separate files in FPath +"RTN","TMGHTML1",106,0) + ;"Input: List -- PASS BY REFERENCE. A list of IEN's that must be written. +"RTN","TMGHTML1",107,0) + ;" Format as follows: +"RTN","TMGHTML1",108,0) + ;" List(IEN1)="" +"RTN","TMGHTML1",109,0) + ;" List(IEN2)="" +"RTN","TMGHTML1",110,0) + ;" List(IEN3)="" +"RTN","TMGHTML1",111,0) + ;" List(IEN4)="" +"RTN","TMGHTML1",112,0) + ;" ... +"RTN","TMGHTML1",113,0) + ;" FPath -- The name of the directory that files should be written to +"RTN","TMGHTML1",114,0) + ;" e.g. "/tmp/output/" +"RTN","TMGHTML1",115,0) + ;" OutArray -- An OUT parameter. PASS BY REFERENCE +"RTN","TMGHTML1",116,0) + ;" An array to receive results of names written. Format: +"RTN","TMGHTML1",117,0) + ;" OutArray(IEN1)=Filename1 +"RTN","TMGHTML1",118,0) + ;" OutArray(IEN1,PatientNameAndDOB1)="" +"RTN","TMGHTML1",119,0) + ;" OutArray(IEN2)=Filename2 +"RTN","TMGHTML1",120,0) + ;" OutArray(IEN2,PatientNameAndDOB2)="" +"RTN","TMGHTML1",121,0) + ;" OutArray(IEN3)=Filename3 +"RTN","TMGHTML1",122,0) + ;" OutArray(IEN3,PatientNameAndDOB3)="" +"RTN","TMGHTML1",123,0) + ;" OutArray(IEN4)=Filename4 +"RTN","TMGHTML1",124,0) + ;" OutArray(IEN4,PatientNameAndDOB4)="" +"RTN","TMGHTML1",125,0) + ;" OutArray("B",PatientNameAndDOB1,IEN1)="" +"RTN","TMGHTML1",126,0) + ;" OutArray("B",PatientNameAndDOB1,IEN1b)="" <-- if more than one IEN per patient. +"RTN","TMGHTML1",127,0) + ;" OutArray("B",PatientNameAndDOB2,IEN2)="" +"RTN","TMGHTML1",128,0) + ;" OutArray("B",PatientNameAndDOB3,IEN3)="" +"RTN","TMGHTML1",129,0) + ;" OutArray("B",PatientNameAndDOB4,IEN4)="" +"RTN","TMGHTML1",130,0) + ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string +"RTN","TMGHTML1",131,0) + ;" will be xecuted periodically, to allow display of a progress bar etc. +"RTN","TMGHTML1",132,0) + ;" Note: the following variables with global scope will be declared and +"RTN","TMGHTML1",133,0) + ;" available for use: TMGCUR (current count), TMGMAX (max count), +"RTN","TMGHTML1",134,0) + ;" TMGSTART (the start time +"RTN","TMGHTML1",135,0) + ;" +"RTN","TMGHTML1",136,0) + ;"Output: A series of files will be written (or overwritten) to directory +"RTN","TMGHTML1",137,0) + ;" Each file will be a TIU DOCUMENT in .htm format. +"RTN","TMGHTML1",138,0) + ;" Filename format: lastname_firstname_title_datetime.htm +"RTN","TMGHTML1",139,0) + ;"Result: none +"RTN","TMGHTML1",140,0) + +"RTN","TMGHTML1",141,0) + new ien +"RTN","TMGHTML1",142,0) + kill OutArray +"RTN","TMGHTML1",143,0) + new TMGMAX set TMGMAX=0 +"RTN","TMGHTML1",144,0) + new TMGSTART set TMGSTART=$H +"RTN","TMGHTML1",145,0) + new TMGCUR set TMGCUR=0 +"RTN","TMGHTML1",146,0) + set ien=$order(List("")) +"RTN","TMGHTML1",147,0) + if ien'="" for do quit:(ien="") +"RTN","TMGHTML1",148,0) + . set TMGMAX=TMGMAX+1 +"RTN","TMGHTML1",149,0) + . set ien=$order(List(ien)) +"RTN","TMGHTML1",150,0) + new delay set delay=0 +"RTN","TMGHTML1",151,0) + +"RTN","TMGHTML1",152,0) + set ien=$order(List("")) +"RTN","TMGHTML1",153,0) + if ien'="" for do quit:(ien="") +"RTN","TMGHTML1",154,0) + . set TMGCUR=TMGCUR+1 +"RTN","TMGHTML1",155,0) + . new FName +"RTN","TMGHTML1",156,0) + . set FName=$$MakeFName(ien) +"RTN","TMGHTML1",157,0) + . if $$OpenIO(FPath,FName)'=0 do +"RTN","TMGHTML1",158,0) + . . do Write1Note(ien) +"RTN","TMGHTML1",159,0) + . . do ^%ZISC ;" Close the output device +"RTN","TMGHTML1",160,0) + . . set OutArray(ien)=FName +"RTN","TMGHTML1",161,0) + . . new PtName,DOB,DFN +"RTN","TMGHTML1",162,0) + . . set DFN=$$GET1^DIQ(8925,ien_",",.02,"I") +"RTN","TMGHTML1",163,0) + . . set PtName=$$GET1^DIQ(2,DFN_",",.01) +"RTN","TMGHTML1",164,0) + . . set DOB=$$GET1^DIQ(2,DFN_",",.03) +"RTN","TMGHTML1",165,0) + . . set PtName=PtName_" "_DOB +"RTN","TMGHTML1",166,0) + . . set OutArray(ien,PtName)="" +"RTN","TMGHTML1",167,0) + . . set OutArray("B",PtName,ien)="" +"RTN","TMGHTML1",168,0) + . if (delay>30),$get(PrgCallback)'="" do ;"update progress bar every 30 cycles +"RTN","TMGHTML1",169,0) + . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGHTML1",170,0) + . . xecute PrgCallback ;"call the specified progress code. +"RTN","TMGHTML1",171,0) + . . set delay=0 +"RTN","TMGHTML1",172,0) + . else set delay=delay+1 +"RTN","TMGHTML1",173,0) + . set ien=$order(List(ien)) +"RTN","TMGHTML1",174,0) + +"RTN","TMGHTML1",175,0) + quit +"RTN","TMGHTML1",176,0) + +"RTN","TMGHTML1",177,0) + +"RTN","TMGHTML1",178,0) +OpenIO(FPath,FName,NodeDiv) +"RTN","TMGHTML1",179,0) + ;"Purpose: to open the IO channel such that all writes +"RTN","TMGHTML1",180,0) + ;" will go to the file specified. +"RTN","TMGHTML1",181,0) + ;"Input: FPath -- the path to open file in +"RTN","TMGHTML1",182,0) + ;" FName -- the name of the file to open +"RTN","TMGHTML1",183,0) + ;" NodeDiv -- OPTIONAL (default is "/") -- the path delimiter for OS +"RTN","TMGHTML1",184,0) + ;"result: 1=OK To continue, 0=error +"RTN","TMGHTML1",185,0) + +"RTN","TMGHTML1",186,0) + new result set result=1 +"RTN","TMGHTML1",187,0) + new PFName set PFName=FPath +"RTN","TMGHTML1",188,0) + set NodeDiv=$get(NodeDiv,"/") +"RTN","TMGHTML1",189,0) + new ch +"RTN","TMGHTML1",190,0) + set ch=$extract(PFName,$length(PFName)) +"RTN","TMGHTML1",191,0) + if ch'=NodeDiv set PFName=PFName_NodeDiv +"RTN","TMGHTML1",192,0) + set PFName=PFName_FName +"RTN","TMGHTML1",193,0) + +"RTN","TMGHTML1",194,0) + ;"Select IO channel +"RTN","TMGHTML1",195,0) + set %ZIS("HFSNAME")=PFName +"RTN","TMGHTML1",196,0) + set %ZIS="Q" ;"queing allowed +"RTN","TMGHTML1",197,0) + set %ZIS("HFSMODE")="W" ;"write mode +"RTN","TMGHTML1",198,0) + set IOP="HFS" +"RTN","TMGHTML1",199,0) + +"RTN","TMGHTML1",200,0) + do ^%ZIS ;"standard device call +"RTN","TMGHTML1",201,0) + if POP do goto OIODone +"RTN","TMGHTML1",202,0) + . set result=0 +"RTN","TMGHTML1",203,0) + +"RTN","TMGHTML1",204,0) + use IO +"RTN","TMGHTML1",205,0) + +"RTN","TMGHTML1",206,0) +OIODone +"RTN","TMGHTML1",207,0) + quit result +"RTN","TMGHTML1",208,0) + +"RTN","TMGHTML1",209,0) + +"RTN","TMGHTML1",210,0) +MakeFName(IEN) +"RTN","TMGHTML1",211,0) + ;"Purpose: To create a filename from TIU DOCUMENT IEN +"RTN","TMGHTML1",212,0) + ;"Input -- IEN. and IEN from file 8925 +"RTN","TMGHTML1",213,0) + ;"Result -- the filename +"RTN","TMGHTML1",214,0) + +"RTN","TMGHTML1",215,0) + new result set result="" +"RTN","TMGHTML1",216,0) + new name,type,datetime +"RTN","TMGHTML1",217,0) + +"RTN","TMGHTML1",218,0) + set name=$$GET1^DIQ(8925,IEN_",",.02) +"RTN","TMGHTML1",219,0) + set name=$translate(name,",","_") +"RTN","TMGHTML1",220,0) + set name=$translate(name," ","-") +"RTN","TMGHTML1",221,0) + +"RTN","TMGHTML1",222,0) + set type=$$GET1^DIQ(8925,IEN_",",.01) +"RTN","TMGHTML1",223,0) + set type=$translate(type," ","-") +"RTN","TMGHTML1",224,0) + +"RTN","TMGHTML1",225,0) + set date=$$GET1^DIQ(8925,IEN_",",.07,"I") +"RTN","TMGHTML1",226,0) + set date=$$DTFormat^TMGMISC(date,"mm-dd-yyyy") +"RTN","TMGHTML1",227,0) + +"RTN","TMGHTML1",228,0) + set result=name_"_"_type_"_"_date_".htm" +"RTN","TMGHTML1",229,0) + quit result +"RTN","TMGHTML1",230,0) + +"RTN","TMGHTML1",231,0) + +"RTN","TMGHTML1",232,0) +GetTemplateRecs(pRecs,Template) +"RTN","TMGHTML1",233,0) + ;"Purpose: to ask user for a search/sort template to inport records from. +"RTN","TMGHTML1",234,0) + ;"Input -- pRecs -- pointer to (i.e. name of) array to fill +"RTN","TMGHTML1",235,0) + ;" will probably be passed with "Array(12345)" +"RTN","TMGHTML1",236,0) + ;" Template -- OPTIONAL. Name of template to import. +"RTN","TMGHTML1",237,0) + ;" If not supplied, user will be asked for name +"RTN","TMGHTML1",238,0) + ;"Output: Data is put into pRecs like this: +"RTN","TMGHTML1",239,0) + ;" @pRecs@(IEN1)="" +"RTN","TMGHTML1",240,0) + ;" @pRecs@(IEN2)="" +"RTN","TMGHTML1",241,0) + ;" @pRecs@(IEN3)="" +"RTN","TMGHTML1",242,0) + ;"Result: Count of records imported +"RTN","TMGHTML1",243,0) + ;"Note: uses global variable pHeader +"RTN","TMGHTML1",244,0) + +"RTN","TMGHTML1",245,0) + new File set File=8925 +"RTN","TMGHTML1",246,0) + new count set count=0 +"RTN","TMGHTML1",247,0) + new Y +"RTN","TMGHTML1",248,0) + if $get(pRecs)="" goto GTRDone +"RTN","TMGHTML1",249,0) + +"RTN","TMGHTML1",250,0) + for do quit:((+Y>0)!(+Y=-1)) +"RTN","TMGHTML1",251,0) + . new DIC +"RTN","TMGHTML1",252,0) + . set DIC=.401 +"RTN","TMGHTML1",253,0) + . if $get(Template)'="" do +"RTN","TMGHTML1",254,0) + . . set X=Template +"RTN","TMGHTML1",255,0) + . else do +"RTN","TMGHTML1",256,0) + . . set DIC(0)="AEQ" +"RTN","TMGHTML1",257,0) + . . write "Select a Template containing records for import. ",! +"RTN","TMGHTML1",258,0) + . . write "(? for list, ^ to quit) " +"RTN","TMGHTML1",259,0) + . . set DIC("A")="Enter Template: " +"RTN","TMGHTML1",260,0) + . do ^DIC +"RTN","TMGHTML1",261,0) + . if $get(Template)="" write ! +"RTN","TMGHTML1",262,0) + . if +Y'>0 quit +"RTN","TMGHTML1",263,0) + . new node set node=$get(^DIBT(+Y,0)) +"RTN","TMGHTML1",264,0) + . if $piece(node,"^",4)'=File do quit +"RTN","TMGHTML1",265,0) + . . set Y=0 ;"signal to try again +"RTN","TMGHTML1",266,0) + . . new PriorErrorFound +"RTN","TMGHTML1",267,0) + . . write "Error: That template doesn't contain a list of progress notes. Please select another.",! +"RTN","TMGHTML1",268,0) + +"RTN","TMGHTML1",269,0) + if (+Y>0)&($data(^DIBT(+Y,1))>1) do +"RTN","TMGHTML1",270,0) + . new index set index=$order(^DIBT(+Y,1,0)) +"RTN","TMGHTML1",271,0) + . if index'="" for do quit:(index="") +"RTN","TMGHTML1",272,0) + . . set @pRecs@(index)="" +"RTN","TMGHTML1",273,0) + . . set count=count+1 +"RTN","TMGHTML1",274,0) + . . set index=$order(^DIBT(+Y,1,index)) +"RTN","TMGHTML1",275,0) + +"RTN","TMGHTML1",276,0) + if $get(Template)="" write count," Records selected.",! +"RTN","TMGHTML1",277,0) + +"RTN","TMGHTML1",278,0) +GTRDone +"RTN","TMGHTML1",279,0) + quit count +"RTN","TMGHTML1",280,0) + +"RTN","TMGHTML1",281,0) + +"RTN","TMGHTML1",282,0) + +"RTN","TMGHTML1",283,0) +Write1Note(IEN) +"RTN","TMGHTML1",284,0) + ;"Purpose: To write out a progress note in HTML format +"RTN","TMGHTML1",285,0) + ;"Input: IEN -- the IEN in file 8925 (TIU DOCUMENT) +"RTN","TMGHTML1",286,0) + ;"Output: The note (in complete HTML format) is written to current +"RTN","TMGHTML1",287,0) + ;" output device. +"RTN","TMGHTML1",288,0) + ;"Result: none: +"RTN","TMGHTML1",289,0) + +"RTN","TMGHTML1",290,0) + new offset,s +"RTN","TMGHTML1",291,0) + new IENS set IENS=IEN_"," +"RTN","TMGHTML1",292,0) + +"RTN","TMGHTML1",293,0) + for offset=1:1 do quit:(s["{^}") +"RTN","TMGHTML1",294,0) + . set s=$piece($TEXT(NoteHdr+offset),";;",2) +"RTN","TMGHTML1",295,0) + . quit:(s["{^}") +"RTN","TMGHTML1",296,0) + . write s,! +"RTN","TMGHTML1",297,0) + +"RTN","TMGHTML1",298,0) + write "

",$$GET1^DIQ(8925,IENS,".01"),"

",! ;"Note type +"RTN","TMGHTML1",299,0) + write "

Name: ",$$GET1^DIQ(8925,IENS,".02"),"
",! ;"patient name +"RTN","TMGHTML1",300,0) + new Date set Date=$$GET1^DIQ(8925,IENS,".07","I") +"RTN","TMGHTML1",301,0) + set Date=$$DTFormat^TMGMISC(Date,"mmmm d,yyyy") +"RTN","TMGHTML1",302,0) + write "Date: ",Date,"

",! ;"note date +"RTN","TMGHTML1",303,0) + write "

Note:

",! +"RTN","TMGHTML1",304,0) + +"RTN","TMGHTML1",305,0) + new TMGWP,x +"RTN","TMGHTML1",306,0) + set x=$$GET1^DIQ(8925,IENS,2,"","TMGWP")="WP" +"RTN","TMGHTML1",307,0) + do +"RTN","TMGHTML1",308,0) + . new i +"RTN","TMGHTML1",309,0) + . write "

" +"RTN","TMGHTML1",310,0) + . set i=$order(TMGWP("")) +"RTN","TMGHTML1",311,0) + . for do quit:(i="") +"RTN","TMGHTML1",312,0) + . . new line set line=$get(TMGWP(i)) +"RTN","TMGHTML1",313,0) + . . set line=$$SYMENC^MXMLUTL(line) +"RTN","TMGHTML1",314,0) + . . write line,"
",! +"RTN","TMGHTML1",315,0) + . . set i=$order(TMGWP(i)) +"RTN","TMGHTML1",316,0) + . write "

",! +"RTN","TMGHTML1",317,0) + +"RTN","TMGHTML1",318,0) + write "

Note Detail:
",! +"RTN","TMGHTML1",319,0) + write "Author: ",$$GET1^DIQ(8925,IENS,"1202"),"
",! +"RTN","TMGHTML1",320,0) + write "Signature Date/Time: ",$$GET1^DIQ(8925,IENS,"1501"),"
",! +"RTN","TMGHTML1",321,0) + write "Status: ",$$GET1^DIQ(8925,IENS,".05"),"
",! +"RTN","TMGHTML1",322,0) + write "Location: ",$$GET1^DIQ(8925,IENS,"1211"),"
",! +"RTN","TMGHTML1",323,0) + write "Transcriptionist: ",$$GET1^DIQ(8925,IENS,"1302"),"
",! +"RTN","TMGHTML1",324,0) + write "Transcription Date/Time: ",$$GET1^DIQ(8925,IENS,"1201"),"
",! +"RTN","TMGHTML1",325,0) + ;"write "Line count: ",$$GET1^DIQ(8925,IENS,".1"),"
",! +"RTN","TMGHTML1",326,0) + ;"write "Character count: ",$$GET1^DIQ(8925,IENS,"22711"),"
",! +"RTN","TMGHTML1",327,0) + write "

",! +"RTN","TMGHTML1",328,0) + +"RTN","TMGHTML1",329,0) + write "",! +"RTN","TMGHTML1",331,0) + +"RTN","TMGHTML1",332,0) + quit +"RTN","TMGHTML1",333,0) + +"RTN","TMGHTML1",334,0) + +"RTN","TMGHTML1",335,0) +MakeTOC(OutArray) +"RTN","TMGHTML1",336,0) + ;"Purpose: To write toc.htm (the table of contents side panel) +"RTN","TMGHTML1",337,0) + ;"Input: IEN -- the IEN in file 8925 (TIU DOCUMENT) +"RTN","TMGHTML1",338,0) + ;"Output: OutArray -- PASS BY REFERENCE +"RTN","TMGHTML1",339,0) + ;" An array with file names written. Format: +"RTN","TMGHTML1",340,0) + ;" OutArray(IEN1)=Filename1 +"RTN","TMGHTML1",341,0) + ;" OutArray(IEN1,PatientNameAndDOB1)="" +"RTN","TMGHTML1",342,0) + ;" OutArray(IEN2)=Filename2 +"RTN","TMGHTML1",343,0) + ;" OutArray(IEN2,PatientNameAndDOB2)="" +"RTN","TMGHTML1",344,0) + ;" OutArray(IEN3)=Filename3 +"RTN","TMGHTML1",345,0) + ;" OutArray(IEN3,PatientNameAndDOB3)="" +"RTN","TMGHTML1",346,0) + ;" OutArray(IEN4)=Filename4 +"RTN","TMGHTML1",347,0) + ;" OutArray(IEN4,PatientNameAndDOB4)="" +"RTN","TMGHTML1",348,0) + ;" OutArray("B",PatientNameAndDOB1,IEN1)="" +"RTN","TMGHTML1",349,0) + ;" OutArray("B",PatientNameAndDOB1,IEN1b)="" <-- if more than one IEN per patient. +"RTN","TMGHTML1",350,0) + ;" OutArray("B",PatientNameAndDOB2,IEN2)="" +"RTN","TMGHTML1",351,0) + ;" OutArray("B",PatientNameAndDOB3,IEN3)="" +"RTN","TMGHTML1",352,0) + ;" OutArray("B",PatientNameAndDOB4,IEN4)="" +"RTN","TMGHTML1",353,0) + ;" +"RTN","TMGHTML1",354,0) + ;"Result: none: +"RTN","TMGHTML1",355,0) + +"RTN","TMGHTML1",356,0) + new offset,s +"RTN","TMGHTML1",357,0) + +"RTN","TMGHTML1",358,0) + for offset=1:1 do quit:(s["{^}") +"RTN","TMGHTML1",359,0) + . set s=$piece($TEXT(TOCHdr+offset),";;",2) +"RTN","TMGHTML1",360,0) + . quit:(s["{^}") +"RTN","TMGHTML1",361,0) + . write s,! +"RTN","TMGHTML1",362,0) + +"RTN","TMGHTML1",363,0) + ;"Write Patient name and DOB, then list of their notes , then repeat. +"RTN","TMGHTML1",364,0) + new Patient +"RTN","TMGHTML1",365,0) + set Patient=$order(OutArray("B","")) +"RTN","TMGHTML1",366,0) + if Patient'="" for do quit:(Patient="") +"RTN","TMGHTML1",367,0) + . write "

",Patient,"

",! +"RTN","TMGHTML1",368,0) + . write "
    ",! +"RTN","TMGHTML1",369,0) + . new ien set ien=$order(OutArray("B",Patient,"")) +"RTN","TMGHTML1",370,0) + . if ien'="" for do quit:(ien="") +"RTN","TMGHTML1",371,0) + . . new Type,Date,FName +"RTN","TMGHTML1",372,0) + . . set Type=$$GET1^DIQ(8925,ien_",",".01") ;"Note type +"RTN","TMGHTML1",373,0) + . . set Date=$$GET1^DIQ(8925,ien_",",".07","I") ;"note date +"RTN","TMGHTML1",374,0) + . . set Date=$$DTFormat^TMGMISC(Date,"mm/dd/yyyy") +"RTN","TMGHTML1",375,0) + . . set FName=OutArray(ien) +"RTN","TMGHTML1",376,0) + . . write "
  • " +"RTN","TMGHTML1",377,0) + . . write Type," -- ",Date +"RTN","TMGHTML1",378,0) + . . write "
    • ",! +"RTN","TMGHTML1",379,0) + . . set ien=$order(OutArray("B",Patient,ien)) +"RTN","TMGHTML1",380,0) + . set Patient=$order(OutArray("B",Patient)) +"RTN","TMGHTML1",381,0) + . write "
",! +"RTN","TMGHTML1",382,0) + +"RTN","TMGHTML1",383,0) + write "",! +"RTN","TMGHTML1",385,0) + +"RTN","TMGHTML1",386,0) + quit +"RTN","TMGHTML1",387,0) + +"RTN","TMGHTML1",388,0) + +"RTN","TMGHTML1",389,0) + +"RTN","TMGHTML1",390,0) + ;"======================================================================= +"RTN","TMGHTML1",391,0) +IndexDat +"RTN","TMGHTML1",392,0) + ;; +"RTN","TMGHTML1",393,0) + ;; +"RTN","TMGHTML1",394,0) + ;; +"RTN","TMGHTML1",395,0) + ;; +"RTN","TMGHTML1",396,0) + ;; +"RTN","TMGHTML1",397,0) + ;; Open VistA Exported Notes +"RTN","TMGHTML1",398,0) + ;; +"RTN","TMGHTML1",399,0) + ;; +"RTN","TMGHTML1",400,0) + ;; +"RTN","TMGHTML1",401,0) + ;; +"RTN","TMGHTML1",402,0) + ;; +"RTN","TMGHTML1",403,0) + ;; <body> +"RTN","TMGHTML1",404,0) + ;; </body> +"RTN","TMGHTML1",405,0) + ;; +"RTN","TMGHTML1",406,0) + ;; +"RTN","TMGHTML1",407,0) + ;; +"RTN","TMGHTML1",408,0) + ;; +"RTN","TMGHTML1",409,0) + ;;{^} ;"Kevin's custom end-of-data symbol +"RTN","TMGHTML1",410,0) + +"RTN","TMGHTML1",411,0) +IntroDat +"RTN","TMGHTML1",412,0) + ;; +"RTN","TMGHTML1",413,0) + ;; +"RTN","TMGHTML1",414,0) + ;; +"RTN","TMGHTML1",415,0) + ;; +"RTN","TMGHTML1",416,0) + ;; OpenVistA Exported Notes +"RTN","TMGHTML1",417,0) + ;; +"RTN","TMGHTML1",418,0) + ;; +"RTN","TMGHTML1",419,0) + ;;

Please Select A Patient from List at Left

+"RTN","TMGHTML1",420,0) + ;; +"RTN","TMGHTML1",421,0) + ;; +"RTN","TMGHTML1",422,0) + ;; +"RTN","TMGHTML1",423,0) + ;;{^} ;"Kevin's custom end-of-data symbol +"RTN","TMGHTML1",424,0) + +"RTN","TMGHTML1",425,0) + +"RTN","TMGHTML1",426,0) +TOCHdr +"RTN","TMGHTML1",427,0) + ;; +"RTN","TMGHTML1",428,0) + ;; +"RTN","TMGHTML1",429,0) + ;; +"RTN","TMGHTML1",430,0) + ;;OpenVista List of Patients +"RTN","TMGHTML1",431,0) + ;; +"RTN","TMGHTML1",432,0) + ;; +"RTN","TMGHTML1",433,0) + ;;

Introduction

+"RTN","TMGHTML1",434,0) + ;;

Patients

+"RTN","TMGHTML1",435,0) + ;; +"RTN","TMGHTML1",436,0) + ;;{^} ;"Kevin's custom end-of-data symbol +"RTN","TMGHTML1",437,0) + +"RTN","TMGHTML1",438,0) + +"RTN","TMGHTML1",439,0) +NoteHdr +"RTN","TMGHTML1",440,0) + ;; +"RTN","TMGHTML1",441,0) + ;; +"RTN","TMGHTML1",442,0) + ;; +"RTN","TMGHTML1",443,0) + ;; +"RTN","TMGHTML1",444,0) + ;; OpenVistA Introduction +"RTN","TMGHTML1",445,0) + ;; +"RTN","TMGHTML1",446,0) + ;; +"RTN","TMGHTML1",447,0) + ; +"RTN","TMGHTML1",448,0) + ;;{^} ;"Kevin's custom end-of-data symbol +"RTN","TMGHTML1",449,0) + +"RTN","TMGHTML1",450,0) + +"RTN","TMGHUI1") +0^23^B205063 +"RTN","TMGHUI1",1,0) +TMGHUI1 ;TMG/kst/Custom version of HUI code ;03/25/06 +"RTN","TMGHUI1",2,0) + ;;1.0;TMG-LIB;**1**;01/12/05 +"RTN","TMGHUI1",3,0) + +"RTN","TMGHUI1",4,0) + +"RTN","TMGHUI1",5,0) +HUIPSUPD ;DLD/Pacific HUI/Updates orderable item file with PS Orderable Items ; 1/25/05 7:55am +"RTN","TMGHUI1",6,0) + ;;This routine populates the drug orderable items +"RTN","TMGHUI1",7,0) + +"RTN","TMGHUI1",8,0) + ;"HUI MISCELLANEOUS FUNCTIONS (used/customized in TMG library) +"RTN","TMGHUI1",9,0) + +"RTN","TMGHUI1",10,0) + ;"======================================================================= +"RTN","TMGHUI1",11,0) + ;" API -- Public Functions. +"RTN","TMGHUI1",12,0) + ;"======================================================================= +"RTN","TMGHUI1",13,0) + ;"myGO ;" - global list- (global lister) +"RTN","TMGHUI1",14,0) + +"RTN","TMGHUI1",15,0) + ;"======================================================================= +"RTN","TMGHUI1",16,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGHUI1",17,0) + ;"======================================================================= +"RTN","TMGHUI1",18,0) + +"RTN","TMGHUI1",19,0) + ;"======================================================================= +"RTN","TMGHUI1",20,0) + ;"======================================================================= +"RTN","TMGHUI1",21,0) + +"RTN","TMGHUI1",22,0) +EN +"RTN","TMGHUI1",23,0) + ;" loop through PS(50.7 and add to OE Ordeable item +"RTN","TMGHUI1",24,0) + new PSOIEN +"RTN","TMGHUI1",25,0) + do DT^DICRW +"RTN","TMGHUI1",26,0) + set PSOIEN=$order(^PS(50.7,0)) +"RTN","TMGHUI1",27,0) + if +PSOIEN>0 for do quit:'PSOIEN +"RTN","TMGHUI1",28,0) + . do ADD(PSOIEN) +"RTN","TMGHUI1",29,0) + . set PSOIEN=$order(^PS(50.7,PSOIEN)) +"RTN","TMGHUI1",30,0) + quit +"RTN","TMGHUI1",31,0) + +"RTN","TMGHUI1",32,0) + +"RTN","TMGHUI1",33,0) +ADD(PSOIEN) +"RTN","TMGHUI1",34,0) + ;" Calls PS Orderable Item update routines +"RTN","TMGHUI1",35,0) + do EN^PSSPOIDT(PSOIEN) +"RTN","TMGHUI1",36,0) + do EN2^PSSHL1(PSOIEN,"MUP") +"RTN","TMGHUI1",37,0) + quit +"RTN","TMGHUI1",38,0) + +"RTN","TMGHUI1",39,0) +SET +"RTN","TMGHUI1",40,0) + ;" - updates view set +"RTN","TMGHUI1",41,0) + new DIC,X,Y,IEN,D,TYPE,NM,DGNM,UPDTIME,ATTEMPT +"RTN","TMGHUI1",42,0) + do DT^DICRW +"RTN","TMGHUI1",43,0) + set DIC="^ORD(101.44," +"RTN","TMGHUI1",44,0) + set DIC(0)="AQ" +"RTN","TMGHUI1",45,0) + for D ^DIC quit:+Y quit:X="^" +"RTN","TMGHUI1",46,0) + quit:X="^" +"RTN","TMGHUI1",47,0) + set IEN=+Y +"RTN","TMGHUI1",48,0) + set NM=$P(Y,U,2) +"RTN","TMGHUI1",49,0) + set DGNM=$P(NM,"ORWDSET ",2) +"RTN","TMGHUI1",50,0) + set UPDTIME=$H +"RTN","TMGHUI1",51,0) + set ATTEMPT="" +"RTN","TMGHUI1",52,0) + do FVBLD^ORWUL +"RTN","TMGHUI1",53,0) + quit +"RTN","TMGHUI1",54,0) + +"RTN","TMGHUI1",55,0) + +"RTN","TMGHUI1",56,0) +myGO;" - global list- (global lister) +"RTN","TMGHUI1",57,0) + ;- Jan 2005 - DLD - PACIFIC HUI +"RTN","TMGHUI1",58,0) + ; - THis routine allows global out of a partial global +"RTN","TMGHUI1",59,0) + ;" //kt note: Obtained from N. Anthracite 11/4/05. She got +"RTN","TMGHUI1",60,0) + ;" it from Norman Dodd +"RTN","TMGHUI1",61,0) + ;" Reformatted for full commands +"RTN","TMGHUI1",62,0) + ;" User interface changes made also. +"RTN","TMGHUI1",63,0) + ;" This function dumps one or more globals to selected output device +"RTN","TMGHUI1",64,0) + +"RTN","TMGHUI1",65,0) + write !,"Global Output Utility",! +"RTN","TMGHUI1",66,0) + if '$data(%zdebug) new $et do +"RTN","TMGHUI1",67,0) + . set $et="zg "_$zl_":ERR^%GO" +"RTN","TMGHUI1",68,0) + . use $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%GO") +"RTN","TMGHUI1",69,0) + new g,gn,m,n,c,gl,in,%ZD,%ZG,%ZH,fmt +"RTN","TMGHUI1",70,0) + set c=0 +"RTN","TMGHUI1",71,0) + for read !,"Enter Global ([enter] if done): ",in,! do quit:in="" +"RTN","TMGHUI1",72,0) + . quit:in="" +"RTN","TMGHUI1",73,0) + . if $extract(in)="?",$length(in)=1 do help quit +"RTN","TMGHUI1",74,0) + . if $extract(in)="^",$length(in)=1 set in="" quit +"RTN","TMGHUI1",75,0) + . if $extract(in)'="^" do help quit +"RTN","TMGHUI1",76,0) + . if in["(",in'[")" do help quit +"RTN","TMGHUI1",77,0) + . set c=c+1,gl(c)=in +"RTN","TMGHUI1",78,0) + if '$data(gl) write !,"No globals selected" quit +"RTN","TMGHUI1",79,0) + read !,"Header Label: ",%ZH,! +"RTN","TMGHUI1",80,0) + read !,"Output Format: GO or ZWR: ",fmt,! +"RTN","TMGHUI1",81,0) + if (fmt="")!($extract("ZWR",1,$length(fmt))=$translate(fmt,"zwr","ZWR")) set fmt=1 +"RTN","TMGHUI1",82,0) + else set fmt=0 +"RTN","TMGHUI1",83,0) + for do quit:$length(%ZD) +"RTN","TMGHUI1",84,0) + . read !,"Output device: : ",%ZD,! +"RTN","TMGHUI1",85,0) + . if '$length(%ZD) set %ZD=$p quit +"RTN","TMGHUI1",86,0) + . if %ZD="^" quit +"RTN","TMGHUI1",87,0) + . if %ZD="?" do quit +"RTN","TMGHUI1",88,0) + . . write !!,"Select the device you want for output" +"RTN","TMGHUI1",89,0) + . . write !,"If you wish to exit enter a carat (^)",! +"RTN","TMGHUI1",90,0) + . . set %ZD="" +"RTN","TMGHUI1",91,0) + . if $zparse(%ZD)="" write " no such device" set %ZD="" quit +"RTN","TMGHUI1",92,0) + . open %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0 +"RTN","TMGHUI1",93,0) + . if '$t write !,%ZD," is not available" set %ZD="" quit +"RTN","TMGHUI1",94,0) + . quit +"RTN","TMGHUI1",95,0) +noopen . write !,$p($ZS,",",2,999),! close %ZD set %ZD="" +"RTN","TMGHUI1",96,0) + quit:%ZD="^" +"RTN","TMGHUI1",97,0) + write !! +"RTN","TMGHUI1",98,0) + if '$length(%ZH) set %ZH="%GO Global Output Utility" +"RTN","TMGHUI1",99,0) + use %ZD +"RTN","TMGHUI1",100,0) + write %ZH,!,"GT.M ",$zd($h,"DD-MON-YEAR 24:60:SS") +"RTN","TMGHUI1",101,0) + write:fmt " ZWR" +"RTN","TMGHUI1",102,0) + write ! +"RTN","TMGHUI1",103,0) + set c=0,(m,n)=0 +"RTN","TMGHUI1",104,0) + for set c=$order(gl(c)) quit:'+c set gn=gl(c),g=gn do +"RTN","TMGHUI1",105,0) + . use $p +"RTN","TMGHUI1",106,0) + . write:$x>70 ! +"RTN","TMGHUI1",107,0) + . write gn,?$x\10+1*10 +"RTN","TMGHUI1",108,0) + . use %ZD +"RTN","TMGHUI1",109,0) + . if $p=%ZD write ! +"RTN","TMGHUI1",110,0) + . quit:g="" +"RTN","TMGHUI1",111,0) + . set m=m+1 +"RTN","TMGHUI1",112,0) + . if $data(@g)'[0 write g do set n=n+1 +"RTN","TMGHUI1",113,0) + . . if fmt write "=" do fw(@g) +"RTN","TMGHUI1",114,0) + . . else write !,@g,! +"RTN","TMGHUI1",115,0) + . for set g=$q(@g) quit:g="" do +"RTN","TMGHUI1",116,0) + . . if fmt zwr @g +"RTN","TMGHUI1",117,0) + . . else write g,!,@g,! +"RTN","TMGHUI1",118,0) + . . set n=n+1 +"RTN","TMGHUI1",119,0) + use %ZD write !! +"RTN","TMGHUI1",120,0) + use $p +"RTN","TMGHUI1",121,0) + write !!,"Total of ",n," node",$s(n=1:"",1:"s") +"RTN","TMGHUI1",122,0) + write " in ",m," global",$s(m=1:".",1:"s."),!! +"RTN","TMGHUI1",123,0) + close:%ZD'=$p %ZD +"RTN","TMGHUI1",124,0) + use $p:(ctrap="":exc="") +"RTN","TMGHUI1",125,0) + quit +"RTN","TMGHUI1",126,0) + +"RTN","TMGHUI1",127,0) +fw(s) +"RTN","TMGHUI1",128,0) + ;" variables used in this function are: fwlen, s, cc, fastate, isctl, i, thistime +"RTN","TMGHUI1",129,0) + ;" initialize this procedure +"RTN","TMGHUI1",130,0) + set fwlen=$length(s) +"RTN","TMGHUI1",131,0) + if fwlen=0 write ! quit +"RTN","TMGHUI1",132,0) + if s=+s write s,! quit +"RTN","TMGHUI1",133,0) + set cc=$extract(s) +"RTN","TMGHUI1",134,0) + if cc?1C write "$C(",$a(cc) set fastate=2 +"RTN","TMGHUI1",135,0) + else write """",cc w:cc="""" cc set fastate=1 +"RTN","TMGHUI1",136,0) + ;" start the loop to deal with the whole string. +"RTN","TMGHUI1",137,0) + for i=2:1:fwlen set cc=$extract(s,i,i),isctl=cc?1C d +"RTN","TMGHUI1",138,0) + . set thistime=1 +"RTN","TMGHUI1",139,0) + . if fastate=1 do +"RTN","TMGHUI1",140,0) + . . if (isctl) write """_$C(",$a(cc) set fastate=2,thistime=0 +"RTN","TMGHUI1",141,0) + . . else write cc w:cc="""" cc +"RTN","TMGHUI1",142,0) + . if (fastate=2)&thistime do +"RTN","TMGHUI1",143,0) + . . if (isctl)!(cc="""") write ",",$a(cc) +"RTN","TMGHUI1",144,0) + . . else write ")_""",cc set fastate=1 +"RTN","TMGHUI1",145,0) + if fastate=1 write """",! +"RTN","TMGHUI1",146,0) + else write ")",! +"RTN","TMGHUI1",147,0) + quit +"RTN","TMGHUI1",148,0) + +"RTN","TMGHUI1",149,0) +ERR use $p write !,$p($zs,",",2,99),! +"RTN","TMGHUI1",150,0) + ; Warning - Fall-though +"RTN","TMGHUI1",151,0) + set $ec="" +"RTN","TMGHUI1",152,0) +EXIT if $data(%ZD),%ZD'=$p close %ZD +"RTN","TMGHUI1",153,0) + use $p:(ctrap="":exc="") +"RTN","TMGHUI1",154,0) + quit +"RTN","TMGHUI1",155,0) + +"RTN","TMGHUI1",156,0) +help; +"RTN","TMGHUI1",157,0) + write !,"Enter a global reference to start at with ^" +"RTN","TMGHUI1",158,0) + write !,"i.e ^DPT or ^VA(200)" +"RTN","TMGHUI1",159,0) + quit +"RTN","TMGIDE") +0^24^B7091 +"RTN","TMGIDE",1,0) +TMGIDE ;TMG/kst/A debugger/tracer for GT.M ;03/25/06 +"RTN","TMGIDE",2,0) + ;;1.0;TMG-LIB;**1**;04/12/05 +"RTN","TMGIDE",3,0) + +"RTN","TMGIDE",4,0) + ;" A Debug/Tracer for GT.M +"RTN","TMGIDE",5,0) + ;" +"RTN","TMGIDE",6,0) + ;" K. Toppenberg +"RTN","TMGIDE",7,0) + ;" 4-13-2005 +"RTN","TMGIDE",8,0) + ;" License: GPL Applies +"RTN","TMGIDE",9,0) + ;" +"RTN","TMGIDE",10,0) + ;" +"RTN","TMGIDE",11,0) + ;" This program will launch a shell for the TMG STEP TRAP debugger +"RTN","TMGIDE",12,0) + ;" It provides the user with a prompt, like this: +"RTN","TMGIDE",13,0) + ;" +"RTN","TMGIDE",14,0) + ;" (^ to quit) IDE> +"RTN","TMGIDE",15,0) + ;" +"RTN","TMGIDE",16,0) + ;" Any valid M code may be entered here. To use the tracing +"RTN","TMGIDE",17,0) + ;" ability, launch a function, like this: +"RTN","TMGIDE",18,0) + ;" +"RTN","TMGIDE",19,0) + ;" (^ to quit) IDE>do ^MyFunction +"RTN","TMGIDE",20,0) + ;" +"RTN","TMGIDE",21,0) + ;" +"RTN","TMGIDE",22,0) + ;" Dependancies: +"RTN","TMGIDE",23,0) + ;" Uses TMGIDE2,TMGTERM, +"RTN","TMGIDE",24,0) + ;" ^DIM,XGF,XINDX7,XINDX8,XINDEX <-- VA code +"RTN","TMGIDE",25,0) + ;" %ZVEM* (if available) +"RTN","TMGIDE",26,0) + ;" +"RTN","TMGIDE",27,0) + ;"======================================================================= +"RTN","TMGIDE",28,0) + ;" API -- Public Functions. +"RTN","TMGIDE",29,0) + ;"======================================================================= +"RTN","TMGIDE",30,0) + ;"Start^TMGIDE -- launch Debugger +"RTN","TMGIDE",31,0) + ;"BKPT^TMGIDE -- set a breakpoint +"RTN","TMGIDE",32,0) + ;"KBKPT^TMGIDE -- kill (release) breakpoint +"RTN","TMGIDE",33,0) + +"RTN","TMGIDE",34,0) + ;"======================================================================= +"RTN","TMGIDE",35,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGIDE",36,0) + ;"======================================================================= +"RTN","TMGIDE",37,0) + ;"Prompt +"RTN","TMGIDE",38,0) + ;"ShutDown +"RTN","TMGIDE",39,0) + ;"ParsePos(pos,label,offset,routine,dmod) +"RTN","TMGIDE",40,0) + ;"ConvertPos(Pos,pArray) +"RTN","TMGIDE",41,0) + ;"ScanMod(Module,pArray) +"RTN","TMGIDE",42,0) + ;"BROWSENODES(current,Order,paginate,countNodes) +"RTN","TMGIDE",43,0) + ;"ShowNodes(pArray,order,paginate,countNodes) +"RTN","TMGIDE",44,0) + ;"ListCt(pArray) +"RTN","TMGIDE",45,0) + ;"TrimL(S,TrimCh) +"RTN","TMGIDE",46,0) + ;"TrimR(S,TrimCh) +"RTN","TMGIDE",47,0) + ;"Trim(S,TrimCh) +"RTN","TMGIDE",48,0) + ;"Substitute(S,Match,NewValue) +"RTN","TMGIDE",49,0) + ;"REPLACE(IN,SPEC) +"RTN","TMGIDE",50,0) + ;"DebugWrite(DBIndent,s,AddNewline) +"RTN","TMGIDE",51,0) + ;"DebugIndent(DBIndentForced) +"RTN","TMGIDE",52,0) + ;"$$ArrayDump(ArrayP,TMGIDX,indent) +"RTN","TMGIDE",53,0) + ;"ExpandLine(Pos) +"RTN","TMGIDE",54,0) + ;"CREF(X) +"RTN","TMGIDE",55,0) + ;"LGR() +"RTN","TMGIDE",56,0) + ;"UP(X) +"RTN","TMGIDE",57,0) + ;"READ(XGCHARS,XGTO) +"RTN","TMGIDE",58,0) + ;"READ2(XGCHARS,XGTO) +"RTN","TMGIDE",59,0) + +"RTN","TMGIDE",60,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",61,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",62,0) + +"RTN","TMGIDE",63,0) +START +"RTN","TMGIDE",64,0) +Start +"RTN","TMGIDE",65,0) + ;"Purpose: To Launch debugger. This is the entry point +"RTN","TMGIDE",66,0) + +"RTN","TMGIDE",67,0) + ;"Set up variables with global scope (used by TMGIDE2) +"RTN","TMGIDE",68,0) + if $get(TMGScrWidth)="" set TMGScrWidth=$get(IOM,66)-1 +"RTN","TMGIDE",69,0) + if $get(TMGScrHeight)="" set TMGScrHeight=10 +"RTN","TMGIDE",70,0) + set TMGLROffset=0 +"RTN","TMGIDE",71,0) + ;"set tpWatchLine="" +"RTN","TMGIDE",72,0) + set TMGTrap=1 ;"kt added 2/10/06 +"RTN","TMGIDE",73,0) + set TMGStepMode="into" ;"kt added 2/10/06 +"RTN","TMGIDE",74,0) + set TMGRunMode=1 ;"kt added 2/22/06 +"RTN","TMGIDE",75,0) + set TMGZTRAP=$ZTRAP +"RTN","TMGIDE",76,0) + +"RTN","TMGIDE",77,0) + new tpHideList +"RTN","TMGIDE",78,0) + set tpHideList=$name(^TMG("TMGIDE",$J,"HIDE LIST")) +"RTN","TMGIDE",79,0) + set @tpHideList@("TMGIDE")="" +"RTN","TMGIDE",80,0) + set @tpHideList@("TMGIDE2")="" +"RTN","TMGIDE",81,0) + set @tpHideList@("TMGIDE3")="" +"RTN","TMGIDE",82,0) + set @tpHideList@("TMGIDE4")="" +"RTN","TMGIDE",83,0) + set @tpHideList@("TMGTERM")="" +"RTN","TMGIDE",84,0) + set @tpHideList@("%ZVE")="" +"RTN","TMGIDE",85,0) + set @tpHideList@("%ZVEMK")="" +"RTN","TMGIDE",86,0) + set @tpHideList@("XGF")="" +"RTN","TMGIDE",87,0) + set @tpHideList@("XGKB")="" +"RTN","TMGIDE",88,0) + +"RTN","TMGIDE",89,0) + do SetGlobals^TMGTERM +"RTN","TMGIDE",90,0) + do ensureBreakpoints^TMGIDE2() +"RTN","TMGIDE",91,0) + +"RTN","TMGIDE",92,0) + new Menu,UsrSlct +"RTN","TMGIDE",93,0) +M1 set Menu(0)="Welcome to the TMG debugging environment" +"RTN","TMGIDE",94,0) + set Menu(1)="Start debugger in THIS window."_$char(9)_"AllInOne" +"RTN","TMGIDE",95,0) + set Menu(2)="Start debugger LISTENER."_$char(9)_"StartListener" +"RTN","TMGIDE",96,0) + set Menu(3)="Debug, SENDING output to a listener."_$char(9)_"StartSender" +"RTN","TMGIDE",97,0) + set Menu(4)="Set a custom breakpoint"_$char(9)_"SetBreakpoint" +"RTN","TMGIDE",98,0) + set Menu(5)="Kill a custom breakpoint"_$char(9)_"KillBreakpoint" +"RTN","TMGIDE",99,0) + +"RTN","TMGIDE",100,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGIDE",101,0) + +"RTN","TMGIDE",102,0) + if UsrSlct="AllInOne" goto MenuDone +"RTN","TMGIDE",103,0) + if UsrSlct="StartListener" do Listener^TMGIDE3 goto M1 +"RTN","TMGIDE",104,0) + if UsrSlct="StartSender" do Sender^TMGIDE4 goto M1 +"RTN","TMGIDE",105,0) + if UsrSlct="SetBreakpoint" do BKPT goto M1 +"RTN","TMGIDE",106,0) + if UsrSlct="KillBreakpoint" do KBKPT goto M1 +"RTN","TMGIDE",107,0) + if UsrSlct="^" goto Done +"RTN","TMGIDE",108,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGIDE",109,0) + goto M1 +"RTN","TMGIDE",110,0) + +"RTN","TMGIDE",111,0) +MenuDone +"RTN","TMGIDE",112,0) + for i=1:1:10 write ! +"RTN","TMGIDE",113,0) + write !,"Welcome to the TMG debugging environment",! +"RTN","TMGIDE",114,0) + write "Enter any valid M command...",! +"RTN","TMGIDE",115,0) + do SetErrTrap +"RTN","TMGIDE",116,0) + +"RTN","TMGIDE",117,0) + do Prompt("AllInOne") +"RTN","TMGIDE",118,0) +Done +"RTN","TMGIDE",119,0) + do ShutDown +"RTN","TMGIDE",120,0) + quit +"RTN","TMGIDE",121,0) + +"RTN","TMGIDE",122,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE",123,0) +SetErrTrap +"RTN","TMGIDE",124,0) + set $ZTRAP="do ErrTrap^TMGIDE2($ZPOS) break" +"RTN","TMGIDE",125,0) + set $ZSTATUS="" +"RTN","TMGIDE",126,0) + quit +"RTN","TMGIDE",127,0) + +"RTN","TMGIDE",128,0) +Prompt(Mode) +"RTN","TMGIDE",129,0) + ;"Purpose: to interact with user and run through code. +"RTN","TMGIDE",130,0) + ;"Mode: OPTIONAL: Default is 'AllInOne' +"RTN","TMGIDE",131,0) + ;" AllInOne --> debug output to same window +"RTN","TMGIDE",132,0) + ;" SendOut --> debug output to Listener widow +"RTN","TMGIDE",133,0) + +"RTN","TMGIDE",134,0) + set Mode=$get(Mode,"AllInOne") +"RTN","TMGIDE",135,0) + new BlankLine set $piece(BlankLine," ",78)=" " +"RTN","TMGIDE",136,0) + new HxSize set HxSize=8 ;"hard codes in history length of 8 +"RTN","TMGIDE",137,0) + new TMGdbgLine +"RTN","TMGIDE",138,0) + new TMGlastline set TMGlastLine="" +"RTN","TMGIDE",139,0) + new HxShowNum set HxShowNum=0 +"RTN","TMGIDE",140,0) + new HxLine,HxLineMax,HxLineCur +"RTN","TMGIDE",141,0) + do INITKB^XGF() ;"set up keyboard input escape code processing +"RTN","TMGIDE",142,0) + +"RTN","TMGIDE",143,0) +Ppt2 +"RTN","TMGIDE",144,0) + set HxShowNum=+$get(HxShowNum) +"RTN","TMGIDE",145,0) + set TMGStepMode="into" ;"kt added 5/3/06 +"RTN","TMGIDE",146,0) + set HxLine=$get(^TMG("TMGIDE","CMD HISTORY",$J,HxShowNum)) +"RTN","TMGIDE",147,0) + set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) +"RTN","TMGIDE",148,0) + +"RTN","TMGIDE",149,0) + write "(^ to quit) " +"RTN","TMGIDE",150,0) + if HxShowNum=0 write "^// " +"RTN","TMGIDE",151,0) + else write "// ",HxLine +"RTN","TMGIDE",152,0) + +"RTN","TMGIDE",153,0) + set TMGdbgLine=$$READ() ;"$$READ^XGF ;"returns line terminator in TMGXGRT +"RTN","TMGIDE",154,0) + ;"read TMGdbgLine,! +"RTN","TMGIDE",155,0) + ;"write "[TMGXGRT=",TMGXGRT,"]" +"RTN","TMGIDE",156,0) + if TMGdbgLine="?" do goto Ppt2 +"RTN","TMGIDE",157,0) + . write !,"Here you should enter any valid M command, as would normally",! +"RTN","TMGIDE",158,0) + . write "entered at a GTM> prompt.",! +"RTN","TMGIDE",159,0) + . write " examples: WRITE ""HELLO"",! or DO ^TMGTEST",! +"RTN","TMGIDE",160,0) + +"RTN","TMGIDE",161,0) + if (TMGdbgLine="")&(HxShowNum>0) set TMGdbgLine=HxLine +"RTN","TMGIDE",162,0) + ;"if (TMGdbgLine="")&(TMGXGRT="CR")&(HxShowNum>0) set TMGdbgLine=HxLine +"RTN","TMGIDE",163,0) + +"RTN","TMGIDE",164,0) + if (TMGXGRT="DOWN")!(TMGXGRT="RIGHT")!(TMGdbgLine="]") do goto Ppt2 +"RTN","TMGIDE",165,0) + . set HxShowNum=HxShowNum-1 +"RTN","TMGIDE",166,0) + . if HxShowNum<0 set HxShowNum=HxLineMax +"RTN","TMGIDE",167,0) + . ;"write "setting HxShowNum=",HxShowNum,! +"RTN","TMGIDE",168,0) + . do CHA^TMGTERM(1) write BlankLine do CHA^TMGTERM(1) +"RTN","TMGIDE",169,0) + +"RTN","TMGIDE",170,0) + if (TMGXGRT="UP")!(TMGXGRT="LEFT")!(TMGdbgLine="[") do goto Ppt2 +"RTN","TMGIDE",171,0) + . set HxShowNum=HxShowNum+1 +"RTN","TMGIDE",172,0) + . if HxShowNum>HxLineMax set HxShowNum=0 +"RTN","TMGIDE",173,0) + . ;"write "setting HxShowNum=",HxShowNum,! +"RTN","TMGIDE",174,0) + . do CHA^TMGTERM(1) write BlankLine do CHA^TMGTERM(1) +"RTN","TMGIDE",175,0) + +"RTN","TMGIDE",176,0) + if TMGdbgLine="" set TMGdbgLine="^" +"RTN","TMGIDE",177,0) + if TMGdbgLine="^" set $ZSTEP="" quit +"RTN","TMGIDE",178,0) + write ! +"RTN","TMGIDE",179,0) + +"RTN","TMGIDE",180,0) + ;"Save Cmd history +"RTN","TMGIDE",181,0) + set HxLineCur=$get(^TMG("TMGIDE","CMD HISTORY",$J,"CUR"),0) ;"<-- points to last used, not next avail +"RTN","TMGIDE",182,0) + set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) ;"equals buffer size AFTER it fills +"RTN","TMGIDE",183,0) + set HxLineCur=HxLineCur+1 +"RTN","TMGIDE",184,0) + if HxLineCur>HxSize set HxLineCur=1 +"RTN","TMGIDE",185,0) + set ^TMG("TMGIDE","CMD HISTORY",$J,HxLineCur)=TMGdbgLine +"RTN","TMGIDE",186,0) + set ^TMG("TMGIDE","CMD HISTORY",$J,"CUR")=HxLineCur +"RTN","TMGIDE",187,0) + if HxLineCur>HxLineMax do +"RTN","TMGIDE",188,0) + . set HxLineMax=HxLineCur +"RTN","TMGIDE",189,0) + . set ^TMG("TMGIDE","CMD HISTORY",$J,"MAX")=HxLineMax +"RTN","TMGIDE",190,0) + +"RTN","TMGIDE",191,0) + set TMGRunMode=1 ;"1=Step-by-step mode +"RTN","TMGIDE",192,0) + set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE2($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue" +"RTN","TMGIDE",193,0) + +"RTN","TMGIDE",194,0) + set HxShowNum=0 +"RTN","TMGIDE",195,0) + zstep into +"RTN","TMGIDE",196,0) + xecute TMGdbgLine +"RTN","TMGIDE",197,0) + set $ZSTEP="" ;"turn off step capture +"RTN","TMGIDE",198,0) + write ! +"RTN","TMGIDE",199,0) + goto Ppt2 +"RTN","TMGIDE",200,0) + +"RTN","TMGIDE",201,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE",202,0) + +"RTN","TMGIDE",203,0) +ShutDown +"RTN","TMGIDE",204,0) + do KillGlobals^TMGTERM +"RTN","TMGIDE",205,0) + +"RTN","TMGIDE",206,0) + ;"kill TMGScrWidth +"RTN","TMGIDE",207,0) + ;"kill TMGScrHeight +"RTN","TMGIDE",208,0) + ;"kill TMGLROffset +"RTN","TMGIDE",209,0) + ;"kill tpWatchLine +"RTN","TMGIDE",210,0) + kill TMGStepMode ;" 2/10/06 kt +"RTN","TMGIDE",211,0) + kill ^TMP("TreadMGIDE",$J,"MODULES") +"RTN","TMGIDE",212,0) + do VTATRIB^TMGTERM(0) +"RTN","TMGIDE",213,0) + do RESETKB^XGF ;"turn off XGF escape key processing code. +"RTN","TMGIDE",214,0) + write "Leaving TMG debugging environment. Goodbye.",! +"RTN","TMGIDE",215,0) + quit +"RTN","TMGIDE",216,0) + +"RTN","TMGIDE",217,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE",218,0) + +"RTN","TMGIDE",219,0) +BKPT +"RTN","TMGIDE",220,0) + ;"Purpose: To ask user for an address, and set a breakpoint there +"RTN","TMGIDE",221,0) + ;" This can be done from GTM prompt, and debugger will be launched +"RTN","TMGIDE",222,0) + ;" when this address is reached during normal execution. +"RTN","TMGIDE",223,0) + +"RTN","TMGIDE",224,0) + read "Enter breakpoint (e.g. Label+8^MyFunct): ",Pos,! +"RTN","TMGIDE",225,0) + do SetBreakpoint^TMGIDE2(Pos) +"RTN","TMGIDE",226,0) + set $ZTRAP="" ;"This makes sure that Fileman error trap is not active +"RTN","TMGIDE",227,0) + quit +"RTN","TMGIDE",228,0) + +"RTN","TMGIDE",229,0) + +"RTN","TMGIDE",230,0) +KBKPT +"RTN","TMGIDE",231,0) + ;"Purpose: To ask user for an address, and kill (release) breakpoint there +"RTN","TMGIDE",232,0) + ;" This can be done from GTM prompt +"RTN","TMGIDE",233,0) + +"RTN","TMGIDE",234,0) + read "Enter breakpoint to be killed (released) (e.g. Label+8^MyFunct): ",Pos,! +"RTN","TMGIDE",235,0) + do RelBreakpoint^TMGIDE2(Pos) +"RTN","TMGIDE",236,0) + quit +"RTN","TMGIDE",237,0) + +"RTN","TMGIDE",238,0) + +"RTN","TMGIDE",239,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",240,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",241,0) + ;"Support Functions +"RTN","TMGIDE",242,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",243,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE",244,0) + +"RTN","TMGIDE",245,0) +ParsePos(pos,label,offset,routine,dmod) +"RTN","TMGIDE",246,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",247,0) + ;"Purpose: to convert a pos string (e.g. X+2^ROUTINE$DMOD) into componant parts +"RTN","TMGIDE",248,0) + ;"Input: pos -- the string, as example above +"RTN","TMGIDE",249,0) + ;" label -- OUT PARAM, PASS BY REF, would return "x" +"RTN","TMGIDE",250,0) + ;" offset -- OUT PARAM, PASS BY REF, would return "+2" +"RTN","TMGIDE",251,0) + ;" routine -- OUT PARAM, PASS BY REF, would return "ROUTINE" +"RTN","TMGIDE",252,0) + ;" dmod -- OUT PARAM, PASS BY REF, would return "DMOD" +"RTN","TMGIDE",253,0) + ;"Results: none +"RTN","TMGIDE",254,0) + ;"Note: results are shortened to 8 characters. +"RTN","TMGIDE",255,0) + +"RTN","TMGIDE",256,0) + new s +"RTN","TMGIDE",257,0) + set s=$get(pos) +"RTN","TMGIDE",258,0) + set dmod=$piece(s,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE +"RTN","TMGIDE",259,0) + set routine=$piece(s,"^",2) +"RTN","TMGIDE",260,0) + ;"set routine=$extract(routine,1,8) //kt remove 3/1/08, new GTM needs > 8 chars +"RTN","TMGIDE",261,0) + set label=$piece(s,"^",1) +"RTN","TMGIDE",262,0) + set offset=$piece(label,"+",2) +"RTN","TMGIDE",263,0) + set label=$piece(label,"+",1) +"RTN","TMGIDE",264,0) + ;"set label=$extract(label,1,8) //kt remove 3/1/08, new GTM needs > 8 chars +"RTN","TMGIDE",265,0) + +"RTN","TMGIDE",266,0) + quit +"RTN","TMGIDE",267,0) + +"RTN","TMGIDE",268,0) + +"RTN","TMGIDE",269,0) +ConvertPos(Pos,pArray) +"RTN","TMGIDE",270,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",271,0) + ;"Purpose: to convert a text positioning line from one that is relative to the last tag/label, into +"RTN","TMGIDE",272,0) + ;" one that is relative to the start of the file +"RTN","TMGIDE",273,0) + ;" e.g. START+8^MYFUNCT --> +32^MYFUNCT +"RTN","TMGIDE",274,0) + ;"Input: Pos -- a position, as returned from $ZPOS +"RTN","TMGIDE",275,0) + ;" pArray -- pointer to (name of). Array holding holding tag offsets +"RTN","TMGIDE",276,0) + ;" pArray will be in this format: +"RTN","TMGIDE",277,0) + ;" pArray("ModuleA",1,"TAG")="ALabel1" +"RTN","TMGIDE",278,0) + ;" pArray("ModuleA",1,"OFFSET")=1 +"RTN","TMGIDE",279,0) + ;" pArray("ModuleA",2,"TAG")="ALabel2" +"RTN","TMGIDE",280,0) + ;" pArray("ModuleA",2,"OFFSET")=9 +"RTN","TMGIDE",281,0) + ;" pArray("ModuleA","Label1")=1 +"RTN","TMGIDE",282,0) + ;" pArray("ModuleA","Label2")=2 +"RTN","TMGIDE",283,0) + ;" pArray("ModuleA","Label3")=3 +"RTN","TMGIDE",284,0) + ;" pArray("ModuleB",1,"TAG")="BLabel1" +"RTN","TMGIDE",285,0) + ;" pArray("ModuleB",1,"OFFSET")=4 +"RTN","TMGIDE",286,0) + ;" pArray("ModuleB",2,"TAG")="BLabel2" +"RTN","TMGIDE",287,0) + ;" pArray("ModuleB",2,"OFFSET")=23 +"RTN","TMGIDE",288,0) + ;" pArray("ModuleB","Label1")=1 +"RTN","TMGIDE",289,0) + ;" pArray("ModuleB","Label2")=2 +"RTN","TMGIDE",290,0) + ;" pArray("ModuleB","Label3")=3 +"RTN","TMGIDE",291,0) + ;" NOTE: -- if array passed is empty, then this function will call ScanModule to fill it +"RTN","TMGIDE",292,0) + ;"Result: returns the new position line, relative to the start of the file/module +"RTN","TMGIDE",293,0) + ;" +"RTN","TMGIDE",294,0) + +"RTN","TMGIDE",295,0) + new cpS +"RTN","TMGIDE",296,0) + new cpResult set cpResult="" +"RTN","TMGIDE",297,0) + new cpRoutine,cpLabel,cpOffset +"RTN","TMGIDE",298,0) + +"RTN","TMGIDE",299,0) + set cpS=$piece(Pos,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE +"RTN","TMGIDE",300,0) + if cpS="" do goto CPDone +"RTN","TMGIDE",301,0) + . write "Parse error: Nothing before $ in",cpS,! +"RTN","TMGIDE",302,0) + +"RTN","TMGIDE",303,0) + set cpRoutine=$piece(cpS,"^",2) +"RTN","TMGIDE",304,0) + if cpRoutine="" do goto CPDone +"RTN","TMGIDE",305,0) + . write "Parse error: No routine specified in: ",cpS,! +"RTN","TMGIDE",306,0) + +"RTN","TMGIDE",307,0) + set cpS=$piece(cpS,"^",1) +"RTN","TMGIDE",308,0) + set cpOffset=+$piece(cpS,"+",2) +"RTN","TMGIDE",309,0) + ;"if cpOffset="" set cpOffset=1 +"RTN","TMGIDE",310,0) + ;"else set cpOffset=+cpOffset +"RTN","TMGIDE",311,0) + set cpLabel=$piece(cpS,"+",1) +"RTN","TMGIDE",312,0) + +"RTN","TMGIDE",313,0) + if $data(@pArray@(cpRoutine))=0 do +"RTN","TMGIDE",314,0) + . new p2Array set p2Array=$name(@pArray@(cpRoutine)) +"RTN","TMGIDE",315,0) + . do ScanMod(cpRoutine,p2Array) +"RTN","TMGIDE",316,0) + +"RTN","TMGIDE",317,0) + new cpIdx set cpIdx=+$get(@pArray@(cpRoutine,cpLabel)) +"RTN","TMGIDE",318,0) + if cpIdx=0 do goto CPDone +"RTN","TMGIDE",319,0) + . ;"write "Parse error: Can't find ",cpRoutine,",",cpLabel," in stored source code.",! +"RTN","TMGIDE",320,0) + new cpGOffset set cpGOffset=@pArray@(cpRoutine,cpIdx,"OFFSET") +"RTN","TMGIDE",321,0) + set cpResult="+"_+(cpGOffset+cpOffset)_"^"_cpRoutine +"RTN","TMGIDE",322,0) + +"RTN","TMGIDE",323,0) +CPDone +"RTN","TMGIDE",324,0) + quit cpResult +"RTN","TMGIDE",325,0) + +"RTN","TMGIDE",326,0) + +"RTN","TMGIDE",327,0) +RelConvertPos(Pos,ViewOffset,pArray) +"RTN","TMGIDE",328,0) + ;"Purpose: to convert a positioning line from one that is relative to +"RTN","TMGIDE",329,0) + ;" the start of the file to one that is relative to the +"RTN","TMGIDE",330,0) + ;" last tag/label +"RTN","TMGIDE",331,0) + ;" e.g. +32^MYFUNCT --> START+8^MYFUNCT +"RTN","TMGIDE",332,0) + ;" I.e. this function in the OPPOSITE of ConvertPos +"RTN","TMGIDE",333,0) + ;"Input: Pos -- a position, as returned from $ZPOS +"RTN","TMGIDE",334,0) + ;" ViewOffset -- the offset from the Pos to get pos for +"RTN","TMGIDE",335,0) + ;" pArray -- pointer to (name of). Array holding holding tag offsets +"RTN","TMGIDE",336,0) + ;" see Description in ConvertPos() +"RTN","TMGIDE",337,0) + ;"Result: returns the new position line, relative to the start of the last tag/label +"RTN","TMGIDE",338,0) + +"RTN","TMGIDE",339,0) + ;"write !,"Here in RelConvertPos. Pos=",Pos," ViewOffset=",ViewOffset,! +"RTN","TMGIDE",340,0) + new zbRelPos,zbLabel,zbOffset,zbRoutine +"RTN","TMGIDE",341,0) + do ParsePos^TMGIDE(Pos,.zbLabel,.zbOffset,.zbRoutine) +"RTN","TMGIDE",342,0) + set zbRelPos=zbLabel_"+"_+(zbOffset+ViewOffset)_"^"_zbRoutine +"RTN","TMGIDE",343,0) + new zbTemp set zbTemp=zbRelPos +"RTN","TMGIDE",344,0) + ;"5/27/07 I don't know why following line was here. Removing. +"RTN","TMGIDE",345,0) + ;"It was breaking the setting of breakpoints. I wonder if I have now +"RTN","TMGIDE",346,0) + ;"broken conditional breakpoints... Figure that out later... +"RTN","TMGIDE",347,0) + ;"set zbRelPos=$$ConvertPos^TMGIDE(zbRelPos,pArray) +"RTN","TMGIDE",348,0) + if zbRelPos="" do +"RTN","TMGIDE",349,0) + . write "Before ConvertPos, zbRelPos=",zbTemp,! +"RTN","TMGIDE",350,0) + . write "Afterwards, zbRelPos=""""",! +"RTN","TMGIDE",351,0) + ;"write "Done RelConvertPos. Result=",zbRelPos,! +"RTN","TMGIDE",352,0) + quit zbRelPos +"RTN","TMGIDE",353,0) + +"RTN","TMGIDE",354,0) + +"RTN","TMGIDE",355,0) +ScanMod(Module,pArray) +"RTN","TMGIDE",356,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",357,0) + ;"Purpose: To scan a module and find all the labels/entry points/Entry points +"RTN","TMGIDE",358,0) + ;"Input: Module -- The name of the module, like "XGF" (not "XGF.m" or "^XGF") +"RTN","TMGIDE",359,0) + ;" pArray -- pointer to (NAME OF) array Will be filled like this +"RTN","TMGIDE",360,0) + ;" pArray(1,"TAG")="Label1" +"RTN","TMGIDE",361,0) + ;" pArray(1,"OFFSET")=1 +"RTN","TMGIDE",362,0) + ;" pArray(2,"TAG")="Label2" +"RTN","TMGIDE",363,0) + ;" pArray(2,"OFFSET")=9 +"RTN","TMGIDE",364,0) + ;" pArray(3,"TAG")="Label3" etc. +"RTN","TMGIDE",365,0) + ;" pArray(3,"OFFSET")=15 +"RTN","TMGIDE",366,0) + ;" pArray("Label1")=1 +"RTN","TMGIDE",367,0) + ;" pArray("Label2")=2 +"RTN","TMGIDE",368,0) + ;" pArray("Label3")=3 +"RTN","TMGIDE",369,0) + ;" +"RTN","TMGIDE",370,0) + ;" NOTE: there seems to be a problem if the passed pArray value is "pArray", +"RTN","TMGIDE",371,0) + ;" so use another name. +"RTN","TMGIDE",372,0) + ;" +"RTN","TMGIDE",373,0) + ;"Output: Results are put into array +"RTN","TMGIDE",374,0) + ;"Result: none +"RTN","TMGIDE",375,0) + +"RTN","TMGIDE",376,0) + new smIdx set smIdx=1 +"RTN","TMGIDE",377,0) + new LabelNum set LabelNum=0 +"RTN","TMGIDE",378,0) + new smLine set smLine="" +"RTN","TMGIDE",379,0) + if $get(Module)="" goto SMDone +"RTN","TMGIDE",380,0) + ;"look for a var with global scope to see how how many characters are significant to GT.M +"RTN","TMGIDE",381,0) + if $get(zbSigNameLen)="" do +"RTN","TMGIDE",382,0) + . set zbSigNameLen=$$NumSigChs^TMGMISC() +"RTN","TMGIDE",383,0) + +"RTN","TMGIDE",384,0) + for do quit:(smLine="") +"RTN","TMGIDE",385,0) + . new smCh +"RTN","TMGIDE",386,0) + . set smLine=$text(+smIdx^@Module) +"RTN","TMGIDE",387,0) + . if smLine="" quit +"RTN","TMGIDE",388,0) + . set smLine=$$Substitute(smLine,$Char(9)," ") ;"replace tabs for 8 spaces +"RTN","TMGIDE",389,0) + . set smCh=$extract(smLine,1) +"RTN","TMGIDE",390,0) + . if (smCh'=" ")&(smCh'=";") do +"RTN","TMGIDE",391,0) + . . new label +"RTN","TMGIDE",392,0) + . . set label=$piece(smLine," ",1) +"RTN","TMGIDE",393,0) + . . set label=$piece(label,"(",1) ;"MyFunct(X,Y) --> MyFunct +"RTN","TMGIDE",394,0) + . . set label=$extract(label,1,zbSigNameLen) +"RTN","TMGIDE",395,0) + . . set LabelNum=LabelNum+1 +"RTN","TMGIDE",396,0) + . . set @pArray@(LabelNum,"TAG")=label +"RTN","TMGIDE",397,0) + . . set @pArray@(LabelNum,"OFFSET")=smIdx +"RTN","TMGIDE",398,0) + . . set @pArray@(label)=LabelNum +"RTN","TMGIDE",399,0) + . set smIdx=smIdx+1 +"RTN","TMGIDE",400,0) + +"RTN","TMGIDE",401,0) +SMDone +"RTN","TMGIDE",402,0) + quit +"RTN","TMGIDE",403,0) + +"RTN","TMGIDE",404,0) + +"RTN","TMGIDE",405,0) + +"RTN","TMGIDE",406,0) +BROWSENODES(current,Order,paginate,countNodes) +"RTN","TMGIDE",407,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",408,0) + ;"Purpose: to display nodes of specified array +"RTN","TMGIDE",409,0) + ;"Input: Current -- The reference to display +"RTN","TMGIDE",410,0) + ;" order -- OPTIONAL, default=1; 1 for forward, -1 for backwards order +"RTN","TMGIDE",411,0) + ;" paginate -- OPTIONAL, default=0; 0=no pagination, 1=pause after each page +"RTN","TMGIDE",412,0) + ;" countNodes -- OPTIONAL, default=0; 1=show number of child nodes. +"RTN","TMGIDE",413,0) + +"RTN","TMGIDE",414,0) + new parent,child +"RTN","TMGIDE",415,0) + set parent="" +"RTN","TMGIDE",416,0) + set order=$get(order,1) +"RTN","TMGIDE",417,0) + set paginate=$get(paginate,0) +"RTN","TMGIDE",418,0) + set countNodes=$get(countNodes,0) +"RTN","TMGIDE",419,0) + +"RTN","TMGIDE",420,0) + new len set len=$length(current) +"RTN","TMGIDE",421,0) + new lastChar set lastChar=$extract(current,len) +"RTN","TMGIDE",422,0) + if lastChar'=")" do +"RTN","TMGIDE",423,0) + . if current'["(" quit +"RTN","TMGIDE",424,0) + . if lastChar="," set current=$extract(current,1,len-1) +"RTN","TMGIDE",425,0) + . if lastChar="(" set current=$extract(current,1,len-1) quit +"RTN","TMGIDE",426,0) + . set current=current_")" +"RTN","TMGIDE",427,0) + +"RTN","TMGIDE",428,0) +BNLoop +"RTN","TMGIDE",429,0) + if current="" goto BNDone +"RTN","TMGIDE",430,0) + set child=$$ShowNodes(current,order,paginate,countNodes) +"RTN","TMGIDE",431,0) + if child'="" do +"RTN","TMGIDE",432,0) + . set parent(child)=current +"RTN","TMGIDE",433,0) + . set current=child +"RTN","TMGIDE",434,0) + else set current=$get(parent(current)) +"RTN","TMGIDE",435,0) + goto BNLoop +"RTN","TMGIDE",436,0) +BNDone +"RTN","TMGIDE",437,0) + quit +"RTN","TMGIDE",438,0) + +"RTN","TMGIDE",439,0) + +"RTN","TMGIDE",440,0) +ShowNodes(pArray,order,paginate,countNodes) +"RTN","TMGIDE",441,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",442,0) + ;"Purpose: To display all the nodes of the given array +"RTN","TMGIDE",443,0) + ;"Input: pArray -- NAME OF array to display +"RTN","TMGIDE",444,0) + ;" order -- OPTIONAL, default=1; 1 for forward, -1 for backwards order +"RTN","TMGIDE",445,0) + ;" paginate -- OPTIONAL, default=0; 0=no pagination, 1=pause after each page +"RTN","TMGIDE",446,0) + ;" countNodes -- OPTIONAL, default=0; 1=show number of child nodes. +"RTN","TMGIDE",447,0) + ;"Results: returns NAME OF next node to display (or "" if none) +"RTN","TMGIDE",448,0) + +"RTN","TMGIDE",449,0) + new TMGi +"RTN","TMGIDE",450,0) + new count set count=1 +"RTN","TMGIDE",451,0) + new Answers +"RTN","TMGIDE",452,0) + new someShown set someShown=0 +"RTN","TMGIDE",453,0) + new abort set abort=0 +"RTN","TMGIDE",454,0) + set paginate=$get(paginate,0) +"RTN","TMGIDE",455,0) + new pageCount set pageCount=0 +"RTN","TMGIDE",456,0) + new pageLen set pageLen=20 +"RTN","TMGIDE",457,0) + set countNodes=$get(countNodes,0) +"RTN","TMGIDE",458,0) + +"RTN","TMGIDE",459,0) + write pArray,! +"RTN","TMGIDE",460,0) + set TMGi=$order(@pArray@(""),order) +"RTN","TMGIDE",461,0) + if TMGi'="" for do quit:(TMGi="")!(abort=1) +"RTN","TMGIDE",462,0) + . write count,". +--[",TMGi,"]" +"RTN","TMGIDE",463,0) + . if countNodes=1 write "(",$$ListCt($name(@pArray@(TMGi))),")" +"RTN","TMGIDE",464,0) + . write "=",$extract($get(@pArray@(TMGi)),1,40),! +"RTN","TMGIDE",465,0) + . set someShown=1 +"RTN","TMGIDE",466,0) + . set Answers(count)=$name(@pArray@(TMGi)) +"RTN","TMGIDE",467,0) + . set count=count+1 +"RTN","TMGIDE",468,0) + . new zbTemp read *zbTemp:0 +"RTN","TMGIDE",469,0) + . if zbTemp'=-1 set abort=1 +"RTN","TMGIDE",470,0) + . set pageCount=pageCount+1 +"RTN","TMGIDE",471,0) + . if (paginate=1)&(pageCount>pageLen) do +"RTN","TMGIDE",472,0) + . . new zbTemp +"RTN","TMGIDE",473,0) + . . read "Press [ENTER] to continue (^ to stop list)...",zbTemp:$get(DTIME,3600),! +"RTN","TMGIDE",474,0) + . . if zbTemp="^" set abort=1 +"RTN","TMGIDE",475,0) + . . set pageCount=0 +"RTN","TMGIDE",476,0) + . set TMGi=$order(@pArray@(TMGi),order) +"RTN","TMGIDE",477,0) + +"RTN","TMGIDE",478,0) + if someShown=0 write " (no data)",! +"RTN","TMGIDE",479,0) + write !,"Enter # to browse (^ to backup): ^//" +"RTN","TMGIDE",480,0) + new zbTemp read zbTemp:$get(DTIME,3600),! +"RTN","TMGIDE",481,0) + +"RTN","TMGIDE",482,0) + new result set result=$get(Answers(zbTemp)) +"RTN","TMGIDE",483,0) + +"RTN","TMGIDE",484,0) + quit result +"RTN","TMGIDE",485,0) + +"RTN","TMGIDE",486,0) + +"RTN","TMGIDE",487,0) +ListCt(pArray) +"RTN","TMGIDE",488,0) + ;"NOTE: Duplicate of function in TMGMISC +"RTN","TMGIDE",489,0) + ;"SCOPE: PUBLIC +"RTN","TMGIDE",490,0) + ;"Purpose: to count the number of entries in an array +"RTN","TMGIDE",491,0) + ;"Input: pointer to (name of) array to test. +"RTN","TMGIDE",492,0) + ;"Output: the number of entries at highest level +"RTN","TMGIDE",493,0) + ;" e.g. Array("TELEPHONE")=1234 +"RTN","TMGIDE",494,0) + ;" Array("CAR")=4764 +"RTN","TMGIDE",495,0) + ;" Array("DOG")=5213 +"RTN","TMGIDE",496,0) + ;" Array("DOG","COLLAR")=5213 <-- not highest level,not counted. +"RTN","TMGIDE",497,0) + ;" The above array would have a count of 3 +"RTN","TMGIDE",498,0) + new i,result set result=0 +"RTN","TMGIDE",499,0) + +"RTN","TMGIDE",500,0) + do +"RTN","TMGIDE",501,0) + . new $etrap +"RTN","TMGIDE",502,0) + . set $etrap="write ""?? Error Trapped ??"",! set $ECODE="""" quit" +"RTN","TMGIDE",503,0) + . set i=$order(@pArray@("")) +"RTN","TMGIDE",504,0) + . if i="" quit +"RTN","TMGIDE",505,0) + . for set result=result+1 set i=$order(@pArray@(i)) quit:i="" +"RTN","TMGIDE",506,0) + +"RTN","TMGIDE",507,0) + quit result +"RTN","TMGIDE",508,0) + +"RTN","TMGIDE",509,0) + +"RTN","TMGIDE",510,0) +TrimL(S,TrimCh) +"RTN","TMGIDE",511,0) + ;"NOTE: Duplicate of function in TMGSTUTL +"RTN","TMGIDE",512,0) + ;"Purpose: To a trip a string of leading white space +"RTN","TMGIDE",513,0) + ;" i.e. convert " hello" into "hello" +"RTN","TMGIDE",514,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGIDE",515,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGIDE",516,0) + ;"Results: returns modified string +"RTN","TMGIDE",517,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGIDE",518,0) + +"RTN","TMGIDE",519,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGIDE",520,0) + +"RTN","TMGIDE",521,0) + new result set result=$get(S) +"RTN","TMGIDE",522,0) + new Ch set Ch="" +"RTN","TMGIDE",523,0) + +"RTN","TMGIDE",524,0) + for do quit:(Ch'=TrimCh) +"RTN","TMGIDE",525,0) + . set Ch=$extract(result,1,1) +"RTN","TMGIDE",526,0) + . if Ch=TrimCh do +"RTN","TMGIDE",527,0) + . . set result=$extract(result,2,1024) +"RTN","TMGIDE",528,0) + +"RTN","TMGIDE",529,0) + quit result +"RTN","TMGIDE",530,0) + +"RTN","TMGIDE",531,0) + +"RTN","TMGIDE",532,0) +TrimR(S,TrimCh) +"RTN","TMGIDE",533,0) + ;"NOTE: Duplicate of function in TMGSTUTL +"RTN","TMGIDE",534,0) + ;"Purpose: To a trip a string of trailing white space +"RTN","TMGIDE",535,0) + ;" i.e. convert "hello " into "hello" +"RTN","TMGIDE",536,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGIDE",537,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGIDE",538,0) + ;"Results: returns modified string +"RTN","TMGIDE",539,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGIDE",540,0) + +"RTN","TMGIDE",541,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGIDE",542,0) + +"RTN","TMGIDE",543,0) + new result set result=$get(S) +"RTN","TMGIDE",544,0) + new Ch set Ch="" +"RTN","TMGIDE",545,0) + new L +"RTN","TMGIDE",546,0) + +"RTN","TMGIDE",547,0) + for do quit:(Ch'=TrimCh) +"RTN","TMGIDE",548,0) + . set L=$length(result) +"RTN","TMGIDE",549,0) + . set Ch=$extract(result,L,L) +"RTN","TMGIDE",550,0) + . if Ch=TrimCh do +"RTN","TMGIDE",551,0) + . . set result=$extract(result,1,L-1) +"RTN","TMGIDE",552,0) + +"RTN","TMGIDE",553,0) + quit result +"RTN","TMGIDE",554,0) + +"RTN","TMGIDE",555,0) + +"RTN","TMGIDE",556,0) +Trim(S,TrimCh) +"RTN","TMGIDE",557,0) + ;"NOTE: Duplicate of function in TMGSTUTL +"RTN","TMGIDE",558,0) + ;"Purpose: To a trip a string of leading and trailing white space +"RTN","TMGIDE",559,0) + ;" i.e. convert " hello " into "hello" +"RTN","TMGIDE",560,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGIDE",561,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGIDE",562,0) + ;"Results: returns modified string +"RTN","TMGIDE",563,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGIDE",564,0) + +"RTN","TMGIDE",565,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGIDE",566,0) + +"RTN","TMGIDE",567,0) + new result set result=$get(S) +"RTN","TMGIDE",568,0) + set result=$$TrimL(.result,TrimCh) +"RTN","TMGIDE",569,0) + set result=$$TrimR(.result,TrimCh) +"RTN","TMGIDE",570,0) + +"RTN","TMGIDE",571,0) + quit result +"RTN","TMGIDE",572,0) + +"RTN","TMGIDE",573,0) + +"RTN","TMGIDE",574,0) + +"RTN","TMGIDE",575,0) +Substitute(S,Match,NewValue) +"RTN","TMGIDE",576,0) + ;"NOTE: Duplicate of function in TMGSTUTL +"RTN","TMGIDE",577,0) + ;"PUBLIC FUNCTION +"RTN","TMGIDE",578,0) + ;"Purpose: to look for all instances of Match in S, and replace with NewValue +"RTN","TMGIDE",579,0) + ;"Input: S - string to alter. Altered if passed by reference +"RTN","TMGIDE",580,0) + ;" Match -- the sequence to look for, i.e. '##' +"RTN","TMGIDE",581,0) + ;" NewValue -- what to replace Match with, i.e. '$$' +"RTN","TMGIDE",582,0) + ;"Note: This is different than $translate, as follows +"RTN","TMGIDE",583,0) + ;" $translate("ABC###DEF","###","*") --> "ABC***DEF" +"RTN","TMGIDE",584,0) + ;" $$Substitute("ABC###DEF","###","*") --> "ABC*DEF" +"RTN","TMGIDE",585,0) + ;"Result: returns altered string (if any alterations indicated) +"RTN","TMGIDE",586,0) + ;"Output: S is altered, if passed by reference. +"RTN","TMGIDE",587,0) + +"RTN","TMGIDE",588,0) + new spec +"RTN","TMGIDE",589,0) + set spec($get(Match))=$get(NewValue) +"RTN","TMGIDE",590,0) + set S=$$REPLACE(S,.spec) +"RTN","TMGIDE",591,0) + quit S +"RTN","TMGIDE",592,0) + +"RTN","TMGIDE",593,0) + +"RTN","TMGIDE",594,0) +REPLACE(IN,SPEC) ;"See $$REPLACE in MDC minutes. +"RTN","TMGIDE",595,0) + ;"Taken from REPLACE^XLFSTR +"RTN","TMGIDE",596,0) + quit:'$D(IN) "" +"RTN","TMGIDE",597,0) + quit:$D(SPEC)'>9 IN +"RTN","TMGIDE",598,0) + N %1,%2,%3,%4,%5,%6,%7,%8 +"RTN","TMGIDE",599,0) + set %1=$L(IN) +"RTN","TMGIDE",600,0) + set %7=$J("",%1) +"RTN","TMGIDE",601,0) + set %3="" +"RTN","TMGIDE",602,0) + set %6=9999 +"RTN","TMGIDE",603,0) + for set %3=$order(SPEC(%3)) quit:%3="" set %6(%6)=%3,%6=%6-1 +"RTN","TMGIDE",604,0) + for %6=0:0 set %6=$O(%6(%6)) quit:%6'>0 set %3=%6(%6) do:$D(SPEC(%3))#2 RE1 +"RTN","TMGIDE",605,0) + set %8="" +"RTN","TMGIDE",606,0) + for %2=1:1:%1 do RE3 +"RTN","TMGIDE",607,0) + quit %8 +"RTN","TMGIDE",608,0) +RE1 set %4=$L(%3) +"RTN","TMGIDE",609,0) + set %5=0 for S %5=$F(IN,%3,%5) Q:%5<1 D RE2 +"RTN","TMGIDE",610,0) + Q +"RTN","TMGIDE",611,0) +RE2 Q:$E(%7,%5-%4,%5-1)["X" S %8(%5-%4)=SPEC(%3) +"RTN","TMGIDE",612,0) + F %2=%5-%4:1:%5-1 S %7=$E(%7,1,%2-1)_"X"_$E(%7,%2+1,%1) +"RTN","TMGIDE",613,0) + Q +"RTN","TMGIDE",614,0) +RE3 I $E(%7,%2)=" " S %8=%8_$E(IN,%2) Q +"RTN","TMGIDE",615,0) + S:$D(%8(%2)) %8=%8_%8(%2) +"RTN","TMGIDE",616,0) + Q +"RTN","TMGIDE",617,0) + +"RTN","TMGIDE",618,0) + +"RTN","TMGIDE",619,0) +KeyPress(wantChar,waitTime) +"RTN","TMGIDE",620,0) + ;"NOTE: Duplicate of function in TMGUSRIF +"RTN","TMGIDE",621,0) + ;"Purpose: to check for a keypress +"RTN","TMGIDE",622,0) + ;"Input: wantChar -- OPTIONAL, if 1, then Character is returned, not ASCII value +"RTN","TMGIDE",623,0) + ;" waitTime -- OPTIONAL, default is 0 (immediate return) +"RTN","TMGIDE",624,0) + ;"Result: ASCII value of key, if pressed, -1 otherwise ("" if wantChar=1) +"RTN","TMGIDE",625,0) + ;"Note: this does NOT wait for user to press key +"RTN","TMGIDE",626,0) + +"RTN","TMGIDE",627,0) + new zbTemp +"RTN","TMGIDE",628,0) + set waitTime=$get(waitTime,0) +"RTN","TMGIDE",629,0) + read *zbTemp:waitTime +"RTN","TMGIDE",630,0) + if $get(wantChar)=1 set zbTemp=$char(zbTemp) +"RTN","TMGIDE",631,0) + quit zbTemp +"RTN","TMGIDE",632,0) + +"RTN","TMGIDE",633,0) + +"RTN","TMGIDE",634,0) + +"RTN","TMGIDE",635,0) +DebugWrite(DBIndent,s,AddNewline) +"RTN","TMGIDE",636,0) + ;"NOTE: Duplicate of function in TMGDEBUG +"RTN","TMGIDE",637,0) + ;"PUBLIC FUNCTION +"RTN","TMGIDE",638,0) + ;"Purpose: to write debug output. Having the proc separate will allow +"RTN","TMGIDE",639,0) + ;" easier dump to file etc. +"RTN","TMGIDE",640,0) + ;"Input:DBIndent, the amount of indentation expected for output. +"RTN","TMGIDE",641,0) + ;" s -- the text to write +"RTN","TMGIDE",642,0) + ;" AddNewline -- boolean, 1 if ! (i.e. newline) should be written after s +"RTN","TMGIDE",643,0) + +"RTN","TMGIDE",644,0) + ;"Relevant DEBUG values +"RTN","TMGIDE",645,0) + ;" cdbNone - no debug (0) +"RTN","TMGIDE",646,0) + ;" cdbToScrn - Debug output to screen (1) +"RTN","TMGIDE",647,0) + ;" cdbToFile - Debug output to file (2) +"RTN","TMGIDE",648,0) + ;" cdbToTail - Debug output to X tail dialog box. (3) +"RTN","TMGIDE",649,0) + ;"Note: If above values are not defined, then functionality will be ignored. +"RTN","TMGIDE",650,0) + +"RTN","TMGIDE",651,0) + +"RTN","TMGIDE",652,0) + set cdbNone=$get(cdbNone,0) +"RTN","TMGIDE",653,0) + set cdbToScrn=$get(cdbToScrn,1) +"RTN","TMGIDE",654,0) + set cdbToFile=$get(cdbToFile,2) +"RTN","TMGIDE",655,0) + set cdbToTail=$get(cdbToTail,3) +"RTN","TMGIDE",656,0) + set TMGDEBUG=$get(TMGDEBUG,cdbNone) +"RTN","TMGIDE",657,0) + if $get(TMGDEBUG)=cdbNone quit +"RTN","TMGIDE",658,0) + +"RTN","TMGIDE",659,0) + if (TMGDEBUG=$get(cdbToFile))!(TMGDEBUG=$get(cdbToTail)) do +"RTN","TMGIDE",660,0) + . if $data(DebugFile) use DebugFile +"RTN","TMGIDE",661,0) + +"RTN","TMGIDE",662,0) + write s +"RTN","TMGIDE",663,0) + set cTrue=$get(cTrue,1) +"RTN","TMGIDE",664,0) + if $get(AddNewline)=cTrue write ! +"RTN","TMGIDE",665,0) + +"RTN","TMGIDE",666,0) + if (TMGDEBUG=$get(cdbToFile))!(TMGDEBUG=$get(cdbToTail)) do +"RTN","TMGIDE",667,0) + . use $PRINCIPAL +"RTN","TMGIDE",668,0) + +"RTN","TMGIDE",669,0) + quit +"RTN","TMGIDE",670,0) + +"RTN","TMGIDE",671,0) + +"RTN","TMGIDE",672,0) +DebugIndent(DBIndentForced) +"RTN","TMGIDE",673,0) + ;"NOTE: Duplicate of function in TMGDEBUG +"RTN","TMGIDE",674,0) + ;"PUBLIC FUNCTION +"RTN","TMGIDE",675,0) + ;"Purpose: to provide a unified indentation for debug messages +"RTN","TMGIDE",676,0) + ;"Input: DBIndent = number of indentations +"RTN","TMGIDE",677,0) + ;" Forced = 1 if to indent regardless of DEBUG mode +"RTN","TMGIDE",678,0) + +"RTN","TMGIDE",679,0) + set Forced=$get(Forced,0) +"RTN","TMGIDE",680,0) + +"RTN","TMGIDE",681,0) + if ($get(TMGDEBUG,0)=0)&(Forced=0) quit +"RTN","TMGIDE",682,0) + new i +"RTN","TMGIDE",683,0) + for i=1:1:DBIndent do +"RTN","TMGIDE",684,0) + . if Forced do DebugWrite(DBIndent," ") +"RTN","TMGIDE",685,0) + . else do DebugWrite(DBIndent,". ") +"RTN","TMGIDE",686,0) + quit +"RTN","TMGIDE",687,0) + +"RTN","TMGIDE",688,0) + +"RTN","TMGIDE",689,0) +ArrayDump(ArrayP,TMGIDX,indent) +"RTN","TMGIDE",690,0) + ;"NOTE: Duplicate of function in TMGDEBUG +"RTN","TMGIDE",691,0) + ;"PUBLIC FUNCTION +"RTN","TMGIDE",692,0) + ;"Purpose: to get a custom version of GTM's "zwr" command +"RTN","TMGIDE",693,0) + ;"Input: Uses global scope var DBIndent (if defined) +"RTN","TMGIDE",694,0) + ;" ArrayP: NAME of global to display, i.e. "^VA(200)" +"RTN","TMGIDE",695,0) + ;" TMGIDX: initial index (i.e. 5 if wanting to start with ^VA(200,5) +"RTN","TMGIDE",696,0) + ;" indent: spacing from left margin to begin with. (A number. Each count is 2 spaces) +"RTN","TMGIDE",697,0) + ;" OPTIONAL: indent may be an array, with information about columns +"RTN","TMGIDE",698,0) + ;" to skip. For example: +"RTN","TMGIDE",699,0) + ;" indent=3, indent(2)=0 --> show | for columns 1 & 3, but NOT 2 +"RTN","TMGIDE",700,0) + ;"Result: 0=OK to continue, 1=user aborted display +"RTN","TMGIDE",701,0) + +"RTN","TMGIDE",702,0) + new result set result=0 +"RTN","TMGIDE",703,0) + if $$UserAborted^TMGUSRIF set result=1 goto ADDone +"RTN","TMGIDE",704,0) + new $etrap set $etrap="set result="""",$etrap="""",$ecode=""""" +"RTN","TMGIDE",705,0) + +"RTN","TMGIDE",706,0) +AD1 if $data(ArrayP)=0 goto ADDone +"RTN","TMGIDE",707,0) + new abort set abort=0 +"RTN","TMGIDE",708,0) + if (ArrayP["@") do goto:(abort=1) ADDone +"RTN","TMGIDE",709,0) + . new zbTemp set zbTemp=$piece($extract(ArrayP,2,99),"@",1) +"RTN","TMGIDE",710,0) + . if $data(zbTemp)#10=0 set abort=1 +"RTN","TMGIDE",711,0) + ;"Note: I need to do some validation to ensure ArrayP doesn't have any null nodes. +"RTN","TMGIDE",712,0) + new X set X="SET zbTemp=$GET("_ArrayP_")" +"RTN","TMGIDE",713,0) + set X=$$UP(X) +"RTN","TMGIDE",714,0) + do ^DIM ;"a method to ensure ArrayP doesn't have an invalid reference. +"RTN","TMGIDE",715,0) + if $get(X)="" goto ADDone +"RTN","TMGIDE",716,0) + +"RTN","TMGIDE",717,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGIDE",718,0) + set cTrue=$get(cTrue,1) +"RTN","TMGIDE",719,0) + set cFalse=$get(cFalse,0) +"RTN","TMGIDE",720,0) + +"RTN","TMGIDE",721,0) + ;"Force this function to output, even if TMGDEBUG is not defined. +"RTN","TMGIDE",722,0) + ;"if $data(TMGDEBUG)=0 new TMGDEBUG ;"//kt 1-16-06, doesn't seem to be working +"RTN","TMGIDE",723,0) + new TMGDEBUG ;"//kt added 1-16-06 +"RTN","TMGIDE",724,0) + set TMGDEBUG=1 +"RTN","TMGIDE",725,0) + +"RTN","TMGIDE",726,0) + new ChildP,TMGi +"RTN","TMGIDE",727,0) + +"RTN","TMGIDE",728,0) + set TMGIDX=$get(TMGIDX,"") +"RTN","TMGIDE",729,0) + set indent=$get(indent,0) +"RTN","TMGIDE",730,0) + new SavIndex set SavIndex=TMGIDX +"RTN","TMGIDE",731,0) + +"RTN","TMGIDE",732,0) + do DebugIndent(DBIndent) +"RTN","TMGIDE",733,0) + +"RTN","TMGIDE",734,0) + if indent>0 do +"RTN","TMGIDE",735,0) + . for TMGi=1:1:indent-1 do +"RTN","TMGIDE",736,0) + . . new s set s="" +"RTN","TMGIDE",737,0) + . . if $get(indent(TMGi),-1)=0 set s=" " +"RTN","TMGIDE",738,0) + . . else set s="| " +"RTN","TMGIDE",739,0) + . . do DebugWrite(DBIndent,s) +"RTN","TMGIDE",740,0) + . do DebugWrite(DBIndent,"}~") +"RTN","TMGIDE",741,0) + +"RTN","TMGIDE",742,0) + if TMGIDX'="" do +"RTN","TMGIDE",743,0) + . if $data(@ArrayP@(TMGIDX))#10=1 do +"RTN","TMGIDE",744,0) + . . new s set s=@ArrayP@(TMGIDX) +"RTN","TMGIDE",745,0) + . . if s="" set s="""""" +"RTN","TMGIDE",746,0) + . . new qt set qt="" +"RTN","TMGIDE",747,0) + . . if +TMGIDX'=TMGIDX set qt="""" +"RTN","TMGIDE",748,0) + . . do DebugWrite(DBIndent,qt_TMGIDX_qt_" = "_s,cTrue) +"RTN","TMGIDE",749,0) + . else do +"RTN","TMGIDE",750,0) + . . do DebugWrite(DBIndent,TMGIDX,1) +"RTN","TMGIDE",751,0) + . set ArrayP=$name(@ArrayP@(TMGIDX)) +"RTN","TMGIDE",752,0) + else do +"RTN","TMGIDE",753,0) + . ;"do DebugWrite(DBIndent,ArrayP_"(*)",cFalse) +"RTN","TMGIDE",754,0) + . do DebugWrite(DBIndent,ArrayP,cFalse) +"RTN","TMGIDE",755,0) + . if $data(@ArrayP)#10=1 do +"RTN","TMGIDE",756,0) + . . do DebugWrite(0,"="_$get(@ArrayP),cFalse) +"RTN","TMGIDE",757,0) + . do DebugWrite(0,"",cTrue) +"RTN","TMGIDE",758,0) + +"RTN","TMGIDE",759,0) + set TMGIDX=$order(@ArrayP@("")) +"RTN","TMGIDE",760,0) + if TMGIDX="" goto ADDone +"RTN","TMGIDE",761,0) + set indent=indent+1 +"RTN","TMGIDE",762,0) + +"RTN","TMGIDE",763,0) + for do quit:TMGIDX="" if result=1 goto ADDone +"RTN","TMGIDE",764,0) + . new tTMGIDX set tTMGIDX=$order(@ArrayP@(TMGIDX)) +"RTN","TMGIDE",765,0) + . if tTMGIDX="" set indent(indent)=0 +"RTN","TMGIDE",766,0) + . new tIndent merge tIndent=indent +"RTN","TMGIDE",767,0) + . set result=$$ArrayDump(ArrayP,TMGIDX,.tIndent) ;"Call self recursively +"RTN","TMGIDE",768,0) + . set TMGIDX=$order(@ArrayP@(TMGIDX)) +"RTN","TMGIDE",769,0) + +"RTN","TMGIDE",770,0) + ;"Put in a blank space at end of subbranch +"RTN","TMGIDE",771,0) + do DebugIndent(DBIndent) +"RTN","TMGIDE",772,0) + +"RTN","TMGIDE",773,0) + if indent>0 do +"RTN","TMGIDE",774,0) + . for TMGi=1:1:indent-1 do +"RTN","TMGIDE",775,0) + . . new s set s="" +"RTN","TMGIDE",776,0) + . . if $get(indent(TMGi),-1)=0 set s=" " +"RTN","TMGIDE",777,0) + . . else set s="| " +"RTN","TMGIDE",778,0) + . . do DebugWrite(DBIndent,s) +"RTN","TMGIDE",779,0) + . do DebugWrite(DBIndent," ",1) +"RTN","TMGIDE",780,0) + +"RTN","TMGIDE",781,0) +ADDone +"RTN","TMGIDE",782,0) + quit result +"RTN","TMGIDE",783,0) + +"RTN","TMGIDE",784,0) + +"RTN","TMGIDE",785,0) +ExpandLine(Pos) +"RTN","TMGIDE",786,0) + ;"NOTE: Duplicate of function in TMGDEBUG +"RTN","TMGIDE",787,0) + ;"Purpose: to expand a line of code, found at position "Pos", using ^XINDX8 functionality +"RTN","TMGIDE",788,0) + ;"Input: Pos: a position as returned by $ZPOS (e.g. G+5^DIS, or +23^DIS) +"RTN","TMGIDE",789,0) + ;"Output: Writes to the currently selecte IO device and expansion of one line of code +"RTN","TMGIDE",790,0) + ;"Note: This is used for taking the very long lines of code, as found in Fileman, and +"RTN","TMGIDE",791,0) + ;" convert them to a format with one command on each line. +"RTN","TMGIDE",792,0) + ;" Note: it appears to do syntax checking and shows ERROR if syntax is not per VA +"RTN","TMGIDE",793,0) + ;" conventions--such as commands must be UPPERCASE etc. +"RTN","TMGIDE",794,0) + +"RTN","TMGIDE",795,0) + ;"--- copied and modified from XINDX8.m --- +"RTN","TMGIDE",796,0) + +"RTN","TMGIDE",797,0) + kill ^UTILITY($J) +"RTN","TMGIDE",798,0) + +"RTN","TMGIDE",799,0) + new label,offset,RTN,dmod +"RTN","TMGIDE",800,0) + do ParsePos(Pos,.label,.offset,.RTN,.dmod) +"RTN","TMGIDE",801,0) + if label'="" do ;"change position from one relative to label into one relative to top of file +"RTN","TMGIDE",802,0) + . new CodeArray +"RTN","TMGIDE",803,0) + . set Pos=$$ConvertPos(Pos,"CodeArray") +"RTN","TMGIDE",804,0) + . do ParsePos(Pos,.label,.offset,.RTN,.dmod) +"RTN","TMGIDE",805,0) + +"RTN","TMGIDE",806,0) + if RTN="" goto ELDone +"RTN","TMGIDE",807,0) + +"RTN","TMGIDE",808,0) + do BUILD^XINDX7 +"RTN","TMGIDE",809,0) + set ^UTILITY($J,RTN)="" +"RTN","TMGIDE",810,0) + do LOAD^XINDEX +"RTN","TMGIDE",811,0) + set CCN=0 +"RTN","TMGIDE",812,0) + for I=1:1:+^UTILITY($J,1,RTN,0,0) set CCN=CCN+$L(^UTILITY($J,1,RTN,0,I,0))+2 +"RTN","TMGIDE",813,0) + set ^UTILITY($J,1,RTN,0)=CCN +"RTN","TMGIDE",814,0) + ;"do ^XINDX8 -- included below +"RTN","TMGIDE",815,0) + +"RTN","TMGIDE",816,0) + new Q,DDOT,LO,PG,LIN,ML,IDT +"RTN","TMGIDE",817,0) + new tIOSL set tIOSL=IOSL +"RTN","TMGIDE",818,0) + set IOSL=999999 ;"really long 'page length' prevents header printout (and error) +"RTN","TMGIDE",819,0) + +"RTN","TMGIDE",820,0) + set Q="""" +"RTN","TMGIDE",821,0) + set DDOT=0 +"RTN","TMGIDE",822,0) + set LO=0 +"RTN","TMGIDE",823,0) + set PG=+$G(PG) +"RTN","TMGIDE",824,0) + +"RTN","TMGIDE",825,0) + set LC=offset +"RTN","TMGIDE",826,0) + if $D(^UTILITY($J,1,RTN,0,LC)) do +"RTN","TMGIDE",827,0) + . set LIN=^(LC,0),ML=0,IDT=10 +"RTN","TMGIDE",828,0) + . set LO=LC-1 +"RTN","TMGIDE",829,0) + . do CD^XINDX8 +"RTN","TMGIDE",830,0) + +"RTN","TMGIDE",831,0) + kill AGR,EOC,IDT,JJ,LO,ML,OLD,SAV,TY +"RTN","TMGIDE",832,0) + +"RTN","TMGIDE",833,0) + set IOSL=tIOSL ;"restore saved IOSL +"RTN","TMGIDE",834,0) +ELDone +"RTN","TMGIDE",835,0) + quit +"RTN","TMGIDE",836,0) + +"RTN","TMGIDE",837,0) + +"RTN","TMGIDE",838,0) + +"RTN","TMGIDE",839,0) +CREF(X) +"RTN","TMGIDE",840,0) + ;"Taken from CREF^DILF --> ENCREF^DIQGU +"RTN","TMGIDE",841,0) + ;"Convert an open reference to a closed reference +"RTN","TMGIDE",842,0) + new L,X1,X2,X3 +"RTN","TMGIDE",843,0) + set X1=$piece(X,"(") +"RTN","TMGIDE",844,0) + set X2=$piece(X,"(",2,99) +"RTN","TMGIDE",845,0) + set L=$length(X2) +"RTN","TMGIDE",846,0) + set X3=$translate($extract(X2,L),",)") +"RTN","TMGIDE",847,0) + set X2=$extract(X2,1,(L-1))_X3 +"RTN","TMGIDE",848,0) + +"RTN","TMGIDE",849,0) + quit X1_$select(X2]"":"("_X2_")",1:"") +"RTN","TMGIDE",850,0) + +"RTN","TMGIDE",851,0) + +"RTN","TMGIDE",852,0) +LGR() +"RTN","TMGIDE",853,0) + ;"Taken from LGR^%ZOSV +"RTN","TMGIDE",854,0) + ;" Last global reference ($REFERENCE) +"RTN","TMGIDE",855,0) + quit $R +"RTN","TMGIDE",856,0) + +"RTN","TMGIDE",857,0) +UP(X) +"RTN","TMGIDE",858,0) + ;"Taken from UP^XLFSTR +"RTN","TMGIDE",859,0) + quit $translate(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") +"RTN","TMGIDE",860,0) + +"RTN","TMGIDE",861,0) + +"RTN","TMGIDE",862,0) +READ() +"RTN","TMGIDE",863,0) + ;"Purpose: To read user input, with knowledge of arrow keys +"RTN","TMGIDE",864,0) + ;" This will use VPE keyboard handling if available, otherwise XGF stuff +"RTN","TMGIDE",865,0) + ;"Result: Will return all user input up to a terminator (RETURN, or a special key) +"RTN","TMGIDE",866,0) + ;" See code in %ZVEMKRN for possible code returns. format +"RTN","TMGIDE",867,0) + +"RTN","TMGIDE",868,0) + ;"9/3/06 -- don't use VPE keyboard anymore +"RTN","TMGIDE",869,0) + quit $$OLDREAD(,604800) ;"set timeout to 1 week (604800 secs). +"RTN","TMGIDE",870,0) + +"RTN","TMGIDE",871,0) + if $text(+0^%ZVEMKRN)="" quit $$OLDREAD() +"RTN","TMGIDE",872,0) + +"RTN","TMGIDE",873,0) + new key,FnKey +"RTN","TMGIDE",874,0) + new done set done=0 +"RTN","TMGIDE",875,0) + new result set result="" +"RTN","TMGIDE",876,0) + +"RTN","TMGIDE",877,0) + for do quit:(done=1) +"RTN","TMGIDE",878,0) + . ;"READ^%ZVEMKRN(PROMPT,LENGTH,NOECHO) ; +"RTN","TMGIDE",879,0) + . ;"PROMPT Display prompt. +"RTN","TMGIDE",880,0) + . ;"LENGTH Maximum # of characters user may enter. +"RTN","TMGIDE",881,0) + . ;"NOECHO 1=Do not echo what user types. +"RTN","TMGIDE",882,0) + . set key=$$READ^%ZVEMKRN("",1,0) +"RTN","TMGIDE",883,0) + . set FnKey=$get(VEE("K")) +"RTN","TMGIDE",884,0) + . if FnKey="" set done=1,FnKey="" quit +"RTN","TMGIDE",885,0) + . if (FnKey="")!(FnKey="") do +"RTN","TMGIDE",886,0) + . . set result=$extract(result,1,$length(result)-1) +"RTN","TMGIDE",887,0) + . . write $char(8)_" "_$char(8) ;"a backspace char +"RTN","TMGIDE",888,0) + . . set FnKey="" set key="" +"RTN","TMGIDE",889,0) + . if FnKey'="" set key=FnKey,done=1 +"RTN","TMGIDE",890,0) + . if key'="" set result=result_key +"RTN","TMGIDE",891,0) + +"RTN","TMGIDE",892,0) + quit result +"RTN","TMGIDE",893,0) + +"RTN","TMGIDE",894,0) + +"RTN","TMGIDE",895,0) +OLDREAD(XGCHARS,XGTO) +"RTN","TMGIDE",896,0) + ;"Taken from READ^XGF +"RTN","TMGIDE",897,0) + ;"read the keyboard +"RTN","TMGIDE",898,0) + ;"XGCHARS:number of chars to read, XGTO:timeout +"RTN","TMGIDE",899,0) + quit $$READ2($G(XGCHARS),$G(XGTO)) +"RTN","TMGIDE",900,0) + +"RTN","TMGIDE",901,0) +READ2(XGCHARS,XGTO) +"RTN","TMGIDE",902,0) + ;"Taken from READ^XGKB +"RTN","TMGIDE",903,0) + ;" read XGCHARS using escape processing. XGTO timeout (optional). Result returned. +"RTN","TMGIDE",904,0) + ;" Char that terminated the read will be in TMGXGRT +"RTN","TMGIDE",905,0) + N S,XGW1,XGT1,XGSEQ ;string,window,timer,timer sequence +"RTN","TMGIDE",906,0) + K DTOUT +"RTN","TMGIDE",907,0) + S TMGXGRT="" +"RTN","TMGIDE",908,0) + D:$G(XGTO)="" ;set timeout value if one wasn't passed +"RTN","TMGIDE",909,0) + . I $D(XGT) D Q ;if timers are defined +"RTN","TMGIDE",910,0) + . . S XGTO=$O(XGT(0,"")) ;get shortest time left of all timers +"RTN","TMGIDE",911,0) + . . S XGW1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,1) ;get timer's window +"RTN","TMGIDE",912,0) + . . S XGT1=$P(XGT(0,XGTO,$O(XGT(0,XGTO,"")),"ID"),U,3) ;get timer's name +"RTN","TMGIDE",913,0) + . I $D(XGW) S XGTO=99999999 Q ;in emulation read forever +"RTN","TMGIDE",914,0) + . S XGTO=$G(DTIME,600) +"RTN","TMGIDE",915,0) + ; +"RTN","TMGIDE",916,0) + I $G(XGCHARS)>0 R S#XGCHARS:XGTO S:'$T DTOUT=1 I 1 ;fixed length read +"RTN","TMGIDE",917,0) + E R S:XGTO S:'$T DTOUT=1 I 1 ;read as many as possible +"RTN","TMGIDE",918,0) + S:$G(DTOUT)&('$D(XGT1)) S=U ;stuff ^ +"RTN","TMGIDE",919,0) + ; +"RTN","TMGIDE",920,0) + S:$L($ZB) TMGXGRT=$G(^XUTL("XGKB",$ZB)) ;get terminator if any +"RTN","TMGIDE",921,0) + I $G(DTOUT),$D(XGT1),$D(^TMP("XGW",$J,XGW1,"T",XGT1,"EVENT","TIMER")) D I 1 ;if timed out +"RTN","TMGIDE",922,0) + . D E^XGEVNT1(XGW1,"T",XGT1,"","TIMER") +"RTN","TMGIDE",923,0) + E I $L(TMGXGRT),$D(^TMP("XGKEY",$J,TMGXGRT)) X ^(TMGXGRT) ;do some action +"RTN","TMGIDE",924,0) + ; this really should be handled by keyboard mapping -- later +"RTN","TMGIDE",925,0) + Q S +"RTN","TMGIDE",926,0) + +"RTN","TMGIDE2") +0^25^B9859 +"RTN","TMGIDE2",1,0) +TMGIDE2 ;TMG/kst/A debugger/tracer for GT.M (core functionality) ;03/25/06 +"RTN","TMGIDE2",2,0) + ;;1.0;TMG-LIB;**1**;04/12/05 +"RTN","TMGIDE2",3,0) + +"RTN","TMGIDE2",4,0) + ;" GT.M TRAP STEP +"RTN","TMGIDE2",5,0) + ;" +"RTN","TMGIDE2",6,0) + ;" K. Toppenberg +"RTN","TMGIDE2",7,0) + ;" 4-13-2005 +"RTN","TMGIDE2",8,0) + ;" License: GPL Applies +"RTN","TMGIDE2",9,0) + ;" +"RTN","TMGIDE2",10,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE2",11,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE2",12,0) + ;" This code module will allow tracing through code. +"RTN","TMGIDE2",13,0) + ;" It is used as follows: +"RTN","TMGIDE2",14,0) + ;" +"RTN","TMGIDE2",15,0) + ;" set $ZSTEP="do STEPTRAP^TMGIDE2($ZPOS) zstep into zcontinue" +"RTN","TMGIDE2",16,0) + ;" zstep into +"RTN","TMGIDE2",17,0) + ;" do ^MyFunction ;"<--- put the function you want to trace here +"RTN","TMGIDE2",18,0) + ;" +"RTN","TMGIDE2",19,0) + ;" set $ZSTEP="" ;"<---turn off step capture +"RTN","TMGIDE2",20,0) + ;" quit +"RTN","TMGIDE2",21,0) + ;" +"RTN","TMGIDE2",22,0) + ;" +"RTN","TMGIDE2",23,0) + ;" Dependencies: +"RTN","TMGIDE2",24,0) + ;" Uses: ^TMGTERM,^TMGIDE +"RTN","TMGIDE2",25,0) + ;" +"RTN","TMGIDE2",26,0) + ;"Notes: +"RTN","TMGIDE2",27,0) + ;" This function will be called inbetween lines of the main +"RTN","TMGIDE2",28,0) + ;" program that is being traced. Thus this function can't do +"RTN","TMGIDE2",29,0) + ;" anything that might change the environment of the main +"RTN","TMGIDE2",30,0) + ;" program. +"RTN","TMGIDE2",31,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE2",32,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE2",33,0) + +"RTN","TMGIDE2",34,0) + ;"======================================================================= +"RTN","TMGIDE2",35,0) + ;" API -- Public Functions. +"RTN","TMGIDE2",36,0) + ;"======================================================================= +"RTN","TMGIDE2",37,0) + ;"STEPTRAP(idePos,TMGMsg) +"RTN","TMGIDE2",38,0) + ;"ErrTrap(idePos) +"RTN","TMGIDE2",39,0) + +"RTN","TMGIDE2",40,0) + ;"======================================================================= +"RTN","TMGIDE2",41,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGIDE2",42,0) + ;"======================================================================= +"RTN","TMGIDE2",43,0) + ;"EvalWatches +"RTN","TMGIDE2",44,0) + ;"BlankLine +"RTN","TMGIDE2",45,0) + ;"ShowCode(idePos,ScrWidth,ScrHeight,Wipe,ViewOffset,LROffset) +"RTN","TMGIDE2",46,0) + ;"GetStackInfo(Stack,OrigIDEPos) +"RTN","TMGIDE2",47,0) + ;"SetBreakpoint(pos) +"RTN","TMGIDE2",48,0) + ;"RelBreakpoint(pos) +"RTN","TMGIDE2",49,0) + +"RTN","TMGIDE2",50,0) + ;"======================================================================= +"RTN","TMGIDE2",51,0) + ;"======================================================================= +"RTN","TMGIDE2",52,0) + +"RTN","TMGIDE2",53,0) + +"RTN","TMGIDE2",54,0) +STEPTRAP(idePos,TMGMsg) +"RTN","TMGIDE2",55,0) + ;"Purpose: This is the line that is called by GT.M for each zstep event. +"RTN","TMGIDE2",56,0) + ;" It will be used to display the current code execution point, and +"RTN","TMGIDE2",57,0) + ;" query user as to plans for future execution: run/step/ etc. +"RTN","TMGIDE2",58,0) + ;"Input: idePos -- a text line containing position, as returned bye $ZPOS +"RTN","TMGIDE2",59,0) + ;" TMGMsg -- OPTIONAL -- can be used by programs to pass in info. +"RTN","TMGIDE2",60,0) + ;" If TMGMsg=1, then this function was called without the +"RTN","TMGIDE2",61,0) + ;" $ZSTEP value set, so this function should set it. +"RTN","TMGIDE2",62,0) + +"RTN","TMGIDE2",63,0) + if $ZTRAP'["^TMG" do SetErrTrap^TMGIDE ;"ensure no redirecting of error trap +"RTN","TMGIDE2",64,0) + new stpResult set stpResult=1 ;"1=step into, 2=step over +"RTN","TMGIDE2",65,0) + new NakedRef set NakedRef=$$LGR^TMGIDE ;"save naked reference +"RTN","TMGIDE2",66,0) + new ArrayName set ArrayName="^TMG(""TMGIDE"",$J,""MODULES"")" +"RTN","TMGIDE2",67,0) + +"RTN","TMGIDE2",68,0) + new tpBlankLine,tpAction,tpKeyIn,tpRunMode,tpStepMode,tpI,tpDone +"RTN","TMGIDE2",69,0) + new ViewOffset set ViewOffset=0 +"RTN","TMGIDE2",70,0) + new relPos +"RTN","TMGIDE2",71,0) + +"RTN","TMGIDE2",72,0) + ;"Run modes: 0=running mode +"RTN","TMGIDE2",73,0) + ;" 1=stepping mode +"RTN","TMGIDE2",74,0) + ;" 2=Don't show code +"RTN","TMGIDE2",75,0) + ;" 3=running SLOW mode +"RTN","TMGIDE2",76,0) + ;" -1=quit +"RTN","TMGIDE2",77,0) + +"RTN","TMGIDE2",78,0) + new savedIO,savedX,savedY +"RTN","TMGIDE2",79,0) + set savedIO=$IO +"RTN","TMGIDE2",80,0) + set savedX=$X,savedY=$Y +"RTN","TMGIDE2",81,0) + +"RTN","TMGIDE2",82,0) + set tpRunMode=$get(TMGRunMode,1) +"RTN","TMGIDE2",83,0) + set tpStepMode=$get(TMGStepMode,"into") +"RTN","TMGIDE2",84,0) + +"RTN","TMGIDE2",85,0) + new ScrHeight,ScrWidth,LROffset +"RTN","TMGIDE2",86,0) + set ScrHeight=$get(TMGScrHeight,10) +"RTN","TMGIDE2",87,0) + set ScrWidth=$get(TMGScrWidth,($get(IOM,66)-1)) +"RTN","TMGIDE2",88,0) + set LROffset=$get(TMGLROffset,0) +"RTN","TMGIDE2",89,0) + use $P:(WIDTH=ScrWidth:NOWRAP) ;"reset IO to the screen +"RTN","TMGIDE2",90,0) + +"RTN","TMGIDE2",91,0) + set tpBlankLine=" " +"RTN","TMGIDE2",92,0) + for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" " +"RTN","TMGIDE2",93,0) + +"RTN","TMGIDE2",94,0) + set relPos=idePos +"RTN","TMGIDE2",95,0) + new OrigIDEPos set OrigIDEPos=idePos +"RTN","TMGIDE2",96,0) + new tempPos set tempPos=$$ConvertPos^TMGIDE(idePos,ArrayName) +"RTN","TMGIDE2",97,0) + if tempPos'="" set idePos=tempPos +"RTN","TMGIDE2",98,0) + +"RTN","TMGIDE2",99,0) + ;"Note: I will have to try to get this working later. +"RTN","TMGIDE2",100,0) + ;"I have it such that the condition is recognized. But now I need to +"RTN","TMGIDE2",101,0) + ;"Differientate between stepping through code, and a breakpoint from +"RTN","TMGIDE2",102,0) + ;"a full speed run. +"RTN","TMGIDE2",103,0) + new stpSkip set stpSkip=0 +"RTN","TMGIDE2",104,0) + if $$IsBreakpoint(idePos) do ;"goto:(stpSkip=1) SP2Done +"RTN","TMGIDE2",105,0) + . new ifS set ifS=$$GetBrkCond(idePos) if ifS="" quit +"RTN","TMGIDE2",106,0) + . new $etrap set $etrap="write ""ERROR in breakpoint condition code."",! quit" +"RTN","TMGIDE2",107,0) + . if (@ifS=0) set stpSkip=1 +"RTN","TMGIDE2",108,0) + . if @ifS write "Condition FOUND!!" ;"do PressToCont^TMGUSRIF +"RTN","TMGIDE2",109,0) + +"RTN","TMGIDE2",110,0) + ;"don't show hidden modules +"RTN","TMGIDE2",111,0) + if $$ShouldSkip($piece(idePos,"^",2)) goto SP2Done +"RTN","TMGIDE2",112,0) + +"RTN","TMGIDE2",113,0) + do VCUSAV2^TMGTERM +"RTN","TMGIDE2",114,0) + +"RTN","TMGIDE2",115,0) + new CsrOnBreakline set CsrOnBreakline=0 +"RTN","TMGIDE2",116,0) + if tpRunMode'=2 do ;"2=Don't show code +"RTN","TMGIDE2",117,0) + . do ShowCode(idePos,ScrWidth,ScrHeight,LROffset,.CsrOnBreakline) +"RTN","TMGIDE2",118,0) + . write CsrOnBreakline,! ;"temps +"RTN","TMGIDE2",119,0) + else do +"RTN","TMGIDE2",120,0) + . do CUP^TMGTERM(1,2) +"RTN","TMGIDE2",121,0) + write tpBlankLine,! +"RTN","TMGIDE2",122,0) + write tpBlankLine,! +"RTN","TMGIDE2",123,0) + do CUU^TMGTERM(2) +"RTN","TMGIDE2",124,0) + +"RTN","TMGIDE2",125,0) + if (tpRunMode=0)!(tpRunMode=2)!(tpRunMode=3) do ;"i.e. not stepping mode +"RTN","TMGIDE2",126,0) + . write tpBlankLine,! +"RTN","TMGIDE2",127,0) + . do CUU^TMGTERM(1) +"RTN","TMGIDE2",128,0) + . do EvalWatches +"RTN","TMGIDE2",129,0) + . write "(Press any key to pause)",! +"RTN","TMGIDE2",130,0) + . read *tpKeyIn:0 +"RTN","TMGIDE2",131,0) + . if (tpKeyIn>0) set tpRunMode=1 +"RTN","TMGIDE2",132,0) + . else if tpRunMode=3 hang 0.25 +"RTN","TMGIDE2",133,0) + +"RTN","TMGIDE2",134,0) + if tpRunMode=2 goto SPDone ;"Don't-show mode --> goto SPDone +"RTN","TMGIDE2",135,0) + do CmdPrompt ;"display prompt and interact with user +"RTN","TMGIDE2",136,0) + +"RTN","TMGIDE2",137,0) +SPDone +"RTN","TMGIDE2",138,0) + do VCULOAD2^TMGTERM +"RTN","TMGIDE2",139,0) +SP2Done +"RTN","TMGIDE2",140,0) + ;"Finish up and return to GTM execution +"RTN","TMGIDE2",141,0) + set TMGRunMode=tpRunMode +"RTN","TMGIDE2",142,0) + if tpStepMode="into" set stpResult=1 +"RTN","TMGIDE2",143,0) + else set stpResult=2 +"RTN","TMGIDE2",144,0) + set TMGStepMode=tpStepMode +"RTN","TMGIDE2",145,0) + +"RTN","TMGIDE2",146,0) + if $data(savedIO) use savedIO ;"turn IO back to what it was when coming into this function. +"RTN","TMGIDE2",147,0) + set $X=+$get(savedX),$Y=+$get(savedY) +"RTN","TMGIDE2",148,0) + +"RTN","TMGIDE2",149,0) + if $get(TMGMsg)=1 do ;"call was without $ZSTEP set, so we should set it. +"RTN","TMGIDE2",150,0) + . set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE2($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue" +"RTN","TMGIDE2",151,0) + . zstep:(stpResult=1) into zstep:(stpResult=2) over +"RTN","TMGIDE2",152,0) + +"RTN","TMGIDE2",153,0) + if NakedRef'["""""" do ;"If holds "" index, skip over +"RTN","TMGIDE2",154,0) + . new discard set discard=$get(@NakedRef) ;"reset naked reference. +"RTN","TMGIDE2",155,0) + +"RTN","TMGIDE2",156,0) + quit stpResult +"RTN","TMGIDE2",157,0) + +"RTN","TMGIDE2",158,0) + ;"============================================================================ +"RTN","TMGIDE2",159,0) + +"RTN","TMGIDE2",160,0) +CmdPrompt +"RTN","TMGIDE2",161,0) + ;"Purpose: Display the command prompt, and handle user input +"RTN","TMGIDE2",162,0) + ;"Note: uses some variables with global scope, because this code block +"RTN","TMGIDE2",163,0) + ;" was simply cut out of main routine above. +"RTN","TMGIDE2",164,0) + +"RTN","TMGIDE2",165,0) + new tpDone +"RTN","TMGIDE2",166,0) + +"RTN","TMGIDE2",167,0) + new $etrap set $etrap="set result="""",$etrap="""",$ecode=""""" +"RTN","TMGIDE2",168,0) + set tpDone=0 +"RTN","TMGIDE2",169,0) + if tpRunMode=1 for do quit:tpDone=1 +"RTN","TMGIDE2",170,0) + . new DefAction set DefAction="O" +"RTN","TMGIDE2",171,0) + . do ShowCode(idePos,ScrWidth,ScrHeight,,ViewOffset,LROffset,.CsrOnBreakline) +"RTN","TMGIDE2",172,0) + . new tempi for tempi=1:1:2 do ;"create empty space below display. +"RTN","TMGIDE2",173,0) + . . write tpBlankLine,! +"RTN","TMGIDE2",174,0) + . do CUU^TMGTERM(2) +"RTN","TMGIDE2",175,0) + . if CsrOnBreakline=1 do +"RTN","TMGIDE2",176,0) + . . new ifS set ifS=$$GetBrkCond($$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName)) +"RTN","TMGIDE2",177,0) + . . if ifS'="" write "Breakpoint test: [",ifS,"]",! +"RTN","TMGIDE2",178,0) + . write "}" +"RTN","TMGIDE2",179,0) + . do EvalWatches +"RTN","TMGIDE2",180,0) + . set $X=1 +"RTN","TMGIDE2",181,0) + . write "Action (? for help): " +"RTN","TMGIDE2",182,0) + . if tpStepMode="into" write "step INTO// " set DefAction="I" +"RTN","TMGIDE2",183,0) + . else write "step OVER// " set DefAction="O" +"RTN","TMGIDE2",184,0) + . new loop +"RTN","TMGIDE2",185,0) + . new tempX set tempX=$X +"RTN","TMGIDE2",186,0) + . for loop=1:1:20 write " " +"RTN","TMGIDE2",187,0) + . for loop=1:1:20 write $char(8) ;"backspace +"RTN","TMGIDE2",188,0) + . set $X=tempX +"RTN","TMGIDE2",189,0) + . set tpAction=$$READ^TMGIDE() write ! +"RTN","TMGIDE2",190,0) + . if tpAction="" set tpAction=DefAction +"RTN","TMGIDE2",191,0) + . set TMGXGRT=$get(TMGXGRT) +"RTN","TMGIDE2",192,0) + . if TMGXGRT="UP" set tpAction="A" +"RTN","TMGIDE2",193,0) + . if TMGXGRT="PREV" set tpAction="AA" +"RTN","TMGIDE2",194,0) + . if TMGXGRT="DOWN" set tpAction="Z" +"RTN","TMGIDE2",195,0) + . if TMGXGRT="NEXT" set tpAction="ZZ" +"RTN","TMGIDE2",196,0) + . if TMGXGRT="RIGHT" set tpAction="]" +"RTN","TMGIDE2",197,0) + . if TMGXGRT="LEFT" set tpAction="[" +"RTN","TMGIDE2",198,0) + . new origAction set origAction=tpAction +"RTN","TMGIDE2",199,0) + . set tpAction=$$UP^TMGIDE(tpAction) +"RTN","TMGIDE2",200,0) + . if tpAction="R" do quit +"RTN","TMGIDE2",201,0) + . . set tpRunMode=0 +"RTN","TMGIDE2",202,0) + . . set tpDone=1 +"RTN","TMGIDE2",203,0) + . if tpAction="L" do quit +"RTN","TMGIDE2",204,0) + . . set tpRunMode=3 +"RTN","TMGIDE2",205,0) + . . set tpDone=1 +"RTN","TMGIDE2",206,0) + . if $extract(tpAction,1)="M" do quit +"RTN","TMGIDE2",207,0) + . . ;"new zbTemp +"RTN","TMGIDE2",208,0) + . . do CUU^TMGTERM(1) +"RTN","TMGIDE2",209,0) + . . do CHA^TMGTERM(1) ;"move to x=1 on this line +"RTN","TMGIDE2",210,0) + . . write tpBlankLine,! +"RTN","TMGIDE2",211,0) + . . do CUU^TMGTERM(1) +"RTN","TMGIDE2",212,0) + . . set tpLine=$$Trim^TMGIDE($piece(origAction," ",2,999)) +"RTN","TMGIDE2",213,0) + . . if tpLine="" read " enter M code (^ to cancel): ",tpLine,! +"RTN","TMGIDE2",214,0) + . . if (tpLine'="^") do +"RTN","TMGIDE2",215,0) + . . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"",! set $etrap="""",$ecode=""""" +"RTN","TMGIDE2",216,0) + . . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",217,0) + . . . xecute tpLine +"RTN","TMGIDE2",218,0) + . if tpAction="I" do quit +"RTN","TMGIDE2",219,0) + . . set tpStepMode="into" +"RTN","TMGIDE2",220,0) + . . ;"set $ZSTEP="do STEPTRAP^TMGIDE2($ZPOS) zstep into zcontinue" +"RTN","TMGIDE2",221,0) + . . set tpDone=1 +"RTN","TMGIDE2",222,0) + . if tpAction="O" do quit +"RTN","TMGIDE2",223,0) + . . set tpStepMode="over" +"RTN","TMGIDE2",224,0) + . . ;"set $ZSTEP="do STEPTRAP^TMGIDE2($ZPOS) zstep over zcontinue" +"RTN","TMGIDE2",225,0) + . . set tpDone=1 +"RTN","TMGIDE2",226,0) + . if tpAction="X" do quit ;"Turn off debugger +"RTN","TMGIDE2",227,0) + . . set $ZSTEP="" +"RTN","TMGIDE2",228,0) + . . set TMGMsg=0 +"RTN","TMGIDE2",229,0) + . . set tpDone=1 +"RTN","TMGIDE2",230,0) + . if tpAction="C" do quit +"RTN","TMGIDE2",231,0) + . . new brkPos +"RTN","TMGIDE2",232,0) + . . read !,"Enter breakpoint (e.g. Label+8^MyFunct): ",brkPos,! +"RTN","TMGIDE2",233,0) + . . do SetBreakpoint(brkPos) +"RTN","TMGIDE2",234,0) + . if tpAction="BC" do quit ;"enter a breakpoint condition (IF code) +"RTN","TMGIDE2",235,0) + . . write "Enter an IF condition. Examples: 'A=1' or '$$FN1^MOD(A)=2'",! +"RTN","TMGIDE2",236,0) + . . read "Enter IF condition (^ to cancel, @ to delete): ",tpLine,! +"RTN","TMGIDE2",237,0) + . . if (tpLine="^") quit +"RTN","TMGIDE2",238,0) + . . new brkPos set brkPos=$$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName) +"RTN","TMGIDE2",239,0) + . . do SetBrkCond(brkPos,tpLine) +"RTN","TMGIDE2",240,0) + . if tpAction="B" do quit ;"Toggle a breakpoint at current location +"RTN","TMGIDE2",241,0) + . . ;"write !,"Trying to determine correct breakpoint. relPos=",relPos," ViewOffset=",ViewOffset,! +"RTN","TMGIDE2",242,0) + . . new brkPos set brkPos=$$RelConvertPos^TMGIDE(relPos,ViewOffset,ArrayName) +"RTN","TMGIDE2",243,0) + . . ;"write "brkPos=",brkPos,! +"RTN","TMGIDE2",244,0) + . . if brkPos="" write "relPos=",relPos," view offset=",ViewOffset," ArrayName=",ArrayName,! +"RTN","TMGIDE2",245,0) + . . do ToggleBreakpoint(brkPos) +"RTN","TMGIDE2",246,0) + . if tpAction="E" do quit +"RTN","TMGIDE2",247,0) + . . new expPos,zbLabel,zbOffset,zbRoutine +"RTN","TMGIDE2",248,0) + . . do ParsePos^TMGIDE(idePos,.zbLabel,.zbOffset,.zbRoutine) +"RTN","TMGIDE2",249,0) + . . set expPos=zbLabel_"+"_+(zbOffset+ViewOffset)_"^"_zbRoutine +"RTN","TMGIDE2",250,0) + . . write ! +"RTN","TMGIDE2",251,0) + . . do ExpandLine^TMGIDE(expPos) +"RTN","TMGIDE2",252,0) + . . new tempKey read " --- Press Enter To Continue--",tempKey:$get(DTIME,3600) +"RTN","TMGIDE2",253,0) + . if tpAction="H" do quit +"RTN","TMGIDE2",254,0) + . . set tpRunMode=2 +"RTN","TMGIDE2",255,0) + . . set tpDone=1 +"RTN","TMGIDE2",256,0) + . if $extract(tpAction,1)="W" do quit +"RTN","TMGIDE2",257,0) + . . ;"new zbTemp +"RTN","TMGIDE2",258,0) + . . do CUU^TMGTERM(1) +"RTN","TMGIDE2",259,0) + . . do CHA^TMGTERM(1) ;"move to x=1 on this line +"RTN","TMGIDE2",260,0) + . . write tpBlankLine,! +"RTN","TMGIDE2",261,0) + . . do CUU^TMGTERM(1) +"RTN","TMGIDE2",262,0) + . . if tpAction["+" do +"RTN","TMGIDE2",263,0) + . . . new watchVar set watchVar=$$Trim^TMGIDE($piece(origAction,"+",2)) +"RTN","TMGIDE2",264,0) + . . . if watchVar="^" set watchVar="NakedRef" +"RTN","TMGIDE2",265,0) + . . . set tpWatchLine=$get(tpWatchLine)_" write """_watchVar_" =["",$get("_watchVar_"),""], """ +"RTN","TMGIDE2",266,0) + . . else do +"RTN","TMGIDE2",267,0) + . . . new tempCode +"RTN","TMGIDE2",268,0) + . . . read "Enter M code (^ to cancel): ",tempCode,! +"RTN","TMGIDE2",269,0) + . . . if tempCode'="^" set tpWatchLine=tempCode +"RTN","TMGIDE2",270,0) + . if (tpAction="A")!(tpAction="AA")!(tpAction="") do quit +"RTN","TMGIDE2",271,0) + . . set ViewOffset=ViewOffset-1 +"RTN","TMGIDE2",272,0) + . . if tpAction="AA" set ViewOffset=ViewOffset-ScrHeight+2; +"RTN","TMGIDE2",273,0) + . if (tpAction="") do quit +"RTN","TMGIDE2",274,0) + . . set ViewOffset=ViewOffset-1 +"RTN","TMGIDE2",275,0) + . . set ViewOffset=ViewOffset-ScrHeight+2; +"RTN","TMGIDE2",276,0) + . if (tpAction="") do quit +"RTN","TMGIDE2",277,0) + . . set ViewOffset=ViewOffset+1 +"RTN","TMGIDE2",278,0) + . . set ViewOffset=ViewOffset+ScrHeight-2; +"RTN","TMGIDE2",279,0) + . if (tpAction="Z")!(tpAction="ZZ")!(tpAction="") do quit +"RTN","TMGIDE2",280,0) + . . set ViewOffset=ViewOffset+1 +"RTN","TMGIDE2",281,0) + . . if tpAction="ZZ" set ViewOffset=ViewOffset+ScrHeight-2; +"RTN","TMGIDE2",282,0) + . if (tpAction="Q")!(tpAction="^") do quit +"RTN","TMGIDE2",283,0) + . . kill @ArrayName ;"kt added 7-18-06 +"RTN","TMGIDE2",284,0) + . . set $etrap="" ;"remove error trap +"RTN","TMGIDE2",285,0) + . . write !!!!!!!!!!! +"RTN","TMGIDE2",286,0) + . . write "CREATING AN ARTIFICIAL ERROR TO STOP EXECUTION.",! +"RTN","TMGIDE2",287,0) + . . write "--->Enter 'ZGOTO' from the GTM> prompt to clear error.",!! +"RTN","TMGIDE2",288,0) + . . set $ZSTEP="" ;"turn off step capture +"RTN","TMGIDE2",289,0) + . . xecute "write CrashNonVariable" +"RTN","TMGIDE2",290,0) + . if tpAction="+" do quit +"RTN","TMGIDE2",291,0) + . . set TMGScrWidth=$get(TMGScrWidth)+1 +"RTN","TMGIDE2",292,0) + . if tpAction="=" do quit +"RTN","TMGIDE2",293,0) + . . new tempWidth +"RTN","TMGIDE2",294,0) + . . read "Enter screen width: ",tempWidth,! +"RTN","TMGIDE2",295,0) + . . if (+tempWidth>10) set TMGScrWidth=tempWidth,ScrWidth=tempWidth +"RTN","TMGIDE2",296,0) + . . set tpBlankLine=" " +"RTN","TMGIDE2",297,0) + . . for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" " +"RTN","TMGIDE2",298,0) + . . write # ;"clear screen +"RTN","TMGIDE2",299,0) + . . do ShowCode(idePos,ScrWidth,ScrHeight,,ViewOffset,LROffset,.CsrOnBreakline) ;"<---- not working! +"RTN","TMGIDE2",300,0) + . if tpAction="-" do quit +"RTN","TMGIDE2",301,0) + . . set TMGScrWidth=$get(TMGScrWidth)-1 +"RTN","TMGIDE2",302,0) + . . if TMGScrWidth<10 set TMGScrWidth=10 +"RTN","TMGIDE2",303,0) + . if (tpAction="[")!(tpAction="") do quit +"RTN","TMGIDE2",304,0) + . . if LROffset>1 set LROffset=LROffset-1 +"RTN","TMGIDE2",305,0) + . if (tpAction="[[")!(tpAction="") do quit +"RTN","TMGIDE2",306,0) + . . set LROffset=0 +"RTN","TMGIDE2",307,0) + . if tpAction="]"!(tpAction="") do quit +"RTN","TMGIDE2",308,0) + . . if LROffset=0 set LROffset=1 +"RTN","TMGIDE2",309,0) + . . set LROffset=LROffset+1 +"RTN","TMGIDE2",310,0) + . if (tpAction="]]")!(tpAction="") do quit +"RTN","TMGIDE2",311,0) + . . if LROffset=0 set LROffset=1 +"RTN","TMGIDE2",312,0) + . . set LROffset=LROffset+20 +"RTN","TMGIDE2",313,0) + . if tpAction="CLS" do quit +"RTN","TMGIDE2",314,0) + . . write # +"RTN","TMGIDE2",315,0) + . if tpAction="TABLE" do quit +"RTN","TMGIDE2",316,0) + . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",317,0) + . . zshow "*" +"RTN","TMGIDE2",318,0) + . . new tempKey read " --- Press Enter To Continue--",tempKey:$get(DTIME,3600) +"RTN","TMGIDE2",319,0) + . if tpAction["SHOW" do quit +"RTN","TMGIDE2",320,0) + . . new varName set varName=$$Trim^TMGSTUTL($extract(origAction,5,999)) +"RTN","TMGIDE2",321,0) + . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",322,0) + . . if varName["$" do +"RTN","TMGIDE2",323,0) + . . . new tempCode +"RTN","TMGIDE2",324,0) + . . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"",! set $etrap="""",$ecode=""""" +"RTN","TMGIDE2",325,0) + . . . write varName,"='" +"RTN","TMGIDE2",326,0) + . . . ;"set tempCode="write "_varName +"RTN","TMGIDE2",327,0) + . . . set tempCode="do DebugWrite(1,"_varName_")" +"RTN","TMGIDE2",328,0) + . . . xecute tempCode +"RTN","TMGIDE2",329,0) + . . . write "' " +"RTN","TMGIDE2",330,0) + . . else do +"RTN","TMGIDE2",331,0) + . . . if $get(varName)'="" do +"RTN","TMGIDE2",332,0) + . . . . set varName=$$CREF^TMGIDE(varName) ;"convert open to closed format +"RTN","TMGIDE2",333,0) + . . . . new zbTemp set zbTemp=$$ArrayDump^TMGIDE(varName) +"RTN","TMGIDE2",334,0) + . . . . if zbTemp=0 do PressToCont^TMGUSRIF +"RTN","TMGIDE2",335,0) + . . . else do +"RTN","TMGIDE2",336,0) + . . . . ;"write varName,"='",$get(@varName),"' " +"RTN","TMGIDE2",337,0) + . if tpAction["BROWSE" do quit +"RTN","TMGIDE2",338,0) + . . new varName set varName=$$Trim^TMGIDE($extract(origAction,7,999)) +"RTN","TMGIDE2",339,0) + . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",340,0) + . . do BROWSENODES^TMGIDE(varName) +"RTN","TMGIDE2",341,0) + . if tpAction["NODES" do quit +"RTN","TMGIDE2",342,0) + . . new varName set varName=$$Trim^TMGIDE($extract(origAction,7,999)) +"RTN","TMGIDE2",343,0) + . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",344,0) + . . do BROWSEASK^TMGMISC +"RTN","TMGIDE2",345,0) + . if tpAction["STACK" do quit +"RTN","TMGIDE2",346,0) + . . write ! ;"get below bottom line for output. +"RTN","TMGIDE2",347,0) + . . new Stack do GetStackInfo(.Stack,OrigIDEPos) +"RTN","TMGIDE2",348,0) + . . new Menu set Menu(0)="Pick Stack Entry to BROWSE TO" +"RTN","TMGIDE2",349,0) + . . new TMGi for TMGi=1:1 quit:($get(Stack(TMGi))="") do +"RTN","TMGIDE2",350,0) + . . . ;"write " ",TMGi,". ",Stack(TMGi)," ",! +"RTN","TMGIDE2",351,0) + . . . new $etrap set $etrap="set $etrap="""",$ecode=""""" +"RTN","TMGIDE2",352,0) + . . . new addr set addr=$piece($$TRIM^XLFSTR(Stack(TMGi))," ",2) +"RTN","TMGIDE2",353,0) + . . . new txt set txt=$$TRIM^XLFSTR($text(@addr)) +"RTN","TMGIDE2",354,0) + . . . set txt=$$TRIM^XLFSTR(txt,$char(9)) +"RTN","TMGIDE2",355,0) + . . . new line set line=addr_"-->"_txt +"RTN","TMGIDE2",356,0) + . . . if $length(line)>TMGScrWidth do +"RTN","TMGIDE2",357,0) + . . . . set line=$extract(line,1,TMGScrWidth-4)_"..." +"RTN","TMGIDE2",358,0) + . . . set Menu(TMGi)=line_$char(9)_addr +"RTN","TMGIDE2",359,0) + . . new UsrSlct set UsrSlct=$$Menu^TMGUSRIF(.Menu) +"RTN","TMGIDE2",360,0) + . . write "Unfinished code... Later browse to: [",UsrSlct,"]",! +"RTN","TMGIDE2",361,0) + . if tpAction["RESYNC" do quit +"RTN","TMGIDE2",362,0) + . . kill @ArrayName +"RTN","TMGIDE2",363,0) + . if tpAction["HIDE" do quit +"RTN","TMGIDE2",364,0) + . . do SetupSkips +"RTN","TMGIDE2",365,0) + . else do quit +"RTN","TMGIDE2",366,0) + . . write ! +"RTN","TMGIDE2",367,0) + . . new tpNLines +"RTN","TMGIDE2",368,0) + . . for tpNLines=1:1:5 write tpBlankLine,! +"RTN","TMGIDE2",369,0) + . . do CUU^TMGTERM(5) +"RTN","TMGIDE2",370,0) + . . write " L -- run sLow mode M -- exec M code SHOW [var] -- show [var]",! +"RTN","TMGIDE2",371,0) + . . write " O -- step OVER line I -- step INTO line STACK -- stack show/jump",! +"RTN","TMGIDE2",372,0) + . . write " R -- run H -- Hide debug code CLS -- clear screen",! +"RTN","TMGIDE2",373,0) + . . write " B -- Toggle Breakpoint C -- custom breakpoint BC -- breakpoint code",! +"RTN","TMGIDE2",374,0) + . . write " W - enter watch code W +MyVar --watch MyVar W +^ -- Add Naked Ref",! +"RTN","TMGIDE2",375,0) + . . write " A,AA -- scroll up Z,ZZ -- scroll down BROWSE [var] -- browse [var]",! +"RTN","TMGIDE2",376,0) + . . write " [,[[ -- scroll left ],]] -- scroll right E -- expand current line",! +"RTN","TMGIDE2",377,0) + . . write " X -- turn off debugger Q -- Abort RESYNC -- sync display",! +"RTN","TMGIDE2",378,0) + . . write " - or + -- screen width = -- enter width HIDE -- manage/hide modules",! +"RTN","TMGIDE2",379,0) + . . write " TABLE -- show sym table NODES -- Ask & browse (global) var",! +"RTN","TMGIDE2",380,0) + +"RTN","TMGIDE2",381,0) + quit +"RTN","TMGIDE2",382,0) + +"RTN","TMGIDE2",383,0) + +"RTN","TMGIDE2",384,0) +EvalWatches +"RTN","TMGIDE2",385,0) + if $get(tpWatchLine)'="" do +"RTN","TMGIDE2",386,0) + . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGIDE2",387,0) + . xecute tpWatchLine +"RTN","TMGIDE2",388,0) + . write ! +"RTN","TMGIDE2",389,0) + else write ! +"RTN","TMGIDE2",390,0) + +"RTN","TMGIDE2",391,0) + +"RTN","TMGIDE2",392,0) +BlankLine +"RTN","TMGIDE2",393,0) + write tpBlankLine +"RTN","TMGIDE2",394,0) + do CHA^TMGTERM(1) ;"move to x=1 on this line +"RTN","TMGIDE2",395,0) + quit +"RTN","TMGIDE2",396,0) + +"RTN","TMGIDE2",397,0) + +"RTN","TMGIDE2",398,0) +ErrTrap(idePos) +"RTN","TMGIDE2",399,0) + ;"Purpose: This is the line that is called by GT.M for each ztrap event. +"RTN","TMGIDE2",400,0) + ;" It will be used to display the current code execution point +"RTN","TMGIDE2",401,0) + +"RTN","TMGIDE2",402,0) + new ScrHeight,ScrWidth +"RTN","TMGIDE2",403,0) + set ScrHeight=$get(TMGScrHeight,10) +"RTN","TMGIDE2",404,0) + set ScrWidth=$get(TMGScrWidth,70) +"RTN","TMGIDE2",405,0) + +"RTN","TMGIDE2",406,0) + do VCUSAV2^TMGTERM +"RTN","TMGIDE2",407,0) + do ShowCode(idePos,ScrWidth,ScrHeight,0) +"RTN","TMGIDE2",408,0) + +"RTN","TMGIDE2",409,0) +ETDone +"RTN","TMGIDE2",410,0) + do VCULOAD2^TMGTERM +"RTN","TMGIDE2",411,0) + quit +"RTN","TMGIDE2",412,0) + +"RTN","TMGIDE2",413,0) + +"RTN","TMGIDE2",414,0) + +"RTN","TMGIDE2",415,0) + +"RTN","TMGIDE2",416,0) +ShowCode(idePos,ScrWidth,ScrHeight,Wipe,ViewOffset,LROffset,CsrOnBreakline) +"RTN","TMGIDE2",417,0) + ;"Purpose: This will display code at the top of the screen +"RTN","TMGIDE2",418,0) + ;"Input: idePos -- string like this: X+2^ROUTINE[$DMOD] +"RTN","TMGIDE2",419,0) + ;" ScrWidth -- width of code display (Num of columns) +"RTN","TMGIDE2",420,0) + ;" ScrHeight -- height of code display (number of rows) +"RTN","TMGIDE2",421,0) + ;" Wipe -- OPTIONAL. if 1, then code area is wiped blank +"RTN","TMGIDE2",422,0) + ;" ViewOffset -- OPTIONAL. If a value is supplied, then +"RTN","TMGIDE2",423,0) + ;" the display will be shifted up or down (i.e. to view +"RTN","TMGIDE2",424,0) + ;" code other than at the point of execution) +"RTN","TMGIDE2",425,0) + ;" Positive numbers will scroll page downward. +"RTN","TMGIDE2",426,0) + ;" LROffset -- OPTIONAL. if value > 0 then the display +"RTN","TMGIDE2",427,0) + ;" of each line will begin with this number character. +"RTN","TMGIDE2",428,0) + ;" (i.e. will shift screen so that long lines can be seen.) +"RTN","TMGIDE2",429,0) + ;" 0->no offset; 1->no offset (start at character 1); 2->offset 1 +"RTN","TMGIDE2",430,0) + ;" CsrOnBreakline -- OPTIONAL. PASS BY REFERENCE. Will return 1 +"RTN","TMGIDE2",431,0) + ;" if cursor is on a break line, otherwise 0 +"RTN","TMGIDE2",432,0) + +"RTN","TMGIDE2",433,0) + new cdLoop +"RTN","TMGIDE2",434,0) + new scRoutine,scLabel,scOffset,scS +"RTN","TMGIDE2",435,0) + new LastRou,LastLabel,LastOffset +"RTN","TMGIDE2",436,0) + new dbFGColor,bBGColor,nlFGColor,nlBGColor +"RTN","TMGIDE2",437,0) + new BlankLine +"RTN","TMGIDE2",438,0) + new StartOffset +"RTN","TMGIDE2",439,0) + new scCursorLine +"RTN","TMGIDE2",440,0) + new zBreakIdx set zBreakIdx=-1 +"RTN","TMGIDE2",441,0) + new ArrayName set ArrayName="^TMG(""TMGIDE"",$J,""MODULES"")" +"RTN","TMGIDE2",442,0) + +"RTN","TMGIDE2",443,0) + set ScrWidth=$get(ScrWidth,80) +"RTN","TMGIDE2",444,0) + set ScrHeight=$get(ScrHeight,10) +"RTN","TMGIDE2",445,0) + set LROffset=+$get(LROffset,1) +"RTN","TMGIDE2",446,0) + +"RTN","TMGIDE2",447,0) + set BlankLine=" " +"RTN","TMGIDE2",448,0) + for cdLoop=1:1:ScrWidth-1 set BlankLine=BlankLine_" " +"RTN","TMGIDE2",449,0) + +"RTN","TMGIDE2",450,0) + do VCOLORS^TMGTERM(14,6) ;"bright white on cyan background +"RTN","TMGIDE2",451,0) + do CUP^TMGTERM(1,1) ;"Cursor to line (1,1) +"RTN","TMGIDE2",452,0) + +"RTN","TMGIDE2",453,0) + if $get(Wipe)=1 do goto SCDone +"RTN","TMGIDE2",454,0) + . do VTATRIB^TMGTERM(0) ;"reset colors +"RTN","TMGIDE2",455,0) + . for cdLoop=0:1:ScrHeight+1 write BlankLine +"RTN","TMGIDE2",456,0) + +"RTN","TMGIDE2",457,0) + set scS=$piece(idePos,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE +"RTN","TMGIDE2",458,0) + do ParsePos^TMGIDE(scS,.scLabel,.scOffset,.scRoutine) +"RTN","TMGIDE2",459,0) + if scRoutine="" do goto SCDone +"RTN","TMGIDE2",460,0) + . write !,!,"Error -- invalid position provided to ShowCode routine: ",idePos,! +"RTN","TMGIDE2",461,0) + . write "scS=",scS,! +"RTN","TMGIDE2",462,0) + +"RTN","TMGIDE2",463,0) + set scS="=== Routine: "_scLabel_"^"_scRoutine_" " +"RTN","TMGIDE2",464,0) + if $data(OrigIDEPos) set scS=scS_"("_OrigIDEPos_") " +"RTN","TMGIDE2",465,0) + else set scS=scS_"("_idePos_") " +"RTN","TMGIDE2",466,0) + write scS +"RTN","TMGIDE2",467,0) + for cdLoop=1:1:ScrWidth-$length(scS) write "=" +"RTN","TMGIDE2",468,0) + write ! +"RTN","TMGIDE2",469,0) + +"RTN","TMGIDE2",470,0) + do VCOLORS^TMGTERM(14,4) ;"bright white on blue background +"RTN","TMGIDE2",471,0) + +"RTN","TMGIDE2",472,0) + do ;"setup to show a symbol for breakpoint +"RTN","TMGIDE2",473,0) + . new zbS set zbS="" +"RTN","TMGIDE2",474,0) + . for set zbS=$order(^TMG("TMGIDE",$J,"ZBREAK",zbS)) quit:(zbS="") do +"RTN","TMGIDE2",475,0) + . . new zbRoutine,zbLabel,zbOffset +"RTN","TMGIDE2",476,0) + . . ;"write "found bk point:",zbS,! +"RTN","TMGIDE2",477,0) + . . new tempPos set tempPos=$$ConvertPos^TMGIDE(zbS,ArrayName) +"RTN","TMGIDE2",478,0) + . . ;"write "converted pos=",tempPos,! +"RTN","TMGIDE2",479,0) + . . do ParsePos^TMGIDE(tempPos,.zbLabel,.zbOffset,.zbRoutine) +"RTN","TMGIDE2",480,0) + . . ;"do ParsePos^TMGIDE(zbS,.zbLabel,.zbOffset,.zbRoutine) +"RTN","TMGIDE2",481,0) + . . ;"write "calculated offset=",zbOffset,! +"RTN","TMGIDE2",482,0) + . . ;"write "label=",zbLabel,! +"RTN","TMGIDE2",483,0) + . . ;"write "routine=",zbRoutine,! +"RTN","TMGIDE2",484,0) + . . if zbRoutine'=scRoutine quit +"RTN","TMGIDE2",485,0) + . . if zbLabel'=scLabel quit +"RTN","TMGIDE2",486,0) + . . set zBreakIdx(zbOffset)=1 +"RTN","TMGIDE2",487,0) + +"RTN","TMGIDE2",488,0) + if scOffset>(ScrHeight) do +"RTN","TMGIDE2",489,0) + set StartOffset=(scOffset-ScrHeight)+2 +"RTN","TMGIDE2",490,0) + else set StartOffset=0 +"RTN","TMGIDE2",491,0) + set StartOffset=StartOffset+$get(ViewOffset) +"RTN","TMGIDE2",492,0) + +"RTN","TMGIDE2",493,0) + set CsrOnBreakline=0 +"RTN","TMGIDE2",494,0) + for cdLoop=StartOffset:1:(ScrHeight+StartOffset) do +"RTN","TMGIDE2",495,0) + . new cbLine,cbRef,cbCursor,cBrkLine +"RTN","TMGIDE2",496,0) + . set cBrkLine=$data(zBreakIdx(cdLoop)) +"RTN","TMGIDE2",497,0) + . new cHighCsrPos set cHighCsrPos=0 +"RTN","TMGIDE2",498,0) + . new cHighExecPos set cHighExecPos=0 +"RTN","TMGIDE2",499,0) + . set cbRef=scLabel_"+"_cdLoop_"^"_scRoutine +"RTN","TMGIDE2",500,0) + . set cbLine=$text(@cbRef) +"RTN","TMGIDE2",501,0) + . set cbLine=$$Substitute^TMGIDE(cbLine,$Char(9)," ") +"RTN","TMGIDE2",502,0) + . if LROffset>0 set cbLine=$extract(cbLine,LROffset,999) +"RTN","TMGIDE2",503,0) + . set scCursorLine=scOffset+$get(ViewOffset) +"RTN","TMGIDE2",504,0) + . set cHighCsrPos=(cdLoop=scCursorLine) +"RTN","TMGIDE2",505,0) + . set cHighExecPos=(cdLoop=scOffset) +"RTN","TMGIDE2",506,0) + . if cHighCsrPos do VCOLORS^TMGTERM(14,6) ;"bright white on cyan background +"RTN","TMGIDE2",507,0) + . else if cHighExecPos do VCOLORS^TMGTERM(14,3) ;"bright white on yellow background +"RTN","TMGIDE2",508,0) + . if cdLoop>0 do +"RTN","TMGIDE2",509,0) + . . new tSpace set tSpace="" +"RTN","TMGIDE2",510,0) + . . if cdLoop<10 set tSpace=" " +"RTN","TMGIDE2",511,0) + . . set cbLine="+"_cdLoop_tSpace_cbLine +"RTN","TMGIDE2",512,0) + . else set cbLine=" "_cbLine +"RTN","TMGIDE2",513,0) + . if cBrkLine do +"RTN","TMGIDE2",514,0) + . . if (cHighCsrPos=0)&(cHighExecPos=0) do VCOLORS^TMGTERM(14,8) ;"bright white on red background +"RTN","TMGIDE2",515,0) + . . else do +"RTN","TMGIDE2",516,0) + . . . do VCOLORS^TMGTERM(1,6) ;"red on cyan +"RTN","TMGIDE2",517,0) + . . . set CsrOnBreakline=1 +"RTN","TMGIDE2",518,0) + . if (cdLoop=scOffset) write ">" +"RTN","TMGIDE2",519,0) + . else if cBrkLine write "#" +"RTN","TMGIDE2",520,0) + . else write " " +"RTN","TMGIDE2",521,0) + . if $length(cbLine)>(ScrWidth-1) write $extract(cbLine,1,ScrWidth-4),"...",! +"RTN","TMGIDE2",522,0) + . else do +"RTN","TMGIDE2",523,0) + . . write $extract(cbLine,1,ScrWidth-1) +"RTN","TMGIDE2",524,0) + . . write $extract(BlankLine,1,ScrWidth-$length(cbLine)-1),! +"RTN","TMGIDE2",525,0) + . if (cdLoop=scOffset)!(cHighCsrPos)!(cBrkLine) do +"RTN","TMGIDE2",526,0) + . . do VCOLORS^TMGTERM(14,4) ;"bright white on blue background +"RTN","TMGIDE2",527,0) + +"RTN","TMGIDE2",528,0) + for cdLoop=1:1:ScrWidth write "~" +"RTN","TMGIDE2",529,0) + write ! +"RTN","TMGIDE2",530,0) + +"RTN","TMGIDE2",531,0) +SCDone +"RTN","TMGIDE2",532,0) + do VTATRIB^TMGTERM(0) ;"reset colors +"RTN","TMGIDE2",533,0) + +"RTN","TMGIDE2",534,0) + quit +"RTN","TMGIDE2",535,0) + +"RTN","TMGIDE2",536,0) + +"RTN","TMGIDE2",537,0) +GetStackInfo(Stack,ExecPos) +"RTN","TMGIDE2",538,0) + ;"Purpose: to query GTM and get back filtered Stack information +"RTN","TMGIDE2",539,0) + ;"Input: Stack -- PASS BY REFERENCE. An array to received back info. Old info is killed +"RTN","TMGIDE2",540,0) + ;" ExecPos -- OPTIONAL. Current execution position +"RTN","TMGIDE2",541,0) + +"RTN","TMGIDE2",542,0) + set ExecPos=$get(ExecPos) +"RTN","TMGIDE2",543,0) + kill Stack +"RTN","TMGIDE2",544,0) + new i,count +"RTN","TMGIDE2",545,0) + set count=1 +"RTN","TMGIDE2",546,0) + if $STACK<3 quit ;"0-2 are steps getting into debugger +"RTN","TMGIDE2",547,0) + for i=3:1:$STACK do +"RTN","TMGIDE2",548,0) + . new s +"RTN","TMGIDE2",549,0) + . set s=$STACK(i,"PLACE") +"RTN","TMGIDE2",550,0) + . if s["TMGIDE" quit +"RTN","TMGIDE2",551,0) + . if s["GTM$DMODE" quit +"RTN","TMGIDE2",552,0) + . if s="@" set s=s_""""_$STACK(i,"MCODE")_"""" +"RTN","TMGIDE2",553,0) + . if s=ExecPos set s=s_" <--Current execution point",i=$STACK+1 +"RTN","TMGIDE2",554,0) + . set Stack(count)=$STACK(i)_" "_s +"RTN","TMGIDE2",555,0) + . set count=count+1 +"RTN","TMGIDE2",556,0) + +"RTN","TMGIDE2",557,0) + quit +"RTN","TMGIDE2",558,0) + +"RTN","TMGIDE2",559,0) + +"RTN","TMGIDE2",560,0) +ToggleBreakpoint(pos,condition) +"RTN","TMGIDE2",561,0) + ;"Purpose: to set or release the GT.M breakpoint at position +"RTN","TMGIDE2",562,0) + ;"Input: pos -- the position to alter +"RTN","TMGIDE2",563,0) + ;" condition -- OPTIONAL -- should be contain valid M code such that +"RTN","TMGIDE2",564,0) + ;" if @condition is valid. Examples: +"RTN","TMGIDE2",565,0) + ;" i=1 or $data(VAR)=0 or $$MyFunct(var)=1 +"RTN","TMGIDE2",566,0) + +"RTN","TMGIDE2",567,0) + ;"write "Is ",pos," a breakpoint? " +"RTN","TMGIDE2",568,0) + if $$IsBreakpoint(pos) do +"RTN","TMGIDE2",569,0) + . ;"write "YES",! +"RTN","TMGIDE2",570,0) + . do RelBreakpoint(pos) +"RTN","TMGIDE2",571,0) + else do +"RTN","TMGIDE2",572,0) + . ;"write "NO",! +"RTN","TMGIDE2",573,0) + . do SetBreakpoint(pos,.condition) +"RTN","TMGIDE2",574,0) + quit +"RTN","TMGIDE2",575,0) + +"RTN","TMGIDE2",576,0) +IsBreakpoint(pos) +"RTN","TMGIDE2",577,0) + ;"Purpose: to determine if position is a breakpoint pos +"RTN","TMGIDE2",578,0) + +"RTN","TMGIDE2",579,0) + ;"Note: I am concerned that pos might contain a name longer than 8 chars +"RTN","TMGIDE2",580,0) + ;" and might give a false result, or ^TMP(...) might hold a name +"RTN","TMGIDE2",581,0) + ;" longer than 8 chars. +"RTN","TMGIDE2",582,0) + ;" BUT, if I just cut name off at 8 chars, it might not work well +"RTN","TMGIDE2",583,0) + ;" with GTM v5 +"RTN","TMGIDE2",584,0) + +"RTN","TMGIDE2",585,0) + new result set result=0 +"RTN","TMGIDE2",586,0) + ;"write "looking for breakpoint at: ",pos,! +"RTN","TMGIDE2",587,0) + if $get(pos)'="" set result=$data(^TMG("TMGIDE",$J,"ZBREAK",pos)) +"RTN","TMGIDE2",588,0) + ;"if result=1 write "here is result: ",result,! +"RTN","TMGIDE2",589,0) + quit (result'=0) +"RTN","TMGIDE2",590,0) + +"RTN","TMGIDE2",591,0) + +"RTN","TMGIDE2",592,0) +ensureBreakpoints() +"RTN","TMGIDE2",593,0) + ;"Purpose: When an module is recompiled, GT.M drops the breakpoints for +"RTN","TMGIDE2",594,0) + ;" that module. However, the breakpoints are still stored for this +"RTN","TMGIDE2",595,0) + ;" debugger, meaning that the lines will still be highlighted etc, +"RTN","TMGIDE2",596,0) + ;" --but they don't work. This function will go through stored +"RTN","TMGIDE2",597,0) + ;" breakpoints and again register them with GT.M +"RTN","TMGIDE2",598,0) + +"RTN","TMGIDE2",599,0) + new pos set pos="" +"RTN","TMGIDE2",600,0) + for set pos=$order(^TMG("TMGIDE",$J,"ZBREAK",pos)) quit:(pos="") do +"RTN","TMGIDE2",601,0) + . do SetBreakpoint(pos) +"RTN","TMGIDE2",602,0) + +"RTN","TMGIDE2",603,0) + quit +"RTN","TMGIDE2",604,0) + +"RTN","TMGIDE2",605,0) + +"RTN","TMGIDE2",606,0) +SetBreakpoint(pos,condition) +"RTN","TMGIDE2",607,0) + ;"Purpose: set the GT.M breakpoint to pos position +"RTN","TMGIDE2",608,0) + ;"Input: pos -- the position to alter +"RTN","TMGIDE2",609,0) + ;" condition -- OPTIONAL -- should be contain valid M code such that +"RTN","TMGIDE2",610,0) + ;" if @condition is valid. Examples: +"RTN","TMGIDE2",611,0) + ;" i=1 or $data(VAR)=0 or $$MyFunct(var)=1 +"RTN","TMGIDE2",612,0) + +"RTN","TMGIDE2",613,0) + if $get(pos)="" do goto SBkDone +"RTN","TMGIDE2",614,0) + . write "?? no position specified ??",! +"RTN","TMGIDE2",615,0) + new brkLine +"RTN","TMGIDE2",616,0) + set brkLine=pos_":""n tmg s TMGRunMode=1 s tmg=$$STEPTRAP^TMGIDE2($ZPOS,1)""" +"RTN","TMGIDE2",617,0) + +"RTN","TMGIDE2",618,0) + set ^TMG("TMGIDE",$J,"ZBREAK",pos)="" +"RTN","TMGIDE2",619,0) + do SetBrkCond(pos,.condition) +"RTN","TMGIDE2",620,0) + do +"RTN","TMGIDE2",621,0) + . new $etrap +"RTN","TMGIDE2",622,0) + . set $etrap="K ^TMG(""TMGIDE"",$J,""ZBREAK"",pos) S $ETRAP="""",$ECODE=""""" +"RTN","TMGIDE2",623,0) + . ZBREAK @brkLine +"RTN","TMGIDE2",624,0) + ;"write "Setting breakpoint at: ",pos,! +"RTN","TMGIDE2",625,0) + +"RTN","TMGIDE2",626,0) +SBkDone +"RTN","TMGIDE2",627,0) + quit +"RTN","TMGIDE2",628,0) + +"RTN","TMGIDE2",629,0) + +"RTN","TMGIDE2",630,0) +SetBrkCond(pos,condition) +"RTN","TMGIDE2",631,0) + ;"Purpose: A standardized SET for condition. +"RTN","TMGIDE2",632,0) + if $get(condition)="" quit +"RTN","TMGIDE2",633,0) + if $get(pos)="" quit +"RTN","TMGIDE2",634,0) + if condition="@" kill ^TMG("TMGIDE",$J,"ZBREAK",pos,"IF") +"RTN","TMGIDE2",635,0) + else set ^TMG("TMGIDE",$J,"ZBREAK",pos,"IF")=condition +"RTN","TMGIDE2",636,0) + if $$IsBreakpoint(pos)=0 do SetBreakpoint(pos) +"RTN","TMGIDE2",637,0) + quit +"RTN","TMGIDE2",638,0) + +"RTN","TMGIDE2",639,0) + +"RTN","TMGIDE2",640,0) +GetBrkCond(pos) +"RTN","TMGIDE2",641,0) + ;"Purpose: A standardized GET for condition. +"RTN","TMGIDE2",642,0) + ;"Results: returns condition code, or "" +"RTN","TMGIDE2",643,0) + new result set result="" +"RTN","TMGIDE2",644,0) + set:(pos'="") result=$get(^TMG("TMGIDE",$J,"ZBREAK",pos,"IF")) +"RTN","TMGIDE2",645,0) + quit result +"RTN","TMGIDE2",646,0) + +"RTN","TMGIDE2",647,0) +RelBreakpoint(pos) +"RTN","TMGIDE2",648,0) + ;"Purpose: to release a GT.M breakpoint at position +"RTN","TMGIDE2",649,0) + +"RTN","TMGIDE2",650,0) + new brkLine +"RTN","TMGIDE2",651,0) + set brkLine=pos_":""zcontinue""" +"RTN","TMGIDE2",652,0) + kill ^TMG("TMGIDE",$J,"ZBREAK",pos) +"RTN","TMGIDE2",653,0) + ;"write "released breakpoint at: ",pos,! +"RTN","TMGIDE2",654,0) + +"RTN","TMGIDE2",655,0) + ZBREAK @brkLine +"RTN","TMGIDE2",656,0) + quit +"RTN","TMGIDE2",657,0) + +"RTN","TMGIDE2",658,0) + +"RTN","TMGIDE2",659,0) +ShouldSkip(module) +"RTN","TMGIDE2",660,0) + ;"Purpose: to see if module is in hidden list +"RTN","TMGIDE2",661,0) + new result set result=0 +"RTN","TMGIDE2",662,0) + if $get(tpHideList)="" goto SSKDone +"RTN","TMGIDE2",663,0) + +"RTN","TMGIDE2",664,0) + new mod set mod="" +"RTN","TMGIDE2",665,0) + new l set l=$length(module) +"RTN","TMGIDE2",666,0) + for set mod=$order(@tpHideList@(mod)) quit:(mod="")!(result=1) do +"RTN","TMGIDE2",667,0) + . set result=($extract(module,1,l)=mod) +"RTN","TMGIDE2",668,0) +SSKDone +"RTN","TMGIDE2",669,0) + quit result +"RTN","TMGIDE2",670,0) + +"RTN","TMGIDE2",671,0) + +"RTN","TMGIDE2",672,0) +SetupSkips +"RTN","TMGIDE2",673,0) + ;"Purpose: to manage modules that are to be skipped over. +"RTN","TMGIDE2",674,0) + ;"Input: none. But this modifies variable @tpHideList with global scope +"RTN","TMGIDE2",675,0) + ;"results: none +"RTN","TMGIDE2",676,0) + +"RTN","TMGIDE2",677,0) + new menu,option +"RTN","TMGIDE2",678,0) + set menu(0)="Pick Options for Hiding/Showing Modules" +"RTN","TMGIDE2",679,0) + set menu(1)="SHOW current hidden list"_$c(9)_"SHOW" +"RTN","TMGIDE2",680,0) + set menu(2)="ADD module to hidden list"_$c(9)_"ADD" +"RTN","TMGIDE2",681,0) + set menu(3)="REMOVE module from hidden list"_$c(9)_"REMOVE" +"RTN","TMGIDE2",682,0) + set menu(4)="Done."_$c(9)_"^" +"RTN","TMGIDE2",683,0) + +"RTN","TMGIDE2",684,0) +StSkp set option=$$Menu^TMGUSRIF(.menu) +"RTN","TMGIDE2",685,0) + if option="SHOW" do ShowSkip +"RTN","TMGIDE2",686,0) + if option="ADD" do AddSkip +"RTN","TMGIDE2",687,0) + if option="REMOVE" do RmSkip +"RTN","TMGIDE2",688,0) + if option="^" goto StSkDone +"RTN","TMGIDE2",689,0) + goto StSkp +"RTN","TMGIDE2",690,0) + +"RTN","TMGIDE2",691,0) +StSkDone +"RTN","TMGIDE2",692,0) + quit +"RTN","TMGIDE2",693,0) + +"RTN","TMGIDE2",694,0) +AddSkip +"RTN","TMGIDE2",695,0) + ;"Purpose: to allow user to Add a module to hidden list +"RTN","TMGIDE2",696,0) + ;"Input: none. But this modifies variable @tpHideList with global scope +"RTN","TMGIDE2",697,0) + ;"results: none +"RTN","TMGIDE2",698,0) + +"RTN","TMGIDE2",699,0) +ASKP1 write "Enter name of module to add to hidden list (? for help, ^ to abort)",! +"RTN","TMGIDE2",700,0) + new mod +"RTN","TMGIDE2",701,0) + read "Enter module: ",mod:$get(DTIME,3600),! +"RTN","TMGIDE2",702,0) + if mod="?" do goto ASKP1 +"RTN","TMGIDE2",703,0) + . write "Some modules of the code are not helpful to debugging one's code.",! +"RTN","TMGIDE2",704,0) + . write "For example, if one did not ever want to trace into the code stored",! +"RTN","TMGIDE2",705,0) + . write "in DIC, then DIC would be added as a module to be hidden. Then, when",! +"RTN","TMGIDE2",706,0) + . write "debugging one's own code, all traces into ^DIC would be skipped over.",! +"RTN","TMGIDE2",707,0) + . write "If only part of the name is specified, then ALL modules starting with",! +"RTN","TMGIDE2",708,0) + . write "this name will be excluded.",! +"RTN","TMGIDE2",709,0) + . do PressToCont^TMGUSERIF +"RTN","TMGIDE2",710,0) + if mod="^" goto ASDone +"RTN","TMGIDE2",711,0) + write "Add '",mod,"' as a module to be skipped over" +"RTN","TMGIDE2",712,0) + new % set %=1 +"RTN","TMGIDE2",713,0) + do YN^DICN +"RTN","TMGIDE2",714,0) + if %=1 set @tpHideList@(mod)="" +"RTN","TMGIDE2",715,0) + +"RTN","TMGIDE2",716,0) +ASDone +"RTN","TMGIDE2",717,0) + quit +"RTN","TMGIDE2",718,0) + +"RTN","TMGIDE2",719,0) +RmSkip +"RTN","TMGIDE2",720,0) + ;"Purpose: to allow user to remove a module from hidden list +"RTN","TMGIDE2",721,0) + ;"Input: none. But this modifies variable @tpHideList with global scope +"RTN","TMGIDE2",722,0) + ;"results: none +"RTN","TMGIDE2",723,0) + +"RTN","TMGIDE2",724,0) + new menu,option,idx +"RTN","TMGIDE2",725,0) +RmL1 kill menu +"RTN","TMGIDE2",726,0) + set idx=0 +"RTN","TMGIDE2",727,0) + new mod set mod="" +"RTN","TMGIDE2",728,0) + ;"Load menu with current list. +"RTN","TMGIDE2",729,0) + for set mod=$order(@tpHideList@(mod)) quit:(mod="") do +"RTN","TMGIDE2",730,0) + . set idx=idx+1,menu(idx)=mod_$c(9)_mod +"RTN","TMGIDE2",731,0) + if $data(menu)=0 goto RmSkipDone +"RTN","TMGIDE2",732,0) + . write "--The list is currently empty--" +"RTN","TMGIDE2",733,0) + . do PressToCont^TMGUSRIF +"RTN","TMGIDE2",734,0) + set idx=idx+1 +"RTN","TMGIDE2",735,0) + set menu(idx)="Done"_$c(9)_"^" +"RTN","TMGIDE2",736,0) + set menu(0)="Pick Module to remove from hidden list" +"RTN","TMGIDE2",737,0) + set option=$$Menu^TMGUSRIF(.menu) +"RTN","TMGIDE2",738,0) + if option="^" goto RmSkipDone +"RTN","TMGIDE2",739,0) + kill @tpHideList@(option) +"RTN","TMGIDE2",740,0) + goto RmL1 +"RTN","TMGIDE2",741,0) + +"RTN","TMGIDE2",742,0) +RmSkipDone +"RTN","TMGIDE2",743,0) + quit +"RTN","TMGIDE2",744,0) + +"RTN","TMGIDE2",745,0) + +"RTN","TMGIDE2",746,0) +ShowSkip +"RTN","TMGIDE2",747,0) + ;"Purpose: to show the hidden list +"RTN","TMGIDE2",748,0) + ;"Input: none. But this uses variable @tpHideList with global scope +"RTN","TMGIDE2",749,0) + ;"results: none +"RTN","TMGIDE2",750,0) + +"RTN","TMGIDE2",751,0) + new mod set mod="" +"RTN","TMGIDE2",752,0) + if $data(@tpHideList)>0 do +"RTN","TMGIDE2",753,0) + . for set mod=$order(@tpHideList@(mod)) quit:(mod="") do +"RTN","TMGIDE2",754,0) + . . write " ",mod,! +"RTN","TMGIDE2",755,0) + else do +"RTN","TMGIDE2",756,0) + . write "--The list is currently empty--" +"RTN","TMGIDE2",757,0) + do PressToCont^TMGUSRIF +"RTN","TMGIDE2",758,0) + quit +"RTN","TMGIDE3") +0^110^B2891 +"RTN","TMGIDE3",1,0) +TMGIDE3 ;TMG/kst/A debugger/tracer for GT.M (Listener code) ;04/14/08 +"RTN","TMGIDE3",2,0) + ;;1.0;TMG-LIB;**1**;04/14/08 +"RTN","TMGIDE3",3,0) + +"RTN","TMGIDE3",4,0) + ;" TMG IDE Debugger Listener +"RTN","TMGIDE3",5,0) + ;" +"RTN","TMGIDE3",6,0) + ;" K. Toppenberg +"RTN","TMGIDE3",7,0) + ;" 4-14-2008 +"RTN","TMGIDE3",8,0) + ;" License: GPL Applies +"RTN","TMGIDE3",9,0) + ;" +"RTN","TMGIDE3",10,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE3",11,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE3",12,0) + +"RTN","TMGIDE3",13,0) +Listener +"RTN","TMGIDE3",14,0) + ;"Purpose: This code will wait for messages from the executing process, and +"RTN","TMGIDE3",15,0) + ;" will display the code as it changes, and send messages back to +"RTN","TMGIDE3",16,0) + ;" all the user to control the process remotely. +"RTN","TMGIDE3",17,0) + ;" --This code will be run from the LISTENING process. +"RTN","TMGIDE3",18,0) + +"RTN","TMGIDE3",19,0) + new Msg +"RTN","TMGIDE3",20,0) + new jobNumWatching set jobNumWatching=0 +"RTN","TMGIDE3",21,0) + new UsrInput +"RTN","TMGIDE3",22,0) + new hangDelay set hangDelay=0.2 +"RTN","TMGIDE3",23,0) + +"RTN","TMGIDE3",24,0) + new BlankLine set $piece(BlankLine," ",78)=" " +"RTN","TMGIDE3",25,0) + new HxSize set HxSize=8 ;"hard codes in history length of 8 +"RTN","TMGIDE3",26,0) + new TMGdbgLine +"RTN","TMGIDE3",27,0) + new TMGlastline set TMGlastLine="" +"RTN","TMGIDE3",28,0) + new HxShowNum set HxShowNum=0 +"RTN","TMGIDE3",29,0) + new HxLine,HxLineMax,HxLineCur +"RTN","TMGIDE3",30,0) + do INITKB^XGF() ;"set up keyboard input escape code processing +"RTN","TMGIDE3",31,0) + +"RTN","TMGIDE3",32,0) + new i write # for i=1:1:12 write ! +"RTN","TMGIDE3",33,0) + write "=== TMG IDE Listener ===",!,! +"RTN","TMGIDE3",34,0) + write "Job# ",$J,": Waiting for a Sender..." +"RTN","TMGIDE3",35,0) + +"RTN","TMGIDE3",36,0) + new msgRef set msgRef=$name(^TMG("TMGIDE","LISTENER",$J)) +"RTN","TMGIDE3",37,0) +Init set @msgRef@("STATUS")="AVAIL" +"RTN","TMGIDE3",38,0) + set @msgRef@("MSG IN")="" +"RTN","TMGIDE3",39,0) + set @msgRef@("MSG OUT")="" +"RTN","TMGIDE3",40,0) +Loop +"RTN","TMGIDE3",41,0) + set Msg=$get(@msgRef@("MSG IN")) +"RTN","TMGIDE3",42,0) + +"RTN","TMGIDE3",43,0) + if Msg["INQ" do ;"Expects: 'INQ 12345' and 12345 is job number asking +"RTN","TMGIDE3",44,0) + . new fromJob set fromJob=$piece(Msg," ",2) +"RTN","TMGIDE3",45,0) + . set @msgRef@("MSG OUT")="ACK "_fromJob +"RTN","TMGIDE3",46,0) + . ;"write "Sending msg: ","ACK "_fromJob,! +"RTN","TMGIDE3",47,0) + else if Msg["LISTEN TO " do ;"Expects: 'LISTEN TO 12345' and 12345 is job number asking +"RTN","TMGIDE3",48,0) + . set jobNumWatching=+$piece(Msg," ",3) +"RTN","TMGIDE3",49,0) + . set @msgRef@("STATUS")="LISTENING TO "_jobNumWatching +"RTN","TMGIDE3",50,0) + . set @msgRef@("MSG OUT")=@msgRef@("STATUS") +"RTN","TMGIDE3",51,0) + . ;"write "Sending msg: ",@msgRef@("STATUS"),! +"RTN","TMGIDE3",52,0) + else if Msg="DONE" do goto LstnDone +"RTN","TMGIDE3",53,0) + . set @msgRef@("MSG OUT")="OK" +"RTN","TMGIDE3",54,0) + . write "DONE received. Quitting.",! +"RTN","TMGIDE3",55,0) + else if Msg["TALK" do +"RTN","TMGIDE3",56,0) + . write $piece(Msg," ",2),! +"RTN","TMGIDE3",57,0) + . set @msgRef@("MSG OUT")="OK" +"RTN","TMGIDE3",58,0) + else if Msg="DO PROMPT" do +"RTN","TMGIDE3",59,0) + . new result set result=$$Prompt() +"RTN","TMGIDE3",60,0) + . set @msgRef@("MSG OUT")=result +"RTN","TMGIDE3",61,0) + else if $piece(Msg," ",1)="READ" do +"RTN","TMGIDE3",62,0) + . new s,result +"RTN","TMGIDE3",63,0) + . set s=$piece(Msg," ",2,99) +"RTN","TMGIDE3",64,0) + . write s +"RTN","TMGIDE3",65,0) + . read result:$get(DTIME,3600),! +"RTN","TMGIDE3",66,0) + . set @msgRef@("MSG OUT")=result +"RTN","TMGIDE3",67,0) + else if $piece(Msg," ",1,2)="DO TRAP" do +"RTN","TMGIDE3",68,0) + . new idePos set idePos=$piece(Msg," ",3) +"RTN","TMGIDE3",69,0) + . new TMGMsg set TMGMsg=$piece(Msg," ",4) +"RTN","TMGIDE3",70,0) + . new TMGdbgResult +"RTN","TMGIDE3",71,0) + . set TMGdbgResult=$$STEPTRAP^TMGIDE2(idePos,TMGMsg) +"RTN","TMGIDE3",72,0) + . set @msgRef@("MSG OUT")=TMGdbgResult +"RTN","TMGIDE3",73,0) + +"RTN","TMGIDE3",74,0) + set @msgRef@("MSG IN")="" +"RTN","TMGIDE3",75,0) + +"RTN","TMGIDE3",76,0) +LUser +"RTN","TMGIDE3",77,0) + set UsrInput=$$KeyPressed^TMGUSRIF(1) ;"1=wantChar +"RTN","TMGIDE3",78,0) + if UsrInput="" hang hangDelay goto Loop +"RTN","TMGIDE3",79,0) + +"RTN","TMGIDE3",80,0) + if UsrInput="^" goto LstnDone +"RTN","TMGIDE3",81,0) + goto Loop +"RTN","TMGIDE3",82,0) + +"RTN","TMGIDE3",83,0) +LstnDone +"RTN","TMGIDE3",84,0) + kill @msgRef +"RTN","TMGIDE3",85,0) + quit +"RTN","TMGIDE3",86,0) + +"RTN","TMGIDE3",87,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE3",88,0) +SetErrTrap +"RTN","TMGIDE3",89,0) + set $ZTRAP="do ErrTrap^TMGIDE2($ZPOS) break" +"RTN","TMGIDE3",90,0) + set $ZSTATUS="" +"RTN","TMGIDE3",91,0) + quit +"RTN","TMGIDE3",92,0) + +"RTN","TMGIDE3",93,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE3",94,0) + +"RTN","TMGIDE3",95,0) +Prompt() +"RTN","TMGIDE3",96,0) + ;"Purpose: to interact with user and run through code. +"RTN","TMGIDE3",97,0) + +"RTN","TMGIDE3",98,0) + new i write # for i=1:1:12 write ! +"RTN","TMGIDE3",99,0) + write "=== TMG IDE Controller ===",!,! +"RTN","TMGIDE3",100,0) + +"RTN","TMGIDE3",101,0) +Ppt2 +"RTN","TMGIDE3",102,0) + set HxShowNum=+$get(HxShowNum) +"RTN","TMGIDE3",103,0) + set TMGStepMode="into" ;"kt added 5/3/06 +"RTN","TMGIDE3",104,0) + set HxLine=$get(^TMG("TMGIDE","CMD HISTORY",$J,HxShowNum)) +"RTN","TMGIDE3",105,0) + set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) +"RTN","TMGIDE3",106,0) + +"RTN","TMGIDE3",107,0) + write "(^ to quit) " +"RTN","TMGIDE3",108,0) + if HxShowNum=0 write "^// " +"RTN","TMGIDE3",109,0) + else write "// ",HxLine +"RTN","TMGIDE3",110,0) + +"RTN","TMGIDE3",111,0) + set TMGdbgLine=$$READ^TMGIDE() ;"$$READ^XGF ;"returns line terminator in TMGXGRT +"RTN","TMGIDE3",112,0) + if TMGdbgLine="?" do goto Ppt2 +"RTN","TMGIDE3",113,0) + . write !,"Here you should enter any valid M command, as would normally",! +"RTN","TMGIDE3",114,0) + . write "entered at a GTM> prompt.",! +"RTN","TMGIDE3",115,0) + . write " examples: WRITE ""HELLO"",! or DO ^TMGTEST",! +"RTN","TMGIDE3",116,0) + +"RTN","TMGIDE3",117,0) + if (TMGdbgLine="")&(HxShowNum>0) set TMGdbgLine=HxLine +"RTN","TMGIDE3",118,0) + ;"if (TMGdbgLine="")&(TMGXGRT="CR")&(HxShowNum>0) set TMGdbgLine=HxLine +"RTN","TMGIDE3",119,0) + +"RTN","TMGIDE3",120,0) + if (TMGXGRT="DOWN")!(TMGXGRT="RIGHT")!(TMGdbgLine="]") do goto Ppt2 +"RTN","TMGIDE3",121,0) + . set HxShowNum=HxShowNum-1 +"RTN","TMGIDE3",122,0) + . if HxShowNum<0 set HxShowNum=HxLineMax +"RTN","TMGIDE3",123,0) + . ;"write "setting HxShowNum=",HxShowNum,! +"RTN","TMGIDE3",124,0) + . do CHA^TMGTERM(1) write BlankLine do CHA^TMGTERM(1) +"RTN","TMGIDE3",125,0) + +"RTN","TMGIDE3",126,0) + if (TMGXGRT="UP")!(TMGXGRT="LEFT")!(TMGdbgLine="[") do goto Ppt2 +"RTN","TMGIDE3",127,0) + . set HxShowNum=HxShowNum+1 +"RTN","TMGIDE3",128,0) + . if HxShowNum>HxLineMax set HxShowNum=0 +"RTN","TMGIDE3",129,0) + . ;"write "setting HxShowNum=",HxShowNum,! +"RTN","TMGIDE3",130,0) + . do CHA^TMGTERM(1) write BlankLine do CHA^TMGTERM(1) +"RTN","TMGIDE3",131,0) + +"RTN","TMGIDE3",132,0) + if TMGdbgLine="" set TMGdbgLine="^" +"RTN","TMGIDE3",133,0) + ;"if TMGdbgLine="^" set $ZSTEP="" quit +"RTN","TMGIDE3",134,0) + write ! +"RTN","TMGIDE3",135,0) + +"RTN","TMGIDE3",136,0) + ;"Save Cmd history +"RTN","TMGIDE3",137,0) + set HxLineCur=$get(^TMG("TMGIDE","CMD HISTORY",$J,"CUR"),0) ;"<-- points to last used, not next avail +"RTN","TMGIDE3",138,0) + set HxLineMax=$get(^TMG("TMGIDE","CMD HISTORY",$J,"MAX"),0) ;"equals buffer size AFTER it fills +"RTN","TMGIDE3",139,0) + set HxLineCur=HxLineCur+1 +"RTN","TMGIDE3",140,0) + if HxLineCur>HxSize set HxLineCur=1 +"RTN","TMGIDE3",141,0) + set ^TMG("TMGIDE","CMD HISTORY",$J,HxLineCur)=TMGdbgLine +"RTN","TMGIDE3",142,0) + set ^TMG("TMGIDE","CMD HISTORY",$J,"CUR")=HxLineCur +"RTN","TMGIDE3",143,0) + if HxLineCur>HxLineMax do +"RTN","TMGIDE3",144,0) + . set HxLineMax=HxLineCur +"RTN","TMGIDE3",145,0) + . set ^TMG("TMGIDE","CMD HISTORY",$J,"MAX")=HxLineMax +"RTN","TMGIDE3",146,0) + ;"write "Saving line in #",HxLineCur," Max=",HxLineMax,! +"RTN","TMGIDE3",147,0) + +"RTN","TMGIDE3",148,0) + quit TMGdbgLine +"RTN","TMGIDE3",149,0) + +"RTN","TMGIDE3",150,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE3",151,0) + ;"------------------------------------------------------------------- +"RTN","TMGIDE3",152,0) + +"RTN","TMGIDE3",153,0) + +"RTN","TMGIDE3",154,0) + +"RTN","TMGIDE4") +0^111^B3347 +"RTN","TMGIDE4",1,0) +TMGIDE4 ;TMG/kst/A debugger/tracer for GT.M (Sender code) ;04/14/08 +"RTN","TMGIDE4",2,0) + ;;1.0;TMG-LIB;**1**;04/14/08 +"RTN","TMGIDE4",3,0) + +"RTN","TMGIDE4",4,0) + ;" TMG IDE Debugger Sender +"RTN","TMGIDE4",5,0) + ;" +"RTN","TMGIDE4",6,0) + ;" K. Toppenberg +"RTN","TMGIDE4",7,0) + ;" 4-14-2008 +"RTN","TMGIDE4",8,0) + ;" License: GPL Applies +"RTN","TMGIDE4",9,0) + ;" +"RTN","TMGIDE4",10,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",11,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",12,0) + +"RTN","TMGIDE4",13,0) + +"RTN","TMGIDE4",14,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",15,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",16,0) +Sender +"RTN","TMGIDE4",17,0) + ;"Purpose: This code will be run from the debugging process, that will +"RTN","TMGIDE4",18,0) + ;" be sending it's output another listening process. +"RTN","TMGIDE4",19,0) + +"RTN","TMGIDE4",20,0) + new TMGdbgListener,TMGdbgResult,TMGdbgXLine +"RTN","TMGIDE4",21,0) + set TMGdbgListener=$$GetListener() +"RTN","TMGIDE4",22,0) + write "Found Controller: Job #",TMGdbgListener,! +"RTN","TMGIDE4",23,0) + set ^TMG("TMGIDE","SENDER",$J,"CONNECTED TO")=TMGdbgListener +"RTN","TMGIDE4",24,0) + +"RTN","TMGIDE4",25,0) + set TMGdbgResult=$$MessageTo(TMGdbgListener,"Welcome to the TMG debugging environment",,1) +"RTN","TMGIDE4",26,0) + set TMGdbgResult=$$MessageTo(TMGdbgListener,"READ "_"Enter any valid M command...",9999,1) +"RTN","TMGIDE4",27,0) +SendL1 +"RTN","TMGIDE4",28,0) + write !,!,"=== TMG IDE Sender ===",!,! +"RTN","TMGIDE4",29,0) + write "Waiting for command from Controller window..." +"RTN","TMGIDE4",30,0) + set TMGdbgXLine=$$MessageTo(TMGdbgListener,"DO PROMPT",9999,0) +"RTN","TMGIDE4",31,0) + write ! +"RTN","TMGIDE4",32,0) + +"RTN","TMGIDE4",33,0) + if TMGdbgXLine="^" goto SendDone +"RTN","TMGIDE4",34,0) + +"RTN","TMGIDE4",35,0) + set TMGRunMode=1 ;"1=Step-by-step mode +"RTN","TMGIDE4",36,0) + set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGIDE4($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue" +"RTN","TMGIDE4",37,0) + +"RTN","TMGIDE4",38,0) + ;"write "About to xecute: ",TMGdbgXLine,! +"RTN","TMGIDE4",39,0) + zstep into +"RTN","TMGIDE4",40,0) + xecute TMGdbgXLine +"RTN","TMGIDE4",41,0) + set $ZSTEP="" ;"turn off step capture +"RTN","TMGIDE4",42,0) + goto SendL1 +"RTN","TMGIDE4",43,0) + +"RTN","TMGIDE4",44,0) + +"RTN","TMGIDE4",45,0) +SendDone +"RTN","TMGIDE4",46,0) + write $$MessageTo(TMGdbgListener,"DONE",,1),! +"RTN","TMGIDE4",47,0) + kill ^TMG("TMGIDE","SENDER",$J) +"RTN","TMGIDE4",48,0) + quit +"RTN","TMGIDE4",49,0) + +"RTN","TMGIDE4",50,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",51,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",52,0) +STEPTRAP(idePos,TMGMsg) +"RTN","TMGIDE4",53,0) + ;"Purpose: This is the line that is called by GT.M for each zstep event. +"RTN","TMGIDE4",54,0) + ;" It will be used to display the current code execution point, and +"RTN","TMGIDE4",55,0) + ;" query user as to plans for future execution: run/step/ etc. +"RTN","TMGIDE4",56,0) + ;"Input: idePos -- a text line containing position, as returned bye $ZPOS +"RTN","TMGIDE4",57,0) + ;" TMGMsg -- OPTIONAL -- can be used by programs to pass in info. +"RTN","TMGIDE4",58,0) + ;" If TMGMsg=1, then this function was called without the +"RTN","TMGIDE4",59,0) + ;" $ZSTEP value set, so this function should set it. +"RTN","TMGIDE4",60,0) + +"RTN","TMGIDE4",61,0) + set TMGMsg=$get(TMGMsg) +"RTN","TMGIDE4",62,0) + new TMGdbgResult +"RTN","TMGIDE4",63,0) + if +$get(TMGdbgListener)=0 do +"RTN","TMGIDE4",64,0) + . set TMGdbgListener=$get(^TMG("TMGIDE","SENDER",$J,"CONNECTED TO")) +"RTN","TMGIDE4",65,0) + set TMGdbgResult=$$MessageTo(TMGdbgListener,"DO TRAP "_idePos_" "_TMGMsg,9999,0) +"RTN","TMGIDE4",66,0) + +"RTN","TMGIDE4",67,0) + quit TMGdbgResult +"RTN","TMGIDE4",68,0) + +"RTN","TMGIDE4",69,0) + ;"------------------------------------------------------------ +"RTN","TMGIDE4",70,0) + +"RTN","TMGIDE4",71,0) +GetListener() +"RTN","TMGIDE4",72,0) + ;"Purpose: to find an available listener and connect to it. +"RTN","TMGIDE4",73,0) + ;"Note: this returns the FIRST active listener that is available. +"RTN","TMGIDE4",74,0) + ;"Result: returns $JOB of listening process, or 0 if none found. +"RTN","TMGIDE4",75,0) + +"RTN","TMGIDE4",76,0) + new jobNum,result +"RTN","TMGIDE4",77,0) + set jobNum=0,result=0 +"RTN","TMGIDE4",78,0) + for set jobNum=$order(^TMG("TMGIDE","LISTENER",jobNum)) quit:(+jobNum'>0)!(result>0) do +"RTN","TMGIDE4",79,0) + . if $get(^TMG("TMGIDE","LISTENER",jobNum,"STATUS"))="AVAIL" do +"RTN","TMGIDE4",80,0) + . . if $$ActiveListener(jobNum) do +"RTN","TMGIDE4",81,0) + . . . if $$MessageTo(jobNum,"LISTEN TO "_$J)="LISTENING TO "_$J do +"RTN","TMGIDE4",82,0) + . . . . set result=jobNum +"RTN","TMGIDE4",83,0) + . . else kill ^TMG("TMGIDE","LISTENER",jobNum) +"RTN","TMGIDE4",84,0) + quit result +"RTN","TMGIDE4",85,0) + +"RTN","TMGIDE4",86,0) + +"RTN","TMGIDE4",87,0) +ActiveListener(jobNum) +"RTN","TMGIDE4",88,0) + ;"Purpose: to determine if listener is alive and active. +"RTN","TMGIDE4",89,0) + ;"Results: 1 if listener active and alive, 0 otherwise +"RTN","TMGIDE4",90,0) + new result +"RTN","TMGIDE4",91,0) + set result=($$MessageTo(jobNum,"INQ "_$J)="ACK "_$J) +"RTN","TMGIDE4",92,0) + quit result +"RTN","TMGIDE4",93,0) + +"RTN","TMGIDE4",94,0) + +"RTN","TMGIDE4",95,0) + +"RTN","TMGIDE4",96,0) +MessageTo(jobNum,Msg,timeOutTime,ignoreReply) +"RTN","TMGIDE4",97,0) + ;"Purpose: to send message to listener, and return the reply, or time out +"RTN","TMGIDE4",98,0) + ;"Input: jobNum -- the $JOB of the listener +"RTN","TMGIDE4",99,0) + ;" Msg -- the message to send +"RTN","TMGIDE4",100,0) + ;" timeOutTime -- OPTIONAL, default is 2 seconds +"RTN","TMGIDE4",101,0) + ;" ignoreReply -- OPTIONAL, default is 0 +"RTN","TMGIDE4",102,0) + ;"Output: the returned message, or "" if timed out or no reply, or ignoreReply=1 +"RTN","TMGIDE4",103,0) + +"RTN","TMGIDE4",104,0) + ;"write !,"Sending to Listener #",jobNum,! +"RTN","TMGIDE4",105,0) + ;"write "Msg=",Msg,! +"RTN","TMGIDE4",106,0) + +"RTN","TMGIDE4",107,0) + set timeOutTime=$get(timeOutTime,2) +"RTN","TMGIDE4",108,0) + set ignoreReply=$get(ignoreReply,0) +"RTN","TMGIDE4",109,0) + new result set result="" +"RTN","TMGIDE4",110,0) + set ^TMG("TMGIDE","LISTENER",jobNum,"MSG OUT")="" ;"clear any old messge +"RTN","TMGIDE4",111,0) + set ^TMG("TMGIDE","LISTENER",jobNum,"MSG IN")=Msg +"RTN","TMGIDE4",112,0) + if (ignoreReply=0) for do quit:(result'="")!(timeOutTime<0) +"RTN","TMGIDE4",113,0) + . set result=$get(^TMG("TMGIDE","LISTENER",jobNum,"MSG OUT")) +"RTN","TMGIDE4",114,0) + . if (result'="") quit +"RTN","TMGIDE4",115,0) + . hang 0.1 +"RTN","TMGIDE4",116,0) + . set timeOutTime=timeOutTime-0.1 +"RTN","TMGIDE4",117,0) + +"RTN","TMGIDE4",118,0) + quit result +"RTN","TMGIDE4",119,0) + +"RTN","TMGINIT") +0^26^B65344038 +"RTN","TMGINIT",1,0) +TMGINIT ;TMG/kst/Custom (non-interactive) version of DINIT ;03/25/06 +"RTN","TMGINIT",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGINIT",3,0) + +"RTN","TMGINIT",4,0) + ;"DINIT(INFO) -- NON-INTERACTIVE versions of standard DINIT code. +"RTN","TMGINIT",5,0) + ;"============================================================================= +"RTN","TMGINIT",6,0) + ;"Kevin Toppenberg, MD 11-04 +"RTN","TMGINIT",7,0) + ;" +"RTN","TMGINIT",8,0) + ;"Purpose: +"RTN","TMGINIT",9,0) + ;" +"RTN","TMGINIT",10,0) + ;"This library will provide optional NON-INTERACTIVE versions of standard DINIT code. +"RTN","TMGINIT",11,0) + ;" +"RTN","TMGINIT",12,0) + ;"DINIT(INFO) +"RTN","TMGINIT",13,0) + ;" +"RTN","TMGINIT",14,0) + ;"============================================================================= +"RTN","TMGINIT",15,0) + +"RTN","TMGINIT",16,0) +DINIT(INFO) ;SFISC/GFT,XAK-INITIALIZE VA FILEMAN ;1:06 PM 30 Mar 1999 +"RTN","TMGINIT",17,0) +V ;;22.0;VA FileMan (WorldVista Modified);;Mar 30, 1999 +"RTN","TMGINIT",18,0) + ;";;22.0;VA FileMan;;Mar 30, 1999 +"RTN","TMGINIT",19,0) + ;Per VHA Directive 10-93-142, this routine should not be modified. +"RTN","TMGINIT",20,0) + ;" +"RTN","TMGINIT",21,0) + ;"K. Toppenberg's changes made November, 2004 +"RTN","TMGINIT",22,0) + ;" +"RTN","TMGINIT",23,0) + ;"Input: +"RTN","TMGINIT",24,0) + ;" Note: INFO variable is completely an OPTIONAL parameter. +"RTN","TMGINIT",25,0) + ;" If not supplied, interactive mode used +"RTN","TMGINIT",26,0) + ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed. +"RTN","TMGINIT",27,0) + ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed. +"RTN","TMGINIT",28,0) + ;" +"RTN","TMGINIT",29,0) + ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied: +"RTN","TMGINIT",30,0) + ;" ---------------------- +"RTN","TMGINIT",31,0) + ;" INFO("CONTINUE") -- Should contain the answer the user would enter for question: +"RTN","TMGINIT",32,0) + ;" "Initialize VA Fileman now?" (i.e. Y or N) +"RTN","TMGINIT",33,0) + ;" INFO("SITE NAME") -- answer for "SITE NAME?" +"RTN","TMGINIT",34,0) + ;" INFO("SITE NUMBER") -- answer for "SITE NUMBER?" +"RTN","TMGINIT",35,0) + ;" INFO("SYS TYPE") -- answer for "TYPE OF MUMPS SYSTEM YOU ARE USING" +"RTN","TMGINIT",36,0) + ;"Output: +"RTN","TMGINIT",37,0) + ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array +"RTN","TMGINIT",38,0) + ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out. +"RTN","TMGINIT",39,0) + ;" INFO("TEXT","LINES")=Number of output lines +"RTN","TMGINIT",40,0) + ;" INFO("TEXT",1)= 1st output line +"RTN","TMGINIT",41,0) + ;" INFO("TEXT",2)= 2nd output line, etc... +"RTN","TMGINIT",42,0) + ; +"RTN","TMGINIT",43,0) + ; +"RTN","TMGINIT",44,0) + +"RTN","TMGINIT",45,0) + NEW DBINDENT SET DBINDENT=0 +"RTN","TMGINIT",46,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Starting: DINIT^TMGINIT") +"RTN","TMGINIT",47,0) + +"RTN","TMGINIT",48,0) + NEW SILNTOUT SET SILNTOUT=$get(INFO("SILENT-OUTPUT"),0) ;//KT +"RTN","TMGINIT",49,0) + NEW SILENTIN SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT +"RTN","TMGINIT",50,0) + KILL INFO("TEXT") ;//kt +"RTN","TMGINIT",51,0) + +"RTN","TMGINIT",52,0) + D KL^DINIT6 +"RTN","TMGINIT",53,0) +N ; +"RTN","TMGINIT",54,0) + D VERSION +"RTN","TMGINIT",55,0) + N DIFROM S DIFROM=VERSION +"RTN","TMGINIT",56,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!",X) +"RTN","TMGINIT",57,0) + D DT^DICRW +"RTN","TMGINIT",58,0) + I $G(^DD("VERSION"))]"",^DD("VERSION")_"z"]](VERSION_"z") D +"RTN","TMGINIT",59,0) + . DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!","*** WARNING!! VA FileMan version "_^DD("VERSION")_" is currently loaded on this system.","!") +"RTN","TMGINIT",60,0) + . DO OUTP^TMGQIO(SILNTOUT,"This Initialization will bring in VA FileMan version "_VERSION_", an earlier version!!","!","!") +"RTN","TMGINIT",61,0) + S Y=$G(^DD("OS")) I Y,"1,2,3,4,5,6,10,11,12,13,15,"[(Y_",") DO G KL^DINIT6 +"RTN","TMGINIT",62,0) + . DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!","Your defined operating system entry "_$P($G(^DD("OS",Y,0)),U)_" does not support the") +"RTN","TMGINIT",63,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","1995 M Standards.","!","!") +"RTN","TMGINIT",64,0) + . DO OUTP^TMGQIO(SILNTOUT,"You may not initialize VA FileMan V21.") +"RTN","TMGINIT",65,0) +DO DO OUTP^TMGQIO(SILNTOUT,"!","!","Initialize VA FileMan now? NO//") +"RTN","TMGINIT",66,0) + DO INP^TMGQIO(.Y,SILENTIN,60,$GET(INFO("CONTINUE"))) +"RTN","TMGINIT",67,0) + GOTO:Y["^"!("Nn"[$E(Y))!('$T) KL^DINIT6 +"RTN","TMGINIT",68,0) + I "Yy"'[$E(Y) DO GOTO DO +"RTN","TMGINIT",69,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Answer YES to begin Initializing VA FileMan (^ to abort)") +"RTN","TMGINIT",70,0) + ; +"RTN","TMGINIT",71,0) + ; +"RTN","TMGINIT",72,0) +NA DO OUTP^TMGQIO(SILNTOUT,"!","!","SITE NAME: ") +"RTN","TMGINIT",73,0) + I $D(^DD("SITE")) DO OUTP^TMGQIO(SILNTOUT,^DD("SITE"),"// ") +"RTN","TMGINIT",74,0) + DO INP^TMGQIO(.X,SILENTIN,60,$GET(INFO("SITE NAME"))) +"RTN","TMGINIT",75,0) + G KL^DINIT6:X="^"!'$T +"RTN","TMGINIT",76,0) + I X="",$D(^DD("SITE"))#2 S X=^DD("SITE") +"RTN","TMGINIT",77,0) + I X'?1AN.ANP DO G NA +"RTN","TMGINIT",78,0) + . DO OUTP^TMGQIO(SILNTOUT," ENTER THE NAME OF THIS INSTALLATION SITE (^ to abort)","!","!") +"RTN","TMGINIT",79,0) + S %X=X +"RTN","TMGINIT",80,0) + ; +"RTN","TMGINIT",81,0) + ; +"RTN","TMGINIT",82,0) +NO DO OUTP^TMGQIO(SILNTOUT,"!","!","SITE NUMBER: ") +"RTN","TMGINIT",83,0) + IF $D(^DD("SITE",1)) DO OUTP^TMGQIO(SILNTOUT,^DD("SITE",1),"// ") +"RTN","TMGINIT",84,0) + DO INP^TMGQIO(.X,SILENTIN,60,$GET(INFO("SITE NUMBER"))) +"RTN","TMGINIT",85,0) + IF (X="^")!('$T) G KL^DINIT6 +"RTN","TMGINIT",86,0) + IF X="" S X=$GET(^DD("SITE",1),0) +"RTN","TMGINIT",87,0) + IF X>0 DO +"RTN","TMGINIT",88,0) + . SET ^DD("SITE")=%X,^DD("SITE",1)=X +"RTN","TMGINIT",89,0) + IF (X'>0)&(SILENTIN=1) GOTO KL^DINIT6 +"RTN","TMGINIT",90,0) + IF X'>0 DO GOTO NO +"RTN","TMGINIT",91,0) + . DO OUTP^TMGQIO(SILNTOUT," ENTER A NUMBER, CORRESPONDING TO YOUR INSTITUTION") +"RTN","TMGINIT",92,0) + ;***** REMOVE AFTER V21 INIT ***** +"RTN","TMGINIT",93,0) + ;D +"RTN","TMGINIT",94,0) + ;. N DIREC F DIREC=0:0 S DIREC=$O(^DI(.84,DIREC)) Q:'DIREC Q:DIREC>10000 K ^DI(.84,DIREC,5) +"RTN","TMGINIT",95,0) + ;. Q +"RTN","TMGINIT",96,0) + ;********************************* +"RTN","TMGINIT",97,0) + K ^DD(0) +"RTN","TMGINIT",98,0) + D ^DINIT0,^DINIT11B +"RTN","TMGINIT",99,0) + D OSETC +"RTN","TMGINIT",100,0) + DO OUTP^TMGQIO(SILNTOUT,"!") +"RTN","TMGINIT",101,0) + S Y=1 +"RTN","TMGINIT",102,0) + D OS +"RTN","TMGINIT",103,0) + G KL^DINIT6:Y<0 +"RTN","TMGINIT",104,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Now loading other FileMan files--please wait.") +"RTN","TMGINIT",105,0) + G GO +"RTN","TMGINIT",106,0) + ; +"RTN","TMGINIT",107,0) + ; +"RTN","TMGINIT",108,0) + ;"============================================================================= +"RTN","TMGINIT",109,0) +OS DO OUTP^TMGQIO(SILNTOUT,"!") +"RTN","TMGINIT",110,0) + S DIC="^DD(""OS""," +"RTN","TMGINIT",111,0) + IF (SILENTIN=0)&($DATA(INFO("SYS TYPE"))'=0) DO +"RTN","TMGINIT",112,0) + . S DIC(0)="IAQE" +"RTN","TMGINIT",113,0) + . S DIC("A")="TYPE OF MUMPS SYSTEM YOU ARE USING: " +"RTN","TMGINIT",114,0) + ELSE DO +"RTN","TMGINIT",115,0) + . SET DIC(0)="I" +"RTN","TMGINIT",116,0) + . SET X=INFO("SYS TYPE") +"RTN","TMGINIT",117,0) + I $D(^DD("OS"))#2 DO +"RTN","TMGINIT",118,0) + . S (DITZS,DIC("B"))=^("OS") +"RTN","TMGINIT",119,0) + . S:DITZS=7 (DITZS,DIC("B"))=18 +"RTN","TMGINIT",120,0) + E DO +"RTN","TMGINIT",121,0) + . S (DITZS,^DD("OS"))=100 +"RTN","TMGINIT",122,0) + D ^DIC +"RTN","TMGINIT",123,0) + K DIC +"RTN","TMGINIT",124,0) + G Q:Y<0 +"RTN","TMGINIT",125,0) + S (DITZS,^DD("OS"))=+Y +"RTN","TMGINIT",126,0) + I $D(^%ZTSK),$D(^%ZOSF("OS"))#2,$D(^("MGR"))#2 D +"RTN","TMGINIT",127,0) + . S ZTRTN="OS^%RCR" +"RTN","TMGINIT",128,0) + . S ZTUCI=^%ZOSF("MGR") +"RTN","TMGINIT",129,0) + . S ZTDTH=$H +"RTN","TMGINIT",130,0) + . S ZTIO="" +"RTN","TMGINIT",131,0) + . S ZTSAVE("DITZS")="" +"RTN","TMGINIT",132,0) + . S ZTDESC="Set Operating System" +"RTN","TMGINIT",133,0) + . D ^%ZTLOAD +"RTN","TMGINIT",134,0) + . Q +"RTN","TMGINIT",135,0) +Q K DITZS,ZTSK +"RTN","TMGINIT",136,0) + Q +"RTN","TMGINIT",137,0) + ; +"RTN","TMGINIT",138,0) + ; +"RTN","TMGINIT",139,0) + ;"============================================================================= +"RTN","TMGINIT",140,0) +VERSION ; +"RTN","TMGINIT",141,0) + S VERSION=$P($T(V),";",3),X="VA FileMan V."_VERSION +"RTN","TMGINIT",142,0) + Q +"RTN","TMGINIT",143,0) + ; +"RTN","TMGINIT",144,0) + ; +"RTN","TMGINIT",145,0) + ;"============================================================================= +"RTN","TMGINIT",146,0) +GO ; +"RTN","TMGINIT",147,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"GO^TMGINIT") +"RTN","TMGINIT",148,0) + S I=$C(126) +"RTN","TMGINIT",149,0) + S DIT=$P($H,",",2) +"RTN","TMGINIT",150,0) + S $P(^DIBT(0),U,1,2)="TEMPLATE^.4I" +"RTN","TMGINIT",151,0) + S $P(^DIE(0),U,1,2)="TEMPLATE^.4I" +"RTN","TMGINIT",152,0) + S $P(^DIPT(0),U,1,2)="TEMPLATE^.4I" +"RTN","TMGINIT",153,0) + S ^(.01,0)="CAPTIONED^" +"RTN","TMGINIT",154,0) + S ^("F",1)="S DIC=DCC,DA=D0 D EN^DIQ" +"RTN","TMGINIT",155,0) + S ^DIPT(.02,0)="FILE SECURITY CODES^^^1" +"RTN","TMGINIT",156,0) + S ^("F",1)=".01;L20"_I_"0;R13"_I_31_I_33_I_35_I_34_I_32_I_21_I_20 +"RTN","TMGINIT",157,0) + S ^DIA(0)="AUDIT^1.1I" +"RTN","TMGINIT",158,0) + K ^DD(.4),^(.41),^("^"),^(.403),^(.4031),^(.40315),^(.403115),^(.4032),^(.404),^(.40415),^(.4044),^(.404421),^(1.2) +"RTN","TMGINIT",159,0) + K ^DIC(.403),^(.404),^(1.2) +"RTN","TMGINIT",160,0) + K ^DD(.44),^(.441),^(.4411),^(.447),^(.448),^(.411),^(.42),^(.81),^DIC(.44),^(.81) +"RTN","TMGINIT",161,0) + F I=.2,.4,.401,.402,.5,.6,.83,1.1,1.11,1.12,1.13 K ^DIC(I,"%D") +"RTN","TMGINIT",162,0) + K ^DIC(.46),^DD(.46),^(.461),^(.463) +"RTN","TMGINIT",163,0) + K ^DIC(.11),^(.31) F I=.11,.111,.112,.114,.31,.312 K ^DD(I) +"RTN","TMGINIT",164,0) + F I=1.521,1.52101,1.5211,1.5212,1.5213,1.5214,1.5215,1.5216,1.5217,1.5218,1.5219,1.52191,1.52192 K ^DIC(I),^DD(I) +"RTN","TMGINIT",165,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Leaving OSETC^TMGINIT--via GOTO ^DINITOFO") +"RTN","TMGINIT",166,0) + G ^DINIT0F0 +"RTN","TMGINIT",167,0) + ; +"RTN","TMGINIT",168,0) + ;"============================================================================= +"RTN","TMGINIT",169,0) + +"RTN","TMGINIT",170,0) +OSETC ;BRING IN MUMPS OS, DIALOG & LANGUAGE DD AND DATA FOR FILEMAN +"RTN","TMGINIT",171,0) + +"RTN","TMGINIT",172,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Starting: OSETC^TMGINIT") +"RTN","TMGINIT",173,0) + +"RTN","TMGINIT",174,0) + N DN,R,D,DDF,DDT,DTO,DFR,DFN,DTN,DMRG,I,Z,D0 +"RTN","TMGINIT",175,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Now loading MUMPS Operating System File") +"RTN","TMGINIT",176,0) + D ^DINIT21 +"RTN","TMGINIT",177,0) + D OSDD^DINIT24 +"RTN","TMGINIT",178,0) + S ^DIC(.7,0)="MUMPS OPERATING SYSTEM^.7" +"RTN","TMGINIT",179,0) + S ^(0,"GL")="^DD(""OS""," +"RTN","TMGINIT",180,0) + D A^DINIT3 +"RTN","TMGINIT",181,0) + S ^DIC(.7,"%D",0)="^^5^5^2940908^" +"RTN","TMGINIT",182,0) + S ^DIC(.7,"%D",1,0)="This file stores operating system-specific code. Since the code to invoke" +"RTN","TMGINIT",183,0) + S ^DIC(.7,"%D",2,0)="some operating system utilities that FileMan uses varies among operating" +"RTN","TMGINIT",184,0) + S ^DIC(.7,"%D",3,0)="systems, code to perform these utilities is stored in and executed from" +"RTN","TMGINIT",185,0) + S ^DIC(.7,"%D",4,0)="this file. During the FileMan INIT process an operating system is" +"RTN","TMGINIT",186,0) + S ^DIC(.7,"%D",5,0)="selected so that FileMan knows which entry to use from this file." +"RTN","TMGINIT",187,0) + K ^DD("OS","B"),DA,DIK +"RTN","TMGINIT",188,0) + S DA(1)=.7 +"RTN","TMGINIT",189,0) + S DIK="^DD(.7," +"RTN","TMGINIT",190,0) + D X^DINIT3 +"RTN","TMGINIT",191,0) + K DA,DIK +"RTN","TMGINIT",192,0) + S DIK="^DD(""OS""," +"RTN","TMGINIT",193,0) + D X^DINIT3 +"RTN","TMGINIT",194,0) + D +"RTN","TMGINIT",195,0) + . N I,DA,DIK +"RTN","TMGINIT",196,0) + . F I=1,2,3,4,5,6,7,10,11,12,13,14,15 S DA=I,DIK="^DD(""OS""," D ^DIK +"RTN","TMGINIT",197,0) + . Q +"RTN","TMGINIT",198,0) + ; +"RTN","TMGINIT",199,0) + K ^UTILITY(U,$J) +"RTN","TMGINIT",200,0) + K ^UTILITY("DIK",$J) +"RTN","TMGINIT",201,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Now loading DIALOG and LANGUAGE Files") +"RTN","TMGINIT",202,0) + S DN="^DINIT" F R=1:1:39 D @(DN_$$B36(R)) W "." +"RTN","TMGINIT",203,0) + S $P(^DIC(.84,0),U,1,2)="DIALOG^.84" +"RTN","TMGINIT",204,0) + S $P(^DI(.84,0),U,1,2)="DIALOG^.84I" +"RTN","TMGINIT",205,0) + I $D(^DIC(.84,0,"GL")) D A1^DINIT3 +"RTN","TMGINIT",206,0) + S $P(^DIC(.85,0),U,1,2)="LANGUAGE^.85" +"RTN","TMGINIT",207,0) + S $P(^DI(.85,0),U,1,2)="LANGUAGE^.85I" +"RTN","TMGINIT",208,0) + I $D(^DIC(.85,0,"GL")) D A1^DINIT3 +"RTN","TMGINIT",209,0) + F I=.84,.841,.842,.844,.845,.847,.8471,.85 D XX^DINIT3 +"RTN","TMGINIT",210,0) + D DATA +"RTN","TMGINIT",211,0) + +"RTN","TMGINIT",212,0) +OSETCQ +"RTN","TMGINIT",213,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"OSETC^TMGINIT") +"RTN","TMGINIT",214,0) + Q +"RTN","TMGINIT",215,0) + ; +"RTN","TMGINIT",216,0) + ;"============================================================================= +"RTN","TMGINIT",217,0) +DATA +"RTN","TMGINIT",218,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"DATA^TMGINIT") +"RTN","TMGINIT",219,0) + +"RTN","TMGINIT",220,0) + DO OUTP^TMGQIO(SILNTOUT,".") +"RTN","TMGINIT",221,0) + S (D,DDF(1),DDT(0))=$O(^UTILITY(U,$J,0)) +"RTN","TMGINIT",222,0) + GOTO:D'>0 DATAQ +"RTN","TMGINIT",223,0) + S DTO=0,DMRG=1,DTO(0)=^(D),Z=^(D)_"0)",D0=^(D,0),@Z=D0 +"RTN","TMGINIT",224,0) + S DFR(1)="^UTILITY(U,$J,DDF(1),D0,",DKP=0 +"RTN","TMGINIT",225,0) + F D0=0:0 DO GOTO:'$D(^(D0,0)) DATAQ +"RTN","TMGINIT",226,0) + . S D0=$O(^UTILITY(U,$J,DDF(1),D0)) +"RTN","TMGINIT",227,0) + . S:D0="" D0=-1 +"RTN","TMGINIT",228,0) + . Q:'$D(^(D0,0)) +"RTN","TMGINIT",229,0) + . S Z=^(0) +"RTN","TMGINIT",230,0) + . D I^DITR +"RTN","TMGINIT",231,0) + K ^UTILITY(U,$J,DDF(1)),DDF,DDT,DTO,DFR,DFN,DTN +"RTN","TMGINIT",232,0) + G DATA +"RTN","TMGINIT",233,0) +DATAQ +"RTN","TMGINIT",234,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"DATA^TMGINIT") +"RTN","TMGINIT",235,0) + QUIT +"RTN","TMGINIT",236,0) + ; +"RTN","TMGINIT",237,0) + ;"============================================================================= +"RTN","TMGINIT",238,0) +B36(X) Q $$N1(X\(36*36)#36+1)_$$N1(X\36#36+1)_$$N1(X#36+1) +"RTN","TMGINIT",239,0) +N1(%) Q $E("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",%) +"RTN","TMGINIT",240,0) + +"RTN","TMGINIT",241,0) + ;"===================================================================================== +"RTN","TMGIOUTL") +0^27^B7057 +"RTN","TMGIOUTL",1,0) +TMGIOUTL ;TMG/kst/IO Utilities ;03/25/06 +"RTN","TMGIOUTL",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGIOUTL",3,0) + +"RTN","TMGIOUTL",4,0) + ;"TMG IO UTILITIES +"RTN","TMGIOUTL",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGIOUTL",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGIOUTL",7,0) + ;"7-12-2005 +"RTN","TMGIOUTL",8,0) + +"RTN","TMGIOUTL",9,0) + ;"======================================================================= +"RTN","TMGIOUTL",10,0) + ;" API -- Public Functions. +"RTN","TMGIOUTL",11,0) + ;"======================================================================= +"RTN","TMGIOUTL",12,0) + ;"$$FNameExtract^TMGIOUTL(FullNamePath,NodeDiv) +"RTN","TMGIOUTL",13,0) + ;"$$PathExtract^TMGIOUTL(FullNamePath,NodeDiv) +"RTN","TMGIOUTL",14,0) + ;"SplitFNamePath^TMGIOUTL(FullNamePath,OutName,OutPath,NodeDiv) +"RTN","TMGIOUTL",15,0) + ;"$$GetFName^TMGIOUTL(Msg,DefPath,DefFName,NodeDiv,OutPath,OutName) +"RTN","TMGIOUTL",16,0) + ;"$$IsDir^TMGIOUTL(Path) ;DEPRECIATED .. moved to ^TMGKERNL +"RTN","TMGIOUTL",17,0) + ;"$$Move^TMGIOUTL(Source,Dest) ;DEPRECIATED .. moved to ^TMGKERNL +"RTN","TMGIOUTL",18,0) + ;"$$FileExists^TMGIOUTL(FullNamePath) +"RTN","TMGIOUTL",19,0) + ;"$$Dos2Unix^TMGIOUTL(FullNamePath) ;DEPRECIATED .. moved to ^TMGKERNL +"RTN","TMGIOUTL",20,0) + ;"$$WP2HFS^TMGIOUTL(GlobalP,path,filename) +"RTN","TMGIOUTL",21,0) + ;"$$WP2HFSfp^TMGIOUTL(GlobalP,pathfilename) +"RTN","TMGIOUTL",22,0) + ;"$$HFS2WP^TMGIOUTL(path,filename,GlobalP) +"RTN","TMGIOUTL",23,0) + ;"$$HFS2WPfp^TMGIOUTL(pathfilename,GlobalP) +"RTN","TMGIOUTL",24,0) + ;"$$DelFile^TMGIOUTL(pathfilename) +"RTN","TMGIOUTL",25,0) + ;"$$EnsureTrailDiv^TMGIOUTL(path) +"RTN","TMGIOUTL",26,0) + +"RTN","TMGIOUTL",27,0) + ;"======================================================================= +"RTN","TMGIOUTL",28,0) + ;"Dependancies +"RTN","TMGIOUTL",29,0) + ;"TMGUSRIF for showing dialogs. +"RTN","TMGIOUTL",30,0) + ;"TMGDEBUG +"RTN","TMGIOUTL",31,0) + ;"TMGSTUTL +"RTN","TMGIOUTL",32,0) + ;"TMGMISC +"RTN","TMGIOUTL",33,0) + ;"======================================================================= +"RTN","TMGIOUTL",34,0) + +"RTN","TMGIOUTL",35,0) + ;"======================================================================= +"RTN","TMGIOUTL",36,0) + +"RTN","TMGIOUTL",37,0) +FNameExtract(FullNamePath,NodeDiv) +"RTN","TMGIOUTL",38,0) + ;"SCOPE: Public +"RTN","TMGIOUTL",39,0) + ;"Purpose: to extract a file name from a full path+name string +"RTN","TMGIOUTL",40,0) + ;"Input: FullNamePath: String to process. +"RTN","TMGIOUTL",41,0) + ;" e.g.: "/tmp/myfilename.txt" +"RTN","TMGIOUTL",42,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",43,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",44,0) + ;"Result: the filename, or "" if not found +"RTN","TMGIOUTL",45,0) + ;" e.g.: "myfilename.txt" +"RTN","TMGIOUTL",46,0) + +"RTN","TMGIOUTL",47,0) + new OutPath,OutName +"RTN","TMGIOUTL",48,0) + do SplitFNamePath(.FullNamePath,.OutPath,.OutName,.NodeDiv) +"RTN","TMGIOUTL",49,0) + quit $get(OutName) +"RTN","TMGIOUTL",50,0) + +"RTN","TMGIOUTL",51,0) + +"RTN","TMGIOUTL",52,0) +PathExtract(FullNamePath,NodeDiv) +"RTN","TMGIOUTL",53,0) + ;"SCOPE: Public +"RTN","TMGIOUTL",54,0) + ;"Purpose: to extract a file name from a full path+name string +"RTN","TMGIOUTL",55,0) + ;"Input: FullNamePath: String to process. +"RTN","TMGIOUTL",56,0) + ;" e.g.: "/usr/local/myfilename.txt" +"RTN","TMGIOUTL",57,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",58,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",59,0) + ;"Result: the path, or "" if not found +"RTN","TMGIOUTL",60,0) + ;" e.g.: "/usr/local/" +"RTN","TMGIOUTL",61,0) + +"RTN","TMGIOUTL",62,0) + new OutPath,OutName +"RTN","TMGIOUTL",63,0) + do SplitFNamePath(.FullNamePath,.OutPath,.OutName,.NodeDiv) +"RTN","TMGIOUTL",64,0) + quit $get(OutPath) +"RTN","TMGIOUTL",65,0) + +"RTN","TMGIOUTL",66,0) + +"RTN","TMGIOUTL",67,0) +SplitFNamePath(FullNamePath,OutPath,OutName,NodeDiv) +"RTN","TMGIOUTL",68,0) + ;"SCOPE: Public +"RTN","TMGIOUTL",69,0) + ;"Purpose: Take FullNamePath, and split into name and path. +"RTN","TMGIOUTL",70,0) + ;"Input: FullNamePath: String to process. +"RTN","TMGIOUTL",71,0) + ;" e.g.: "/tmp/myfilename.txt" +"RTN","TMGIOUTL",72,0) + ;" NOTICE: IF PASSED BY REFERENCE, WILL BE CHANGED TO FILENAME! +"RTN","TMGIOUTL",73,0) + ;" OutName: MUST BE PASSED BY REFERENCE. This is an OUT parameter +"RTN","TMGIOUTL",74,0) + ;" OutPath: MUST BE PASSED BY REFERENCE. This is an OUT parameter +"RTN","TMGIOUTL",75,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",76,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",77,0) + ;"Output: The resulting file name is put into OutName, +"RTN","TMGIOUTL",78,0) + ;" e.g.: "myfilename.txt" +"RTN","TMGIOUTL",79,0) + ;" and the path is put into OutPath. +"RTN","TMGIOUTL",80,0) + ;" e.g.: "/tmp/" +"RTN","TMGIOUTL",81,0) + ;"Result: None. +"RTN","TMGIOUTL",82,0) + +"RTN","TMGIOUTL",83,0) + set OutPath="" +"RTN","TMGIOUTL",84,0) + set OutName="" +"RTN","TMGIOUTL",85,0) + new PathNode +"RTN","TMGIOUTL",86,0) + set NodeDiv=$get(NodeDiv,"/") +"RTN","TMGIOUTL",87,0) + set FullNamePath=$get(FullNamePath) +"RTN","TMGIOUTL",88,0) +SPN1 +"RTN","TMGIOUTL",89,0) + if (FullNamePath[NodeDiv)=0 set OutName=FullNamePath goto SPNDone +"RTN","TMGIOUTL",90,0) + set PathNode=$piece(FullNamePath,NodeDiv,1) +"RTN","TMGIOUTL",91,0) + set OutPath=OutPath_PathNode_NodeDiv +"RTN","TMGIOUTL",92,0) + set $piece(FullNamePath,NodeDiv,1)="" +"RTN","TMGIOUTL",93,0) + set FullNamePath=$extract(FullNamePath,2,255) +"RTN","TMGIOUTL",94,0) + goto SPN1 +"RTN","TMGIOUTL",95,0) + +"RTN","TMGIOUTL",96,0) +SPNDone +"RTN","TMGIOUTL",97,0) + quit +"RTN","TMGIOUTL",98,0) + +"RTN","TMGIOUTL",99,0) + +"RTN","TMGIOUTL",100,0) +GetFName(Msg,DefPath,DefFName,NodeDiv,OutPath,OutName,Prompt) +"RTN","TMGIOUTL",101,0) + ;"SCOPE: PUBLIC +"RTN","TMGIOUTL",102,0) + ;"Purpose: To query the user, to get a filename back +"RTN","TMGIOUTL",103,0) + ;" Supplies optional directory listing. +"RTN","TMGIOUTL",104,0) + ;"Input: Msg. [OPTIONAL] A message to show user prior to name prompt. +"RTN","TMGIOUTL",105,0) + ;" May contain "\n" character for line wrapping. +"RTN","TMGIOUTL",106,0) + ;" DefPath: [OPTIONAL] The default path to offer user. +"RTN","TMGIOUTL",107,0) + ;" DefFName:[OPTIONAL] The default filename to offer user. +"RTN","TMGIOUTL",108,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",109,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",110,0) + ;" OutPath: [OPTIONAL] Pass by reference, filled with selected path +"RTN","TMGIOUTL",111,0) + ;" //no --> Note: Will return like this: '/home/test' not '/home/test/' +"RTN","TMGIOUTL",112,0) + ;" (6-5-05: I think this because $$FTG^%ZISH wants the path like this) +"RTN","TMGIOUTL",113,0) + ;" OutName: [OPTIONAL] Pass by reference, filled with selected name +"RTN","TMGIOUTL",114,0) + ;" Prompt: [OPTIONAL] Prompt for user to enter filename/directory name +"RTN","TMGIOUTL",115,0) + ;"Result: returns user specified filename (with path), or "" if aborted +"RTN","TMGIOUTL",116,0) + +"RTN","TMGIOUTL",117,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFName^TMGIOUTL") +"RTN","TMGIOUTL",118,0) + +"RTN","TMGIOUTL",119,0) + set Prompt=$get(Prompt,"Enter File Name (? for help): ") +"RTN","TMGIOUTL",120,0) + if $data(Msg) do +"RTN","TMGIOUTL",121,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling PopupBox") +"RTN","TMGIOUTL",122,0) + . do PopupBox^TMGUSRIF("Message:",.Msg) +"RTN","TMGIOUTL",123,0) + +"RTN","TMGIOUTL",124,0) + set DefFName=$get(DefFName) +"RTN","TMGIOUTL",125,0) + if $get(NodeDiv)="" kill NodeDiv +"RTN","TMGIOUTL",126,0) + set NodeDiv=$get(NodeDiv,"/") +"RTN","TMGIOUTL",127,0) + set DefPath=$get(DefPath,NodeDiv) +"RTN","TMGIOUTL",128,0) + set OutPath=$get(OutPath) +"RTN","TMGIOUTL",129,0) + set OutName=$get(OutName) +"RTN","TMGIOUTL",130,0) + new UserName +"RTN","TMGIOUTL",131,0) + new result set result="" +"RTN","TMGIOUTL",132,0) + new loop set loop=0 +"RTN","TMGIOUTL",133,0) + +"RTN","TMGIOUTL",134,0) + if $$IsDir(DefPath)=0 do +"RTN","TMGIOUTL",135,0) + . ;"write "Default directory ["_DefPath_"] doesn't exist.",! +"RTN","TMGIOUTL",136,0) + . set DefPath=NodeDiv +"RTN","TMGIOUTL",137,0) + +"RTN","TMGIOUTL",138,0) +GFN1 +"RTN","TMGIOUTL",139,0) + write Prompt ;"hello +"RTN","TMGIOUTL",140,0) + if $extract(DefPath,$length(DefPath))'=NodeDiv do +"RTN","TMGIOUTL",141,0) + . set DefPath=DefPath_NodeDiv +"RTN","TMGIOUTL",142,0) + write DefPath_DefFName,"" +"RTN","TMGIOUTL",143,0) + set UserName=$$Read^TMGUSRIF("rt",$get(DTIME,3600),,DefPath_DefFName) +"RTN","TMGIOUTL",144,0) + write ! +"RTN","TMGIOUTL",145,0) + ;"read UserName:$get(DTIME,3600),! +"RTN","TMGIOUTL",146,0) + set UserName=$$Trim^TMGSTUTL(UserName) +"RTN","TMGIOUTL",147,0) + +"RTN","TMGIOUTL",148,0) + if (UserName["..") do goto GFN1 +"RTN","TMGIOUTL",149,0) + . new temp1 +"RTN","TMGIOUTL",150,0) + . ;"anything missing on this line? Was blank... +"RTN","TMGIOUTL",151,0) + . if ($extract(DefPath,$length(DefPath))=NodeDiv)&(DefPath'="/") do +"RTN","TMGIOUTL",152,0) + . set DefPath=$extract(DefPath,1,$length(DefPath)-1) +"RTN","TMGIOUTL",153,0) + . do SplitFNamePath(DefPath,.DefPath,.temp,1) +"RTN","TMGIOUTL",154,0) + else if UserName="" do goto GFNDone +"RTN","TMGIOUTL",155,0) + . set OutPath=DefPath +"RTN","TMGIOUTL",156,0) + . set OutName=DefFName +"RTN","TMGIOUTL",157,0) + . set result=DefPath_DefFName +"RTN","TMGIOUTL",158,0) + else if ($$UP^XLFSTR(UserName)["??") do goto GFN1 +"RTN","TMGIOUTL",159,0) + . new TMGMask,UserMask +"RTN","TMGIOUTL",160,0) + . set UserMask=$piece(UserName,"?? ",2) +"RTN","TMGIOUTL",161,0) + . if UserMask="" set UserMask=$piece(UserName,"?? ",2) +"RTN","TMGIOUTL",162,0) + . if UserMask="" set UserMask="*" +"RTN","TMGIOUTL",163,0) + . set TMGMask(UserMask)="" +"RTN","TMGIOUTL",164,0) + . new TMGFiles +"RTN","TMGIOUTL",165,0) + . if $$IsDir(DefPath)=0 write "?? invalid directory",! quit +"RTN","TMGIOUTL",166,0) + . if $$LIST^%ZISH(DefPath,"TMGMask","TMGFiles")=1 do +"RTN","TMGIOUTL",167,0) + . . write "Directory Listing",! +"RTN","TMGIOUTL",168,0) + . . write "-----------------",! +"RTN","TMGIOUTL",169,0) + . . new col set col=3 +"RTN","TMGIOUTL",170,0) + . . new index set index="" +"RTN","TMGIOUTL",171,0) + . . for set index=$order(TMGFiles(index)) quit:(index)="" do +"RTN","TMGIOUTL",172,0) + . . . set col=(col+1)#4 +"RTN","TMGIOUTL",173,0) + . . . write ?(col*20)+1 +"RTN","TMGIOUTL",174,0) + . . . new testDir set testDir=$$EnsureTrailDiv(DefPath,NodeDiv) +"RTN","TMGIOUTL",175,0) + . . . set testDir=testDir_index +"RTN","TMGIOUTL",176,0) + . . . if $$IsDir(testDir) write "<",index,">" +"RTN","TMGIOUTL",177,0) + . . . else write index +"RTN","TMGIOUTL",178,0) + . . . if col=3 write ! +"RTN","TMGIOUTL",179,0) + . . write ! +"RTN","TMGIOUTL",180,0) + else if UserName["^" do goto GFNDone +"RTN","TMGIOUTL",181,0) + . set result="" +"RTN","TMGIOUTL",182,0) + . set OutPath="" +"RTN","TMGIOUTL",183,0) + . set OutName="" +"RTN","TMGIOUTL",184,0) + else if UserName["?" do goto GFN1 +"RTN","TMGIOUTL",185,0) + . write " Current directory: [",DefPath,"]",! +"RTN","TMGIOUTL",186,0) + . write " Default file name: [",DefFName,"]",! +"RTN","TMGIOUTL",187,0) + . write " Example input: ",NodeDiv,"Data",NodeDiv,"Office",NodeDiv,"myfile.txt",! +"RTN","TMGIOUTL",188,0) + . write " DELETE (with backspace) parts of path not wanted.",! +"RTN","TMGIOUTL",189,0) + . write " Enter ^ to abort",! +"RTN","TMGIOUTL",190,0) + . write " Enter ?? for directory listing (?? a* to show files starting with a)",! +"RTN","TMGIOUTL",191,0) + . write " Enter .. to move up one directory level",! +"RTN","TMGIOUTL",192,0) + . write " NOTE: If a partial name is entered then [ENTER], it will be autofinished.",! +"RTN","TMGIOUTL",193,0) + else if $extract(UserName,$length(UserName))=NodeDiv do goto GFN1 +"RTN","TMGIOUTL",194,0) + . new tempPath set tempPath=DefPath +"RTN","TMGIOUTL",195,0) + . if $extract(UserName,1,1)=NodeDiv set DefPath="" +"RTN","TMGIOUTL",196,0) + . if $$IsDir(DefPath_UserName) set DefPath=DefPath_UserName +"RTN","TMGIOUTL",197,0) + . else write "?? invalid directory",! set DefPath=tempPath +"RTN","TMGIOUTL",198,0) + else for do quit:(loop'=1) +"RTN","TMGIOUTL",199,0) + . if loop=0 do +"RTN","TMGIOUTL",200,0) + . . if $extract(UserName,1,1)=NodeDiv do SplitFNamePath(UserName,.DefPath,.UserName) +"RTN","TMGIOUTL",201,0) + . . set OutPath=DefPath +"RTN","TMGIOUTL",202,0) + . . set OutName=UserName +"RTN","TMGIOUTL",203,0) + . . set result=OutPath_OutName +"RTN","TMGIOUTL",204,0) + . else set loop=0 +"RTN","TMGIOUTL",205,0) + . if $$IsDir(result) do quit +"RTN","TMGIOUTL",206,0) + . . set DefPath=result +"RTN","TMGIOUTL",207,0) + . . set DefName="" +"RTN","TMGIOUTL",208,0) + . . set result="" +"RTN","TMGIOUTL",209,0) + . . do CUU^TMGTERM(1) ;"cursor up 1 VT100 esc sequence. +"RTN","TMGIOUTL",210,0) + . if result["*" do +"RTN","TMGIOUTL",211,0) + . . set result=$$PickOneFile(result) +"RTN","TMGIOUTL",212,0) + . if '$$FileExists(result) do +"RTN","TMGIOUTL",213,0) + . . new tempresult set tempresult=result +"RTN","TMGIOUTL",214,0) + . . set result=$$PickOneFile(result_"*") +"RTN","TMGIOUTL",215,0) + . . if result="^" set loop=0 quit +"RTN","TMGIOUTL",216,0) + . . if result'="" set loop=1 quit +"RTN","TMGIOUTL",217,0) + . . new UseAnyway +"RTN","TMGIOUTL",218,0) + . . write !,"File name """,tempresult,""" doesn't exist.",! +"RTN","TMGIOUTL",219,0) + . . read "Use name anyway? NO// ",UseAnyway:$get(DTIME,3600),! +"RTN","TMGIOUTL",220,0) + . . set UseAnyway=$$UP^XLFSTR(UseAnyway) +"RTN","TMGIOUTL",221,0) + . . if '(UseAnyway["Y") set result="" +"RTN","TMGIOUTL",222,0) + . . else set result=tempresult +"RTN","TMGIOUTL",223,0) + +"RTN","TMGIOUTL",224,0) + if result="" goto GFN1 +"RTN","TMGIOUTL",225,0) + +"RTN","TMGIOUTL",226,0) +GFNDone +"RTN","TMGIOUTL",227,0) + +"RTN","TMGIOUTL",228,0) + if (result'=UserName)&(UserName'="^") do +"RTN","TMGIOUTL",229,0) + . write "Using file: ",result,! +"RTN","TMGIOUTL",230,0) + +"RTN","TMGIOUTL",231,0) + ;"Take off any terminal '/' from path +"RTN","TMGIOUTL",232,0) + ;"if $extract(OutPath,$length(OutPath))=NodeDiv do +"RTN","TMGIOUTL",233,0) + ;". set OutPath=$extract(OutPath,1,$length(OutPath)-1) +"RTN","TMGIOUTL",234,0) + +"RTN","TMGIOUTL",235,0) + do SplitFNamePath(result,.OutPath,.OutName,NodeDiv) +"RTN","TMGIOUTL",236,0) + +"RTN","TMGIOUTL",237,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFName^TMGIOUTL") +"RTN","TMGIOUTL",238,0) + +"RTN","TMGIOUTL",239,0) + quit result +"RTN","TMGIOUTL",240,0) + +"RTN","TMGIOUTL",241,0) + +"RTN","TMGIOUTL",242,0) +GetDirName(Msg,DefPath,NodeDiv,OutPath,Prompt) +"RTN","TMGIOUTL",243,0) + +"RTN","TMGIOUTL",244,0) + ;" **** finish later -- maybe... Not currently in use. +"RTN","TMGIOUTL",245,0) + +"RTN","TMGIOUTL",246,0) + ;"SCOPE: PUBLIC +"RTN","TMGIOUTL",247,0) + ;"Purpose: To query the user, to get a directory name back +"RTN","TMGIOUTL",248,0) + ;" Supplies optional directory listing. +"RTN","TMGIOUTL",249,0) + ;"Input: Msg. [OPTIONAL] A message to show user prior to name prompt. +"RTN","TMGIOUTL",250,0) + ;" May contain "\n" character for line wrapping. +"RTN","TMGIOUTL",251,0) + ;" DefPath: [OPTIONAL] The default path to offer user. +"RTN","TMGIOUTL",252,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",253,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",254,0) + ;" OutPath: [OPTIONAL] Pass by reference, filled with selected path +"RTN","TMGIOUTL",255,0) + ;" //no --> Note: Will return like this: '/home/test' not '/home/test/' +"RTN","TMGIOUTL",256,0) + ;" (6-5-05: I think this because $$FTG^%ZISH wants the path like this) +"RTN","TMGIOUTL",257,0) + ;" Prompt: [OPTIONAL] Prompt for user to enter filename/directory name +"RTN","TMGIOUTL",258,0) + ;"Result: returns user specified filename (with path), or "" if aborted +"RTN","TMGIOUTL",259,0) + +"RTN","TMGIOUTL",260,0) + +"RTN","TMGIOUTL",261,0) + set Prompt=$get(Prompt,"Enter Directory Name (? for help): ") +"RTN","TMGIOUTL",262,0) + if $data(Msg) do PopupBox^TMGUSRIF("Message:",.Msg) +"RTN","TMGIOUTL",263,0) + +"RTN","TMGIOUTL",264,0) + set DefFName=$get(DefFName) +"RTN","TMGIOUTL",265,0) + if $get(NodeDiv)="" kill NodeDiv +"RTN","TMGIOUTL",266,0) + set NodeDiv=$get(NodeDiv,"/") +"RTN","TMGIOUTL",267,0) + set DefPath=$get(DefPath,NodeDiv) +"RTN","TMGIOUTL",268,0) + set OutPath=$get(OutPath) +"RTN","TMGIOUTL",269,0) + set OutName=$get(OutName) +"RTN","TMGIOUTL",270,0) + new UserName +"RTN","TMGIOUTL",271,0) + new result set result="" +"RTN","TMGIOUTL",272,0) + new loop set loop=0 +"RTN","TMGIOUTL",273,0) + +"RTN","TMGIOUTL",274,0) + if $$IsDir(DefPath)=0 set DefPath=NodeDiv +"RTN","TMGIOUTL",275,0) + +"RTN","TMGIOUTL",276,0) +GDN1 write Prompt ;"hi +"RTN","TMGIOUTL",277,0) + if $extract(DefPath,$length(DefPath))'=NodeDiv do +"RTN","TMGIOUTL",278,0) + . set DefPath=DefPath_NodeDiv +"RTN","TMGIOUTL",279,0) + write DefPath_DefFName,"" +"RTN","TMGIOUTL",280,0) + read UserName:$get(DTIME,3600),! +"RTN","TMGIOUTL",281,0) + set UserName=$$Trim^TMGSTUTL(UserName) +"RTN","TMGIOUTL",282,0) + +"RTN","TMGIOUTL",283,0) + if (UserName="..") do goto GDN1 +"RTN","TMGIOUTL",284,0) + . new temp1 +"RTN","TMGIOUTL",285,0) + . ;"anything missing on this line? Was blank... +"RTN","TMGIOUTL",286,0) + . if ($extract(DefPath,$length(DefPath))=NodeDiv)&(DefPath'="/") do +"RTN","TMGIOUTL",287,0) + . . set DefPath=$extract(DefPath,1,$length(DefPath)-1) +"RTN","TMGIOUTL",288,0) + . do SplitFNamePath(DefPath,.DefPath,.temp,1) +"RTN","TMGIOUTL",289,0) + else if UserName="" do goto GFN2Done +"RTN","TMGIOUTL",290,0) + . set OutPath=DefPath +"RTN","TMGIOUTL",291,0) + . set OutName=DefFName +"RTN","TMGIOUTL",292,0) + . set result=DefPath_DefFName +"RTN","TMGIOUTL",293,0) + else if ($$UP^XLFSTR(UserName)["??") do goto GDN1 +"RTN","TMGIOUTL",294,0) + . new TMGMask,UserMask +"RTN","TMGIOUTL",295,0) + . set UserMask=$piece(UserName,"?? ",2) +"RTN","TMGIOUTL",296,0) + . if UserMask="" set UserMask=$piece(UserName,"?? ",2) +"RTN","TMGIOUTL",297,0) + . if UserMask="" set UserMask="*" +"RTN","TMGIOUTL",298,0) + . set TMGMask(UserMask)="" +"RTN","TMGIOUTL",299,0) + . new TMGFiles +"RTN","TMGIOUTL",300,0) + . if $$IsDir(DefPath)=0 write "?? invalid directory",! quit +"RTN","TMGIOUTL",301,0) + . if $$LIST^%ZISH(DefPath,"TMGMask","TMGFiles")=1 do +"RTN","TMGIOUTL",302,0) + . . write "Directory Listing",! +"RTN","TMGIOUTL",303,0) + . . write "-----------------",! +"RTN","TMGIOUTL",304,0) + . . new index set index=$order(TMGFiles("")) +"RTN","TMGIOUTL",305,0) + . . for do quit:index="" +"RTN","TMGIOUTL",306,0) + . . . if index="" quit +"RTN","TMGIOUTL",307,0) + . . . write " ",index,! +"RTN","TMGIOUTL",308,0) + . . . set index=$order(TMGFiles(index)) +"RTN","TMGIOUTL",309,0) + else if UserName="^" do goto GFN2Done +"RTN","TMGIOUTL",310,0) + . set result="" +"RTN","TMGIOUTL",311,0) + . set OutPath="" +"RTN","TMGIOUTL",312,0) + . set OutName="" +"RTN","TMGIOUTL",313,0) + else if UserName["?" do goto GDN1 +"RTN","TMGIOUTL",314,0) + . write " Current directory: [",DefPath,"]",! +"RTN","TMGIOUTL",315,0) + . write " Default file name: [",DefFName,"]",! +"RTN","TMGIOUTL",316,0) + . write " Example input: ",NodeDiv,"Data",NodeDiv,"Office",NodeDiv,"myfile.txt",! +"RTN","TMGIOUTL",317,0) + . write " Enter ^ to abort",! +"RTN","TMGIOUTL",318,0) + . write " Enter ?? for directory listing (?? a* to show files starting with a)",! +"RTN","TMGIOUTL",319,0) + . write " Enter .. to move up one directory level",! +"RTN","TMGIOUTL",320,0) + else if $extract(UserName,$length(UserName))=NodeDiv do goto GDN1 +"RTN","TMGIOUTL",321,0) + . new tempPath set tempPath=DefPath +"RTN","TMGIOUTL",322,0) + . if $extract(UserName,1,1)=NodeDiv set DefPath="" +"RTN","TMGIOUTL",323,0) + . if $$IsDir(DefPath_UserName) set DefPath=DefPath_UserName +"RTN","TMGIOUTL",324,0) + . else write "?? invalid directory",! set DefPath=tempPath +"RTN","TMGIOUTL",325,0) + else for do quit:(loop'=1) +"RTN","TMGIOUTL",326,0) + . if loop=0 do +"RTN","TMGIOUTL",327,0) + . . if $extract(UserName,1,1)=NodeDiv do SplitFNamePath(UserName,.DefPath,.UserName) +"RTN","TMGIOUTL",328,0) + . . set OutPath=DefPath +"RTN","TMGIOUTL",329,0) + . . set OutName=UserName +"RTN","TMGIOUTL",330,0) + . . set result=OutPath_OutName +"RTN","TMGIOUTL",331,0) + . else set loop=0 +"RTN","TMGIOUTL",332,0) + . if $$IsDir(result) do quit +"RTN","TMGIOUTL",333,0) + . . set DefPath=result +"RTN","TMGIOUTL",334,0) + . . set DefName="" +"RTN","TMGIOUTL",335,0) + . . set result="" +"RTN","TMGIOUTL",336,0) + . . do CUU^TMGTERM(1) ;"Cursor Up 1 VT100 escape code +"RTN","TMGIOUTL",337,0) + . if result["*" do +"RTN","TMGIOUTL",338,0) + . . set result=$$PickOneFile(result) +"RTN","TMGIOUTL",339,0) + . if '$$FileExists(result) do +"RTN","TMGIOUTL",340,0) + . . new tempresult set tempresult=result +"RTN","TMGIOUTL",341,0) + . . set result=$$PickOneFile(result_"*") +"RTN","TMGIOUTL",342,0) + . . if result="^" set loop=0 quit +"RTN","TMGIOUTL",343,0) + . . if result'="" set loop=1 quit +"RTN","TMGIOUTL",344,0) + . . new UseAnyway +"RTN","TMGIOUTL",345,0) + . . write !,"File name """,tempresult,""" doesn't exist.",! +"RTN","TMGIOUTL",346,0) + . . read "Use name anyway? NO// ",UseAnyway:$get(DTIME,3600),! +"RTN","TMGIOUTL",347,0) + . . set UseAnyway=$$UP^XLFSTR(UseAnyway) +"RTN","TMGIOUTL",348,0) + . . if '(UseAnyway["Y") set result="" +"RTN","TMGIOUTL",349,0) + . . else set result=tempresult +"RTN","TMGIOUTL",350,0) + +"RTN","TMGIOUTL",351,0) + if result="" goto GDN1 +"RTN","TMGIOUTL",352,0) + +"RTN","TMGIOUTL",353,0) +GFN2Done +"RTN","TMGIOUTL",354,0) + +"RTN","TMGIOUTL",355,0) + if (result'=UserName)&(UserName'="^") do +"RTN","TMGIOUTL",356,0) + . write "Using file: ",result,! +"RTN","TMGIOUTL",357,0) + +"RTN","TMGIOUTL",358,0) + ;"Take off any terminal '/' from path +"RTN","TMGIOUTL",359,0) + ;"if $extract(OutPath,$length(OutPath))=NodeDiv do +"RTN","TMGIOUTL",360,0) + ;". set OutPath=$extract(OutPath,1,$length(OutPath)-1) +"RTN","TMGIOUTL",361,0) + +"RTN","TMGIOUTL",362,0) + do SplitFNamePath(result,.OutPath,.OutName,NodeDiv) +"RTN","TMGIOUTL",363,0) + +"RTN","TMGIOUTL",364,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFName^TMGIOUTL") +"RTN","TMGIOUTL",365,0) + +"RTN","TMGIOUTL",366,0) + quit result +"RTN","TMGIOUTL",367,0) + +"RTN","TMGIOUTL",368,0) + +"RTN","TMGIOUTL",369,0) +IsDir(Path) +"RTN","TMGIOUTL",370,0) + ;"Purpose: To determine if Path is a path to a directory (i.e. are there sub files) +"RTN","TMGIOUTL",371,0) + ;"Input: Path to test, e.g. "/home/user" or "/home/user/" +"RTN","TMGIOUTL",372,0) + ;"Result: 1 if there are files in path, 0 otherwise +"RTN","TMGIOUTL",373,0) + ;"Note: if Path is a valid path to a directory, but there are no files in directory, 0 returned. +"RTN","TMGIOUTL",374,0) + +"RTN","TMGIOUTL",375,0) + +"RTN","TMGIOUTL",376,0) + ;"Moved to ^TMGKERNL +"RTN","TMGIOUTL",377,0) + quit $$IsDir^TMGKERNL(.Path) +"RTN","TMGIOUTL",378,0) + +"RTN","TMGIOUTL",379,0) + +"RTN","TMGIOUTL",380,0) +Move(Source,Dest) +"RTN","TMGIOUTL",381,0) + ;"Purpose to provide a shell for the Linux command 'mv' +"RTN","TMGIOUTL",382,0) + ;" This can serve to move or rename a file +"RTN","TMGIOUTL",383,0) + ;"Note: a platform independant version of the this could be constructed later... +"RTN","TMGIOUTL",384,0) + ;"Result: 0 if no error; >0 if error +"RTN","TMGIOUTL",385,0) + ;"Notice!!!! The return code here is DIFFERENT from usual +"RTN","TMGIOUTL",386,0) + +"RTN","TMGIOUTL",387,0) + ;"Moved to ^TMGKERNL +"RTN","TMGIOUTL",388,0) + quit $$Move^TMGKERNL(.Source,.Dest) +"RTN","TMGIOUTL",389,0) + +"RTN","TMGIOUTL",390,0) + +"RTN","TMGIOUTL",391,0) +FileExists(FullNamePath) +"RTN","TMGIOUTL",392,0) + ;"To determine if file exists. +"RTN","TMGIOUTL",393,0) + ;"Input: FullNamePath -- the full name and path of file to test, e.g. "/tmp/myfiles/a/test.txt" +"RTN","TMGIOUTL",394,0) + ;"Results: 1 if file exists (and is unique), 0 if not +"RTN","TMGIOUTL",395,0) + ;"Note: If FullNamePath indicates a directory, then 0 is returned. +"RTN","TMGIOUTL",396,0) + ;" Note if FullNamePath contains a * pattern, that would cause multiple +"RTN","TMGIOUTL",397,0) + ;" files to be returned, then filename is not unique, and function +"RTN","TMGIOUTL",398,0) + ;" will RETURN THAT IT IS NOT A (unique) FILE +"RTN","TMGIOUTL",399,0) + +"RTN","TMGIOUTL",400,0) + new JustName,JustPath +"RTN","TMGIOUTL",401,0) + new TMGMask +"RTN","TMGIOUTL",402,0) + new TMGFiles +"RTN","TMGIOUTL",403,0) + new result set result=0 +"RTN","TMGIOUTL",404,0) + +"RTN","TMGIOUTL",405,0) + do SplitFNamePath(FullNamePath,.JustPath,.JustName) +"RTN","TMGIOUTL",406,0) + +"RTN","TMGIOUTL",407,0) + set TMGMask(JustName)="" +"RTN","TMGIOUTL",408,0) + if $$LIST^%ZISH(JustPath,"TMGMask","TMGFiles")=1 do +"RTN","TMGIOUTL",409,0) + . if $$ListCt^TMGMISC("TMGFiles")=1 do +"RTN","TMGIOUTL",410,0) + . . set result='$$IsDir(FullNamePath) +"RTN","TMGIOUTL",411,0) + +"RTN","TMGIOUTL",412,0) + quit result +"RTN","TMGIOUTL",413,0) + +"RTN","TMGIOUTL",414,0) + +"RTN","TMGIOUTL",415,0) +PickOneFile(PartNamePath) +"RTN","TMGIOUTL",416,0) + ;"To take a name like "MyFil*", and display all matches and allow user to pick one +"RTN","TMGIOUTL",417,0) + ;"Input: PartNamePath -- the partial name and path of file to test, e.g. "/tmp/myfiles/a/tes*" +"RTN","TMGIOUTL",418,0) + ;"Results: The FullNamePath of the chosen file (or "" if none, or canceled) +"RTN","TMGIOUTL",419,0) + ;" 12-14-05, if user enters "^", this is returned. +"RTN","TMGIOUTL",420,0) + +"RTN","TMGIOUTL",421,0) + new JustName,JustPath +"RTN","TMGIOUTL",422,0) + new TMGMask +"RTN","TMGIOUTL",423,0) + new TMGFiles +"RTN","TMGIOUTL",424,0) + new result set result="" +"RTN","TMGIOUTL",425,0) + +"RTN","TMGIOUTL",426,0) + do SplitFNamePath(PartNamePath,.JustPath,.JustName) +"RTN","TMGIOUTL",427,0) + +"RTN","TMGIOUTL",428,0) + set TMGMask(JustName)="" +"RTN","TMGIOUTL",429,0) + if $$LIST^%ZISH(JustPath,"TMGMask","TMGFiles")=1 do +"RTN","TMGIOUTL",430,0) + . new count set count=$$ListCt^TMGMISC("TMGFiles") +"RTN","TMGIOUTL",431,0) + . if count=1 set result=$order(TMGFiles("")) quit +"RTN","TMGIOUTL",432,0) + . write count," matches to ",PartNamePath," found. Pick one:",! +"RTN","TMGIOUTL",433,0) + . new part,fName,Num +"RTN","TMGIOUTL",434,0) + . set fName=$order(TMGFiles("")) +"RTN","TMGIOUTL",435,0) + . set Num=1 +"RTN","TMGIOUTL",436,0) + . set part=1 +"RTN","TMGIOUTL",437,0) + . if fName'="" for do quit:(fName="")!(result="^") +"RTN","TMGIOUTL",438,0) + . . write " ",Num,". ",JustPath,fName +"RTN","TMGIOUTL",439,0) + . . if $$IsDir(JustPath_fName) write "/" +"RTN","TMGIOUTL",440,0) + . . write ! +"RTN","TMGIOUTL",441,0) + . . set TMGFiles(Num)=fName +"RTN","TMGIOUTL",442,0) + . . set fName=$order(TMGFiles(fName)) +"RTN","TMGIOUTL",443,0) + . . if (part=10)!(fName="") do +"RTN","TMGIOUTL",444,0) + . . . new choice +"RTN","TMGIOUTL",445,0) + . . . set part=1 +"RTN","TMGIOUTL",446,0) + . . . write "Choose file (1-",Num,"), '^' to cancel, or [Enter] to continue: " +"RTN","TMGIOUTL",447,0) + . . . read choice:$get(DTIME,3600),!! +"RTN","TMGIOUTL",448,0) + . . . if choice="^" set fName="",result="^" quit +"RTN","TMGIOUTL",449,0) + . . . if (+choice>0)&(+choice0 if error +"RTN","TMGIOUTL",467,0) + ;"Notice!!!! The return code here is DIFFERENT from usual +"RTN","TMGIOUTL",468,0) + +"RTN","TMGIOUTL",469,0) + ;"Moved to ^TMGKERNL +"RTN","TMGIOUTL",470,0) + quit $$Dos2Unix^TMGKERNL(FullNamePath) +"RTN","TMGIOUTL",471,0) + +"RTN","TMGIOUTL",472,0) + +"RTN","TMGIOUTL",473,0) +WP2HFS(GlobalP,path,filename) +"RTN","TMGIOUTL",474,0) + ;"Purpose: To write a WP field to a Host-File-System file +"RTN","TMGIOUTL",475,0) + ;"Input: GlobalP -- The reference to the header node (e.g. ^TMG(22702,99,1) in example below) +"RTN","TMGIOUTL",476,0) + ;" path: for the output file, the path up to, but not including, the filename +"RTN","TMGIOUTL",477,0) + ;" filename -- the filename to save to in the host file system. If file already exists, it will be overwritten. +"RTN","TMGIOUTL",478,0) + ;"Note: The format of a WP field is as follows: +"RTN","TMGIOUTL",479,0) + ;" e.g. ^TMG(22702,99,1,0) = ^^4^4^3050118^ +"RTN","TMGIOUTL",480,0) + ;" ^TMG(22702,99,1,1,0) = Here is the first line of text +"RTN","TMGIOUTL",481,0) + ;" ^TMG(22702,99,1,2,0) = And here is another line +"RTN","TMGIOUTL",482,0) + ;" ^TMG(22702,99,1,3,0) = +"RTN","TMGIOUTL",483,0) + ;" ^TMG(22702,99,1,4,0) = And here is a final line +"RTN","TMGIOUTL",484,0) + ;" And the format of the 0 node is: ^^^^^^ +"RTN","TMGIOUTL",485,0) + ;"Result: 0 if failure, 1 if success +"RTN","TMGIOUTL",486,0) + ;"Assumptions: That GlobalP is a valid reference to a WP field +"RTN","TMGIOUTL",487,0) + +"RTN","TMGIOUTL",488,0) + new result set result=0 ;"default to failure +"RTN","TMGIOUTL",489,0) + +"RTN","TMGIOUTL",490,0) + if $data(GlobalP)&($data(path))&($data(filename)) do +"RTN","TMGIOUTL",491,0) + . new TMGWP +"RTN","TMGIOUTL",492,0) + . merge TMGWP=@GlobalP +"RTN","TMGIOUTL",493,0) + . set result=$$GTF^%ZISH("TMGWP(1,0)",1,path,filename) +"RTN","TMGIOUTL",494,0) + +"RTN","TMGIOUTL",495,0) + quit result +"RTN","TMGIOUTL",496,0) + +"RTN","TMGIOUTL",497,0) +WP2HFSfp(GlobalP,pathfilename) +"RTN","TMGIOUTL",498,0) + ;"Purpose: To provide an interface to WP2HFS for cases when filename is not already separated from path +"RTN","TMGIOUTL",499,0) + ;"Result: 0 if failure, 1 if success +"RTN","TMGIOUTL",500,0) + +"RTN","TMGIOUTL",501,0) + new path,filename,result +"RTN","TMGIOUTL",502,0) + +"RTN","TMGIOUTL",503,0) + do SplitFNamePath(.pathfilename,.path,.filename) +"RTN","TMGIOUTL",504,0) + set result=$$WP2HFS(.GlobalP,.path,.filename) +"RTN","TMGIOUTL",505,0) + quit result +"RTN","TMGIOUTL",506,0) + +"RTN","TMGIOUTL",507,0) + +"RTN","TMGIOUTL",508,0) +HFS2WP(path,filename,GlobalP) +"RTN","TMGIOUTL",509,0) + ;"Purpose: To read a WP field from a Host-File-System file +"RTN","TMGIOUTL",510,0) + ;"Input: path: for the output file, the path up to, but not including, the filename +"RTN","TMGIOUTL",511,0) + ;" filename -- the filename to save to in the host file system. If file already exists, it will be overwritten. +"RTN","TMGIOUTL",512,0) + ;" GlobalP -- The reference to the header node (e.g. ^TMG(22702,99,1) in example below) +"RTN","TMGIOUTL",513,0) + ;"Note: The format of a WP field is as follows: +"RTN","TMGIOUTL",514,0) + ;" e.g. ^TMG(22702,99,1,0) = ^^4^4^3050118^ +"RTN","TMGIOUTL",515,0) + ;" ^TMG(22702,99,1,1,0) = Here is the first line of text +"RTN","TMGIOUTL",516,0) + ;" ^TMG(22702,99,1,2,0) = And here is another line +"RTN","TMGIOUTL",517,0) + ;" ^TMG(22702,99,1,3,0) = +"RTN","TMGIOUTL",518,0) + ;" ^TMG(22702,99,1,4,0) = And here is a final line +"RTN","TMGIOUTL",519,0) + ;" And the format of the 0 node is: ^^^^^^ +"RTN","TMGIOUTL",520,0) + ;"Result: 0 if failure, 1 if success +"RTN","TMGIOUTL",521,0) + ;"Assumptions: That GlobalP is a valid reference to a WP field +"RTN","TMGIOUTL",522,0) + +"RTN","TMGIOUTL",523,0) + new result set result=0 ;"default to failure +"RTN","TMGIOUTL",524,0) + +"RTN","TMGIOUTL",525,0) + if $data(GlobalP)&($data(path))&($data(filename)) do +"RTN","TMGIOUTL",526,0) + . new TMGWP,WP +"RTN","TMGIOUTL",527,0) + . set result=$$FTG^%ZISH(path,filename,"TMGWP(1,0)",1) +"RTN","TMGIOUTL",528,0) + . ;"zwr TMGWP(*) +"RTN","TMGIOUTL",529,0) + . ;"new temp read "press enter to continue",temp:$get(DTIME,3600),! +"RTN","TMGIOUTL",530,0) + . if result=0 quit +"RTN","TMGIOUTL",531,0) + . ;"Scan for overflow nodes, and integrate into main body +"RTN","TMGIOUTL",532,0) + . new i set i=$order(TMGWP("")) +"RTN","TMGIOUTL",533,0) + . if i'="" for do quit:(i="") +"RTN","TMGIOUTL",534,0) + . . if $data(TMGWP(i,"OVF")) do +"RTN","TMGIOUTL",535,0) + . . . new j set j=$order(TMGWP(i,"OVF","")) +"RTN","TMGIOUTL",536,0) + . . . if j'="" for do quit:(j="") +"RTN","TMGIOUTL",537,0) + . . . . new n set n=i+(j/10) +"RTN","TMGIOUTL",538,0) + . . . . set TMGWP(n,0)=TMGWP(i,"OVF",j) +"RTN","TMGIOUTL",539,0) + . . . . set j=$order(TMGWP(i,"OVF",j)) +"RTN","TMGIOUTL",540,0) + . . . kill TMGWP(i,"OVF") +"RTN","TMGIOUTL",541,0) + . . set i=$order(TMGWP(i)) +"RTN","TMGIOUTL",542,0) + . ;"Now copy into another variable, renumbering lines (in case there were overflow lines) +"RTN","TMGIOUTL",543,0) + . set i=$order(TMGWP("")) +"RTN","TMGIOUTL",544,0) + . set j=0 +"RTN","TMGIOUTL",545,0) + . if i'="" for do quit:(i="") +"RTN","TMGIOUTL",546,0) + . . set j=j+1 +"RTN","TMGIOUTL",547,0) + . . set WP(j,0)=TMGWP(i,0) +"RTN","TMGIOUTL",548,0) + . . set i=$order(TMGWP(i)) +"RTN","TMGIOUTL",549,0) + . ;"now create a header node +"RTN","TMGIOUTL",550,0) + . do NOW^%DTC ;"returns result in X +"RTN","TMGIOUTL",551,0) + . set WP(0)="^^"_j_"^"_j_"^"_X_"^^" +"RTN","TMGIOUTL",552,0) + . ;"now put WP into global reference. +"RTN","TMGIOUTL",553,0) + . ;"zwr WP(*) +"RTN","TMGIOUTL",554,0) + . ;"new temp read "press enter to continue",temp:$get(DTIME,3600),! +"RTN","TMGIOUTL",555,0) + . kill @GlobalP +"RTN","TMGIOUTL",556,0) + . merge @GlobalP=WP +"RTN","TMGIOUTL",557,0) + +"RTN","TMGIOUTL",558,0) + quit result +"RTN","TMGIOUTL",559,0) + +"RTN","TMGIOUTL",560,0) + +"RTN","TMGIOUTL",561,0) +HFS2WPfp(pathfilename,GlobalP) +"RTN","TMGIOUTL",562,0) + ;"Purpose: To provide an interface to HFS2WP for cases when filename is not already separated from path +"RTN","TMGIOUTL",563,0) + ;"Result: 0 if failure, 1 if success +"RTN","TMGIOUTL",564,0) + +"RTN","TMGIOUTL",565,0) + new path,filename,result +"RTN","TMGIOUTL",566,0) + +"RTN","TMGIOUTL",567,0) + do SplitFNamePath(.pathfilename,.path,.filename) +"RTN","TMGIOUTL",568,0) + set result=$$HFS2WP(.path,.filename,.GlobalP) +"RTN","TMGIOUTL",569,0) + quit result +"RTN","TMGIOUTL",570,0) + +"RTN","TMGIOUTL",571,0) + +"RTN","TMGIOUTL",572,0) +DelFile(pathfilename) +"RTN","TMGIOUTL",573,0) + ;"Purpose: to delete one file on host file system +"RTN","TMGIOUTL",574,0) + ;"Results: returns 1 if success, 0 if failure +"RTN","TMGIOUTL",575,0) + ;"Note: 2/22/2006 -- if deletion is blocked by OS, then 1 may be returns but file is not deleted. +"RTN","TMGIOUTL",576,0) + +"RTN","TMGIOUTL",577,0) + new path,filename,result +"RTN","TMGIOUTL",578,0) + new TMGFile +"RTN","TMGIOUTL",579,0) + +"RTN","TMGIOUTL",580,0) + do SplitFNamePath(.pathfilename,.path,.filename) +"RTN","TMGIOUTL",581,0) + set TMGFile(filename)="" +"RTN","TMGIOUTL",582,0) + set result=$$DEL^%ZISH(path,"TMGFile") +"RTN","TMGIOUTL",583,0) + +"RTN","TMGIOUTL",584,0) + quit result +"RTN","TMGIOUTL",585,0) + +"RTN","TMGIOUTL",586,0) + +"RTN","TMGIOUTL",587,0) +EnsureTrailDiv(Path,NodeDiv) +"RTN","TMGIOUTL",588,0) + ;"Purpose: to ensure that a path ends with a node divider. +"RTN","TMGIOUTL",589,0) + ;" e.g. /var/local --> /var/local/ +"RTN","TMGIOUTL",590,0) + ;" and /var/local/ --> /var/local/ +"RTN","TMGIOUTL",591,0) + ;"Input: Path -- the path to convert +"RTN","TMGIOUTL",592,0) + ;" NodeDiv: [OPTIONAL] -- the character that separates folders (e.g. "/") +"RTN","TMGIOUTL",593,0) + ;" if not supplied, then default value is "/" +"RTN","TMGIOUTL",594,0) + +"RTN","TMGIOUTL",595,0) + set Path=$get(Path) +"RTN","TMGIOUTL",596,0) + set NodeDiv=$get(NodeDiv,"/") +"RTN","TMGIOUTL",597,0) + +"RTN","TMGIOUTL",598,0) + new result set result=Path +"RTN","TMGIOUTL",599,0) + if $extract(Path,$length(Path))'=NodeDiv do +"RTN","TMGIOUTL",600,0) + . set Path=Path_NodeDiv +"RTN","TMGIOUTL",601,0) + +"RTN","TMGIOUTL",602,0) + quit result +"RTN","TMGIOUTL",603,0) + +"RTN","TMGIOUTL",604,0) + +"RTN","TMGITR") +0^28^B9486 +"RTN","TMGITR",1,0) +TMGITR ;TMG/kst/Array and Files Iterater code ;03/25/06 +"RTN","TMGITR",2,0) + ;;1.0;TMG-LIB;**1**;08/12/06 +"RTN","TMGITR",3,0) + +"RTN","TMGITR",4,0) + ;"TMG MISCELLANEOUS FUNCTIONS +"RTN","TMGITR",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGITR",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGITR",7,0) + ;"8-12-06 +"RTN","TMGITR",8,0) + +"RTN","TMGITR",9,0) + ;"======================================================================= +"RTN","TMGITR",10,0) + ;" API -- Public Functions. +"RTN","TMGITR",11,0) + ;"======================================================================= +"RTN","TMGITR",12,0) + ;"firstIndex=$$ItrInit^TMGITR(File,.Iterater,[IENS],[direction],[PriorIndex]) -- set up an iterater for a given fileman file +"RTN","TMGITR",13,0) + ;"nextIndex=$$ItrNext^TMGITR(.Iterater,[.]CurIndex,[direction]) +"RTN","TMGITR",14,0) + +"RTN","TMGITR",15,0) + ;"firstfieldValue=$$ItrFInit^TMGITR(File,.Iterater,.Index,[Field],[IENS],[Flags]) -- set up an iterater for a given Fileman file, with FIELD return +"RTN","TMGITR",16,0) + ;"nextFieldValue=$$ItrFNext^TMGITR(.Iterater,[.]CurIndex,.CurField,[direction]) -- return next $order using iterater, returning FIELD +"RTN","TMGITR",17,0) + +"RTN","TMGITR",18,0) + ;"firstIndex=$$ItrAInit^TMGITR(pArray,.Iterater,[direction],[PriorIndex]) -- set up an iterater for a given Array +"RTN","TMGITR",19,0) + ;"nextIndex=$$ItrANext^TMGITR(.Iterater,[.]CurIndex,[direction]) -- return next $order using iterater +"RTN","TMGITR",20,0) + +"RTN","TMGITR",21,0) + ;"PrepProgress^TMGITR(.Iterater,Interval,ByCt,pIndex) +"RTN","TMGITR",22,0) + ;"ProgressDone^TMGITR(.Iterater) +"RTN","TMGITR",23,0) + +"RTN","TMGITR",24,0) + ;"======================================================================= +"RTN","TMGITR",25,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGITR",26,0) + ;"======================================================================= +"RTN","TMGITR",27,0) + ;"MakeRef(FileNum,IENS) -- make an global reference from a subfile +"RTN","TMGITR",28,0) + +"RTN","TMGITR",29,0) + ;"======================================================================= +"RTN","TMGITR",30,0) + ;"DEPENDENCIES +"RTN","TMGITR",31,0) + ;" DIQ,DILF +"RTN","TMGITR",32,0) + ;"======================================================================= +"RTN","TMGITR",33,0) + ;"======================================================================= +"RTN","TMGITR",34,0) + +"RTN","TMGITR",35,0) + ;"Note: This code has not been tested/debugged with subfiles yet. +"RTN","TMGITR",36,0) + +"RTN","TMGITR",37,0) + +"RTN","TMGITR",38,0) +ItrInit(File,Iterater,IENS,Direction) +"RTN","TMGITR",39,0) + ;"Purpose: To set up an iterater for a given fileman file +"RTN","TMGITR",40,0) + ;"Input: File -- name or number of a Fileman File +"RTN","TMGITR",41,0) + ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGITR",42,0) + ;" loaded with a reference that can be used with $order +"RTN","TMGITR",43,0) + ;" e.g. Index=$order(@Iterater@(Index)) +"RTN","TMGITR",44,0) + ;" Iterater also stores other info as an array: +"RTN","TMGITR",45,0) + ;" Iterater("FILENUM")=FileNum +"RTN","TMGITR",46,0) + ;" Iterater("IENS"=IENS used to create iterater (if supplied) +"RTN","TMGITR",47,0) + ;" Iterater("COUNT")=number of records +"RTN","TMGITR",48,0) + ;" IENS -- OPTIONAL, if File is a subfile, then must supply +"RTN","TMGITR",49,0) + ;" the IENS to specify its location, e.g. +"RTN","TMGITR",50,0) + ;" IEN,parent-IEN,grandparent-IEN, etc. +"RTN","TMGITR",51,0) + ;" Function will add terminal ',' for user if needed. +"RTN","TMGITR",52,0) + ;" Direction -- the Direction from "" to go for first record (-1 --> get last record) +"RTN","TMGITR",53,0) + ;"Results: IEN of the first record in file, or "" if error +"RTN","TMGITR",54,0) + +"RTN","TMGITR",55,0) + ;"Note: This is designed to work with Fileman files, with numeric +"RTN","TMGITR",56,0) + ;" nodes. It is designed to NOT return alpha nodes (indices) +"RTN","TMGITR",57,0) + +"RTN","TMGITR",58,0) + kill Iterater ;"Clear any prior entries +"RTN","TMGITR",59,0) + set File=$get(File) +"RTN","TMGITR",60,0) + if +File'=File set File=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGITR",61,0) + new Index set Index="" ;"default to error +"RTN","TMGITR",62,0) + set Iterater("FILENUM")=File +"RTN","TMGITR",63,0) + set Iterater("COUNT")=0 +"RTN","TMGITR",64,0) + set Iterater("MAX")=0 +"RTN","TMGITR",65,0) + if $get(IENS)'="" do +"RTN","TMGITR",66,0) + . if $extract(IENS,$length(IENS))'="," set IENS=IENS_"," +"RTN","TMGITR",67,0) + . set Iterater("IENS")=IENS +"RTN","TMGITR",68,0) + +"RTN","TMGITR",69,0) + new ParentFile set ParentFile=+$get(^DD(File,0,"UP")) +"RTN","TMGITR",70,0) + if ParentFile=0 do +"RTN","TMGITR",71,0) + . set Iterater=$get(^DIC(File,0,"GL")) +"RTN","TMGITR",72,0) + . set Iterater=$$CREF^DILF(Iterater) +"RTN","TMGITR",73,0) + else set Iterater=$$MakeRef(File,IENS) +"RTN","TMGITR",74,0) + +"RTN","TMGITR",75,0) + set Direction=$get(Direction,1) +"RTN","TMGITR",76,0) + if Iterater'="" do +"RTN","TMGITR",77,0) + . set Index=$order(@Iterater@(0),Direction) +"RTN","TMGITR",78,0) + . set Iterater("COUNT")=$piece($get(@Iterater@(0)),"^",4) +"RTN","TMGITR",79,0) + . new index set index=":" +"RTN","TMGITR",80,0) + . for set index=$order(@Iterater@(index),-1) quit:(+index>0)!(index="") +"RTN","TMGITR",81,0) + . set Iterater("MAX")=index +"RTN","TMGITR",82,0) + +"RTN","TMGITR",83,0) +IIDone +"RTN","TMGITR",84,0) + quit Index +"RTN","TMGITR",85,0) + +"RTN","TMGITR",86,0) + +"RTN","TMGITR",87,0) +ItrFInit(File,Iterater,Index,Field,IENS,Flags,Direction) +"RTN","TMGITR",88,0) + ;"Purpose: To set up an iterater for a given Fileman file, with FIELD return +"RTN","TMGITR",89,0) + ;"Input: File -- name or number of a Fileman File +"RTN","TMGITR",90,0) + ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGITR",91,0) + ;" loaded with a reference that can be used with $order +"RTN","TMGITR",92,0) + ;" e.g. Index=$order(@Iterater@(Index)) +"RTN","TMGITR",93,0) + ;" Iterater also stores other info as an array: +"RTN","TMGITR",94,0) + ;" Iterater("FILENUM")=FileNum +"RTN","TMGITR",95,0) + ;" Iterater("FIELD")=Field +"RTN","TMGITR",96,0) + ;" Iterater("FLAGS")=Flags +"RTN","TMGITR",97,0) + ;" Iterater("IENS"=IENS used to create iterater +"RTN","TMGITR",98,0) + ;" Index -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGITR",99,0) + ;" returns the first IEN in the file. +"RTN","TMGITR",100,0) + ;" Field -- optional. Field Name or Number. If supplied, +"RTN","TMGITR",101,0) + ;" value of field will be returned (rather than +"RTN","TMGITR",102,0) + ;" IENS -- optional, if File is a subfile, then must supply +"RTN","TMGITR",103,0) + ;" the IENS to specify its location, e.g. +"RTN","TMGITR",104,0) + ;" NOTE: MUST end in "," +"RTN","TMGITR",105,0) + ;" IEN,parent-IEN,grandparent-IEN, etc. +"RTN","TMGITR",106,0) + ;" Flags -- OPTIONAL -- Determines how value is returned. Same Flags as used +"RTN","TMGITR",107,0) + ;" by GET1^DIQ. "I"=Internal value returned (default is external form) +"RTN","TMGITR",108,0) + ;" Direction -- OPTIONAL -- the Direction from "" to go for first record (-1 --> get last record) +"RTN","TMGITR",109,0) + ;"Results: Value of field for IEN of the first record in file, or "" if error +"RTN","TMGITR",110,0) + new result set result="" +"RTN","TMGITR",111,0) + set IENS=$get(IENS) +"RTN","TMGITR",112,0) + set Index=$$ItrInit(.File,.Iterater,.IENS,.Direction) +"RTN","TMGITR",113,0) + set Field=$get(Field) +"RTN","TMGITR",114,0) + if +Field'=Field set Field=$$GetNumField^TMGDBAPI(.File,Field) +"RTN","TMGITR",115,0) + set Iterater("FIELD")=Field +"RTN","TMGITR",116,0) + set Iterater("FLAGS")=$get(Flags) +"RTN","TMGITR",117,0) + set IENS=Index_","_IENS +"RTN","TMGITR",118,0) + if Index'="" set result=$$GET1^DIQ(File,.IENS,.Field,.Flags) +"RTN","TMGITR",119,0) + +"RTN","TMGITR",120,0) + quit result +"RTN","TMGITR",121,0) + +"RTN","TMGITR",122,0) +ItrAInit(pArray,Iterater,Direction,PriorIndex) +"RTN","TMGITR",123,0) + ;"Purpose: To set up an iterater for a given Array +"RTN","TMGITR",124,0) + ;"Input: Array -- PASS BY NAME, the Array to be iterated. +"RTN","TMGITR",125,0) + ;" Iterater -- PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGITR",126,0) + ;" loaded with a reference that can be used with $order +"RTN","TMGITR",127,0) + ;" e.g. Index=$order(@Iterater@(Index)) +"RTN","TMGITR",128,0) + ;" Iterater also stores other info as an array: +"RTN","TMGITR",129,0) + ;" Iterater("COUNT")=number of top level nodes in the Array +"RTN","TMGITR",130,0) + ;" Direction -- OPTIONAL -- the Direction from "" (or PriorIndex) to go for first record (-1 --> get last record) +"RTN","TMGITR",131,0) + ;" PriorIndex -- OPTIONAL -- the prior index to start from. Default="" +"RTN","TMGITR",132,0) + ;"Results: first node in the Array, or "" if error +"RTN","TMGITR",133,0) + +"RTN","TMGITR",134,0) + kill Iterater ;"Clear any prior entries +"RTN","TMGITR",135,0) + set Iterater=pArray +"RTN","TMGITR",136,0) + new Index set Index="" ;"default to error +"RTN","TMGITR",137,0) + if $get(pArray)="" goto IAIDone +"RTN","TMGITR",138,0) + set Direction=$get(Direction,1) +"RTN","TMGITR",139,0) + set PriorIndex=$get(PriorIndex,"") +"RTN","TMGITR",140,0) + ;"Will count later, if needed (avoid delay otherwise) +"RTN","TMGITR",141,0) + ;"set Iterater("COUNT")=$$ListCt^TMGMISC(pArray) +"RTN","TMGITR",142,0) + set Iterater("COUNT")=0 ;"override later +"RTN","TMGITR",143,0) + set Iterater("MAX")=$order(@Iterater@(":"),-1) +"RTN","TMGITR",144,0) + set Index=$order(@Iterater@(PriorIndex),Direction) +"RTN","TMGITR",145,0) + +"RTN","TMGITR",146,0) +IAIDone +"RTN","TMGITR",147,0) + quit Index +"RTN","TMGITR",148,0) + +"RTN","TMGITR",149,0) + +"RTN","TMGITR",150,0) +MakeRef(FileNum,IENS) +"RTN","TMGITR",151,0) + ;"Purpose: to make an global reference from a subfile +"RTN","TMGITR",152,0) + ;"Input: FileNum -- must be filenumber +"RTN","TMGITR",153,0) + ;" IENS -- a standard Fileman IENS of subfile. DON'T pass by reference +"RTN","TMGITR",154,0) + ;" Array("SUBFILE","NUMBER")=file number of this sub file. +"RTN","TMGITR",155,0) + ;" Array("SUBFILE","NAME")=file name of this sub file. +"RTN","TMGITR",156,0) + ;" Array("PARENT","NUMBER")=parent file number +"RTN","TMGITR",157,0) + ;" Array("PARENT","NAME")=parent file name +"RTN","TMGITR",158,0) + ;" Array("PARENT","GL")=global reference of parent, in open format<-- only valid if parent isn't also a subfile +"RTN","TMGITR",159,0) + ;" Array("FIELD IN PARENT","NUMBER")=field number of subfile in parent +"RTN","TMGITR",160,0) + ;" Array("FIELD IN PARENT","NAME")=filed name of subfile in parent +"RTN","TMGITR",161,0) + ;" Array("FIELD IN PARENT","LOC")=node and piece where subfile is stored +"RTN","TMGITR",162,0) + ;" Array("FIELD IN PARENT","CODE")=code giving subfile's attributes. +"RTN","TMGITR",163,0) + ;"Result: returns reference +"RTN","TMGITR",164,0) + +"RTN","TMGITR",165,0) + new i +"RTN","TMGITR",166,0) + new temp,IEN,parentFile +"RTN","TMGITR",167,0) + new ref set ref="" +"RTN","TMGITR",168,0) + new Info +"RTN","TMGITR",169,0) + +"RTN","TMGITR",170,0) + for i=1:1 do quit:(FileNum=0) +"RTN","TMGITR",171,0) + . ;"new NumIENs set NumIENs=$length(IENS,",") +"RTN","TMGITR",172,0) + . ;"set IEN=$piece(IENS,",",NumIENs) +"RTN","TMGITR",173,0) + . ;"set IENS=$piece(IENS,",",1,NumIENs-1) +"RTN","TMGITR",174,0) + . set IEN=$piece(IENS,",",1) +"RTN","TMGITR",175,0) + . set IENS=$piece(IENS,",",2,999) +"RTN","TMGITR",176,0) + . if IEN'="" set temp(i+1,"IEN")=IEN +"RTN","TMGITR",177,0) + . if $$GetSubFInfo^TMGDBAPI(FileNum,.Info)=0 set FileNum=0 quit +"RTN","TMGITR",178,0) + . set FileNum=$get(Info("PARENT","NUMBER")) +"RTN","TMGITR",179,0) + . set temp(i,"LOC IN PARENT")=$get(Info("FIELD IN PARENT","LOC")) +"RTN","TMGITR",180,0) + . set temp(i+1,"REF")=$$CREF^DILF($get(Info("PARENT","GL"))) +"RTN","TMGITR",181,0) + +"RTN","TMGITR",182,0) + set i=$order(temp(""),-1) +"RTN","TMGITR",183,0) + if i'="" for do quit:(i="") +"RTN","TMGITR",184,0) + . if $get(temp(i,"REF"))'="" set ref=temp(i,"REF") +"RTN","TMGITR",185,0) + . new IEN set IEN=$get(temp(i,"IEN")) +"RTN","TMGITR",186,0) + . new LOC set LOC=$piece($get(temp(i,"LOC IN PARENT")),";",1) +"RTN","TMGITR",187,0) + . if LOC'="" set ref=$name(@ref@(LOC)) +"RTN","TMGITR",188,0) + . if IEN'="" set ref=$name(@ref@(IEN)) +"RTN","TMGITR",189,0) + . set i=$order(temp(i),-1) +"RTN","TMGITR",190,0) + +"RTN","TMGITR",191,0) + quit ref +"RTN","TMGITR",192,0) + +"RTN","TMGITR",193,0) + +"RTN","TMGITR",194,0) + +"RTN","TMGITR",195,0) +ItrFNext(Iterater,CurIndex,CurField,direction) +"RTN","TMGITR",196,0) + ;"Purpose: to return next $order using iterater, returning FIELD +"RTN","TMGITR",197,0) + ;"Input: Iterater -- PASS BY REFERENCE. an iterater reference, as created by ItrInit +"RTN","TMGITR",198,0) + ;" Iterater also stores other info as an array: +"RTN","TMGITR",199,0) + ;" Iterater("FILENUM")=FileNum +"RTN","TMGITR",200,0) + ;" Iterater("FIELD")=Field +"RTN","TMGITR",201,0) + ;" Iterater("FLAGS")=Flags +"RTN","TMGITR",202,0) + ;" Iterater("IENS"=IENS used to create iterater +"RTN","TMGITR",203,0) + ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL +"RTN","TMGITR",204,0) + ;" CurIndex -- The current value of the index +"RTN","TMGITR",205,0) + ;" IF PASSED BY REF, WILL BE CHANGED +"RTN","TMGITR",206,0) + ;" CurField -- OPTIONAL, PASS BY REFERENCE, an OUT PARAMETER -- not used to find next. +"RTN","TMGITR",207,0) + ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards +"RTN","TMGITR",208,0) + ;"Results: returns the next value by $order, or "" if none +"RTN","TMGITR",209,0) + ;"NOTE: won't currently work for subfiles--would require passing a IENS +"RTN","TMGITR",210,0) + +"RTN","TMGITR",211,0) + set CurIndex=$$ItrNext(.Iterater,.CurIndex,.direction) +"RTN","TMGITR",212,0) + new File,Field,Flags +"RTN","TMGITR",213,0) + set CurField="" +"RTN","TMGITR",214,0) + if CurIndex'="" do +"RTN","TMGITR",215,0) + . set File=$get(Iterater("FILENUM")) +"RTN","TMGITR",216,0) + . set Field=$get(Iterater("FIELD")) +"RTN","TMGITR",217,0) + . set Flags=$get(Iterater("FLAGS")) +"RTN","TMGITR",218,0) + . set CurField=$$GET1^DIQ(File,CurIndex,Field,Flags) +"RTN","TMGITR",219,0) + +"RTN","TMGITR",220,0) + quit CurField +"RTN","TMGITR",221,0) + +"RTN","TMGITR",222,0) + +"RTN","TMGITR",223,0) +ItrNext(Iterater,CurIndex,direction) +"RTN","TMGITR",224,0) + ;"Purpose: to return next $order using iterater +"RTN","TMGITR",225,0) + ;"Input: Iterater -- and iterater reference, as created by ItrInit +"RTN","TMGITR",226,0) + ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL +"RTN","TMGITR",227,0) + ;" CurIndex -- The current value of the index +"RTN","TMGITR",228,0) + ;" IF PASSED BY REF, WILL BE CHANGED +"RTN","TMGITR",229,0) + ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards +"RTN","TMGITR",230,0) + ;"Results: returns the next value by $order, or "" if none +"RTN","TMGITR",231,0) + +"RTN","TMGITR",232,0) + set CurIndex=$order(@Iterater@(CurIndex),$get(direction,1)) +"RTN","TMGITR",233,0) + +"RTN","TMGITR",234,0) + new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN")) +"RTN","TMGITR",235,0) + if ProgressFn'="" do +"RTN","TMGITR",236,0) + . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGITR",237,0) + . if CurIndex="" do ProgressDone(.Iterater) +"RTN","TMGITR",238,0) + . else do +"RTN","TMGITR",239,0) + . . set Iterater("PROGRESS FN","CURRENT")=Iterater("PROGRESS FN","CURRENT")+1 +"RTN","TMGITR",240,0) + . . xecute ProgressFn +"RTN","TMGITR",241,0) + +"RTN","TMGITR",242,0) + quit CurIndex +"RTN","TMGITR",243,0) + +"RTN","TMGITR",244,0) + +"RTN","TMGITR",245,0) +ItrANext(Iterater,CurIndex,direction) +"RTN","TMGITR",246,0) + ;"Purpose: to return next $order using iterater +"RTN","TMGITR",247,0) + ;"Input: Iterater -- and iterater reference, as created by ItrAInit +"RTN","TMGITR",248,0) + ;" Iterater("PROGRESS FN")=a PROGRESS FUNCTION <-- OPTIONAL +"RTN","TMGITR",249,0) + ;" CurIndex -- The current value of the index +"RTN","TMGITR",250,0) + ;" IF PASSED BY REF, WILL BE CHANGED +"RTN","TMGITR",251,0) + ;" direction -- OPTIONAL, 1 (default) for forward, -1 for backwards +"RTN","TMGITR",252,0) + ;"Results: returns the next value by $order, or "" if none +"RTN","TMGITR",253,0) + +"RTN","TMGITR",254,0) + quit $$ItrNext(.Iterater,.CurIndex,.direction) +"RTN","TMGITR",255,0) + +"RTN","TMGITR",256,0) + +"RTN","TMGITR",257,0) +PrepProgress(Iterater,Interval,ByCt,pIndex) +"RTN","TMGITR",258,0) + ;"Purpose: to set up code so that ItrNext can easily show a progress function +"RTN","TMGITR",259,0) + ;"Input: Iterater -- PASS BY REFERENCE. Array as set up by ItrInit +"RTN","TMGITR",260,0) + ;" Interval -- OPTIONAL, default=10 The interval between showing progress bar +"RTN","TMGITR",261,0) + ;" ByCt -- OPTIONAL, default=1, +"RTN","TMGITR",262,0) + ;" if 0: range is 0..MaxIEN, index=IEN +"RTN","TMGITR",263,0) + ;" if 1: range is 0..Number of Records, index=record counter +"RTN","TMGITR",264,0) + ;" pIndex -- if ByCt=0, REQUIRED. NAME OF 'IEN' variable +"RTN","TMGITR",265,0) + +"RTN","TMGITR",266,0) + new pCurrent,pTotal,pStartTime,PrgFn +"RTN","TMGITR",267,0) + set Interval=$get(Interval,10) +"RTN","TMGITR",268,0) + if Interval=1 set Interval=2 ;" X#1 is always 0, so would never show. +"RTN","TMGITR",269,0) + set ByCt=$get(ByCt,1) +"RTN","TMGITR",270,0) + set Iterater("PROGRESS FN","BY-CT")=ByCt +"RTN","TMGITR",271,0) + set Iterater("PROGRESS FN","CURRENT")=0 +"RTN","TMGITR",272,0) + set Iterater("PROGRESS FN","START TIME")=$H +"RTN","TMGITR",273,0) + set pStartTime=$name(Iterater("PROGRESS FN","START TIME")) +"RTN","TMGITR",274,0) + if ByCt=0 do +"RTN","TMGITR",275,0) + . set Iterater("PROGRESS FN","INDEX")=pIndex +"RTN","TMGITR",276,0) + . new pMax set pMax=$name(Iterater("MAX")) +"RTN","TMGITR",277,0) + . set PrgFn="if "_pIndex_"#"_Interval_"=1 " +"RTN","TMGITR",278,0) + . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pIndex_",""Progress"",0,"_pMax_",,"_pStartTime_")" +"RTN","TMGITR",279,0) + else do +"RTN","TMGITR",280,0) + . set pCurrent=$name(Iterater("PROGRESS FN","CURRENT")) +"RTN","TMGITR",281,0) + . if +$get(Iterater("COUNT"))=0 do +"RTN","TMGITR",282,0) + . . set Iterater("COUNT")=$$ListCt^TMGMISC(Iterater) +"RTN","TMGITR",283,0) + . set pTotal=$name(Iterater("COUNT")) +"RTN","TMGITR",284,0) + . set PrgFn="if "_pCurrent_"#"_Interval_"=1 " +"RTN","TMGITR",285,0) + . set PrgFn=PrgFn_"do ProgressBar^TMGUSRIF("_pCurrent_",""Progress"",0,"_pTotal_",,"_pStartTime_")" +"RTN","TMGITR",286,0) + +"RTN","TMGITR",287,0) + set Iterater("PROGRESS DONE FN")="do ProgressBar^TMGUSRIF(100,""Progress"",0,100)" +"RTN","TMGITR",288,0) + set Iterater("PROGRESS FN")=PrgFn +"RTN","TMGITR",289,0) + +"RTN","TMGITR",290,0) + quit +"RTN","TMGITR",291,0) + +"RTN","TMGITR",292,0) + +"RTN","TMGITR",293,0) +ProgressDone(Iterater) +"RTN","TMGITR",294,0) + ;"Purpose: to allow user to call and ensure the progress bar is at 100% after +"RTN","TMGITR",295,0) + ;" loop is done. This is needed because the Iterater code has no way of +"RTN","TMGITR",296,0) + ;" knowing what criteria will be used to determine when loop is complete. +"RTN","TMGITR",297,0) + +"RTN","TMGITR",298,0) + ;"new ProgressFn set ProgressFn=$get(Iterater("PROGRESS FN")) +"RTN","TMGITR",299,0) + new ProgressFn set ProgressFn=$get(Iterater("PROGRESS DONE FN")) +"RTN","TMGITR",300,0) + if $get(ProgressFn)'="" do +"RTN","TMGITR",301,0) + . ;"new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGITR",302,0) + . ;"new ByCt set ByCt=$get(Iterater("PROGRESS FN","BY-CT"),1) +"RTN","TMGITR",303,0) + . ;"if ByCt=0 do +"RTN","TMGITR",304,0) + . ;". new pIndex set pIndex=$get(Iterater("PROGRESS FN","INDEX")) +"RTN","TMGITR",305,0) + . ;". new max set max=1 +"RTN","TMGITR",306,0) + . ;". if pIndex'="" do +"RTN","TMGITR",307,0) + . ;". . set Iterater("MAX")=+$get(@pIndex) +"RTN","TMGITR",308,0) + . ;". . if Iterater("MAX")'>0 set Iterater("MAX")=1 +"RTN","TMGITR",309,0) + . ;"else do +"RTN","TMGITR",310,0) + . ;". set Iterater("PROGRESS FN","CURRENT")=$get(Iterater("COUNT")) +"RTN","TMGITR",311,0) + . xecute ProgressFn +"RTN","TMGITR",312,0) + write ! +"RTN","TMGITR",313,0) + quit +"RTN","TMGITR",314,0) + +"RTN","TMGITR",315,0) + ;"============================================================ +"RTN","TMGITR",316,0) + ;"============================================================ +"RTN","TMGITR",317,0) + +"RTN","TMGITR",318,0) + +"RTN","TMGITR",319,0) +Test +"RTN","TMGITR",320,0) + ;"Purpose: test functionality and usability +"RTN","TMGITR",321,0) + ;" of plain iterater functions +"RTN","TMGITR",322,0) + +"RTN","TMGITR",323,0) + new Itr,IEN +"RTN","TMGITR",324,0) + new abort set abort=0 +"RTN","TMGITR",325,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGITR",326,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGITR",327,0) + if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGITR",328,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGITR",329,0) + . ;"write IEN,! +"RTN","TMGITR",330,0) + . ;"other code here... +"RTN","TMGITR",331,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGITR",332,0) + +"RTN","TMGITR",333,0) + quit +"RTN","TMGITR",334,0) + +"RTN","TMGITR",335,0) + +"RTN","TMGITR",336,0) +Test2 +"RTN","TMGITR",337,0) + ;"Purpose: test functionality and usability +"RTN","TMGITR",338,0) + ;" of iterater functions that return a given field +"RTN","TMGITR",339,0) + +"RTN","TMGITR",340,0) + new Itr,IEN,Name +"RTN","TMGITR",341,0) + new abort set abort=0 +"RTN","TMGITR",342,0) + set Name=$$ItrFInit^TMGITR(22706.9,.Itr,.IEN,.05) +"RTN","TMGITR",343,0) + for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.Name)="@@@")!(+IEN=0))!abort +"RTN","TMGITR",344,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGITR",345,0) + . ;"write Name,! +"RTN","TMGITR",346,0) + . ;"other code here... +"RTN","TMGITR",347,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGITR",348,0) + +"RTN","TMGITR",349,0) + quit +"RTN","TMGITR",350,0) + +"RTN","TMGITR",351,0) + +"RTN","TMGITR",352,0) +Test3 +"RTN","TMGITR",353,0) + ;"Purpose: test functionality and usability +"RTN","TMGITR",354,0) + ;" of iterater functions that work on an array +"RTN","TMGITR",355,0) + +"RTN","TMGITR",356,0) + new Itr,index +"RTN","TMGITR",357,0) + new abort set abort=0 +"RTN","TMGITR",358,0) + set index=$$ItrAInit^TMGITR("^PSDRUG(""B"")",.Itr) +"RTN","TMGITR",359,0) + do PrepProgress^TMGITR(.Itr,20,1,"index") +"RTN","TMGITR",360,0) + if index'="" for do quit:($$ItrANext^TMGITR(.Itr,.index)="")!abort +"RTN","TMGITR",361,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGITR",362,0) + . ;"other code here... +"RTN","TMGITR",363,0) + . ;"write index,! +"RTN","TMGITR",364,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGITR",365,0) + +"RTN","TMGITR",366,0) + quit +"RTN","TMGITR",367,0) + +"RTN","TMGKERNL") +0^29^B5946 +"RTN","TMGKERNL",1,0) +TMGKERNL ;TMG/kst/OS Specific functions ;03/25/06 +"RTN","TMGKERNL",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGKERNL",3,0) + +"RTN","TMGKERNL",4,0) + ;"TMG KERNEL FUNCTIONS +"RTN","TMGKERNL",5,0) + ;"I.e. functions that are OS specific. +"RTN","TMGKERNL",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGKERNL",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGKERNL",8,0) + ;"7-12-2005 +"RTN","TMGKERNL",9,0) + +"RTN","TMGKERNL",10,0) + ;"======================================================================= +"RTN","TMGKERNL",11,0) + ;" API -- Public Functions. +"RTN","TMGKERNL",12,0) + ;"======================================================================= +"RTN","TMGKERNL",13,0) + ;"$$Dos2Unix(FullNamePath) +"RTN","TMGKERNL",14,0) + ;"$$IsDir(Path) +"RTN","TMGKERNL",15,0) + ;"$$Move(Source,Dest) +"RTN","TMGKERNL",16,0) + ;"$$Copy(Source,Dest) +"RTN","TMGKERNL",17,0) + ;"$$Convert^TMGKERNL(FPathName,NewType) -- convert a graphic image to new type +"RTN","TMGKERNL",18,0) + +"RTN","TMGKERNL",19,0) + ;"======================================================================= +"RTN","TMGKERNL",20,0) + ;"Dependancies +"RTN","TMGKERNL",21,0) + ;"======================================================================= +"RTN","TMGKERNL",22,0) + +"RTN","TMGKERNL",23,0) + ;"======================================================================= +"RTN","TMGKERNL",24,0) + +"RTN","TMGKERNL",25,0) +Dos2Unix(FullNamePath) +"RTN","TMGKERNL",26,0) + ;"Purpose: To execute the unix command Dos2Unix on filename path +"RTN","TMGKERNL",27,0) + ;"FullNamePath: The filename to act on. +"RTN","TMGKERNL",28,0) + ;"Result: 0 if no error; >0 if error +"RTN","TMGKERNL",29,0) + ;"Notice!!!! The return code here is DIFFERENT from usual +"RTN","TMGKERNL",30,0) + +"RTN","TMGKERNL",31,0) + new result set result=0 +"RTN","TMGKERNL",32,0) + if $get(FullNamePath)="" goto DUDone +"RTN","TMGKERNL",33,0) + new spec set spec(" ")="\ " +"RTN","TMGKERNL",34,0) + set FullNamePath=$$REPLACE^XLFSTR(FullNamePath,.spec) +"RTN","TMGKERNL",35,0) + +"RTN","TMGKERNL",36,0) + new HookCmd +"RTN","TMGKERNL",37,0) + set HookCmd="dos2unix -q "_FullNamePath +"RTN","TMGKERNL",38,0) + ;"write "Hookcmd=",HookCmd,! +"RTN","TMGKERNL",39,0) + zsystem HookCmd +"RTN","TMGKERNL",40,0) + set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) +"RTN","TMGKERNL",41,0) + +"RTN","TMGKERNL",42,0) +DUDone +"RTN","TMGKERNL",43,0) + quit result +"RTN","TMGKERNL",44,0) + +"RTN","TMGKERNL",45,0) + +"RTN","TMGKERNL",46,0) + +"RTN","TMGKERNL",47,0) +IsDir(Path) +"RTN","TMGKERNL",48,0) + ;"Purpose: To determine if Path is a path to a directory (i.e. are there sub files) +"RTN","TMGKERNL",49,0) + ;"Input: Path to test, e.g. "/home/user" or "/home/user/" +"RTN","TMGKERNL",50,0) + ;"Result: 1 if there are files in path, 0 otherwise +"RTN","TMGKERNL",51,0) + ;"Note: if Path is a valid path to a directory, but there are no files in directory, 0 returned. +"RTN","TMGKERNL",52,0) + +"RTN","TMGKERNL",53,0) + new TMGMask set TMGMask("*")="" +"RTN","TMGKERNL",54,0) + new TMGFiles +"RTN","TMGKERNL",55,0) + new result set result=0 +"RTN","TMGKERNL",56,0) + +"RTN","TMGKERNL",57,0) + new spec set spec(" ")="\ " +"RTN","TMGKERNL",58,0) + set Path=$$REPLACE^XLFSTR(Path,.spec) +"RTN","TMGKERNL",59,0) + +"RTN","TMGKERNL",60,0) + ;"Note: I can't seem to get this to work with names containing spaces. +"RTN","TMGKERNL",61,0) + if $$LIST^%ZISH(Path,"TMGMask","TMGFiles")=1 do +"RTN","TMGKERNL",62,0) + . new index set index=$order(TMGFiles("")) +"RTN","TMGKERNL",63,0) + . if index'="" set result=1 +"RTN","TMGKERNL",64,0) + +"RTN","TMGKERNL",65,0) + quit result +"RTN","TMGKERNL",66,0) + +"RTN","TMGKERNL",67,0) + +"RTN","TMGKERNL",68,0) +Move(Source,Dest) +"RTN","TMGKERNL",69,0) + ;"Purpose to provide a shell for the Linux command 'mv' +"RTN","TMGKERNL",70,0) + ;" This can serve to move or rename a file +"RTN","TMGKERNL",71,0) + ;"Note: a platform independant version of the this could be constructed later... +"RTN","TMGKERNL",72,0) + ;"Result: 0 if no error; >0 if error +"RTN","TMGKERNL",73,0) + ;"Notice!!!! The return code here is DIFFERENT from usual +"RTN","TMGKERNL",74,0) + +"RTN","TMGKERNL",75,0) + new HookCmd,result +"RTN","TMGKERNL",76,0) + new Srch +"RTN","TMGKERNL",77,0) + set Srch(" ")="\ " +"RTN","TMGKERNL",78,0) + set Source=$$REPLACE^XLFSTR(Source,.Srch) +"RTN","TMGKERNL",79,0) + set Dest=$$REPLACE^XLFSTR(Dest,.Srch) +"RTN","TMGKERNL",80,0) + set HookCmd="mv "_Source_" "_Dest +"RTN","TMGKERNL",81,0) + zsystem HookCmd +"RTN","TMGKERNL",82,0) + set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) +"RTN","TMGKERNL",83,0) + quit result +"RTN","TMGKERNL",84,0) + +"RTN","TMGKERNL",85,0) + +"RTN","TMGKERNL",86,0) +Copy(Source,Dest) +"RTN","TMGKERNL",87,0) + ;"Purpose to provide a shell for the Linux command 'cp' +"RTN","TMGKERNL",88,0) + ;" This can serve to move or rename a file +"RTN","TMGKERNL",89,0) + ;"Note: a platform independant version of the this could be constructed later... +"RTN","TMGKERNL",90,0) + ;"Result: 0 if no error; >0 if error +"RTN","TMGKERNL",91,0) + ;"Notice!!!! The return code here is DIFFERENT from usual +"RTN","TMGKERNL",92,0) + +"RTN","TMGKERNL",93,0) + new HookCmd,result +"RTN","TMGKERNL",94,0) + new Srch +"RTN","TMGKERNL",95,0) + set Srch(" ")="\ " +"RTN","TMGKERNL",96,0) + set Source=$$REPLACE^XLFSTR(Source,.Srch) +"RTN","TMGKERNL",97,0) + set Dest=$$REPLACE^XLFSTR(Dest,.Srch) +"RTN","TMGKERNL",98,0) + set HookCmd="cp "_Source_" "_Dest +"RTN","TMGKERNL",99,0) + zsystem HookCmd +"RTN","TMGKERNL",100,0) + set result=$ZSYSTEM&255 ;"get result of execution. (low byte only) +"RTN","TMGKERNL",101,0) + quit result +"RTN","TMGKERNL",102,0) + +"RTN","TMGKERNL",103,0) + +"RTN","TMGKERNL",104,0) +Convert(FPathName,NewType) +"RTN","TMGKERNL",105,0) + ;"Purpose: to convert a graphic image on the linux host to new type +"RTN","TMGKERNL",106,0) + ;" i.e. image.jpg --> image.png. This is more than a simple renaming. +"RTN","TMGKERNL",107,0) + ;"Input: FPathName -- full path, filename and extention. E.g. "\tmp\image.jpg" +"RTN","TMGKERNL",108,0) + ;" NewType -- the new image type (without '.'), +"RTN","TMGKERNL",109,0) + ;" E.g. "jpg", or "JPG", or "TIFF", or "pcd" (NOT ".jpg" etc) +"RTN","TMGKERNL",110,0) + ;"Output: New FPathName (with new extension) to new image file, or "" if problem +"RTN","TMGKERNL",111,0) + ;" +"RTN","TMGKERNL",112,0) + ;"Note: If the conversion is successful, then the original image will be deleted +"RTN","TMGKERNL",113,0) + ;"Note: This function depends on the ImageMagick graphic utility "convert" to be +"RTN","TMGKERNL",114,0) + ;" installed on the host linux system, and in the path so that it can be +"RTN","TMGKERNL",115,0) + ;" launched from any directory. +"RTN","TMGKERNL",116,0) + +"RTN","TMGKERNL",117,0) + new newFPathName set newFPathName="" +"RTN","TMGKERNL",118,0) + set NewType=$get(NewType) +"RTN","TMGKERNL",119,0) + if NewType="" goto ConvDone +"RTN","TMGKERNL",120,0) + +"RTN","TMGKERNL",121,0) + new FName,FPath,FileSpec +"RTN","TMGKERNL",122,0) + do SplitFNamePath^TMGIOUTL(FPathName,.FPath,.FName,"/") +"RTN","TMGKERNL",123,0) + set FileSpec(FName)="" +"RTN","TMGKERNL",124,0) + +"RTN","TMGKERNL",125,0) + set newFPathName=$piece(FPathName,".",1)_"."_NewType +"RTN","TMGKERNL",126,0) + +"RTN","TMGKERNL",127,0) + ;"Setup and launch linux command to execute convert +"RTN","TMGKERNL",128,0) + new CmdStr +"RTN","TMGKERNL",129,0) + set CmdStr="convert "_FPathName_" "_newFPathName +"RTN","TMGKERNL",130,0) + do +"RTN","TMGKERNL",131,0) + . ;"new $ETRAP,$ZTRAP +"RTN","TMGKERNL",132,0) + . ;"set $ETRAP="S $ECODE=""""" +"RTN","TMGKERNL",133,0) + . zsystem CmdStr ;"Launch command +"RTN","TMGKERNL",134,0) + +"RTN","TMGKERNL",135,0) + ;"get result of execution. (low byte only) -- if wanted +"RTN","TMGKERNL",136,0) + new CmdResult set CmdResult=$ZSYSTEM&255 +"RTN","TMGKERNL",137,0) + if CmdResult'=0 do goto ConvDone +"RTN","TMGKERNL",138,0) + . set newFPathName="" +"RTN","TMGKERNL",139,0) + +"RTN","TMGKERNL",140,0) + ;"Delete old image file +"RTN","TMGKERNL",141,0) + ;"**** temp!!!!! REMOVE COMMENTS LATER +"RTN","TMGKERNL",142,0) + ;"new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") +"RTN","TMGKERNL",143,0) + +"RTN","TMGKERNL",144,0) +ConvDone +"RTN","TMGKERNL",145,0) + quit newFPathName +"RTN","TMGKERNL",146,0) + +"RTN","TMGKERNL",147,0) + +"RTN","TMGKERNL",148,0) + +"RTN","TMGKERNL",149,0) + +"RTN","TMGKERNL",150,0) + +"RTN","TMGKIDS") +0^112^B2764 +"RTN","TMGKIDS",1,0) +TMGKIDS ;TMG/kst/Code used for pre and post routines for KIDS build ;04/16/08 +"RTN","TMGKIDS",2,0) + ;;1.0;TMG-LIB;**1**;04/16/08 +"RTN","TMGKIDS",3,0) + +"RTN","TMGKIDS",4,0) +POSTINST +"RTN","TMGKIDS",5,0) + ;"Purpose: To provide a function that KIDS can call after installing patch. +"RTN","TMGKIDS",6,0) + ;"This particular function will add custom RPC entries to the RPC field in +"RTN","TMGKIDS",7,0) + ;"the OPTION field in OR CPRS GUI CHART. +"RTN","TMGKIDS",8,0) + +"RTN","TMGKIDS",9,0) +D1 ;"Below is a data list, not simple comments +"RTN","TMGKIDS",10,0) + ;;TMG ADD PATIENT +"RTN","TMGKIDS",11,0) + ;;TMG AUTOSIGN TIU DOCUMENT +"RTN","TMGKIDS",12,0) + ;;TMG BARCODE DECODE +"RTN","TMGKIDS",13,0) + ;;TMG BARCODE ENCODE +"RTN","TMGKIDS",14,0) + ;;TMG DOWNLOAD FILE +"RTN","TMGKIDS",15,0) + ;;TMG DOWNLOAD FILE DROPBOX +"RTN","TMGKIDS",16,0) + ;;TMG GET BLANK TIU DOCUMENT +"RTN","TMGKIDS",17,0) + ;;TMG GET DFN +"RTN","TMGKIDS",18,0) + ;;TMG GET IMAGE LONG DESCRIPTION +"RTN","TMGKIDS",19,0) + ;;TMG GET PATIENT DEMOGRAPHICS +"RTN","TMGKIDS",20,0) + ;;TMG SET PATIENT DEMOGRAPHICS +"RTN","TMGKIDS",21,0) + ;;TMG UPLOAD FILE +"RTN","TMGKIDS",22,0) + ;;TMG UPLOAD FILE DROPBOX +"RTN","TMGKIDS",23,0) + ;;TMG CPRS GET URL LIST +"RTN","TMGKIDS",24,0) + ;;--END OF LIST-- +"RTN","TMGKIDS",25,0) + +"RTN","TMGKIDS",26,0) + new ienORCPRS,DIC,X,Y +"RTN","TMGKIDS",27,0) + ;"set ienORCPRS= ... find in OPTION file. +"RTN","TMGKIDS",28,0) + set DIC=19 ;"OPTION file +"RTN","TMGKIDS",29,0) + set X="OR CPRS GUI CHART" +"RTN","TMGKIDS",30,0) + do ^DIC +"RTN","TMGKIDS",31,0) + set ienORCPRS=+$piece(Y,"^",1) +"RTN","TMGKIDS",32,0) + if ienORCPRS'>0 do goto PostDone +"RTN","TMGKIDS",33,0) + . write !,!,"Sorry, unable to locate OR CPRS GUI CHART in OPTION file.",! +"RTN","TMGKIDS",34,0) + . write "Unable to add TMG's RPC's to allowed list of RPC's for CPRS.",! +"RTN","TMGKIDS",35,0) + +"RTN","TMGKIDS",36,0) + new i,rpcName +"RTN","TMGKIDS",37,0) + for i=1:1 do quit:(rpcName="") +"RTN","TMGKIDS",38,0) + . set rpcName=$text(D1+i^TMGKIDS) +"RTN","TMGKIDS",39,0) + . set rpcName=$piece(rpcName,";;",2) +"RTN","TMGKIDS",40,0) + . if rpcName="--END OF LIST--" set rpcName="" +"RTN","TMGKIDS",41,0) + . if rpcName="" quit +"RTN","TMGKIDS",42,0) + . do AddRPC(ienORCPRS,rpcName) +"RTN","TMGKIDS",43,0) + +"RTN","TMGKIDS",44,0) +PostDone +"RTN","TMGKIDS",45,0) + quit +"RTN","TMGKIDS",46,0) + +"RTN","TMGKIDS",47,0) + +"RTN","TMGKIDS",48,0) + +"RTN","TMGKIDS",49,0) +AddRPC(IENOption,RPCName) +"RTN","TMGKIDS",50,0) + ;"Purpose: To add the RPC Name to the RPC subfile in the Option record, +"RTN","TMGKIDS",51,0) + ;" given by IENOption +"RTN","TMGKIDS",52,0) + ;"Note: If IENRPC is already present, then it won't be added again. +"RTN","TMGKIDS",53,0) + +"RTN","TMGKIDS",54,0) + ;"See if RPC is already present, to avoid duplication +"RTN","TMGKIDS",55,0) + new DIC,TMGD0,X,Y +"RTN","TMGKIDS",56,0) + set TMGD0=IENOption +"RTN","TMGKIDS",57,0) + set X=RPCName +"RTN","TMGKIDS",58,0) + set DIC="^DIC(19,"_IENOption_",""RPC""," +"RTN","TMGKIDS",59,0) + set DIC(0)="MZ" +"RTN","TMGKIDS",60,0) + do ^DIC +"RTN","TMGKIDS",61,0) + +"RTN","TMGKIDS",62,0) + write RPCName +"RTN","TMGKIDS",63,0) + if +Y'>0 do +"RTN","TMGKIDS",64,0) + . ;"code to add RPC here. +"RTN","TMGKIDS",65,0) + . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGKIDS",66,0) + . set TMGFDA(19.05,"+1,"_IENOption_",",.01)=RPCName +"RTN","TMGKIDS",67,0) + . do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGKIDS",68,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGKIDS",69,0) + . write ?30,"... Added as allowed RPC from CPRS",! +"RTN","TMGKIDS",70,0) + else do +"RTN","TMGKIDS",71,0) + . write ?30,"... already present",! +"RTN","TMGKIDS",72,0) + +"RTN","TMGKIDS",73,0) + quit +"RTN","TMGKIDS",74,0) + +"RTN","TMGKIDS",75,0) + +"RTN","TMGKIDS",76,0) + +"RTN","TMGMATH") +0^30^B823927915 +"RTN","TMGMATH",1,0) + ;"16-Feb-1999, 16:54:35 +"RTN","TMGMATH",2,0) + ;"Routine Save for all M[UMPS] Library Functions +"RTN","TMGMATH",3,0) + ; +"RTN","TMGMATH",4,0) + ;" Unless otherwise noted, the code below +"RTN","TMGMATH",5,0) + ;" was approved in document X11/95-11 +"RTN","TMGMATH",6,0) + ; +"RTN","TMGMATH",7,0) + ;" If corrections have been applied, +"RTN","TMGMATH",8,0) + ;" first the original line appears, +"RTN","TMGMATH",9,0) + ;" with three semicolons at the beginning of the line. +"RTN","TMGMATH",10,0) + ; +"RTN","TMGMATH",11,0) + ;" Then the source of the correction is acknowledged, +"RTN","TMGMATH",12,0) + ;" then the corrected line appears, followed by a +"RTN","TMGMATH",13,0) + ;" line containing three semicolons. +"RTN","TMGMATH",14,0) + ; +"RTN","TMGMATH",15,0) + ;"Downloaded from http://www.jacquardsystems.com/Examples/lib/mlibfunc.rs +"RTN","TMGMATH",16,0) + ;"on 5/21/07 +"RTN","TMGMATH",17,0) +ABS(X) Quit $Translate(+X,"-") +"RTN","TMGMATH",18,0) + ;=== +"RTN","TMGMATH",19,0) + ; +"RTN","TMGMATH",20,0) + ; +"RTN","TMGMATH",21,0) +ARCCOS(X) ; +"RTN","TMGMATH",22,0) + ;;;" ;" Number ~~ +"RTN","TMGMATH",23,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",24,0) + ;" Comment: This version of the function is +"RTN","TMGMATH",25,0) + ;" optimized for speed, not for precision. +"RTN","TMGMATH",26,0) + ;" The 'precision' parameter is not supported, +"RTN","TMGMATH",27,0) + ;" and the precision is at best 2 in 10**-8. +"RTN","TMGMATH",28,0) + ;;; +"RTN","TMGMATH",29,0) + ; +"RTN","TMGMATH",30,0) + New A,N,R,SIGN,XX +"RTN","TMGMATH",31,0) + If X<-1 Set $Ecode=",M28," +"RTN","TMGMATH",32,0) + If X>1 Set $Ecode=",M28," +"RTN","TMGMATH",33,0) + Set SIGN=1 Set:X<0 X=-X,SIGN=-1 +"RTN","TMGMATH",34,0) + Set A(0)=1.5707963050,A(1)=-0.2145988016,A(2)=0.0889789874 +"RTN","TMGMATH",35,0) + Set A(3)=-0.0501743046,A(4)=0.0308918810,A(5)=-0.0170881256 +"RTN","TMGMATH",36,0) + Set A(6)=0.0066700901,A(7)=-0.0012624911 +"RTN","TMGMATH",37,0) + Set R=A(0),XX=1 For N=1:1:7 Set XX=XX*X,R=A(N)*XX+R +"RTN","TMGMATH",38,0) + ; +"RTN","TMGMATH",39,0) + ;;;" Set R=$%SQRT^MATH(1-X)*R ;" Number ~~ +"RTN","TMGMATH",40,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",41,0) + Set R=$%SQRT^MATH(1-X,11)*R +"RTN","TMGMATH",42,0) + ;;; +"RTN","TMGMATH",43,0) + ; +"RTN","TMGMATH",44,0) + Quit R*SIGN +"RTN","TMGMATH",45,0) + ;=== +"RTN","TMGMATH",46,0) + ; +"RTN","TMGMATH",47,0) + ; +"RTN","TMGMATH",48,0) +ARCCOS(X,PREC) ; +"RTN","TMGMATH",49,0) + ; +"RTN","TMGMATH",50,0) + ;;;" New L,LIM,K,SIG,SIGS ;" Number ~~ +"RTN","TMGMATH",51,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",52,0) + New L,LIM,K,SIG,SIGS,VALUE +"RTN","TMGMATH",53,0) + ;;; +"RTN","TMGMATH",54,0) + ; +"RTN","TMGMATH",55,0) + If X<-1 Set $Ecode=",M28," +"RTN","TMGMATH",56,0) + If X>1 Set $Ecode=",M28," +"RTN","TMGMATH",57,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",58,0) + ; +"RTN","TMGMATH",59,0) + ;;;" If $Translate(X,"-")=1 Set VALUE=0 Quit ;" Number ~~ +"RTN","TMGMATH",60,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",61,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",62,0) + If $Translate(X,"-")=1 Quit 0 +"RTN","TMGMATH",63,0) + ;;; +"RTN","TMGMATH",64,0) + ; +"RTN","TMGMATH",65,0) + Set SIG=$Select(X<0:-1,1:1),VALUE=1-(X*X) +"RTN","TMGMATH",66,0) + ; +"RTN","TMGMATH",67,0) + ;;;" Set X=$%SQRT^MATH(VALUE) ;" Number ~~ +"RTN","TMGMATH",68,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",69,0) + Set X=$%SQRT^MATH(VALUE,PREC) +"RTN","TMGMATH",70,0) + ;;; +"RTN","TMGMATH",71,0) + ; +"RTN","TMGMATH",72,0) + ;;;" If $Translate(X,"-")=1 Do Quit ;" Number ~~ +"RTN","TMGMATH",73,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",74,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",75,0) + If $Translate(X,"-")=1 Do Quit VALUE +"RTN","TMGMATH",76,0) + . ;;; +"RTN","TMGMATH",77,0) + . ; +"RTN","TMGMATH",78,0) + . Set VALUE=$%PI^MATH()/2*X +"RTN","TMGMATH",79,0) + . Quit +"RTN","TMGMATH",80,0) + ; +"RTN","TMGMATH",81,0) + ;;;" If X>0.9 Do Quit ;" Number ~~ +"RTN","TMGMATH",82,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",83,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",84,0) + If X>0.9 Do Quit VALUE +"RTN","TMGMATH",85,0) + . ;;; +"RTN","TMGMATH",86,0) + . ; +"RTN","TMGMATH",87,0) + . Set SIGS=$Select(X<0:-1,1:1) +"RTN","TMGMATH",88,0) + . Set VALUE=1/(1/X/X-1) +"RTN","TMGMATH",89,0) + . ; +"RTN","TMGMATH",90,0) + . ;;;" Set X=$%SQRT^MATH(VALUE) ;" Number ~~ +"RTN","TMGMATH",91,0) + . ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",92,0) + . Set X=$%SQRT^MATH(VALUE,PREC) +"RTN","TMGMATH",93,0) + . ;;; +"RTN","TMGMATH",94,0) + . ; +"RTN","TMGMATH",95,0) + . ; +"RTN","TMGMATH",96,0) + . ;;;" Set VALUE=$%ARCTAN^MATH(X,10)*SIGS ;" Number ~~ +"RTN","TMGMATH",97,0) + . ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",98,0) + . Set VALUE=$%ARCTAN^MATH(X,PREC)*SIGS +"RTN","TMGMATH",99,0) + . ;;; +"RTN","TMGMATH",100,0) + ; +"RTN","TMGMATH",101,0) + . Quit +"RTN","TMGMATH",102,0) + Set (VALUE,L)=X +"RTN","TMGMATH",103,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",104,0) + For K=3:2 Do Quit:($Translate(L,"-")1 Set $Ecode=",M28," +"RTN","TMGMATH",174,0) + Set SIGN=1 Set:X<0 X=-X,SIGN=-1 +"RTN","TMGMATH",175,0) + Set A(0)=1.5707963050,A(1)=-0.2145988016,A(2)=0.0889789874 +"RTN","TMGMATH",176,0) + Set A(3)=-0.0501743046,A(4)=0.0308918810,A(5)=-0.0170881256 +"RTN","TMGMATH",177,0) + Set A(6)=0.0066700901,A(7)=-0.0012624911 +"RTN","TMGMATH",178,0) + Set R=A(0),XX=1 For N=1:1:7 Set XX=XX*X,R=A(N)*XX+R +"RTN","TMGMATH",179,0) + ; +"RTN","TMGMATH",180,0) + ;;;" Set R=$%SQRT^MATH(1-X)*R ;" Number ~~ +"RTN","TMGMATH",181,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",182,0) + Set R=$%SQRT^MATH(1-X,11)*R +"RTN","TMGMATH",183,0) + ;;; +"RTN","TMGMATH",184,0) + ; +"RTN","TMGMATH",185,0) + Set R=$%PI^MATH()/2-R +"RTN","TMGMATH",186,0) + Quit R*SIGN +"RTN","TMGMATH",187,0) + ;=== +"RTN","TMGMATH",188,0) + ; +"RTN","TMGMATH",189,0) + ; +"RTN","TMGMATH",190,0) +ARCSIN(X,PREC) ; +"RTN","TMGMATH",191,0) + New L,LIM,K,SIGS,VALUE +"RTN","TMGMATH",192,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",193,0) + ; +"RTN","TMGMATH",194,0) + ;;;" If $Translate(X,"-")=1 Do Quit ;" Number ~~ +"RTN","TMGMATH",195,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",196,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",197,0) + If $Translate(X,"-")=1 Do Quit VALUE +"RTN","TMGMATH",198,0) + . ;;; +"RTN","TMGMATH",199,0) + . ; +"RTN","TMGMATH",200,0) + . Set VALUE=$%PI^MATH()/2*X +"RTN","TMGMATH",201,0) + . Quit +"RTN","TMGMATH",202,0) + ; +"RTN","TMGMATH",203,0) + ;;;" If X>0.99999 Do Quit ;" Number ~~ +"RTN","TMGMATH",204,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",205,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",206,0) + If X>0.99999 Do Quit VALUE +"RTN","TMGMATH",207,0) + . ;;; +"RTN","TMGMATH",208,0) + . ; +"RTN","TMGMATH",209,0) + . Set SIGS=$Select(X<0:-1,1:1) +"RTN","TMGMATH",210,0) + . Set VALUE=1/(1/X/X-1) +"RTN","TMGMATH",211,0) + . ; +"RTN","TMGMATH",212,0) + . ;;;" Set X=$%SQRT^MATH(VALUE) ;" Number ~~ +"RTN","TMGMATH",213,0) + . ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",214,0) + . Set X=$%SQRT^MATH(VALUE,PREC) +"RTN","TMGMATH",215,0) + . ;;; +"RTN","TMGMATH",216,0) + . ; +"RTN","TMGMATH",217,0) + . ;;;" Set VALUE=$%ARCTAN^MATH(X,10)*SIGS ;" Number ~~ +"RTN","TMGMATH",218,0) + . ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",219,0) + . Set VALUE=$%ARCTAN^MATH(X,PREC)*SIGS +"RTN","TMGMATH",220,0) + . ;;; +"RTN","TMGMATH",221,0) + . ; +"RTN","TMGMATH",222,0) + . Quit +"RTN","TMGMATH",223,0) + Set (VALUE,L)=X +"RTN","TMGMATH",224,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",225,0) + For K=3:2 Do Quit:($Translate(L,"-")HI:HI,1:X) +"RTN","TMGMATH",253,0) + ; +"RTN","TMGMATH",254,0) + ;;;" Set FOLD=$Select(X'<1:0,1:1), ;" Number ~~ +"RTN","TMGMATH",255,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",256,0) + Set FOLD=$Select(X'<1:0,1:1) +"RTN","TMGMATH",257,0) + ;;; +"RTN","TMGMATH",258,0) + ; +"RTN","TMGMATH",259,0) + Set X=$Select(FOLD:1/X,1:X) +"RTN","TMGMATH",260,0) + Set L=X,VALUE=$%PI^MATH()/2-(1/X),SIGN=1 +"RTN","TMGMATH",261,0) + ; +"RTN","TMGMATH",262,0) + ;;;" If X<1.3 Do Quit ;" Number ~~ +"RTN","TMGMATH",263,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",264,0) + ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",265,0) + If X<1.3 Do Quit VALUE +"RTN","TMGMATH",266,0) + . ;;; +"RTN","TMGMATH",267,0) + . ; +"RTN","TMGMATH",268,0) + . Set X=$Select(FOLD:1/X,1:X),VALUE=1/((1/X/X)+1) +"RTN","TMGMATH",269,0) + . ; +"RTN","TMGMATH",270,0) + . ;;;" Set $%SQRT^MATH(VALUE) ;" Number ~~ +"RTN","TMGMATH",271,0) + . ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",272,0) + . ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",273,0) + . Set X=$%SQRT^MATH(VALUE,PREC) +"RTN","TMGMATH",274,0) + . ;;; +"RTN","TMGMATH",275,0) + . ; +"RTN","TMGMATH",276,0) + . If $Translate(X,"-")=1 Do Quit +"RTN","TMGMATH",277,0) + . . Set VALUE=$%PI^MATH()/2*X +"RTN","TMGMATH",278,0) + . . Quit +"RTN","TMGMATH",279,0) + . If X>0.9 Do Quit +"RTN","TMGMATH",280,0) + . . Set SIGS=$Select(X<0:-1,1:1) +"RTN","TMGMATH",281,0) + . . Set VALUE=1/(1/X/X-1) +"RTN","TMGMATH",282,0) + . . Set X=$%SQRT^MATH(VALUE) +"RTN","TMGMATH",283,0) + . . Set VALUE=$$ARCTAN(X,10) +"RTN","TMGMATH",284,0) + . . Set VALUE=VALUE*SIGS +"RTN","TMGMATH",285,0) + . . Quit +"RTN","TMGMATH",286,0) + . Set (VALUE,L)=X +"RTN","TMGMATH",287,0) + . Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",288,0) + . For K=3:2 Do Quit:($Translate(L,"-")11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",294,0) + For K=3:2 Do Quit:($Translate(1/L,"-")1 Set $Ecode=",M28," +"RTN","TMGMATH",312,0) + ; +"RTN","TMGMATH",313,0) + ;;;" ;" Number ~~ +"RTN","TMGMATH",314,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",315,0) + ;" Alan Frank (October 1995) +"RTN","TMGMATH",316,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",317,0) + ;;; +"RTN","TMGMATH",318,0) + ; +"RTN","TMGMATH",319,0) + Quit $%LOG^MATH(1+X/(1-X),PREC)/2 +"RTN","TMGMATH",320,0) + ;=== +"RTN","TMGMATH",321,0) + ; +"RTN","TMGMATH",322,0) + ; +"RTN","TMGMATH",323,0) +CABS(Z) ; +"RTN","TMGMATH",324,0) + New ZRE,ZIM +"RTN","TMGMATH",325,0) + Set ZRE=+Z,ZIM=+$Piece(Z,"%",2) +"RTN","TMGMATH",326,0) + Quit $%SQRT^MATH(ZRE*ZRE+(ZIM*ZIM)) +"RTN","TMGMATH",327,0) + ;=== +"RTN","TMGMATH",328,0) + ; +"RTN","TMGMATH",329,0) + ; +"RTN","TMGMATH",330,0) +CADD(X,Y) ; +"RTN","TMGMATH",331,0) + New XRE,XIM,YRE,YIM +"RTN","TMGMATH",332,0) + Set XRE=+X,XIM=+$Piece(X,"%",2) +"RTN","TMGMATH",333,0) + Set YRE=+Y,YIM=+$Piece(Y,"%",2) +"RTN","TMGMATH",334,0) + Quit XRE+YRE_"%"_(XIM+YIM) +"RTN","TMGMATH",335,0) + ;=== +"RTN","TMGMATH",336,0) + ; +"RTN","TMGMATH",337,0) + ; +"RTN","TMGMATH",338,0) +CCOS(Z,PREC) ; +"RTN","TMGMATH",339,0) + New E1,E2,IA +"RTN","TMGMATH",340,0) + ; +"RTN","TMGMATH",341,0) + ;;;" ;" Number ~~ +"RTN","TMGMATH",342,0) + ;" Alan Frank (October 1995) +"RTN","TMGMATH",343,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",344,0) + ;;; +"RTN","TMGMATH",345,0) + ; +"RTN","TMGMATH",346,0) + Set IA=$%CMUL^MATH(Z,"0%1") +"RTN","TMGMATH",347,0) + Set E1=$%CEXP^MATH(IA,PREC) +"RTN","TMGMATH",348,0) + Set IA=-IA_"%"_(-$Piece(IA,"%",2)) +"RTN","TMGMATH",349,0) + Set E2=$%CEXP^MATH(IA,PREC) +"RTN","TMGMATH",350,0) + Set IA=$%CADD^MATH(E1,E2) +"RTN","TMGMATH",351,0) + Quit $%CMUL^MATH(IA,"0.5%0") +"RTN","TMGMATH",352,0) + ;=== +"RTN","TMGMATH",353,0) + ; +"RTN","TMGMATH",354,0) + ; +"RTN","TMGMATH",355,0) +CDIV(X,Y) ; +"RTN","TMGMATH",356,0) + New D,IM,RE,XIM,XRE,YIM,YRE +"RTN","TMGMATH",357,0) + Set XRE=+X,XIM=+$Piece(X,"%",2) +"RTN","TMGMATH",358,0) + Set YRE=+Y,YIM=+$Piece(Y,"%",2) +"RTN","TMGMATH",359,0) + Set D=YRE*YRE+(YIM*YIM) +"RTN","TMGMATH",360,0) + Set RE=XRE*YRE+(XIM*YIM)/D +"RTN","TMGMATH",361,0) + Set IM=XIM*YRE-(XRE*YIM)/D +"RTN","TMGMATH",362,0) + Quit RE_"%"_IM +"RTN","TMGMATH",363,0) + ;=== +"RTN","TMGMATH",364,0) + ; +"RTN","TMGMATH",365,0) + ; +"RTN","TMGMATH",366,0) +CEXP(Z,PREC) ; +"RTN","TMGMATH",367,0) + New R,ZIM,ZRE +"RTN","TMGMATH",368,0) + ; +"RTN","TMGMATH",369,0) + ;;;" ;" Number ~~ +"RTN","TMGMATH",370,0) + ;" Alan Frank (October 1995) +"RTN","TMGMATH",371,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",372,0) + ;;; +"RTN","TMGMATH",373,0) + ; +"RTN","TMGMATH",374,0) + Set ZRE=+Z,ZIM=+$Piece(Z,"%",2) +"RTN","TMGMATH",375,0) + Set R=$%EXP^MATH(ZRE,PREC) +"RTN","TMGMATH",376,0) + Quit R*$%COS^MATH(ZIM,PREC)_"%"_(R*$%SIN^MATH(ZIM,PREC)) +"RTN","TMGMATH",377,0) + ;=== +"RTN","TMGMATH",378,0) + ; +"RTN","TMGMATH",379,0) + ; +"RTN","TMGMATH",380,0) +CLOG(Z,PREC) ; +"RTN","TMGMATH",381,0) + New ABS,ARG,ZIM,ZRE +"RTN","TMGMATH",382,0) + ; +"RTN","TMGMATH",383,0) + ;;;" ;" Number ~~ +"RTN","TMGMATH",384,0) + ;" Alan Frank (October 1995) +"RTN","TMGMATH",385,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",386,0) + ;;; +"RTN","TMGMATH",387,0) + ; +"RTN","TMGMATH",388,0) + Set ABS=$%CABS^MATH(Z) +"RTN","TMGMATH",389,0) + Set ZRE=+Z,ZIM=+$Piece(Z,"%",2) +"RTN","TMGMATH",390,0) + ; +"RTN","TMGMATH",391,0) + ;;;" Set ARG=$%ARCTAN^MATH(ZIM,ZRE,PREC) ;" Number ~~ +"RTN","TMGMATH",392,0) + ;" Alan Frank (October 1995) +"RTN","TMGMATH",393,0) + Set ARG=$%ARCTAN^MATH(ZIM/ZRE,PREC) +"RTN","TMGMATH",394,0) + ;;; +"RTN","TMGMATH",395,0) + ; +"RTN","TMGMATH",396,0) + Quit $%LOG^MATH(ABS,PREC)_"%"_ARG +"RTN","TMGMATH",397,0) + ;=== +"RTN","TMGMATH",398,0) + ; +"RTN","TMGMATH",399,0) + ; +"RTN","TMGMATH",400,0) +CMUL(X,Y) ; +"RTN","TMGMATH",401,0) + New XIM,XRE,YIM,YRE +"RTN","TMGMATH",402,0) + Set XRE=+X,XIM=+$Piece(X,"%",2) +"RTN","TMGMATH",403,0) + Set YRE=+Y,YIM=+$Piece(Y,"%",2) +"RTN","TMGMATH",404,0) + Quit XRE*YRE-(XIM*YIM)_"%"_(XRE*YIM+(XIM*YRE)) +"RTN","TMGMATH",405,0) + ;=== +"RTN","TMGMATH",406,0) + ; +"RTN","TMGMATH",407,0) + ; +"RTN","TMGMATH",408,0) +COMPLEX(X) Quit +X_"%0" +"RTN","TMGMATH",409,0) + ;=== +"RTN","TMGMATH",410,0) + ; +"RTN","TMGMATH",411,0) + ; +"RTN","TMGMATH",412,0) +CONJUG(Z) ; +"RTN","TMGMATH",413,0) + New ZIM,ZRE +"RTN","TMGMATH",414,0) + Set ZRE=+Z,ZIM=+$Piece(Z,"%",2) +"RTN","TMGMATH",415,0) + Quit ZRE_"%"_(-ZIM) +"RTN","TMGMATH",416,0) + ;=== +"RTN","TMGMATH",417,0) + ; +"RTN","TMGMATH",418,0) + ; +"RTN","TMGMATH",419,0) +COS(X,PREC) ; +"RTN","TMGMATH",420,0) + New L,LIM,K,SIGN,VALUE +"RTN","TMGMATH",421,0) + ; +"RTN","TMGMATH",422,0) + ;;;" Set:X[":" X=$%DMSDEC^MATH(X,12) ;" Number ~~ +"RTN","TMGMATH",423,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",424,0) + ;" Comment: The official description does not mention than +"RTN","TMGMATH",425,0) + ;" the function may also be called with the first +"RTN","TMGMATH",426,0) + ;" parameter in degrees, minutes and seconds. +"RTN","TMGMATH",427,0) + Set:X[":" X=$%DMSDEC^MATH(X) +"RTN","TMGMATH",428,0) + ;;; +"RTN","TMGMATH",429,0) + ; +"RTN","TMGMATH",430,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",431,0) + Set X=X#(2*$%PI^MATH()) +"RTN","TMGMATH",432,0) + Set (VALUE,L)=1,SIGN=-1 +"RTN","TMGMATH",433,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",434,0) + For K=2:2 Do Quit:($Translate(L,"-")PI X=2*PI-X +"RTN","TMGMATH",459,0) + Set:X*2>PI X=PI-X,SIGN=-1 +"RTN","TMGMATH",460,0) + ; +"RTN","TMGMATH",461,0) + Set XX=X*X,A(1)=-0.4999999963,A(2)=0.0416666418 +"RTN","TMGMATH",462,0) + Set A(3)=-0.0013888397,A(4)=0.0000247609,A(5)=-0.0000002605 +"RTN","TMGMATH",463,0) + Set (X,R)=1 For N=1:1:5 Set X=X*XX,R=A(N)*X+R +"RTN","TMGMATH",464,0) + Quit R*SIGN +"RTN","TMGMATH",465,0) + ;=== +"RTN","TMGMATH",466,0) + ; +"RTN","TMGMATH",467,0) + ; +"RTN","TMGMATH",468,0) +COSH(X,PREC) ; +"RTN","TMGMATH",469,0) + ; +"RTN","TMGMATH",470,0) + ;;;" New F,I,P,R,T,XX ;" Number ~~ +"RTN","TMGMATH",471,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",472,0) + New E,F,I,P,R,T,XX +"RTN","TMGMATH",473,0) + ;;; +"RTN","TMGMATH",474,0) + ; +"RTN","TMGMATH",475,0) + Set PREC=$Get(PREC,11)+1 +"RTN","TMGMATH",476,0) + Set @("E=1E-"_PREC) +"RTN","TMGMATH",477,0) + Set XX=X*X,F=1,(P,R,T)=1,I=1 +"RTN","TMGMATH",478,0) + For Set T=T*XX,F=I+1*I*F,R=T/F+R,P=P-R/R,I=I+2 If -E11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",497,0) + For K=2:2 Do Quit:($Translate(L,"-")11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",504,0) + For K=3:2 Do Quit:($Translate(L,"-")0:PI/2,1:-PI/2) ;" Number ~~ +"RTN","TMGMATH",560,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",561,0) + Else Set TH=$SELECT(ZIM>0:PI/2,1:-PI/2) +"RTN","TMGMATH",562,0) + ;;; +"RTN","TMGMATH",563,0) + ; +"RTN","TMGMATH",564,0) + Set RHO=$%LOG^MATH(R,PREC) +"RTN","TMGMATH",565,0) + Set AR=$%EXP^MATH(RHO*NRE-(TH*NIM),PREC) +"RTN","TMGMATH",566,0) + Set PHI=RHO*NIM+(NRE*TH) +"RTN","TMGMATH",567,0) + Quit AR*$%COS^MATH(PHI,PREC)_"%"_(AR*$%SIN^MATH(PHI,PREC)) +"RTN","TMGMATH",568,0) + ;=== +"RTN","TMGMATH",569,0) + ; +"RTN","TMGMATH",570,0) + ; +"RTN","TMGMATH",571,0) +CSC(X,PREC) ; +"RTN","TMGMATH",572,0) + New L,LIM,K,SIGN,VALUE +"RTN","TMGMATH",573,0) + ; +"RTN","TMGMATH",574,0) + ;;;" Set:X[":" X=$%DMSDEC^MATH(X,12) ;" Number ~~ +"RTN","TMGMATH",575,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",576,0) + ;" Comment: The official description does not mention than +"RTN","TMGMATH",577,0) + ;" the function may also be called with the first +"RTN","TMGMATH",578,0) + ;" parameter in degrees, minutes and seconds. +"RTN","TMGMATH",579,0) + Set:X[":" X=$%DMSDEC^MATH(X) +"RTN","TMGMATH",580,0) + ;;; +"RTN","TMGMATH",581,0) + ; +"RTN","TMGMATH",582,0) + ;;;" Set PREC=$Select($Data(PREC)#2:PREC,1:10) ;" Number ~~ +"RTN","TMGMATH",583,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",584,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",585,0) + ;;; +"RTN","TMGMATH",586,0) + ; +"RTN","TMGMATH",587,0) + Set X=X#(2*$%PI^MATH()) +"RTN","TMGMATH",588,0) + Set (VALUE,L)=X,SIGN=-1 +"RTN","TMGMATH",589,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",590,0) + For K=3:2 Do Quit:($Translate(L,"-")11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",660,0) + For K=2:1 Set L=L*X/K,VALUE=VALUE+L Quit:($Translate(L,"-")0 Set $Ecode=",M28," +"RTN","TMGMATH",668,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",669,0) + Set M=1 +"RTN","TMGMATH",670,0) + ; +"RTN","TMGMATH",671,0) + ;;;" If X>0 For N=0:1 Quit:(X/M)<10 Set M=M*10 ;" Number ~~ +"RTN","TMGMATH",672,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",673,0) + For N=0:1 Quit:(X/M)<10 Set M=M*10 +"RTN","TMGMATH",674,0) + ;;; +"RTN","TMGMATH",675,0) + ; +"RTN","TMGMATH",676,0) + If X<1 For N=0:-1 Quit:(X/M)>0.1 Set M=M*0.1 +"RTN","TMGMATH",677,0) + Set X=X/M +"RTN","TMGMATH",678,0) + Set X=(X-1)/(X+1),(VALUE,L)=X +"RTN","TMGMATH",679,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",680,0) + For K=3:2 Set L=L*X*X,M=L/K,VALUE=M+VALUE Set:M<0 M=-M Quit:M0 Set $Ecode=",M28," +"RTN","TMGMATH",689,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",690,0) + Set M=1 +"RTN","TMGMATH",691,0) + ; +"RTN","TMGMATH",692,0) + ;;;" If X>0 For N=0:1 Quit:(X/M)<10 Set M=M*10 ;" Number ~~ +"RTN","TMGMATH",693,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",694,0) + For N=0:1 Quit:(X/M)<10 Set M=M*10 +"RTN","TMGMATH",695,0) + ;;; +"RTN","TMGMATH",696,0) + ; +"RTN","TMGMATH",697,0) + If X<1 For N=0:-1 Quit:(X/M)>0.1 Set M=M*0.1 +"RTN","TMGMATH",698,0) + Set X=X/M +"RTN","TMGMATH",699,0) + Set X=(X-1)/(X+1),(VALUE,L)=X +"RTN","TMGMATH",700,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",701,0) + For K=3:2 Set L=L*X*X,M=L/K,VALUE=M+VALUE Set:M<0 M=-M Quit:M$TRANSLATE(TEMP,"-") +"RTN","TMGMATH",802,0) + . . SET TEMP=T(J1,K),J2=J1 +"RTN","TMGMATH",803,0) + . . QUIT +"RTN","TMGMATH",804,0) + . ; +"RTN","TMGMATH",805,0) + . ;" Exchange row number K with row number J2, +"RTN","TMGMATH",806,0) + . ;" if necessary +"RTN","TMGMATH",807,0) + . ; +"RTN","TMGMATH",808,0) + . DO:J2'=K +"RTN","TMGMATH",809,0) + . . ; +"RTN","TMGMATH",810,0) + . . FOR J=K:1:N DO +"RTN","TMGMATH",811,0) + . . . SET T1=$GET(T(K,J)),T2=$GET(T(J2,J)) +"RTN","TMGMATH",812,0) + . . . KILL T(K,J),T(J2,J) +"RTN","TMGMATH",813,0) + . . . IF T1'="" SET T(J2,J)=T1 +"RTN","TMGMATH",814,0) + . . . IF T2'="" SET T(K,J)=T2 +"RTN","TMGMATH",815,0) + . . . QUIT +"RTN","TMGMATH",816,0) + . . FOR J=1:1:M DO +"RTN","TMGMATH",817,0) + . . . SET T1=$GET(R(K,J)),T2=$GET(R(J2,J)) +"RTN","TMGMATH",818,0) + . . . KILL R(K,J),R(J2,J) +"RTN","TMGMATH",819,0) + . . . IF T1'="" SET R(J2,J)=T1 +"RTN","TMGMATH",820,0) + . . . IF T2'="" SET R(K,J)=T2 +"RTN","TMGMATH",821,0) + . . . QUIT +"RTN","TMGMATH",822,0) + . . QUIT +"RTN","TMGMATH",823,0) + . ; +"RTN","TMGMATH",824,0) + . ;" Actual reduction +"RTN","TMGMATH",825,0) + . ; +"RTN","TMGMATH",826,0) + . FOR I=K+1:1:N DO +"RTN","TMGMATH",827,0) + . . FOR J=K+1:1:N DO +"RTN","TMGMATH",828,0) + . . . QUIT:'$GET(T(K,K)) +"RTN","TMGMATH",829,0) + . . . SET T(I,J)=-$GET(T(K,J))*$GET(T(I,K))/T(K,K)+$GET(T(I,J)) +"RTN","TMGMATH",830,0) + . . . QUIT +"RTN","TMGMATH",831,0) + . . FOR J=1:1:M DO +"RTN","TMGMATH",832,0) + . . . QUIT:'$GET(T(K,K)) +"RTN","TMGMATH",833,0) + . . . SET R(I,J)=-$GET(R(K,J))*$GET(T(I,K))/T(K,K)+$GET(R(I,J)) +"RTN","TMGMATH",834,0) + . . . QUIT +"RTN","TMGMATH",835,0) + . . QUIT +"RTN","TMGMATH",836,0) + . QUIT +"RTN","TMGMATH",837,0) + ; +"RTN","TMGMATH",838,0) + ;" Backsubstitution +"RTN","TMGMATH",839,0) + ; +"RTN","TMGMATH",840,0) + FOR J=1:1:M DO +"RTN","TMGMATH",841,0) + . IF $GET(T(N,N)) SET R(N,J)=$GET(R(N,J))/T(N,N) +"RTN","TMGMATH",842,0) + . IF N-1>0 FOR I1=1:1:N-1 DO +"RTN","TMGMATH",843,0) + . . SET I=N-I1 +"RTN","TMGMATH",844,0) + . . FOR L=I+1:1:N DO +"RTN","TMGMATH",845,0) + . . . SET R(I,J)=-$GET(T(I,L))*$GET(R(L,J))+$GET(R(I,J)) +"RTN","TMGMATH",846,0) + . . . QUIT +"RTN","TMGMATH",847,0) + . . IF $GET(T(I,I)) SET R(I,J)=$GET(R(I,J))/$GET(T(I,I)) +"RTN","TMGMATH",848,0) + . . QUIT +"RTN","TMGMATH",849,0) + . QUIT +"RTN","TMGMATH",850,0) + ;;;QUIT $%MTXDET^MATH(.R) +"RTN","TMGMATH",851,0) + ;" Ed de Moel, 29 Aug 1999 +"RTN","TMGMATH",852,0) + QUIT $SELECT(M=N:$%MTXDET^MATH(.R,M),1:1) +"RTN","TMGMATH",853,0) + ;;; +"RTN","TMGMATH",854,0) + ;=== +"RTN","TMGMATH",855,0) + ; +"RTN","TMGMATH",856,0) +MTXINV(A,R,N) ; +"RTN","TMGMATH",857,0) + ;" Invert A[N,N], result goes to R[N,N] +"RTN","TMGMATH",858,0) + IF $DATA(A)<10 QUIT 0 +"RTN","TMGMATH",859,0) + IF $GET(N)<1 QUIT 0 +"RTN","TMGMATH",860,0) + ; +"RTN","TMGMATH",861,0) + NEW T,X +"RTN","TMGMATH",862,0) + SET X=$%MTXUNIT^MATH(.T,N) +"RTN","TMGMATH",863,0) + QUIT $%MTXEQU^MATH(.A,.T,.R,N,N) +"RTN","TMGMATH",864,0) + ;=== +"RTN","TMGMATH",865,0) + ; +"RTN","TMGMATH",866,0) + ; +"RTN","TMGMATH",867,0) +MTXMUL(A,B,R,M,L,N) ; +"RTN","TMGMATH",868,0) + ;" Multiply A[M,L] by B[L,N], result goes to R[M,N] +"RTN","TMGMATH",869,0) + IF $DATA(A)<10 QUIT 0 +"RTN","TMGMATH",870,0) + IF $DATA(B)<10 QUIT 0 +"RTN","TMGMATH",871,0) + IF $GET(L)<1 QUIT 0 +"RTN","TMGMATH",872,0) + IF $GET(M)<1 QUIT 0 +"RTN","TMGMATH",873,0) + IF $GET(N)<1 QUIT 0 +"RTN","TMGMATH",874,0) + ; +"RTN","TMGMATH",875,0) + NEW I,J,K,SUM,ANY +"RTN","TMGMATH",876,0) + FOR I=1:1:M FOR J=1:1:N DO +"RTN","TMGMATH",877,0) + . SET (SUM,ANY)=0 +"RTN","TMGMATH",878,0) + . KVALUE R(I,J) +"RTN","TMGMATH",879,0) + . FOR K=1:1:L DO +"RTN","TMGMATH",880,0) + . . SET:$DATA(A(I,K))#2 ANY=1 +"RTN","TMGMATH",881,0) + . . SET:$DATA(B(K,J))#2 ANY=1 +"RTN","TMGMATH",882,0) + . . SET SUM=$GET(A(I,K))*$GET(B(K,J))+SUM +"RTN","TMGMATH",883,0) + . . QUIT +"RTN","TMGMATH",884,0) + . SET:ANY R(I,J)=SUM +"RTN","TMGMATH",885,0) + . QUIT +"RTN","TMGMATH",886,0) + QUIT 1 +"RTN","TMGMATH",887,0) + ;=== +"RTN","TMGMATH",888,0) + ; +"RTN","TMGMATH",889,0) + ; +"RTN","TMGMATH",890,0) +MTXSCA(A,R,ROWS,COLS,S) ; +"RTN","TMGMATH",891,0) + ;" Multiply A[ROWS,COLS] with the scalar S, +"RTN","TMGMATH",892,0) + ;" result goes to R[ROWS,COLS] +"RTN","TMGMATH",893,0) + IF $DATA(A)<10 QUIT 0 +"RTN","TMGMATH",894,0) + IF $GET(ROWS)<1 QUIT 0 +"RTN","TMGMATH",895,0) + IF $GET(COLS)<1 QUIT 0 +"RTN","TMGMATH",896,0) + IF '($DATA(S)#2) QUIT 0 +"RTN","TMGMATH",897,0) + ; +"RTN","TMGMATH",898,0) + NEW ROW,COL +"RTN","TMGMATH",899,0) + FOR ROW=1:1:ROWS FOR COL=1:1:COLS DO +"RTN","TMGMATH",900,0) + . KVALUE R(ROW,COL) +"RTN","TMGMATH",901,0) + . SET:$DATA(A(ROW,COL))#2 R(ROW,COL)=A(ROW,COL)*S +"RTN","TMGMATH",902,0) + . QUIT +"RTN","TMGMATH",903,0) + QUIT 1 +"RTN","TMGMATH",904,0) + ;=== +"RTN","TMGMATH",905,0) + ; +"RTN","TMGMATH",906,0) + ; +"RTN","TMGMATH",907,0) +MTXSUB(A,B,R,ROWS,COLS) ; +"RTN","TMGMATH",908,0) + ;" Subtract B[ROWS,COLS] from A[ROWS,COLS], +"RTN","TMGMATH",909,0) + ;" result goes to R[ROWS,COLS] +"RTN","TMGMATH",910,0) + IF $DATA(A)<10 QUIT 0 +"RTN","TMGMATH",911,0) + IF $DATA(B)<10 QUIT 0 +"RTN","TMGMATH",912,0) + IF $GET(ROWS)<1 QUIT 0 +"RTN","TMGMATH",913,0) + IF $GET(COLS)<1 QUIT 0 +"RTN","TMGMATH",914,0) + ; +"RTN","TMGMATH",915,0) + NEW ROW,COL,ANY +"RTN","TMGMATH",916,0) + FOR ROW=1:1:ROWS FOR COL=1:1:COLS DO +"RTN","TMGMATH",917,0) + . KVALUE R(ROW,COL) SET ANY=0 +"RTN","TMGMATH",918,0) + . SET:$DATA(A(ROW,COL))#2 ANY=1 +"RTN","TMGMATH",919,0) + . SET:$DATA(B(ROW,COL))#2 ANY=1 +"RTN","TMGMATH",920,0) + . ; +"RTN","TMGMATH",921,0) + . ;;;" SET:ANY R(ROW,COL)=$GET(A(ROW,COL)-$GET(B(ROW,COL)) ;" Number ~~ +"RTN","TMGMATH",922,0) + . ;" Eli Reidler (28 June 1996) +"RTN","TMGMATH",923,0) + . SET:ANY R(ROW,COL)=$GET(A(ROW,COL))-$GET(B(ROW,COL)) +"RTN","TMGMATH",924,0) + . ;;; +"RTN","TMGMATH",925,0) + . ; +"RTN","TMGMATH",926,0) + . QUIT +"RTN","TMGMATH",927,0) + QUIT 1 +"RTN","TMGMATH",928,0) + ;=== +"RTN","TMGMATH",929,0) + ; +"RTN","TMGMATH",930,0) + ; +"RTN","TMGMATH",931,0) +MTXTRP(A,R,M,N) ; +"RTN","TMGMATH",932,0) + ;" Transpose A[M,N], result goes to R[N,M] +"RTN","TMGMATH",933,0) + IF $DATA(A)<10 QUIT 0 +"RTN","TMGMATH",934,0) + IF $GET(M)<1 QUIT 0 +"RTN","TMGMATH",935,0) + IF $GET(N)<1 QUIT 0 +"RTN","TMGMATH",936,0) + ; +"RTN","TMGMATH",937,0) + NEW I,J,K,D1,V1,D2,V2 +"RTN","TMGMATH",938,0) + FOR I=1:1:M+N-1 FOR J=1:1:I+1\2 DO +"RTN","TMGMATH",939,0) + . SET K=I-J+1 +"RTN","TMGMATH",940,0) + . IF K=J DO QUIT +"RTN","TMGMATH",941,0) + . . SET V1=$GET(A(J,J)),D1=$DATA(A(J,J))#2 +"RTN","TMGMATH",942,0) + . . IF J'>N,J'>M KVALUE R(J,J) SET:D1 R(J,J)=V1 +"RTN","TMGMATH",943,0) + . . QUIT +"RTN","TMGMATH",944,0) + . ; +"RTN","TMGMATH",945,0) + . SET V1=$GET(A(K,J)),D1=$DATA(A(K,J))#2 +"RTN","TMGMATH",946,0) + . SET V2=$GET(A(J,K)),D2=$DATA(A(J,K))#2 +"RTN","TMGMATH",947,0) + . IF K'>M,J'>N KVALUE R(K,J) SET:D2 R(K,J)=V2 +"RTN","TMGMATH",948,0) + . IF J'>M,K'>N KVALUE R(J,K) SET:D1 R(J,K)=V1 +"RTN","TMGMATH",949,0) + . QUIT +"RTN","TMGMATH",950,0) + QUIT 1 +"RTN","TMGMATH",951,0) + ;=== +"RTN","TMGMATH",952,0) + ; +"RTN","TMGMATH",953,0) + ; +"RTN","TMGMATH",954,0) +MTXUNIT(R,N,SPARSE) ; +"RTN","TMGMATH",955,0) + ;" Create a unit matrix R[N,N] +"RTN","TMGMATH",956,0) + IF $GET(N)<1 QUIT 0 +"RTN","TMGMATH",957,0) + ; +"RTN","TMGMATH",958,0) + NEW ROW,COL +"RTN","TMGMATH",959,0) + FOR ROW=1:1:N FOR COL=1:1:N DO +"RTN","TMGMATH",960,0) + . KVALUE R(ROW,COL) +"RTN","TMGMATH",961,0) + . IF $GET(SPARSE) QUIT:ROW'=COL +"RTN","TMGMATH",962,0) + . SET R(ROW,COL)=$SELECT(ROW=COL:1,1:0) +"RTN","TMGMATH",963,0) + . QUIT +"RTN","TMGMATH",964,0) + QUIT 1 +"RTN","TMGMATH",965,0) + ;=== +"RTN","TMGMATH",966,0) + ; +"RTN","TMGMATH",967,0) + ; +"RTN","TMGMATH",968,0) +PI() Quit 3.14159265358979 +"RTN","TMGMATH",969,0) + ;=== +"RTN","TMGMATH",970,0) + ; +"RTN","TMGMATH",971,0) + ; +"RTN","TMGMATH",972,0) +PRODUCE(IN,SPEC,MAX) ; +"RTN","TMGMATH",973,0) + NEW VALUE,AGAIN,P1,P2,I,COUNT +"RTN","TMGMATH",974,0) + SET VALUE=IN,COUNT=0 +"RTN","TMGMATH",975,0) + FOR DO QUIT:'AGAIN +"RTN","TMGMATH",976,0) + . SET AGAIN=0 +"RTN","TMGMATH",977,0) + . SET I="" +"RTN","TMGMATH",978,0) + . FOR SET I=$ORDER(SPEC(I)) QUIT:I="" DO QUIT:COUNT<0 +"RTN","TMGMATH",979,0) + . . QUIT:$GET(SPEC(I,1))="" +"RTN","TMGMATH",980,0) + . . QUIT:'($DATA(SPEC(I,2))#2) +"RTN","TMGMATH",981,0) + . . FOR QUIT:VALUE'[SPEC(I,1) DO QUIT:COUNT<0 +"RTN","TMGMATH",982,0) + . . . SET P1=$PIECE(VALUE,SPEC(I,1),1) +"RTN","TMGMATH",983,0) + . . . SET P2=$PIECE(VALUE,SPEC(I,1),2,$LENGTH(VALUE)) +"RTN","TMGMATH",984,0) + . . . SET VALUE=P1_SPEC(I,2)_P2,AGAIN=1 +"RTN","TMGMATH",985,0) + . . . SET COUNT=COUNT+1 +"RTN","TMGMATH",986,0) + . . . IF $DATA(MAX),COUNT>MAX SET COUNT=-1,AGAIN=0 +"RTN","TMGMATH",987,0) + . . . QUIT +"RTN","TMGMATH",988,0) + . . QUIT +"RTN","TMGMATH",989,0) + . QUIT +"RTN","TMGMATH",990,0) + QUIT VALUE +"RTN","TMGMATH",991,0) + ;=== +"RTN","TMGMATH",992,0) + ; +"RTN","TMGMATH",993,0) + ; +"RTN","TMGMATH",994,0) +RADDEG(X) Quit X*180/3.14159265358979 +"RTN","TMGMATH",995,0) + ;=== +"RTN","TMGMATH",996,0) + ; +"RTN","TMGMATH",997,0) + ; +"RTN","TMGMATH",998,0) +REPLACE(IN,SPEC) ; +"RTN","TMGMATH",999,0) + NEW L,MASK,K,I,LT,F,VALUE +"RTN","TMGMATH",1000,0) + SET L=$LENGTH(IN),MASK=$JUSTIFY("",L) +"RTN","TMGMATH",1001,0) + SET I="" FOR SET I=$ORDER(SPEC(I)) QUIT:I="" DO +"RTN","TMGMATH",1002,0) + . QUIT:'($DATA(SPEC(I,1))#2) +"RTN","TMGMATH",1003,0) + . QUIT:SPEC(I,1)="" +"RTN","TMGMATH",1004,0) + . QUIT:'($DATA(SPEC(I,2))#2) +"RTN","TMGMATH",1005,0) + . SET LT=$LENGTH(SPEC(I,1)) +"RTN","TMGMATH",1006,0) + . SET F=0 FOR SET F=$FIND(IN,SPEC(I,1),F) QUIT:F<1 DO +"RTN","TMGMATH",1007,0) + . . QUIT:$EXTRACT(MASK,F-LT,F-1)["X" +"RTN","TMGMATH",1008,0) + . . SET VALUE(F-LT)=SPEC(I,2) +"RTN","TMGMATH",1009,0) + . . SET $EXTRACT(MASK,F-LT,F-1)=$TRANSLATE($JUSTIFY("",LT)," ","X") +"RTN","TMGMATH",1010,0) + . . QUIT +"RTN","TMGMATH",1011,0) + . QUIT +"RTN","TMGMATH",1012,0) + SET VALUE="" FOR K=1:1:L DO +"RTN","TMGMATH",1013,0) + . IF $EXTRACT(MASK,K)=" " SET VALUE=VALUE_$EXTRACT(IN,K) QUIT +"RTN","TMGMATH",1014,0) + . SET:$DATA(VALUE(K)) VALUE=VALUE_VALUE(K) +"RTN","TMGMATH",1015,0) + . QUIT +"RTN","TMGMATH",1016,0) + QUIT VALUE +"RTN","TMGMATH",1017,0) + ;=== +"RTN","TMGMATH",1018,0) + ; +"RTN","TMGMATH",1019,0) + ; +"RTN","TMGMATH",1020,0) +SEC(X,PREC) ; +"RTN","TMGMATH",1021,0) + New L,LIM,K,SIGN,VALUE +"RTN","TMGMATH",1022,0) + ; +"RTN","TMGMATH",1023,0) + ;;;" Set:X[":" X=$%DMSDEC^MATH(X,12) ;" Number ~~ +"RTN","TMGMATH",1024,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",1025,0) + ;" Comment: The official description does not mention than +"RTN","TMGMATH",1026,0) + ;" the function may also be called with the first +"RTN","TMGMATH",1027,0) + ;" parameter in degrees, minutes and seconds. +"RTN","TMGMATH",1028,0) + Set:X[":" X=$%DMSDEC^MATH(X) +"RTN","TMGMATH",1029,0) + ;;; +"RTN","TMGMATH",1030,0) + ; +"RTN","TMGMATH",1031,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",1032,0) + Set X=X#(2*$%PI^MATH()) +"RTN","TMGMATH",1033,0) + Set (VALUE,L)=1,SIGN=-1 +"RTN","TMGMATH",1034,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",1035,0) + For K=2:2 Do Quit:($Translate(L,"-")0:1,1:0) +"RTN","TMGMATH",1052,0) + ;=== +"RTN","TMGMATH",1053,0) + ; +"RTN","TMGMATH",1054,0) + ; +"RTN","TMGMATH",1055,0) +SIN(X,PREC) ; +"RTN","TMGMATH",1056,0) + New L,LIM,K,SIGN,VALUE +"RTN","TMGMATH",1057,0) + ; +"RTN","TMGMATH",1058,0) + ;;;" Set:X[":" X=$%DMSDEC^MATH(X,12) ;" Number ~~ +"RTN","TMGMATH",1059,0) + ;" Winfried Gerum (8 June 1995) +"RTN","TMGMATH",1060,0) + ;" Comment: The official description does not mention than +"RTN","TMGMATH",1061,0) + ;" the function may also be called with the first +"RTN","TMGMATH",1062,0) + ;" parameter in degrees, minutes and seconds. +"RTN","TMGMATH",1063,0) + Set:X[":" X=$%DMSDEC^MATH(X) +"RTN","TMGMATH",1064,0) + ;;; +"RTN","TMGMATH",1065,0) + ; +"RTN","TMGMATH",1066,0) + Set PREC=$Get(PREC,11) +"RTN","TMGMATH",1067,0) + Set X=X#(2*$%PI^MATH()) +"RTN","TMGMATH",1068,0) + Set (VALUE,L)=X,SIGN=-1 +"RTN","TMGMATH",1069,0) + Set LIM=$Select((PREC+3)'>11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",1070,0) + For K=3:2 Do Quit:($Translate(L,"-")PI X=2*PI-X,SIGN=-1 +"RTN","TMGMATH",1095,0) + ; +"RTN","TMGMATH",1096,0) + ;;;" Set:X*211:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",1170,0) + For K=3:2 Do Quit:($Translate(L,"-")11:PREC+3,1:11),@("LIM=1E-"_LIM) +"RTN","TMGMATH",1177,0) + For K=2:2 Do Quit:($Translate(L,"-")0) do +"RTN","TMGMEDIC",56,0) + . set DoAll="Y" +"RTN","TMGMEDIC",57,0) + else do +"RTN","TMGMEDIC",58,0) + . read "Convert all files in same directory? YES// ",DoAll:$get(DTIME,3600),! +"RTN","TMGMEDIC",59,0) + if DoAll="" set DoAll="Y" +"RTN","TMGMEDIC",60,0) + set DoAll=$$UP^XLFSTR(DoAll) +"RTN","TMGMEDIC",61,0) + if DoAll["Y" do +"RTN","TMGMEDIC",62,0) + . new result +"RTN","TMGMEDIC",63,0) + . set TMGMask("*")="" +"RTN","TMGMEDIC",64,0) + . set result=$$LIST^%ZISH(JustPath,"TMGMask","TMGFiles") +"RTN","TMGMEDIC",65,0) + else do +"RTN","TMGMEDIC",66,0) + . set TMGFiles(JustFile)="" +"RTN","TMGMEDIC",67,0) + if DoAll="^" goto FDCDone +"RTN","TMGMEDIC",68,0) + +"RTN","TMGMEDIC",69,0) + for do quit:(DestDir'="") +"RTN","TMGMEDIC",70,0) + . set s="Enter DESTINATION directory to move originals file(s) into after conversion.\n Leave blank to NOT move." +"RTN","TMGMEDIC",71,0) + . new Discard +"RTN","TMGMEDIC",72,0) + . set Discard=$$GetFName^TMGIOUTL(s,JustPath_"originals/","","",.DestDir,,"Enter Directory Name (? for Help): ") +"RTN","TMGMEDIC",73,0) + . write ! +"RTN","TMGMEDIC",74,0) + . if DestDir=JustPath set DestDir=NoDestDir quit +"RTN","TMGMEDIC",75,0) + +"RTN","TMGMEDIC",76,0) + set FileName=$order(TMGFiles("")) +"RTN","TMGMEDIC",77,0) + if FileName'="" for do quit:(FileName="")!(abort=1) +"RTN","TMGMEDIC",78,0) + . new skipThis set skipThis=SkipExisting +"RTN","TMGMEDIC",79,0) + . new isDir set isDir=0 +"RTN","TMGMEDIC",80,0) + . set FullNamePath=JustPath_FileName +"RTN","TMGMEDIC",81,0) + . if $$IsDir^TMGIOUTL(FullNamePath) set skipThis=1,isDir=1 +"RTN","TMGMEDIC",82,0) + . if (skipThis=0)&(noAskSkip=0)&($$FileExists^TMGIOUTL(FullNamePath_".vista")) do quit:(abort) +"RTN","TMGMEDIC",83,0) + . . new redo +"RTN","TMGMEDIC",84,0) + . . write "File ",FullNamePath," has already been converted.",! +"RTN","TMGMEDIC",85,0) + . . read "Convert anyway? (Yes/No/Yes-Always/No-Always) (Y/N/YA/NA/^) YA// ",redo:$get(DTIME,3600),! +"RTN","TMGMEDIC",86,0) + . . set redo=$$UP^XLFSTR(redo) +"RTN","TMGMEDIC",87,0) + . . if redo="" set redo="YA" +"RTN","TMGMEDIC",88,0) + . . if redo="^" set abort=1 quit +"RTN","TMGMEDIC",89,0) + . . if redo="YA" set noAskSkip=1 +"RTN","TMGMEDIC",90,0) + . . if redo="NA" set SkipExisting=1,skipThis=1 +"RTN","TMGMEDIC",91,0) + . . if "NO"[redo set skipThis=1 +"RTN","TMGMEDIC",92,0) + . if (FullNamePath'[".vista")&(skipThis=0) do +"RTN","TMGMEDIC",93,0) + . . write !,"Converting file: ",FullNamePath,"...",! +"RTN","TMGMEDIC",94,0) + . . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",95,0) + . . set result=$$CONVDICT(FullNamePath,.OfficeLoc) +"RTN","TMGMEDIC",96,0) + . . if result'>0 do +"RTN","TMGMEDIC",97,0) + . . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error converting file.") +"RTN","TMGMEDIC",98,0) + . . . set PriorErrorFound=0 ;"clear errors, to allow reporting of future errors. +"RTN","TMGMEDIC",99,0) + . . . set ErrorFiles(FullNamePath)=1 +"RTN","TMGMEDIC",100,0) + . . . if result=-1 set abort=1 quit +"RTN","TMGMEDIC",101,0) + . . else if DestDir'=NoDestDir do +"RTN","TMGMEDIC",102,0) + . . . new Dest set Dest=DestDir_FileName +"RTN","TMGMEDIC",103,0) + . . . ;"write "Moving: ",FullNamePath,! +"RTN","TMGMEDIC",104,0) + . . . ;"write "To: ",Dest,! +"RTN","TMGMEDIC",105,0) + . . . if $$Move^TMGIOUTL(FullNamePath,Dest)=0 do +"RTN","TMGMEDIC",106,0) + . . . . write "Moved ",FileName,!," to: ",Dest,! +"RTN","TMGMEDIC",107,0) + . if (skipThis=1)&(FullNamePath'[".vista")&(isDir=0) do +"RTN","TMGMEDIC",108,0) + . . write "Skipping over file, as requested: ",FullNamePath,! +"RTN","TMGMEDIC",109,0) + . set FileName=$order(TMGFiles(FileName)) +"RTN","TMGMEDIC",110,0) + +"RTN","TMGMEDIC",111,0) + if $data(ErrorFiles) do +"RTN","TMGMEDIC",112,0) + . write !!,"The following files contained notes with errors...",! +"RTN","TMGMEDIC",113,0) + . set FileName=$order(ErrorFiles("")) +"RTN","TMGMEDIC",114,0) + . if FileName'="" for do quit:(FileName="") +"RTN","TMGMEDIC",115,0) + . . write FileName,! +"RTN","TMGMEDIC",116,0) + . . set FileName=$order(ErrorFiles(FileName)) +"RTN","TMGMEDIC",117,0) + +"RTN","TMGMEDIC",118,0) +FDCDone +"RTN","TMGMEDIC",119,0) + write !,"Goodbye.",! +"RTN","TMGMEDIC",120,0) + quit +"RTN","TMGMEDIC",121,0) + +"RTN","TMGMEDIC",122,0) + +"RTN","TMGMEDIC",123,0) +ASKCONVD +"RTN","TMGMEDIC",124,0) + ;"Purpose: To convert files created for old Medic system into format ready for +"RTN","TMGMEDIC",125,0) + ;" upload into VistA +"RTN","TMGMEDIC",126,0) + ;"Input: None (Filename will be asked) +"RTN","TMGMEDIC",127,0) + ;"Output: none (A new file will be created at same site as old file, with .vista extension +"RTN","TMGMEDIC",128,0) + ;"Result: none +"RTN","TMGMEDIC",129,0) + +"RTN","TMGMEDIC",130,0) + new FullNamePath +"RTN","TMGMEDIC",131,0) + new JustFile,JustPath +"RTN","TMGMEDIC",132,0) + new result +"RTN","TMGMEDIC",133,0) + new PriorErrorFound +"RTN","TMGMEDIC",134,0) + +"RTN","TMGMEDIC",135,0) + set FullNamePath=$$GetFName^TMGIOUTL("Please select Medic transcription file to convert","/","","",.JustPath,.JustFile) +"RTN","TMGMEDIC",136,0) + if FullNamePath="" do goto CDDone +"RTN","TMGMEDIC",137,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No file selected. Aborting") +"RTN","TMGMEDIC",138,0) + +"RTN","TMGMEDIC",139,0) + set result=$$CONVDICT(FullNamePath) +"RTN","TMGMEDIC",140,0) + +"RTN","TMGMEDIC",141,0) + write "Goodbye.",! +"RTN","TMGMEDIC",142,0) + +"RTN","TMGMEDIC",143,0) + quit +"RTN","TMGMEDIC",144,0) + +"RTN","TMGMEDIC",145,0) + +"RTN","TMGMEDIC",146,0) +CONVDICT(FullNamePath,OfficeLoc) +"RTN","TMGMEDIC",147,0) + ;"Purpose: To convert files created for old Medic system into format ready for +"RTN","TMGMEDIC",148,0) + ;" upload into VistA +"RTN","TMGMEDIC",149,0) + ;"Input: FullNamePath -- full path and filename. +"RTN","TMGMEDIC",150,0) + ;" OfficeLoc -OPTIONAL (if not provided, user may be quered for info) +"RTN","TMGMEDIC",151,0) + ;" OfficeLoc(DUZ)="Full Name of Location" +"RTN","TMGMEDIC",152,0) + ;" e.g. OfficeLoc(12)="Main_Office" +"RTN","TMGMEDIC",153,0) + ;"Output: none (A new file will be created at same site as old file, with .vista extension +"RTN","TMGMEDIC",154,0) + ;"Result: 1 if success, 0 if failure; -1 abort +"RTN","TMGMEDIC",155,0) + +"RTN","TMGMEDIC",156,0) + new JustFile,JustPath +"RTN","TMGMEDIC",157,0) + new TempFile +"RTN","TMGMEDIC",158,0) + new ResultFile +"RTN","TMGMEDIC",159,0) + new index +"RTN","TMGMEDIC",160,0) + new abort set abort=0 +"RTN","TMGMEDIC",161,0) + new result +"RTN","TMGMEDIC",162,0) + new error set error=0 +"RTN","TMGMEDIC",163,0) + new retry set retry=0 +"RTN","TMGMEDIC",164,0) + new ErrorFound set ErrorFound=0 +"RTN","TMGMEDIC",165,0) + +"RTN","TMGMEDIC",166,0) + do SplitFNamePath^TMGIOUTL(FullNamePath,.JustPath,.JustFile) +"RTN","TMGMEDIC",167,0) + +"RTN","TMGMEDIC",168,0) + if $$Dos2Unix^TMGIOUTL(FullNamePath)>0 do goto CDDone +"RTN","TMGMEDIC",169,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error while converting file ('"_FullNamePath_"') to Linux text format. Aborting") +"RTN","TMGMEDIC",170,0) + +"RTN","TMGMEDIC",171,0) +LoadFile +"RTN","TMGMEDIC",172,0) + if $$FTG^%ZISH(JustPath,JustFile,"TempFile(0)",1)=0 do goto CDDone +"RTN","TMGMEDIC",173,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error loading file. Aborting") +"RTN","TMGMEDIC",174,0) + +"RTN","TMGMEDIC",175,0) + for do quit:($data(TempFile)=0)!(abort=1) +"RTN","TMGMEDIC",176,0) + . new OneNote,NoteInfo +"RTN","TMGMEDIC",177,0) + . set error=0 +"RTN","TMGMEDIC",178,0) + . do ExtractOneNote(.TempFile,.OneNote) +"RTN","TMGMEDIC",179,0) + . if $$ConvertOneNote(.OneNote,.NoteInfo,.OfficeLoc)=0 do quit +"RTN","TMGMEDIC",180,0) + . . set ErrorFound=1 +"RTN","TMGMEDIC",181,0) + . . set PriorErrorFound=0 +"RTN","TMGMEDIC",182,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error while processing note.") +"RTN","TMGMEDIC",183,0) + . . set PriorErrorFound=0 +"RTN","TMGMEDIC",184,0) + . . write "Will run through that again, this time in verbose/debug mode",! +"RTN","TMGMEDIC",185,0) + . . set error=$$ConvertOneNote(.OneNote,.NoteInfo,.OfficeLoc,1) +"RTN","TMGMEDIC",186,0) + . . write "",! +"RTN","TMGMEDIC",187,0) + . . write "File: ",FullNamePath,! +"RTN","TMGMEDIC",188,0) + . . if $data(NoteInfo) do +"RTN","TMGMEDIC",189,0) + . . . write "Here is the Note Info that was successfully gathered:",! +"RTN","TMGMEDIC",190,0) + . . . zwr NoteInfo(*) +"RTN","TMGMEDIC",191,0) + . . new temp +"RTN","TMGMEDIC",192,0) + . . read !,"Show more info? (^ to abort) NO// ",temp:$get(DTIME,3600),! +"RTN","TMGMEDIC",193,0) + . . if $$UP^XLFSTR(temp)["Y" do +"RTN","TMGMEDIC",194,0) + . . . write "Here is the note to be processed:",! +"RTN","TMGMEDIC",195,0) + . . . zwr OneNote(*) +"RTN","TMGMEDIC",196,0) + . . . if $data(NoteInfo) do +"RTN","TMGMEDIC",197,0) + . . . . write "Here is the info that was extracted:",! +"RTN","TMGMEDIC",198,0) + . . . . zwr NoteInfo(*) +"RTN","TMGMEDIC",199,0) + . . . write !,"That was the info...",! +"RTN","TMGMEDIC",200,0) + . . . read !,"Press enter to continue (^ to abort)...",temp:$get(DTIME,3600),! +"RTN","TMGMEDIC",201,0) + . . if temp="^" set abort=1,error=1 +"RTN","TMGMEDIC",202,0) + . . write !,"File: ",FullNamePath,! +"RTN","TMGMEDIC",203,0) + . . read "Edit file? (^ to abort) NO// ",temp:$get(DTIME,3600),! +"RTN","TMGMEDIC",204,0) + . . if $$UP^XLFSTR(temp)["Y" do quit +"RTN","TMGMEDIC",205,0) + . . . do LinuxEdit^TMGEDIT("joe",$$LinuxStr^TMGSTUTL(FullNamePath)) +"RTN","TMGMEDIC",206,0) + . . . set retry=1,abort=1 +"RTN","TMGMEDIC",207,0) + . . if temp="^" set abort=1,error=1 +"RTN","TMGMEDIC",208,0) + . if error=0 do WriteOneNote(.OneNote,.NoteInfo,.ResultFile) +"RTN","TMGMEDIC",209,0) + +"RTN","TMGMEDIC",210,0) + if retry=1 do goto LoadFile +"RTN","TMGMEDIC",211,0) + . kill TempFile +"RTN","TMGMEDIC",212,0) + . set retry=0,abort=0,error=0 +"RTN","TMGMEDIC",213,0) + +"RTN","TMGMEDIC",214,0) + if abort=1 goto CDDone +"RTN","TMGMEDIC",215,0) + set index=$order(ResultFile("")) +"RTN","TMGMEDIC",216,0) + new ref set ref="ResultFile("_index_")" +"RTN","TMGMEDIC",217,0) + if $$GTF^%ZISH(ref,1,JustPath,JustFile_".vista")=0 do goto CDDone +"RTN","TMGMEDIC",218,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error saving file. Aborting") +"RTN","TMGMEDIC",219,0) + else do +"RTN","TMGMEDIC",220,0) + . write !,"File successfully written to: '",JustFile_".vista'",!! +"RTN","TMGMEDIC",221,0) + . if $$IsDir^TMGIOUTL(JustPath_"orig/") do +"RTN","TMGMEDIC",222,0) + . . if $$Move^TMGIOUTL(JustPath_JustFile,JustPath_"orig/"_JustFile)=0 do +"RTN","TMGMEDIC",223,0) + . . . write "Original file moved to: ",JustPath_"orig/",! +"RTN","TMGMEDIC",224,0) + . . else do +"RTN","TMGMEDIC",225,0) + . . . write "Unable to move file moved to: ",JustPath_"orig/",! +"RTN","TMGMEDIC",226,0) + +"RTN","TMGMEDIC",227,0) + +"RTN","TMGMEDIC",228,0) +CDDone +"RTN","TMGMEDIC",229,0) + set result='ErrorFound +"RTN","TMGMEDIC",230,0) + if abort=1 set result=-1 +"RTN","TMGMEDIC",231,0) + quit result +"RTN","TMGMEDIC",232,0) + +"RTN","TMGMEDIC",233,0) + +"RTN","TMGMEDIC",234,0) +ExtractOneNote(Array,OneNote) +"RTN","TMGMEDIC",235,0) + ;"Purpose: To extract one note from Array, and return in OneNote +"RTN","TMGMEDIC",236,0) + ;"Input: Array: PASS BY REFERENCE. This should be array holding entire transcription file +"RTN","TMGMEDIC",237,0) + ;" extracted note will be removed from Array +"RTN","TMGMEDIC",238,0) + ;" OneNote: PASS BY REFERENCE. This array will hold the extracted note. +"RTN","TMGMEDIC",239,0) + ;" Anything in OneNote array will be killed before refilling +"RTN","TMGMEDIC",240,0) + ;"Note: notes are always divided by a line that looks like this: +"RTN","TMGMEDIC",241,0) + ;" !PAT(xxxx) !DATE(xxxx) (Note: I will use !DATE as my signal, because if we use this +"RTN","TMGMEDIC",242,0) + ;" system in the future, !PAT may not be available. +"RTN","TMGMEDIC",243,0) + ;" This function will assume that Array is at the first line of the new note (i.e. no lead lines) +"RTN","TMGMEDIC",244,0) + ;" The new note will be copied from the beginning of Array until the next occurance of +"RTN","TMGMEDIC",245,0) + ;" !PAT/!DATE, or until the end of the Array. +"RTN","TMGMEDIC",246,0) + ;"Output: one note is copied into OneNote +"RTN","TMGMEDIC",247,0) + ;"Results: none +"RTN","TMGMEDIC",248,0) + +"RTN","TMGMEDIC",249,0) + new index +"RTN","TMGMEDIC",250,0) + new j +"RTN","TMGMEDIC",251,0) + new NextLine set NextLine="" +"RTN","TMGMEDIC",252,0) + kill OneNote +"RTN","TMGMEDIC",253,0) + +"RTN","TMGMEDIC",254,0) + set index=$order(Array("")) +"RTN","TMGMEDIC",255,0) + set j=0 ;"<-- Start numbering of array at 0 (because 0 header line will be killed later) +"RTN","TMGMEDIC",256,0) + if index'="" for do quit:(index="")!(NextLine["!DATE") +"RTN","TMGMEDIC",257,0) + . set OneNote(j)=$get(Array(index)) +"RTN","TMGMEDIC",258,0) + . set j=j+1 +"RTN","TMGMEDIC",259,0) + . kill Array(index) +"RTN","TMGMEDIC",260,0) + . set index=$order(Array(index)) +"RTN","TMGMEDIC",261,0) + . if index'="" set NextLine=$get(Array(index)) +"RTN","TMGMEDIC",262,0) + . else set NextLine="" +"RTN","TMGMEDIC",263,0) + +"RTN","TMGMEDIC",264,0) + quit +"RTN","TMGMEDIC",265,0) + +"RTN","TMGMEDIC",266,0) + +"RTN","TMGMEDIC",267,0) + +"RTN","TMGMEDIC",268,0) +ConvertOneNote(OneNote,NoteInfo,OfficeLoc,DebugMode) +"RTN","TMGMEDIC",269,0) + ;"Purpose: To take a note (in older MEDIC upload format) and extract information needed to make a VistA upload note +"RTN","TMGMEDIC",270,0) + ;"Input: OneNote -- PASS BY REFERENCE -- a single note to be converted. Format will be like this: +"RTN","TMGMEDIC",271,0) + ;" OneNote(0)="first line" +"RTN","TMGMEDIC",272,0) + ;" OneNote(1)="second line" +"RTN","TMGMEDIC",273,0) + ;" etc. +"RTN","TMGMEDIC",274,0) + ;" ---Content of note--- +"RTN","TMGMEDIC",275,0) + ;" !PAT(123456) !DATE(05/12/05) <--- always the first line (OneNote(0)) +"RTN","TMGMEDIC",276,0) + ;" +"RTN","TMGMEDIC",277,0) + ;" PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005 <---Date of encounter +"RTN","TMGMEDIC",278,0) + ;" CHART#: 123456[TAB]DOB: 05/06/1995 +"RTN","TMGMEDIC",279,0) + ;" +"RTN","TMGMEDIC",280,0) + ;" +"RTN","TMGMEDIC",281,0) + ;" ... +"RTN","TMGMEDIC",282,0) + ;" +"RTN","TMGMEDIC",283,0) + ;" +"RTN","TMGMEDIC",284,0) + ;" +"RTN","TMGMEDIC",285,0) + ;" PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005 +"RTN","TMGMEDIC",286,0) + ;" CHART#: 123456[TAB]DOB: 05/06/1995 +"RTN","TMGMEDIC",287,0) + ;" Page Two +"RTN","TMGMEDIC",288,0) + ;" +"RTN","TMGMEDIC",289,0) + ;" ... +"RTN","TMGMEDIC",290,0) + ;" +"RTN","TMGMEDIC",291,0) + ;" <--- end of note +"RTN","TMGMEDIC",292,0) + ;" Kevin S. Toppenberg M.D. +"RTN","TMGMEDIC",293,0) + ;" KST/kle +"RTN","TMGMEDIC",294,0) + ;" +"RTN","TMGMEDIC",295,0) + ;" +"RTN","TMGMEDIC",296,0) + ;" NoteInfo -- PASS BY REFERENCE. This is an array to return note into into, as follows: +"RTN","TMGMEDIC",297,0) + ;" NoteInfo("PATIENT")="Lastname,firstname initial" +"RTN","TMGMEDIC",298,0) + ;" NoteInfo("DOB")="5/12/05" +"RTN","TMGMEDIC",299,0) + ;" NoteInfo("AUTHOR")="Toppenberg,Kevin S" +"RTN","TMGMEDIC",300,0) + ;" NoteInfo("TRANS INITS")="kle" +"RTN","TMGMEDIC",301,0) + ;" NoteInfo("MEDIC NUMBER")=123456 +"RTN","TMGMEDIC",302,0) + ;" NoteInfo("DATE OF ENCOUNTER")="05/12/05" +"RTN","TMGMEDIC",303,0) + ;" NoteInfo("LOCATION")="Main_Office" +"RTN","TMGMEDIC",304,0) + ;" OfficeLoc -- PASS BY REFERENCE -- OPTIONAL +"RTN","TMGMEDIC",305,0) + ;" an array storing default locations for authors. See format in CONVDICT +"RTN","TMGMEDIC",306,0) + ;" If not passed, into will be looked for in^TMG( +"RTN","TMGMEDIC",307,0) + ;" Note: **First looks in file 8926 for def. office +"RTN","TMGMEDIC",308,0) + ;" DebugMode -- OPTIONAL. If value=1, then verbose info written +"RTN","TMGMEDIC",309,0) + ;"Output: Results are returned in NoteInfo. OneNote is modified to remove !PAT() and !DATE() line +"RTN","TMGMEDIC",310,0) + ;"Results: 1 if success, 0 if error +"RTN","TMGMEDIC",311,0) + ;"Note: accesses a global var: PriorErrorFound (OK if not defined) +"RTN","TMGMEDIC",312,0) + +"RTN","TMGMEDIC",313,0) + new result set result=1 +"RTN","TMGMEDIC",314,0) + Kill NoteInfo +"RTN","TMGMEDIC",315,0) + new index set index=0 +"RTN","TMGMEDIC",316,0) + new Line +"RTN","TMGMEDIC",317,0) + new Debug set Debug=$get(DebugMode,0) +"RTN","TMGMEDIC",318,0) + +"RTN","TMGMEDIC",319,0) + new HeaderLine set HeaderLine=$get(OneNote(index)) +"RTN","TMGMEDIC",320,0) + ;"kill OneNote(index) +"RTN","TMGMEDIC",321,0) + +"RTN","TMGMEDIC",322,0) + if Debug do +"RTN","TMGMEDIC",323,0) + . write !,"========================================================",! +"RTN","TMGMEDIC",324,0) + . write "Processing the following line: ",! +"RTN","TMGMEDIC",325,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",326,0) + . write HeaderLine,! +"RTN","TMGMEDIC",327,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",328,0) + . write "Expecting line to contain '!PAT [!DATE]",! +"RTN","TMGMEDIC",329,0) + . write "========================================================",! +"RTN","TMGMEDIC",330,0) + +"RTN","TMGMEDIC",331,0) + if (HeaderLine="")!((HeaderLine'["!DATE")&(HeaderLine'["!PAT")) do goto CONDone +"RTN","TMGMEDIC",332,0) + . set result=0 +"RTN","TMGMEDIC",333,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Header line not correct.") +"RTN","TMGMEDIC",334,0) + +"RTN","TMGMEDIC",335,0) + if Debug do +"RTN","TMGMEDIC",336,0) + . write "Checking header line for '!PAT(xxx)'" +"RTN","TMGMEDIC",337,0) + if HeaderLine["!PAT(" do +"RTN","TMGMEDIC",338,0) + . if Debug write "...found.",! +"RTN","TMGMEDIC",339,0) + . new s,s1,s2 +"RTN","TMGMEDIC",340,0) + . set s=$piece(HeaderLine,"!PAT(",2) +"RTN","TMGMEDIC",341,0) + . set s1=$$Trim^TMGSTUTL(s) +"RTN","TMGMEDIC",342,0) + . set s1=$piece(s,")",1) +"RTN","TMGMEDIC",343,0) + . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",344,0) + . if s1'="" do +"RTN","TMGMEDIC",345,0) + . . set NoteInfo("MEDIC NUMBER")=s1 +"RTN","TMGMEDIC",346,0) + . . if Debug write "!PAT() --> Patient number found was: ",s1,! +"RTN","TMGMEDIC",347,0) + . else write "Patient number unexpectedly not found!",! +"RTN","TMGMEDIC",348,0) + +"RTN","TMGMEDIC",349,0) + if HeaderLine["!DATE(" do +"RTN","TMGMEDIC",350,0) + . new s,s1,s2 +"RTN","TMGMEDIC",351,0) + . set s=$piece(HeaderLine,"!DATE(",2) +"RTN","TMGMEDIC",352,0) + . set s1=$piece(s,")",1) +"RTN","TMGMEDIC",353,0) + . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",354,0) + . if s1'="" do +"RTN","TMGMEDIC",355,0) + . . set NoteInfo("DATE OF ENCOUNTER")=s1 +"RTN","TMGMEDIC",356,0) + . . if Debug write "!DATE() --> Date of encounter found was: ",s1,! +"RTN","TMGMEDIC",357,0) + . else write "Date of encounter unexpectedly not found!",! +"RTN","TMGMEDIC",358,0) + +"RTN","TMGMEDIC",359,0) + set index=index+1 +"RTN","TMGMEDIC",360,0) + if $$Trim^TMGSTUTL($get(OneNote(index)))="" set index=index+1 ;"Skip any blank line +"RTN","TMGMEDIC",361,0) + ;"e.g. line-- PATIENT NAME:[TAB]Sarah P. Doe[TAB]DATE: 05/12/2005 <---Date of encounter +"RTN","TMGMEDIC",362,0) + set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",363,0) + set Line=$translate(Line,$char(9)," ") ;"convert tabs to space +"RTN","TMGMEDIC",364,0) + +"RTN","TMGMEDIC",365,0) + if Debug do +"RTN","TMGMEDIC",366,0) + . write !,"========================================================",! +"RTN","TMGMEDIC",367,0) + . write "Processing the following line: ",! +"RTN","TMGMEDIC",368,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",369,0) + . write Line,! +"RTN","TMGMEDIC",370,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",371,0) + . write "Expecting pattern line this: ",! +"RTN","TMGMEDIC",372,0) + . write "[PATIENT NAME: ]Sarah P. Doe [DATE:05/12/2005] [DOS:5/12/2005] [DOB:1/1/1920]",! +"RTN","TMGMEDIC",373,0) + . write "========================================================",! +"RTN","TMGMEDIC",374,0) + +"RTN","TMGMEDIC",375,0) + if (Line["PATIENT NAME:")!(Line["DATE:")!(Line["DOS:")!(Line["DOB:") do +"RTN","TMGMEDIC",376,0) + . new s,s1,s2 +"RTN","TMGMEDIC",377,0) + . s s="" +"RTN","TMGMEDIC",378,0) + . if (Line["PATIENT NAME:") set s=$piece(Line,"PATIENT NAME:",2) +"RTN","TMGMEDIC",379,0) + . else set s=Line +"RTN","TMGMEDIC",380,0) + . ;"if (Line'["DATE:")&(Line'["DOS:")&(Line'["DOB:") do +"RTN","TMGMEDIC",381,0) + . ;". set result=0 +"RTN","TMGMEDIC",382,0) + . ;". do ShowError^TMGDEBUG(.PriorErrorFound,"'DATE' or 'DOS' or 'DOB' not found in note header.") +"RTN","TMGMEDIC",383,0) + . ;". write "-->'",Line,"'",! +"RTN","TMGMEDIC",384,0) + . set s1="" +"RTN","TMGMEDIC",385,0) + . new doneloop set doneloop=0 +"RTN","TMGMEDIC",386,0) + . for do quit:(doneloop) +"RTN","TMGMEDIC",387,0) + . . if (s["DATE:") set s=$piece(s,"DATE:",1) quit +"RTN","TMGMEDIC",388,0) + . . if (s["DOB:") set s=$piece(s,"DOB:",1) quit +"RTN","TMGMEDIC",389,0) + . . if (s["DOS:") set s=$piece(s,"DOS:",1) quit +"RTN","TMGMEDIC",390,0) + . . set s1=$$Trim^TMGSTUTL(s) +"RTN","TMGMEDIC",391,0) + . . set s1=$$FormatName^TMGMISC(s1) +"RTN","TMGMEDIC",392,0) + . . set doneloop=1 +"RTN","TMGMEDIC",393,0) + . if s1'="" set NoteInfo("PATIENT")=s1 +"RTN","TMGMEDIC",394,0) + . if Debug write "Patient Name found was: ",s1,! +"RTN","TMGMEDIC",395,0) + . if (Line["DOB:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005' +"RTN","TMGMEDIC",396,0) + . . if Debug write "Looking at ",Line,! +"RTN","TMGMEDIC",397,0) + . . set s1=$piece(Line,"DOB:",2) +"RTN","TMGMEDIC",398,0) + . . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",399,0) + . . set s1=$piece(s1," ",1) +"RTN","TMGMEDIC",400,0) + . . set NoteInfo("DOB")=s1 +"RTN","TMGMEDIC",401,0) + . . if Debug write "Patient DOB found was: ",s1,! +"RTN","TMGMEDIC",402,0) + . if (Line["DOS:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005' +"RTN","TMGMEDIC",403,0) + . . if Debug write "Looking at ",Line,! +"RTN","TMGMEDIC",404,0) + . . set s1=$piece(Line,"DOS:",2) +"RTN","TMGMEDIC",405,0) + . . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",406,0) + . . set s1=$piece(s1," ",1) +"RTN","TMGMEDIC",407,0) + . . set NoteInfo("DATE OF ENCOUNTER")=s1 +"RTN","TMGMEDIC",408,0) + . . if Debug write "Date of Encounter: ",s1,! +"RTN","TMGMEDIC",409,0) + . if (Line["DATE:") do ;"expects date to contain NO spaces... e.g. 1/1/05, not 'Jan 1, 2005' +"RTN","TMGMEDIC",410,0) + . . if Debug write "Looking at ",Line,! +"RTN","TMGMEDIC",411,0) + . . set s1=$piece(Line,"DATE:",2) +"RTN","TMGMEDIC",412,0) + . . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",413,0) + . . set s1=$piece(s1," ",1) +"RTN","TMGMEDIC",414,0) + . . set NoteInfo("DATE OF ENCOUNTER")=s1 +"RTN","TMGMEDIC",415,0) + . . if Debug write "Date of Encounter: ",s1,! +"RTN","TMGMEDIC",416,0) + else do goto CONDone +"RTN","TMGMEDIC",417,0) + . set result=0 +"RTN","TMGMEDIC",418,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"'PATIENT NAME:' or 'DATE:' or 'DOS:' or 'DOB:' not found.") +"RTN","TMGMEDIC",419,0) + +"RTN","TMGMEDIC",420,0) + set index=index+1 +"RTN","TMGMEDIC",421,0) + if $$Trim^TMGSTUTL($get(OneNote(index)))="" set index=index+1 ;"Skip any blank line +"RTN","TMGMEDIC",422,0) + ;"e.g. line -- CHART#: 123456[TAB]DOB: 05/06/1995 +"RTN","TMGMEDIC",423,0) + set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",424,0) + set Line=$translate(Line,$char(9)," ") ;"convert tabs to space +"RTN","TMGMEDIC",425,0) + +"RTN","TMGMEDIC",426,0) + if Debug do +"RTN","TMGMEDIC",427,0) + . write !,"========================================================",! +"RTN","TMGMEDIC",428,0) + . write "Processing the following line: ",! +"RTN","TMGMEDIC",429,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",430,0) + . write Line,! +"RTN","TMGMEDIC",431,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",432,0) + . write "Expecting pattern line this: ",! +"RTN","TMGMEDIC",433,0) + . write " CHART#: 123456 DOB: 05/06/1995",! +"RTN","TMGMEDIC",434,0) + . write "(Note: This line is optional)",! +"RTN","TMGMEDIC",435,0) + . write "========================================================",! +"RTN","TMGMEDIC",436,0) + +"RTN","TMGMEDIC",437,0) + if $get(NoteInfo("MEDIC NUMBER"))="" do +"RTN","TMGMEDIC",438,0) + . if Line["CHART#:" do +"RTN","TMGMEDIC",439,0) + . . new s,s1,s2 +"RTN","TMGMEDIC",440,0) + . . set s=$piece(Line,"CHART#:",2) +"RTN","TMGMEDIC",441,0) + . . set s1=$piece(s,"DOB:",1) +"RTN","TMGMEDIC",442,0) + . . set NoteInfo("MEDIC NUMBER")=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",443,0) + . else do +"RTN","TMGMEDIC",444,0) + . . set result=0 +"RTN","TMGMEDIC",445,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"'CHART#:' not found in line.") +"RTN","TMGMEDIC",446,0) + . . write "-->'",Line,"'",! +"RTN","TMGMEDIC",447,0) + +"RTN","TMGMEDIC",448,0) + if $get(NoteInfo("DOB"))="" do if result=0 goto CONDone +"RTN","TMGMEDIC",449,0) + . if Line["DOB:" do +"RTN","TMGMEDIC",450,0) + . . new s,s1,s2 +"RTN","TMGMEDIC",451,0) + . . set s1=$piece(Line,"DOB:",2) +"RTN","TMGMEDIC",452,0) + . . set s1=$$Trim^TMGSTUTL(s1) +"RTN","TMGMEDIC",453,0) + . . if s1'="" set NoteInfo("DOB")=s1 +"RTN","TMGMEDIC",454,0) + . else do +"RTN","TMGMEDIC",455,0) + . . set result=0 +"RTN","TMGMEDIC",456,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"'DOB:' not found in line.") +"RTN","TMGMEDIC",457,0) + . . write "-->'",Line,"'",! +"RTN","TMGMEDIC",458,0) + +"RTN","TMGMEDIC",459,0) + if $get(NoteInfo("DATE OF ENCOUNTER"))="" do goto CONDone +"RTN","TMGMEDIC",460,0) + . set result=0 +"RTN","TMGMEDIC",461,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Done with header, but no Date of Encounter found.") +"RTN","TMGMEDIC",462,0) + +"RTN","TMGMEDIC",463,0) + ;"Main header processing now done. Now scan for a header for subsequent pages, and delete. +"RTN","TMGMEDIC",464,0) + if Debug write !!,"Now scanning for unneeded header info in middle of note.",! +"RTN","TMGMEDIC",465,0) + set index=index+1 +"RTN","TMGMEDIC",466,0) + for do quit:(index="") +"RTN","TMGMEDIC",467,0) + . set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",468,0) + . if Debug write "." +"RTN","TMGMEDIC",469,0) + . ;"if Debug write ">>",Line,! +"RTN","TMGMEDIC",470,0) + . if (Line["PATIENT NAME:")&(Line["DATE:") do +"RTN","TMGMEDIC",471,0) + . . if Debug do +"RTN","TMGMEDIC",472,0) + . . . write !,"Found one...",! +"RTN","TMGMEDIC",473,0) + . . . write "-->",Line,! +"RTN","TMGMEDIC",474,0) + . . kill OneNote(index) +"RTN","TMGMEDIC",475,0) + . . if $$Trim^TMGSTUTL($get(OneNote(index-1)))="" kill OneNote(index-1) +"RTN","TMGMEDIC",476,0) + . . set index=index+1 +"RTN","TMGMEDIC",477,0) + . . set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",478,0) + . . if (Line["CHART#")&(Line["DOB") kill OneNote(index) +"RTN","TMGMEDIC",479,0) + . . if Debug write "And-->",Line,! +"RTN","TMGMEDIC",480,0) + . . set index=index+1 +"RTN","TMGMEDIC",481,0) + . . set Line=$$Trim^TMGSTUTL($$UP^XLFSTR($get(OneNote(index)))) +"RTN","TMGMEDIC",482,0) + . . if ($piece(Line," ",1)="PAGE")&($piece(Line," ",3)="") do +"RTN","TMGMEDIC",483,0) + . . . if Debug write "And-->",Line,! +"RTN","TMGMEDIC",484,0) + . . . kill OneNote(index) +"RTN","TMGMEDIC",485,0) + . set index=$order(OneNote(index)) +"RTN","TMGMEDIC",486,0) + +"RTN","TMGMEDIC",487,0) + ;"Now work backwards from end of note to get transcriptionist name and author name +"RTN","TMGMEDIC",488,0) + if Debug write !!,"Now trimming blank lines from the end of the note (scanning backwards).",! +"RTN","TMGMEDIC",489,0) + ;"Trim blank lines from end of note. +"RTN","TMGMEDIC",490,0) + set index=$order(OneNote(""),-1) +"RTN","TMGMEDIC",491,0) + for do quit:(Line'="")!(+index<4) +"RTN","TMGMEDIC",492,0) + . set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",493,0) + . set Line=$translate(Line,$char(9)," ") ;"convert tabs to space +"RTN","TMGMEDIC",494,0) + . set Line=$$Trim^TMGSTUTL(Line) +"RTN","TMGMEDIC",495,0) + . ;"if Debug write ">> '",Line,"'",! +"RTN","TMGMEDIC",496,0) + . if Debug write "." +"RTN","TMGMEDIC",497,0) + . if Line="" kill OneNote(index) +"RTN","TMGMEDIC",498,0) + . set index=$order(OneNote(index),-1) +"RTN","TMGMEDIC",499,0) + +"RTN","TMGMEDIC",500,0) + if Debug write !!,"Now looking for Transcriptionist initials. (scanning backwards)",! +"RTN","TMGMEDIC",501,0) + new InitsFound set InitsFound=0 +"RTN","TMGMEDIC",502,0) + ;"Get transcriptionist initials +"RTN","TMGMEDIC",503,0) + set index=$order(OneNote(""),-1) +"RTN","TMGMEDIC",504,0) + for do quit:(InitsFound)!(index="")!(+index<4) +"RTN","TMGMEDIC",505,0) + . set Line=$get(OneNote(index)) +"RTN","TMGMEDIC",506,0) + . set Line=$translate(Line,$char(9)," ") ;"convert tabs to space +"RTN","TMGMEDIC",507,0) + . set Line=$$Trim^TMGSTUTL(Line) +"RTN","TMGMEDIC",508,0) + . ;"if Debug write ">",Line,! +"RTN","TMGMEDIC",509,0) + . if Debug write "." +"RTN","TMGMEDIC",510,0) + . if (Line["/")&($piece(Line," ",2)="") do quit +"RTN","TMGMEDIC",511,0) + . . set InitsFound=1 +"RTN","TMGMEDIC",512,0) + . . if Debug write "...found a line (#",index,") with '/' -->",Line,! +"RTN","TMGMEDIC",513,0) + . set index=$order(OneNote(index),-1) +"RTN","TMGMEDIC",514,0) + +"RTN","TMGMEDIC",515,0) + if Debug do +"RTN","TMGMEDIC",516,0) + . write !,"========================================================",! +"RTN","TMGMEDIC",517,0) + . write "Now looking for transcriptionist's name",! +"RTN","TMGMEDIC",518,0) + . write "Processing the following line: ",! +"RTN","TMGMEDIC",519,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",520,0) + . write Line,! +"RTN","TMGMEDIC",521,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",522,0) + . write "Expecting pattern: 'Author's inits/tran's inits'" +"RTN","TMGMEDIC",523,0) + . write " (with no other text on line.)",! +"RTN","TMGMEDIC",524,0) + . write " e.g. KST/abc",! +"RTN","TMGMEDIC",525,0) + . write "========================================================",! +"RTN","TMGMEDIC",526,0) + if (Line[" ")&(Debug) do +"RTN","TMGMEDIC",527,0) + . write "? trim not working?",! +"RTN","TMGMEDIC",528,0) + . write "OneNote(index)='",OneNote(index),"'",! +"RTN","TMGMEDIC",529,0) + . write "After trim, resulting Line='",Line,"'",! +"RTN","TMGMEDIC",530,0) + . write "Will try another trim.",! +"RTN","TMGMEDIC",531,0) + . set Line=$$Trim^TMGSTUTL(Line) +"RTN","TMGMEDIC",532,0) + . write "Now Line='",Line,"'",! +"RTN","TMGMEDIC",533,0) + if (Line["/")&($piece(Line," ",2)="") do +"RTN","TMGMEDIC",534,0) + . new inits +"RTN","TMGMEDIC",535,0) + . set inits=$piece(Line,"/",2) +"RTN","TMGMEDIC",536,0) + . set NoteInfo("TRANS INITS")=inits +"RTN","TMGMEDIC",537,0) + . if Debug write "...found a line with '/': ",Line,! +"RTN","TMGMEDIC",538,0) + . ;"now turn initials into full name via database lookup +"RTN","TMGMEDIC",539,0) + . set DIC=200,DIC(0)="M" +"RTN","TMGMEDIC",540,0) + . set X=inits +"RTN","TMGMEDIC",541,0) + . do ^DIC +"RTN","TMGMEDIC",542,0) + . if Y'>0 do quit +"RTN","TMGMEDIC",543,0) + . . set result=0 +"RTN","TMGMEDIC",544,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find '"_inits_"' in database.") +"RTN","TMGMEDIC",545,0) + . set NoteInfo("TRANSCRIPTIONIST")=$piece(Y,"^",2) +"RTN","TMGMEDIC",546,0) + else do goto CONDone +"RTN","TMGMEDIC",547,0) + . set result=0,PriorErrorFound=0 +"RTN","TMGMEDIC",548,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Transcriptionists initials not found") +"RTN","TMGMEDIC",549,0) + +"RTN","TMGMEDIC",550,0) + ;"Get author +"RTN","TMGMEDIC",551,0) + for do quit:(Line'="") +"RTN","TMGMEDIC",552,0) + . set index=$order(OneNote(index),-1) +"RTN","TMGMEDIC",553,0) + . set Line=$$Trim^TMGSTUTL($get(OneNote(index))) +"RTN","TMGMEDIC",554,0) + if Debug do +"RTN","TMGMEDIC",555,0) + . write !,"========================================================",! +"RTN","TMGMEDIC",556,0) + . write "Now looking for author's name",! +"RTN","TMGMEDIC",557,0) + . write "Processing the following line: ",! +"RTN","TMGMEDIC",558,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",559,0) + . write Line,! +"RTN","TMGMEDIC",560,0) + . write "--------------------------------------------------------",! +"RTN","TMGMEDIC",561,0) + . write "Expecting pattern: 'Doctor's name'",! +"RTN","TMGMEDIC",562,0) + . write "========================================================",! +"RTN","TMGMEDIC",563,0) + if Line'="" do +"RTN","TMGMEDIC",564,0) + . set Line=$$FormatName^TMGMISC(Line,1) +"RTN","TMGMEDIC",565,0) + . If Line="TOPPENBERG,M DEE" set Line="TOPPENBERG,MARCIA D" +"RTN","TMGMEDIC",566,0) + . if Line="SVENDSEN,CLAES V" set Line="SVENDSEN,CLAES U" +"RTN","TMGMEDIC",567,0) + . set NoteInfo("AUTHOR")=Line +"RTN","TMGMEDIC",568,0) + +"RTN","TMGMEDIC",569,0) + if $get(NoteInfo("DOB"))="" do goto CONDone +"RTN","TMGMEDIC",570,0) + . set result=0 +"RTN","TMGMEDIC",571,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Patient DOB not found.") +"RTN","TMGMEDIC",572,0) + +"RTN","TMGMEDIC",573,0) + ;"Ensure provider name is correct +"RTN","TMGMEDIC",574,0) + if Debug do +"RTN","TMGMEDIC",575,0) + . write "Looking up Author in VistA database to ensure it's correct.",! +"RTN","TMGMEDIC",576,0) + set DIC=200 +"RTN","TMGMEDIC",577,0) + set DIC(0)="" +"RTN","TMGMEDIC",578,0) + set X=$get(NoteInfo("AUTHOR")) +"RTN","TMGMEDIC",579,0) + do ^DIC +"RTN","TMGMEDIC",580,0) + if Y'>0 do goto CONDone +"RTN","TMGMEDIC",581,0) + . set result=0 +"RTN","TMGMEDIC",582,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Provider name in note ('"_$get(NoteInfo("AUTHOR"))_"') incorrect. Aborting") +"RTN","TMGMEDIC",583,0) + ;"Now get office location based on provider +"RTN","TMGMEDIC",584,0) + if Debug write "Found: ",Y,! +"RTN","TMGMEDIC",585,0) + new Office set Office="" +"RTN","TMGMEDIC",586,0) + new AuthDUZ +"RTN","TMGMEDIC",587,0) + set AuthDUZ=+Y +"RTN","TMGMEDIC",588,0) + new i set i=$order(^TIU(8926,"B",AuthDUZ,"")) ;"file 8926: def. office +"RTN","TMGMEDIC",589,0) + if i'="" do +"RTN","TMGMEDIC",590,0) + . new j set j=$get(TIU(8926,i,0)) +"RTN","TMGMEDIC",591,0) + . if j="" quit +"RTN","TMGMEDIC",592,0) + . new IENOffice set IENOffice=$piece(j,"^",2) +"RTN","TMGMEDIC",593,0) + . if IENOffice="" quit +"RTN","TMGMEDIC",594,0) + . set Office=$piece($get(^SC(IENOffice,0)),"^",1) +"RTN","TMGMEDIC",595,0) + if Office="" set Office=$get(OfficeLoc(AuthDUZ)) +"RTN","TMGMEDIC",596,0) + if Office="" set Office=$get(^TMG("MEDIC CONV","Office",AuthDUZ)) +"RTN","TMGMEDIC",597,0) + if Office="" do +"RTN","TMGMEDIC",598,0) + . set DIC=44 ;"HOSPITAL LOCATION +"RTN","TMGMEDIC",599,0) + . set DIC(0)="AEQ" +"RTN","TMGMEDIC",600,0) + . set X="" +"RTN","TMGMEDIC",601,0) + . set DIC("A")="Which office does "_$piece(Y,"^",2)_" work in (Type ? for list)?: " +"RTN","TMGMEDIC",602,0) + . do ^DIC +"RTN","TMGMEDIC",603,0) + . write ! +"RTN","TMGMEDIC",604,0) + . if Y>0 do +"RTN","TMGMEDIC",605,0) + . . set Office=$piece(Y,"^",2) +"RTN","TMGMEDIC",606,0) + . . set OfficeLoc(AuthDUZ)=Office +"RTN","TMGMEDIC",607,0) + . . set ^TMG("MEDIC CONV","Office",AuthDUZ)=Office +"RTN","TMGMEDIC",608,0) + if Office="" do goto CONDone +"RTN","TMGMEDIC",609,0) + . set result=0 +"RTN","TMGMEDIC",610,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't determine office location. Aborting") +"RTN","TMGMEDIC",611,0) + set NoteInfo("LOCATION")=Office +"RTN","TMGMEDIC",612,0) + +"RTN","TMGMEDIC",613,0) +CONDone +"RTN","TMGMEDIC",614,0) + quit result +"RTN","TMGMEDIC",615,0) + +"RTN","TMGMEDIC",616,0) + +"RTN","TMGMEDIC",617,0) +WriteOneNote(OneNote,NoteInfo,ResultFile) +"RTN","TMGMEDIC",618,0) + ;"Purpose: To take One note, and append to Result File, with appropriate header, based on NoteInfo +"RTN","TMGMEDIC",619,0) + ;"Input: OneNote -- PASS BY REFERENCE-- the text array to append to resulting file +"RTN","TMGMEDIC",620,0) + ;" NoteInfo -- array with note info. See format in ConvertOneNote +"RTN","TMGMEDIC",621,0) + ;" ResultFile -- PASS BY REFERENCE this is the array built to the cumulative output +"RTN","TMGMEDIC",622,0) + ;" +"RTN","TMGMEDIC",623,0) + ;" Here is the needed format for vista upload. (at our site) +"RTN","TMGMEDIC",624,0) + ;" [NewDict]: NOTE +"RTN","TMGMEDIC",625,0) + ;" Patient Name: Doe,John A +"RTN","TMGMEDIC",626,0) + ;" DOB: 08/01/0931 +"RTN","TMGMEDIC",627,0) + ;" Date of Encounter: 06/08/2005 +"RTN","TMGMEDIC",628,0) + ;" Provider: Welby,Marcus +"RTN","TMGMEDIC",629,0) + ;" Visit Location: Laughlin_Office +"RTN","TMGMEDIC",630,0) + ;" Transcriptionist: Fingers,Speedy +"RTN","TMGMEDIC",631,0) + ;" [TEXT] +"RTN","TMGMEDIC",632,0) + ;" (Here is the text of the note... +"RTN","TMGMEDIC",633,0) + ;" [END] +"RTN","TMGMEDIC",634,0) + +"RTN","TMGMEDIC",635,0) + kill OneNote(0) ;"the !PAT() !DATE etc. line +"RTN","TMGMEDIC",636,0) + +"RTN","TMGMEDIC",637,0) + set OneNote(.1)="[NewDict]: NOTE" +"RTN","TMGMEDIC",638,0) + set OneNote(.2)="Patient Name: "_$get(NoteInfo("PATIENT")) +"RTN","TMGMEDIC",639,0) + set OneNote(.3)="DOB: "_$get(NoteInfo("DOB")) +"RTN","TMGMEDIC",640,0) + set OneNote(.4)="Date of Encounter: "_$get(NoteInfo("DATE OF ENCOUNTER")) +"RTN","TMGMEDIC",641,0) + set OneNote(.5)="Provider: "_$get(NoteInfo("AUTHOR")) +"RTN","TMGMEDIC",642,0) + set OneNote(.6)="Visit Location: "_$get(NoteInfo("LOCATION")) +"RTN","TMGMEDIC",643,0) + set OneNote(.7)="Transcriptionist: "_$get(NoteInfo("TRANSCRIPTIONIST")) +"RTN","TMGMEDIC",644,0) + set OneNote(.8)="[TEXT]" +"RTN","TMGMEDIC",645,0) + +"RTN","TMGMEDIC",646,0) + new s +"RTN","TMGMEDIC",647,0) + set s=$get(NoteInfo("PATIENT")) +"RTN","TMGMEDIC",648,0) + set s=s_" on "_$get(NoteInfo("DATE OF ENCOUNTER"))_"; " +"RTN","TMGMEDIC",649,0) + set s=s_$get(NoteInfo("AUTHOR")) +"RTN","TMGMEDIC",650,0) + set s=s_" at "_$get(NoteInfo("LOCATION")) +"RTN","TMGMEDIC",651,0) + write "Done: ",s,! +"RTN","TMGMEDIC",652,0) + +"RTN","TMGMEDIC",653,0) + new index,j +"RTN","TMGMEDIC",654,0) + set index=$order(OneNote(""),-1) +"RTN","TMGMEDIC",655,0) + set index=index+1 +"RTN","TMGMEDIC",656,0) + set OneNote(index)="[END]" +"RTN","TMGMEDIC",657,0) + set OneNote(index+1)=" " +"RTN","TMGMEDIC",658,0) + +"RTN","TMGMEDIC",659,0) + ;"Now append OneNote to ResultFile +"RTN","TMGMEDIC",660,0) + set j=$order(ResultFile(""),-1)+1 +"RTN","TMGMEDIC",661,0) + set index=$order(OneNote("")) +"RTN","TMGMEDIC",662,0) + for do quit:(index="") +"RTN","TMGMEDIC",663,0) + . set ResultFile(j)=$get(OneNote(index)) +"RTN","TMGMEDIC",664,0) + . set j=j+1 +"RTN","TMGMEDIC",665,0) + . set index=$order(OneNote(index)) +"RTN","TMGMEDIC",666,0) + +"RTN","TMGMEDIC",667,0) + quit +"RTN","TMGMEDIC",668,0) + +"RTN","TMGMEDIC",669,0) + +"RTN","TMGMEDIC",670,0) +TELNET +"RTN","TMGMEDIC",671,0) + ;"Purpose: to provide ability to telnet to medic server (AIX) +"RTN","TMGMEDIC",672,0) + +"RTN","TMGMEDIC",673,0) + new HookCmd +"RTN","TMGMEDIC",674,0) + set HookCmd="telnet medic" +"RTN","TMGMEDIC",675,0) + zsystem HookCmd +"RTN","TMGMEDIC",676,0) + +"RTN","TMGMEDIC",677,0) + write !,!,"Done. Returning to VistA",! +"RTN","TMGMEDIC",678,0) + new temp read "Press Enter to Continue...",temp:$get(DTIME,3600),! +"RTN","TMGMEDIC",679,0) + +"RTN","TMGMEDIC",680,0) + quit +"RTN","TMGMGRST") +0^32^B2452596 +"RTN","TMGMGRST",1,0) +TMGMGRST ;TMG/kst/Custom version of ZTMGRSET and ZOSFGUX ;03/25/06 +"RTN","TMGMGRST",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGMGRST",3,0) + +"RTN","TMGMGRST",4,0) + ;"ZTMGRSET(INFO) & ZOSFGUX -- NON-INTERACTIVE versions of standard code. +"RTN","TMGMGRST",5,0) + ;"============================================================================= +"RTN","TMGMGRST",6,0) + ;"Kevin Toppenberg, MD 11-04 +"RTN","TMGMGRST",7,0) + ;" +"RTN","TMGMGRST",8,0) + ;"Purpose: +"RTN","TMGMGRST",9,0) + ;" +"RTN","TMGMGRST",10,0) + ;"This library will provide optional NON-INTERACTIVE versions of standard code. +"RTN","TMGMGRST",11,0) + ;" +"RTN","TMGMGRST",12,0) + ;"ZTMGRSET(INFO) +"RTN","TMGMGRST",13,0) + ;"ZOSFGUX +"RTN","TMGMGRST",14,0) + ;" +"RTN","TMGMGRST",15,0) + ;"Dependancies: +"RTN","TMGMGRST",16,0) + ;" TMGQIO +"RTN","TMGMGRST",17,0) + ;" if TMGDEBUG defined, then requires TMGDEBUG.m +"RTN","TMGMGRST",18,0) + ;"============================================================================= +"RTN","TMGMGRST",19,0) + +"RTN","TMGMGRST",20,0) +ZTMGRSET(INFO) ;SF/RWF,PUG/TOAD - SET UP THE MGR ACCOUNT FOR THE SYSTEM ;10/29/2003 10:19 +"RTN","TMGMGRST",21,0) + ;;8.0+;KERNEL;**34,36,69,94,121,127,136,191,275 (WorldVista Modified)**;JUL 10, 1995; +"RTN","TMGMGRST",22,0) + ;";;8.0;KERNEL;**34,36,69,94,121,127,136,191,275**;JUL 10, 1995; +"RTN","TMGMGRST",23,0) + ;" +"RTN","TMGMGRST",24,0) + ;"K. Toppenberg's changes made November, 2004 +"RTN","TMGMGRST",25,0) + ;" +"RTN","TMGMGRST",26,0) + ;"Input: +"RTN","TMGMGRST",27,0) + ;" Note: INFO variable is completely an OPTIONAL parameter. +"RTN","TMGMGRST",28,0) + ;" If not supplied, interactive mode used +"RTN","TMGMGRST",29,0) + ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed. +"RTN","TMGMGRST",30,0) + ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed. +"RTN","TMGMGRST",31,0) + ;" +"RTN","TMGMGRST",32,0) + ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied: +"RTN","TMGMGRST",33,0) + ;" ---------------------- +"RTN","TMGMGRST",34,0) + ;" INFO("CONTINUE") -- Should contain the answer the user would enter for question: +"RTN","TMGMGRST",35,0) + ;" "THIS MAY NOT BE THE MANAGER UCI... continue anyway?" (i.e. Y or N) +"RTN","TMGMGRST",36,0) + ;" INFO("OS") -- should have number that would be used to select OS to install (i.e. 1,2,3 etc.) +"RTN","TMGMGRST",37,0) + ;" INFO("RENAME") -- should have answer to "Rename fileman routines?" (i.e. Y or N) +"RTN","TMGMGRST",38,0) + ;" INFO("MGR-UCI,VOL") -- should have Managers UCI,VOL +"RTN","TMGMGRST",39,0) + ;" INFO("SIGNON-UCI,VOL") -- should have Sign-on UCI,VOL +"RTN","TMGMGRST",40,0) + ;" INFO("VOLUME-SET")--should have: NAME OF VOLUME SET (use same volume set as for 'Production') +"RTN","TMGMGRST",41,0) + ;" INFO("TEMP") -- should have temp directory for system +"RTN","TMGMGRST",42,0) + ;"Output: +"RTN","TMGMGRST",43,0) + ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array +"RTN","TMGMGRST",44,0) + ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out. +"RTN","TMGMGRST",45,0) + ;" INFO("TEXT","LINES")=Number of output lines +"RTN","TMGMGRST",46,0) + ;" INFO("TEXT",1)= 1st output line +"RTN","TMGMGRST",47,0) + ;" INFO("TEXT",2)= 2nd output line, etc... +"RTN","TMGMGRST",48,0) + ; +"RTN","TMGMGRST",49,0) + ; +"RTN","TMGMGRST",50,0) + +"RTN","TMGMGRST",51,0) + IF '$data(DBIndent) NEW DBIndent SET DBIndent=0 +"RTN","TMGMGRST",52,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZTMGRSET^TMGMGRST") +"RTN","TMGMGRST",53,0) + +"RTN","TMGMGRST",54,0) + N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR +"RTN","TMGMGRST",55,0) + NEW ABORT SET ABORT=0 ;//kt +"RTN","TMGMGRST",56,0) + NEW SILNTOUT SET SILNTOUT=$get(INFO("SILENT-OUTPUT"),0) ;//kt +"RTN","TMGMGRST",57,0) + NEW SILENTIN SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT +"RTN","TMGMGRST",58,0) + KILL INFO("TEXT") ;//kt +"RTN","TMGMGRST",59,0) + +"RTN","TMGMGRST",60,0) + S ZTMODE=0 +"RTN","TMGMGRST",61,0) +A +"RTN","TMGMGRST",62,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","ZTMGRSET","!","Version ",$P($T(ZTMGRSET+1),";",3)," ",$P($T(ZTMGRSET+1),";",5)) +"RTN","TMGMGRST",63,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","HELLO! I'm here to help initialize the current account.") +"RTN","TMGMGRST",64,0) + +"RTN","TMGMGRST",65,0) + ; +"RTN","TMGMGRST",66,0) + SET Y=0 ;//kt added +"RTN","TMGMGRST",67,0) + I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") +"RTN","TMGMGRST",68,0) + new CurUCI set CurUCI=Y +"RTN","TMGMGRST",69,0) + I CurUCI'["MG" DO QUIT:(ABORT=1) +"RTN","TMGMGRST",70,0) + . write !,!,"CurUCI=",CurUCI,! +"RTN","TMGMGRST",71,0) + . DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!","THIS MAY NOT BE THE MANAGER UCI.","!") +"RTN","TMGMGRST",72,0) + . DO OUTP^TMGQIO(SILNTOUT," I think it is ",CurUCI,". Should I continue anyway? N//") +"RTN","TMGMGRST",73,0) + . DO INP^TMGQIO(.X,SILENTIN,120,$GET(INFO("CONTINUE"))) +"RTN","TMGMGRST",74,0) + . IF "Yy"'[$E(X_"N") DO OUTP^TMGQIO(SILNTOUT,"QUITING.","!") SET ABORT=1 QUIT +"RTN","TMGMGRST",75,0) + ; +"RTN","TMGMGRST",76,0) + S ZTOS=$$OS() +"RTN","TMGMGRST",77,0) + I ZTOS'>0 DO OUTP^TMGQIO(SILNTOUT,"!","Can't determine the OS type. Exiting ZTMGRSET.") QUIT +"RTN","TMGMGRST",78,0) + ; +"RTN","TMGMGRST",79,0) + I ZTMODE D QUIT:(ABORT=1) +"RTN","TMGMGRST",80,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","Patch number to load: ") +"RTN","TMGMGRST",81,0) + . DO INP^TMGQIO(.PCNM,SILENTIN,,$get(INFO("PATCHNUM"))) +"RTN","TMGMGRST",82,0) + . IF (PCNM<1)!(PCNM>999) DO QUIT +"RTN","TMGMGRST",83,0) + . . DO OUTP^TMGQIO(SILNTOUT,"!","!","Need a Patch number to load. Exiting ZTMGRSET") +"RTN","TMGMGRST",84,0) + . . SET ABORT=1 +"RTN","TMGMGRST",85,0) + . S SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$C(34)_PCNM_$C(34)_"1P.E" +"RTN","TMGMGRST",86,0) + ; +"RTN","TMGMGRST",87,0) + ; +"RTN","TMGMGRST",88,0) + K ^%ZOSF("MASTER"),^("SIGNOFF") ;Remove old nodes. +"RTN","TMGMGRST",89,0) + ; +"RTN","TMGMGRST",90,0) +DOIT +"RTN","TMGMGRST",91,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","I will now rename a group of routines specific to your operating system.","!") +"RTN","TMGMGRST",92,0) + D @ZTOS +"RTN","TMGMGRST",93,0) + D ALL +"RTN","TMGMGRST",94,0) + D GLOBALS:'ZTMODE +"RTN","TMGMGRST",95,0) + ; +"RTN","TMGMGRST",96,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Completed ZTMGRSET^TMGMGRST.","!","So I guess this is 'Goodbye'.","!","!") +"RTN","TMGMGRST",97,0) + ; +"RTN","TMGMGRST",98,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZTMGRSET^TMGMGRST") +"RTN","TMGMGRST",99,0) + +"RTN","TMGMGRST",100,0) + Q +"RTN","TMGMGRST",101,0) + ; +"RTN","TMGMGRST",102,0) + ;============================================================================================== +"RTN","TMGMGRST",103,0) + ;============================================================================================== +"RTN","TMGMGRST",104,0) + ; +"RTN","TMGMGRST",105,0) +RELOAD ;Reload any patched routines +"RTN","TMGMGRST",106,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"RELOAD^TMGMGRST") +"RTN","TMGMGRST",107,0) + N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR +"RTN","TMGMGRST",108,0) + S ZTMODE=1 G A +"RTN","TMGMGRST",109,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OS^TMGMGRST") +"RTN","TMGMGRST",110,0) + Q +"RTN","TMGMGRST",111,0) + ; +"RTN","TMGMGRST",112,0) + ;============================================================================================== +"RTN","TMGMGRST",113,0) + ;============================================================================================== +"RTN","TMGMGRST",114,0) + ; +"RTN","TMGMGRST",115,0) +OS() ;Select the OS +"RTN","TMGMGRST",116,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OS^TMGMGRST") +"RTN","TMGMGRST",117,0) + N Y,X1,X +"RTN","TMGMGRST",118,0) + S U="^",SCR="I 1" F I=1:1:20 S X=$T(@I) Q:X="" S OSMAX=I +"RTN","TMGMGRST",119,0) +B +"RTN","TMGMGRST",120,0) + S Y=0,ZTOS=0 I $D(^%ZOSF("OS")) D +"RTN","TMGMGRST",121,0) + . S X1=$P(^%ZOSF("OS"),U),ZTOS=$$OSNUM +"RTN","TMGMGRST",122,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","I think you are using ",X1) +"RTN","TMGMGRST",123,0) + DO OUTP^TMGQIO(SILNTOUT,"!","Which MUMPS system should I install?","!") +"RTN","TMGMGRST",124,0) + DO OUTP^TMGQIO(SILNTOUT,"!",0," = Abort;") +"RTN","TMGMGRST",125,0) + F I=1:1:OSMAX DO OUTP^TMGQIO(SILNTOUT,"!",I," = ",$P($T(@I),";",3)) +"RTN","TMGMGRST",126,0) + DO OUTP^TMGQIO(SILNTOUT,"!","System: ") +"RTN","TMGMGRST",127,0) + IF ZTOS DO OUTP^TMGQIO(SILNTOUT,ZTOS,"//") +"RTN","TMGMGRST",128,0) + DO INP^TMGQIO(.X,SILENTIN,300,$get(INFO("OS"),U)) +"RTN","TMGMGRST",129,0) + IF X="" S X=ZTOS +"RTN","TMGMGRST",130,0) + IF (X=U)!(X=0) DO OUTP^TMGQIO(SILNTOUT,"!") SET X=0 GOTO OSQ +"RTN","TMGMGRST",131,0) + I X<1!(X>OSMAX) DO OUTP^TMGQIO(SILNTOUT,"!","NOT A VALID OS CHOICE") GOTO B +"RTN","TMGMGRST",132,0) +OSQ +"RTN","TMGMGRST",133,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OS^TMGMGRST") +"RTN","TMGMGRST",134,0) + QUIT X +"RTN","TMGMGRST",135,0) + ; +"RTN","TMGMGRST",136,0) + +"RTN","TMGMGRST",137,0) +OSNUM() ;Return the OS number +"RTN","TMGMGRST",138,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OSNUM^TMGMGRST") +"RTN","TMGMGRST",139,0) + N I,X1,X2,Y S Y=0,X1=$P($G(^%ZOSF("OS")),"^") +"RTN","TMGMGRST",140,0) + F I=1:1 S X2=$T(@I) Q:X2="" I X2[X1 S Y=I QUIT +"RTN","TMGMGRST",141,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OSNUM^TMGMGRST") +"RTN","TMGMGRST",142,0) + QUIT Y +"RTN","TMGMGRST",143,0) + ; +"RTN","TMGMGRST",144,0) + +"RTN","TMGMGRST",145,0) +ALL +"RTN","TMGMGRST",146,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ALL^TMGMGRST") +"RTN","TMGMGRST",147,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Now to load routines common to all systems.") +"RTN","TMGMGRST",148,0) + D TM,ETRAP,DEV,OTHER,FM +"RTN","TMGMGRST",149,0) + I ZTOS=7!(ZTOS=8) D +"RTN","TMGMGRST",150,0) + . S ^%ZE="D ^ZE" +"RTN","TMGMGRST",151,0) + E D ;With ZLoad, ZSave, ZInsert +"RTN","TMGMGRST",152,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Installing ^%Z editor") +"RTN","TMGMGRST",153,0) + . D ^ZTEDIT +"RTN","TMGMGRST",154,0) + I 'ZTMODE DO +"RTN","TMGMGRST",155,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Setting ^%ZIS('C')") +"RTN","TMGMGRST",156,0) + . K ^%ZIS("C") +"RTN","TMGMGRST",157,0) + . S ^%ZIS("C")="G ^%ZISC" +"RTN","TMGMGRST",158,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ALL^TMGMGRST") +"RTN","TMGMGRST",159,0) + Q +"RTN","TMGMGRST",160,0) + ; +"RTN","TMGMGRST",161,0) + +"RTN","TMGMGRST",162,0) +TM ;Taskman +"RTN","TMGMGRST",163,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"TM^TMGMGRST") +"RTN","TMGMGRST",164,0) + S %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7" +"RTN","TMGMGRST",165,0) + S %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7" +"RTN","TMGMGRST",166,0) + D MOVE +"RTN","TMGMGRST",167,0) + S %S="ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6" +"RTN","TMGMGRST",168,0) + S %D="%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6" +"RTN","TMGMGRST",169,0) + D MOVE +"RTN","TMGMGRST",170,0) + S %S="ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS5^ZTMS7^ZTMSH" +"RTN","TMGMGRST",171,0) + ;I ZTOS=7!(ZTOS=8) S $P(%S,U,1)="ZTMSGTM" +"RTN","TMGMGRST",172,0) + S %D="%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS5^%ZTMS7^%ZTMSH" +"RTN","TMGMGRST",173,0) + D MOVE +"RTN","TMGMGRST",174,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"TM^TMGMGRST") +"RTN","TMGMGRST",175,0) + Q +"RTN","TMGMGRST",176,0) + +"RTN","TMGMGRST",177,0) +FM ;Rename the FileMan routines +"RTN","TMGMGRST",178,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"FM^TMGMGRST") +"RTN","TMGMGRST",179,0) + I ZTMODE=1 GOTO FMQ ;"Only ask on full install +"RTN","TMGMGRST",180,0) + DO INP^TMGQIO(.X,SILENTIN,600,$get(INFO("RENAME"),"N"),"!","!","Want to rename the FileMan routines: No//") +"RTN","TMGMGRST",181,0) + GOTO:"Yy"'[$E(X_"N") FMQ +"RTN","TMGMGRST",182,0) + S %S="DIDT^DIDTC^DIRCR",%D="%DT^%DTC^%RCR" +"RTN","TMGMGRST",183,0) + D MOVE +"RTN","TMGMGRST",184,0) +FMQ +"RTN","TMGMGRST",185,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"FM^TMGMGRST") +"RTN","TMGMGRST",186,0) + QUIT +"RTN","TMGMGRST",187,0) + ; +"RTN","TMGMGRST",188,0) + ; +"RTN","TMGMGRST",189,0) +ETRAP ;Error Trap +"RTN","TMGMGRST",190,0) + S %S="ZTER^ZTER1",%D="%ZTER^%ZTER1" +"RTN","TMGMGRST",191,0) + D MOVE +"RTN","TMGMGRST",192,0) + Q +"RTN","TMGMGRST",193,0) + ; +"RTN","TMGMGRST",194,0) + ; +"RTN","TMGMGRST",195,0) +OTHER +"RTN","TMGMGRST",196,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"OTHER^TMGMGRST") +"RTN","TMGMGRST",197,0) + S %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE" +"RTN","TMGMGRST",198,0) + S %D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE" +"RTN","TMGMGRST",199,0) + D MOVE +"RTN","TMGMGRST",200,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"OTHER^TMGMGRST") +"RTN","TMGMGRST",201,0) + Q +"RTN","TMGMGRST",202,0) + ; +"RTN","TMGMGRST",203,0) + ; +"RTN","TMGMGRST",204,0) +DEV +"RTN","TMGMGRST",205,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"DEV^TMGMGRST") +"RTN","TMGMGRST",206,0) + S %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL" +"RTN","TMGMGRST",207,0) + S %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL" +"RTN","TMGMGRST",208,0) + D MOVE +"RTN","TMGMGRST",209,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"DEV^TMGMGRST") +"RTN","TMGMGRST",210,0) + Q +"RTN","TMGMGRST",211,0) + ; +"RTN","TMGMGRST",212,0) + ; +"RTN","TMGMGRST",213,0) +RUM ;Build the routines for Capacity Management (CM) +"RTN","TMGMGRST",214,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"RUM^TMGMGRST") +"RTN","TMGMGRST",215,0) + S %S="" +"RTN","TMGMGRST",216,0) + I ZTOS=1 S %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD" ;DSM +"RTN","TMGMGRST",217,0) + I ZTOS=2 S %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD" ;MSM +"RTN","TMGMGRST",218,0) + I ZTOS=3 S %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD" ;OpenM +"RTN","TMGMGRST",219,0) + I ZTOS=7!(ZTOS=8) S %S="ZOSVKRG^ZOSVKSGE^ZOSVKSGS^ZOSVKSD" ;GT.M +"RTN","TMGMGRST",220,0) + S %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD" +"RTN","TMGMGRST",221,0) + D MOVE +"RTN","TMGMGRST",222,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"RUM^TMGMGRST") +"RTN","TMGMGRST",223,0) + Q +"RTN","TMGMGRST",224,0) + ; +"RTN","TMGMGRST",225,0) + ; +"RTN","TMGMGRST",226,0) +ZOSF(X) ; +"RTN","TMGMGRST",227,0) + ;"Note: KT made change to this function. It used to be that it would be +"RTN","TMGMGRST",228,0) + ;" called as do ZOSF("FUNCTION"). Now it should be called like this: +"RTN","TMGMGRST",229,0) + ;" ZOSF("^FUNCTION"). The old fuction would automatically prefix +"RTN","TMGMGRST",230,0) + ;" all calls with a '^'. I took this out so that calls to functions +"RTN","TMGMGRST",231,0) + ;" contained in this module are possible. +"RTN","TMGMGRST",232,0) + ; +"RTN","TMGMGRST",233,0) + ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZOSF^TMGMGRST") +"RTN","TMGMGRST",234,0) + X SCR +"RTN","TMGMGRST",235,0) + I $T DO @(X) +"RTN","TMGMGRST",236,0) + ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZOSF^TMGMGRST") +"RTN","TMGMGRST",237,0) + Q +"RTN","TMGMGRST",238,0) + ; +"RTN","TMGMGRST",239,0) + ; +"RTN","TMGMGRST",240,0) +1 ;;VAX DSM(V6), VAX DSM(V7) +"RTN","TMGMGRST",241,0) + S %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD^ZISETVXD" +"RTN","TMGMGRST",242,0) + D DES,MOVE +"RTN","TMGMGRST",243,0) + S %S="ZOSV2VXD^ZTMDCL",%D="%ZOSV2^%ZTMDCL" +"RTN","TMGMGRST",244,0) + D MOVE,RUM,ZOSF("^ZOSFVXD") +"RTN","TMGMGRST",245,0) + Q +"RTN","TMGMGRST",246,0) + ; +"RTN","TMGMGRST",247,0) + ; +"RTN","TMGMGRST",248,0) +2 ;;MSM-PC/PLUS, MSM for NT or UNIX +"RTN","TMGMGRST",249,0) + DO OUTP^TMGQIO(SILNTOUT,"!","- Use autostart to do ZTMB don't resave as STUSER.") +"RTN","TMGMGRST",250,0) + S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM^ZISETMSM" +"RTN","TMGMGRST",251,0) + D DES,MOVE +"RTN","TMGMGRST",252,0) + S %S="ZOSV2MSM",%D="%ZOSV2" +"RTN","TMGMGRST",253,0) + D MOVE,RUM,ZOSF("^ZOSFMSM") +"RTN","TMGMGRST",254,0) + I $$VERSION^%ZOSV(1)["UNIX" S %S="ZISHMSU",%D="%ZISH" D MOVE +"RTN","TMGMGRST",255,0) + Q +"RTN","TMGMGRST",256,0) + ; +"RTN","TMGMGRST",257,0) + ; +"RTN","TMGMGRST",258,0) +3 ;;OpenM for NT, Cache/NT, Cache/VMS +"RTN","TMGMGRST",259,0) + S %S="ZOSVONT^^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT" +"RTN","TMGMGRST",260,0) + D DES,MOVE +"RTN","TMGMGRST",261,0) + S %S="ZISTCPS",%D="%ZISTCPS" +"RTN","TMGMGRST",262,0) + D MOVE,RUM,ZOSF("^ZOSFONT") +"RTN","TMGMGRST",263,0) + Q +"RTN","TMGMGRST",264,0) + ; +"RTN","TMGMGRST",265,0) + ; +"RTN","TMGMGRST",266,0) +4 ;;Datatree, DTM-PC, DT-MAX +"RTN","TMGMGRST",267,0) + S %S="ZOSVDTM^ZTBKCDTM^ZIS4DTM^ZISFDTM^ZISHDTM^XUCIDTM^ZISETDTM" +"RTN","TMGMGRST",268,0) + D DES,MOVE +"RTN","TMGMGRST",269,0) + S %S="ZOSV1DTM^ZTMB",%D="%ZOSV1^%ustart" +"RTN","TMGMGRST",270,0) + D MOVE,ZOSF("^ZOSFDTM") +"RTN","TMGMGRST",271,0) + Q +"RTN","TMGMGRST",272,0) + ; +"RTN","TMGMGRST",273,0) + ; +"RTN","TMGMGRST",274,0) +5 ;;MVX,ISM VAX +"RTN","TMGMGRST",275,0) + S %S="ZOSVMSQ^ZTBKCMSQ^ZIS4MSQ^ZISFMSQ^ZISHMSQ^XUCIMSQ^ZISETMSQ" +"RTN","TMGMGRST",276,0) + D DES,MOVE +"RTN","TMGMGRST",277,0) + S %S="ZTMB",%D="ZSTU" +"RTN","TMGMGRST",278,0) + D MOVE,ZOSF("^ZOSFMSQ") +"RTN","TMGMGRST",279,0) + Q +"RTN","TMGMGRST",280,0) + ; +"RTN","TMGMGRST",281,0) + ; +"RTN","TMGMGRST",282,0) +6 ;;ISM (UNIX, Open VMS) +"RTN","TMGMGRST",283,0) + S %S="ZOSVIS2^^ZIS4IS2^ZISFIS2^ZISHIS2^XUCIIS2^ZISETIS2" +"RTN","TMGMGRST",284,0) + D DES,MOVE +"RTN","TMGMGRST",285,0) + S %S="ZTMB",%D="ZSTU" +"RTN","TMGMGRST",286,0) + D MOVE,ZOSF("^ZOSFIS2") +"RTN","TMGMGRST",287,0) + Q +"RTN","TMGMGRST",288,0) + ; +"RTN","TMGMGRST",289,0) + ; +"RTN","TMGMGRST",290,0) +7 ;;GT.M (VMS) +"RTN","TMGMGRST",291,0) + S %S="ZOSVGTM^ZTBKCGTM^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM^ZISETGTM" +"RTN","TMGMGRST",292,0) + D DES,MOVE +"RTN","TMGMGRST",293,0) + S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS" +"RTN","TMGMGRST",294,0) + D MOVE,ZOSF("^ZOSFGTM") +"RTN","TMGMGRST",295,0) + Q +"RTN","TMGMGRST",296,0) + ; +"RTN","TMGMGRST",297,0) + ; +"RTN","TMGMGRST",298,0) +8 ;;GT.M (Unix) +"RTN","TMGMGRST",299,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"8^TMGMGRST") +"RTN","TMGMGRST",300,0) + S %S="ZOSVGUX^ZTBKCGUX^ZIS4GTM^ZISFGTM^ZISHGUX^XUCIGTM^ZISETGUX" +"RTN","TMGMGRST",301,0) + ;S %S="ZOSVGUX^ZIS4GTM^ZISFGTM^ZISHGUX^XUCIGTM" ;//kt removed 2 files that were missing +"RTN","TMGMGRST",302,0) + D DES +"RTN","TMGMGRST",303,0) + D MOVE +"RTN","TMGMGRST",304,0) + S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS" +"RTN","TMGMGRST",305,0) + D MOVE +"RTN","TMGMGRST",306,0) + D ZOSF("ZOSFGUX") +"RTN","TMGMGRST",307,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"8^TMGMGRST") +"RTN","TMGMGRST",308,0) + Q +"RTN","TMGMGRST",309,0) + ; +"RTN","TMGMGRST",310,0) + ; +"RTN","TMGMGRST",311,0) +10 ;;NOT SUPPORTED +"RTN","TMGMGRST",312,0) + Q +"RTN","TMGMGRST",313,0) + ; +"RTN","TMGMGRST",314,0) + ; +"RTN","TMGMGRST",315,0) +MOVE ; rename % routines +"RTN","TMGMGRST",316,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"MOVE^TMGMGRST") +"RTN","TMGMGRST",317,0) + N %,X,Y +"RTN","TMGMGRST",318,0) + F %=1:1:$L(%D,"^") D +"RTN","TMGMGRST",319,0) + . S X=$P(%S,U,%) ; from +"RTN","TMGMGRST",320,0) + . S Y=$P(%D,U,%) ; to +"RTN","TMGMGRST",321,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Routine: ",X) +"RTN","TMGMGRST",322,0) + . NEW INDENT SET INDENT=12-$LENGTH(X) +"RTN","TMGMGRST",323,0) + . IF INDENT>0 DO OUTP^TMGQIO(SILNTOUT,"?"_INDENT) +"RTN","TMGMGRST",324,0) + . DO OUTP^TMGQIO(SILNTOUT," --> ",Y) +"RTN","TMGMGRST",325,0) + . SET INDENT=12-$LENGTH(Y) +"RTN","TMGMGRST",326,0) + . DO OUTP^TMGQIO(SILNTOUT,"?"_INDENT) +"RTN","TMGMGRST",327,0) + . Q:(X="")!(Y="") +"RTN","TMGMGRST",328,0) + . I $TEXT(^@X)="" DO QUIT +"RTN","TMGMGRST",329,0) + . . DO OUTP^TMGQIO(SILNTOUT,"Missing") +"RTN","TMGMGRST",330,0) + . X SCR +"RTN","TMGMGRST",331,0) + . Q:'$T +"RTN","TMGMGRST",332,0) + . IF $$COPY(X,Y)=0 DO +"RTN","TMGMGRST",333,0) + . . DO OUTP^TMGQIO(SILNTOUT,"Loaded") +"RTN","TMGMGRST",334,0) + . . ;"DO OUTP^TMGQIO(SILNTOUT,"?10","Saved as ",Y) +"RTN","TMGMGRST",335,0) + . ELSE DO +"RTN","TMGMGRST",336,0) + . . DO OUTP^TMGQIO(SILNTOUT,"Missing (Failed Copy)") +"RTN","TMGMGRST",337,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"MOVE^TMGMGRST") +"RTN","TMGMGRST",338,0) + QUIT +"RTN","TMGMGRST",339,0) + ; +"RTN","TMGMGRST",340,0) + ; +"RTN","TMGMGRST",341,0) +COPY(FROM,TO) ; +"RTN","TMGMGRST",342,0) + ;"Purpose: To copy file FROM to TO, getting directory path from $ZRO +"RTN","TMGMGRST",343,0) + ;"Input: FROM-- a filename without path or '.m' extension +"RTN","TMGMGRST",344,0) + ;" TO-- a filename without path or '.m' extension +"RTN","TMGMGRST",345,0) + ;"Result: 0: no error 1=error +"RTN","TMGMGRST",346,0) + ; +"RTN","TMGMGRST",347,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"COPY^TMGMGRST") +"RTN","TMGMGRST",348,0) + NEW RESULT SET RESULT=0 +"RTN","TMGMGRST",349,0) + I ZTOS'=7,ZTOS'=8 DO GOTO CPQ +"RTN","TMGMGRST",350,0) + . X "ZL @FROM ZS @TO" +"RTN","TMGMGRST",351,0) + ; +"RTN","TMGMGRST",352,0) + ;"For GT.M below +"RTN","TMGMGRST",353,0) + ;"-------------- +"RTN","TMGMGRST",354,0) + ; +"RTN","TMGMGRST",355,0) + N PATH,COPY +"RTN","TMGMGRST",356,0) + SET FROM=$GET(FROM)_".m" +"RTN","TMGMGRST",357,0) + SET TO=$TR($GET(TO),"%","_")_".m" +"RTN","TMGMGRST",358,0) + S PATH=$$GETPATH(.FROM) +"RTN","TMGMGRST",359,0) + IF PATH="" SET RESULT=1 GOTO CPQ ;"QUIT 1 +"RTN","TMGMGRST",360,0) + IF $EXTRACT(PATH,$LENGTH(PATH))'="/" SET PATH=PATH_"/" ;"Ensure path ends in '/'. +"RTN","TMGMGRST",361,0) + S COPY=$S(ZTOS=7:"COPY",1:"cp") +"RTN","TMGMGRST",362,0) + ZSYSTEM COPY_" "_PATH_FROM_" "_PATH_TO +"RTN","TMGMGRST",363,0) + SET RESULT=$ZSYSTEM +"RTN","TMGMGRST",364,0) + ; +"RTN","TMGMGRST",365,0) + ;"IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M2") +"RTN","TMGMGRST",366,0) + ; +"RTN","TMGMGRST",367,0) + ; +"RTN","TMGMGRST",368,0) +CPQ +"RTN","TMGMGRST",369,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"COPY^TMGMGRST") +"RTN","TMGMGRST",370,0) + QUIT RESULT +"RTN","TMGMGRST",371,0) + ; +"RTN","TMGMGRST",372,0) +GETPATH(FILE) +"RTN","TMGMGRST",373,0) + ;"Note: This function is for GTM, which has a path sequence that may be searched for files. +"RTN","TMGMGRST",374,0) + ;"Purpose: To take file, and look through file path to determine which path the file +"RTN","TMGMGRST",375,0) + ;" exists in. +"RTN","TMGMGRST",376,0) + ;" e.g. if $ZRO="ObjDir1(SourceDir1 SourceDir2) ObjDir2(SourceDir3 SourceDir4)" +"RTN","TMGMGRST",377,0) + ;" then this function will look in SourceDir's 1..4 to see which one contains +"RTN","TMGMGRST",378,0) + ;" FILE. Functions will return the appropriate SourceDir +"RTN","TMGMGRST",379,0) + ;"Input:FILE: the filename to look for, with extension. e.g. "XUP.m" +"RTN","TMGMGRST",380,0) + ;"Result: Will return the source directory, e.g. /usr/local/OpenVistA/r +"RTN","TMGMGRST",381,0) + ; +"RTN","TMGMGRST",382,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GETPATH^TMGMGRST") +"RTN","TMGMGRST",383,0) + NEW LASTDIR SET LASTDIR="" +"RTN","TMGMGRST",384,0) + NEW RESULT SET RESULT="" +"RTN","TMGMGRST",385,0) + NEW PATH SET PATH="" +"RTN","TMGMGRST",386,0) + ; +"RTN","TMGMGRST",387,0) + FOR DO QUIT:(RESULT'="")!(LASTDIR="") +"RTN","TMGMGRST",388,0) + . SET LASTDIR=$$R(LASTDIR) +"RTN","TMGMGRST",389,0) + . IF LASTDIR="" QUIT +"RTN","TMGMGRST",390,0) + . ;"DO OUTP^TMGQIO(SILNTOUT,"!","Looking in: ",LASTDIR) +"RTN","TMGMGRST",391,0) + . SET PATH=LASTDIR +"RTN","TMGMGRST",392,0) + . IF $$FEXISTS(PATH,FILE) DO +"RTN","TMGMGRST",393,0) + . . SET RESULT=PATH +"RTN","TMGMGRST",394,0) + . ELSE DO +"RTN","TMGMGRST",395,0) + ; +"RTN","TMGMGRST",396,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GETPATH^TMGMGRST") +"RTN","TMGMGRST",397,0) + QUIT RESULT +"RTN","TMGMGRST",398,0) + ; +"RTN","TMGMGRST",399,0) + ; +"RTN","TMGMGRST",400,0) +R(LASTDIR) ; routine directory for GT.M +"RTN","TMGMGRST",401,0) + ;"Notice: The comments here only apply to GTM for Linux (#8). +"RTN","TMGMGRST",402,0) + ;" I don't have details about GT.M for VMS (#7) so I have not implemented +"RTN","TMGMGRST",403,0) + ;" cyclic directory evaluation. LASTDIR will be ignored. +"RTN","TMGMGRST",404,0) + ;"INPUT: LASTDIR - OPTIONAL. This is the directory returned last time fuction called, to +"RTN","TMGMGRST",405,0) + ;" allow for cycling through all possible directories. +"RTN","TMGMGRST",406,0) + ;"NOTE: The Syntax for $ZRO is as follows: +"RTN","TMGMGRST",407,0) + ;" ObjectDir1(SourceDir1) ObjectDir2(SourceDir1 SourceDir2 ...) ObjectDir3() ObjectDir4 +"RTN","TMGMGRST",408,0) + ;" This shows elements are separated by spaces. +"RTN","TMGMGRST",409,0) + ;" Note that each element starts with the directory for .o files +"RTN","TMGMGRST",410,0) + ;" Each object directory has an optional (SourceDir) immediately following it +"RTN","TMGMGRST",411,0) + ;" if (Dir) is present, it contains one or more source directories (separated by spaces) +"RTN","TMGMGRST",412,0) + ;" if () is empty (i.e. "()") then no source directory is available. +"RTN","TMGMGRST",413,0) + ;" if (Dir) is absent (i.e. ""), then object dir is used to search for source .m files +"RTN","TMGMGRST",414,0) + ;"Result: will return the next directory, or "" if none. +"RTN","TMGMGRST",415,0) + ;" +"RTN","TMGMGRST",416,0) + ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"R^TMGMGRST") +"RTN","TMGMGRST",417,0) + NEW RESULT SET RESULT="" +"RTN","TMGMGRST",418,0) + SET LASTDIR=$GET(LASTDIR) +"RTN","TMGMGRST",419,0) + ;"if LASTDIR'="" W "Will look for dir AFTER ",LASTDIR,! +"RTN","TMGMGRST",420,0) + I ZTOS=7 DO +"RTN","TMGMGRST",421,0) + . SET RESULT=$P($ZRO,",",1) +"RTN","TMGMGRST",422,0) + IF ZTOS=8 DO ;"GT.M for Linux +"RTN","TMGMGRST",423,0) + . NEW SECTION +"RTN","TMGMGRST",424,0) + . NEW PRIORFND SET PRIORFND=0 +"RTN","TMGMGRST",425,0) + . NEW ELEMENT SET ELEMENT=" " +"RTN","TMGMGRST",426,0) + . NEW DIVPTS ;"Array to hold cut points of $ZRO. Setup in GETSECTN +"RTN","TMGMGRST",427,0) + . SET DIVPTS("MAX")=0 +"RTN","TMGMGRST",428,0) + . FOR SECTION=1:1 DO QUIT:(RESULT'="")!(SECTION>DIVPTS("MAX")+1) +"RTN","TMGMGRST",429,0) + . . SET ELEMENT=$$GETSECTN($ZRO,SECTION,.DIVPTS) ;"gets 'ObjDir(SrceDir1 SrceDir2 ...)' etc. +"RTN","TMGMGRST",430,0) + . . NEW SOURCES SET SOURCES="" +"RTN","TMGMGRST",431,0) + . . IF (ELEMENT["(")&(ELEMENT[")") DO +"RTN","TMGMGRST",432,0) + . . . SET SOURCES=$PIECE(ELEMENT,"(",2) +"RTN","TMGMGRST",433,0) + . . . SET SOURCES=$PIECE(SOURCES,")",1) ;"Get just (..) part -- the source file paths. +"RTN","TMGMGRST",434,0) + . . ELSE DO +"RTN","TMGMGRST",435,0) + . . . SET SOURCES=ELEMENT ;"i.e. for ObjectDir [i.e. not ObjectDir()] format. +"RTN","TMGMGRST",436,0) + . . IF (ELEMENT="")!(SOURCES="") QUIT +"RTN","TMGMGRST",437,0) + . . NEW PART +"RTN","TMGMGRST",438,0) + . . NEW PATH SET PATH=" " +"RTN","TMGMGRST",439,0) + . . FOR PART=1:1 DO QUIT:(RESULT'="")!(PATH="") +"RTN","TMGMGRST",440,0) + . . . SET PATH=$PIECE(SOURCES," ",PART) ;"returns 'SourceDir1' etc. +"RTN","TMGMGRST",441,0) + . . . IF PATH="" QUIT +"RTN","TMGMGRST",442,0) + . . . IF (LASTDIR="")!(PRIORFND) SET RESULT=PATH +"RTN","TMGMGRST",443,0) + . . . ELSE IF PATH=LASTDIR SET PRIORFND=1 +"RTN","TMGMGRST",444,0) + ; +"RTN","TMGMGRST",445,0) + ;"OLDER CODE +"RTN","TMGMGRST",446,0) + ;". NEW temp +"RTN","TMGMGRST",447,0) + ;". SET temp=$ZRO +"RTN","TMGMGRST",448,0) + ;". IF $ZRO["(" DO +"RTN","TMGMGRST",449,0) + ;". SET temp=$P($ZRO,"(",2) +"RTN","TMGMGRST",450,0) + ;". SET temp=$P(temp,")",1) +"RTN","TMGMGRST",451,0) + ;". SET RESULT=$P(temp," ",1)_"/" +"RTN","TMGMGRST",452,0) + ; +"RTN","TMGMGRST",453,0) + ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"R^TMGMGRST") +"RTN","TMGMGRST",454,0) + +"RTN","TMGMGRST",455,0) + QUIT RESULT +"RTN","TMGMGRST",456,0) + ; +"RTN","TMGMGRST",457,0) + ; +"RTN","TMGMGRST",458,0) +GETSECTN(S,NUM,DIVPTS) +"RTN","TMGMGRST",459,0) + ;"Purpose: To parse a string as follows: +"RTN","TMGMGRST",460,0) + ;" Expected format of S: +"RTN","TMGMGRST",461,0) + ;" ObjectDir(SourceDir1 SourceDir2 ...) ObjectDir2(SourceDir1 SourceDir2 ...) ... +"RTN","TMGMGRST",462,0) + ;" or ObjectDir ObjectDir2(SourceDir1 SourceDir2 ...) ObjectDir() ... etc. +"RTN","TMGMGRST",463,0) + ;" --- so major sections are divided by spaces, with optional () with optional contents. +"RTN","TMGMGRST",464,0) + ;" --- there is no nesting of parentheses. +"RTN","TMGMGRST",465,0) + ;" If NUM=1, return ObjectDir(SourceDir1 SourceDir2 ...) +"RTN","TMGMGRST",466,0) + ;" If NUM=2, return ObjectDir2(SourceDir1 SourceDir2 ...) etc. +"RTN","TMGMGRST",467,0) + ;" Notice: Spaces in ObjectDir name are NOT SUPPORTED +"RTN","TMGMGRST",468,0) + ;" Notice: If more than one space separates sections, will be treated as extra section +"RTN","TMGMGRST",469,0) + ;"INPUT: S -- string as above +"RTN","TMGMGRST",470,0) + ;" NUM -- the section number to get (1..n) +"RTN","TMGMGRST",471,0) + ;" DIVPTS -- [OPTIONAL] PASS BY REFERENCE. If empty, then will be filled +"RTN","TMGMGRST",472,0) + ;" with the indexes of the dividing spaces +"RTN","TMGMGRST",473,0) + ;" e.g. DIVPTS(1)=12 DIVPTS(2)=25 DIVPTS(3)=41 DIVPTS("MAX")=3 +"RTN","TMGMGRST",474,0) + ;" If not empty, then this will be used return the requested section. +"RTN","TMGMGRST",475,0) + ; +"RTN","TMGMGRST",476,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GETSECTN^TMGMGRST") +"RTN","TMGMGRST",477,0) + ; +"RTN","TMGMGRST",478,0) + NEW RESULT SET RESULT="" +"RTN","TMGMGRST",479,0) + NEW START SET START=0 +"RTN","TMGMGRST",480,0) + NEW END SET END=9999 +"RTN","TMGMGRST",481,0) + NEW PTIDX SET PTIDX=0 +"RTN","TMGMGRST",482,0) + NEW SECTION SET SECTION=0 +"RTN","TMGMGRST",483,0) + NEW MAXIDX +"RTN","TMGMGRST",484,0) + ; +"RTN","TMGMGRST",485,0) + SET S=$GET(S) +"RTN","TMGMGRST",486,0) + SET NUM=$GET(NUM,0) +"RTN","TMGMGRST",487,0) + ; +"RTN","TMGMGRST",488,0) + ;Fill Array of division points if empty +"RTN","TMGMGRST",489,0) + IF $DATA(DIVPTS)'=11 DO +"RTN","TMGMGRST",490,0) + . NEW INPAREN SET INPAREN=0 +"RTN","TMGMGRST",491,0) + . NEW I,CH +"RTN","TMGMGRST",492,0) + . FOR I=1:1:$LENGTH(S) DO +"RTN","TMGMGRST",493,0) + . . SET CH=$EXTRACT(S,I) +"RTN","TMGMGRST",494,0) + . . IF CH="(" SET INPAREN=1 QUIT +"RTN","TMGMGRST",495,0) + . . IF CH=")" SET INPAREN=0 QUIT +"RTN","TMGMGRST",496,0) + . . IF (CH=" ")&(INPAREN=0) DO +"RTN","TMGMGRST",497,0) + . . . SET PTIDX=PTIDX+1 +"RTN","TMGMGRST",498,0) + . . . SET DIVPTS(PTIDX)=I +"RTN","TMGMGRST",499,0) + . . . SET DIVPTS("MAX")=PTIDX +"RTN","TMGMGRST",500,0) + ; +"RTN","TMGMGRST",501,0) + IF (NUM>0)&(NUM'>DIVPTS("MAX")+1) DO +"RTN","TMGMGRST",502,0) + . SET PTIDX=$ORDER(DIVPTS(0)) +"RTN","TMGMGRST",503,0) + . ;" 1 2 3 <-- Section #'2 +"RTN","TMGMGRST",504,0) + . ;"xxxxx xxxxxx xxxxx <-- sample S +"RTN","TMGMGRST",505,0) + . ;" ^ ^ <-- DIVPTS 1 & 2 +"RTN","TMGMGRST",506,0) + . IF NUM>1 SET START=DIVPTS(NUM-1)+1 ;"default START=0 +"RTN","TMGMGRST",507,0) + . IF NUM'>DIVPTS("MAX") SET END=DIVPTS(NUM)-1 ;"default END=9999 +"RTN","TMGMGRST",508,0) + . SET RESULT=$EXTRACT(S,START,END) +"RTN","TMGMGRST",509,0) + ; +"RTN","TMGMGRST",510,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GETSECTN^TMGMGRST") +"RTN","TMGMGRST",511,0) + QUIT RESULT +"RTN","TMGMGRST",512,0) + ; +"RTN","TMGMGRST",513,0) + ; +"RTN","TMGMGRST",514,0) +FEXISTS(PATH,FNAME) +"RTN","TMGMGRST",515,0) + ;"Purpose: To determine if file FNAME exists on HFS +"RTN","TMGMGRST",516,0) + ;"Input: PATH: full path up to, but not including, filename. e.g. '/home/user/' +"RTN","TMGMGRST",517,0) + ;" FNAME: name of the file to open. e.g. 'myfile.txt' +"RTN","TMGMGRST",518,0) + ;"Result: 1=file exists, 0=file doesn't exist +"RTN","TMGMGRST",519,0) + ;"IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"FEXISTS^TMGMGRST") +"RTN","TMGMGRST",520,0) + NEW RESULT SET RESULT=0 +"RTN","TMGMGRST",521,0) + IF ($DATA(PATH)'=0)!($DATA(FNAME)'=0) DO +"RTN","TMGMGRST",522,0) + . NEW HANDLE SET HANDLE="" +"RTN","TMGMGRST",523,0) + . DO OPEN^%ZISH(HANDLE,PATH,FNAME,"R") ;"Try to access file +"RTN","TMGMGRST",524,0) + . IF POP=0 DO ;"POP=0 means file opened, ergo file exists. +"RTN","TMGMGRST",525,0) + . . SET RESULT=1 +"RTN","TMGMGRST",526,0) + . . DO CLOSE^%ZISH(HANDLE) ;"close file... we don't need it. +"RTN","TMGMGRST",527,0) + ;"IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"FEXISTS^TMGMGRST") +"RTN","TMGMGRST",528,0) + QUIT RESULT +"RTN","TMGMGRST",529,0) + ; +"RTN","TMGMGRST",530,0) + ; +"RTN","TMGMGRST",531,0) +SPLITF(IN,PATH,FNAME,NODEDIV) +"RTN","TMGMGRST",532,0) + ;"Purpose: To take a string with path and filename and +"RTN","TMGMGRST",533,0) + ;" cleave into a path string and a filename string +"RTN","TMGMGRST",534,0) + ;"Input: IN: Initial string to parse. e.g. /home/user1/somefile.txt +"RTN","TMGMGRST",535,0) + ;" PATH & FNAME: vars SHOULD BE PASSED BY REFERENCE -- to take out results +"RTN","TMGMGRST",536,0) + ;" The character used to divide nodes, e.g. '/' OPTIONAL .. defaults to '/' +"RTN","TMGMGRST",537,0) + ;"Output:PATH: the path part of IN, e.g. '/home/user1/' +"RTN","TMGMGRST",538,0) + ;" FNAME: the filename part of IN, e.g. 'somefile.txt' +"RTN","TMGMGRST",539,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"SPLITF^TMGMGRST") +"RTN","TMGMGRST",540,0) + SET NODEDIV=$GET(NODEDIV,"/") +"RTN","TMGMGRST",541,0) + SET PATH=$GET(PATH) +"RTN","TMGMGRST",542,0) + SET FNAME=$GET(IN) +"RTN","TMGMGRST",543,0) + NEW DONE SET DONE=0 +"RTN","TMGMGRST",544,0) + FOR DO QUIT:(DONE=1) +"RTN","TMGMGRST",545,0) + IF FNAME[NODEDIV DO +"RTN","TMGMGRST",546,0) + . SET PATH=PATH_$PIECE(FNAME,NODEDIV,1)_NODEDIV +"RTN","TMGMGRST",547,0) + . SET FNAME=$PIECE(FNAME,NODEDIV,2,256) +"RTN","TMGMGRST",548,0) + ELSE SET DONE=1 +"RTN","TMGMGRST",549,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"SPLITF^TMGMGRST") +"RTN","TMGMGRST",550,0) + QUIT +"RTN","TMGMGRST",551,0) + ; +"RTN","TMGMGRST",552,0) + ; +"RTN","TMGMGRST",553,0) +DES +"RTN","TMGMGRST",554,0) + S %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI^ZISETUP" +"RTN","TMGMGRST",555,0) + Q +"RTN","TMGMGRST",556,0) + ; +"RTN","TMGMGRST",557,0) + ; +"RTN","TMGMGRST",558,0) +GLOBALS ;Set node zero of file #3.05 & #3.07 +"RTN","TMGMGRST",559,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"GLOBALS^TMGMGRST") +"RTN","TMGMGRST",560,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","Now, I will check your % globals.") +"RTN","TMGMGRST",561,0) + DO OUTP^TMGQIO(SILNTOUT,"..........") +"RTN","TMGMGRST",562,0) + F %="^%ZIS","^%ZISL","^%ZTER","^%ZUA" S:'$D(@%) @%="" +"RTN","TMGMGRST",563,0) + S:$D(^%ZTSK(0))[0 ^%ZTSK(-1)=100,^%ZTSCH="" +"RTN","TMGMGRST",564,0) + S Z1=$G(^%ZTSK(-1),-1),Z2=$G(^%ZTSK(0)) +"RTN","TMGMGRST",565,0) + I Z1'=$P(Z2,"^",3) S:Z1'>0 ^%ZTSK(-1)=+Z2 S ^%ZTSK(0)="TASK'S^14.4^"_^%ZTSK(-1) +"RTN","TMGMGRST",566,0) + S:$D(^%ZUA(3.05,0))[0 ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^" +"RTN","TMGMGRST",567,0) + S:$D(^%ZUA(3.07,0))[0 ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^" +"RTN","TMGMGRST",568,0) + DO OUTP^TMGQIO(SILNTOUT,"... Done") +"RTN","TMGMGRST",569,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"GLOBALS^TMGMGRST") +"RTN","TMGMGRST",570,0) + Q +"RTN","TMGMGRST",571,0) + ; +"RTN","TMGMGRST",572,0) + ; +"RTN","TMGMGRST",573,0) +NAME() ;Setup the static names for this system +"RTN","TMGMGRST",574,0) + ;"Input -- none +"RTN","TMGMGRST",575,0) + ;"Result -- 0=normal exit 1=error +"RTN","TMGMGRST",576,0) + ; +"RTN","TMGMGRST",577,0) + ;"WRITE "IN CUSTOM NAME FUNCTION",! +"RTN","TMGMGRST",578,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"NAME^TMGMGRST") +"RTN","TMGMGRST",579,0) + ; +"RTN","TMGMGRST",580,0) + NEW RETRY SET RETRY=0 +"RTN","TMGMGRST",581,0) + NEW ABORT SET ABORT=0 +"RTN","TMGMGRST",582,0) + NEW RESULT SET RESULT=1 +"RTN","TMGMGRST",583,0) + ; +"RTN","TMGMGRST",584,0) +MGR +"RTN","TMGMGRST",585,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M1") +"RTN","TMGMGRST",586,0) + +"RTN","TMGMGRST",587,0) + IF ABORT=1 GOTO NMQ +"RTN","TMGMGRST",588,0) + SET RETRY=0 +"RTN","TMGMGRST",589,0) + DO OUTP^TMGQIO(SILNTOUT,"!","!","ENTER NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// ") +"RTN","TMGMGRST",590,0) + DO INP^TMGQIO(.X,SILENTIN,$G(DTIME,9999),$get(INFO("MGR-UCI,VOL"))) +"RTN","TMGMGRST",591,0) + IF X="" SET X=^%ZOSF("MGR") +"RTN","TMGMGRST",592,0) + IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ +"RTN","TMGMGRST",593,0) + I X]"" DO IF (RETRY=1) goto MGR +"RTN","TMGMGRST",594,0) + . X ^("UCICHECK") +"RTN","TMGMGRST",595,0) + . IF 0[Y DO +"RTN","TMGMGRST",596,0) + . . SET RETRY=1 +"RTN","TMGMGRST",597,0) + . . IF SILENTIN=1 DO +"RTN","TMGMGRST",598,0) + . . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid Manager's UCI,VOLUME SET") +"RTN","TMGMGRST",599,0) + . . . SET ABORT=1 +"RTN","TMGMGRST",600,0) + S ^%ZOSF("MGR")=X +"RTN","TMGMGRST",601,0) + ; +"RTN","TMGMGRST",602,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M2") +"RTN","TMGMGRST",603,0) + ; +"RTN","TMGMGRST",604,0) +PROD +"RTN","TMGMGRST",605,0) + IF ABORT=1 GOTO NMQ +"RTN","TMGMGRST",606,0) + SET RETRY=0 +"RTN","TMGMGRST",607,0) + DO OUTP^TMGQIO(SILNTOUT,"!","ENTER PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// ") +"RTN","TMGMGRST",608,0) + DO INP^TMGQIO(.X,SILENTIN,$S($G(DTIME):DTIME,1:9999),$get(INFO("SIGNON-UCI,VOL"))) +"RTN","TMGMGRST",609,0) + IF X="" SET X=^%ZOSF("PROD") +"RTN","TMGMGRST",610,0) + IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ +"RTN","TMGMGRST",611,0) + I X]"" DO IF (RETRY=1) goto PROD +"RTN","TMGMGRST",612,0) + . X ^("UCICHECK") +"RTN","TMGMGRST",613,0) + . IF 0[Y DO +"RTN","TMGMGRST",614,0) + . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid Sign-On UCI,VOLUME SET","!") +"RTN","TMGMGRST",615,0) + . . SET RETRY=1 +"RTN","TMGMGRST",616,0) + . . IF SILENTIN=1 SET ABORT=1 +"RTN","TMGMGRST",617,0) + S ^%ZOSF("PROD")=X +"RTN","TMGMGRST",618,0) + ; +"RTN","TMGMGRST",619,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M3") +"RTN","TMGMGRST",620,0) + ; +"RTN","TMGMGRST",621,0) +VOL +"RTN","TMGMGRST",622,0) + IF ABORT=1 GOTO NMQ +"RTN","TMGMGRST",623,0) + SET RETRY=0 +"RTN","TMGMGRST",624,0) + DO OUTP^TMGQIO(SILNTOUT,"!","ENTER NAME OF VOLUME SET (use same volume set as for 'Production'): "_^%ZOSF("VOL")_"//") +"RTN","TMGMGRST",625,0) + DO INP^TMGQIO(.X,SILENTIN,$G(DTIME,9999),$get(INFO("VOLUME-SET"))) +"RTN","TMGMGRST",626,0) + IF X="" SET X=^%ZOSF("VOL") +"RTN","TMGMGRST",627,0) + IF X="^" DO OUTP^TMGQIO(SILNTOUT,"!","SKIPPING...") GOTO NMQ +"RTN","TMGMGRST",628,0) + I X]"" DO IF (RETRY=1) goto VOL +"RTN","TMGMGRST",629,0) + . IF (X'?3U)!(^%ZOSF("PROD")'[X) DO +"RTN","TMGMGRST",630,0) + . . DO OUTP^TMGQIO(SILNTOUT,"MUST be 3 upper-case letters.") +"RTN","TMGMGRST",631,0) + . . DO OUTP^TMGQIO(SILNTOUT,"Also, MUST be same Volume Set entered above.") +"RTN","TMGMGRST",632,0) + . . SET RETRY=1 +"RTN","TMGMGRST",633,0) + . . IF SILENTIN=1 DO +"RTN","TMGMGRST",634,0) + . . . DO OUTP^TMGQIO(SILNTOUT,"!","Invalid VOLUME SET") +"RTN","TMGMGRST",635,0) + . . . SET ABORT=1 +"RTN","TMGMGRST",636,0) + SET ^%ZOSF("VOL")=X +"RTN","TMGMGRST",637,0) + ; +"RTN","TMGMGRST",638,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M4") +"RTN","TMGMGRST",639,0) + ; +"RTN","TMGMGRST",640,0) + ;"KT copied/modified TMP section from ZOSFGUX (GT.M/Linux specific) +"RTN","TMGMGRST",641,0) +TMP ;Get the temp directory +"RTN","TMGMGRST",642,0) + IF ABORT=1 GOTO NMQ +"RTN","TMGMGRST",643,0) + IF $GET(ZTOS)=8 DO GOTO TMP:(RETRY=1) +"RTN","TMGMGRST",644,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Enter the temp directory for the system: '"_^%ZOSF("TMP")_"'//") +"RTN","TMGMGRST",645,0) + . DO INP^TMGQIO(.X,SILENTIN,$S($G(DTIME):DTIME,1:9999),$get(INFO("TEMP"))) +"RTN","TMGMGRST",646,0) + . IF X="" SET X=^%ZOSF("TMP") +"RTN","TMGMGRST",647,0) + . IF SILENTIN=0 SET ABORT=1 QUIT +"RTN","TMGMGRST",648,0) + . ELSE DO QUIT:(RETRY=1)!(ABORT=1) +"RTN","TMGMGRST",649,0) + . . IF X="" SET ABORT=1 DO OUTP^TMGQIO(SILNTOUT,"SKIPPING...") QUIT +"RTN","TMGMGRST",650,0) + . . IF X'?1"/".E SET RETRY=1 QUIT +"RTN","TMGMGRST",651,0) + . S ^%ZOSF("TMP")=X +"RTN","TMGMGRST",652,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","^%ZOSF setup") +"RTN","TMGMGRST",653,0) + +"RTN","TMGMGRST",654,0) + DO OUTP^TMGQIO(SILNTOUT,"!") +"RTN","TMGMGRST",655,0) + SET RESULT=0 +"RTN","TMGMGRST",656,0) + +"RTN","TMGMGRST",657,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBIndent,"M5") +"RTN","TMGMGRST",658,0) + +"RTN","TMGMGRST",659,0) +NMQ +"RTN","TMGMGRST",660,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"NAME^TMGMGRST") +"RTN","TMGMGRST",661,0) + QUIT RESULT +"RTN","TMGMGRST",662,0) + ; +"RTN","TMGMGRST",663,0) + ; +"RTN","TMGMGRST",664,0) + ;"===================================================================================== +"RTN","TMGMGRST",665,0) + ;"===================================================================================== +"RTN","TMGMGRST",666,0) + ;"===================================================================================== +"RTN","TMGMGRST",667,0) + ;"Note: ZOSFGUX used to be a separate file. I included it here for modification. +"RTN","TMGMGRST",668,0) + +"RTN","TMGMGRST",669,0) +ZOSFGUX ;SFISC/MVB,PUG/TOAD - ZOSF Table for GT.M for Unix ;10 Feb 2003 6:37 pm +"RTN","TMGMGRST",670,0) + ;;8.0;KERNEL;**275**;Jul 10, 1995 +"RTN","TMGMGRST",671,0) + ;; for GT.M for Unix, version 4.3 +"RTN","TMGMGRST",672,0) + ; +"RTN","TMGMGRST",673,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBIndent,"ZOSFGUX^TMGMGRST") +"RTN","TMGMGRST",674,0) + S %Y=1 +"RTN","TMGMGRST",675,0) + S DTIME=$G(DTIME,600) +"RTN","TMGMGRST",676,0) + K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") +"RTN","TMGMGRST",677,0) + I $get(^%ZOSF("VOL"))="" S ^%ZOSF("VOL")="ROU" +"RTN","TMGMGRST",678,0) + ;"I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")="ROU" +"RTN","TMGMGRST",679,0) + K ZO +"RTN","TMGMGRST",680,0) + F I="MGR","PROD","VOL","TMP" DO +"RTN","TMGMGRST",681,0) + . IF $D(^%ZOSF(I)) SET ZO(I)=^%ZOSF(I) +"RTN","TMGMGRST",682,0) + F I=1:2 DO QUIT:Z="" +"RTN","TMGMGRST",683,0) + . S Z=$P($TEXT(Z+I),";;",2) +"RTN","TMGMGRST",684,0) + . Q:Z="" +"RTN","TMGMGRST",685,0) + . S X=$P($TEXT(Z+1+I),";;",2,99) +"RTN","TMGMGRST",686,0) + . IF Z="OS" S $P(^%ZOSF(Z),"^")=X +"RTN","TMGMGRST",687,0) + . IF Z'="OS" S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X) +"RTN","TMGMGRST",688,0) + ; +"RTN","TMGMGRST",689,0) +OS2 ;"was OS when this was a separate file. +"RTN","TMGMGRST",690,0) + S ^%ZOSF("OS")="GT.M (Unix)^19" +"RTN","TMGMGRST",691,0) + ; +"RTN","TMGMGRST",692,0) + ; +"RTN","TMGMGRST",693,0) + ;"I (KT) found the original code for Prod,Vol etc to be same as the NAME function in ZTMGRSET, so +"RTN","TMGMGRST",694,0) + ;" I'll just use the modifications already made there. I will add the TMP part to NAME() +"RTN","TMGMGRST",695,0) + IF $$NAME()=1 GOTO ZXQUIT ;"Note, I'm not here making note error returned (doesn't do anything) +"RTN","TMGMGRST",696,0) + +"RTN","TMGMGRST",697,0) +ZXQUIT +"RTN","TMGMGRST",698,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBIndent,"ZOSFGUX^TMGMGRST") +"RTN","TMGMGRST",699,0) + ;"write "LEAVING CUSTOM ZOSF",! +"RTN","TMGMGRST",700,0) + Q +"RTN","TMGMGRST",701,0) + ; +"RTN","TMGMGRST",702,0) + ; +"RTN","TMGMGRST",703,0) +Z ; +"RTN","TMGMGRST",704,0) + ;;ACTJ +"RTN","TMGMGRST",705,0) + ;;S Y=$$ACTJ^%ZOSV() +"RTN","TMGMGRST",706,0) + ;;AVJ +"RTN","TMGMGRST",707,0) + ;;S Y=$$AVJ^%ZOSV() +"RTN","TMGMGRST",708,0) + ;;BRK +"RTN","TMGMGRST",709,0) + ;;U $I:(CENABLE) +"RTN","TMGMGRST",710,0) + ;;DEL +"RTN","TMGMGRST",711,0) + ;;N %RD,%OD S %RD=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/",%OD=$S($ZRO["(":$P($ZRO,"(",1)_"/",1:%RD) ZSYSTEM "rm -f "_%RD_X_".m" ZSYSTEM "rm -f "_%OD_X_".o" +"RTN","TMGMGRST",712,0) + ;;EOFF +"RTN","TMGMGRST",713,0) + ;;U $I:(NOECHO) +"RTN","TMGMGRST",714,0) + ;;EON +"RTN","TMGMGRST",715,0) + ;;U $I:(ECHO) +"RTN","TMGMGRST",716,0) + ;;EOT +"RTN","TMGMGRST",717,0) + ;;S Y=$ZA\1024#2 ; <===== +"RTN","TMGMGRST",718,0) + ;;ERRTN +"RTN","TMGMGRST",719,0) + ;;^%ZTER +"RTN","TMGMGRST",720,0) + ;;ETRP +"RTN","TMGMGRST",721,0) + ;;Q +"RTN","TMGMGRST",722,0) + ;;GD +"RTN","TMGMGRST",723,0) + ;;G ^%GD +"RTN","TMGMGRST",724,0) + ;;$INC +"RTN","TMGMGRST",725,0) + ;;0 +"RTN","TMGMGRST",726,0) + ;;JOBPARAM +"RTN","TMGMGRST",727,0) + ;;G JOBPAR^%ZOSV +"RTN","TMGMGRST",728,0) + ;;LABOFF +"RTN","TMGMGRST",729,0) + ;;U IO:(NOECHO) ; <===== +"RTN","TMGMGRST",730,0) + ;;LOAD +"RTN","TMGMGRST",731,0) + ;;D LOAD^%ZOSV2(X) ;S %N=0 F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N^@X) Q:$L(%)=0 S @(DIF_XCNP_",0)")=% +"RTN","TMGMGRST",732,0) + ;;LPC +"RTN","TMGMGRST",733,0) + ;;S Y="" ; <===== +"RTN","TMGMGRST",734,0) + ;;MAGTAPE +"RTN","TMGMGRST",735,0) + ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ; <===== +"RTN","TMGMGRST",736,0) + ;;MAXSIZ +"RTN","TMGMGRST",737,0) + ;;Q +"RTN","TMGMGRST",738,0) + ;;MGR +"RTN","TMGMGRST",739,0) + ;;VAH,ROU +"RTN","TMGMGRST",740,0) + ;;MTBOT +"RTN","TMGMGRST",741,0) + ;;S Y=$ZA\32#2 ; <===== +"RTN","TMGMGRST",742,0) + ;;MTERR +"RTN","TMGMGRST",743,0) + ;;S Y=$ZA\32768#2 ; <===== +"RTN","TMGMGRST",744,0) + ;;MTONLINE +"RTN","TMGMGRST",745,0) + ;;S Y=$ZA\64#2 ; <===== +"RTN","TMGMGRST",746,0) + ;;MTWPROT +"RTN","TMGMGRST",747,0) + ;;S Y=$ZA\4#2 ; <===== +"RTN","TMGMGRST",748,0) + ;;NBRK +"RTN","TMGMGRST",749,0) + ;;U $I:(NOCENABLE) +"RTN","TMGMGRST",750,0) + ;;NO-PASSALL +"RTN","TMGMGRST",751,0) + ;;U $I:(NOPASSTHRU) +"RTN","TMGMGRST",752,0) + ;;NO-TYPE-AHEAD +"RTN","TMGMGRST",753,0) + ;;U $I:(NOTYPEAHEAD) +"RTN","TMGMGRST",754,0) + ;;PASSALL +"RTN","TMGMGRST",755,0) + ;;U $I:(PASSTHRU) +"RTN","TMGMGRST",756,0) + ;;PRIINQ +"RTN","TMGMGRST",757,0) + ;;S Y=$$PRIINQ^%ZOSV() +"RTN","TMGMGRST",758,0) + ;;PRIORITY +"RTN","TMGMGRST",759,0) + ;;QUIT ;G PRIORITY^%ZOSV +"RTN","TMGMGRST",760,0) + ;;PROD +"RTN","TMGMGRST",761,0) + ;;VAH,ROU +"RTN","TMGMGRST",762,0) + ;;PROGMODE +"RTN","TMGMGRST",763,0) + ;;S Y=$$PROGMODE^%ZOSV() +"RTN","TMGMGRST",764,0) + ;;RD +"RTN","TMGMGRST",765,0) + ;;G ^%RD +"RTN","TMGMGRST",766,0) + ;;RESJOB +"RTN","TMGMGRST",767,0) + ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^FORCEX[MGR]" D DO^%XUCI ; <===== +"RTN","TMGMGRST",768,0) + ;;RM +"RTN","TMGMGRST",769,0) + ;;U $I:WIDTH=$S(X<256:X,1:0) +"RTN","TMGMGRST",770,0) + ;;RSEL +"RTN","TMGMGRST",771,0) + ;;K ^UTILITY($J) D ^%RSEL S X="" X "F S X=$O(%ZR(X)) Q:X="""" S ^UTILITY($J,X)=""""" K %ZR +"RTN","TMGMGRST",772,0) + ;;RSUM +"RTN","TMGMGRST",773,0) + ;;S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y +"RTN","TMGMGRST",774,0) + ;;SS +"RTN","TMGMGRST",775,0) + ;;D ^ZSY +"RTN","TMGMGRST",776,0) + ;;SAVE +"RTN","TMGMGRST",777,0) + ;;D SAVE^%ZOSV2(X) ;N %I,%F S %I=$I,%F=$P($S($ZRO["(":$P($P($ZRO,"(",2),")"),1:$ZRO)," ")_"/"_X_".m" O %F:(NEWVERSION) U %F X "F S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=@(DIE_XCN_"",0)"") Q:$E(%,1)=""$"" I $E(%)'="";"" W %,!" C %F U %I +"RTN","TMGMGRST",778,0) + ;;SIZE +"RTN","TMGMGRST",779,0) + ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 ; <===== +"RTN","TMGMGRST",780,0) + ;;TEST +"RTN","TMGMGRST",781,0) + ;;I X]"",$T(^@X)]"" +"RTN","TMGMGRST",782,0) + ;;TMK +"RTN","TMGMGRST",783,0) + ;;S Y=$ZA\16384#2 +"RTN","TMGMGRST",784,0) + ;;TMP +"RTN","TMGMGRST",785,0) + ;;/tmp/ +"RTN","TMGMGRST",786,0) + ;;TRAP +"RTN","TMGMGRST",787,0) + ;;$ZT="G "_X +"RTN","TMGMGRST",788,0) + ;;TRMOFF +"RTN","TMGMGRST",789,0) + ;;U $I:(TERMINATOR="") +"RTN","TMGMGRST",790,0) + ;;TRMON +"RTN","TMGMGRST",791,0) + ;;U $I:(TERMINATOR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127)) +"RTN","TMGMGRST",792,0) + ;;TRMRD +"RTN","TMGMGRST",793,0) + ;;S Y=$A($ZB) +"RTN","TMGMGRST",794,0) + ;;TYPE-AHEAD +"RTN","TMGMGRST",795,0) + ;;U $I:(TYPEAHEAD) +"RTN","TMGMGRST",796,0) + ;;UCI +"RTN","TMGMGRST",797,0) + ;;S Y=^%ZOSF("PROD") +"RTN","TMGMGRST",798,0) + ;;UCICHECK +"RTN","TMGMGRST",799,0) + ;;S Y=1 +"RTN","TMGMGRST",800,0) + ;;UPPERCASE +"RTN","TMGMGRST",801,0) + ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") +"RTN","TMGMGRST",802,0) + ;;XY +"RTN","TMGMGRST",803,0) + ;;S $X=DX,$Y=DY ; <===== +"RTN","TMGMGRST",804,0) + ;;VOL +"RTN","TMGMGRST",805,0) + ;;ROU +"RTN","TMGMGRST",806,0) + ;;ZD +"RTN","TMGMGRST",807,0) + ;;S Y=$$HTE^XLFDT(X,2) I $L($P(Y,"/"))=1 S Y=0_Y +"RTN","TMGMISC") +0^33^B9343 +"RTN","TMGMISC",1,0) +TMGMISC ;TMG/kst/Misc utility library ;03/25/06 +"RTN","TMGMISC",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGMISC",3,0) + +"RTN","TMGMISC",4,0) + ;"TMG MISCELLANEOUS FUNCTIONS +"RTN","TMGMISC",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGMISC",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGMISC",7,0) + ;"7-12-2005 +"RTN","TMGMISC",8,0) + +"RTN","TMGMISC",9,0) + ;"======================================================================= +"RTN","TMGMISC",10,0) + ;" API -- Public Functions. +"RTN","TMGMISC",11,0) + ;"======================================================================= +"RTN","TMGMISC",12,0) + ;"EDITPT(AddOK) +"RTN","TMGMISC",13,0) + ;"GetPersonClass(PersonClass,ProviderType,Specialty) +"RTN","TMGMISC",14,0) + ;"$$DocLines(IEN,Chars) -- Count number of lines and chars in a 8925 WP field +"RTN","TMGMISC",15,0) + ;"$$WPChars(Ptr) +"RTN","TMGMISC",16,0) + ;"$$RoundUp(n) +"RTN","TMGMISC",17,0) + ;"$$RoundDn(n) +"RTN","TMGMISC",18,0) + ;"$$Round(n) +"RTN","TMGMISC",19,0) + ;"$$InList(Value,ArrayP) -- return if Value is in an array. +"RTN","TMGMISC",20,0) + ;"$$ListCt(pArray) +"RTN","TMGMISC",21,0) + ;"$$NodeCt(pArray) -- count all the nodes in an array +"RTN","TMGMISC",22,0) + ;"$$IndexOf(pArray,value) +"RTN","TMGMISC",23,0) + ;"ListPack(pArray,StartNum,IncValue) +"RTN","TMGMISC",24,0) + ;"ListAdd(pArray,index,value) +"RTN","TMGMISC",25,0) + ;"ListAnd(pArray1,pArray2,pResult) +"RTN","TMGMISC",26,0) + ;"ListNot(pArray1,pArray2,pResult) +"RTN","TMGMISC",27,0) + ;"$$DTFormat(FMDate,format) -- format fileman dates +"RTN","TMGMISC",28,0) + ;"$$CompDOB(DOB1,DOB2) -- compare two dates +"RTN","TMGMISC",29,0) + ;"BrowseBy(CompArray,ByTag) -- Allow a user to interact with dynamic text tree +"RTN","TMGMISC",30,0) + ;"$$CompName(Name1,Name2) -- compare two names +"RTN","TMGMISC",31,0) + ;"$$FormatName(Name) +"RTN","TMGMISC",32,0) + ;"$$HEXCHR(V) -- Take one BYTE and return HEX Values +"RTN","TMGMISC",33,0) + ;"$$HEXCHR2(n,digits) -- convert a number (of arbitrary length) to HEX digits +"RTN","TMGMISC",34,0) + ;"$$HEX2NUM(s) -- convert a string like this $10 to decimal number (e.g.) 16 +"RTN","TMGMISC",35,0) + ;"$$OR(a,b) ; perform a bitwise OR on operands a and b +"RTN","TMGMISC",36,0) + ;"ParsePos(pos,label,offset,routine,dmod) +"RTN","TMGMISC",37,0) + ;"ScanMod(Module,pArray) +"RTN","TMGMISC",38,0) + ;"ConvertPos(Pos,pArray) +"RTN","TMGMISC",39,0) + ;"CompArray(pArray1,pArray2) return if two arrays are identical +"RTN","TMGMISC",40,0) + ;"$$CompABArray(pArrayA,pArrayB,pOutArray) -- FULL compare of two arrays, return diffArray +"RTN","TMGMISC",41,0) + ;"$$IterTemplate(Template,Prior) +"RTN","TMGMISC",42,0) + ;"$$NumPieces(s,delim,maxPoss) -- return number of pieces in string +"RTN","TMGMISC",43,0) + ;"$$LastPiece(s,delim,maxPoss) -- return the last piece of a string +"RTN","TMGMISC",44,0) + ;"$$ParseLast(s,remainS,delim,maxPoss) -- return the last piece AND the first part of the string +"RTN","TMGMISC",45,0) + ;"$$Trim1Node(pRef) -- To shorten a reference by one node. +"RTN","TMGMISC",46,0) + ;"BROWSEASK -- ask user for the name of an array, then display nodes +"RTN","TMGMISC",47,0) + ;"BROWSENODES(current,Order,paginate,countNodes) -- display nodes of specified array +"RTN","TMGMISC",48,0) + ;"ShowNodes(pArray,order,paginate,countNodes) -- display all the nodes of the given array +"RTN","TMGMISC",49,0) + ;"$$IsNumeric(value) -- determine if value is pure numeric. +"RTN","TMGMISC",50,0) + ;"$$ClipDDigits(Num,digits) -- clip number to specified number of digits +"RTN","TMGMISC",51,0) + ;"LaunchScreenman(File,FormIEN,RecIEN,Page) -- launching point screenman form +"RTN","TMGMISC",52,0) + ;"$$NumSigChs --determine how many characters are signficant in a variable name +"RTN","TMGMISC",53,0) + ;"MkMultList(input,List) -- create a list of entries, given a string containing a list of entries. +"RTN","TMGMISC",54,0) + ;"MkRangeList(Num,EndNum,List) -- create a list of entries, given a starting and ending number +"RTN","TMGMISC",55,0) + +"RTN","TMGMISC",56,0) + ;"======================================================================= +"RTN","TMGMISC",57,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGMISC",58,0) + ;"======================================================================= +"RTN","TMGMISC",59,0) + ;"GetPersonClass(PersonClass,ProviderType,Specialty) +"RTN","TMGMISC",60,0) + ;"ProcessToken(Token,Output) +"RTN","TMGMISC",61,0) + ;"$$IsSuffix(s) +"RTN","TMGMISC",62,0) + ;"$$IsTitle(s) +"RTN","TMGMISC",63,0) + ;"ShowBy(CompArray,ByTag,aOpen,bOpen,cOpen) +"RTN","TMGMISC",64,0) + ;"CtTemplate(Template) -- return the Count of IEN's stored in a SORT TEMPLATE +"RTN","TMGMISC",65,0) + +"RTN","TMGMISC",66,0) + ;"======================================================================= +"RTN","TMGMISC",67,0) + ;"DEPENDENCIES +"RTN","TMGMISC",68,0) + ;" TMGDBAPI +"RTN","TMGMISC",69,0) + ;" TMGIOUTL +"RTN","TMGMISC",70,0) + ;" TMGDEBUG +"RTN","TMGMISC",71,0) + ;" TMGSTUTL +"RTN","TMGMISC",72,0) + ;"======================================================================= +"RTN","TMGMISC",73,0) + ;"======================================================================= +"RTN","TMGMISC",74,0) + +"RTN","TMGMISC",75,0) +EDITPT(TMGADDOK) +"RTN","TMGMISC",76,0) + ;"Purpose: To ask for a patient name, and then allow editing +"RTN","TMGMISC",77,0) + ;"Input: TMGADDOK: if 1, then adding new patients is allowed +"RTN","TMGMISC",78,0) + ;"Result: none +"RTN","TMGMISC",79,0) + ; +"RTN","TMGMISC",80,0) + DO LO^DGUTL +"RTN","TMGMISC",81,0) + SET DGCLPR="" +"RTN","TMGMISC",82,0) + NEW DGDIV SET DGDIV=$$PRIM^VASITE +"RTN","TMGMISC",83,0) + ; +"RTN","TMGMISC",84,0) + IF DGDIV>0 SET %ZIS("B")=$PIECE($get(^DG(40.8,+DGDIV,"DEV")),U,1) +"RTN","TMGMISC",85,0) + ; +"RTN","TMGMISC",86,0) + KILL %ZIS("B") +"RTN","TMGMISC",87,0) + IF '$data(DGIO),$PIECE(^DG(43,1,0),U,30) do +"RTN","TMGMISC",88,0) + . SET %ZIS="N",IOP="HOME" +"RTN","TMGMISC",89,0) + . DO ^%ZIS +"RTN","TMGMISC",90,0) + ; +"RTN","TMGMISC",91,0) +A DO ENDREG^DGREG($GET(DFN)) +"RTN","TMGMISC",92,0) + DO IF (Y<0) GOTO EDITDONE +"RTN","TMGMISC",93,0) + . WRITE !! +"RTN","TMGMISC",94,0) + . IF $GET(TMGADDOK)=1 DO +"RTN","TMGMISC",95,0) + . . SET DIC=2,DIC(0)="ALEQM" +"RTN","TMGMISC",96,0) + . . SET DLAYGO=2 +"RTN","TMGMISC",97,0) + . ELSE DO +"RTN","TMGMISC",98,0) + . . SET DIC=2,DIC(0)="AEQM" +"RTN","TMGMISC",99,0) + . . SET DLAYGO=0 +"RTN","TMGMISC",100,0) + . KILL DIC("S") +"RTN","TMGMISC",101,0) + . DO ^DIC +"RTN","TMGMISC",102,0) + . KILL DLAYGO +"RTN","TMGMISC",103,0) + . IF Y<0 QUIT +"RTN","TMGMISC",104,0) + . SET (DFN,DA)=+Y +"RTN","TMGMISC",105,0) + . SET DGNEW=$P(Y,"^",3) +"RTN","TMGMISC",106,0) + . NEW Y +"RTN","TMGMISC",107,0) + . DO PAUSE^DG10 +"RTN","TMGMISC",108,0) + . DO BEGINREG^DGREG(DFN) +"RTN","TMGMISC",109,0) + . IF DGNEW DO NEW^DGRP +"RTN","TMGMISC",110,0) + ; +"RTN","TMGMISC",111,0) + IF +$GET(DGNEW) DO +"RTN","TMGMISC",112,0) + . ;" query CMOR for Patient Record Flag Assignments if NEW patient and +"RTN","TMGMISC",113,0) + . ;" display results. +"RTN","TMGMISC",114,0) + . IF $$PRFQRY^DGPFAPI(DFN) DO DISPPRF^DGPFAPI(DFN) +"RTN","TMGMISC",115,0) + ; +"RTN","TMGMISC",116,0) + SET (DGFC,CURR)=0 +"RTN","TMGMISC",117,0) + SET DA=DFN +"RTN","TMGMISC",118,0) + SET DGFC="^1" +"RTN","TMGMISC",119,0) + SET VET=$SELECT($DATA(^DPT(DFN,"VET")):^("VET")'="Y",1:0) +"RTN","TMGMISC",120,0) + ; +"RTN","TMGMISC",121,0) + SET %ZIS="N",IOP="HOME" +"RTN","TMGMISC",122,0) + DO ^%ZIS +"RTN","TMGMISC",123,0) + SET DGELVER=0 +"RTN","TMGMISC",124,0) + ;"DO EN^DGRPD +"RTN","TMGMISC",125,0) + ;"IF $data(DGRPOUT) DO GOTO A +"RTN","TMGMISC",126,0) + ;". DO ENDREG^DGREG($G(DFN)) +"RTN","TMGMISC",127,0) + ;". DO HL7A08^VAFCDD01 +"RTN","TMGMISC",128,0) + ;". KILL DFN,DGRPOUT +"RTN","TMGMISC",129,0) + ; +"RTN","TMGMISC",130,0) + ;"DO HINQ^DG10 +"RTN","TMGMISC",131,0) + IF $D(^DIC(195.4,1,"UP")) IF ^("UP") DO ADM^RTQ3 +"RTN","TMGMISC",132,0) + ; +"RTN","TMGMISC",133,0) + DO REG^IVMCQ($G(DFN)) ;" send financial query +"RTN","TMGMISC",134,0) + ; +"RTN","TMGMISC",135,0) + SET DGRPV=0 +"RTN","TMGMISC",136,0) + DO EN1^DGRP +"RTN","TMGMISC",137,0) + ; +"RTN","TMGMISC",138,0) +EDITDONE +"RTN","TMGMISC",139,0) + IF $PIECE($GET(^VA(200,DUZ,"TMG")),"^",1)="C" DO +"RTN","TMGMISC",140,0) + . WRITE @IOF,! ;"clear screen if settings call for this. +"RTN","TMGMISC",141,0) + ; +"RTN","TMGMISC",142,0) + QUIT +"RTN","TMGMISC",143,0) + +"RTN","TMGMISC",144,0) + +"RTN","TMGMISC",145,0) +GetPersonClass(PersonClass,ProviderType,Specialty) +"RTN","TMGMISC",146,0) + ;"Purpose: To look through the PERSON CLASS file and find matching record +"RTN","TMGMISC",147,0) + ;"Input -- PersonClass -- a value to match against the .01 field (PROVIDER TYPE) +"RTN","TMGMISC",148,0) + ;" Behavioral Health and Social Service +"RTN","TMGMISC",149,0) + ;" Chiropractors +"RTN","TMGMISC",150,0) + ;" Dental Service +"RTN","TMGMISC",151,0) + ;" Dietary and Nutritional Service +"RTN","TMGMISC",152,0) + ;" Emergency Medical Service +"RTN","TMGMISC",153,0) + ;" Eye and Vision Services +"RTN","TMGMISC",154,0) + ;" Nursing Service +"RTN","TMGMISC",155,0) + ;" Nursing Service Related +"RTN","TMGMISC",156,0) + ;" Physicians (M.D. and D.O.) +"RTN","TMGMISC",157,0) + ;" etc. +"RTN","TMGMISC",158,0) + ;" -- ProviderType -- a value to match against the 1 field (CLASSIFICATION) +"RTN","TMGMISC",159,0) + ;" Physician/Osteopath +"RTN","TMGMISC",160,0) + ;" Resident, Allopathic (includes Interns, Residents, Fellows) +"RTN","TMGMISC",161,0) + ;" Psychologist +"RTN","TMGMISC",162,0) + ;" Neuropsychologist +"RTN","TMGMISC",163,0) + ;" etc. +"RTN","TMGMISC",164,0) + ;" -- Specialty -- a value to match against the 2 field (AREA OF SPECIALIZATION) +"RTN","TMGMISC",165,0) + ;"Output -- (via results) +"RTN","TMGMISC",166,0) + ;"Result -- Returns record number in PERSON CLASS file, OR 0 if not found +"RTN","TMGMISC",167,0) + +"RTN","TMGMISC",168,0) + new RecNum,Params +"RTN","TMGMISC",169,0) + +"RTN","TMGMISC",170,0) + set Params(0,"FILE")="PERSON CLASS" +"RTN","TMGMISC",171,0) + set Params(".01")=$get(PersonClass) +"RTN","TMGMISC",172,0) + set Params("1")=$get(ProviderType) +"RTN","TMGMISC",173,0) + set Params("2")=$get(Specialty) +"RTN","TMGMISC",174,0) + +"RTN","TMGMISC",175,0) + set RecNum=$$RecFind^TMGDBAPI(.Params) +"RTN","TMGMISC",176,0) + +"RTN","TMGMISC",177,0) +GPCDone +"RTN","TMGMISC",178,0) + quit RecNum +"RTN","TMGMISC",179,0) + +"RTN","TMGMISC",180,0) + +"RTN","TMGMISC",181,0) +DocLines(IEN,Chars) +"RTN","TMGMISC",182,0) + ;"Purpose: To count the number of lines and characters in a WP field +"RTN","TMGMISC",183,0) + ;" Initially it is targeted at entries in TIU DOCUMENT file. +"RTN","TMGMISC",184,0) + ;"Input: IEN -- the record number in TIU DOCUMENT to count +"RTN","TMGMISC",185,0) + ;" Chars -- and OUT parameter. PASS BY REFERENCE +"RTN","TMGMISC",186,0) + ;"Results: Returns number of lines, (with 1 decimal value) +"RTN","TMGMISC",187,0) + ;" Also will return character count in Chars, if passed by reference +"RTN","TMGMISC",188,0) + ;"NOte: This uses the Characters per line parameter value stored in +"RTN","TMGMISC",189,0) + ;" field .03 of TIU PARAMETERS (in ^TIU(8925.99)) +"RTN","TMGMISC",190,0) + +"RTN","TMGMISC",191,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DocLines^TMGMISC") +"RTN","TMGMISC",192,0) + +"RTN","TMGMISC",193,0) + new CharsPerLine +"RTN","TMGMISC",194,0) + new LineCount set LineCount=0 +"RTN","TMGMISC",195,0) + set Chars=0 +"RTN","TMGMISC",196,0) + set CharsPerLine=+$piece($get(^TIU(8925.99,1,0)),"^",3) +"RTN","TMGMISC",197,0) + +"RTN","TMGMISC",198,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"CharsPerLine=",CharsPerLine) +"RTN","TMGMISC",199,0) + +"RTN","TMGMISC",200,0) + set WPPtr=$name(^TIU(8925,IEN,"TEXT")) +"RTN","TMGMISC",201,0) + set Chars=$$WPChars(WPPtr) +"RTN","TMGMISC",202,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Chars=",Chars) +"RTN","TMGMISC",203,0) + +"RTN","TMGMISC",204,0) + if CharsPerLine'=0 do +"RTN","TMGMISC",205,0) + . set LineCount=(((Chars/CharsPerLine)*10)\1)/10 +"RTN","TMGMISC",206,0) + . ;"new IntLC,LC,Delta +"RTN","TMGMISC",207,0) + . ;"set LC=Chars\CharsPerLine +"RTN","TMGMISC",208,0) + . ;"set IntLC=Chars\CharsPerLine ;" \ is integer divide +"RTN","TMGMISC",209,0) + . ;"set Delta=(LC-IntLC)*10 +"RTN","TMGMISC",210,0) + . i;"f Delta>4 set IntLC=IntLC+1 ;"Round to closest integer value. +"RTN","TMGMISC",211,0) + . ;"set LineCount=IntLC +"RTN","TMGMISC",212,0) + +"RTN","TMGMISC",213,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"LineCount=",LineCount) +"RTN","TMGMISC",214,0) + +"RTN","TMGMISC",215,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DocLines^TMGMISC") +"RTN","TMGMISC",216,0) + quit LineCount +"RTN","TMGMISC",217,0) + +"RTN","TMGMISC",218,0) + +"RTN","TMGMISC",219,0) +WPChars(Ptr) +"RTN","TMGMISC",220,0) + ;"Purpose: To count the number of characters in the WP field +"RTN","TMGMISC",221,0) + ;" pointed to by the name stored in Ptr +"RTN","TMGMISC",222,0) + ;"Results: Returns number of characters, including spaces +"RTN","TMGMISC",223,0) + +"RTN","TMGMISC",224,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"WPChars^TMGMISC") +"RTN","TMGMISC",225,0) + +"RTN","TMGMISC",226,0) + new index +"RTN","TMGMISC",227,0) + new Chars set Chars=0 +"RTN","TMGMISC",228,0) + +"RTN","TMGMISC",229,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Ptr=",Ptr) +"RTN","TMGMISC",230,0) + set index=$order(@Ptr@(0)) +"RTN","TMGMISC",231,0) + for do quit:(index="") +"RTN","TMGMISC",232,0) + . if index="" quit +"RTN","TMGMISC",233,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"index='",index,"'") +"RTN","TMGMISC",234,0) + . ;"new s set s=$get(@Ptr@(index,0)) write "s=",s,! +"RTN","TMGMISC",235,0) + . set Chars=Chars+$length($get(@Ptr@(index,0))) +"RTN","TMGMISC",236,0) + . set index=$order(@Ptr@(index)) +"RTN","TMGMISC",237,0) + +"RTN","TMGMISC",238,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"WPChars^TMGMISC") +"RTN","TMGMISC",239,0) + +"RTN","TMGMISC",240,0) + quit Chars +"RTN","TMGMISC",241,0) + +"RTN","TMGMISC",242,0) + +"RTN","TMGMISC",243,0) + +"RTN","TMGMISC",244,0) +RoundUp(n) +"RTN","TMGMISC",245,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",246,0) + ;"Purpose: find the next greatest integer after decimal value of n (round up) +"RTN","TMGMISC",247,0) + ;" 1.1 --> 2 +"RTN","TMGMISC",248,0) + ;" 1.0 --> 1 +"RTN","TMGMISC",249,0) + ;" -2.8 --> 2 +"RTN","TMGMISC",250,0) + ;"input: n -- decimal or integer value +"RTN","TMGMISC",251,0) + ;"output an integer, rounded up. +"RTN","TMGMISC",252,0) + +"RTN","TMGMISC",253,0) + new result +"RTN","TMGMISC",254,0) + set result=n\1 +"RTN","TMGMISC",255,0) + if result 1 +"RTN","TMGMISC",262,0) + ;" -2.2 --> -2 +"RTN","TMGMISC",263,0) + ;"input: n -- decimal or integer value +"RTN","TMGMISC",264,0) + ;"output an integer, rounded down. +"RTN","TMGMISC",265,0) + +"RTN","TMGMISC",266,0) + new result +"RTN","TMGMISC",267,0) + set result=n\1 +"RTN","TMGMISC",268,0) + quit result +"RTN","TMGMISC",269,0) + +"RTN","TMGMISC",270,0) +Round(n) +"RTN","TMGMISC",271,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",272,0) + ;"Purpose: find the nearest integer from decimal value of n +"RTN","TMGMISC",273,0) + ;" for values 0.0-0.49 --> 0 +"RTN","TMGMISC",274,0) + ;" for values 0.5-0.99 --> 1 +"RTN","TMGMISC",275,0) + ;"input: n -- decimal or integer value +"RTN","TMGMISC",276,0) + ;"output an integer, rounded to nearest integer +"RTN","TMGMISC",277,0) + +"RTN","TMGMISC",278,0) + new result set result=n +"RTN","TMGMISC",279,0) + new decimal +"RTN","TMGMISC",280,0) + +"RTN","TMGMISC",281,0) + set decimal=+(n-(n\1)) +"RTN","TMGMISC",282,0) + if decimal<0.5 do +"RTN","TMGMISC",283,0) + . set result=$$RoundDn(n) +"RTN","TMGMISC",284,0) + else do +"RTN","TMGMISC",285,0) + . set result=$$RoundUp(n) +"RTN","TMGMISC",286,0) + +"RTN","TMGMISC",287,0) + quit result +"RTN","TMGMISC",288,0) + +"RTN","TMGMISC",289,0) + +"RTN","TMGMISC",290,0) +InList(Value,ArrayP) +"RTN","TMGMISC",291,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",292,0) + ;"Purpose: To return if Value is in an array. Match must be exact (i.e. '=') +"RTN","TMGMISC",293,0) + ;"Input: Value -- the value to test for. Should not be an array +"RTN","TMGMISC",294,0) + ;" ArrayP -- the name of the array. e.g. ArrayP="MyArray(""Title"")" +"RTN","TMGMISC",295,0) + ;"Format of Array: It may be in one of two possible formats: +"RTN","TMGMISC",296,0) + ;" 1. MyArray("Title")=Value, or +"RTN","TMGMISC",297,0) + ;" 2. MyArray("Title")="*" <-- a signal that multiple values are given +"RTN","TMGMISC",298,0) + ;" MyArray("Title",1)=Value1 +"RTN","TMGMISC",299,0) + ;" MyArray("Title",2)=Value2 +"RTN","TMGMISC",300,0) + ;" The '1','2', etc may anything +"RTN","TMGMISC",301,0) + ;"Results: 1 if Value is in list, 0 if not +"RTN","TMGMISC",302,0) + +"RTN","TMGMISC",303,0) + new result set result=0 +"RTN","TMGMISC",304,0) + new index +"RTN","TMGMISC",305,0) + if ($get(ArrayP)'="")&($data(Value)=1) do +"RTN","TMGMISC",306,0) + . if @ArrayP'="*" set result=(@ArrayP=$get(Value)) quit +"RTN","TMGMISC",307,0) + . set index=$order(@ArrayP@("")) quit:(index="") +"RTN","TMGMISC",308,0) + . for do quit:(index="")!(result=1) +"RTN","TMGMISC",309,0) + . . if @ArrayP@(index)=Value set result=1 quit +"RTN","TMGMISC",310,0) + . . set index=$order(@ArrayP@(index)) +"RTN","TMGMISC",311,0) + +"RTN","TMGMISC",312,0) +ILDone +"RTN","TMGMISC",313,0) + quit result +"RTN","TMGMISC",314,0) + +"RTN","TMGMISC",315,0) + +"RTN","TMGMISC",316,0) + ;"IndexOf(pArray,value) +"RTN","TMGMISC",317,0) + ;" ;"SCOPE: PUBLIC +"RTN","TMGMISC",318,0) + ;" ;"Purpose: To scan array and return first index holding value +"RTN","TMGMISC",319,0) + ;" ;"Input: pArray -- PASS BY NAME. Array to scan, in format like this: +"RTN","TMGMISC",320,0) + ;" ;" @pArray@(1)=value1 +"RTN","TMGMISC",321,0) + ;" ;" @pArray@(2)=value2 +"RTN","TMGMISC",322,0) + ;" ;" @pArray@(3)=value3 +"RTN","TMGMISC",323,0) + ;" ;" @pArray@("some name index 1")=value4 +"RTN","TMGMISC",324,0) + ;" ;" @pArray@("some name index 2")=value5 +"RTN","TMGMISC",325,0) + ;" ;" value -- the value to search for +"RTN","TMGMISC",326,0) + ;" ;"results: returns the index holding the value +"RTN","TMGMISC",327,0) + ;" +"RTN","TMGMISC",328,0) + ;" new result set result="" +"RTN","TMGMISC",329,0) + ;" new done set done=0 +"RTN","TMGMISC",330,0) + ;" new index set index="" +"RTN","TMGMISC",331,0) + ;" for set index=$order(@pArray@(index)) quit:(index="")!(done=1) do +"RTN","TMGMISC",332,0) + ;" . set done=($get(@pArray@(index))=value) +"RTN","TMGMISC",333,0) + ;" . if done set result=index +"RTN","TMGMISC",334,0) + ;" +"RTN","TMGMISC",335,0) + ;"IODone quit result +"RTN","TMGMISC",336,0) + +"RTN","TMGMISC",337,0) + +"RTN","TMGMISC",338,0) +ListCt(pArray) +"RTN","TMGMISC",339,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",340,0) + ;"Purpose: to count the number of entries in an array +"RTN","TMGMISC",341,0) + ;"Input: pArray -- PASS BY NAME. pointer to (name of) array to test. +"RTN","TMGMISC",342,0) + ;"Output: the number of entries at highest level +"RTN","TMGMISC",343,0) + ;" e.g. Array("TELEPHONE")=1234 +"RTN","TMGMISC",344,0) + ;" Array("CAR")=4764 +"RTN","TMGMISC",345,0) + ;" Array("DOG")=5213 +"RTN","TMGMISC",346,0) + ;" Array("DOG","COLLAR")=5213 <-- not highest level,not counted. +"RTN","TMGMISC",347,0) + ;" The above array would have a count of 3 +"RTN","TMGMISC",348,0) + ;"Results: returns count, or count up to point of any error +"RTN","TMGMISC",349,0) + new i,result set result=0 +"RTN","TMGMISC",350,0) + +"RTN","TMGMISC",351,0) + do +"RTN","TMGMISC",352,0) + . new $etrap +"RTN","TMGMISC",353,0) + . set $etrap="write ""?? Error Trapped ??"",! set $ECODE="""" quit" +"RTN","TMGMISC",354,0) + . set i=$order(@pArray@("")) +"RTN","TMGMISC",355,0) + . if i="" quit +"RTN","TMGMISC",356,0) + . for set result=result+1 set i=$order(@pArray@(i)) quit:i="" +"RTN","TMGMISC",357,0) + +"RTN","TMGMISC",358,0) + quit result +"RTN","TMGMISC",359,0) + +"RTN","TMGMISC",360,0) +NodeCt(pArray) +"RTN","TMGMISC",361,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",362,0) + ;"Purpose: to count all the nodes in an array +"RTN","TMGMISC",363,0) + ;"Input: pArray -- PASS BY NAME. pointer to (name of) array to test. +"RTN","TMGMISC",364,0) + ;"Output: the number of entries at highest level +"RTN","TMGMISC",365,0) + ;" e.g. Array("TELEPHONE")=1234 +"RTN","TMGMISC",366,0) + ;" Array("CAR")=4764 +"RTN","TMGMISC",367,0) + ;" Array("DOG")=5213 +"RTN","TMGMISC",368,0) + ;" Array("DOG","COLLAR")=5213 <-- IS counted +"RTN","TMGMISC",369,0) + ;" The above array would have a count of 4 +"RTN","TMGMISC",370,0) + ;"Results: returns count, or count up to point of any error +"RTN","TMGMISC",371,0) + new result set result=0 +"RTN","TMGMISC",372,0) + for set pArray=$query(@pArray),result=result+1 quit:(pArray="") +"RTN","TMGMISC",373,0) + quit result +"RTN","TMGMISC",374,0) + +"RTN","TMGMISC",375,0) +IndexOf(pArray,value) +"RTN","TMGMISC",376,0) + ;"SCOPE: PUBLIC: +"RTN","TMGMISC",377,0) + ;"Purpose: To search through an array of keys and values, and return 1st index (i.e. key) of value +"RTN","TMGMISC",378,0) + ;"Input: pArray -- NAME OF array to search, format: +"RTN","TMGMISC",379,0) + ;" @pArray@(key1)=value1 +"RTN","TMGMISC",380,0) + ;" @pArray@(key2)=value2 +"RTN","TMGMISC",381,0) + ;" @pArray@(key3)=value3 +"RTN","TMGMISC",382,0) + ;" value -- the value to search for +"RTN","TMGMISC",383,0) + ;"Results: will return key for first found (based on $order sequence),or "" if not found +"RTN","TMGMISC",384,0) + +"RTN","TMGMISC",385,0) + new result set result="" +"RTN","TMGMISC",386,0) + new i set i="" +"RTN","TMGMISC",387,0) + new done set done=0 +"RTN","TMGMISC",388,0) + for set i=$order(@pArray@(i)) quit:(i="")!(done=1) do +"RTN","TMGMISC",389,0) + . if $get(@pArray@(i))=value set result=i,done=1 +"RTN","TMGMISC",390,0) + +"RTN","TMGMISC",391,0) + quit result +"RTN","TMGMISC",392,0) + +"RTN","TMGMISC",393,0) +ListPack(pArray,StartNum,IncValue) +"RTN","TMGMISC",394,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",395,0) + ;"Purpose: to take an array with numeric ordering and pack values. +"RTN","TMGMISC",396,0) + ;" e.g. Array(3)="dog" +"RTN","TMGMISC",397,0) + ;" Array(5)="cat" +"RTN","TMGMISC",398,0) + ;" Array(75)="goat" +"RTN","TMGMISC",399,0) + ;" Will be pack as follows: +"RTN","TMGMISC",400,0) + ;" Array(1)="dog" +"RTN","TMGMISC",401,0) + ;" Array(2)="cat" +"RTN","TMGMISC",402,0) + ;" Array(3)="goat" +"RTN","TMGMISC",403,0) + ;"Input: pArray -- pointer to (NAME OF) array to pack. +"RTN","TMGMISC",404,0) + ;" StartNum -- OPTIONAL, default=1. Value to start numbering at +"RTN","TMGMISC",405,0) + ;" IncValue -- OPTIONAL, default=1. Amount to add to index value each time +"RTN","TMGMISC",406,0) + ;"Output: array will be altered +"RTN","TMGMISC",407,0) + ;"Results: none. +"RTN","TMGMISC",408,0) + ;"Notes: It is assumed that all of the indices are numeric +"RTN","TMGMISC",409,0) + ;" Nodes that are ALPHA (non-numeric) will be KILLED!! +"RTN","TMGMISC",410,0) + ;" If nodes have subnodes, they will be preserved. +"RTN","TMGMISC",411,0) + +"RTN","TMGMISC",412,0) + new TMGlpArray +"RTN","TMGMISC",413,0) + new i +"RTN","TMGMISC",414,0) + new count set count=$get(StartNum,1) +"RTN","TMGMISC",415,0) + set i=$order(@pArray@("")) +"RTN","TMGMISC",416,0) + if +i=i for do quit:(+i'=i) +"RTN","TMGMISC",417,0) + . merge TMGlpArray(count)=@pArray@(i) +"RTN","TMGMISC",418,0) + . set count=count+$get(IncValue,1) +"RTN","TMGMISC",419,0) + . set i=$order(@pArray@(i)) +"RTN","TMGMISC",420,0) + kill @pArray +"RTN","TMGMISC",421,0) + merge @pArray=TMGlpArray +"RTN","TMGMISC",422,0) + quit +"RTN","TMGMISC",423,0) + +"RTN","TMGMISC",424,0) + +"RTN","TMGMISC",425,0) +ListTrim(pArray,startIndex,endIndex,CountName) +"RTN","TMGMISC",426,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",427,0) + ;"Purpose: Take a list with numeric (integer) ordering, and trim (kill) entry +"RTN","TMGMISC",428,0) + ;" items startIndex...endIndex +"RTN","TMGMISC",429,0) + ;"Input: pArray -- PASS BY NAME. The array to trim +"RTN","TMGMISC",430,0) + ;" startIndex -- the first index item to kill. Default=1 +"RTN","TMGMISC",431,0) + ;" endIndex -- the last index item to kill. Default=1 +"RTN","TMGMISC",432,0) + ;" CountName -- OPTIONAL. The name of a node that includes the +"RTN","TMGMISC",433,0) + ;" final count of remaining nodes. Default is "COUNT" +"RTN","TMGMISC",434,0) + ;"Output: Array items will be killed. Also, a node with the resulting count +"RTN","TMGMISC",435,0) + ;" of remaining items will be created, with name of CountName. e.g. +"RTN","TMGMISC",436,0) + ;" INPUT: startIndex=1, endIndex=4 +"RTN","TMGMISC",437,0) + ;" @pArray@(2)="grape" +"RTN","TMGMISC",438,0) + ;" @pArray@(3)="orange" +"RTN","TMGMISC",439,0) + ;" @pArray@(5)="apple" +"RTN","TMGMISC",440,0) + ;" @pArray@(7)="pear" +"RTN","TMGMISC",441,0) + ;" @pArray@(9)="peach" +"RTN","TMGMISC",442,0) + ;" +"RTN","TMGMISC",443,0) + ;" OUTPUT: +"RTN","TMGMISC",444,0) + ;" @pArray@(5)="apple" +"RTN","TMGMISC",445,0) + ;" @pArray@(7)="pear" +"RTN","TMGMISC",446,0) + ;" @pArray@(9)="peach" +"RTN","TMGMISC",447,0) + ;" @pArray@("COUNT")=3 +"RTN","TMGMISC",448,0) + +"RTN","TMGMISC",449,0) + set startIndex=$get(startIndex,1) +"RTN","TMGMISC",450,0) + set endIndex=$get(endIndex,1) +"RTN","TMGMISC",451,0) + set CountName=$get(CountName,"COUNT") +"RTN","TMGMISC",452,0) + kill @pArray@(CountName) +"RTN","TMGMISC",453,0) + new i for i=startIndex:1:endIndex kill @pArray@(i) +"RTN","TMGMISC",454,0) + do ListPack(pArray) +"RTN","TMGMISC",455,0) + set @pArray@(CountName)=$$ListCt(pArray) +"RTN","TMGMISC",456,0) + quit +"RTN","TMGMISC",457,0) + +"RTN","TMGMISC",458,0) + +"RTN","TMGMISC",459,0) +ListAdd(pArray,index,value) +"RTN","TMGMISC",460,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",461,0) + ;"Purpose: To take a simple list and add to end of ist +"RTN","TMGMISC",462,0) + ;" e.g. Array("Apple")=75 +"RTN","TMGMISC",463,0) + ;" Array("Pear")=19 +"RTN","TMGMISC",464,0) + ;" +"RTN","TMGMISC",465,0) + ;" do ListAdd("Array","Grape",12) --> +"RTN","TMGMISC",466,0) + ;" +"RTN","TMGMISC",467,0) + ;" e.g. Array("Apple")=75 +"RTN","TMGMISC",468,0) + ;" Array("Pear")=19 +"RTN","TMGMISC",469,0) + ;" Array("Grape")=12 +"RTN","TMGMISC",470,0) + +"RTN","TMGMISC",471,0) + ;"Note: function creation aborted, because there is no intrinsic ordering in arrays. I.e. the above would actually +"RTN","TMGMISC",472,0) + ;" be in this order, as returned by $order(): +"RTN","TMGMISC",473,0) + ;" e.g. Array("Apple")=75 +"RTN","TMGMISC",474,0) + ;" Array("Grape")=12 <-- "G" comes before "P" alphabetically +"RTN","TMGMISC",475,0) + ;" Array("Pear")=19 +"RTN","TMGMISC",476,0) + +"RTN","TMGMISC",477,0) + ;"I'll leave this here as a reminder to myself next time. +"RTN","TMGMISC",478,0) + +"RTN","TMGMISC",479,0) + quit +"RTN","TMGMISC",480,0) + +"RTN","TMGMISC",481,0) + +"RTN","TMGMISC",482,0) +ListAnd(pArray1,pArray2,pResult) +"RTN","TMGMISC",483,0) + ;"Purpose: To take two lists, and create a third list that has only those entries that +"RTN","TMGMISC",484,0) + ;" exist in Array1 AND Array2 +"RTN","TMGMISC",485,0) + ;"Input: pArray1 : NAME OF array for list 1 +"RTN","TMGMISC",486,0) + ;" pArray2 : NAME OF array for list 2 +"RTN","TMGMISC",487,0) + ;" pResult : NAME OF array to results -- any preexisting entries will be killed +"RTN","TMGMISC",488,0) + ;"Note: only TOP LEVEL nodes are considered, and *value* for pArray1 use for combined value +"RTN","TMGMISC",489,0) + ;"E.g. of Use +"RTN","TMGMISC",490,0) + ;" @pArray1@("cat")="feline" +"RTN","TMGMISC",491,0) + ;" @pArray1@("dog")="canine" +"RTN","TMGMISC",492,0) + ;" @pArray1@("horse")="equinine" +"RTN","TMGMISC",493,0) + ;" @pArray1@("bird")="avian" +"RTN","TMGMISC",494,0) + ;" @pArray1@("bird","weight")=12 <--- will be ignored, not a top level node +"RTN","TMGMISC",495,0) + ;" +"RTN","TMGMISC",496,0) + ;" @pArray2@("hog")="porcine" +"RTN","TMGMISC",497,0) + ;" @pArray2@("horse")="equinine" +"RTN","TMGMISC",498,0) + ;" @pArray2@("cow")="bovine" +"RTN","TMGMISC",499,0) + ;" @pArray2@("bird")="flier" <----- note different value for key="bird" +"RTN","TMGMISC",500,0) + ;" +"RTN","TMGMISC",501,0) + ;" resulting list: +"RTN","TMGMISC",502,0) + ;" @pResult@("horse")="equinine" +"RTN","TMGMISC",503,0) + ;" @pResult@("bird")="avian" <-- note value from pArray1 used. +"RTN","TMGMISC",504,0) + +"RTN","TMGMISC",505,0) + new Result +"RTN","TMGMISC",506,0) + +"RTN","TMGMISC",507,0) + new i set i=$order(@pArray1@("")) +"RTN","TMGMISC",508,0) + if i'="" for do quit:(i="") +"RTN","TMGMISC",509,0) + . if $data(@pArray2@(i))#10 do +"RTN","TMGMISC",510,0) + . . set Result(i)=$get(@pArray1@(i)) +"RTN","TMGMISC",511,0) + . set i=$order(@pArray1@(i)) +"RTN","TMGMISC",512,0) + +"RTN","TMGMISC",513,0) + kill @pResult +"RTN","TMGMISC",514,0) + merge @pResult=Result +"RTN","TMGMISC",515,0) + +"RTN","TMGMISC",516,0) + quit +"RTN","TMGMISC",517,0) + +"RTN","TMGMISC",518,0) + +"RTN","TMGMISC",519,0) +ListNot(pArray1,pArray2,Verbose) +"RTN","TMGMISC",520,0) + ;"Purpose: To take two lists, and remove all entries from list 2 from list 1 +"RTN","TMGMISC",521,0) + ;" exist in Array1 NOT Array2 +"RTN","TMGMISC",522,0) + ;"Input: pArray1 : NAME OF array for list 1 +"RTN","TMGMISC",523,0) + ;" pArray2 : NAME OF array for list 2 +"RTN","TMGMISC",524,0) + ;" Verbose: OPTIONAL. if 1 then verbose output, progress bar etc. +"RTN","TMGMISC",525,0) + +"RTN","TMGMISC",526,0) + ;"Note: only TOP LEVEL nodes are considered, and +"RTN","TMGMISC",527,0) + ;" *value* for pArray1 use for combined value +"RTN","TMGMISC",528,0) + +"RTN","TMGMISC",529,0) + ;"E.g. of Use +"RTN","TMGMISC",530,0) + ;" list 1: +"RTN","TMGMISC",531,0) + ;" @pArray1@("cat")="feline" +"RTN","TMGMISC",532,0) + ;" @pArray1@("dog")="canine" +"RTN","TMGMISC",533,0) + ;" @pArray1@("horse")="equinine" +"RTN","TMGMISC",534,0) + ;" @pArray1@("bird")="avian" +"RTN","TMGMISC",535,0) + ;" @pArray1@("bird","weight")=12 <--- will be ignored, not a top level node +"RTN","TMGMISC",536,0) + ;" +"RTN","TMGMISC",537,0) + ;" list 2: +"RTN","TMGMISC",538,0) + ;" @pArray1@("cat")="feline" +"RTN","TMGMISC",539,0) + ;" @pArray1@("horse")="equinine" +"RTN","TMGMISC",540,0) + ;" +"RTN","TMGMISC",541,0) + ;" resulting list: +"RTN","TMGMISC",542,0) + ;" @pArray1@("dog")="canine" +"RTN","TMGMISC",543,0) + ;" @pArray1@("bird")="avian" +"RTN","TMGMISC",544,0) + ;" @pArray1@("bird","weight")=12 +"RTN","TMGMISC",545,0) + ;" +"RTN","TMGMISC",546,0) + +"RTN","TMGMISC",547,0) + new Itr,index +"RTN","TMGMISC",548,0) + set index=$$ItrAInit^TMGITR(pArray2,.Itr) +"RTN","TMGMISC",549,0) + if Verbose=1 do PrepProgress^TMGITR(.Itr,20,1,"index") +"RTN","TMGMISC",550,0) + if index'="" for do quit:($$ItrANext^TMGITR(.Itr,.index)="") +"RTN","TMGMISC",551,0) + . kill @pArray1@(i) +"RTN","TMGMISC",552,0) + +"RTN","TMGMISC",553,0) + quit +"RTN","TMGMISC",554,0) + +"RTN","TMGMISC",555,0) + +"RTN","TMGMISC",556,0) + ;"Note: Sometime, compare this function to $$DATE^TIULS ... I didn't know about this function before! +"RTN","TMGMISC",557,0) +DTFormat(FMDate,format,Array) +"RTN","TMGMISC",558,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",559,0) + ;"Purpose: to allow custom formating of fileman dates in to text equivalents +"RTN","TMGMISC",560,0) + ;"Input: FMDate -- this is the date to work on, in Fileman Format +"RTN","TMGMISC",561,0) + ;" format -- a formating string with codes as follows. +"RTN","TMGMISC",562,0) + ;" yy -- 2 digit year +"RTN","TMGMISC",563,0) + ;" yyyy -- 4 digit year +"RTN","TMGMISC",564,0) + ;" m - month number without a leading 0. +"RTN","TMGMISC",565,0) + ;" mm -- 2 digit month number (01-12) +"RTN","TMGMISC",566,0) + ;" mmm - abreviated months (Jan,Feb,Mar etc.) +"RTN","TMGMISC",567,0) + ;" mmmm -- full names of months (January,February,March etc) +"RTN","TMGMISC",568,0) + ;" d -- the number of the day of the month (1-31) without a leading 0 +"RTN","TMGMISC",569,0) + ;" dd -- 2 digit number of the day of the month +"RTN","TMGMISC",570,0) + ;" w -- the numeric day of the week (1-7) +"RTN","TMGMISC",571,0) + ;" ww -- abreviated day of week (Mon,Tue,Wed) +"RTN","TMGMISC",572,0) + ;" www -- day of week (Monday,Tuesday,Wednesday) +"RTN","TMGMISC",573,0) + ;" h -- the number of the hour without a leading 0 (1-23) 24-hr clock mode +"RTN","TMGMISC",574,0) + ;" hh -- 2 digit number of the hour. 24-hr clock mode +"RTN","TMGMISC",575,0) + ;" H -- the number of the hour without a leading 0 (1-12) 12-hr clock mode +"RTN","TMGMISC",576,0) + ;" HH -- 2 digit number of the hour. 12-hr clock mode +"RTN","TMGMISC",577,0) + ;" # -- will display 'am' for hours 1-12 and 'pm' for hours 13-24 +"RTN","TMGMISC",578,0) + ;" M - the number of minutes with out a leading 0 +"RTN","TMGMISC",579,0) + ;" MM -- a 2 digit display of minutes +"RTN","TMGMISC",580,0) + ;" s - the number of seconds without a leading 0 +"RTN","TMGMISC",581,0) + ;" ss -- a 2 digit display of number of seconds. +"RTN","TMGMISC",582,0) + ;" allowed punctuation symbols-- ' ' : , / @ .;- (space, colon, comma, forward slash, at symbol,semicolon,period,hyphen) +"RTN","TMGMISC",583,0) + ;" 'text' is included as is, even if it is same as a formatting code +"RTN","TMGMISC",584,0) + ;" Other unexpected text will be ignored +"RTN","TMGMISC",585,0) + ;" +"RTN","TMGMISC",586,0) + ;" If a date value of 0 is found for a code, that code is ignored (except for min/sec) +"RTN","TMGMISC",587,0) + ;" +"RTN","TMGMISC",588,0) + ;" Examples: with FMDate=3050215.183000 (i.e. Feb 5, 2005 @ 18:30 0 sec) +"RTN","TMGMISC",589,0) + ;" "mmmm d,yyyy" --> "February 5,2005" +"RTN","TMGMISC",590,0) + ;" "mm d,yyyy" --> "Feb 5,2005" +"RTN","TMGMISC",591,0) + ;" "'Exactly' H:MM # 'on' mm/dd/yy" --> "Exactly 6:30 pm on 02/05/05" +"RTN","TMGMISC",592,0) + ;" "mm/dd/yyyy" --> "02/05/2005" +"RTN","TMGMISC",593,0) + ;" +"RTN","TMGMISC",594,0) + ;" Array -- OPTIONAL, if supplied, SHOULD BE PASSED BY REFERENCE +"RTN","TMGMISC",595,0) + ;" The array will be filled with data as follows: +"RTN","TMGMISC",596,0) + ;" Array(Token)=value for that token (ignores codes such as '/',':' ect) +"RTN","TMGMISC",597,0) + +"RTN","TMGMISC",598,0) + ;"Output: Text of date, as specified by above +"RTN","TMGMISC",599,0) + +"RTN","TMGMISC",600,0) + new result set result="" +"RTN","TMGMISC",601,0) + new Token set Token="" +"RTN","TMGMISC",602,0) + new LastToken set LastToken="" +"RTN","TMGMISC",603,0) + new ch set ch="" +"RTN","TMGMISC",604,0) + new LastCh set LastCh="" +"RTN","TMGMISC",605,0) + new InStr set InStr=0 +"RTN","TMGMISC",606,0) + new done set done=0 +"RTN","TMGMISC",607,0) + new i +"RTN","TMGMISC",608,0) + +"RTN","TMGMISC",609,0) + if $get(format)="" goto FDTDone +"RTN","TMGMISC",610,0) + if +$get(FMDate)=0 goto FDTDone +"RTN","TMGMISC",611,0) + +"RTN","TMGMISC",612,0) + for i=1:1:$length(format) do quit:done +"RTN","TMGMISC",613,0) + . set LastCh=ch +"RTN","TMGMISC",614,0) + . set ch=$extract(format,i) ;"get next char of format string. +"RTN","TMGMISC",615,0) + . if (ch'=LastCh)&(LastCh'="")&(InStr=0) do ProcessToken(FMDate,.Token,.result,.Array) +"RTN","TMGMISC",616,0) + . set Token=Token_ch +"RTN","TMGMISC",617,0) + . if ch="'" do quit +"RTN","TMGMISC",618,0) + . . if InStr do ProcessToken(FMDate,.Token,.result) +"RTN","TMGMISC",619,0) + . . set InStr='InStr ;"toggle In-String mode +"RTN","TMGMISC",620,0) + . if (i=$length(format)) do ProcessToken(FMDate,.Token,.result,.Array) +"RTN","TMGMISC",621,0) + +"RTN","TMGMISC",622,0) +FDTDone +"RTN","TMGMISC",623,0) + quit result +"RTN","TMGMISC",624,0) + +"RTN","TMGMISC",625,0) + +"RTN","TMGMISC",626,0) +ProcessToken(FMDate,Token,Output,Array) +"RTN","TMGMISC",627,0) + ;"SCOPE: PRIVATE +"RTN","TMGMISC",628,0) + ;"Purpose: To take tokens and build output following rules specified by DTFormat) +"RTN","TMGMISC",629,0) + ;"Input: FMDate -- the date to work with +"RTN","TMGMISC",630,0) + ;" Token -- SHOULD BE PASSED BY REFERENCE. The code as oulined in DTFormat +"RTN","TMGMISC",631,0) + ;" Output -- SHOULD BE PASSED BY REFERENCE. The cumulative output +"RTN","TMGMISC",632,0) + ;" Array -- OPTIONAL, if supplied, SHOULD BE PASSED BY REFERENCE +"RTN","TMGMISC",633,0) + ;" The array will be filled with data as follows: +"RTN","TMGMISC",634,0) + ;" Array(Token)=value for that token (ignores codes such as '/') +"RTN","TMGMISC",635,0) + +"RTN","TMGMISC",636,0) + +"RTN","TMGMISC",637,0) + if $extract(Token,1,1)="'" do goto PTDone +"RTN","TMGMISC",638,0) + . new Str set Str=$extract(Token,2,$length(Token)-1) +"RTN","TMGMISC",639,0) + . set Output=Output_Str +"RTN","TMGMISC",640,0) + +"RTN","TMGMISC",641,0) + if Token=" " set Output=Output_Token goto PTDone +"RTN","TMGMISC",642,0) + if Token="." set Output=Output_Token goto PTDone +"RTN","TMGMISC",643,0) + if Token=":" set Output=Output_Token goto PTDone +"RTN","TMGMISC",644,0) + if Token="/" set Output=Output_Token goto PTDone +"RTN","TMGMISC",645,0) + if Token=";" set Output=Output_Token goto PTDone +"RTN","TMGMISC",646,0) + if Token="," set Output=Output_Token goto PTDone +"RTN","TMGMISC",647,0) + if Token="-" set Output=Output_Token goto PTDone +"RTN","TMGMISC",648,0) + if Token="@" set Output=Output_Token goto PTDone +"RTN","TMGMISC",649,0) + +"RTN","TMGMISC",650,0) + if Token="yy" do goto PTDone +"RTN","TMGMISC",651,0) + . new Year set Year=+$extract(FMDate,1,3) +"RTN","TMGMISC",652,0) + . if Year=0 quit +"RTN","TMGMISC",653,0) + . set Year=+$extract(FMDate,2,3) +"RTN","TMGMISC",654,0) + . if Year<10 set Year="0"_Year +"RTN","TMGMISC",655,0) + . set Output=Output_Year +"RTN","TMGMISC",656,0) + . set Array(Token)=Year; +"RTN","TMGMISC",657,0) + +"RTN","TMGMISC",658,0) + if Token="yyyy" do goto PTDone +"RTN","TMGMISC",659,0) + . new Year set Year=+$extract(FMDate,1,3) +"RTN","TMGMISC",660,0) + . if Year>0 do +"RTN","TMGMISC",661,0) + . . set Year=Year+1700 +"RTN","TMGMISC",662,0) + . . set Output=Output_Year +"RTN","TMGMISC",663,0) + . . set Array(Token)=Year +"RTN","TMGMISC",664,0) + +"RTN","TMGMISC",665,0) + if Token="m" do goto PTDone +"RTN","TMGMISC",666,0) + . new Month set Month=+$extract(FMDate,4,5) +"RTN","TMGMISC",667,0) + . if Month>0 do +"RTN","TMGMISC",668,0) + . . set Output=Output_Month +"RTN","TMGMISC",669,0) + . . set Array(Token)=Month +"RTN","TMGMISC",670,0) + +"RTN","TMGMISC",671,0) + if Token="mm" do goto PTDone +"RTN","TMGMISC",672,0) + . new Month set Month=+$extract(FMDate,4,5) +"RTN","TMGMISC",673,0) + . if Month=0 quit +"RTN","TMGMISC",674,0) + . if Month<10 set Month="0"_Month +"RTN","TMGMISC",675,0) + . set Output=Output_Month +"RTN","TMGMISC",676,0) + . set Array(Token)=Month +"RTN","TMGMISC",677,0) + +"RTN","TMGMISC",678,0) + if Token="mmm" do goto PTDone +"RTN","TMGMISC",679,0) + . new Month set Month=+$extract(FMDate,4,5) +"RTN","TMGMISC",680,0) + . if Month=0 quit +"RTN","TMGMISC",681,0) + . else if Month=1 set Month="Jan" +"RTN","TMGMISC",682,0) + . else if Month=2 set Month="Feb" +"RTN","TMGMISC",683,0) + . else if Month=3 set Month="Mar" +"RTN","TMGMISC",684,0) + . else if Month=4 set Month="Apr" +"RTN","TMGMISC",685,0) + . else if Month=5 set Month="May" +"RTN","TMGMISC",686,0) + . else if Month=6 set Month="Jun" +"RTN","TMGMISC",687,0) + . else if Month=7 set Month="Jul" +"RTN","TMGMISC",688,0) + . else if Month=8 set Month="Aug" +"RTN","TMGMISC",689,0) + . else if Month=9 set Month="Sept" +"RTN","TMGMISC",690,0) + . else if Month=10 set Month="Oct" +"RTN","TMGMISC",691,0) + . else if Month=11 set Month="Nov" +"RTN","TMGMISC",692,0) + . else if Month=12 set Month="Dec" +"RTN","TMGMISC",693,0) + . if +Month=0 do +"RTN","TMGMISC",694,0) + . . set Output=Output_Month +"RTN","TMGMISC",695,0) + . . set Array(Token)=Month +"RTN","TMGMISC",696,0) + +"RTN","TMGMISC",697,0) + if Token="mmmm" do goto PTDone +"RTN","TMGMISC",698,0) + . new Month set Month=+$extract(FMDate,4,5) +"RTN","TMGMISC",699,0) + . if Month=0 quit +"RTN","TMGMISC",700,0) + . else if Month=1 set Month="January" +"RTN","TMGMISC",701,0) + . else if Month=2 set Month="February" +"RTN","TMGMISC",702,0) + . else if Month=3 set Month="March" +"RTN","TMGMISC",703,0) + . else if Month=4 set Month="April" +"RTN","TMGMISC",704,0) + . else if Month=5 set Month="May" +"RTN","TMGMISC",705,0) + . else if Month=6 set Month="June" +"RTN","TMGMISC",706,0) + . else if Month=7 set Month="July" +"RTN","TMGMISC",707,0) + . else if Month=8 set Month="August" +"RTN","TMGMISC",708,0) + . else if Month=9 set Month="September" +"RTN","TMGMISC",709,0) + . else if Month=10 set Month="October" +"RTN","TMGMISC",710,0) + . else if Month=11 set Month="November" +"RTN","TMGMISC",711,0) + . else if Month=12 set Month="December" +"RTN","TMGMISC",712,0) + . else if +Month=0 do +"RTN","TMGMISC",713,0) + . . set Output=Output_Month +"RTN","TMGMISC",714,0) + . . set Array(Token)=Month +"RTN","TMGMISC",715,0) + +"RTN","TMGMISC",716,0) + if Token="d" do goto PTDone +"RTN","TMGMISC",717,0) + . new Day set Day=+$extract(FMDate,6,7) +"RTN","TMGMISC",718,0) + . if Day>0 do +"RTN","TMGMISC",719,0) + . . set Output=Output_Day +"RTN","TMGMISC",720,0) + . . set Array(Token)=Day +"RTN","TMGMISC",721,0) + +"RTN","TMGMISC",722,0) + if Token="dd" do goto PTDone +"RTN","TMGMISC",723,0) + . new Day set Day=+$extract(FMDate,6,7) +"RTN","TMGMISC",724,0) + . if Day=0 quit +"RTN","TMGMISC",725,0) + . if Day<10 set Day="0"_Day +"RTN","TMGMISC",726,0) + . set Output=Output_Day +"RTN","TMGMISC",727,0) + . set Array(Token)=Day +"RTN","TMGMISC",728,0) + +"RTN","TMGMISC",729,0) + if Token="w" do goto PTDone +"RTN","TMGMISC",730,0) + . new DOW set DOW=$$DOW^XLFDT(FMDate,1) +"RTN","TMGMISC",731,0) + . if DOW>0 do +"RTN","TMGMISC",732,0) + . . set Output=Output_DOW +"RTN","TMGMISC",733,0) + . . set Array(Token)=DOW +"RTN","TMGMISC",734,0) + +"RTN","TMGMISC",735,0) + if Token="ww" do goto PTDone +"RTN","TMGMISC",736,0) + . new DOW set DOW=$$DOW^XLFDT(FMDate,1) +"RTN","TMGMISC",737,0) + . if (DOW<0)!(DOW>6) quit +"RTN","TMGMISC",738,0) + . if DOW=0 set DOW="Sun" +"RTN","TMGMISC",739,0) + . if DOW=1 set DOW="Mon" +"RTN","TMGMISC",740,0) + . if DOW=2 set DOW="Tue" +"RTN","TMGMISC",741,0) + . if DOW=3 set DOW="Wed" +"RTN","TMGMISC",742,0) + . if DOW=4 set DOW="Thur" +"RTN","TMGMISC",743,0) + . if DOW=5 set DOW="Fri" +"RTN","TMGMISC",744,0) + . if DOW=6 set DOW="Sat" +"RTN","TMGMISC",745,0) + . set Output=Output_DOW +"RTN","TMGMISC",746,0) + . set Array(Token)=DOW +"RTN","TMGMISC",747,0) + +"RTN","TMGMISC",748,0) + if Token="www" do goto PTDone +"RTN","TMGMISC",749,0) + . new DOW set DOW=$$DOW^XLFDT(FMDate) +"RTN","TMGMISC",750,0) + . if DOW'="day" do +"RTN","TMGMISC",751,0) + . . set Output=Output_DOW +"RTN","TMGMISC",752,0) + . . set Array(Token)=DOW +"RTN","TMGMISC",753,0) + +"RTN","TMGMISC",754,0) + if Token="h" do goto PTDone +"RTN","TMGMISC",755,0) + . new Hour set Hour=+$extract(FMDate,9,10) +"RTN","TMGMISC",756,0) + . if Hour>0 do +"RTN","TMGMISC",757,0) + . . set Output=Output_Hour +"RTN","TMGMISC",758,0) + . . set Array(Token)=Hour +"RTN","TMGMISC",759,0) + +"RTN","TMGMISC",760,0) + if Token="hh" do goto PTDone +"RTN","TMGMISC",761,0) + . new Hour set Hour=+$extract(FMDate,9,10) +"RTN","TMGMISC",762,0) + . if Hour=0 quit +"RTN","TMGMISC",763,0) + . if Hour<10 set Hour="0"_Hour +"RTN","TMGMISC",764,0) + . set Output=Output_Hour +"RTN","TMGMISC",765,0) + . set Array(Token)=Hour +"RTN","TMGMISC",766,0) + +"RTN","TMGMISC",767,0) + if Token="H" do goto PTDone +"RTN","TMGMISC",768,0) + . new Hour set Hour=+$extract(FMDate,9,10) +"RTN","TMGMISC",769,0) + . if Hour>12 set Hour=Hour-12 +"RTN","TMGMISC",770,0) + . if Hour>0 do +"RTN","TMGMISC",771,0) + . . set Output=Output_Hour +"RTN","TMGMISC",772,0) + . . set Array(Token)=Hour +"RTN","TMGMISC",773,0) + +"RTN","TMGMISC",774,0) + if Token="HH" do goto PTDone +"RTN","TMGMISC",775,0) + . new Hour set Hour=+$extract(FMDate,9,10) +"RTN","TMGMISC",776,0) + . if Hour=0 quit +"RTN","TMGMISC",777,0) + . if Hour>12 set Hour=Hour-12 +"RTN","TMGMISC",778,0) + . if Hour<10 set Hour="0"_Hour +"RTN","TMGMISC",779,0) + . set Output=Output_Hour +"RTN","TMGMISC",780,0) + . set Array(Token)=Hour +"RTN","TMGMISC",781,0) + +"RTN","TMGMISC",782,0) + if Token="#" do goto PTDone +"RTN","TMGMISC",783,0) + . new Hour set Hour=+$extract(FMDate,9,10) +"RTN","TMGMISC",784,0) + . new code +"RTN","TMGMISC",785,0) + . if Hour=0 quit +"RTN","TMGMISC",786,0) + . if Hour>12 set code="pm" +"RTN","TMGMISC",787,0) + . else set code="am" +"RTN","TMGMISC",788,0) + . set Output=Output_code +"RTN","TMGMISC",789,0) + . set Array(Token)=code +"RTN","TMGMISC",790,0) + +"RTN","TMGMISC",791,0) + new Min set Min=+$extract(FMDate,11,12) +"RTN","TMGMISC",792,0) + +"RTN","TMGMISC",793,0) + if Token="M" do goto PTDone +"RTN","TMGMISC",794,0) + . new Min set Min=+$extract(FMDate,11,12) +"RTN","TMGMISC",795,0) + . set Output=Output_Min +"RTN","TMGMISC",796,0) + . set Array(Token)=Min +"RTN","TMGMISC",797,0) + +"RTN","TMGMISC",798,0) + if Token="MM" do goto PTDone +"RTN","TMGMISC",799,0) + . new Min set Min=+$extract(FMDate,11,12) +"RTN","TMGMISC",800,0) + . if Min<10 set Min="0"_Min +"RTN","TMGMISC",801,0) + . set Output=Output_Min +"RTN","TMGMISC",802,0) + . set Array(Token)=Min +"RTN","TMGMISC",803,0) + +"RTN","TMGMISC",804,0) + if Token="s" do goto PTDone +"RTN","TMGMISC",805,0) + . new Sec set Sec=+$extract(FMDate,13,14) +"RTN","TMGMISC",806,0) + . set Output=Output_Sec +"RTN","TMGMISC",807,0) + . set Array(Token)=Sec +"RTN","TMGMISC",808,0) + +"RTN","TMGMISC",809,0) + if Token="ss" do goto PTDone +"RTN","TMGMISC",810,0) + . new Sec set Sec=+$extract(FMDate,13,14) +"RTN","TMGMISC",811,0) + . if Sec<10 set Sec="0"_Sec +"RTN","TMGMISC",812,0) + . set Output=Output_Sec +"RTN","TMGMISC",813,0) + . set Array(Token)=Sec +"RTN","TMGMISC",814,0) + +"RTN","TMGMISC",815,0) +PTDone +"RTN","TMGMISC",816,0) + set Token="" +"RTN","TMGMISC",817,0) + quit +"RTN","TMGMISC",818,0) + +"RTN","TMGMISC",819,0) + +"RTN","TMGMISC",820,0) + +"RTN","TMGMISC",821,0) + +"RTN","TMGMISC",822,0) +CompDOB(DOB1,DOB2) +"RTN","TMGMISC",823,0) + ;"Purpose: to compare two DOB and return if they match, or are similar +"RTN","TMGMISC",824,0) + ;"Input: DOB1,DOB2 -- the two values to compare (in external format) +"RTN","TMGMISC",825,0) + ;"Result: 0 - no similarity or equality +"RTN","TMGMISC",826,0) + ;" 0.25 - doubt similarity +"RTN","TMGMISC",827,0) + ;" 0.50 - possible similarity +"RTN","TMGMISC",828,0) + ;" 0.75 - probable similarity +"RTN","TMGMISC",829,0) + ;" 1 - exact match +"RTN","TMGMISC",830,0) + ;"Note: I made this function because during lookups, I would get failures with data such as: +"RTN","TMGMISC",831,0) + ;" WILLIAM,JOHN G JR 05-21-60 +"RTN","TMGMISC",832,0) + ;" WILLIAM,JOHN G JR 05-11-60 <-- date differs by one digit. +"RTN","TMGMISC",833,0) + ;"Rules for comparision +"RTN","TMGMISC",834,0) + ;" if dates differ by 1 digit --> score of 0.75 +"RTN","TMGMISC",835,0) + ;" if dates differ by an absolute difference of < 1 months --> 0.75 +"RTN","TMGMISC",836,0) + ;" if dates differ by an absolute difference of < 6 months --> 0.50 +"RTN","TMGMISC",837,0) + ;" if dates differ by an absolute difference of < 1 year --> 0.25 +"RTN","TMGMISC",838,0) + ;" if dates differ by 2 digits --> 0.25 +"RTN","TMGMISC",839,0) + +"RTN","TMGMISC",840,0) + new DT1,DT2 +"RTN","TMGMISC",841,0) + new result set result=0 +"RTN","TMGMISC",842,0) + +"RTN","TMGMISC",843,0) + new %DT +"RTN","TMGMISC",844,0) + set X=DOB1 do ^%DT set DT1=Y ;"convert into internal format to avoid format snafu's +"RTN","TMGMISC",845,0) + set X=DOB2 do ^%DT set DT2=Y +"RTN","TMGMISC",846,0) + +"RTN","TMGMISC",847,0) + new DT1array,DT2array +"RTN","TMGMISC",848,0) + new temp +"RTN","TMGMISC",849,0) + if DT1=DT2 set result=1 goto CDOBDone +"RTN","TMGMISC",850,0) + +"RTN","TMGMISC",851,0) + set temp=$$DTFormat^TMGMISC(DT1,"mm/dd/yy",.DT1array) ;"parse date parts into array. +"RTN","TMGMISC",852,0) + set temp=$$DTFormat^TMGMISC(DT2,"mm/dd/yy",.DT2array) +"RTN","TMGMISC",853,0) + +"RTN","TMGMISC",854,0) + ;"Compare digits +"RTN","TMGMISC",855,0) + new NumDif set NumDif=0 +"RTN","TMGMISC",856,0) + new dg1,dg2 +"RTN","TMGMISC",857,0) + +"RTN","TMGMISC",858,0) + set dg1=$extract($get(DT1array("dd")),1,1) set dg2=$extract($get(DT2array("dd")),1,1) +"RTN","TMGMISC",859,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",860,0) + set dg1=$extract($get(DT1array("dd")),2,2) set dg2=$extract($get(DT2array("dd")),2,2) +"RTN","TMGMISC",861,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",862,0) + +"RTN","TMGMISC",863,0) + set dg1=$extract($get(DT1array("mm")),1,1) set dg2=$extract($get(DT2array("mm")),1,1) +"RTN","TMGMISC",864,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",865,0) + set dg1=$extract($get(DT1array("mm")),2,2) set dg2=$extract($get(DT2array("mm")),2,2) +"RTN","TMGMISC",866,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",867,0) + +"RTN","TMGMISC",868,0) + set dg1=$extract($get(DT1array("yy")),1,1) set dg2=$extract($get(DT2array("yy")),1,1) +"RTN","TMGMISC",869,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",870,0) + set dg1=$extract($get(DT1array("yy")),2,2) set dg2=$extract($get(DT2array("yy")),2,2) +"RTN","TMGMISC",871,0) + if dg1'=dg2 set NumDif=NumDif+1 +"RTN","TMGMISC",872,0) + +"RTN","TMGMISC",873,0) + if NumDif=1 set result=0.75 goto CDOBDone +"RTN","TMGMISC",874,0) + if NumDif=2 set result=0.50 +"RTN","TMGMISC",875,0) + +"RTN","TMGMISC",876,0) + ;"Compare absolute date +"RTN","TMGMISC",877,0) + new H1,H2,DateDif +"RTN","TMGMISC",878,0) + set H1=$$FMTH^XLFDT(DT1,1) +"RTN","TMGMISC",879,0) + set H2=$$FMTH^XLFDT(DT2,1) +"RTN","TMGMISC",880,0) + set DateDif=$$HDIFF^XLFDT(H1,H2,1) ;"1=results in 'days' +"RTN","TMGMISC",881,0) + if $$HDIFF^XLFDT(H2,H1)>DateDif set DateDif=$$HDIFF^XLFDT(H2,H1) +"RTN","TMGMISC",882,0) + +"RTN","TMGMISC",883,0) + new score set score=0 +"RTN","TMGMISC",884,0) + if DateDif<30 set score=0.75 +"RTN","TMGMISC",885,0) + if DateDif<(30*6) set score=0.50 +"RTN","TMGMISC",886,0) + if DateDif<365 set score=0.25 +"RTN","TMGMISC",887,0) + +"RTN","TMGMISC",888,0) + if score>result set result=score +"RTN","TMGMISC",889,0) + +"RTN","TMGMISC",890,0) +CDOBDone +"RTN","TMGMISC",891,0) + quit result +"RTN","TMGMISC",892,0) + +"RTN","TMGMISC",893,0) + +"RTN","TMGMISC",894,0) + +"RTN","TMGMISC",895,0) +BrowseBy(CompArray,ByTag) +"RTN","TMGMISC",896,0) + ;"Purpose: Allow a user to interact with dynamic text tree +"RTN","TMGMISC",897,0) + ;" that will open and close nodes. +"RTN","TMGMISC",898,0) + ;"Input: CompArray -- array to browse. Should be in this format +"RTN","TMGMISC",899,0) + ;" CompArray("opening tag",a,b,c,d) +"RTN","TMGMISC",900,0) + ;" ByTag -- the name to use in for "opening tag") +"RTN","TMGMISC",901,0) + +"RTN","TMGMISC",902,0) + new aOpen set aOpen=0 +"RTN","TMGMISC",903,0) + new bOpen set bOpen=0 +"RTN","TMGMISC",904,0) + new cOpen set cOpen=0 +"RTN","TMGMISC",905,0) + +"RTN","TMGMISC",906,0) + new done set done=0 +"RTN","TMGMISC",907,0) + new input +"RTN","TMGMISC",908,0) + +"RTN","TMGMISC",909,0) + for do quit:(done=1) +"RTN","TMGMISC",910,0) + . do ShowBy(.CompArray,ByTag,aOpen,bOpen,cOpen) +"RTN","TMGMISC",911,0) + . read "Enter option:",input:$get(DTIME,3600),! +"RTN","TMGMISC",912,0) + . if input="" set input=0 +"RTN","TMGMISC",913,0) + . if +input>0 do +"RTN","TMGMISC",914,0) + . . if aOpen=0 do +"RTN","TMGMISC",915,0) + . . . set aOpen=input,bOpen=0,cOpen=0 +"RTN","TMGMISC",916,0) + . . else if bOpen=0 do +"RTN","TMGMISC",917,0) + . . . set bOpen=input,cOpen=0 +"RTN","TMGMISC",918,0) + . . else if cOpen=0 set cOpen=input +"RTN","TMGMISC",919,0) + . else if input=0 do +"RTN","TMGMISC",920,0) + . . if cOpen'=0 set cOpen=0 quit +"RTN","TMGMISC",921,0) + . . if bOpen'=0 set bOpen=0 quit +"RTN","TMGMISC",922,0) + . . set aOpen=0 +"RTN","TMGMISC",923,0) + . else if input="^" set done=1 +"RTN","TMGMISC",924,0) + +"RTN","TMGMISC",925,0) + quit +"RTN","TMGMISC",926,0) + +"RTN","TMGMISC",927,0) + +"RTN","TMGMISC",928,0) +ShowBy(CompArray,ByTag,aOpen,bOpen,cOpen) +"RTN","TMGMISC",929,0) + +"RTN","TMGMISC",930,0) + new a,b,c,d +"RTN","TMGMISC",931,0) + new acount set acount=0 +"RTN","TMGMISC",932,0) + new bcount set bcount=0 +"RTN","TMGMISC",933,0) + new ccount set ccount=0 +"RTN","TMGMISC",934,0) + new dcount set dcount=0 +"RTN","TMGMISC",935,0) + +"RTN","TMGMISC",936,0) + write # +"RTN","TMGMISC",937,0) + +"RTN","TMGMISC",938,0) + set a=$order(CompArray(ByTag,"")) +"RTN","TMGMISC",939,0) + if a'="" for do quit:(a="") +"RTN","TMGMISC",940,0) + . set acount=acount+1 +"RTN","TMGMISC",941,0) + . new nexta set nexta=$order(CompArray(ByTag,a)) +"RTN","TMGMISC",942,0) + . new Aindent +"RTN","TMGMISC",943,0) + . if (aOpen=0) do +"RTN","TMGMISC",944,0) + . . if acount<10 write "0" +"RTN","TMGMISC",945,0) + . . write acount,". " +"RTN","TMGMISC",946,0) + . else write "... " +"RTN","TMGMISC",947,0) + . write a,! +"RTN","TMGMISC",948,0) + . set b=$order(CompArray(ByTag,a,"")) +"RTN","TMGMISC",949,0) + . if (aOpen=acount)&(b'="") for do quit:(b="") +"RTN","TMGMISC",950,0) + . . set bcount=bcount+1 +"RTN","TMGMISC",951,0) + . . new nextb set nextb=$order(CompArray(ByTag,a,b)) +"RTN","TMGMISC",952,0) + . . new Bindent +"RTN","TMGMISC",953,0) + . . write " +--" +"RTN","TMGMISC",954,0) + . . if (bOpen=0) do +"RTN","TMGMISC",955,0) + . . . if bcount<10 write "0" +"RTN","TMGMISC",956,0) + . . . write bcount,". " +"RTN","TMGMISC",957,0) + . . else write "... " +"RTN","TMGMISC",958,0) + . . write b,! +"RTN","TMGMISC",959,0) + . . if nextb'="" set Aindent=" | " +"RTN","TMGMISC",960,0) + . . else set Aindent=" " +"RTN","TMGMISC",961,0) + . . set c=$order(CompArray(ByTag,a,b,"")) +"RTN","TMGMISC",962,0) + . . if (bOpen=bcount)&(c'="") for do quit:(c="") +"RTN","TMGMISC",963,0) + . . . set ccount=ccount+1 +"RTN","TMGMISC",964,0) + . . . new nextc set nextc=$order(CompArray(ByTag,a,b,c)) +"RTN","TMGMISC",965,0) + . . . if nextc'="" set Bindent=" | " +"RTN","TMGMISC",966,0) + . . . else set Bindent=" " +"RTN","TMGMISC",967,0) + . . . write Aindent," +--" +"RTN","TMGMISC",968,0) + . . . if (cOpen=0) do +"RTN","TMGMISC",969,0) + . . . . if ccount<10 write "0" +"RTN","TMGMISC",970,0) + . . . . write ccount,". " +"RTN","TMGMISC",971,0) + . . . else write "... " +"RTN","TMGMISC",972,0) + . . . write c,! +"RTN","TMGMISC",973,0) + . . . set d=$order(CompArray(ByTag,a,b,c,"")) +"RTN","TMGMISC",974,0) + . . . if (cOpen=ccount)&(d'="") for do quit:(d="") +"RTN","TMGMISC",975,0) + . . . . set dcount=dcount+1 +"RTN","TMGMISC",976,0) + . . . . write Aindent,Bindent," +-- " +"RTN","TMGMISC",977,0) + . . . . if dcount<10 write "0" +"RTN","TMGMISC",978,0) + . . . . write dcount,". " +"RTN","TMGMISC",979,0) + . . . . write d,! +"RTN","TMGMISC",980,0) + . . . . set d=$order(CompArray(ByTag,a,b,c,d)) +"RTN","TMGMISC",981,0) + . . . set c=nextc +"RTN","TMGMISC",982,0) + . . set b=nextb +"RTN","TMGMISC",983,0) + . set a=nexta +"RTN","TMGMISC",984,0) + +"RTN","TMGMISC",985,0) +SBDone +"RTN","TMGMISC",986,0) + quit +"RTN","TMGMISC",987,0) + +"RTN","TMGMISC",988,0) + +"RTN","TMGMISC",989,0) + +"RTN","TMGMISC",990,0) +CompName(Name1,Name2) +"RTN","TMGMISC",991,0) + ;"Purpose: To compare two names, to see if they are the name, or compatible. +"RTN","TMGMISC",992,0) + ;" e.g. WILLIAMS,J BILL vs. WILLAMS,JOHN BILL, vs. WILLIAMS,JOHN B +"RTN","TMGMISC",993,0) + ;"Input: Two names to compare +"RTN","TMGMISC",994,0) + ;"Result: 0 -- if entries conflict +"RTN","TMGMISC",995,0) + ;" 0.5 -- if entries are consistent (i.e. in example above) +"RTN","TMGMISC",996,0) + ;" 1 -- if entries completely match +"RTN","TMGMISC",997,0) + ;"Note: This function WILL IGNORE a suffix. This is because +"RTN","TMGMISC",998,0) + ;" WILLIAM,BILL 5-1-1950 +"RTN","TMGMISC",999,0) + ;" WILLIAM,BILL SR 5-1-1950 +"RTN","TMGMISC",1000,0) + ;" would be considered the same person (the date is the determining factor) +"RTN","TMGMISC",1001,0) + ;"Rules: Last names must completely match or --> 0 +"RTN","TMGMISC",1002,0) + ;" If name is exactly the same, then --> 1 +"RTN","TMGMISC",1003,0) + ;" Initial must be same as first letters in name (e.g. N vs. NEWTON) --> 0.5 +"RTN","TMGMISC",1004,0) + +"RTN","TMGMISC",1005,0) + new result set result=1 +"RTN","TMGMISC",1006,0) + +"RTN","TMGMISC",1007,0) + new NArray1,NArray2,TMGMsg +"RTN","TMGMISC",1008,0) + +"RTN","TMGMISC",1009,0) + set Name1=$$FormatName(Name1,1) ;"should convert to standard format. +"RTN","TMGMISC",1010,0) + set Name2=$$FormatName(Name2,1) +"RTN","TMGMISC",1011,0) + +"RTN","TMGMISC",1012,0) + do STDNAME^XLFNAME(.Name1,"C",.TMGMsg) +"RTN","TMGMISC",1013,0) + do STDNAME^XLFNAME(.Name1,"C",.TMGMsg) ;"Doing a second time will ensure Array not in initial format. +"RTN","TMGMISC",1014,0) + +"RTN","TMGMISC",1015,0) + do STDNAME^XLFNAME(.Name2,"C",.TMGMsg) +"RTN","TMGMISC",1016,0) + do STDNAME^XLFNAME(.Name2,"C",.TMGMsg) ;"Doing a second time will ensure Array not in initial format. +"RTN","TMGMISC",1017,0) + +"RTN","TMGMISC",1018,0) + if Name1=Name2 set result=1 goto CompNDone +"RTN","TMGMISC",1019,0) + if Name1("FAMILY")'=Name2("FAMILY") do goto:(result=0) CompNDone +"RTN","TMGMISC",1020,0) + . if $$EN^XUA4A71(Name1("FAMILY"))'=$$EN^XUA4A71(Name2("FAMILY")) set result=0 ;"check soundex equality +"RTN","TMGMISC",1021,0) + +"RTN","TMGMISC",1022,0) + if Name1("GIVEN")'=Name2("GIVEN") do +"RTN","TMGMISC",1023,0) + . if $$EN^XUA4A71(Name1("GIVEN"))=$$EN^XUA4A71(Name2("GIVEN")) quit ;"check soundex equality +"RTN","TMGMISC",1024,0) + . new n1,n2 +"RTN","TMGMISC",1025,0) + . set n1=Name1("GIVEN") +"RTN","TMGMISC",1026,0) + . set n2=Name2("GIVEN") +"RTN","TMGMISC",1027,0) + . if $length(n2)<$length(n1) do ;"ensure length n2>n1 +"RTN","TMGMISC",1028,0) + . . new temp set temp=n2 +"RTN","TMGMISC",1029,0) + . . set n2=n1,n1=temp +"RTN","TMGMISC",1030,0) + . if $extract(n2,1,$length(n1))=n1 set result=0.5 +"RTN","TMGMISC",1031,0) + . else set result=0 +"RTN","TMGMISC",1032,0) + if result=0 goto CompNDone +"RTN","TMGMISC",1033,0) + +"RTN","TMGMISC",1034,0) + if Name1("MIDDLE")'=Name2("MIDDLE") do +"RTN","TMGMISC",1035,0) + . if $$EN^XUA4A71(Name1("MIDDLE"))=$$EN^XUA4A71(Name2("MIDDLE")) quit ;"check soundex equality +"RTN","TMGMISC",1036,0) + . new n1,n2 +"RTN","TMGMISC",1037,0) + . set n1=Name1("MIDDLE") +"RTN","TMGMISC",1038,0) + . set n2=Name2("MIDDLE") +"RTN","TMGMISC",1039,0) + . if $length(n2)<$length(n1) do ;"ensure length n2>n1 +"RTN","TMGMISC",1040,0) + . . new temp set temp=n2 +"RTN","TMGMISC",1041,0) + . . set n2=n1,n1=temp +"RTN","TMGMISC",1042,0) + . if $extract(n2,1,$length(n1))=n1 set result=0.5 +"RTN","TMGMISC",1043,0) + . else set result=0 +"RTN","TMGMISC",1044,0) + if result=0 goto CompNDone +"RTN","TMGMISC",1045,0) + +"RTN","TMGMISC",1046,0) +CompNDone +"RTN","TMGMISC",1047,0) + quit result +"RTN","TMGMISC",1048,0) + +"RTN","TMGMISC",1049,0) + +"RTN","TMGMISC",1050,0) + +"RTN","TMGMISC",1051,0) +FormatName(Name,CutTitle) +"RTN","TMGMISC",1052,0) + ;"Purpose: To ensure patient name is properly formated. +"RTN","TMGMISC",1053,0) + ;" i.e. John G. Doe --> DOE,JOHN G +"RTN","TMGMISC",1054,0) + ;" John G. Doe III --> DOE,JOHN G III +"RTN","TMGMISC",1055,0) + ;" John G. Doe,III --> DOE,JOHN G III +"RTN","TMGMISC",1056,0) + ;" Doe, John G --> DOE,JOHN G +"RTN","TMGMISC",1057,0) + ;" Doe,John g.,III, phd --> DOE,JOHN G III PHD +"RTN","TMGMISC",1058,0) + ;"Input: Name -- the name to be reformated +"RTN","TMGMISC",1059,0) + ;" CutTitle -- OPTIONAL -- if 1, then titles (e.g. MD, PhD etc) will be cut +"RTN","TMGMISC",1060,0) + ;"Results: returns properly formated name +"RTN","TMGMISC",1061,0) + ;"Note: If Name is passed by reference, it will be changed +"RTN","TMGMISC",1062,0) + ;" Also, NO lookup is done in database to ensure name exists +"RTN","TMGMISC",1063,0) + +"RTN","TMGMISC",1064,0) + ;"Note: this function malfunctioned on a patient with name like this: +"RTN","TMGMISC",1065,0) + ;" JOHN A VAN DER BON --> BON,JOHN A VAN DER (should be VAN DER BON,JOHN A) +"RTN","TMGMISC",1066,0) + ;" I don't have a quick for this right now... +"RTN","TMGMISC",1067,0) + ;"Also, Sue St. Clair --> CLAIR,SUE ST this is also wrong. +"RTN","TMGMISC",1068,0) + +"RTN","TMGMISC",1069,0) + ;"FYI: do STDNAME^XLFNAME(.NAME,FLAGS,.ERRARRAY) can also do standardization, +"RTN","TMGMISC",1070,0) + ;" and also parse to component parts. It specifically address the St. Clair issue. +"RTN","TMGMISC",1071,0) + +"RTN","TMGMISC",1072,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FormatName^TMGGDFN") +"RTN","TMGMISC",1073,0) + +"RTN","TMGMISC",1074,0) + new NameArray +"RTN","TMGMISC",1075,0) + new MaxNode +"RTN","TMGMISC",1076,0) + new Suffix set Suffix="" +"RTN","TMGMISC",1077,0) + new i,s,lname +"RTN","TMGMISC",1078,0) + new fname set fname="" +"RTN","TMGMISC",1079,0) + new result set result="" +"RTN","TMGMISC",1080,0) + if $data(Name)#10=0 goto FormatNDone +"RTN","TMGMISC",1081,0) + +"RTN","TMGMISC",1082,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Person's name initially is: '",Name,"'") +"RTN","TMGMISC",1083,0) + set Name=$translate(Name,"*.","") ;"cleans off any *'s or .'s from initials etc. +"RTN","TMGMISC",1084,0) + if Name[", " do +"RTN","TMGMISC",1085,0) + . new s1,s2 +"RTN","TMGMISC",1086,0) + . set s1=$piece(Name,", ",1) +"RTN","TMGMISC",1087,0) + . set s2=$piece(Name,", ",2) +"RTN","TMGMISC",1088,0) + . if $$IsTitle($$UP^XLFSTR(s2))&($get(CutTitle)=1) do +"RTN","TMGMISC",1089,0) + . . set Name=s1 +"RTN","TMGMISC",1090,0) + . else do +"RTN","TMGMISC",1091,0) + . . set Name=s1_","_s2 +"RTN","TMGMISC",1092,0) + . ;"set Name=$translate(Name,", ",",") ;"Convert 'Doe, John' into 'Doe,John' +"RTN","TMGMISC",1093,0) + set Name=$$UP^XLFSTR(Name) ;"convert to upper case +"RTN","TMGMISC",1094,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After translations, name is: '",Name,"'") +"RTN","TMGMISC",1095,0) + set result=$$FORMAT^DPTNAME(Name,3,30) ;"Convert to 'internal' format +"RTN","TMGMISC",1096,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"After $$FORMAT^DPTNAME, name is: '",result,"'") +"RTN","TMGMISC",1097,0) + +"RTN","TMGMISC",1098,0) + ;"Now, test if FORMAT^DPTNAME caused empty name, i.e. +"RTN","TMGMISC",1099,0) + ;" John G Doe --> "" (it wanted Doe,John G) +"RTN","TMGMISC",1100,0) + set lname=$piece(result,",",2) +"RTN","TMGMISC",1101,0) + if $$IsTitle(lname)&($get(CutTitle)=1) do ;"trim off title if not wanted. +"RTN","TMGMISC",1102,0) + . set result=$piece(result,",",1) +"RTN","TMGMISC",1103,0) + . set lname="" +"RTN","TMGMISC",1104,0) + if $$IsSuffix(lname)=1 do +"RTN","TMGMISC",1105,0) + . ;"Here we have 'JOHN DOE,III' --> must be changed to 'DOE,JOHN III' +"RTN","TMGMISC",1106,0) + . set Name=$translate(Name,","," ") ;"First change 'JOHN DOE,III' --> 'JOHN DOE III' +"RTN","TMGMISC",1107,0) + . set result="" ;"signal need to rearrange letters. +"RTN","TMGMISC",1108,0) + if (result="")&(Name'[",") do +"RTN","TMGMISC",1109,0) + . set s=Name +"RTN","TMGMISC",1110,0) + . do CleaveToArray^TMGSTUTL(s," ",.NameArray,1) +"RTN","TMGMISC",1111,0) + . set MaxNode=+$get(NameArray("MAXNODE")) +"RTN","TMGMISC",1112,0) + . if MaxNode=0 quit +"RTN","TMGMISC",1113,0) + . if $get(CutTitle)=1 do +"RTN","TMGMISC",1114,0) + . . if $$IsTitle(NameArray(MaxNode)) do +"RTN","TMGMISC",1115,0) + . . . kill NameArray(MaxNode) +"RTN","TMGMISC",1116,0) + . . . set MaxNode=MaxNode-1 +"RTN","TMGMISC",1117,0) + . . . set NameArray("MAXNODE")=MaxNode +"RTN","TMGMISC",1118,0) + . set lname=NameArray(MaxNode) +"RTN","TMGMISC",1119,0) + . if ($$IsSuffix(lname)=1)!($$IsTitle(lname)) do +"RTN","TMGMISC",1120,0) + . . ;"Change JOHN G DOE III --> JOHN G III DOE (order change in array) +"RTN","TMGMISC",1121,0) + . . set lname=NameArray(MaxNode-1) ;"i.e. DOE +"RTN","TMGMISC",1122,0) + . . set Suffix=NameArray(MaxNode) ;"i.e. III +"RTN","TMGMISC",1123,0) + . . set NameArray(MaxNode)=lname +"RTN","TMGMISC",1124,0) + . . set NameArray(MaxNode-1)=Suffix +"RTN","TMGMISC",1125,0) + . set result=lname_"," +"RTN","TMGMISC",1126,0) + . for i=1:1:MaxNode-1 do +"RTN","TMGMISC",1127,0) + . . set result=result_NameArray(i)_" " +"RTN","TMGMISC",1128,0) + +"RTN","TMGMISC",1129,0) + ;"convert potential 'DOE,JOHN G,III, PHD' --> 'DOE,JOHN G III PHD' +"RTN","TMGMISC",1130,0) + set lname=$piece(result,",",1) +"RTN","TMGMISC",1131,0) + set fname=$piece(result,",",2,99) +"RTN","TMGMISC",1132,0) + set fname=$translate(fname,","," ") +"RTN","TMGMISC",1133,0) + set result=lname_","_fname +"RTN","TMGMISC",1134,0) + +"RTN","TMGMISC",1135,0) + set result=$$Trim^TMGSTUTL(result) +"RTN","TMGMISC",1136,0) + +"RTN","TMGMISC",1137,0) + ;"One last run through, after all custom alterations made. +"RTN","TMGMISC",1138,0) + ;"convert potential 'DOE,JOHN G III PHD' --> 'DOE,JOHN G III PHD' +"RTN","TMGMISC",1139,0) + set result=$$FORMAT^DPTNAME(result,3,30) ;"Convert to 'internal' format +"RTN","TMGMISC",1140,0) + +"RTN","TMGMISC",1141,0) +FormatNDone +"RTN","TMGMISC",1142,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FormatName^TMGGDFN") +"RTN","TMGMISC",1143,0) + quit result +"RTN","TMGMISC",1144,0) + +"RTN","TMGMISC",1145,0) + +"RTN","TMGMISC",1146,0) +IsSuffix(s) +"RTN","TMGMISC",1147,0) + ;"Purpose: to return whether s is a suffix (i.e. I,II,Jr.,Sr. etc.) +"RTN","TMGMISC",1148,0) + ;"Input: s : the string to check +"RTN","TMGMISC",1149,0) + ;"Result 0 if NOT a suffix, 1 if IS a suffix. +"RTN","TMGMISC",1150,0) + +"RTN","TMGMISC",1151,0) + new result set result=0 +"RTN","TMGMISC",1152,0) + +"RTN","TMGMISC",1153,0) + if (s="I")!(s="II")!(s="III")!(s="JR")!(s="SR") set result=1 +"RTN","TMGMISC",1154,0) + +"RTN","TMGMISC",1155,0) + quit result +"RTN","TMGMISC",1156,0) + +"RTN","TMGMISC",1157,0) + +"RTN","TMGMISC",1158,0) +IsTitle(s) +"RTN","TMGMISC",1159,0) + ;"Purpose: to return whether s is a title (i.e. MD,PHD,JD,DDS etc.) +"RTN","TMGMISC",1160,0) + ;"Input: s : the string to check +"RTN","TMGMISC",1161,0) + ;"Result 0 if NOT a suffix, 1 if IS a suffix. +"RTN","TMGMISC",1162,0) + +"RTN","TMGMISC",1163,0) + new result set result=0 +"RTN","TMGMISC",1164,0) + +"RTN","TMGMISC",1165,0) + if (s="MD")!(s="PHD")!(s="JD")!(s="DDS") set result=1 +"RTN","TMGMISC",1166,0) + if (s="FNP")!(s="GNP")!(s="NP")!(s="PA") set result=1 +"RTN","TMGMISC",1167,0) + if (s="RN")!(s="LPN") set result=1 +"RTN","TMGMISC",1168,0) + +"RTN","TMGMISC",1169,0) + quit result +"RTN","TMGMISC",1170,0) + +"RTN","TMGMISC",1171,0) + +"RTN","TMGMISC",1172,0) + +"RTN","TMGMISC",1173,0) +HEXCHR(V) +"RTN","TMGMISC",1174,0) + ;"Scope: PUBLIC +"RTN","TMGMISC",1175,0) + ;"Take one BYTE and return HEX Values +"RTN","TMGMISC",1176,0) + ;"(from Chris Richardson -- thanks!) +"RTN","TMGMISC",1177,0) + new NV,B1,B2 +"RTN","TMGMISC",1178,0) + set NV="0123456789ABCDEF" +"RTN","TMGMISC",1179,0) + set B1=(V#16)+1 ; "0 to 15 becomes 1 to 16 +"RTN","TMGMISC",1180,0) + set B2=(V\16)+1 +"RTN","TMGMISC",1181,0) + quit $E(NV,B2)_$E(NV,B1) +"RTN","TMGMISC",1182,0) + +"RTN","TMGMISC",1183,0) + +"RTN","TMGMISC",1184,0) +HEXCHR2(n,digits) +"RTN","TMGMISC",1185,0) + ;"SCOPE: PUBLIC +"RTN","TMGMISC",1186,0) + ;"Purpose: convert n to hex characters +"RTN","TMGMISC",1187,0) + ;"Input: n -- the number to convert +"RTN","TMGMISC",1188,0) + ;" digits: (optional) number of digits in output. Leading 0's padded to +"RTN","TMGMISC",1189,0) + ;" front of answer to set number of digits. +"RTN","TMGMISC",1190,0) + ;" e.g. if answer is "A", then +"RTN","TMGMISC",1191,0) + ;" 2 -> mandates at least 2 digits ("0A") +"RTN","TMGMISC",1192,0) + ;" 3->3 digits ("00A") +"RTN","TMGMISC",1193,0) + ;"Note: This function is not as fast as HEXCHR(V) +"RTN","TMGMISC",1194,0) + +"RTN","TMGMISC",1195,0) + new lo +"RTN","TMGMISC",1196,0) + new result set result="" +"RTN","TMGMISC",1197,0) + new ch +"RTN","TMGMISC",1198,0) + set digits=$get(digits,1) +"RTN","TMGMISC",1199,0) + +"RTN","TMGMISC",1200,0) + for do quit:(n=0) +"RTN","TMGMISC",1201,0) + . set lo=n#16 +"RTN","TMGMISC",1202,0) + . if (lo<10) set ch=+lo +"RTN","TMGMISC",1203,0) + . else set ch=$char(55+lo) +"RTN","TMGMISC",1204,0) + . set result=ch_result +"RTN","TMGMISC",1205,0) + . set n=n\16 +"RTN","TMGMISC",1206,0) + +"RTN","TMGMISC",1207,0) + if $length(result) 16 +"RTN","TMGMISC",1217,0) + +"RTN","TMGMISC",1218,0) + new multiplier set multiplier=1 +"RTN","TMGMISC",1219,0) + new result set result=0 +"RTN","TMGMISC",1220,0) + +"RTN","TMGMISC",1221,0) + if $extract(s,1)="$" set s=$extract(s,2,$length(s)) +"RTN","TMGMISC",1222,0) + +"RTN","TMGMISC",1223,0) + for do quit:(s="") +"RTN","TMGMISC",1224,0) + . new sStart,sEnd,n +"RTN","TMGMISC",1225,0) + . set sStart=$extract(s,1,$length(s)-1) +"RTN","TMGMISC",1226,0) + . set sEnd=$extract(s,$length(s)) +"RTN","TMGMISC",1227,0) + . if +sEnd=sEnd set n=sEnd +"RTN","TMGMISC",1228,0) + . else set n=($ascii(sEnd)-65)+16 +"RTN","TMGMISC",1229,0) + . set result=result+(n*multiplier) +"RTN","TMGMISC",1230,0) + . set multiplier=multiplier*16 +"RTN","TMGMISC",1231,0) + . set s=sStart +"RTN","TMGMISC",1232,0) + +"RTN","TMGMISC",1233,0) + quit result +"RTN","TMGMISC",1234,0) + +"RTN","TMGMISC",1235,0) + +"RTN","TMGMISC",1236,0) +OR(a,b) +"RTN","TMGMISC",1237,0) + ;"Scope: PUBLIC +"RTN","TMGMISC",1238,0) + ;"Purpose: to perform a bitwise OR on operands a and b +"RTN","TMGMISC",1239,0) + +"RTN","TMGMISC",1240,0) + new result set result=0 +"RTN","TMGMISC",1241,0) + new mult set mult=1 +"RTN","TMGMISC",1242,0) + for do quit:(a'>0)&(b'>0) +"RTN","TMGMISC",1243,0) + . set result=result+(((a#2)!(b#2))*mult) +"RTN","TMGMISC",1244,0) + . set a=a\2,b=b\2,mult=mult*2 +"RTN","TMGMISC",1245,0) + +"RTN","TMGMISC",1246,0) + quit result +"RTN","TMGMISC",1247,0) + +"RTN","TMGMISC",1248,0) + +"RTN","TMGMISC",1249,0) +ParsePos(pos,label,offset,routine,dmod) +"RTN","TMGMISC",1250,0) + ;"Purpose: to convert a pos string (e.g. X+2^ROUTINE$DMOD) into componant parts +"RTN","TMGMISC",1251,0) + ;"Input: pos -- the string, as example above +"RTN","TMGMISC",1252,0) + ;" label -- OUT PARAM, PASS BY REF, would return "x" +"RTN","TMGMISC",1253,0) + ;" offset -- OUT PARAM, PASS BY REF, would return "+2" +"RTN","TMGMISC",1254,0) + ;" routine -- OUT PARAM, PASS BY REF, would return "ROUTINE" +"RTN","TMGMISC",1255,0) + ;" dmod -- OUT PARAM, PASS BY REF, would return "DMOD" +"RTN","TMGMISC",1256,0) + ;"Results: none +"RTN","TMGMISC",1257,0) + ;"Note: results are shortened to 8 characters. +"RTN","TMGMISC",1258,0) + +"RTN","TMGMISC",1259,0) + new s +"RTN","TMGMISC",1260,0) + set s=$get(pos) +"RTN","TMGMISC",1261,0) + set dmod=$piece(s,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE +"RTN","TMGMISC",1262,0) + set routine=$piece(s,"^",2) +"RTN","TMGMISC",1263,0) + set routine=$extract(routine,1,8) +"RTN","TMGMISC",1264,0) + set label=$piece(s,"^",1) +"RTN","TMGMISC",1265,0) + set offset=$piece(label,"+",2) +"RTN","TMGMISC",1266,0) + set label=$piece(label,"+",1) +"RTN","TMGMISC",1267,0) + set label=$extract(label,1,8) +"RTN","TMGMISC",1268,0) + +"RTN","TMGMISC",1269,0) + quit +"RTN","TMGMISC",1270,0) + +"RTN","TMGMISC",1271,0) + +"RTN","TMGMISC",1272,0) +ScanMod(Module,pArray) +"RTN","TMGMISC",1273,0) + ;"Purpose: To scan a module and find all the labels/entry points/Entry points +"RTN","TMGMISC",1274,0) + ;"Input: Module -- The name of the module, like "XGF" (not "XGF.m" or "^XGF") +"RTN","TMGMISC",1275,0) + ;" pArray -- pointer to (NAME OF) array Will be filled like this +"RTN","TMGMISC",1276,0) + ;" pArray(1,"TAG")="Label1" +"RTN","TMGMISC",1277,0) + ;" pArray(1,"OFFSET")=1 +"RTN","TMGMISC",1278,0) + ;" pArray(2,"TAG")="Label2" +"RTN","TMGMISC",1279,0) + ;" pArray(2,"OFFSET")=9 +"RTN","TMGMISC",1280,0) + ;" pArray(3,"TAG")="Label3" etc. +"RTN","TMGMISC",1281,0) + ;" pArray(3,"OFFSET")=15 +"RTN","TMGMISC",1282,0) + ;" pArray("Label1")=1 +"RTN","TMGMISC",1283,0) + ;" pArray("Label2")=2 +"RTN","TMGMISC",1284,0) + ;" pArray("Label3")=3 +"RTN","TMGMISC",1285,0) + ;" +"RTN","TMGMISC",1286,0) + ;" NOTE: there seems to be a problem if the passed pArray value is "pArray", +"RTN","TMGMISC",1287,0) + ;" so use another name. +"RTN","TMGMISC",1288,0) + ;" +"RTN","TMGMISC",1289,0) + ;"Output: Results are put into array +"RTN","TMGMISC",1290,0) + ;"Result: none +"RTN","TMGMISC",1291,0) + +"RTN","TMGMISC",1292,0) + new smIdx set smIdx=1 +"RTN","TMGMISC",1293,0) + new LabelNum set LabelNum=0 +"RTN","TMGMISC",1294,0) + new smLine set smLine="" +"RTN","TMGMISC",1295,0) + if $get(Module)="" goto SMDone +"RTN","TMGMISC",1296,0) + +"RTN","TMGMISC",1297,0) + for do quit:(smLine="") +"RTN","TMGMISC",1298,0) + . new smCh +"RTN","TMGMISC",1299,0) + . set smLine=$text(+smIdx^@Module) +"RTN","TMGMISC",1300,0) + . if smLine="" quit +"RTN","TMGMISC",1301,0) + . set smLine=$$Substitute^TMGSTUTL(smLine,$Char(9)," ") ;"replace tabs for 8 spaces +"RTN","TMGMISC",1302,0) + . set smCh=$extract(smLine,1) +"RTN","TMGMISC",1303,0) + . if (smCh'=" ")&(smCh'=";") do +"RTN","TMGMISC",1304,0) + . . new label +"RTN","TMGMISC",1305,0) + . . set label=$piece(smLine," ",1) +"RTN","TMGMISC",1306,0) + . . set LabelNum=LabelNum+1 +"RTN","TMGMISC",1307,0) + . . set @pArray@(LabelNum,"TAG")=label +"RTN","TMGMISC",1308,0) + . . set @pArray@(LabelNum,"OFFSET")=smIdx +"RTN","TMGMISC",1309,0) + . . set @pArray@(label)=LabelNum +"RTN","TMGMISC",1310,0) + . set smIdx=smIdx+1 +"RTN","TMGMISC",1311,0) + +"RTN","TMGMISC",1312,0) +SMDone +"RTN","TMGMISC",1313,0) + quit +"RTN","TMGMISC",1314,0) + +"RTN","TMGMISC",1315,0) + +"RTN","TMGMISC",1316,0) +ConvertPos(Pos,pArray) +"RTN","TMGMISC",1317,0) + ;"Purpose: to convert a text positioning line from one that is relative to the last tag/label, into +"RTN","TMGMISC",1318,0) + ;" one that is relative to the start of the file +"RTN","TMGMISC",1319,0) + ;" e.g. START+8^MYFUNCT --> +32^MYFUNCT +"RTN","TMGMISC",1320,0) + ;"Input: Pos -- a position, as returned from $ZPOS +"RTN","TMGMISC",1321,0) + ;" pArray -- pointer to (name of). Array holding holding tag offsets +"RTN","TMGMISC",1322,0) + ;" pArray will be in this format: +"RTN","TMGMISC",1323,0) + ;" pArray("ModuleA",1,"TAG")="ALabel1" +"RTN","TMGMISC",1324,0) + ;" pArray("ModuleA",1,"OFFSET")=1 +"RTN","TMGMISC",1325,0) + ;" pArray("ModuleA",2,"TAG")="ALabel2" +"RTN","TMGMISC",1326,0) + ;" pArray("ModuleA",2,"OFFSET")=9 +"RTN","TMGMISC",1327,0) + ;" pArray("ModuleA","Label1")=1 +"RTN","TMGMISC",1328,0) + ;" pArray("ModuleA","Label2")=2 +"RTN","TMGMISC",1329,0) + ;" pArray("ModuleA","Label3")=3 +"RTN","TMGMISC",1330,0) + ;" pArray("ModuleB",1,"TAG")="BLabel1" +"RTN","TMGMISC",1331,0) + ;" pArray("ModuleB",1,"OFFSET")=4 +"RTN","TMGMISC",1332,0) + ;" pArray("ModuleB",2,"TAG")="BLabel2" +"RTN","TMGMISC",1333,0) + ;" pArray("ModuleB",2,"OFFSET")=23 +"RTN","TMGMISC",1334,0) + ;" pArray("ModuleB","Label1")=1 +"RTN","TMGMISC",1335,0) + ;" pArray("ModuleB","Label2")=2 +"RTN","TMGMISC",1336,0) + ;" pArray("ModuleB","Label3")=3 +"RTN","TMGMISC",1337,0) + ;" NOTE: -- if array passed is empty, then this function will call ScanModule to fill it +"RTN","TMGMISC",1338,0) + ;"Result: returns the new position line, relative to the start of the file/module +"RTN","TMGMISC",1339,0) + ;" +"RTN","TMGMISC",1340,0) + +"RTN","TMGMISC",1341,0) + new cpS +"RTN","TMGMISC",1342,0) + new cpResult set cpResult="" +"RTN","TMGMISC",1343,0) + new cpRoutine,cpLabel,cpOffset +"RTN","TMGMISC",1344,0) + +"RTN","TMGMISC",1345,0) + set cpS=$piece(Pos,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE +"RTN","TMGMISC",1346,0) + if cpS="" goto CPDone +"RTN","TMGMISC",1347,0) + +"RTN","TMGMISC",1348,0) + set cpRoutine=$piece(cpS,"^",2) +"RTN","TMGMISC",1349,0) + if cpRoutine="" goto CPDone +"RTN","TMGMISC",1350,0) + +"RTN","TMGMISC",1351,0) + set cpS=$piece(cpS,"^",1) +"RTN","TMGMISC",1352,0) + set cpOffset=+$piece(cpS,"+",2) +"RTN","TMGMISC",1353,0) + ;"if cpOffset="" set cpOffset=1 +"RTN","TMGMISC",1354,0) + ;"else set cpOffset=+cpOffset +"RTN","TMGMISC",1355,0) + set cpLabel=$piece(cpS,"+",1) +"RTN","TMGMISC",1356,0) + +"RTN","TMGMISC",1357,0) + if $data(@pArray@(cpRoutine))=0 do +"RTN","TMGMISC",1358,0) + . new p2Array set p2Array=$name(@pArray@(cpRoutine)) +"RTN","TMGMISC",1359,0) + . do ScanMod(cpRoutine,p2Array) +"RTN","TMGMISC",1360,0) + +"RTN","TMGMISC",1361,0) + new cpIdx set cpIdx=+$get(@pArray@(cpRoutine,cpLabel)) +"RTN","TMGMISC",1362,0) + if cpIdx=0 goto CPDone +"RTN","TMGMISC",1363,0) + new cpGOffset set cpGOffset=@pArray@(cpRoutine,cpIdx,"OFFSET") +"RTN","TMGMISC",1364,0) + set cpResult="+"_+(cpGOffset+cpOffset)_"^"_cpRoutine +"RTN","TMGMISC",1365,0) + +"RTN","TMGMISC",1366,0) +CPDone +"RTN","TMGMISC",1367,0) + quit cpResult +"RTN","TMGMISC",1368,0) + +"RTN","TMGMISC",1369,0) + +"RTN","TMGMISC",1370,0) + +"RTN","TMGMISC",1371,0) + +"RTN","TMGMISC",1372,0) +CompArray(pArray1,pArray2) +"RTN","TMGMISC",1373,0) + ;"Purpose: To return if two arrays are identical +"RTN","TMGMISC",1374,0) + ;" Equality means that all nodes and values are present and equal +"RTN","TMGMISC",1375,0) + ;"Input: Array1 -- PASS BY NAME. The *name of* the first array to be compared +"RTN","TMGMISC",1376,0) + ;" Array1 -- PASS BY NAME. The *name of* the second array to be compared +"RTN","TMGMISC",1377,0) + ;"Output: 1 if two are identical, 0 if not +"RTN","TMGMISC",1378,0) + +"RTN","TMGMISC",1379,0) + new result set result=1 +"RTN","TMGMISC",1380,0) + new index1,index2 +"RTN","TMGMISC",1381,0) + set index1=$order(@pArray1@("")) +"RTN","TMGMISC",1382,0) + set index2=$order(@pArray2@("")) +"RTN","TMGMISC",1383,0) + if (index1="")!(index2="") set result=0 goto CADone +"RTN","TMGMISC",1384,0) + for do quit:(result=0)!(index1="")!(index2="") +"RTN","TMGMISC",1385,0) + . if index2'=index2 set result=0 quit +"RTN","TMGMISC",1386,0) + . if $get(@pArray1@(index1))'=$get(@pArray2@(index2)) set result=0 quit +"RTN","TMGMISC",1387,0) + . if ($data(@pArray1@(index1))'<10)!($data(@pArray2@(index2))'<10) do +"RTN","TMGMISC",1388,0) + . . set result=$$CompArray($name(@pArray1@(index1)),$name(@pArray2@(index2))) +"RTN","TMGMISC",1389,0) + . set index1=$order(@pArray1@(index1)) +"RTN","TMGMISC",1390,0) + . set index2=$order(@pArray2@(index2)) +"RTN","TMGMISC",1391,0) + +"RTN","TMGMISC",1392,0) +CADone quit result +"RTN","TMGMISC",1393,0) + +"RTN","TMGMISC",1394,0) + +"RTN","TMGMISC",1395,0) + +"RTN","TMGMISC",1396,0) +IterTemplate(Template,Prior) +"RTN","TMGMISC",1397,0) + ;"Purpose: To iterate through a SORT TEMPLATE (i.e. provide record numbers held in the template +"RTN","TMGMISC",1398,0) + ;" one at a time. For each time this function is called, one record number (IEN) is returned. +"RTN","TMGMISC",1399,0) + ;"Input: Template: the IEN of an entry from file SORT TEMPLATE (file# .401) +"RTN","TMGMISC",1400,0) + ;" Prior -- OPTIONAL (default is to return first record), an IEN as returned from this +"RTN","TMGMISC",1401,0) + ;" function during the last call. +"RTN","TMGMISC",1402,0) + ;"Result: Returns the next record found in list, occuring after Prior, or -1 if error or not found +"RTN","TMGMISC",1403,0) + ;" Returns "" if end of list (no next record) +"RTN","TMGMISC",1404,0) + +"RTN","TMGMISC",1405,0) + ;"Example of use: This will list all records held in SORT TEMPLATE record# 809 +"RTN","TMGMISC",1406,0) + ;" set IEN="" +"RTN","TMGMISC",1407,0) + ;" for s IEN=$$IterTemplate^TMGMISC(809,IEN) w IEN,! q:(+IEN'>0) +"RTN","TMGMISC",1408,0) + +"RTN","TMGMISC",1409,0) + set Prior=$get(Prior) +"RTN","TMGMISC",1410,0) + set result=-1 +"RTN","TMGMISC",1411,0) + if +$get(Template)'>0 goto ItTDone +"RTN","TMGMISC",1412,0) + +"RTN","TMGMISC",1413,0) + set result=$order(^DIBT(Template,1,Prior)) +"RTN","TMGMISC",1414,0) + +"RTN","TMGMISC",1415,0) +ItTDone quit result +"RTN","TMGMISC",1416,0) + +"RTN","TMGMISC",1417,0) +CtTemplate(Template) +"RTN","TMGMISC",1418,0) + ;"Purpose: To return the Count of IEN's stored in a SORT TEMPLATE +"RTN","TMGMISC",1419,0) + ;"Input: Template: the IEN of an entry from file SORT TEMPLATE (file# .401) +"RTN","TMGMISC",1420,0) + ;"Result: Returns the count of records held +"RTN","TMGMISC",1421,0) + +"RTN","TMGMISC",1422,0) + new name set name=$name(^DIBT(Template,1)) +"RTN","TMGMISC",1423,0) + quit $$ListCt(name) +"RTN","TMGMISC",1424,0) + +"RTN","TMGMISC",1425,0) + +"RTN","TMGMISC",1426,0) +NumPieces(s,delim,maxPoss) +"RTN","TMGMISC",1427,0) + ;"Purpose: to return the number of pieces in s, using delim as a delimiter +"RTN","TMGMISC",1428,0) + ;"Input: s -- the string to test +"RTN","TMGMISC",1429,0) + ;" delim -- OPTIONAL -- the delimiter (e.g. ',' or ';' or ' ' etc), default=" " +"RTN","TMGMISC",1430,0) + ;" maxPoss -- OPTIONAL the maximum number of possible pieces, default=32 +"RTN","TMGMISC",1431,0) + ;" the function counts DOWN from this number, so if s has more than default, must specify +"RTN","TMGMISC",1432,0) + ;"Result: Returns the number of pieces +"RTN","TMGMISC",1433,0) + ;" e.g. 'this is a test', space delimiter --> returns 4 +"RTN","TMGMISC",1434,0) + ;"Note: ("this is a test",";") --> 1 +"RTN","TMGMISC",1435,0) + ;" ("",";") --> 0 +"RTN","TMGMISC",1436,0) + +"RTN","TMGMISC",1437,0) + ;"NOTICE!!! +"RTN","TMGMISC",1438,0) + ;"After writing this function, I was told that $length(s,delim) will do this. +"RTN","TMGMISC",1439,0) + ;" I will leave this here as a reminder, but it probably shouldn't be used.... +"RTN","TMGMISC",1440,0) + quit $length(s,$get(delim," ")) +"RTN","TMGMISC",1441,0) + +"RTN","TMGMISC",1442,0) + +"RTN","TMGMISC",1443,0) + new i,result set result=0 +"RTN","TMGMISC",1444,0) + if $get(s)="" goto NPsDone +"RTN","TMGMISC",1445,0) + set delim=$get(delim," ") +"RTN","TMGMISC",1446,0) + set maxPoss=+$get(maxPoss,32) +"RTN","TMGMISC",1447,0) + +"RTN","TMGMISC",1448,0) + for result=maxPoss:-1:1 quit:($piece(s,delim,result)'="") +"RTN","TMGMISC",1449,0) + +"RTN","TMGMISC",1450,0) + quit result +"RTN","TMGMISC",1451,0) + +"RTN","TMGMISC",1452,0) +LastPiece(s,delim,maxPoss) +"RTN","TMGMISC",1453,0) + ;"Purpose: to return the last piece of a string +"RTN","TMGMISC",1454,0) + ;"Input: s -- the string to use +"RTN","TMGMISC",1455,0) + ;" delim -- OPTIONAL -- the delimiter (e.g. ',' or ';' or ' ' etc), default=" " +"RTN","TMGMISC",1456,0) + ;" maxPoss -- OPTIONAL the maximum number of possible pieces, default=32 (see NumPieces function) +"RTN","TMGMISC",1457,0) + ;"Results : returns the LAST piece in the string +"RTN","TMGMISC",1458,0) + +"RTN","TMGMISC",1459,0) + new result set result="" +"RTN","TMGMISC",1460,0) + if $get(s)="" goto LPDone +"RTN","TMGMISC",1461,0) + set delim=$get(delim," ") +"RTN","TMGMISC",1462,0) + new n +"RTN","TMGMISC",1463,0) + set n=$length(s,delim) +"RTN","TMGMISC",1464,0) + set result=$piece(s,delim,n) +"RTN","TMGMISC",1465,0) + +"RTN","TMGMISC",1466,0) +LPDone +"RTN","TMGMISC",1467,0) + quit result +"RTN","TMGMISC",1468,0) + +"RTN","TMGMISC",1469,0) +ParseLast(s,remainS,delim,maxPoss) +"RTN","TMGMISC",1470,0) + ;"Purpose: to return the last piece of a string, AND return the first part of the string in remainS +"RTN","TMGMISC",1471,0) + ;"Input: s -- the string to use +"RTN","TMGMISC",1472,0) + ;" remainS -- an OUT parameter. PASS BY REFERENCE. Returns the part of the string up to result +"RTN","TMGMISC",1473,0) + ;" delim -- OPTIONAL -- the delimiter (e.g. ',' or ';' or ' ' etc), default=" " +"RTN","TMGMISC",1474,0) + ;" maxPoss -- OPTIONAL the maximum number of possible pieces, default=32 (see NumPieces function) +"RTN","TMGMISC",1475,0) + ;"Results : returns the LAST piece in the string +"RTN","TMGMISC",1476,0) + +"RTN","TMGMISC",1477,0) + new result set result="" +"RTN","TMGMISC",1478,0) + new tempS set tempS=s ;"in case s passed by reference, and remainS=s (i.e. w $$ParseLast(s,.s) +"RTN","TMGMISC",1479,0) + set remainS="" +"RTN","TMGMISC",1480,0) + set delim=$get(delim," ") +"RTN","TMGMISC",1481,0) + +"RTN","TMGMISC",1482,0) + if $get(tempS)="" goto PLDone +"RTN","TMGMISC",1483,0) + new n +"RTN","TMGMISC",1484,0) + set n=$length(s,delim) +"RTN","TMGMISC",1485,0) + set result=$piece(tempS,delim,n) +"RTN","TMGMISC",1486,0) + if n>1 set remainS=$piece(tempS,delim,1,n-1) +"RTN","TMGMISC",1487,0) + +"RTN","TMGMISC",1488,0) +PLDone +"RTN","TMGMISC",1489,0) + quit result +"RTN","TMGMISC",1490,0) + +"RTN","TMGMISC",1491,0) + +"RTN","TMGMISC",1492,0) + +"RTN","TMGMISC",1493,0) +NPsDone +"RTN","TMGMISC",1494,0) + quit result +"RTN","TMGMISC",1495,0) + +"RTN","TMGMISC",1496,0) + +"RTN","TMGMISC",1497,0) +Trim1Node(pRef) +"RTN","TMGMISC",1498,0) + ;"Purpose: To shorten a reference by one node. +"RTN","TMGMISC",1499,0) + ;" e.g. "Array(567,2342,123)" --> "Array(567,2342)" +"RTN","TMGMISC",1500,0) + ;"Input: pRef -- the NAME OF an array. +"RTN","TMGMISC",1501,0) + ;"Result: will return shortened reference, or "" if problem +"RTN","TMGMISC",1502,0) + ;" If no nodes to trim, just array name will be returnes. +"RTN","TMGMISC",1503,0) + +"RTN","TMGMISC",1504,0) + new result set result=pRef +"RTN","TMGMISC",1505,0) + if pRef="" goto T1NDone +"RTN","TMGMISC",1506,0) + +"RTN","TMGMISC",1507,0) + if $qlength(pRef)>0 set result=$name(@pRef,$qlength(pRef)-1) +"RTN","TMGMISC",1508,0) + goto T1NDone +"RTN","TMGMISC",1509,0) + +"RTN","TMGMISC",1510,0) + ;"Below is an old way I came up with (not as effecient!) +"RTN","TMGMISC",1511,0) + ;"NOT USED. +"RTN","TMGMISC",1512,0) + set result=$qsubscript(pRef,0) +"RTN","TMGMISC",1513,0) + +"RTN","TMGMISC",1514,0) + new numNodes,i +"RTN","TMGMISC",1515,0) + set numNodes=$qlength(pRef) +"RTN","TMGMISC",1516,0) + for i=1:1:(numNodes-1) do +"RTN","TMGMISC",1517,0) + . new node set node=$qsubscript(pRef,i) +"RTN","TMGMISC",1518,0) + . set result=$name(@result@(node)) +"RTN","TMGMISC",1519,0) + +"RTN","TMGMISC",1520,0) +T1NDone +"RTN","TMGMISC",1521,0) + quit result +"RTN","TMGMISC",1522,0) + +"RTN","TMGMISC",1523,0) + +"RTN","TMGMISC",1524,0) +BROWSEASK +"RTN","TMGMISC",1525,0) + ;"Purpose: to ask user for the name of an array, then display nodes +"RTN","TMGMISC",1526,0) + +"RTN","TMGMISC",1527,0) + new current +"RTN","TMGMISC",1528,0) + new order set order=1 ;"default = forward display. +"RTN","TMGMISC",1529,0) + new paginate set paginate=0 ;"no pagination +"RTN","TMGMISC",1530,0) + new countNodes set countNodes=0 ;"no counting +"RTN","TMGMISC",1531,0) + write ! +"RTN","TMGMISC",1532,0) + read "Enter name of array (or File number) to display nodes in: ",current:$get(DTIME,3600),! +"RTN","TMGMISC",1533,0) + if +current=current do +"RTN","TMGMISC",1534,0) + . set current=$get(^DIC(+current,0,"GL")) +"RTN","TMGMISC",1535,0) + . if current="" write "File number not found. Quitting.",! quit +"RTN","TMGMISC",1536,0) + . write "Browsing array: ",current,! +"RTN","TMGMISC",1537,0) + if current="" set current="^" +"RTN","TMGMISC",1538,0) + if current="^" goto BADone +"RTN","TMGMISC",1539,0) + +"RTN","TMGMISC",1540,0) + new % set %=2 ;" default= NO +"RTN","TMGMISC",1541,0) + write "Display in REVERSE order? " +"RTN","TMGMISC",1542,0) + do YN^DICN write ! +"RTN","TMGMISC",1543,0) + if %=1 set order=-1 +"RTN","TMGMISC",1544,0) + if %=-1 goto BADone +"RTN","TMGMISC",1545,0) + +"RTN","TMGMISC",1546,0) + set %=2 +"RTN","TMGMISC",1547,0) + write "Pause after each page? " +"RTN","TMGMISC",1548,0) + do YN^DICN write ! +"RTN","TMGMISC",1549,0) + if %=1 set paginate=1 +"RTN","TMGMISC",1550,0) + if %=-1 goto BADone +"RTN","TMGMISC",1551,0) + +"RTN","TMGMISC",1552,0) + set %=2 +"RTN","TMGMISC",1553,0) + write "Show number of subnodes? " +"RTN","TMGMISC",1554,0) + do YN^DICN write ! +"RTN","TMGMISC",1555,0) + if %=1 set countNodes=1 +"RTN","TMGMISC",1556,0) + if %=-1 goto BADone +"RTN","TMGMISC",1557,0) + +"RTN","TMGMISC",1558,0) + do BROWSENODES(current,order,paginate,countNodes) +"RTN","TMGMISC",1559,0) +BADone +"RTN","TMGMISC",1560,0) + quit +"RTN","TMGMISC",1561,0) + +"RTN","TMGMISC",1562,0) + +"RTN","TMGMISC",1563,0) +BROWSENODES(current,Order,paginate,countNodes) +"RTN","TMGMISC",1564,0) + ;"Purpose: to display nodes of specified array +"RTN","TMGMISC",1565,0) + ;"Input: Current -- The reference to display +"RTN","TMGMISC",1566,0) + ;" order -- OPTIONAL, default=1; 1 for forward, -1 for backwards order +"RTN","TMGMISC",1567,0) + ;" paginate -- OPTIONAL, default=0; 0=no pagination, 1=pause after each page +"RTN","TMGMISC",1568,0) + ;" countNodes -- OPTIONAL, default=0; 1=show number of child nodes. +"RTN","TMGMISC",1569,0) + +"RTN","TMGMISC",1570,0) + new parent,child +"RTN","TMGMISC",1571,0) + set parent="" +"RTN","TMGMISC",1572,0) + set order=$get(order,1) +"RTN","TMGMISC",1573,0) + set paginate=$get(paginate,0) +"RTN","TMGMISC",1574,0) + set countNodes=$get(countNodes,0) +"RTN","TMGMISC",1575,0) + +"RTN","TMGMISC",1576,0) + new len set len=$length(current) +"RTN","TMGMISC",1577,0) + new lastChar set lastChar=$extract(current,len) +"RTN","TMGMISC",1578,0) + if lastChar'=")" do +"RTN","TMGMISC",1579,0) + . if current'["(" quit +"RTN","TMGMISC",1580,0) + . if lastChar="," set current=$extract(current,1,len-1) +"RTN","TMGMISC",1581,0) + . if lastChar="(" set current=$extract(current,1,len-1) quit +"RTN","TMGMISC",1582,0) + . set current=current_")" +"RTN","TMGMISC",1583,0) + +"RTN","TMGMISC",1584,0) +BNLoop +"RTN","TMGMISC",1585,0) + if current="" goto BNDone +"RTN","TMGMISC",1586,0) + set child=$$ShowNodes(current,order,paginate,countNodes) +"RTN","TMGMISC",1587,0) + if child'="" do +"RTN","TMGMISC",1588,0) + . set parent(child)=current +"RTN","TMGMISC",1589,0) + . set current=child +"RTN","TMGMISC",1590,0) + else set current=$get(parent(current)) +"RTN","TMGMISC",1591,0) + goto BNLoop +"RTN","TMGMISC",1592,0) +BNDone +"RTN","TMGMISC",1593,0) + quit +"RTN","TMGMISC",1594,0) + +"RTN","TMGMISC",1595,0) + +"RTN","TMGMISC",1596,0) +ShowNodes(pArray,order,paginate,countNodes) +"RTN","TMGMISC",1597,0) + ;"Purpose: To display all the nodes of the given array +"RTN","TMGMISC",1598,0) + ;"Input: pArray -- NAME OF array to display +"RTN","TMGMISC",1599,0) + ;" order -- OPTIONAL, default=1; 1 for forward, -1 for backwards order +"RTN","TMGMISC",1600,0) + ;" paginate -- OPTIONAL, default=0; 0=no pagination, 1=pause after each page +"RTN","TMGMISC",1601,0) + ;" countNodes -- OPTIONAL, default=0; 1=show number of child nodes. +"RTN","TMGMISC",1602,0) + ;"Results: returns NAME OF next node to display (or "" if none) +"RTN","TMGMISC",1603,0) + +"RTN","TMGMISC",1604,0) + new TMGi +"RTN","TMGMISC",1605,0) + new count set count=1 +"RTN","TMGMISC",1606,0) + new Answers +"RTN","TMGMISC",1607,0) + new someShown set someShown=0 +"RTN","TMGMISC",1608,0) + new abort set abort=0 +"RTN","TMGMISC",1609,0) + set paginate=$get(paginate,0) +"RTN","TMGMISC",1610,0) + new pageCount set pageCount=0 +"RTN","TMGMISC",1611,0) + new pageLen set pageLen=20 +"RTN","TMGMISC",1612,0) + set countNodes=$get(countNodes,0) +"RTN","TMGMISC",1613,0) + +"RTN","TMGMISC",1614,0) + write pArray,! +"RTN","TMGMISC",1615,0) + set TMGi=$order(@pArray@(""),order) +"RTN","TMGMISC",1616,0) + if TMGi'="" for do quit:(TMGi="")!(abort=1) +"RTN","TMGMISC",1617,0) + . write count,". +--[",TMGi,"]" +"RTN","TMGMISC",1618,0) + . if countNodes=1 write "(",$$ListCt($name(@pArray@(TMGi))),")" +"RTN","TMGMISC",1619,0) + . write "=",$extract($get(@pArray@(TMGi)),1,40),! +"RTN","TMGMISC",1620,0) + . set someShown=1 +"RTN","TMGMISC",1621,0) + . set Answers(count)=$name(@pArray@(TMGi)) +"RTN","TMGMISC",1622,0) + . set count=count+1 +"RTN","TMGMISC",1623,0) + . new temp read *temp:0 +"RTN","TMGMISC",1624,0) + . if temp'=-1 set abort=1 +"RTN","TMGMISC",1625,0) + . set pageCount=pageCount+1 +"RTN","TMGMISC",1626,0) + . if (paginate=1)&(pageCount>pageLen) do +"RTN","TMGMISC",1627,0) + . . new temp +"RTN","TMGMISC",1628,0) + . . read "Press [ENTER] to continue (^ to stop list)...",temp:$get(DTIME,3600),! +"RTN","TMGMISC",1629,0) + . . if temp="^" set abort=1 +"RTN","TMGMISC",1630,0) + . . set pageCount=0 +"RTN","TMGMISC",1631,0) + . set TMGi=$order(@pArray@(TMGi),order) +"RTN","TMGMISC",1632,0) + +"RTN","TMGMISC",1633,0) + if someShown=0 write " (no data)",! +"RTN","TMGMISC",1634,0) + write !,"Enter # to browse (^ to backup): ^//" +"RTN","TMGMISC",1635,0) + new temp read temp:$get(DTIME,3600),! +"RTN","TMGMISC",1636,0) + +"RTN","TMGMISC",1637,0) + new result set result=$get(Answers(temp)) +"RTN","TMGMISC",1638,0) + +"RTN","TMGMISC",1639,0) + quit result +"RTN","TMGMISC",1640,0) + +"RTN","TMGMISC",1641,0) + +"RTN","TMGMISC",1642,0) +IsNumeric(value) +"RTN","TMGMISC",1643,0) + ;"Purpose: to determine if value is pure numeric. +"RTN","TMGMISC",1644,0) + ;"Note: This will be a more involved test than simply: if +value=value, because +"RTN","TMGMISC",1645,0) + ;" +"00001" is not the same as "1" or 1. Also +"123abc"--> 123, but is not pure numeric +"RTN","TMGMISC",1646,0) + set value=$$Trim^TMGSTUTL(value) ;" trim whitespace +"RTN","TMGMISC",1647,0) + set value=$$TrimL^TMGSTUTL(value,"0") ;"trim leading zeros +"RTN","TMGMISC",1648,0) + quit (value=+value) +"RTN","TMGMISC",1649,0) + +"RTN","TMGMISC",1650,0) + +"RTN","TMGMISC",1651,0) +ClipDDigits(Num,digits) +"RTN","TMGMISC",1652,0) + ;"Purpose: to clip number to specified number of decimal digits +"RTN","TMGMISC",1653,0) + ;" e.g. 1234.9876543 --> 1234.9876 if digits=4 +"RTN","TMGMISC",1654,0) + ;"Input: Num -- the number to process +"RTN","TMGMISC",1655,0) + ;" digits -- the number of allowed decimal digits after the decimal point +"RTN","TMGMISC",1656,0) + ;"Result: returns the number clipped to the specified number of decimals +"RTN","TMGMISC",1657,0) + ;" note: this is a CLIP, not a ROUND function +"RTN","TMGMISC",1658,0) + +"RTN","TMGMISC",1659,0) + new result set result=Num +"RTN","TMGMISC",1660,0) + new decimals set decimals=$extract($piece(Num,".",2),1,digits) +"RTN","TMGMISC",1661,0) + set result=$piece(Num,".",1) +"RTN","TMGMISC",1662,0) + if decimals'="" set result=result_"."_decimals +"RTN","TMGMISC",1663,0) +CDgDone +"RTN","TMGMISC",1664,0) + quit result +"RTN","TMGMISC",1665,0) + +"RTN","TMGMISC",1666,0) + +"RTN","TMGMISC",1667,0) +Diff(File,IENS1,IENS2,Result) +"RTN","TMGMISC",1668,0) + ;"Purpose: to determine how two records differ in a given file +"RTN","TMGMISC",1669,0) + ;"Input: File -- file name or number of file containing records to be compared +"RTN","TMGMISC",1670,0) + ;" IENS1 -- the IEN (or IENS if file is a subfile) of the first record to be compared +"RTN","TMGMISC",1671,0) + ;" IENS2 -- the IEN (or IENS if file is a subfile) of the second record to be compared +"RTN","TMGMISC",1672,0) + ;" Result -- PASS BE REFERENCE, and OUT PARAMETER +"RTN","TMGMISC",1673,0) + ;" Format of output Result array. Will only hold differences +"RTN","TMGMISC",1674,0) + ;" e.g. Result(FieldNum,"EXTRA",1)=valueOfField +"RTN","TMGMISC",1675,0) + ;" e.g. Result(FieldNum,"EXTRA",2)=valueOfField +"RTN","TMGMISC",1676,0) + ;" e.g. Result(FieldNum,"CONFLICT",1)=valueOfField +"RTN","TMGMISC",1677,0) + ;" e.g. Result(FieldNum,"CONFLICT",2)=valueOfField +"RTN","TMGMISC",1678,0) + ;" e.g. Result(FieldNum,"FIELD NAMES")=FieldName +"RTN","TMGMISC",1679,0) + ;"Note: this will consider only the first 1024 characters of WP fields +"RTN","TMGMISC",1680,0) + ;"Note: For now, multiples (subfiles) will be IGNORED +"RTN","TMGMISC",1681,0) + +"RTN","TMGMISC",1682,0) + new fileNum set fileNum=+$get(File) +"RTN","TMGMISC",1683,0) + if fileNum=0 set fileNum=$$GetFileNum^TMGDBAPI(.File) +"RTN","TMGMISC",1684,0) + new subFileNum +"RTN","TMGMISC",1685,0) + +"RTN","TMGMISC",1686,0) + new field set field=$order(^DD(fileNum,0)) +"RTN","TMGMISC",1687,0) + if +field>0 for do quit:(+field'>0) +"RTN","TMGMISC",1688,0) + . set subFileNum=+$piece($get(^DD(fileNum,field,0)),"^",2) ;"get subfile number, or 0 if not subfile +"RTN","TMGMISC",1689,0) + . if subFileNum>0 do ;"finish later... +"RTN","TMGMISC",1690,0) + . . ;"Here I need to somehow cycle through each record of the subfile and compare THOSE +"RTN","TMGMISC",1691,0) + . . new subResult +"RTN","TMGMISC",1692,0) + . . do DiffSubFile(subFileNum,.IENS1,.IENS2,.subResult) ;"null function for now +"RTN","TMGMISC",1693,0) + . . ;"do some merge between Result and subResult +"RTN","TMGMISC",1694,0) + . else do Diff1Field(fileNum,field,.IENS1,.IENS2,.Result) +"RTN","TMGMISC",1695,0) + . set field=$order(^DD(fileNum,field)) +"RTN","TMGMISC",1696,0) + +"RTN","TMGMISC",1697,0) + quit +"RTN","TMGMISC",1698,0) + +"RTN","TMGMISC",1699,0) + +"RTN","TMGMISC",1700,0) +Diff1Field(File,Field,IENS1,IEN2,Result) +"RTN","TMGMISC",1701,0) + ;"Purpose: to determine how two records differ for one given field +"RTN","TMGMISC",1702,0) + ;"Input: File -- file NUMBER of file containing records to be compared +"RTN","TMGMISC",1703,0) + ;" Field -- Field NUMBER to be evaluated +"RTN","TMGMISC",1704,0) + ;" IENS1 -- the IEN (or IENS if file is a subfile) of the first record to be compared +"RTN","TMGMISC",1705,0) + ;" IENS2 -- the IEN (or IENS if file is a subfile) of the second record to be compared +"RTN","TMGMISC",1706,0) + ;" Result -- PASS BE REFERENCE, and OUT PARAMETER +"RTN","TMGMISC",1707,0) + ;" Format of output Result array. Will only hold differences +"RTN","TMGMISC",1708,0) + ;" e.g. Result(FieldNum,"EXTRA",1)=valueOfField +"RTN","TMGMISC",1709,0) + ;" e.g. Result(FieldNum,"EXTRA",2)=valueOfField +"RTN","TMGMISC",1710,0) + ;" e.g. Result(FieldNum,"CONFLICT",1)=valueOfField +"RTN","TMGMISC",1711,0) + ;" e.g. Result(FieldNum,"CONFLICT",2)=valueOfField +"RTN","TMGMISC",1712,0) + ;" e.g. Result(FieldNum,"FIELD NAMES")=FieldName +"RTN","TMGMISC",1713,0) + ;"Results: none (data returned in Result out parameter) +"RTN","TMGMISC",1714,0) + ;"Note: only first 1023 characters of a WP field will be compared +"RTN","TMGMISC",1715,0) + +"RTN","TMGMISC",1716,0) + new value1,value2,TMGWP1,TMGWP2 +"RTN","TMGMISC",1717,0) + new fieldName set fieldName=$piece($get(^DD(File,Field,0)),"^",1) +"RTN","TMGMISC",1718,0) + +"RTN","TMGMISC",1719,0) + set value1=$$GET1^DIQ(File,IENS1,Field,"","TMGWP1") +"RTN","TMGMISC",1720,0) + set value2=$$GET1^DIQ(File,IENS2,Field,"","TMGWP2") +"RTN","TMGMISC",1721,0) + +"RTN","TMGMISC",1722,0) + if $data(TMGWP1)!$data(TMGWP2) do +"RTN","TMGMISC",1723,0) + . set value1=$$WPToStr^TMGSTUTL("TMGWP1"," ",1023) ;"Turn first 1023 characters into one long string +"RTN","TMGMISC",1724,0) + . set value2=$$WPToStr^TMGSTUTL("TMGWP2"," ",1023) ;"Turn first 1023 characters into one long string +"RTN","TMGMISC",1725,0) + +"RTN","TMGMISC",1726,0) + if value1=value2 goto D1FDone ;"default is no conflict +"RTN","TMGMISC",1727,0) + if (value2="")&(value1'="") do +"RTN","TMGMISC",1728,0) + . set Result(Field,"EXTRA",1)=value1 +"RTN","TMGMISC",1729,0) + . set Result(Field,"FIELD NAME")=fieldName +"RTN","TMGMISC",1730,0) + if (value1="")&(value2'="") do +"RTN","TMGMISC",1731,0) + . set Result(Field,"EXTRA",2)=value2 +"RTN","TMGMISC",1732,0) + . set Result(Field,"FIELD NAME")=fieldName +"RTN","TMGMISC",1733,0) + if (value1'="")&(value2'="") do +"RTN","TMGMISC",1734,0) + . set Result(Field,"CONFLICT",1)=value1 +"RTN","TMGMISC",1735,0) + . set Result(Field,"CONFLICT",2)=value2 +"RTN","TMGMISC",1736,0) + . set Result(Field,"FIELD NAME")=fieldName +"RTN","TMGMISC",1737,0) + +"RTN","TMGMISC",1738,0) +D1FDone +"RTN","TMGMISC",1739,0) + quit +"RTN","TMGMISC",1740,0) + +"RTN","TMGMISC",1741,0) +DiffSubFile(SubFile,IENS1,IENS2,Result) +"RTN","TMGMISC",1742,0) + +"RTN","TMGMISC",1743,0) + quit +"RTN","TMGMISC",1744,0) + +"RTN","TMGMISC",1745,0) + +"RTN","TMGMISC",1746,0) + +"RTN","TMGMISC",1747,0) +Array2XML(pArray,pResult,indent) +"RTN","TMGMISC",1748,0) + ;"Purpose: to convert an array into XML format +"RTN","TMGMISC",1749,0) + ;"Input: pArray -- the NAME OF the array to convert (array can be any format) +"RTN","TMGMISC",1750,0) + ;" pResult -- the NAME OF the output array. +"RTN","TMGMISC",1751,0) + ;" format: +"RTN","TMGMISC",1752,0) + ;" Result(0)="" +"RTN","TMGMISC",1753,0) + ;" Result(1)="Node Value +"RTN","TMGMISC",1754,0) + ;" Result(2)=" Node Value +"RTN","TMGMISC",1755,0) + ;" Result(3)=" Node Value +"RTN","TMGMISC",1756,0) + ;" Result(4)=" Node Value ;"<--- start subnode +"RTN","TMGMISC",1757,0) + ;" Result(5)=" Node Value +"RTN","TMGMISC",1758,0) + ;" Result(6)=" Node Value +"RTN","TMGMISC",1759,0) + ;" Result(7)=" ;"<---- end subnode +"RTN","TMGMISC",1760,0) + ;" Result(8)=" Node Value +"RTN","TMGMISC",1761,0) + ;" indent -- OPTIONAL. if 1, then subnodes have whitespace indent for pretty viewing +"RTN","TMGMISC",1762,0) + ;"Output: pResult is filled +"RTN","TMGMISC",1763,0) + ;"Result: none. +"RTN","TMGMISC",1764,0) + ;"Note: example call do Array2XML("MyArray","MyOutput",1) +"RTN","TMGMISC",1765,0) + +"RTN","TMGMISC",1766,0) + kill @pResult +"RTN","TMGMISC",1767,0) + set @pResult@(0)=0 +"RTN","TMGMISC",1768,0) + if $get(indent)=1 set indent="" +"RTN","TMGMISC",1769,0) + else set indent=-1 +"RTN","TMGMISC",1770,0) + do A2XNode(pArray,pResult,.indent) +"RTN","TMGMISC",1771,0) + set @pResult@(0)=$$XMLHDR^MXMLUTL +"RTN","TMGMISC",1772,0) + +"RTN","TMGMISC",1773,0) + quit +"RTN","TMGMISC",1774,0) + +"RTN","TMGMISC",1775,0) + +"RTN","TMGMISC",1776,0) +A2XNode(pArray,pResult,indent) +"RTN","TMGMISC",1777,0) + ;"Purpose: To do the output for Array2XML +"RTN","TMGMISC",1778,0) + ;"Input: pArray - the NAME OF the array to convert +"RTN","TMGMISC",1779,0) + ;" pResult - the NAME OF the output array. +"RTN","TMGMISC",1780,0) + ;" Format to be as described in Array2XML, which one exception: Result(0)=MaxLine +"RTN","TMGMISC",1781,0) + ;" indent -- OPTIONAL. if numeric value, then subnodes WON't whitespace indent for pretty viewing +"RTN","TMGMISC",1782,0) + ;" otherwise, indent is string holding space to indent +"RTN","TMGMISC",1783,0) + ;"Result: none +"RTN","TMGMISC",1784,0) + +"RTN","TMGMISC",1785,0) + new i,s +"RTN","TMGMISC",1786,0) + set indent=$get(indent) +"RTN","TMGMISC",1787,0) + set i=$order(@pArray@("")) +"RTN","TMGMISC",1788,0) + if i'="" for do quit:(i="") +"RTN","TMGMISC",1789,0) + . set s="" if indent'=-1 set s=indent +"RTN","TMGMISC",1790,0) + . set s=s_""_$get(@pArray@(i)) +"RTN","TMGMISC",1791,0) + . set s=$$SYMENC^MXMLUTL(s) +"RTN","TMGMISC",1792,0) + . if $data(@pArray@(i))>1 do +"RTN","TMGMISC",1793,0) + . . set @pResult@(0)=+$get(@pResult@(0))+1 ;"Increment maxline +"RTN","TMGMISC",1794,0) + . . set @pResult@(@pResult@(0))=s +"RTN","TMGMISC",1795,0) + . . new subIndent set subIndent=-1 +"RTN","TMGMISC",1796,0) + . . if indent'=-1 set subIndent=indent_" " +"RTN","TMGMISC",1797,0) + . . do A2XNode($name(@pArray@(i)),pResult,subIndent) +"RTN","TMGMISC",1798,0) + . . set s="" if indent'=-1 set s=indent +"RTN","TMGMISC",1799,0) + . . set s=s_"" +"RTN","TMGMISC",1800,0) + . else do +"RTN","TMGMISC",1801,0) + . . set s=s_"" +"RTN","TMGMISC",1802,0) + . set @pResult@(0)=+$get(@pResult@(0))+1 ;"Increment maxline +"RTN","TMGMISC",1803,0) + . set @pResult@(@pResult@(0))=s +"RTN","TMGMISC",1804,0) + . set i=$order(@pArray@(i)) +"RTN","TMGMISC",1805,0) + +"RTN","TMGMISC",1806,0) + quit +"RTN","TMGMISC",1807,0) + +"RTN","TMGMISC",1808,0) + +"RTN","TMGMISC",1809,0) +Up(pArray) +"RTN","TMGMISC",1810,0) + ;"Purpose: Return a NAME of an array that is one level 'up' from the +"RTN","TMGMISC",1811,0) + ;" the current array. This really means one node shorter. +"RTN","TMGMISC",1812,0) + ;" e.g. '^MyVar('plant','tree','apple tree')' --> '^MyVar('plant','tree')' +"RTN","TMGMISC",1813,0) + ;"Results: returns shorten array as above, or "" if error +"RTN","TMGMISC",1814,0) + +"RTN","TMGMISC",1815,0) + new result set result="" +"RTN","TMGMISC",1816,0) + if $get(pArray)="" goto UpDone +"RTN","TMGMISC",1817,0) + set result=$qsubscript(pArray,0) +"RTN","TMGMISC",1818,0) + new i +"RTN","TMGMISC",1819,0) + for i=1:1:$qlength(pArray)-1 do +"RTN","TMGMISC",1820,0) + . set result=$name(@result@($qsubscript(pArray,i))) +"RTN","TMGMISC",1821,0) + +"RTN","TMGMISC",1822,0) +UpDone quit result +"RTN","TMGMISC",1823,0) + +"RTN","TMGMISC",1824,0) + +"RTN","TMGMISC",1825,0) +LaunchScreenman(File,FormIEN,RecIEN,Page) +"RTN","TMGMISC",1826,0) + ;"Purpose: to provide a programatic launching point for displaying a +"RTN","TMGMISC",1827,0) + ;" screenman form for editing a record +"RTN","TMGMISC",1828,0) + ;"Input: File -- the IEN of file to be edited +"RTN","TMGMISC",1829,0) + ;" FormIEN -- the IEN in file FORM (.403) +"RTN","TMGMISC",1830,0) + ;" RecIEN -- the IEN in File to edit +"RTN","TMGMISC",1831,0) + ;" Page -- OPTIONAL, default=1. The starting page of form. +"RTN","TMGMISC",1832,0) + ;"Note: Form should be compiled before calling the function. This can be +"RTN","TMGMISC",1833,0) + ;" achieved by running the form once from ^DDSRUN (or viat Fileman menu) +"RTN","TMGMISC",1834,0) + +"RTN","TMGMISC",1835,0) + new DDSFILE set DDSFILE=File +"RTN","TMGMISC",1836,0) + new DDSRUNDR set DDSRUNDR=FormIEN +"RTN","TMGMISC",1837,0) + new DDSPAGE set DDSPAGE=+$get(Page,1) +"RTN","TMGMISC",1838,0) + new DA set DA=RecIEN +"RTN","TMGMISC",1839,0) + +"RTN","TMGMISC",1840,0) + do REC+9^DDSRUN ;"this goes against SAC conventions. +"RTN","TMGMISC",1841,0) + +"RTN","TMGMISC",1842,0) + quit +"RTN","TMGMISC",1843,0) + +"RTN","TMGMISC",1844,0) + +"RTN","TMGMISC",1845,0) +NumSigChs() +"RTN","TMGMISC",1846,0) + ;"Purpose: To determine how many characters are signficant in a variable name +"RTN","TMGMISC",1847,0) + ;" I.e. older versions of GT.M had only the first 8 characters as +"RTN","TMGMISC",1848,0) + ;" significant. Newer versions allow more characters to be significant. +"RTN","TMGMISC",1849,0) + +"RTN","TMGMISC",1850,0) + new pVar1,pVar2,i +"RTN","TMGMISC",1851,0) + set pVar1="zb",i=2 +"RTN","TMGMISC",1852,0) + new done set done=0 +"RTN","TMGMISC",1853,0) + for do quit:done +"RTN","TMGMISC",1854,0) + . set i=i+1 +"RTN","TMGMISC",1855,0) + . set pVar2=pVar1_"b" +"RTN","TMGMISC",1856,0) + . set pVar1=pVar1_"a" +"RTN","TMGMISC",1857,0) + . set @pVar1=7 +"RTN","TMGMISC",1858,0) + . if $get(@pVar2)=@pVar1 set done=1 +"RTN","TMGMISC",1859,0) + +"RTN","TMGMISC",1860,0) + quit (i-1) +"RTN","TMGMISC",1861,0) + +"RTN","TMGMISC",1862,0) + +"RTN","TMGMISC",1863,0) +SrchReplace(File,Field,Caption) +"RTN","TMGMISC",1864,0) + ;"Purpose: To do a text-based search and replace in all record of +"RTN","TMGMISC",1865,0) + ;" specified file, in the text of the specified file. +"RTN","TMGMISC",1866,0) + ;" Note: this does not work with pointer fields. It would +"RTN","TMGMISC",1867,0) + ;" fail to find the matching text in the pointer value and ignore it. +"RTN","TMGMISC",1868,0) + ;" It does not support subfiles. +"RTN","TMGMISC",1869,0) + ;"Input: File -- the file name or number to work with. +"RTN","TMGMISC",1870,0) + ;" Field -- the field name or number to work with +"RTN","TMGMISC",1871,0) + ;" Caption -- OPTIONAL. A descriptive text of action. +"RTN","TMGMISC",1872,0) + ;"Output: Data in records will be changed via Fileman and errors (if found) +"RTN","TMGMISC",1873,0) + ;" will be written to console. +"RTN","TMGMISC",1874,0) + ;"Results: none. +"RTN","TMGMISC",1875,0) + +"RTN","TMGMISC",1876,0) + if $get(File)="" goto SRDone +"RTN","TMGMISC",1877,0) + if $get(Field)="" goto SRDone +"RTN","TMGMISC",1878,0) + new OKToCont set OKToCont=1 +"RTN","TMGMISC",1879,0) + if +Field'=Field set OKToCont=$$SetFileFldNums^TMGDBAPI(File,Field,.File,.Field) +"RTN","TMGMISC",1880,0) + if OKToCont=0 goto SRDone +"RTN","TMGMISC",1881,0) + +"RTN","TMGMISC",1882,0) + if $get(Caption)'="" do +"RTN","TMGMISC",1883,0) + . write !,!,Caption,! +"RTN","TMGMISC",1884,0) + . write "----------------------------------------------------",!! +"RTN","TMGMISC",1885,0) + +"RTN","TMGMISC",1886,0) + new searchS,replaceS,% +"RTN","TMGMISC",1887,0) +SR1 +"RTN","TMGMISC",1888,0) + write "Enter characters/words to SEARCH for (^ to abort): " +"RTN","TMGMISC",1889,0) + read searchS:$get(DTIME,3600),! +"RTN","TMGMISC",1890,0) + if (searchS="")!(searchS="^") goto SRDone +"RTN","TMGMISC",1891,0) + write "REPLACE with (^ to abort): " +"RTN","TMGMISC",1892,0) + read replaceS:$get(DTIME,3600),! +"RTN","TMGMISC",1893,0) + if (replaceS="^") goto SRDone +"RTN","TMGMISC",1894,0) + write "'",searchS,"'-->'",replaceS,"'",! +"RTN","TMGMISC",1895,0) + set %=1 +"RTN","TMGMISC",1896,0) + write "OK" do YN^DICN write ! +"RTN","TMGMISC",1897,0) + if %=1 goto SR2 +"RTN","TMGMISC",1898,0) + if %=-1 goto SRDone +"RTN","TMGMISC",1899,0) + goto SR1 +"RTN","TMGMISC",1900,0) + +"RTN","TMGMISC",1901,0) +SR2 +"RTN","TMGMISC",1902,0) + new Itr,IEN,CurValue,abort,count +"RTN","TMGMISC",1903,0) + new ref set ref=$get(^DIC(File,0,"GL")) +"RTN","TMGMISC",1904,0) + set ref=$$CREF^DILF(ref) +"RTN","TMGMISC",1905,0) + if ref="" goto SRDone +"RTN","TMGMISC",1906,0) + new node set node=$piece($get(^DD(File,Field,0)),"^",4) +"RTN","TMGMISC",1907,0) + new piece set piece=$piece(node,";",2) +"RTN","TMGMISC",1908,0) + set node=$piece(node,";",1) +"RTN","TMGMISC",1909,0) + +"RTN","TMGMISC",1910,0) + set abort=0,count=0 +"RTN","TMGMISC",1911,0) + set IEN=$$ItrInit^TMGITR(File,.Itr) +"RTN","TMGMISC",1912,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGMISC",1913,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGMISC",1914,0) + . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGMISC",1915,0) + . set CurValue=$piece($get(@ref@(IEN,node)),"^",piece) +"RTN","TMGMISC",1916,0) + . if CurValue'[searchS quit +"RTN","TMGMISC",1917,0) +SR3 . new newValue set newValue=$$Substitute^TMGSTUTL(CurValue,searchS,replaceS) +"RTN","TMGMISC",1918,0) + . new TMGFDA,TMGMSG +"RTN","TMGMISC",1919,0) + . set TMGFDA(File,IEN_",",Field)=newValue +"RTN","TMGMISC",1920,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGMISC",1921,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGMISC",1922,0) + . set count=count+1 +"RTN","TMGMISC",1923,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGMISC",1924,0) + +"RTN","TMGMISC",1925,0) + write count," records changed",! +"RTN","TMGMISC",1926,0) + do PressToCont^TMGUSRIF +"RTN","TMGMISC",1927,0) + +"RTN","TMGMISC",1928,0) +SRDone +"RTN","TMGMISC",1929,0) + quit +"RTN","TMGMISC",1930,0) + +"RTN","TMGMISC",1931,0) + +"RTN","TMGMISC",1932,0) +MkMultList(input,List) +"RTN","TMGMISC",1933,0) + ;"Purpose: To create a list of entries, given a string containing a list of entries. +"RTN","TMGMISC",1934,0) + ;"Input: input -- a string of user input. E.g.: '345,3,12678,78-85,2' or '78-93' or '15' +"RTN","TMGMISC",1935,0) + ;" List -- PASS BY REFERENCE. An OUT PARAMETER. +"RTN","TMGMISC",1936,0) + ;"Output: List will be filled as follows: +"RTN","TMGMISC",1937,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1938,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1939,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1940,0) + ;"Result: 1 if values found, 0 none found, or error encountered +"RTN","TMGMISC",1941,0) + +"RTN","TMGMISC",1942,0) + new result set result=0 +"RTN","TMGMISC",1943,0) + +"RTN","TMGMISC",1944,0) + new i +"RTN","TMGMISC",1945,0) + for i=1:1:$length(input,",") do +"RTN","TMGMISC",1946,0) + . new value set value=$piece(input,",",i) +"RTN","TMGMISC",1947,0) + . if +value=value do +"RTN","TMGMISC",1948,0) + . . set List(value)="" +"RTN","TMGMISC",1949,0) + . . set result=1 +"RTN","TMGMISC",1950,0) + . else if value["-" do +"RTN","TMGMISC",1951,0) + . . new n1,n2 +"RTN","TMGMISC",1952,0) + . . set n1=+$piece(value,"-",1) +"RTN","TMGMISC",1953,0) + . . set n2=+$piece(value,"-",2) +"RTN","TMGMISC",1954,0) + . . set result=$$MkRangeList(n1,n2,.List) +"RTN","TMGMISC",1955,0) + +"RTN","TMGMISC",1956,0) + quit result +"RTN","TMGMISC",1957,0) + +"RTN","TMGMISC",1958,0) + +"RTN","TMGMISC",1959,0) +MkRangeList(Num,EndNum,List) +"RTN","TMGMISC",1960,0) + ;"Purpose: To create a list of entries, given a starting and ending number +"RTN","TMGMISC",1961,0) + ;"Input: Num -- the start entry number +"RTN","TMGMISC",1962,0) + ;" EndNum -- OPTIONAL, the last entry number (if supplied then all values +"RTN","TMGMISC",1963,0) + ;" between Num and Endnum will be added to list +"RTN","TMGMISC",1964,0) + ;" List -- PASS BY REFERENCE. An OUT PARAMETER. +"RTN","TMGMISC",1965,0) + ;"Output: List will be filled as follows: +"RTN","TMGMISC",1966,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1967,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1968,0) + ;" List(Entry number)="" +"RTN","TMGMISC",1969,0) + ;"Result: 1 if value input found, otherwise 0 +"RTN","TMGMISC",1970,0) + +"RTN","TMGMISC",1971,0) + new result set result=0 +"RTN","TMGMISC",1972,0) + set EndNum=$get(EndNum,Num) +"RTN","TMGMISC",1973,0) + if (+Num'=Num)!(+EndNum'=EndNum) goto MkRLDone +"RTN","TMGMISC",1974,0) + +"RTN","TMGMISC",1975,0) + new i +"RTN","TMGMISC",1976,0) + for i=Num:1:EndNum do +"RTN","TMGMISC",1977,0) + . set List(i)="" +"RTN","TMGMISC",1978,0) + . set result=1 +"RTN","TMGMISC",1979,0) + +"RTN","TMGMISC",1980,0) +MkRLDone +"RTN","TMGMISC",1981,0) + quit result +"RTN","TMGMISC",1982,0) + +"RTN","TMGMISC",1983,0) + +"RTN","TMGMISC",1984,0) +Flags(Var,Flag,Mode) +"RTN","TMGMISC",1985,0) + ;"Purpose: To set,delete,or toggle a flag stored in Var +"RTN","TMGMISC",1986,0) + ;"Input: Var -- PASS BY REFERENCE. The variable holding the flags +"RTN","TMGMISC",1987,0) + ;" Flag -- a single character flag to be stored in Var +"RTN","TMGMISC",1988,0) + ;" Mode: should be: 'SET','DEL',or 'TOGGLE'. Default is 'SET' +"RTN","TMGMISC",1989,0) + ;"Results: none +"RTN","TMGMISC",1990,0) + +"RTN","TMGMISC",1991,0) + set Flag=$get(Flag,"SET") +"RTN","TMGMISC",1992,0) + set Var=$get(Var) +"RTN","TMGMISC",1993,0) + if $get(Mode)="TOGGLE" do +"RTN","TMGMISC",1994,0) + . if Var[Flag set Mode="DEL" +"RTN","TMGMISC",1995,0) + . else set Mode="SET" +"RTN","TMGMISC",1996,0) + if $get(Mode)="SET" do +"RTN","TMGMISC",1997,0) + . if Var[Flag quit +"RTN","TMGMISC",1998,0) + . set Var=Var_Flag +"RTN","TMGMISC",1999,0) + if $get(Mode)="DEL" do +"RTN","TMGMISC",2000,0) + . if Var'[Flag quit +"RTN","TMGMISC",2001,0) + . set Var=$piece(Var,Flag,1)_$piece(Var,Flag,2) +"RTN","TMGMISC",2002,0) + +"RTN","TMGMISC",2003,0) + quit +"RTN","TMGMISC",2004,0) + +"RTN","TMGMISC",2005,0) + +"RTN","TMGMISC",2006,0) +CompABArray(pArrayA,pArrayB,pExtraB,pMissingB,pDiff,ProgressFn,IncVar) +"RTN","TMGMISC",2007,0) + ;"Purpose: To compare two arrays, A & B, and return results in OutArray +"RTN","TMGMISC",2008,0) + ;" that specifies how ArrayB differs from ArrayA +"RTN","TMGMISC",2009,0) + ;"Input: pArrayA -- PASS BY NAME. Baseline array to be compared against +"RTN","TMGMISC",2010,0) + ;" pArrayB -- PASS BY NAME. Array to be compare against ArrayA +"RTN","TMGMISC",2011,0) + ;" pExtraB -- PASS BY NAME. An OUT PARAMETER. Array of extra info from B +"RTN","TMGMISC",2012,0) + ;" OPTIONAL. If not provided, then data not filled. +"RTN","TMGMISC",2013,0) + ;" pMissingB -- PASS BY NAME. An OUT PARAMETER. Array of missing info +"RTN","TMGMISC",2014,0) + ;" OPTIONAL. If not provided, then data not filled. +"RTN","TMGMISC",2015,0) + ;" pDiff -- PASS BY NAME. An OUT PARAMETER. Output as below. +"RTN","TMGMISC",2016,0) + ;" OPTIONAL. If not provided, then data not filled. +"RTN","TMGMISC",2017,0) + ;" @pOutArray@("A",node,node,node,...)=different value +"RTN","TMGMISC",2018,0) + ;" @pOutArray@("B",node,node,node,...)=different value +"RTN","TMGMISC",2019,0) + ;" ProgressFn -- OPTIONAL -- M code to exec as a progress indicator +"RTN","TMGMISC",2020,0) + ;" IncVar -- OPTIONAL -- a counter that can be referenced by ProgressFn +"RTN","TMGMISC",2021,0) + ;"Results: 0=OK, 1=aborted +"RTN","TMGMISC",2022,0) + +"RTN","TMGMISC",2023,0) + new indexA,indexB +"RTN","TMGMISC",2024,0) + +"RTN","TMGMISC",2025,0) + set IncVar=+$get(IncVar) +"RTN","TMGMISC",2026,0) + set ProgressFn=$get(ProgressFn) +"RTN","TMGMISC",2027,0) + set pExtraB=$get(pExtraB) +"RTN","TMGMISC",2028,0) + set pMissingB=$get(pMissingB) +"RTN","TMGMISC",2029,0) + set pdiff=$get(pDiff) +"RTN","TMGMISC",2030,0) + new abort set abort=0 +"RTN","TMGMISC",2031,0) + new Compared +"RTN","TMGMISC",2032,0) + +"RTN","TMGMISC",2033,0) + set indexA="" +"RTN","TMGMISC",2034,0) + for set indexA=$order(@pArrayA@(indexA)) quit:(indexA="")!abort do +"RTN","TMGMISC",2035,0) + . set IncVar=IncVar+1 +"RTN","TMGMISC",2036,0) + . if (IncVar#10=1),(ProgressFn'="") do quit:(abort) +"RTN","TMGMISC",2037,0) + . . new $etrap set $etrap="set $etrap="""",$ecode=""""" +"RTN","TMGMISC",2038,0) + . . xecute ProgressFn +"RTN","TMGMISC",2039,0) + . . write !,pArrayA,"(",indexA,") ",! do CUU^TMGTERM(2) ;"temp +"RTN","TMGMISC",2040,0) + . . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGMISC",2041,0) + . if $data(@pArrayB@(indexA))=0 do quit +"RTN","TMGMISC",2042,0) + . . if (pMissingB'="") merge @pMissingB@(pArrayA,indexA)=@pArrayA@(indexA) +"RTN","TMGMISC",2043,0) + . new s1,s2 +"RTN","TMGMISC",2044,0) + . set s1=$get(@pArrayA@(indexA)) +"RTN","TMGMISC",2045,0) + . set s2=$get(@pArrayB@(indexA)) +"RTN","TMGMISC",2046,0) + . if s1'=s2 do +"RTN","TMGMISC",2047,0) + . . if pDiff="" quit +"RTN","TMGMISC",2048,0) + . . if $$TRIM^XLFSTR(s1)=$$TRIM^XLFSTR(s2) quit +"RTN","TMGMISC",2049,0) + . . set @pDiff@("A",pArrayA,indexA)=s1 +"RTN","TMGMISC",2050,0) + . . set @pDiff@("B",pArrayA,indexA)=s2 +"RTN","TMGMISC",2051,0) + . set abort=$$CompABArray($name(@pArrayA@(indexA)),$name(@pArrayB@(indexA)),.pExtraB,.pMissingB,.pDiff,.ProgressFn,.IncVar) +"RTN","TMGMISC",2052,0) + . set Compared($name(@pArrayA@(indexA)),$name(@pArrayB@(indexA)))=1 +"RTN","TMGMISC",2053,0) + +"RTN","TMGMISC",2054,0) + new temp set temp=1 +"RTN","TMGMISC",2055,0) + set indexB="" +"RTN","TMGMISC",2056,0) + for set indexB=$order(@pArrayB@(indexB)) quit:(indexB="")!abort do +"RTN","TMGMISC",2057,0) + . set temp=temp+1 +"RTN","TMGMISC",2058,0) + . if (temp#10=1) do quit:(abort) +"RTN","TMGMISC",2059,0) + . . write !,pArrayA,"(",indexB,") ",! do CUU^TMGTERM(2) ;"temp +"RTN","TMGMISC",2060,0) + . . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGMISC",2061,0) + . if $data(@pArrayA@(indexB))=0 do quit +"RTN","TMGMISC",2062,0) + . . if (pExtraB'="") merge @pExtraB@(pArrayA,indexB)=@pArrayB@(indexB) +"RTN","TMGMISC",2063,0) + . if $get(Compared($name(@pArrayA@(indexB)),$name(@pArrayB@(indexB))))=1 do quit ;"already checked +"RTN","TMGMISC",2064,0) + . . new temp +"RTN","TMGMISC",2065,0) + . set abort=$$CompABArray($name(@pArrayA@(indexB)),$name(@pArrayB@(indexB)),.pExtraB,.pMissingB,.pDiff) +"RTN","TMGMISC",2066,0) + +"RTN","TMGMISC",2067,0) + quit abort +"RTN","TMGMISC",2068,0) + +"RTN","TMGMISC",2069,0) + +"RTN","TMGMISC",2070,0) +FixArray(ref) +"RTN","TMGMISC",2071,0) + ;"Purpose: Convert an array like this: +"RTN","TMGMISC",2072,0) + ;" @ref@("^DD(2,.362)",21,1,0) --> @ref@("^DD",2,.362,21,1,0) +"RTN","TMGMISC",2073,0) + ;" @ref@("^DD(2,.362)",21,2,0) --> @ref@("^DD",2,.362,21,2,0) +"RTN","TMGMISC",2074,0) + ;" @ref@("^DD(2,.362)",23,0) --> @ref@("^DD",2,.362,23,0) +"RTN","TMGMISC",2075,0) + ;" @ref@("^DD(2,.362)",23,1,0) --> @ref@("^DD",2,.362,23,1,0) +"RTN","TMGMISC",2076,0) + ;" @ref@("^DD(2,0,""IX"")","ACFL2",2,.312) --> @ref@("^DD",2,0,"IX","ACFL2",2,.312) +"RTN","TMGMISC",2077,0) + ;" @ref@("^DD(2,0,""IX"")","AEXP",2,.351) --> @ref@("^DD",2,0,"IX","AEXP",2,.351) +"RTN","TMGMISC",2078,0) + ;" @ref@("^DD(2,0,""IX"")","TMGS",2,22701) --> @ref@("^DD",2,0,"IX","TMGS",2,22701) +"RTN","TMGMISC",2079,0) + ;" @ref@("^DD(2,0,""PT"")",228.1,.02) --> @ref@("^DD",2,0,"PT",228.1,.02) +"RTN","TMGMISC",2080,0) + ;" @ref@("^DD(2,0,""PT"")",228.2,.02) --> @ref@("^DD",2,0,"PT",228.2,.02) +"RTN","TMGMISC",2081,0) + ;" @ref@("^DD(2,0,""PT"")",19620.92,.08) --> @ref@("^DD",2,0,"PT",19620.92,.08) +"RTN","TMGMISC",2082,0) + ;" @ref@("^DD(2,0,""PT"",115)",.01) --> @ref@("^DD",2,0,"PT",115,.01) +"RTN","TMGMISC",2083,0) + ;"Input: ref -- PASS BY NAME +"RTN","TMGMISC",2084,0) + ;"Output: contents of @ref are converted as above. +"RTN","TMGMISC",2085,0) + ;"Results: none +"RTN","TMGMISC",2086,0) + +"RTN","TMGMISC",2087,0) + new origRef set origRef=ref +"RTN","TMGMISC",2088,0) + new output,s1,i +"RTN","TMGMISC",2089,0) + for set ref=$query(@ref) quit:(ref="") do +"RTN","TMGMISC",2090,0) + . set s1=$qsubscript(ref,1) +"RTN","TMGMISC",2091,0) + . new newRef set newRef="output" +"RTN","TMGMISC",2092,0) + . new startI set startI=1 +"RTN","TMGMISC",2093,0) + . if s1["(" do +"RTN","TMGMISC",2094,0) + . . set startI=2 +"RTN","TMGMISC",2095,0) + . . set newRef=newRef_"("""_$qs(s1,0)_""")" +"RTN","TMGMISC",2096,0) + . . if $qlength(s1)>1 for i=1:1:$qlength(s1) do +"RTN","TMGMISC",2097,0) + . . . set newRef=$name(@newRef@($qsubscript(s1,i))) +"RTN","TMGMISC",2098,0) + . for i=startI:1:$qlength(ref) do +"RTN","TMGMISC",2099,0) + . . new s3 set s3=$qsubscript(ref,i) +"RTN","TMGMISC",2100,0) + . . set newRef=$name(@newRef@(s3)) +"RTN","TMGMISC",2101,0) + . merge @newRef=@ref +"RTN","TMGMISC",2102,0) + +"RTN","TMGMISC",2103,0) + kill @origRef +"RTN","TMGMISC",2104,0) + merge @origRef=output ;"put changes back into original array +"RTN","TMGMISC",2105,0) + +"RTN","TMGMISC",2106,0) + quit +"RTN","TMGMISC",2107,0) + +"RTN","TMGMISC",2108,0) + +"RTN","TMGMISC",2109,0) + +"RTN","TMGMKU") +0^34^B159313 +"RTN","TMGMKU",1,0) +TMGMKU ;TMG/kst/Custom version of ZTMKU ;03/25/06 +"RTN","TMGMKU",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGMKU",3,0) + +"RTN","TMGMKU",4,0) + ;"ZTMKU code -- NON-INTERACTIVE versions of standard code. +"RTN","TMGMKU",5,0) + ;"============================================================================= +"RTN","TMGMKU",6,0) + ;"Kevin Toppenberg, MD 11-04 +"RTN","TMGMKU",7,0) + ;" +"RTN","TMGMKU",8,0) + ;"Purpose: +"RTN","TMGMKU",9,0) + ;" +"RTN","TMGMKU",10,0) + ;"This library will provide optional NON-INTERACTIVE versions of standard code. +"RTN","TMGMKU",11,0) + ;" +"RTN","TMGMKU",12,0) + ;"ZTMKU code +"RTN","TMGMKU",13,0) + ;"Apparent Callable points: +"RTN","TMGMKU",14,0) + ;" (See below about optional "INFO" parameter) +"RTN","TMGMKU",15,0) + ;" SSUB(NODE) ;Stop sub-managers +"RTN","TMGMKU",16,0) + ;" SMAN(NODE) ;stop managers +"RTN","TMGMKU",17,0) + ;" RUN(INFO) ;Remove Task Managers From WAIT State +"RTN","TMGMKU",18,0) + ;" UPDATE(INFO) ;Have Managers Do an parameter Update +"RTN","TMGMKU",19,0) + ;" WAIT(INFO) ;Put Task Managers In WAIT State +"RTN","TMGMKU",20,0) + ;" STOP(INFO) ;Shut Down Task Managers +"RTN","TMGMKU",21,0) + ;" QUERY ;Query Status Of A Task Manager +"RTN","TMGMKU",22,0) + ;" NODES ;Return Task Manager Status Nodes +"RTN","TMGMKU",23,0) + ;" LIVE ;Return Whether A Task Manager Is Live +"RTN","TMGMKU",24,0) + ;" TABLE(INFO) ;Display Task Manager Table +"RTN","TMGMKU",25,0) + ;" CLEAN(INFO) ;Cleanup Status Node +"RTN","TMGMKU",26,0) + ;" PURGE(INFO) ;Purge the TASK list of running tasks. +"RTN","TMGMKU",27,0) + ;" ZTM ;Return Number Of Live Task Managers +"RTN","TMGMKU",28,0) + ;" +"RTN","TMGMKU",29,0) + ;"Dependancies: +"RTN","TMGMKU",30,0) + ;" if TMGDEBUG defined, then requires TMGDEBUG.m +"RTN","TMGMKU",31,0) + ;"============================================================================= +"RTN","TMGMKU",32,0) + +"RTN","TMGMKU",33,0) +ZTMKU ;SEA/RDS-Taskman: Option, ZTMWAIT/RUN/STOP ;11/04/99 15:05 +"RTN","TMGMKU",34,0) + ;;8.0;KERNEL;**118,127,275**;Jul 10, 1995 +"RTN","TMGMKU",35,0) + ; +"RTN","TMGMKU",36,0) + +"RTN","TMGMKU",37,0) + ;"K. Toppenberg's changes made November, 2004 +"RTN","TMGMKU",38,0) + ;" +"RTN","TMGMKU",39,0) + ;"Input: +"RTN","TMGMKU",40,0) + ;" Note: INFO variable is completely an OPTIONAL parameter. +"RTN","TMGMKU",41,0) + ;" If not supplied, interactive mode used +"RTN","TMGMKU",42,0) + ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed. +"RTN","TMGMKU",43,0) + ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed. +"RTN","TMGMKU",44,0) + ;" +"RTN","TMGMKU",45,0) + ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied, if the +"RTN","TMGMKU",46,0) + ;" relevent function is being called. +"RTN","TMGMKU",47,0) + ;" ---------------------- +"RTN","TMGMKU",48,0) + ;" INFO("CONTINUE") -- Should contain the answer the user would enter for question: +"RTN","TMGMKU",49,0) + ;" Are you sure you want to stop TaskMan? +"RTN","TMGMKU",50,0) + ;" Used in STOP^TMGMKU(INFO) +"RTN","TMGMKU",51,0) + ;" INFO("SUBMANAGERS") -- Answer to: Should active submanagers shut down after finishing their current tasks? +"RTN","TMGMKU",52,0) + ;" Used in STOP^TMGMKU(INFO) +"RTN","TMGMKU",53,0) + ;"Output: +"RTN","TMGMKU",54,0) + ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array +"RTN","TMGMKU",55,0) + ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out. +"RTN","TMGMKU",56,0) + ;" INFO("TEXT","LINES")=Number of output lines +"RTN","TMGMKU",57,0) + ;" INFO("TEXT",1)= 1st output line +"RTN","TMGMKU",58,0) + ;" INFO("TEXT",2)= 2nd output line, etc... +"RTN","TMGMKU",59,0) + ; +"RTN","TMGMKU",60,0) + ; +"RTN","TMGMKU",61,0) + Q +"RTN","TMGMKU",62,0) + +"RTN","TMGMKU",63,0) +INIT +"RTN","TMGMKU",64,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"INIT^TMGMKU") +"RTN","TMGMKU",65,0) + IF $DATA(SILNTOUT)=0 KILL INFO("TEXT") ;//kt +"RTN","TMGMKU",66,0) + ; +"RTN","TMGMKU",67,0) + ;"Note: this establishes a variable with global-scope. ... And no one kills it... +"RTN","TMGMKU",68,0) + SET SILNTOUT=$GET(INFO("SILENT-OUTPUT"),0) ;//kt +"RTN","TMGMKU",69,0) + SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT +"RTN","TMGMKU",70,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"INIT^TMGMKU") +"RTN","TMGMKU",71,0) + ; +"RTN","TMGMKU",72,0) + QUIT +"RTN","TMGMKU",73,0) + +"RTN","TMGMKU",74,0) + +"RTN","TMGMKU",75,0) + ; +"RTN","TMGMKU",76,0) + ;"============================================================================= +"RTN","TMGMKU",77,0) +SSUB(NODE) ;Stop sub-managers +"RTN","TMGMKU",78,0) + D SS(1,"SUB",NODE) Q +"RTN","TMGMKU",79,0) + ;"============================================================================= +"RTN","TMGMKU",80,0) +SMAN(NODE) ;stop managers +"RTN","TMGMKU",81,0) + D SS(1,"MGR",NODE) Q +"RTN","TMGMKU",82,0) + ; +"RTN","TMGMKU",83,0) + ;"============================================================================= +"RTN","TMGMKU",84,0) +SS(MD,GR,NODE) ;Set/clear STOP nodes. +"RTN","TMGMKU",85,0) + S GR=$G(GR,"MGR") S:"MGR_SUB_"'[GR GR="MGR" +"RTN","TMGMKU",86,0) + I MD=1 S ^%ZTSCH("STOP",GR,NODE)=$H D WS(0,GR) +"RTN","TMGMKU",87,0) + I MD=0 K ^%ZTSCH("STOP",GR,NODE) +"RTN","TMGMKU",88,0) + Q +"RTN","TMGMKU",89,0) + ; +"RTN","TMGMKU",90,0) + ;"============================================================================= +"RTN","TMGMKU",91,0) +WS(MD,GR) ;Set/Clear Wait state +"RTN","TMGMKU",92,0) + S GR=$G(GR,"MGR") S:"MGR_SUB_"'[GR GR="MGR" +"RTN","TMGMKU",93,0) + I MD=1 S ^%ZTSCH("WAIT",GR)=$H ;set wait state +"RTN","TMGMKU",94,0) + I MD=0 K ^%ZTSCH("WAIT",GR) ;Clear wait +"RTN","TMGMKU",95,0) + Q +"RTN","TMGMKU",96,0) + ; +"RTN","TMGMKU",97,0) + ;"============================================================================= +"RTN","TMGMKU",98,0) +GROUP(CALL) ;Do CALL for each node, use NODE as the parameter +"RTN","TMGMKU",99,0) + N J,ND,NODE +"RTN","TMGMKU",100,0) + F J=0:0 S J=$O(^%ZTSCH("STATUS",J)) Q:J="" S ND=$G(^(J)),NODE=$P(ND,"^",3) D @CALL +"RTN","TMGMKU",101,0) + Q +"RTN","TMGMKU",102,0) + ; +"RTN","TMGMKU",103,0) + ;"============================================================================= +"RTN","TMGMKU",104,0) +OPT(MD) ;Disable/Enable option prosessing +"RTN","TMGMKU",105,0) + I MD=1 S ^%ZTSCH("NO-OPTION")="" +"RTN","TMGMKU",106,0) + I MD=0 K ^%ZTSCH("NO-OPTION") +"RTN","TMGMKU",107,0) + Q +"RTN","TMGMKU",108,0) + ; +"RTN","TMGMKU",109,0) + ;"============================================================================= +"RTN","TMGMKU",110,0) +RUN(INFO) ;Remove Task Managers From WAIT State +"RTN","TMGMKU",111,0) + D WS(0,"MGR"),WS(0,"SUB") K ^%ZTSCH("STOP") +"RTN","TMGMKU",112,0) + +"RTN","TMGMKU",113,0) + DO INIT +"RTN","TMGMKU",114,0) + DO OUTP^TMGQIO(SILNTOUT,"!","Done!","!") +"RTN","TMGMKU",115,0) + Q +"RTN","TMGMKU",116,0) + ; +"RTN","TMGMKU",117,0) + ;"============================================================================= +"RTN","TMGMKU",118,0) +UPDATE(INFO) ;Have Managers Do an parameter Update +"RTN","TMGMKU",119,0) + K ^%ZTSCH("UPDATE") +"RTN","TMGMKU",120,0) + DO INIT +"RTN","TMGMKU",121,0) + DO OUTP^TMGQIO(SILNTOUT,"!","Done!","!") +"RTN","TMGMKU",122,0) + Q +"RTN","TMGMKU",123,0) + ; +"RTN","TMGMKU",124,0) + ;"============================================================================= +"RTN","TMGMKU",125,0) +WAIT(INFO) ;Put Task Managers In WAIT State +"RTN","TMGMKU",126,0) + DO INIT +"RTN","TMGMKU",127,0) + D WS(1,"MGR") +"RTN","TMGMKU",128,0) + DO OUTP^TMGQIO(SILNTOUT,"!","TaskMan now in 'WAIT STATE'",$C(7),"!") +"RTN","TMGMKU",129,0) + D QSUB +"RTN","TMGMKU",130,0) + Q +"RTN","TMGMKU",131,0) + ; +"RTN","TMGMKU",132,0) + ;"============================================================================= +"RTN","TMGMKU",133,0) +STOP(INFO) ;Shut Down Task Managers +"RTN","TMGMKU",134,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"STOP^TMGMKU") +"RTN","TMGMKU",135,0) + DO INIT +"RTN","TMGMKU",136,0) + N ZTX,ND,J +"RTN","TMGMKU",137,0) + DO INIT +"RTN","TMGMKU",138,0) + F DO Q:'$T!("^YESyesNOno"[ZTX)!(SILENTIN=1) +"RTN","TMGMKU",139,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","Are you sure you want to stop TaskMan? NO// ") +"RTN","TMGMKU",140,0) + . IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Starting Question Loop") +"RTN","TMGMKU",141,0) + . DO INP^TMGQIO(.ZTX,SILENTIN,$G(DTIME,60),$GET(INFO("CONTINUE"))) +"RTN","TMGMKU",142,0) + . IF $GET(ZTX)="" SET ZTX="NO" +"RTN","TMGMKU",143,0) + . Q:'$T!("^YESyesNOno"[ZTX)!(SILENTIN=1) +"RTN","TMGMKU",144,0) + . IF ZTX'["?" DO OUTP^TMGQIO(SILNTOUT,$C(7)) +"RTN","TMGMKU",145,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Answer YES to shut down all Task Managers on current the volume set.") +"RTN","TMGMKU",146,0) + IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Processing input") +"RTN","TMGMKU",147,0) + I "YESyes"[ZTX DO +"RTN","TMGMKU",148,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Shutting down TaskMan.") +"RTN","TMGMKU",149,0) + . D GROUP("SMAN(NODE)") +"RTN","TMGMKU",150,0) + . ;"F J=0:0 S J=$O(^%ZTSCH("STATUS",J)) Q:J="" S ND=$G(^(J)) D SMAN($P(ND,U,3)) +"RTN","TMGMKU",151,0) + . ;"Q +"RTN","TMGMKU",152,0) + . D QSUB +"RTN","TMGMKU",153,0) + ELSE DO +"RTN","TMGMKU",154,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","TaskMan NOT shut down.") +"RTN","TMGMKU",155,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"STOP^TMGMKU") +"RTN","TMGMKU",156,0) + Q +"RTN","TMGMKU",157,0) + ; +"RTN","TMGMKU",158,0) + ;"============================================================================= +"RTN","TMGMKU",159,0) +QSUB +"RTN","TMGMKU",160,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"QSUB^TMGMKU") +"RTN","TMGMKU",161,0) + N ZTX,ND +"RTN","TMGMKU",162,0) + F DO Q:'$T!("^YESyesNOno"[ZTX)!(SILENTIN=1) +"RTN","TMGMKU",163,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","!","Should active submanagers shut down after finishing their current tasks? NO// ") +"RTN","TMGMKU",164,0) + . IF $DATA(TMGDEBUG) DO DebugMsg^TMGDEBUG(.DBINDENT,"Auto answer=",$GET(INFO("SUBMANAGERS"))) +"RTN","TMGMKU",165,0) + . DO INP^TMGQIO(.ZTX,SILENTIN,$S($D(DTIME)#2:DTIME,1:60),$GET(INFO("SUBMANAGERS"))) +"RTN","TMGMKU",166,0) + . IF ZTX="" SET ZTX="NO" +"RTN","TMGMKU",167,0) + . Q:'$T!("^YESyesNOno"[ZTX)!(SILENTIN=1) +"RTN","TMGMKU",168,0) + . IF ZTX'["?" DO OUTP^TMGQIO(SILNTOUT,$C(7)) +"RTN","TMGMKU",169,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Please answer YES or NO..") +"RTN","TMGMKU",170,0) + I "YESyes"[ZTX DO +"RTN","TMGMKU",171,0) + . DO GROUP("SSUB(NODE)") +"RTN","TMGMKU",172,0) + . DO OUTP^TMGQIO(SILNTOUT,"!","Okay!","!") +"RTN","TMGMKU",173,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"QSUB^TMGMKU") +"RTN","TMGMKU",174,0) + Q +"RTN","TMGMKU",175,0) + ; +"RTN","TMGMKU",176,0) + ;"============================================================================= +"RTN","TMGMKU",177,0) +QUERY ;Query Status Of A Task Manager +"RTN","TMGMKU",178,0) + Q:$D(%ZTX)[0 Q:%ZTX="" S %ZTY=0 +"RTN","TMGMKU",179,0) + I $D(^%ZTSCH("STATUS",%ZTX))#2 S %ZTY=^%ZTSCH("STATUS",%ZTX) +"RTN","TMGMKU",180,0) + K %ZTX Q +"RTN","TMGMKU",181,0) + ; +"RTN","TMGMKU",182,0) + ;"============================================================================= +"RTN","TMGMKU",183,0) +NODES ;Return Task Manager Status Nodes +"RTN","TMGMKU",184,0) + S %ZTX="" F %ZTY=0:0 S %ZTX=$O(^%ZTSCH("STATUS",%ZTX)) Q:%ZTX="" S %ZTY=%ZTY+1,%ZTY(%ZTY)=%ZTX +"RTN","TMGMKU",185,0) + K %ZTX Q +"RTN","TMGMKU",186,0) + ; +"RTN","TMGMKU",187,0) + ;"============================================================================= +"RTN","TMGMKU",188,0) +LIVE ;Return Whether A Task Manager Is Live +"RTN","TMGMKU",189,0) + Q:$D(%ZTX)[0 Q:%ZTX="" S %ZTY=0,U="^",%ZTX1=$H,%ZTX2=$P(%ZTX,U) +"RTN","TMGMKU",190,0) + S %ZTX3=%ZTX1-%ZTX2*86400+$P(%ZTX1,",",2)-$P(%ZTX2,",",2) +"RTN","TMGMKU",191,0) + I %ZTX3'<0 S %ZTY=$S($D(^%ZTSCH("RUN"))[0&(%ZTX'["WAIT"):0,%ZTX3<30:1,%ZTX3<120&(%ZTX["PAUSE"):1,1:0) +"RTN","TMGMKU",192,0) + K %ZTX,%ZTX1,%ZTX2,%ZTX3 Q +"RTN","TMGMKU",193,0) + ; +"RTN","TMGMKU",194,0) + ;"============================================================================= +"RTN","TMGMKU",195,0) +TABLE(INFO) ;Display Task Manager Table +"RTN","TMGMKU",196,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"TABLE^TMGMKU") +"RTN","TMGMKU",197,0) + DO INIT +"RTN","TMGMKU",198,0) + DO OUTP^TMGQIO(SILNTOUT,"!","NUMBER","?15","STATUS","?25","DESCRIPTION","?55","LAST UPDATED","?75","LIVE") +"RTN","TMGMKU",199,0) + DO OUTP^TMGQIO(SILNTOUT,"!","------","?15","------","?25","-----------","?55","------------","?75","----") +"RTN","TMGMKU",200,0) + D NODES S %ZTZ=%ZTY,%ZTZ1=0,U="^",%H=$H D YMD^%DTC S DT=X +"RTN","TMGMKU",201,0) + F %ZTI=1:1:%ZTZ DO +"RTN","TMGMKU",202,0) + . S %ZTX=%ZTY(%ZTI) +"RTN","TMGMKU",203,0) + . D QUERY +"RTN","TMGMKU",204,0) + . I %ZTY'=0 DO +"RTN","TMGMKU",205,0) + . . DO OUTP^TMGQIO(SILNTOUT,"!",%ZTY(%ZTI),"?15",$P(%ZTY,U,2),"?25",$P(%ZTY,U,3),"?55") +"RTN","TMGMKU",206,0) + . . S %ZTT=$P(%ZTY,U) +"RTN","TMGMKU",207,0) + . . D T +"RTN","TMGMKU",208,0) + . . S %ZTX=%ZTY +"RTN","TMGMKU",209,0) + . . D LIVE +"RTN","TMGMKU",210,0) + . . DO OUTP^TMGQIO(SILNTOUT,"?75",$S(%ZTY:"YES",1:"NO")) +"RTN","TMGMKU",211,0) + . . I %ZTY S %ZTZ1=%ZTZ1+1 +"RTN","TMGMKU",212,0) + DO OUTP^TMGQIO(SILNTOUT,"!","?6","Total:",$J(%ZTZ,3),"!") +"RTN","TMGMKU",213,0) + DO OUTP^TMGQIO(SILNTOUT,"?6","Live :",$J(%ZTZ1,3)) +"RTN","TMGMKU",214,0) + K %ZTI,%ZTT,%ZTY,%ZTZ +"RTN","TMGMKU",215,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"TABLE^TMGMKU") +"RTN","TMGMKU",216,0) + Q +"RTN","TMGMKU",217,0) + ; +"RTN","TMGMKU",218,0) + ; +"RTN","TMGMKU",219,0) + ;"============================================================================= +"RTN","TMGMKU",220,0) +CLEAN(INFO) ;Cleanup Status Node +"RTN","TMGMKU",221,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"CLEAN^TMGMKU") +"RTN","TMGMKU",222,0) + DO INIT +"RTN","TMGMKU",223,0) + K ^%ZTSCH("STATUS") +"RTN","TMGMKU",224,0) + DO OUTP^TMGQIO(SILNTOUT,"!","Done!","!") +"RTN","TMGMKU",225,0) + ; +"RTN","TMGMKU",226,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"CLEAN^TMGMKU") +"RTN","TMGMKU",227,0) + Q +"RTN","TMGMKU",228,0) + ; +"RTN","TMGMKU",229,0) + ; +"RTN","TMGMKU",230,0) + ;"============================================================================= +"RTN","TMGMKU",231,0) +PURGE(INFO) ;Purge the TASK list of running tasks. +"RTN","TMGMKU",232,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"PURGE^TMGMKU") +"RTN","TMGMKU",233,0) + DO INIT +"RTN","TMGMKU",234,0) + N TSK S TSK=0 +"RTN","TMGMKU",235,0) + F S TSK=$O(^%ZTSCH("TASK",TSK)) Q:TSK'>0 I '$D(^%ZTSCH("TASK",TSK,"P")) K ^%ZTSCH("TASK",TSK) +"RTN","TMGMKU",236,0) + DO OUTP^TMGQIO(SILNTOUT,"!","Done!","!") +"RTN","TMGMKU",237,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"CLEAN^TMGMKU") +"RTN","TMGMKU",238,0) + Q +"RTN","TMGMKU",239,0) + ; +"RTN","TMGMKU",240,0) + ; +"RTN","TMGMKU",241,0) + ;"============================================================================= +"RTN","TMGMKU",242,0) +ZTM ;Return Number Of Live Task Managers +"RTN","TMGMKU",243,0) + D NODES S %ZTZ=%ZTY,%ZTZ1=0 F %ZTI=1:1:%ZTZ S %ZTX=%ZTY(%ZTI) D QUERY I %ZTY'=0 S %ZTX=%ZTY D LIVE I %ZTY S %ZTZ1=%ZTZ1+1 +"RTN","TMGMKU",244,0) + S %ZTY=%ZTZ1 K %ZTI,%ZTZ,%ZTZ1 Q +"RTN","TMGMKU",245,0) + ; +"RTN","TMGMKU",246,0) + ;"============================================================================= +"RTN","TMGMKU",247,0) +T ;Print Informal-format Conversion Of $H-format Date ; Input: %ZTT, DT. +"RTN","TMGMKU",248,0) + IF $DATA(TMGDEBUG) DO DebugEntry^TMGDEBUG(.DBINDENT,"T^TMGMKU") +"RTN","TMGMKU",249,0) + S %H=%ZTT +"RTN","TMGMKU",250,0) + D 7^%DTC +"RTN","TMGMKU",251,0) + DO OUTP^TMGQIO(SILNTOUT,$S(DT=X:"TODAY",DT+1=X:"TOMORROW",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3))_" AT ") +"RTN","TMGMKU",252,0) + S X=$P(%ZTT,",",2)\60 +"RTN","TMGMKU",253,0) + S %H=X\60 +"RTN","TMGMKU",254,0) + DO OUTP^TMGQIO(SILNTOUT,$E(%H+100,2,3)_":"_$E(X#60+100,2,3)) +"RTN","TMGMKU",255,0) + K %,%D,%H,%M,%Y,X +"RTN","TMGMKU",256,0) + ; +"RTN","TMGMKU",257,0) + IF $DATA(TMGDEBUG) DO DebugExit^TMGDEBUG(.DBINDENT,"T^TMGMKU") +"RTN","TMGMKU",258,0) + Q ; Output: %ZTT, DT. +"RTN","TMGMKU",259,0) + ; +"RTN","TMGMKU",260,0) + ;"============================================================================= +"RTN","TMGNDF0A") +0^35^B7420 +"RTN","TMGNDF0A",1,0) +TMGNDF0A ;TMG/kst/FDA Import: Load FDA data files ;03/25/06 +"RTN","TMGNDF0A",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF0A",3,0) + +"RTN","TMGNDF0A",4,0) + ;" FDA - NATIONAL DRUG FILES IMPORT FUNCTIONS +"RTN","TMGNDF0A",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF0A",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF0A",7,0) + ;"11-21-2006 +"RTN","TMGNDF0A",8,0) + +"RTN","TMGNDF0A",9,0) + ;"Purpose: to import the National Drug Files, as distributed by: +"RTN","TMGNDF0A",10,0) + ;" http://www.fda.gov/cder/ndc/ in format as of 10/17/2005 +"RTN","TMGNDF0A",11,0) + ;" List of files imported: +"RTN","TMGNDF0A",12,0) + ;" TMG FDA APPLICATION (22706.1) <--> applicat.TXT +"RTN","TMGNDF0A",13,0) + ;" TMG FDA DOSAGE FORM (22706.2) <--> dosform.TXT +"RTN","TMGNDF0A",14,0) + ;" TMG FDA FIRMS (22706.3) <--> FIRMS.TXT ;was firms.txt +"RTN","TMGNDF0A",15,0) + ;" TMG FDA FORMULATION (22706.4) <--> FORMULAT.TXT +"RTN","TMGNDF0A",16,0) + ;" TMG FDA LISTING (22706.5) <--> listings.TXT ;was listings.txt +"RTN","TMGNDF0A",17,0) + ;" TMG FDA PACKAGES (22706.6) <--> packages.txt +"RTN","TMGNDF0A",18,0) + ;" TMG FDA ROUTES (22706.7) <--> ROUTES.TXT ;was routes.txt +"RTN","TMGNDF0A",19,0) + ;" TMG FDA UNIT ABBREVIATIONS (22706.8) <--> TBLUNIT.TXT ; was tblunit.txt +"RTN","TMGNDF0A",20,0) + +"RTN","TMGNDF0A",21,0) + ;"======================================================================= +"RTN","TMGNDF0A",22,0) + ;" API -- Public Functions. +"RTN","TMGNDF0A",23,0) + ;"======================================================================= +"RTN","TMGNDF0A",24,0) + ;"Menu -- The starting menu for the import process +"RTN","TMGNDF0A",25,0) + +"RTN","TMGNDF0A",26,0) + ;"======================================================================= +"RTN","TMGNDF0A",27,0) + ;" API -- Semi-Public Functions. +"RTN","TMGNDF0A",28,0) + ;"======================================================================= +"RTN","TMGNDF0A",29,0) + ;"ImportNDF +"RTN","TMGNDF0A",30,0) + ;"$$DataImport(Info,ProgressFN) +"RTN","TMGNDF0A",31,0) + ;"Backup +"RTN","TMGNDF0A",32,0) + +"RTN","TMGNDF0A",33,0) + ;"======================================================================= +"RTN","TMGNDF0A",34,0) + ;" Private Functions. +"RTN","TMGNDF0A",35,0) + ;"======================================================================= +"RTN","TMGNDF0A",36,0) + ;"SetLoadDir(LoadDir) +"RTN","TMGNDF0A",37,0) + ;"$$LoadApplication(LoadDir) +"RTN","TMGNDF0A",38,0) + ;"$$LoadDosageForm(LoadDir) +"RTN","TMGNDF0A",39,0) + ;"$$LoadFirms(LoadDir) +"RTN","TMGNDF0A",40,0) + ;"$$LoadFormulation(LoadDir) +"RTN","TMGNDF0A",41,0) + ;"$$LoadListing(LoadDir) +"RTN","TMGNDF0A",42,0) + ;"$$LoadPackages(LoadDir) +"RTN","TMGNDF0A",43,0) + ;"$$LoadRoutes(LoadDir) +"RTN","TMGNDF0A",44,0) + ;"$$LoadUnitAbbr(LoadDir) +"RTN","TMGNDF0A",45,0) + ;"SetSkipFlag +"RTN","TMGNDF0A",46,0) + +"RTN","TMGNDF0A",47,0) + ;"======================================================================= +"RTN","TMGNDF0A",48,0) + ;"======================================================================= +"RTN","TMGNDF0A",49,0) +Menu +"RTN","TMGNDF0A",50,0) + ;"Purpose: To give an interactive menu +"RTN","TMGNDF0A",51,0) + +"RTN","TMGNDF0A",52,0) + new Menu,UsrSlct +"RTN","TMGNDF0A",53,0) + set Menu(0)="Pick Option for Parsing FDA Tables (0A)" +"RTN","TMGNDF0A",54,0) + set Menu(1)="Review instructions"_$char(9)_"Instructions" +"RTN","TMGNDF0A",55,0) + set Menu(2)="Parse FDA tables into corresponding Fileman Tables"_$char(9)_"ParseAll" +"RTN","TMGNDF0A",56,0) + ;"set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF0A",57,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF0A",58,0) + +"RTN","TMGNDF0A",59,0) +CD1 +"RTN","TMGNDF0A",60,0) + write # +"RTN","TMGNDF0A",61,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF0A",62,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF0A",63,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF0A",64,0) + +"RTN","TMGNDF0A",65,0) + ;"if UsrSlct="Prev" goto Menu^TMGNDF1D ;"quit can occur from there... +"RTN","TMGNDF0A",66,0) + if UsrSlct="Next" goto Menu^TMGNDF0B ;"quit can occur from there... +"RTN","TMGNDF0A",67,0) + if UsrSlct="Instructions" do Instructions goto CD1 +"RTN","TMGNDF0A",68,0) + if UsrSlct="ParseAll" do ImportNDF goto CD1 +"RTN","TMGNDF0A",69,0) + goto CD1 +"RTN","TMGNDF0A",70,0) +CDDone +"RTN","TMGNDF0A",71,0) + quit +"RTN","TMGNDF0A",72,0) + +"RTN","TMGNDF0A",73,0) + ;"======================================================================= +"RTN","TMGNDF0A",74,0) + +"RTN","TMGNDF0A",75,0) +Instructions +"RTN","TMGNDF0A",76,0) + ;"Purpose: to show some instructions +"RTN","TMGNDF0A",77,0) + +"RTN","TMGNDF0A",78,0) + write !! +"RTN","TMGNDF0A",79,0) + write "The individual tables from the FDA should be downloaded from: ",! +"RTN","TMGNDF0A",80,0) + write " www.fda.gov/cder/ndc",! +"RTN","TMGNDF0A",81,0) + write ! +"RTN","TMGNDF0A",82,0) + write "Reloading these files will NOT immediately overwrite changes made",! +"RTN","TMGNDF0A",83,0) + write "the COMPILED import data. It will simply get the FDA tables",! +"RTN","TMGNDF0A",84,0) + write "into a format for later compilation.",! +"RTN","TMGNDF0A",85,0) + write ! +"RTN","TMGNDF0A",86,0) + write "Note: the instructions on the FDA website should be compared to the",! +"RTN","TMGNDF0A",87,0) + write "parsing code in TMGNDF0A.m to ensure that the FDA table format has",! +"RTN","TMGNDF0A",88,0) + write "not changed.",!,! +"RTN","TMGNDF0A",89,0) + +"RTN","TMGNDF0A",90,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF0A",91,0) + quit +"RTN","TMGNDF0A",92,0) + +"RTN","TMGNDF0A",93,0) + ;"======================================================================= +"RTN","TMGNDF0A",94,0) + ;"Note: these files were downloaded from: +"RTN","TMGNDF0A",95,0) + ;" www.fda.gov/cder/ndc +"RTN","TMGNDF0A",96,0) + +"RTN","TMGNDF0A",97,0) +ImportNDF +"RTN","TMGNDF0A",98,0) + ;"Purpose: to import the National Drug Files, as distributed by: +"RTN","TMGNDF0A",99,0) + ;" http://www.fda.gov/cder/ndc/, in format as of 10/17/2005 +"RTN","TMGNDF0A",100,0) + ;" List of files imported: +"RTN","TMGNDF0A",101,0) + ;" TMG FDA APPLICATION <--> applicat.TXT +"RTN","TMGNDF0A",102,0) + ;" TMG FDA DOSAGE FORM <--> dosform.TXT +"RTN","TMGNDF0A",103,0) + ;" TMG FDA FIRMS <--> FIRMS.TXT ;was firms.txt +"RTN","TMGNDF0A",104,0) + ;" TMG FDA FORMULATION <--> FORMULAT.TXT +"RTN","TMGNDF0A",105,0) + ;" TMG FDA LISTING <--> listings.TXT ;was listings.txt +"RTN","TMGNDF0A",106,0) + ;" TMG FDA PACKAGES <--> packages.txt +"RTN","TMGNDF0A",107,0) + ;" TMG FDA ROUTES <--> ROUTES.TXT ;was routes.txt +"RTN","TMGNDF0A",108,0) + ;" TMG FDA UNIT ABBREVIATIONS <--> TBLUNIT.TXT ; was tblunit.txt +"RTN","TMGNDF0A",109,0) + ;"Prerequisites: Must have Fileman files created to import into +"RTN","TMGNDF0A",110,0) + +"RTN","TMGNDF0A",111,0) + new LoadDir +"RTN","TMGNDF0A",112,0) + new PriorErrorFound +"RTN","TMGNDF0A",113,0) + new ProgressFn +"RTN","TMGNDF0A",114,0) + set ProgressFn="if TMGCUR#100=1 do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",0,TMGTOTAL,,StartTime)" +"RTN","TMGNDF0A",115,0) + +"RTN","TMGNDF0A",116,0) + write "Custom FDA Drug Files Importer",!! +"RTN","TMGNDF0A",117,0) + write "This will DELETE all exsting entries in FDA National ",! +"RTN","TMGNDF0A",118,0) + write "Drug Files, and then reload them from source text files.",! +"RTN","TMGNDF0A",119,0) + write "Do you want to do this? " +"RTN","TMGNDF0A",120,0) + set %=2 ;"2=NO default +"RTN","TMGNDF0A",121,0) + do YN^DICN +"RTN","TMGNDF0A",122,0) + write ! +"RTN","TMGNDF0A",123,0) + if %'=1 goto INDFError +"RTN","TMGNDF0A",124,0) + if $$SetLoadDir(.LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",125,0) + +"RTN","TMGNDF0A",126,0) + new skip set skip=0 +"RTN","TMGNDF0A",127,0) + write "Loading TMG FDA APPLICATIONS",! +"RTN","TMGNDF0A",128,0) + if 'skip if $$LoadApplication(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",129,0) + write "Loading TMG FDA DOSAGE FORMS",! +"RTN","TMGNDF0A",130,0) + if 'skip if $$LoadDosageForm(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",131,0) + write "Loading TMG FDA firms",! +"RTN","TMGNDF0A",132,0) + if 'skip if $$LoadFirms(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",133,0) + write "Loading TMG FDA FORMULATIONS",! +"RTN","TMGNDF0A",134,0) + if 'skip if $$LoadFormulation(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",135,0) + write "Loading TMG FDA PACKAGES",! +"RTN","TMGNDF0A",136,0) + if 'skip if $$LoadPackages(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",137,0) + write "Loading TMG FDA ROUTES",! +"RTN","TMGNDF0A",138,0) + if 'skip if $$LoadRoutes(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",139,0) + write "Loading TMG FDA UNIT ABBREVIATIONS",! +"RTN","TMGNDF0A",140,0) + if 'skip if $$LoadUnitAbbr(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",141,0) + write "Loading TMG FDA LISTINGS",! +"RTN","TMGNDF0A",142,0) + if 'skip if $$LoadListing(LoadDir)=0 goto INDFError +"RTN","TMGNDF0A",143,0) + +"RTN","TMGNDF0A",144,0) + write "All done. Import Successful.",! +"RTN","TMGNDF0A",145,0) + goto INDFDone +"RTN","TMGNDF0A",146,0) + +"RTN","TMGNDF0A",147,0) +INDFError +"RTN","TMGNDF0A",148,0) + Write "Import was NOT successful. Quitting.",! +"RTN","TMGNDF0A",149,0) + +"RTN","TMGNDF0A",150,0) +INDFDone +"RTN","TMGNDF0A",151,0) + quit +"RTN","TMGNDF0A",152,0) + +"RTN","TMGNDF0A",153,0) + +"RTN","TMGNDF0A",154,0) +SetLoadDir(LoadDir) +"RTN","TMGNDF0A",155,0) + ;"Purpose to ensure that LoadDir is set properly +"RTN","TMGNDF0A",156,0) + ;"LoadDir -- PASS BY REFERENCE, an OUT parameter +"RTN","TMGNDF0A",157,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",158,0) + +"RTN","TMGNDF0A",159,0) + new Msg +"RTN","TMGNDF0A",160,0) + new result set result=1 +"RTN","TMGNDF0A",161,0) + set Msg="Please Pick ANY file in the directory containing NDF files" +"RTN","TMGNDF0A",162,0) + new defDir set defDir="/home/kdt0p/downloads/FDA-NDC-Files/" +"RTN","TMGNDF0A",163,0) + if $$GetFName^TMGIOUTL(Msg,defDir,,,.LoadDir)="" do +"RTN","TMGNDF0A",164,0) + . set result=0 +"RTN","TMGNDF0A",165,0) + +"RTN","TMGNDF0A",166,0) + quit result +"RTN","TMGNDF0A",167,0) + +"RTN","TMGNDF0A",168,0) + +"RTN","TMGNDF0A",169,0) +LoadApplication(LoadDir) +"RTN","TMGNDF0A",170,0) + ;"Purpose: to load from applicat.TXT +"RTN","TMGNDF0A",171,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",172,0) + ;"Output: Kills any prior entries in TMG FDA APPLICATION +"RTN","TMGNDF0A",173,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",174,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",175,0) + +"RTN","TMGNDF0A",176,0) + ;" Info("HFS DIR")= +"RTN","TMGNDF0A",177,0) + ;" Info("HFS FILE")= +"RTN","TMGNDF0A",178,0) + ;" Info("DEST FILE")= +"RTN","TMGNDF0A",179,0) + ;" Info(x)=field# (or "IEN" if data should be used to determine record number +"RTN","TMGNDF0A",180,0) + ;" Info(x,"START")=starting column +"RTN","TMGNDF0A",181,0) + ;" Info(x,"END")=ending column +"RTN","TMGNDF0A",182,0) + +"RTN","TMGNDF0A",183,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",184,0) + ;"===================================== +"RTN","TMGNDF0A",185,0) + ;"MAY OCCUR MORE THAN ONCE PER LISTING SEQ NO. +"RTN","TMGNDF0A",186,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",187,0) + ;" Linking field to LISTINGS. +"RTN","TMGNDF0A",188,0) + ;"APPL_NO NULL CHAR(6) COL:9-14 +"RTN","TMGNDF0A",189,0) + ;" Number of New Drug Application if applicable. If none has been +"RTN","TMGNDF0A",190,0) + ;" provided by the firm then the value ‘Other’ is used. +"RTN","TMGNDF0A",191,0) + ;"PROD_NO NULL CHAR(3) COL:16-18 +"RTN","TMGNDF0A",192,0) + ;" Number used to identify the products of a New Drug Application. +"RTN","TMGNDF0A",193,0) + ;"===================================== +"RTN","TMGNDF0A",194,0) + ;"Log: +"RTN","TMGNDF0A",195,0) + ;" 10/20/07 -- modified for 9/12/07 database +"RTN","TMGNDF0A",196,0) + +"RTN","TMGNDF0A",197,0) + new Info +"RTN","TMGNDF0A",198,0) + new result +"RTN","TMGNDF0A",199,0) + +"RTN","TMGNDF0A",200,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",201,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",202,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",203,0) + new temp set temp=$get(^TMG(22706.1,0)) +"RTN","TMGNDF0A",204,0) + kill ^TMG(22706.1) +"RTN","TMGNDF0A",205,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",206,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",207,0) + set ^TMG(22706.1,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",208,0) + +"RTN","TMGNDF0A",209,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",210,0) + set Info("HFS FILE")="applicat.txt" ;" was applicat.TXT before +"RTN","TMGNDF0A",211,0) + set Info("DEST FILE")="TMG FDA APPLICATION" +"RTN","TMGNDF0A",212,0) + +"RTN","TMGNDF0A",213,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",214,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",215,0) + if result>0 set result=0 goto LADone +"RTN","TMGNDF0A",216,0) + +"RTN","TMGNDF0A",217,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",218,0) + ;"Linking field to LISTINGS. +"RTN","TMGNDF0A",219,0) + set Info(.01)=.01 ;"Listing, pointer to 22706.5 +"RTN","TMGNDF0A",220,0) + set Info(.01,"START")=1 ;"was 1 +"RTN","TMGNDF0A",221,0) + set Info(.01,"END")=7 ;"was 8 +"RTN","TMGNDF0A",222,0) + +"RTN","TMGNDF0A",223,0) + ;"APPL_NO NULL CHAR(6) COL:10-15 +"RTN","TMGNDF0A",224,0) + ;"Number of New Drug Application if applicable. +"RTN","TMGNDF0A",225,0) + ;"If none has been provided by the firm then the value ‘Other’ is used. +"RTN","TMGNDF0A",226,0) + set Info(1)=1 ;"Application +"RTN","TMGNDF0A",227,0) + set Info(1,"START")=9 ;"was 10 <-- was 9 +"RTN","TMGNDF0A",228,0) + set Info(1,"END")=14 ;"was 15 <-- was 15 +"RTN","TMGNDF0A",229,0) + +"RTN","TMGNDF0A",230,0) + ;"PROD_NO NULL CHAR(3) COL:17-19 +"RTN","TMGNDF0A",231,0) + ;"Number used to identify the products of a New Drug Application. . +"RTN","TMGNDF0A",232,0) + set Info(2)=2 ;"Product Number +"RTN","TMGNDF0A",233,0) + set Info(2,"START")=16 ;"was 17 <-- was 16 +"RTN","TMGNDF0A",234,0) + set Info(2,"END")=18 ;"was 19 <-- was 22 +"RTN","TMGNDF0A",235,0) + +"RTN","TMGNDF0A",236,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",237,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",238,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",239,0) + +"RTN","TMGNDF0A",240,0) +LADone +"RTN","TMGNDF0A",241,0) + quit result +"RTN","TMGNDF0A",242,0) + +"RTN","TMGNDF0A",243,0) + +"RTN","TMGNDF0A",244,0) +LoadDosageForm(LoadDir) +"RTN","TMGNDF0A",245,0) + ;"Purpose: to load TMG FDA DOSAGE FORM <--> doseform.TXT +"RTN","TMGNDF0A",246,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",247,0) + ;"Output: Kills any prior entries in TMG FDA DOSAGE FORM +"RTN","TMGNDF0A",248,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",249,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",250,0) + +"RTN","TMGNDF0A",251,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",252,0) + ;"===================================== +"RTN","TMGNDF0A",253,0) + ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO. +"RTN","TMGNDF0A",254,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",255,0) + ;" Linking field to LISTINGS. +"RTN","TMGNDF0A",256,0) + ;"DOSEFORM NULL CHAR(3) COL:9-11 +"RTN","TMGNDF0A",257,0) + ;" The code for the route of administration. File will allow all assigned values for this element. +"RTN","TMGNDF0A",258,0) + ;"DOSAGE_NAME NULL CHAR(240) COL:13-252 +"RTN","TMGNDF0A",259,0) + ;" The translation for the route of administration code. +"RTN","TMGNDF0A",260,0) + ;"===================================== +"RTN","TMGNDF0A",261,0) + ;"Log: +"RTN","TMGNDF0A",262,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",263,0) + +"RTN","TMGNDF0A",264,0) + new Info +"RTN","TMGNDF0A",265,0) + new result +"RTN","TMGNDF0A",266,0) + +"RTN","TMGNDF0A",267,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",268,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",269,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",270,0) + new temp set temp=$get(^TMG(22706.2,0)) +"RTN","TMGNDF0A",271,0) + kill ^TMG(22706.2) +"RTN","TMGNDF0A",272,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",273,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",274,0) + set ^TMG(22706.2,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",275,0) + +"RTN","TMGNDF0A",276,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",277,0) + set Info("HFS FILE")="doseform.TXT" +"RTN","TMGNDF0A",278,0) + set Info("DEST FILE")="TMG FDA DOSAGE FORM" +"RTN","TMGNDF0A",279,0) + +"RTN","TMGNDF0A",280,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",281,0) + set result=$$Dos2Unix^TMGKERNL(tempFile) +"RTN","TMGNDF0A",282,0) + if result>0 set result=0 goto LDsDone +"RTN","TMGNDF0A",283,0) + +"RTN","TMGNDF0A",284,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",285,0) + ;"Linking field to LISTINGS. +"RTN","TMGNDF0A",286,0) + set Info(.01)=.01 ;"Listing, pointer to 22706.5 +"RTN","TMGNDF0A",287,0) + set Info(.01,"START")=1 ;"was 1 +"RTN","TMGNDF0A",288,0) + set Info(.01,"END")=7 ;"was 8 +"RTN","TMGNDF0A",289,0) + +"RTN","TMGNDF0A",290,0) + ;"DOSEFORM NULL CHAR(3) COL:9-11 +"RTN","TMGNDF0A",291,0) + ;"The code for the route of administration. File will allow all assigned values for this element. +"RTN","TMGNDF0A",292,0) + set Info(1)=1 ;"Dosage form +"RTN","TMGNDF0A",293,0) + set Info(1,"START")=9 ;"was 9 +"RTN","TMGNDF0A",294,0) + set Info(1,"END")=11 ;"was 12 +"RTN","TMGNDF0A",295,0) + +"RTN","TMGNDF0A",296,0) + ;"DOSAGE_NAME NULL CHAR(240) COL:13-252 +"RTN","TMGNDF0A",297,0) + ;"The translation for the route of administration code. +"RTN","TMGNDF0A",298,0) + set Info(2)=2 ;"Dosage Name +"RTN","TMGNDF0A",299,0) + set Info(2,"START")=13 ;"was 13 +"RTN","TMGNDF0A",300,0) + set Info(2,"END")=252 ;"was 128 +"RTN","TMGNDF0A",301,0) + +"RTN","TMGNDF0A",302,0) +LDL2 +"RTN","TMGNDF0A",303,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",304,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",305,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",306,0) + +"RTN","TMGNDF0A",307,0) +LDsDone +"RTN","TMGNDF0A",308,0) + quit result +"RTN","TMGNDF0A",309,0) + +"RTN","TMGNDF0A",310,0) + +"RTN","TMGNDF0A",311,0) +LoadFirms(LoadDir) +"RTN","TMGNDF0A",312,0) + ;"Purpose: to load TMG FDA FIRMS <--> FIRMS.TXT ;was firms.txt +"RTN","TMGNDF0A",313,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",314,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",315,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",316,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",317,0) + +"RTN","TMGNDF0A",318,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",319,0) + ;"===================================== +"RTN","TMGNDF0A",320,0) + ;"EACH FIRM HAS A UNIQUE FIRM SEQ NO WHICH CAN OCCUR MULTIPLE TIMES IN THE LISTINGS FILE. +"RTN","TMGNDF0A",321,0) + ;"Contains the firm's full name, and compliance address. The compliance address is the mailing address where the FDA sends listing information to the firm. +"RTN","TMGNDF0A",322,0) + ;"LBLCODE NOT NULL NUM(6) COL:1-6 +"RTN","TMGNDF0A",323,0) + ;" FDA generated identification number for each firm. The number is padded to the left with zeroes to fill out to length 6. +"RTN","TMGNDF0A",324,0) + ;"FIRM_NAME NOT NULL CHAR(65) COL:8-72 +"RTN","TMGNDF0A",325,0) + ;" Firm name as reported by the firm. +"RTN","TMGNDF0A",326,0) + ;"ADDR_HEADER NULL CHAR(40) COL:74-113 +"RTN","TMGNDF0A",327,0) + ;" Address Heading as reported by the firm. +"RTN","TMGNDF0A",328,0) + ;"STREET NULL CHAR(40) COL:115-154 +"RTN","TMGNDF0A",329,0) + ;" Street Address as reported by firm. +"RTN","TMGNDF0A",330,0) + ;"PO_BOX NULL CHAR(9) COL:156-164 +"RTN","TMGNDF0A",331,0) + ;" Post office box number as reported by firm. +"RTN","TMGNDF0A",332,0) + ;"FOREIGN_ADDR NULL CHAR(40) COL:166-205 +"RTN","TMGNDF0A",333,0) + ;" Address information report by firm for foreign countries that does not fit the U.S. Postal service configuration. +"RTN","TMGNDF0A",334,0) + ;"CITY NULL CHAR(30) COL:207-236 +"RTN","TMGNDF0A",335,0) + ;"STATE NULL CHAR(2) COL:238-239 +"RTN","TMGNDF0A",336,0) + ;"ZIP NULL CHAR(9) COL:241-249 +"RTN","TMGNDF0A",337,0) + ;"USPS Zip code. +"RTN","TMGNDF0A",338,0) + ;"PROVINCE NULL CHAR(30) COL:251-280 +"RTN","TMGNDF0A",339,0) + ;" Province of Foreign country if appropriate. +"RTN","TMGNDF0A",340,0) + ;"COUNTRY_NAME NOT NULL CHAR(40) COL:282-321 +"RTN","TMGNDF0A",341,0) + ;"===================================== +"RTN","TMGNDF0A",342,0) + ;"Log: +"RTN","TMGNDF0A",343,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",344,0) + +"RTN","TMGNDF0A",345,0) + new Info +"RTN","TMGNDF0A",346,0) + new result +"RTN","TMGNDF0A",347,0) + +"RTN","TMGNDF0A",348,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",349,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",350,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",351,0) + new temp set temp=$get(^TMG(22706.3,0)) +"RTN","TMGNDF0A",352,0) + kill ^TMG(22706.3) +"RTN","TMGNDF0A",353,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",354,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",355,0) + set ^TMG(22706.3,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",356,0) + +"RTN","TMGNDF0A",357,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",358,0) + set Info("HFS FILE")="FIRMS.TXT" ;"was firms.txt +"RTN","TMGNDF0A",359,0) + set Info("DEST FILE")="TMG FDA FIRMS" +"RTN","TMGNDF0A",360,0) + +"RTN","TMGNDF0A",361,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",362,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",363,0) + if result>0 set result=0 goto LFrDone +"RTN","TMGNDF0A",364,0) + +"RTN","TMGNDF0A",365,0) + ;"LBLCODE NOT NULL NUM(6) COL:1-6 +"RTN","TMGNDF0A",366,0) + ;"FDA generated identification number for each firm. +"RTN","TMGNDF0A",367,0) + ;"The number is padded to the left with zeroes to fill out to length 6. +"RTN","TMGNDF0A",368,0) + set Info(1)=1 ;"Label Code +"RTN","TMGNDF0A",369,0) + set Info(1,"START")=1 +"RTN","TMGNDF0A",370,0) + set Info(1,"END")=6 +"RTN","TMGNDF0A",371,0) + +"RTN","TMGNDF0A",372,0) + ;"FIRM_NAME NOT NULL CHAR(65) COL:8-72 +"RTN","TMGNDF0A",373,0) + ;"Firm name as reported by the firm. +"RTN","TMGNDF0A",374,0) + set Info(.01)=.01 ;"Name +"RTN","TMGNDF0A",375,0) + set Info(.01,"START")=8 +"RTN","TMGNDF0A",376,0) + set Info(.01,"END")=72 +"RTN","TMGNDF0A",377,0) + +"RTN","TMGNDF0A",378,0) + ;"ADDR_HEADER NULL CHAR(40) COL:74-113 +"RTN","TMGNDF0A",379,0) + ;"Address Heading as reported by the firm. +"RTN","TMGNDF0A",380,0) + set Info(2)=2 ;"Address Header +"RTN","TMGNDF0A",381,0) + set Info(2,"START")=74 +"RTN","TMGNDF0A",382,0) + set Info(2,"END")=113 +"RTN","TMGNDF0A",383,0) + +"RTN","TMGNDF0A",384,0) + ;"STREET NULL CHAR(40) COL:115-154 +"RTN","TMGNDF0A",385,0) + ;"Street Address as reported by firm. +"RTN","TMGNDF0A",386,0) + set Info(3)=3 ;"Street +"RTN","TMGNDF0A",387,0) + set Info(3,"START")=115 +"RTN","TMGNDF0A",388,0) + set Info(3,"END")=154 +"RTN","TMGNDF0A",389,0) + +"RTN","TMGNDF0A",390,0) + ;"PO_BOX NULL CHAR(9) COL:156-164 +"RTN","TMGNDF0A",391,0) + ;"Post office box number as reported by firm. +"RTN","TMGNDF0A",392,0) + set Info(4)=4 ;"PO Box +"RTN","TMGNDF0A",393,0) + set Info(4,"START")=156 +"RTN","TMGNDF0A",394,0) + set Info(4,"END")=164 +"RTN","TMGNDF0A",395,0) + +"RTN","TMGNDF0A",396,0) + ;"FOREIGN_ADDR NULL CHAR(40) COL:166-205 +"RTN","TMGNDF0A",397,0) + ;"Address information report by firm for foreign +"RTN","TMGNDF0A",398,0) + ;"countries that does not fit the U.S. Postal service configuration. +"RTN","TMGNDF0A",399,0) + set Info(5)=5 ;"Foreign Address +"RTN","TMGNDF0A",400,0) + set Info(5,"START")=166 +"RTN","TMGNDF0A",401,0) + set Info(5,"END")=205 +"RTN","TMGNDF0A",402,0) + +"RTN","TMGNDF0A",403,0) + ;"CITY NULL CHAR(30) COL:207-236 +"RTN","TMGNDF0A",404,0) + set Info(6)=6 ;"City +"RTN","TMGNDF0A",405,0) + set Info(6,"START")=207 +"RTN","TMGNDF0A",406,0) + set Info(6,"END")=236 +"RTN","TMGNDF0A",407,0) + +"RTN","TMGNDF0A",408,0) + ;"STATE NULL CHAR(2) COL:238-239 +"RTN","TMGNDF0A",409,0) + set Info(7)=7 ;"State +"RTN","TMGNDF0A",410,0) + set Info(7,"START")=238 +"RTN","TMGNDF0A",411,0) + set Info(7,"END")=239 +"RTN","TMGNDF0A",412,0) + +"RTN","TMGNDF0A",413,0) + ;"ZIP NULL CHAR(9) COL:241-249 +"RTN","TMGNDF0A",414,0) + ;"USPS Zip code. +"RTN","TMGNDF0A",415,0) + set Info(8)=8 ;"ZIP +"RTN","TMGNDF0A",416,0) + set Info(8,"START")=241 +"RTN","TMGNDF0A",417,0) + set Info(8,"END")=249 +"RTN","TMGNDF0A",418,0) + +"RTN","TMGNDF0A",419,0) + ;"PROVINCE NULL CHAR(30) COL:251-280 +"RTN","TMGNDF0A",420,0) + ;"Province of Foreign country if appropriate. +"RTN","TMGNDF0A",421,0) + set Info(9)=9 ;"Province +"RTN","TMGNDF0A",422,0) + set Info(9,"START")=251 +"RTN","TMGNDF0A",423,0) + set Info(9,"END")=280 +"RTN","TMGNDF0A",424,0) + +"RTN","TMGNDF0A",425,0) + ;"COUNTRY_NAME NOT NULL CHAR(40) COL:282-321 +"RTN","TMGNDF0A",426,0) + set Info(10)=10 ;"Country +"RTN","TMGNDF0A",427,0) + set Info(10,"START")=282 +"RTN","TMGNDF0A",428,0) + set Info(10,"END")=321 +"RTN","TMGNDF0A",429,0) + +"RTN","TMGNDF0A",430,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",431,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",432,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",433,0) + +"RTN","TMGNDF0A",434,0) +LFrDone +"RTN","TMGNDF0A",435,0) + quit result +"RTN","TMGNDF0A",436,0) + +"RTN","TMGNDF0A",437,0) + +"RTN","TMGNDF0A",438,0) +LoadFormulation(LoadDir) +"RTN","TMGNDF0A",439,0) + ;"Purpose: to load TMG FDA FORMULATION <--> FORMULAT.TXT +"RTN","TMGNDF0A",440,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",441,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",442,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",443,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",444,0) + +"RTN","TMGNDF0A",445,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",446,0) + ;"===================================== +"RTN","TMGNDF0A",447,0) + ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO. +"RTN","TMGNDF0A",448,0) + ;"Lists active ingredients contained in product's formulation. +"RTN","TMGNDF0A",449,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",450,0) + ;" Linking field to LISTINGS. +"RTN","TMGNDF0A",451,0) + ;"STRENGTH NULL CHAR(10) COL: 9-18 +"RTN","TMGNDF0A",452,0) + ;" This is the potency of the active ingredient. +"RTN","TMGNDF0A",453,0) + ;"UNIT NULL CHAR(5) COL: 20-24 +"RTN","TMGNDF0A",454,0) + ;" Unit of measure corresponding to strength. +"RTN","TMGNDF0A",455,0) + ;"INGREDIENT_NAME NOT NULL CHAR(100) COL: 26-125 +"RTN","TMGNDF0A",456,0) + ;" Truncated preferred term for the active ingredient. +"RTN","TMGNDF0A",457,0) + ;"===================================== +"RTN","TMGNDF0A",458,0) + ;"Log: +"RTN","TMGNDF0A",459,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",460,0) + +"RTN","TMGNDF0A",461,0) + new Info +"RTN","TMGNDF0A",462,0) + new result +"RTN","TMGNDF0A",463,0) + +"RTN","TMGNDF0A",464,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",465,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",466,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",467,0) + new temp set temp=$get(^TMG(22706.4,0)) +"RTN","TMGNDF0A",468,0) + kill ^TMG(22706.4) +"RTN","TMGNDF0A",469,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",470,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",471,0) + set ^TMG(22706.4,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",472,0) + +"RTN","TMGNDF0A",473,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",474,0) + set Info("HFS FILE")="FORMULAT.TXT" +"RTN","TMGNDF0A",475,0) + set Info("DEST FILE")="TMG FDA FORMULATION" +"RTN","TMGNDF0A",476,0) + +"RTN","TMGNDF0A",477,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",478,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",479,0) + if result>0 set result=0 goto LFmDone +"RTN","TMGNDF0A",480,0) + +"RTN","TMGNDF0A",481,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",482,0) + ;"Linking field to LISTINGS. +"RTN","TMGNDF0A",483,0) + set Info(.01)=.01 ;"Listing +"RTN","TMGNDF0A",484,0) + set Info(.01,"START")=1 +"RTN","TMGNDF0A",485,0) + set Info(.01,"END")=7 +"RTN","TMGNDF0A",486,0) + +"RTN","TMGNDF0A",487,0) + ;"STRENGTH NULL CHAR(10) COL: 9-18 +"RTN","TMGNDF0A",488,0) + ;"This is the potency of the active ingredient. +"RTN","TMGNDF0A",489,0) + set Info(1)=1 ;"Strength +"RTN","TMGNDF0A",490,0) + set Info(1,"START")=9 +"RTN","TMGNDF0A",491,0) + set Info(1,"END")=18 +"RTN","TMGNDF0A",492,0) + +"RTN","TMGNDF0A",493,0) + ;"UNIT NULL CHAR(5) COL: 20-24 +"RTN","TMGNDF0A",494,0) + ;"Unit of measure corresponding to strength. +"RTN","TMGNDF0A",495,0) + set Info(2)=2 ;"Unit +"RTN","TMGNDF0A",496,0) + set Info(2,"START")=20 +"RTN","TMGNDF0A",497,0) + set Info(2,"END")=24 +"RTN","TMGNDF0A",498,0) + +"RTN","TMGNDF0A",499,0) + ;"INGREDIENT_NAME NOT NULL CHAR(100) COL: 26-125 +"RTN","TMGNDF0A",500,0) + ;"Truncated preferred term for the active ingredient. +"RTN","TMGNDF0A",501,0) + set Info(3)=3 ;"Ingredient Name +"RTN","TMGNDF0A",502,0) + set Info(3,"START")=26 +"RTN","TMGNDF0A",503,0) + set Info(3,"END")=125 +"RTN","TMGNDF0A",504,0) + +"RTN","TMGNDF0A",505,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",506,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",507,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",508,0) + +"RTN","TMGNDF0A",509,0) +LFmDone +"RTN","TMGNDF0A",510,0) + quit result +"RTN","TMGNDF0A",511,0) + +"RTN","TMGNDF0A",512,0) + +"RTN","TMGNDF0A",513,0) +LoadPackages(LoadDir) +"RTN","TMGNDF0A",514,0) + ;"Purpose: to load TMG FDA PACKAGES <--> packages.txt +"RTN","TMGNDF0A",515,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",516,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",517,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",518,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",519,0) + +"RTN","TMGNDF0A",520,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",521,0) + ;"===================================== +"RTN","TMGNDF0A",522,0) + ;"MAY OCCUR MULTIPLE TIMES PER LISTING SEQ NO +"RTN","TMGNDF0A",523,0) + ;"Stores packages for an individual listing. The packages table includes all packages for a corresponding listing. The PKGCODE field contains the last one or two digit segment of the NDC. +"RTN","TMGNDF0A",524,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",525,0) + ;" Linking field to LISTINGS. +"RTN","TMGNDF0A",526,0) + ;"PKGCODE NULL CHAR(2) COL: 9-10 +"RTN","TMGNDF0A",527,0) + ;" The package code portion of NDC code. The package code is the last segment of the NDC. +"RTN","TMGNDF0A",528,0) + ;"PACKSIZE NOT NULL CHAR(25) COL: 12-36 +"RTN","TMGNDF0A",529,0) + ;" The unit or number of units which make up a package. +"RTN","TMGNDF0A",530,0) + ;"PACKTYPE NOT NULL CHAR(25) COL: 38-62 +"RTN","TMGNDF0A",531,0) + ;" Package type, i.e., box, bottle, vial, plastic, or glass. +"RTN","TMGNDF0A",532,0) + ;"===================================== +"RTN","TMGNDF0A",533,0) + ;"Log: +"RTN","TMGNDF0A",534,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",535,0) + +"RTN","TMGNDF0A",536,0) + new Info +"RTN","TMGNDF0A",537,0) + new result +"RTN","TMGNDF0A",538,0) + +"RTN","TMGNDF0A",539,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",540,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",541,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",542,0) + new temp set temp=$get(^TMG(22706.6,0)) +"RTN","TMGNDF0A",543,0) + kill ^TMG(22706.6) +"RTN","TMGNDF0A",544,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",545,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",546,0) + set ^TMG(22706.6,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",547,0) + +"RTN","TMGNDF0A",548,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",549,0) + set Info("HFS FILE")="packages.txt" +"RTN","TMGNDF0A",550,0) + set Info("DEST FILE")="TMG FDA PACKAGES" +"RTN","TMGNDF0A",551,0) + +"RTN","TMGNDF0A",552,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",553,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",554,0) + if result>0 set result=0 goto LPkDone +"RTN","TMGNDF0A",555,0) + +"RTN","TMGNDF0A",556,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",557,0) + ;"Linking field to LISTINGS. +"RTN","TMGNDF0A",558,0) + set Info(.01)=.01 ;"Listing +"RTN","TMGNDF0A",559,0) + set Info(.01,"START")=1 +"RTN","TMGNDF0A",560,0) + set Info(.01,"END")=7 +"RTN","TMGNDF0A",561,0) + +"RTN","TMGNDF0A",562,0) + ;"PKGCODE NULL CHAR(2) COL: 9-10 +"RTN","TMGNDF0A",563,0) + ;"The package code portion of NDC code. The package +"RTN","TMGNDF0A",564,0) + ;"code is the last segment of the NDC. +"RTN","TMGNDF0A",565,0) + set Info(1)=1 ;"Code +"RTN","TMGNDF0A",566,0) + set Info(1,"START")=9 +"RTN","TMGNDF0A",567,0) + set Info(1,"END")=10 +"RTN","TMGNDF0A",568,0) + +"RTN","TMGNDF0A",569,0) + ;"PACKSIZE NOT NULL CHAR(25) COL: 12-36 +"RTN","TMGNDF0A",570,0) + ;"The unit or number of units which make up a package. +"RTN","TMGNDF0A",571,0) + set Info(2)=2 ;"Size +"RTN","TMGNDF0A",572,0) + set Info(2,"START")=12 +"RTN","TMGNDF0A",573,0) + set Info(2,"END")=36 +"RTN","TMGNDF0A",574,0) + +"RTN","TMGNDF0A",575,0) + ;"PACKTYPE NOT NULL CHAR(25) COL: 38-62 +"RTN","TMGNDF0A",576,0) + ;"Package type, i.e., box, bottle, vial, plastic, or glass. +"RTN","TMGNDF0A",577,0) + set Info(3)=3 ;"Type +"RTN","TMGNDF0A",578,0) + set Info(3,"START")=38 +"RTN","TMGNDF0A",579,0) + set Info(3,"END")=62 +"RTN","TMGNDF0A",580,0) + +"RTN","TMGNDF0A",581,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",582,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",583,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",584,0) + +"RTN","TMGNDF0A",585,0) +LPkDone +"RTN","TMGNDF0A",586,0) + quit result +"RTN","TMGNDF0A",587,0) + +"RTN","TMGNDF0A",588,0) + +"RTN","TMGNDF0A",589,0) +LoadRoutes(LoadDir) +"RTN","TMGNDF0A",590,0) + ;"Purpose: to load TMG FDA ROUTES <--> ROUTES.TXT ;was routes.txt +"RTN","TMGNDF0A",591,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",592,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",593,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",594,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",595,0) + +"RTN","TMGNDF0A",596,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",597,0) + ;"===================================== +"RTN","TMGNDF0A",598,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",599,0) + ;" Linking field to LISTINGS. +"RTN","TMGNDF0A",600,0) + ;"ROUTE_CODE NULL CHAR(3) COL:9-11 +"RTN","TMGNDF0A",601,0) + ;" The code for the route of administration. File will allow all assigned values for this element. +"RTN","TMGNDF0A",602,0) + ;"ROUTE_NAME NULL CHAR(240) COL:13-252 +"RTN","TMGNDF0A",603,0) + ;" The translation for the route of administration code. +"RTN","TMGNDF0A",604,0) + ;"===================================== +"RTN","TMGNDF0A",605,0) + ;"Log: +"RTN","TMGNDF0A",606,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",607,0) + +"RTN","TMGNDF0A",608,0) + new Info +"RTN","TMGNDF0A",609,0) + new result +"RTN","TMGNDF0A",610,0) + +"RTN","TMGNDF0A",611,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",612,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",613,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",614,0) + new temp set temp=$get(^TMG(22706.7,0)) +"RTN","TMGNDF0A",615,0) + kill ^TMG(22706.7) +"RTN","TMGNDF0A",616,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",617,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",618,0) + set ^TMG(22706.7,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",619,0) + +"RTN","TMGNDF0A",620,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",621,0) + set Info("HFS FILE")="ROUTES.TXT" ;"was routes.txt +"RTN","TMGNDF0A",622,0) + set Info("DEST FILE")="TMG FDA ROUTES" +"RTN","TMGNDF0A",623,0) + +"RTN","TMGNDF0A",624,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",625,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",626,0) + if result>0 set result=0 goto LRtDone +"RTN","TMGNDF0A",627,0) + +"RTN","TMGNDF0A",628,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL:1-7 +"RTN","TMGNDF0A",629,0) + ;"Linking field to LISTINGS. +"RTN","TMGNDF0A",630,0) + set Info(.01)=.01 ;"Listing +"RTN","TMGNDF0A",631,0) + set Info(.01,"START")=1 +"RTN","TMGNDF0A",632,0) + set Info(.01,"END")=7 +"RTN","TMGNDF0A",633,0) + +"RTN","TMGNDF0A",634,0) + ;"ROUTE_CODE NULL CHAR(3) COL:9-11 +"RTN","TMGNDF0A",635,0) + ;"The code for the route of administration. +"RTN","TMGNDF0A",636,0) + ;"File will allow all assigned values for this element. +"RTN","TMGNDF0A",637,0) + set Info(1)=1 ;"Code +"RTN","TMGNDF0A",638,0) + set Info(1,"START")=9 +"RTN","TMGNDF0A",639,0) + set Info(1,"END")=11 +"RTN","TMGNDF0A",640,0) + +"RTN","TMGNDF0A",641,0) + ;"ROUTE_NAME NULL CHAR(240) COL:13-252 +"RTN","TMGNDF0A",642,0) + ;"The translation for the route of administration code. +"RTN","TMGNDF0A",643,0) + set Info(2)=2 ;"Name +"RTN","TMGNDF0A",644,0) + set Info(2,"START")=13 +"RTN","TMGNDF0A",645,0) + set Info(2,"END")=252 +"RTN","TMGNDF0A",646,0) + +"RTN","TMGNDF0A",647,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",648,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",649,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",650,0) + +"RTN","TMGNDF0A",651,0) +LRtDone +"RTN","TMGNDF0A",652,0) + quit result +"RTN","TMGNDF0A",653,0) + +"RTN","TMGNDF0A",654,0) + +"RTN","TMGNDF0A",655,0) +LoadUnitAbbr(LoadDir) +"RTN","TMGNDF0A",656,0) + ;"Purpose: to load FDA UNIT ABBREVIATIONS <--> TBLUNIT.TXT ; was tblunit.txt +"RTN","TMGNDF0A",657,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",658,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",659,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",660,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",661,0) + +"RTN","TMGNDF0A",662,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",663,0) + ;"===================================== +"RTN","TMGNDF0A",664,0) + ;"THIS FILE CONTAINS A COMPLETE LIST OF THE POTENCY UNIT ABBREVIATIONS USED IN THE DIRECTORY. +"RTN","TMGNDF0A",665,0) + ;"UNIT CHAR(15) COL:1-15 +"RTN","TMGNDF0A",666,0) + ;" The potency unit abbreviations used in the directory. +"RTN","TMGNDF0A",667,0) + ;"TRANSLATION CHAR(100) COL:17-115 +"RTN","TMGNDF0A",668,0) + ;" The translation for the UNIT abbreviations. +"RTN","TMGNDF0A",669,0) + ;"===================================== +"RTN","TMGNDF0A",670,0) + ;"Log: +"RTN","TMGNDF0A",671,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",672,0) + +"RTN","TMGNDF0A",673,0) + new Info +"RTN","TMGNDF0A",674,0) + new result +"RTN","TMGNDF0A",675,0) + +"RTN","TMGNDF0A",676,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",677,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",678,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",679,0) + new temp set temp=$get(^TMG(22706.8,0)) +"RTN","TMGNDF0A",680,0) + kill ^TMG(22706.8) +"RTN","TMGNDF0A",681,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",682,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",683,0) + set ^TMG(22706.8,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",684,0) + +"RTN","TMGNDF0A",685,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",686,0) + set Info("HFS FILE")="TBLUNIT.TXT" ;"was tblunit.txt +"RTN","TMGNDF0A",687,0) + set Info("DEST FILE")="FDA UNIT ABBREVIATIONS" +"RTN","TMGNDF0A",688,0) + +"RTN","TMGNDF0A",689,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",690,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",691,0) + if result>0 set result=0 goto LUADone +"RTN","TMGNDF0A",692,0) + +"RTN","TMGNDF0A",693,0) + ;"UNIT CHAR(15) COL:1-15 +"RTN","TMGNDF0A",694,0) + ;"The potency unit abbreviations used in the directory. +"RTN","TMGNDF0A",695,0) + set Info(.01)=.01 ;"Abbreviation +"RTN","TMGNDF0A",696,0) + set Info(.01,"START")=1 +"RTN","TMGNDF0A",697,0) + set Info(.01,"END")=15 +"RTN","TMGNDF0A",698,0) + +"RTN","TMGNDF0A",699,0) + ;"TRANSLATION CHAR(100) COL:17-115 +"RTN","TMGNDF0A",700,0) + ;"The translation for the UNIT abbreviations. +"RTN","TMGNDF0A",701,0) + set Info(1)=1 ;"Description +"RTN","TMGNDF0A",702,0) + set Info(1,"START")=17 +"RTN","TMGNDF0A",703,0) + set Info(1,"END")=115 ;"was 250 before +"RTN","TMGNDF0A",704,0) + +"RTN","TMGNDF0A",705,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",706,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",707,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",708,0) + +"RTN","TMGNDF0A",709,0) +LUADone +"RTN","TMGNDF0A",710,0) + quit result +"RTN","TMGNDF0A",711,0) + +"RTN","TMGNDF0A",712,0) + +"RTN","TMGNDF0A",713,0) +LoadListing(LoadDir) +"RTN","TMGNDF0A",714,0) + ;"Purpose: to load TMG FDA LISTING <--> listings.TXT ;was listings.txt +"RTN","TMGNDF0A",715,0) + ;"Input: LoadDir -- the directory in HFS to get files from +"RTN","TMGNDF0A",716,0) + ;"Output: Kills any prior entries in TMG FDA FIRMS +"RTN","TMGNDF0A",717,0) + ;"NOTICE: any pointers to this fill might me made invalid via kills +"RTN","TMGNDF0A",718,0) + ;"Result: 1=success, 0=error +"RTN","TMGNDF0A",719,0) + +"RTN","TMGNDF0A",720,0) + ;"FDA documentation for 9/12/2007 file: +"RTN","TMGNDF0A",721,0) + ;"===================================== +"RTN","TMGNDF0A",722,0) + ;"EACH PRODUCT HAS A UNIQUE LISTING SEQ NO; +"RTN","TMGNDF0A",723,0) + ;" EACH FIRM SEQ NO CAN HAVE MULTIPLE LISTING SEQ NO'S. +"RTN","TMGNDF0A",724,0) + ;" Each line in this file represents a product for an individual firm. +"RTN","TMGNDF0A",725,0) + ;" The listing includes such information as the product's name, firm's +"RTN","TMGNDF0A",726,0) + ;" seq number, dose form(s), and Rx/OTC. +"RTN","TMGNDF0A",727,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",728,0) + ;" FDA generated unique identification number for each product. +"RTN","TMGNDF0A",729,0) + ;"LBLCODE NOT NULL CHAR(6) COL: 9-14 +"RTN","TMGNDF0A",730,0) + ;" Labeler code portion of NDC; assigned by FDA to firm. +"RTN","TMGNDF0A",731,0) + ;" The labeler code is the first segment of the National Drug Code. +"RTN","TMGNDF0A",732,0) + ;" While always displayed as 6 digits in this file; for labeler codes 2 through 9999, +"RTN","TMGNDF0A",733,0) + ;" some systems display it as 4 digits; for labeler codes 10,000 through 99,999 it is 5 digits. +"RTN","TMGNDF0A",734,0) + ;" Can be used to link to the FIRMS.TXT file to obtain firm name. +"RTN","TMGNDF0A",735,0) + ;"PRODCODE NOT NULL CHAR(4) COL: 16-19 +"RTN","TMGNDF0A",736,0) + ;" Product code assigned by firm. The prodcode is the second segment of the National +"RTN","TMGNDF0A",737,0) + ;" Drug Code. It may be a 3-digit or 4-digit code depending upon the NDC configuration +"RTN","TMGNDF0A",738,0) + ;" selected by the firm. +"RTN","TMGNDF0A",739,0) + ;"STRENGTH NULL CHAR(10) COL: 21-30 +"RTN","TMGNDF0A",740,0) + ;" For single entity products, this is the potency of the active ingredient. For combination +"RTN","TMGNDF0A",741,0) + ;" products, it may be null or a number or combination of numbers, e.g., Inderide 40/25. +"RTN","TMGNDF0A",742,0) + ;"UNIT NULL CHAR(10) COL: 32-41 +"RTN","TMGNDF0A",743,0) + ;" Unit of measure corresponding to strength. This non-mandatory field contains the unit +"RTN","TMGNDF0A",744,0) + ;" code for a single entity product, e.g., MG, %VV. +"RTN","TMGNDF0A",745,0) + ;"RX_OTC NOT NULL CHAR(1) COL: 43 +"RTN","TMGNDF0A",746,0) + ;" Indicates whether product is labeled for Rx or OTC use (R/O). +"RTN","TMGNDF0A",747,0) + ;"TRADENAME NOT NULL CHAR(100) COL: 45-144 +"RTN","TMGNDF0A",748,0) + ;" Product's name as it appears on the labeling. +"RTN","TMGNDF0A",749,0) + ;"===================================== +"RTN","TMGNDF0A",750,0) + ;"Log: +"RTN","TMGNDF0A",751,0) + ;" 10/20/07 -- no modification needed for 9/12/07 database +"RTN","TMGNDF0A",752,0) + +"RTN","TMGNDF0A",753,0) + new Info +"RTN","TMGNDF0A",754,0) + new result +"RTN","TMGNDF0A",755,0) + +"RTN","TMGNDF0A",756,0) + ;"Note: should Kill all prior records... +"RTN","TMGNDF0A",757,0) + ;"Note: This will blow away ALL records, cross references etc. +"RTN","TMGNDF0A",758,0) + ;" This is not considered good programming practice! +"RTN","TMGNDF0A",759,0) + new temp set temp=$get(^TMG(22706.5,0)) +"RTN","TMGNDF0A",760,0) + kill ^TMG(22706.5) +"RTN","TMGNDF0A",761,0) + set $piece(temp,"^",3)="" +"RTN","TMGNDF0A",762,0) + set $piece(temp,"^",4)=0 +"RTN","TMGNDF0A",763,0) + set ^TMG(22706.5,0)=temp ;"fix up the 0 node +"RTN","TMGNDF0A",764,0) + +"RTN","TMGNDF0A",765,0) + set Info("HFS DIR")=$get(LoadDir) +"RTN","TMGNDF0A",766,0) + set Info("HFS FILE")="listings.TXT" ;"was listings.txt +"RTN","TMGNDF0A",767,0) + set Info("DEST FILE")="TMG FDA LISTING" +"RTN","TMGNDF0A",768,0) + +"RTN","TMGNDF0A",769,0) + new tempFile set tempFile=Info("HFS DIR")_Info("HFS FILE") +"RTN","TMGNDF0A",770,0) + set result=$$Dos2Unix^TMGIOUTL(tempFile) +"RTN","TMGNDF0A",771,0) + if result>0 set result=0 goto LLsDone +"RTN","TMGNDF0A",772,0) + +"RTN","TMGNDF0A",773,0) + ;"LISTING_SEQ_NO NOT NULL NUM(7) COL: 1-7 +"RTN","TMGNDF0A",774,0) + ;"FDA generated unique identification number for each product. +"RTN","TMGNDF0A",775,0) + set Info(.001)="IEN" ;"Sequence number +"RTN","TMGNDF0A",776,0) + set Info(.001,"START")=1 +"RTN","TMGNDF0A",777,0) + set Info(.001,"END")=7 +"RTN","TMGNDF0A",778,0) + +"RTN","TMGNDF0A",779,0) + set Info(.01)=.01 ;"Sequence number +"RTN","TMGNDF0A",780,0) + set Info(.01,"START")=1 +"RTN","TMGNDF0A",781,0) + set Info(.01,"END")=7 +"RTN","TMGNDF0A",782,0) + +"RTN","TMGNDF0A",783,0) + ;"LBLCODE NOT NULL CHAR(6) COL: 9-14 +"RTN","TMGNDF0A",784,0) + ;"Labeler code portion of NDC; assigned by FDA to firm. +"RTN","TMGNDF0A",785,0) + ;"The labeler code is the first segment of the National +"RTN","TMGNDF0A",786,0) + ;"Drug Code. While always displayed as 6 digits in this file; +"RTN","TMGNDF0A",787,0) + ;"for labeler codes 2 through 9999, some systems display it as +"RTN","TMGNDF0A",788,0) + ;"4 digits; for labeler codes 10,000 through 99,999 it is 5 digits. +"RTN","TMGNDF0A",789,0) + ;"Can be used to link to the FIRMS.TXT file to obtain firm name. +"RTN","TMGNDF0A",790,0) + set Info(1)=1 ;"Label Code +"RTN","TMGNDF0A",791,0) + set Info(1,"START")=9 +"RTN","TMGNDF0A",792,0) + set Info(1,"END")=14 +"RTN","TMGNDF0A",793,0) + +"RTN","TMGNDF0A",794,0) + ;"PRODCODE NOT NULL CHAR(4) COL: 16-19 +"RTN","TMGNDF0A",795,0) + ;"Product code assigned by firm. The prodcode is the second segment +"RTN","TMGNDF0A",796,0) + ;"of the National Drug Code (NDC). It may be a 3-digit or 4-digit +"RTN","TMGNDF0A",797,0) + ;"code depending upon the NDC configuration selected by the firm. +"RTN","TMGNDF0A",798,0) + set Info(2)=2 ;"Product Code +"RTN","TMGNDF0A",799,0) + set Info(2,"START")=16 +"RTN","TMGNDF0A",800,0) + set Info(2,"END")=19 +"RTN","TMGNDF0A",801,0) + +"RTN","TMGNDF0A",802,0) + ;"STRENGTH NULL CHAR(10) COL: 21-30 +"RTN","TMGNDF0A",803,0) + ;"For single entity products, this is the potency of the active ingredient. +"RTN","TMGNDF0A",804,0) + ;"For combination products, it may be null or a number or combination of +"RTN","TMGNDF0A",805,0) + ;"numbers, e.g., Inderide 40/25. +"RTN","TMGNDF0A",806,0) + set Info(3)=3 ;"Strength +"RTN","TMGNDF0A",807,0) + set Info(3,"START")=21 +"RTN","TMGNDF0A",808,0) + set Info(3,"END")=30 +"RTN","TMGNDF0A",809,0) + +"RTN","TMGNDF0A",810,0) + ;"UNIT NULL CHAR(10) COL: 32-41 +"RTN","TMGNDF0A",811,0) + ;"Unit of measure corresponding to strength. This non-mandatory field +"RTN","TMGNDF0A",812,0) + ;"contains the unit code for a single entity product, e.g., MG, %VV. +"RTN","TMGNDF0A",813,0) + set Info(4)=4 ;"Unit +"RTN","TMGNDF0A",814,0) + set Info(4,"START")=32 +"RTN","TMGNDF0A",815,0) + set Info(4,"END")=41 +"RTN","TMGNDF0A",816,0) + +"RTN","TMGNDF0A",817,0) + ;"RX_OTC NOT NULL CHAR(1) COL: 43 +"RTN","TMGNDF0A",818,0) + ;"Indicates whether product is labeled for Rx or OTC use (R/O). +"RTN","TMGNDF0A",819,0) + set Info(5)=5 ;"Rx or OTC +"RTN","TMGNDF0A",820,0) + set Info(5,"START")=43 +"RTN","TMGNDF0A",821,0) + set Info(5,"END")=43 +"RTN","TMGNDF0A",822,0) + +"RTN","TMGNDF0A",823,0) + ;"TRADENAME NOT NULL CHAR(100) COL: 45-144 +"RTN","TMGNDF0A",824,0) + ;"Product's name as it appears on the labeling. +"RTN","TMGNDF0A",825,0) + set Info(7)=7 ;"Trade name +"RTN","TMGNDF0A",826,0) + set Info(7,"START")=45 +"RTN","TMGNDF0A",827,0) + set Info(7,"END")=144 +"RTN","TMGNDF0A",828,0) + +"RTN","TMGNDF0A",829,0) + ;"NOTE: This field will be left blank, as it is not included in FDA +"RTN","TMGNDF0A",830,0) + ;" file here. It is really the same info as LBLCODE, i.e. the +"RTN","TMGNDF0A",831,0) + ;" Firm that makes drug can be determined from LBL code. +"RTN","TMGNDF0A",832,0) + ;"set Info(6)=6 ;"Firm +"RTN","TMGNDF0A",833,0) + ;"set Info(6,"START")=45 +"RTN","TMGNDF0A",834,0) + ;"set Info(6,"END")=51 +"RTN","TMGNDF0A",835,0) + +"RTN","TMGNDF0A",836,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0A",837,0) + set result=$$DataImport(.Info,ProgressFn) +"RTN","TMGNDF0A",838,0) + do ProgressBar^TMGUSRIF(100,"Progress",0,100) +"RTN","TMGNDF0A",839,0) + +"RTN","TMGNDF0A",840,0) +LLL3 +"RTN","TMGNDF0A",841,0) + ;"Fix Firms Pointer +"RTN","TMGNDF0A",842,0) + ;"Note: the latest FDA export does not explicitly specify the Firm, +"RTN","TMGNDF0A",843,0) + ;" and only gives the label code. Thus the label code must be +"RTN","TMGNDF0A",844,0) + ;" used to look up the IEN for the firm, and this put into the +"RTN","TMGNDF0A",845,0) + ;" FIRM fiels (#6) +"RTN","TMGNDF0A",846,0) + +"RTN","TMGNDF0A",847,0) + new Itr,IEN +"RTN","TMGNDF0A",848,0) + set IEN=$$ItrInit^TMGITR(22706.5,.Itr) +"RTN","TMGNDF0A",849,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF0A",850,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF0A",851,0) + . new lblCode +"RTN","TMGNDF0A",852,0) + . set lblCode=$piece($get(^TMG(22706.5,IEN,0)),"^",2) +"RTN","TMGNDF0A",853,0) + . if lblCode="" quit +"RTN","TMGNDF0A",854,0) + . set lblCode=$$RJ^XLFSTR(lblCode,6,"0") +"RTN","TMGNDF0A",855,0) + . new IEN2 set IEN2=+$order(^TMG(22706.3,"C",lblCode,"")) +"RTN","TMGNDF0A",856,0) + . if IEN2'>0 quit +"RTN","TMGNDF0A",857,0) + . set $piece(^TMG(22706.5,IEN,0),"^",7)=IEN2 +"RTN","TMGNDF0A",858,0) + +"RTN","TMGNDF0A",859,0) +LLsDone +"RTN","TMGNDF0A",860,0) + quit result +"RTN","TMGNDF0A",861,0) + +"RTN","TMGNDF0A",862,0) + +"RTN","TMGNDF0A",863,0) +DataImport(Info,ProgressFN) +"RTN","TMGNDF0A",864,0) + ;"Purpose: to provide a generic loading utility, for importing data from a text file. +"RTN","TMGNDF0A",865,0) + ;" Note: this is more specific than code found in DDMP.m +"RTN","TMGNDF0A",866,0) + ;"Assumptions: that all data for one record is found on one line, with a given +"RTN","TMGNDF0A",867,0) + ;" number of columns for each field (i.e. not Comma-Separated-Values). +"RTN","TMGNDF0A",868,0) + ;"Input: Info, an array with relevent info. PASS BY REFERENCE +"RTN","TMGNDF0A",869,0) + ;" Format as follows: +"RTN","TMGNDF0A",870,0) + ;" Info("HFS DIR")= +"RTN","TMGNDF0A",871,0) + ;" Info("HFS FILE")= +"RTN","TMGNDF0A",872,0) + ;" Info("DEST FILE")= +"RTN","TMGNDF0A",873,0) + ;" Info(x)=field# (or "IEN" if data should be used to determine record number +"RTN","TMGNDF0A",874,0) + ;" Info(x,"START")=starting column +"RTN","TMGNDF0A",875,0) + ;" Info(x,"END")=ending column +"RTN","TMGNDF0A",876,0) + ;" ProgressFN: optional. If not "", then this will be XECUTED after each line +"RTN","TMGNDF0A",877,0) + ;" The following variables will be defined: +"RTN","TMGNDF0A",878,0) + ;" TMGTOTAL -- total number of records +"RTN","TMGNDF0A",879,0) + ;" TMGCUR -- current index of record being processed +"RTN","TMGNDF0A",880,0) + ;"Result: 1 if OK to continue, 0 if error +"RTN","TMGNDF0A",881,0) + +"RTN","TMGNDF0A",882,0) + ;"Note: input Data array will be formated like this: +"RTN","TMGNDF0A",883,0) + ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGNDF0A",884,0) + ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200," +"RTN","TMGNDF0A",885,0) + ;" Data(0,cRecNum)=2 <-- only if user-specified. +"RTN","TMGNDF0A",886,0) + ;" Data(0,cEntries)=1 +"RTN","TMGNDF0A",887,0) + ;" Data(1,".01")="MyData1" +"RTN","TMGNDF0A",888,0) + ;" Data(1,".01",cMatchValue)="MyData1" +"RTN","TMGNDF0A",889,0) + ;" Data(1,".02")="Bill" +"RTN","TMGNDF0A",890,0) + ;" Data(1,".02",cMatchValue)="John" +"RTN","TMGNDF0A",891,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGNDF0A",892,0) + ;" Data(1,".04")="MyData4" +"RTN","TMGNDF0A",893,0) + ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06" +"RTN","TMGNDF0A",894,0) + ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07" +"RTN","TMGNDF0A",895,0) + ;" Data(1,".07",1,".01")="SubEntry1" +"RTN","TMGNDF0A",896,0) + ;" Data(1,".07",1,".02")="SE1" +"RTN","TMGNDF0A",897,0) + ;" Data(1,".07",1,".03")="'Some Info'" +"RTN","TMGNDF0A",898,0) + ;" Data(1,".07",2,".01")="SubEntry2" +"RTN","TMGNDF0A",899,0) + ;" Data(1,".07",2,".02")="SE2" +"RTN","TMGNDF0A",900,0) + ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04 +"RTN","TMGNDF0A",901,0) + ;" Data(1,".07",2,".04",1,".01")="JD" +"RTN","TMGNDF0A",902,0) + ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGNDF0A",903,0) + ;" ADDENDUM +"RTN","TMGNDF0A",904,0) + ;" Data(1,".01",cFlags)=any flags specified for given field. +"RTN","TMGNDF0A",905,0) + ;" only present if user specified. +"RTN","TMGNDF0A",906,0) + +"RTN","TMGNDF0A",907,0) + new cFile set cFile="FILE" +"RTN","TMGNDF0A",908,0) + new cRecNum set cRecNum="RECNUM" +"RTN","TMGNDF0A",909,0) + new result set result=1 +"RTN","TMGNDF0A",910,0) + new TMGTOTAL,TMGCUR +"RTN","TMGNDF0A",911,0) + +"RTN","TMGNDF0A",912,0) + new GRef set GRef=$name(^TMP("TMG","DATAIMPORT",$J)) +"RTN","TMGNDF0A",913,0) + new GRef1 set GRef1=$name(@GRef@(1)) ;"I have to use this to load file +"RTN","TMGNDF0A",914,0) + kill @GRef +"RTN","TMGNDF0A",915,0) + +"RTN","TMGNDF0A",916,0) + new result +"RTN","TMGNDF0A",917,0) + new dir set dir=$get(Info("HFS DIR")) +"RTN","TMGNDF0A",918,0) + new HFSfile set HFSfile=$get(Info("HFS FILE")) +"RTN","TMGNDF0A",919,0) + set result=$$FTG^%ZISH(dir,HFSfile,GRef1,4) +"RTN","TMGNDF0A",920,0) + if result=0 goto DIDone +"RTN","TMGNDF0A",921,0) + set TMGTOTAL=$order(@GRef@(""),-1) +"RTN","TMGNDF0A",922,0) + new file set file=$get(Info("DEST FILE")) +"RTN","TMGNDF0A",923,0) + if +file=0 set file=$$GetFileNum^TMGDBAPI(file) +"RTN","TMGNDF0A",924,0) + +"RTN","TMGNDF0A",925,0) + new index +"RTN","TMGNDF0A",926,0) + set index=$order(@GRef@("")) +"RTN","TMGNDF0A",927,0) + for do quit:(+index=0)!(result=0) +"RTN","TMGNDF0A",928,0) + . new RecData,TMGFDA +"RTN","TMGNDF0A",929,0) + . set RecData(0,cFile)=file +"RTN","TMGNDF0A",930,0) + . new line set line=$get(@GRef@(index)) +"RTN","TMGNDF0A",931,0) + . if $data(@GRef@(index,"OVF")) do +"RTN","TMGNDF0A",932,0) + . . new i set i=$order(@GRef@(index,"OVF","")) +"RTN","TMGNDF0A",933,0) + . . for do quit:(+i=0) +"RTN","TMGNDF0A",934,0) + . . . set line=line_$get(@GRef@(index,"OVF",i)) ;"note strings can be longer than 255 now +"RTN","TMGNDF0A",935,0) + . . . set i=$order(@GRef@(index,"OVF",i)) +"RTN","TMGNDF0A",936,0) + . new fields set fields=$order(Info("")) +"RTN","TMGNDF0A",937,0) + . new IEN set IEN="" +"RTN","TMGNDF0A",938,0) + . for do quit:(+fields=0)!(result=0) +"RTN","TMGNDF0A",939,0) + . . new fieldNum set fieldNum=$get(Info(fields)) ;"could be number or 'IEN' +"RTN","TMGNDF0A",940,0) + . . new oneField +"RTN","TMGNDF0A",941,0) + . . set oneField=$extract(line,$get(Info(fields,"START")),$get(Info(fields,"END"))) +"RTN","TMGNDF0A",942,0) + . . set oneField=$$Trim^TMGSTUTL(oneField) +"RTN","TMGNDF0A",943,0) + . . if fieldNum="IEN" do +"RTN","TMGNDF0A",944,0) + . . . set RecData(0,cRecNum)=oneField +"RTN","TMGNDF0A",945,0) + . . . set IEN=oneField +"RTN","TMGNDF0A",946,0) + . . else do +"RTN","TMGNDF0A",947,0) + . . . set RecData(1,fieldNum)=oneField +"RTN","TMGNDF0A",948,0) + . . set fields=$order(Info(fields)) +"RTN","TMGNDF0A",949,0) + . new MarkNum set MarkNum=0 +"RTN","TMGNDF0A",950,0) + . new MsgArray +"RTN","TMGNDF0A",951,0) + . set result=$$SetupFDA^TMGDBAPI(.RecData,.TMGFDA,,"+",.MarkNum,.MsgArray) +"RTN","TMGNDF0A",952,0) + . if result=0 quit +"RTN","TMGNDF0A",953,0) + . new TMGIEN +"RTN","TMGNDF0A",954,0) + . if IEN'=0 do +"RTN","TMGNDF0A",955,0) + . . if +IEN>0 set TMGIEN(1)=IEN +"RTN","TMGNDF0A",956,0) + . . set result=$$dbWrite^TMGDBAPI(.TMGFDA,0,.TMGIEN," ") +"RTN","TMGNDF0A",957,0) + . if result=0 quit +"RTN","TMGNDF0A",958,0) + . if $get(ProgressFN)'="" do +"RTN","TMGNDF0A",959,0) + . . set TMGCUR=index +"RTN","TMGNDF0A",960,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF0A",961,0) + . . xecute ProgressFN +"RTN","TMGNDF0A",962,0) + . set index=$order(@GRef@(index)) +"RTN","TMGNDF0A",963,0) + +"RTN","TMGNDF0A",964,0) +DIDone +"RTN","TMGNDF0A",965,0) + kill @GRef +"RTN","TMGNDF0A",966,0) + quit result +"RTN","TMGNDF0A",967,0) + +"RTN","TMGNDF0A",968,0) + +"RTN","TMGNDF0A",969,0) +SetSkipFlag +"RTN","TMGNDF0A",970,0) + ;"Purpose: To review entries in TMG FDA IMPORT COMPILED and determine which +"RTN","TMGNDF0A",971,0) + ;" of those need to have the SKIP THIS RECORD flag set. +"RTN","TMGNDF0A",972,0) + ;" The following records will be SKIPPED: +"RTN","TMGNDF0A",973,0) + ;" -- If there is an entry in the VA PRODUCT MATCHES field. This would +"RTN","TMGNDF0A",974,0) + ;" mean that there is ALREADY an entry in the database for this +"RTN","TMGNDF0A",975,0) + ;" drug, and it will not need to be added. +"RTN","TMGNDF0A",976,0) + ;" -- If there are no entries in the INGREDIENTS field. This is because if +"RTN","TMGNDF0A",977,0) + ;" the FDA database does not list ingredients for a drug, I believe it +"RTN","TMGNDF0A",978,0) + ;" is because it is not an active drug (otherwise the FDA would require +"RTN","TMGNDF0A",979,0) + ;" full information), and there is very likely another drug entry for +"RTN","TMGNDF0A",980,0) + ;" this same drug that DOES have the ingredients. +"RTN","TMGNDF0A",981,0) + ;"Note: This function is planned to be run after CompileAll^TMGNDF2AA +"RTN","TMGNDF0A",982,0) + +"RTN","TMGNDF0A",983,0) + new IEN +"RTN","TMGNDF0A",984,0) + new NumSkipped,NumNotSkipped,NoIngreds +"RTN","TMGNDF0A",985,0) + set NumSkipped=0,NumNotSkipped=0,NoIngreds=0 +"RTN","TMGNDF0A",986,0) + +"RTN","TMGNDF0A",987,0) + set IEN=$order(^TMG(22706.9,0)) +"RTN","TMGNDF0A",988,0) + if +IEN>0 for do quit:(+IEN'>0) +"RTN","TMGNDF0A",989,0) + . new name set name=$piece($get(^TMG(22706.9,IEN,0)),"^",4) +"RTN","TMGNDF0A",990,0) + . new NumIngreds set NumIngreds=0 +"RTN","TMGNDF0A",991,0) + . new SkipThisOne set SkipThisOne=0 +"RTN","TMGNDF0A",992,0) + . ;"See if there are entries in the VA PRODUCT MATCHES field (node 2) +"RTN","TMGNDF0A",993,0) + . new ProdMatches set ProdMatches=+$piece($get(^TMG(22706.9,IEN,2,0)),"^",4) ;"piece 4 of 0 node is number of entries. +"RTN","TMGNDF0A",994,0) + . if ProdMatches>0 set SkipThisOne=1 +"RTN","TMGNDF0A",995,0) + . ;"See if there are NO entries in the INGREDIENTS field (node 4) +"RTN","TMGNDF0A",996,0) + . set NumIngreds=+$piece($get(^TMG(22706.9,IEN,4,0)),"^",4) ;"piece 4 of 0 node is number of entries. +"RTN","TMGNDF0A",997,0) + . if NumIngreds=0 set SkipThisOne=1,NoIngreds=NoIngreds+1 +"RTN","TMGNDF0A",998,0) + . if SkipThisOne set NumSkipped=NumSkipped+1 +"RTN","TMGNDF0A",999,0) + . else set NumNotSkipped=NumNotSkipped+1 +"RTN","TMGNDF0A",1000,0) + . set $piece(^TMG(22706.9,IEN,1),"^",4)=SkipThisOne +"RTN","TMGNDF0A",1001,0) + . ;"write " matches=",ProdMatches," ingredients=",NumIngreds," ",name,! +"RTN","TMGNDF0A",1002,0) + . set IEN=$order(^TMG(22706.9,IEN)) +"RTN","TMGNDF0A",1003,0) + +"RTN","TMGNDF0A",1004,0) + write !,"There are ",NumSkipped," entries that are will be skipped.",! +"RTN","TMGNDF0A",1005,0) + write " (",NoIngreds," with no ingredients)",! +"RTN","TMGNDF0A",1006,0) + write " (",NumSkipped-NoIngreds," already in the database)",! +"RTN","TMGNDF0A",1007,0) + write "There are ",NumNotSkipped," new entries to be added.",! +"RTN","TMGNDF0A",1008,0) + +"RTN","TMGNDF0A",1009,0) + quit +"RTN","TMGNDF0A",1010,0) + +"RTN","TMGNDF0A",1011,0) + +"RTN","TMGNDF0A",1012,0) +Backup +"RTN","TMGNDF0A",1013,0) + ;"Purpose: To backup files to a temporary global +"RTN","TMGNDF0A",1014,0) + +"RTN","TMGNDF0A",1015,0) + new dateCode set dateCode="1/15/07" +"RTN","TMGNDF0A",1016,0) + +"RTN","TMGNDF0A",1017,0) + new src,dest,i +"RTN","TMGNDF0A",1018,0) + +"RTN","TMGNDF0A",1019,0) + for i=1:1:8 do +"RTN","TMGNDF0A",1020,0) + . set src="^TMG(22706."_i_")" +"RTN","TMGNDF0A",1021,0) + . set dest=$name(^TMG("TMP",src_" "_dateCode)) +"RTN","TMGNDF0A",1022,0) + . write "merging ",src," into ",dest,! +"RTN","TMGNDF0A",1023,0) + . merge @dest=@src +"RTN","TMGNDF0A",1024,0) + +"RTN","TMGNDF0A",1025,0) + quit +"RTN","TMGNDF0B") +0^36^B6565 +"RTN","TMGNDF0B",1,0) +TMGNDF0B ;TMG/kst/FDA Import: Display FDA files ;03/25/06 +"RTN","TMGNDF0B",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF0B",3,0) + +"RTN","TMGNDF0B",4,0) + ;" FDA - NATIONAL DRUG FILES DISPLAY FUNCTIONS +"RTN","TMGNDF0B",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF0B",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF0B",7,0) + ;"11-21-2006 +"RTN","TMGNDF0B",8,0) + +"RTN","TMGNDF0B",9,0) + ;"======================================================================= +"RTN","TMGNDF0B",10,0) + ;" API -- Public Functions. +"RTN","TMGNDF0B",11,0) + ;"======================================================================= +"RTN","TMGNDF0B",12,0) + ;"ShowDrug +"RTN","TMGNDF0B",13,0) + ;"ShowAll +"RTN","TMGNDF0B",14,0) + ;"CountAll +"RTN","TMGNDF0B",15,0) + ;"Show1Drug(IEN,Index) +"RTN","TMGNDF0B",16,0) + +"RTN","TMGNDF0B",17,0) + ;"======================================================================= +"RTN","TMGNDF0B",18,0) + ;" Private Functions. +"RTN","TMGNDF0B",19,0) + ;"======================================================================= +"RTN","TMGNDF0B",20,0) + ;"AskCompile +"RTN","TMGNDF0B",21,0) + ;"CompByTemplate +"RTN","TMGNDF0B",22,0) + ;"ShowTemplate +"RTN","TMGNDF0B",23,0) + +"RTN","TMGNDF0B",24,0) + ;"ShowNDCConflict(Array,IEN2) +"RTN","TMGNDF0B",25,0) + ;"FormatDrug(Array) +"RTN","TMGNDF0B",26,0) + ;"Format2Drug(Array) +"RTN","TMGNDF0B",27,0) + ;"Format3Drug(Array) +"RTN","TMGNDF0B",28,0) + +"RTN","TMGNDF0B",29,0) + +"RTN","TMGNDF0B",30,0) + ;"======================================================================= +"RTN","TMGNDF0B",31,0) + ;"======================================================================= +"RTN","TMGNDF0B",32,0) +Menu +"RTN","TMGNDF0B",33,0) + ;"Purpose: To give an interactive menu +"RTN","TMGNDF0B",34,0) + +"RTN","TMGNDF0B",35,0) + new Menu,UsrSlct +"RTN","TMGNDF0B",36,0) + set Menu(0)="Pick Option for Optional Utilities (0B)" +"RTN","TMGNDF0B",37,0) + set Menu(1)="Show Drugs from FDA Tables"_$char(9)_"ShowAll" +"RTN","TMGNDF0B",38,0) + set Menu(3)="Show ONE Drug from FDA Tables"_$char(9)_"ShowOne" +"RTN","TMGNDF0B",39,0) + set Menu(2)="Count Drugs from FDA Tables"_$char(9)_"CountAll" +"RTN","TMGNDF0B",40,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF0B",41,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF0B",42,0) + +"RTN","TMGNDF0B",43,0) +CD1 +"RTN","TMGNDF0B",44,0) + write # +"RTN","TMGNDF0B",45,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF0B",46,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF0B",47,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF0B",48,0) + +"RTN","TMGNDF0B",49,0) + if UsrSlct="Prev" goto Menu^TMGNDF0A ;"quit can occur from there... +"RTN","TMGNDF0B",50,0) + if UsrSlct="Next" goto Menu^TMGNDF0C ;"quit can occur from there... +"RTN","TMGNDF0B",51,0) + if UsrSlct="ShowAll" do ShowAll goto CD1 +"RTN","TMGNDF0B",52,0) + if UsrSlct="ShowOne" do ShowDrug goto CD1 +"RTN","TMGNDF0B",53,0) + if UsrSlct="CountAll" do CountAll goto CD1 +"RTN","TMGNDF0B",54,0) + goto CD1 +"RTN","TMGNDF0B",55,0) +CDDone +"RTN","TMGNDF0B",56,0) + quit +"RTN","TMGNDF0B",57,0) + +"RTN","TMGNDF0B",58,0) + ;"======================================================================= +"RTN","TMGNDF0B",59,0) + +"RTN","TMGNDF0B",60,0) +ShowDrug +"RTN","TMGNDF0B",61,0) + ;"Purpose: to ask for an IEN, and then show drug +"RTN","TMGNDF0B",62,0) + ;" i.e. IEN from TMG FDA LISTING +"RTN","TMGNDF0B",63,0) + +"RTN","TMGNDF0B",64,0) + new IEN,pIndex +"RTN","TMGNDF0B",65,0) + set pIndex=$$GetpVAPIndex^TMGNDF1A() +"RTN","TMGNDF0B",66,0) + +"RTN","TMGNDF0B",67,0) +loop read "Enter IEN number (^ to quit) ^// ",IEN:$get(DTIME,3600),! +"RTN","TMGNDF0B",68,0) + if IEN="" set IEN="^" +"RTN","TMGNDF0B",69,0) + if IEN="^" goto SDDone +"RTN","TMGNDF0B",70,0) + do Show1Drug(IEN,.Index) +"RTN","TMGNDF0B",71,0) + goto loop +"RTN","TMGNDF0B",72,0) + +"RTN","TMGNDF0B",73,0) +SDDone +"RTN","TMGNDF0B",74,0) + quit +"RTN","TMGNDF0B",75,0) + +"RTN","TMGNDF0B",76,0) + +"RTN","TMGNDF0B",77,0) +Show1Drug(IEN,pIndex) +"RTN","TMGNDF0B",78,0) + ;"Purpose: to show drug from TMG FDA LISTING +"RTN","TMGNDF0B",79,0) + ;"Input: IEN -- IEN from TMG FDA LISTING file +"RTN","TMGNDF0B",80,0) + ;" Index -- PASS BY NAME -- OPTIONAL +"RTN","TMGNDF0B",81,0) + ;" This is an index as returned by IndexVAProd^TMGNDF1A("Index") +"RTN","TMGNDF0B",82,0) + ;" If not passed, then it will be filled here. +"RTN","TMGNDF0B",83,0) + ;"Results: none +"RTN","TMGNDF0B",84,0) + +"RTN","TMGNDF0B",85,0) + new Array,result +"RTN","TMGNDF0B",86,0) + if $get(pIndex)="" set pIndex=$$GetpVAPIndex^TMGNDF1A() +"RTN","TMGNDF0B",87,0) + +"RTN","TMGNDF0B",88,0) + set result=$$GetDrugInfo^TMGNDF1A(IEN,.Array,pIndex) +"RTN","TMGNDF0B",89,0) + if (result=1)&($data(Array)'=0) do +"RTN","TMGNDF0B",90,0) + . write !,"-----------------------------------------",! +"RTN","TMGNDF0B",91,0) + . zwr Array(*) +"RTN","TMGNDF0B",92,0) + quit +"RTN","TMGNDF0B",93,0) + +"RTN","TMGNDF0B",94,0) + +"RTN","TMGNDF0B",95,0) +ShowAll +"RTN","TMGNDF0B",96,0) + ;"Purpose: to show all drugs +"RTN","TMGNDF0B",97,0) + +"RTN","TMGNDF0B",98,0) + new count set count=1 +"RTN","TMGNDF0B",99,0) + new Array +"RTN","TMGNDF0B",100,0) + new temp set temp=" " +"RTN","TMGNDF0B",101,0) + new result set result=1 +"RTN","TMGNDF0B",102,0) + new Matches +"RTN","TMGNDF0B",103,0) + +"RTN","TMGNDF0B",104,0) + new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A() +"RTN","TMGNDF0B",105,0) + +"RTN","TMGNDF0B",106,0) +SADloop +"RTN","TMGNDF0B",107,0) + kill Array +"RTN","TMGNDF0B",108,0) + +"RTN","TMGNDF0B",109,0) + ;"2/13/07 note: the call to GetDrugInfo below looks wrong. I have made changes +"RTN","TMGNDF0B",110,0) + ;" to the location of functions. I think this needs to be reassessed... +"RTN","TMGNDF0B",111,0) + if $$GetDrugInfo^TMGNDF1A(count,.Array,pIndex) do +"RTN","TMGNDF0B",112,0) + . new numMatch set numMatch=+$get(Array("FILE 50.68 IEN","COUNT")) +"RTN","TMGNDF0B",113,0) + . new numPMatch set numPMatch=+$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT")) +"RTN","TMGNDF0B",114,0) + . set Matches(numMatch,numPMatch)=$get(Matches(numMatch,numPMatch))+1 +"RTN","TMGNDF0B",115,0) + . write count,": " +"RTN","TMGNDF0B",116,0) + . do Format2Drug(.Array) +"RTN","TMGNDF0B",117,0) + . quit +"RTN","TMGNDF0B",118,0) + . write "Type ^ to abort, to pause",! +"RTN","TMGNDF0B",119,0) + . if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do +"RTN","TMGNDF0B",120,0) + . . write "No MATCH in VA PRODUCT file",! +"RTN","TMGNDF0B",121,0) + . else if +$get(Array("FILE 50.68 IEN","COUNT"))>1 do +"RTN","TMGNDF0B",122,0) + . . write "MULTIPLE matches found in VA PRODUCT file",! +"RTN","TMGNDF0B",123,0) + . . zwr Array("FILE 50.68 IEN",*) +"RTN","TMGNDF0B",124,0) + . else if +$get(Array("FILE 50.68 IEN","COUNT"))>1 do +"RTN","TMGNDF0B",125,0) + . . write "1 match found.",! +"RTN","TMGNDF0B",126,0) + else set temp="^" +"RTN","TMGNDF0B",127,0) + +"RTN","TMGNDF0B",128,0) + read temp:0.25 +"RTN","TMGNDF0B",129,0) + if temp=" " do +"RTN","TMGNDF0B",130,0) + . read "Press to continue (or ^ to abort) ",temp,! +"RTN","TMGNDF0B",131,0) + set count=count+1 +"RTN","TMGNDF0B",132,0) + if temp="^" goto SD2Done +"RTN","TMGNDF0B",133,0) + +"RTN","TMGNDF0B",134,0) + goto SADloop +"RTN","TMGNDF0B",135,0) + +"RTN","TMGNDF0B",136,0) +SD2Done +"RTN","TMGNDF0B",137,0) + write "Here is the cumulative results of couting matches",! +"RTN","TMGNDF0B",138,0) + write "Matches(Matches,PossMatches)=count",! +"RTN","TMGNDF0B",139,0) + zwr Matches(*) +"RTN","TMGNDF0B",140,0) + quit +"RTN","TMGNDF0B",141,0) + +"RTN","TMGNDF0B",142,0) + +"RTN","TMGNDF0B",143,0) +CountAll +"RTN","TMGNDF0B",144,0) + ;"Purpose: to ask for an IEN, and then show drug +"RTN","TMGNDF0B",145,0) + +"RTN","TMGNDF0B",146,0) + new count set count=20000 +"RTN","TMGNDF0B",147,0) + new Array +"RTN","TMGNDF0B",148,0) + new temp set temp=" " +"RTN","TMGNDF0B",149,0) + new result set result=1 +"RTN","TMGNDF0B",150,0) + new Matches +"RTN","TMGNDF0B",151,0) + new showCount set showCount=0 +"RTN","TMGNDF0B",152,0) + new MaxIEN set MaxIEN=$piece($get(^TMG(22706.5,0)),"^",3) +"RTN","TMGNDF0B",153,0) + new abort set abort=0 +"RTN","TMGNDF0B",154,0) + +"RTN","TMGNDF0B",155,0) +CADloop +"RTN","TMGNDF0B",156,0) + for count=1:1:MaxIEN do quit:(abort=1) +"RTN","TMGNDF0B",157,0) + . kill Array +"RTN","TMGNDF0B",158,0) + . if $$GetDrugInfo^TMGNDF1A(count,.Array)=1 do +"RTN","TMGNDF0B",159,0) + . . new numMatch set numMatch=+$get(Array("FILE 50.68 IEN","COUNT")) +"RTN","TMGNDF0B",160,0) + . . new numPMatch set numPMatch=+$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT")) +"RTN","TMGNDF0B",161,0) + . . set Matches(numMatch,numPMatch)=$get(Matches(numMatch,numPMatch))+1 +"RTN","TMGNDF0B",162,0) + . . if $get(Array("NDC","NOTE"))'="" do +"RTN","TMGNDF0B",163,0) + . . . write count,"--> ",Array("NDC","NOTE"),! +"RTN","TMGNDF0B",164,0) + . . . new badIEN set badIEN=+$piece(Array("NDC","NOTE"),"=",2) +"RTN","TMGNDF0B",165,0) + . . . do ShowNDCConflict(.Array,badIEN) +"RTN","TMGNDF0B",166,0) + . . . read temp:0.25 +"RTN","TMGNDF0B",167,0) + . . . if temp=" " do +"RTN","TMGNDF0B",168,0) + . . . . read "Press to continue (or ^ to abort) ",temp,! +"RTN","TMGNDF0B",169,0) + . . . . if temp="^" set abort=1 +"RTN","TMGNDF0B",170,0) + . . set showCount=showCount+1 +"RTN","TMGNDF0B",171,0) + . . if showCount=100 do +"RTN","TMGNDF0B",172,0) + . . . set showCount=0 +"RTN","TMGNDF0B",173,0) + . . . write count,": " +"RTN","TMGNDF0B",174,0) + . . . do Format2Drug(.Array) +"RTN","TMGNDF0B",175,0) + +"RTN","TMGNDF0B",176,0) +CADDone +"RTN","TMGNDF0B",177,0) + write "Here is the cumulative results of couting matches",! +"RTN","TMGNDF0B",178,0) + write "Matches(Matches,PossMatches)=count",! +"RTN","TMGNDF0B",179,0) + zwr Matches(*) +"RTN","TMGNDF0B",180,0) + quit +"RTN","TMGNDF0B",181,0) + +"RTN","TMGNDF0B",182,0) + +"RTN","TMGNDF0B",183,0) + +"RTN","TMGNDF0B",184,0) +FormatDrug(Array) +"RTN","TMGNDF0B",185,0) + +"RTN","TMGNDF0B",186,0) + if '$data(Array) quit +"RTN","TMGNDF0B",187,0) + new i +"RTN","TMGNDF0B",188,0) + write $get(Array("TRADENAME")),"; " +"RTN","TMGNDF0B",189,0) + write $get(Array("STRENGTH")),"; " +"RTN","TMGNDF0B",190,0) + write $get(Array("UNIT")),"; " +"RTN","TMGNDF0B",191,0) + set i=$order(Array("DOSE","")) +"RTN","TMGNDF0B",192,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF0B",193,0) + . write $get(Array("DOSE",i,"DOSAGE NAME"))," " +"RTN","TMGNDF0B",194,0) + . set i=$order(Array("DOSE",i)) +"RTN","TMGNDF0B",195,0) + write ! +"RTN","TMGNDF0B",196,0) + set i=$order(Array("FORMULATION","")) +"RTN","TMGNDF0B",197,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF0B",198,0) + . write " ingredients: ",$get(Array("FORMULATION",i,"INGREDIENT NAME")),"; " +"RTN","TMGNDF0B",199,0) + . write $get(Array("FORMULATION",i,"STRENGTH")),"; " +"RTN","TMGNDF0B",200,0) + . write $get(Array("FORMULATION",i,"UNIT")),! +"RTN","TMGNDF0B",201,0) + . set i=$order(Array("FORMULATION",i)) +"RTN","TMGNDF0B",202,0) + +"RTN","TMGNDF0B",203,0) + quit +"RTN","TMGNDF0B",204,0) + +"RTN","TMGNDF0B",205,0) +Format2Drug(Array) +"RTN","TMGNDF0B",206,0) + +"RTN","TMGNDF0B",207,0) + new s +"RTN","TMGNDF0B",208,0) + if '$data(Array) quit +"RTN","TMGNDF0B",209,0) + new i +"RTN","TMGNDF0B",210,0) + +"RTN","TMGNDF0B",211,0) + set s="m="_$get(Array("FILE 50.68 IEN","COUNT"),0)_";" +"RTN","TMGNDF0B",212,0) + set s=s_"lm="_$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"),0)_" " +"RTN","TMGNDF0B",213,0) + ;"Array("FILE 50.68 IEN","LOOSE MATCH","COUNT")=1 +"RTN","TMGNDF0B",214,0) + set s=s_$get(Array("TRADENAME"))_" " +"RTN","TMGNDF0B",215,0) + set s=s_$get(Array("STRENGTH"))_" " +"RTN","TMGNDF0B",216,0) + set s=s_$get(Array("UNIT"))_" " +"RTN","TMGNDF0B",217,0) + set i=$order(Array("DOSE","")) +"RTN","TMGNDF0B",218,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF0B",219,0) + . set s=s_$get(Array("DOSE",i,"DOSAGE NAME"))_" " +"RTN","TMGNDF0B",220,0) + . set i=$order(Array("DOSE",i)) +"RTN","TMGNDF0B",221,0) + +"RTN","TMGNDF0B",222,0) + write $extract(s,1,60),! +"RTN","TMGNDF0B",223,0) + +"RTN","TMGNDF0B",224,0) + +"RTN","TMGNDF0B",225,0) + if $get(Array("FORMULATION",1,"STRENGTH"))="" do +"RTN","TMGNDF0B",226,0) + . if $get(Array("STRENGTH"))'="" do +"RTN","TMGNDF0B",227,0) + . . write "Note: Ingredient #1 strength is empty, but Overall strength=" +"RTN","TMGNDF0B",228,0) + . . write $get(Array("STRENGTH")),! +"RTN","TMGNDF0B",229,0) + +"RTN","TMGNDF0B",230,0) + quit +"RTN","TMGNDF0B",231,0) + +"RTN","TMGNDF0B",232,0) + +"RTN","TMGNDF0B",233,0) +Format3Drug(Array) +"RTN","TMGNDF0B",234,0) + ;"Purpose: show match, only if 0 matches and >0 possible matches +"RTN","TMGNDF0B",235,0) + +"RTN","TMGNDF0B",236,0) + new s +"RTN","TMGNDF0B",237,0) + if '$data(Array) quit +"RTN","TMGNDF0B",238,0) + new i +"RTN","TMGNDF0B",239,0) + if $get(Array("FILE 50.68 IEN","COUNT"),0)'=0 quit +"RTN","TMGNDF0B",240,0) + if $get(Array("FILE 50.68 IEN","POSS MATCH","COUNT"),0)'>0 quit +"RTN","TMGNDF0B",241,0) + +"RTN","TMGNDF0B",242,0) + do Format2Drug(.Array) +"RTN","TMGNDF0B",243,0) + +"RTN","TMGNDF0B",244,0) + set i=$order(Array("FILE 50.68 IEN","POSS MATCH","")) +"RTN","TMGNDF0B",245,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF0B",246,0) + . new Msg set Msg=$get(Array("FILE 50.68 IEN","POSS MATCH",i,"MSG")) +"RTN","TMGNDF0B",247,0) + . new Problem set Problem=$get(Array("FILE 50.68 IEN","POSS MATCH",i,"PROBLEM")) +"RTN","TMGNDF0B",248,0) + . new IEN set IEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i)) +"RTN","TMGNDF0B",249,0) + . write IEN,": ",Problem,"(",Msg,")",! +"RTN","TMGNDF0B",250,0) + . set i=$order(Array("FILE 50.68 IEN","POSS MATCH",i)) +"RTN","TMGNDF0B",251,0) + +"RTN","TMGNDF0B",252,0) + quit +"RTN","TMGNDF0B",253,0) + +"RTN","TMGNDF0B",254,0) + +"RTN","TMGNDF0B",255,0) +ShowNDCConflict(Array,IEN2) +"RTN","TMGNDF0B",256,0) + ;"Purpose: show two drug entries that have same NDC's, but differing drug properties +"RTN","TMGNDF0B",257,0) + ;"Input: Array -- PASS BY REFERENECE -- data with DrugIfno (from GetDrugInfo) +"RTN","TMGNDF0B",258,0) + ;" IEN2: the IEN from file VA PRODUCT (50.68) +"RTN","TMGNDF0B",259,0) + +"RTN","TMGNDF0B",260,0) + +"RTN","TMGNDF0B",261,0) + write "Here is TMG FDA* data:",! +"RTN","TMGNDF0B",262,0) + do FormatDrug(.Array) +"RTN","TMGNDF0B",263,0) + write ! +"RTN","TMGNDF0B",264,0) + +"RTN","TMGNDF0B",265,0) + write "Here is VA Product data:",! +"RTN","TMGNDF0B",266,0) + new VAArray +"RTN","TMGNDF0B",267,0) + do GetVADrugInfo^TMGNDF1C(IEN2,.VAArray) +"RTN","TMGNDF0B",268,0) + do FormatDrug(.VAArray) +"RTN","TMGNDF0B",269,0) + +"RTN","TMGNDF0B",270,0) + write !! +"RTN","TMGNDF0B",271,0) + quit +"RTN","TMGNDF0B",272,0) + +"RTN","TMGNDF0B",273,0) + +"RTN","TMGNDF0B",274,0) +AskCompile +"RTN","TMGNDF0B",275,0) + ;"Purpose: To ask for an Entry number from 22706.5 and add drug to compiled file +"RTN","TMGNDF0B",276,0) + +"RTN","TMGNDF0B",277,0) + new IEN +"RTN","TMGNDF0B",278,0) + +"RTN","TMGNDF0B",279,0) + for do quit:(+IEN'=IEN) +"RTN","TMGNDF0B",280,0) + . read "Type in Entry Number (^ to abort): ",IEN:$get(DTIME,3600),! +"RTN","TMGNDF0B",281,0) + . if +IEN'=IEN quit +"RTN","TMGNDF0B",282,0) + . do CompileOne^TMGNDF1C(IEN) +"RTN","TMGNDF0B",283,0) + +"RTN","TMGNDF0B",284,0) + quit +"RTN","TMGNDF0B",285,0) + +"RTN","TMGNDF0B",286,0) +CompByTemplate +"RTN","TMGNDF0B",287,0) + ;"Purpose: To ask for a SORT TEMPLATE, and compile the records for IENs stored there. +"RTN","TMGNDF0B",288,0) + +"RTN","TMGNDF0B",289,0) + new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A() +"RTN","TMGNDF0B",290,0) + +"RTN","TMGNDF0B",291,0) + new IEN,Template +"RTN","TMGNDF0B",292,0) + new DIC,X,Y +"RTN","TMGNDF0B",293,0) + set DIC=.401 +"RTN","TMGNDF0B",294,0) + set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: " +"RTN","TMGNDF0B",295,0) + set DIC(0)="AEQM" +"RTN","TMGNDF0B",296,0) + do ^DIC +"RTN","TMGNDF0B",297,0) + if +Y'>0 goto CBTDone +"RTN","TMGNDF0B",298,0) + set Template=+Y +"RTN","TMGNDF0B",299,0) + +"RTN","TMGNDF0B",300,0) + new TMGTOTAL set TMGTOTAL=$$CtTemplate^TMGMISC(Template) +"RTN","TMGNDF0B",301,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0B",302,0) + new ProgressFn +"RTN","TMGNDF0B",303,0) + set ProgressFn="if count#10=1 do ProgressBar^TMGUSRIF(count,""Progress"",0,TMGTOTAL,,StartTime)" +"RTN","TMGNDF0B",304,0) + set IEN="" +"RTN","TMGNDF0B",305,0) + new count set count=0 +"RTN","TMGNDF0B",306,0) + for do quit:(+IEN'>0) +"RTN","TMGNDF0B",307,0) + . set IEN=$$IterTemplate^TMGMISC(Template,IEN) +"RTN","TMGNDF0B",308,0) + . if +IEN'>0 quit +"RTN","TMGNDF0B",309,0) + . ;"write IEN,! +"RTN","TMGNDF0B",310,0) + . do CompileOne^TMGNDF1C(IEN,0,pIndex) +"RTN","TMGNDF0B",311,0) + . set count=count+1 +"RTN","TMGNDF0B",312,0) + . if $get(ProgressFn)'="" do +"RTN","TMGNDF0B",313,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF0B",314,0) + . . xecute ProgressFn +"RTN","TMGNDF0B",315,0) + +"RTN","TMGNDF0B",316,0) +CBTDone +"RTN","TMGNDF0B",317,0) + quit +"RTN","TMGNDF0B",318,0) + +"RTN","TMGNDF0B",319,0) + +"RTN","TMGNDF0B",320,0) +MkGenAll +"RTN","TMGNDF0B",321,0) + ;"Purpose: To fill in the GENERIC NAME field for record for all records in file +"RTN","TMGNDF0B",322,0) + ;"Input: none +"RTN","TMGNDF0B",323,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added. +"RTN","TMGNDF0B",324,0) + ;"Result: none +"RTN","TMGNDF0B",325,0) + +"RTN","TMGNDF0B",326,0) + new IEN set IEN=0 +"RTN","TMGNDF0B",327,0) + new Array,result,temp +"RTN","TMGNDF0B",328,0) + new Interval set Interval=0 +"RTN","TMGNDF0B",329,0) + new abort set abort=0 +"RTN","TMGNDF0B",330,0) + new TMGTOTAL set TMGTOTAL=$piece($get(^TMG(22706.5,0)),"^",3) +"RTN","TMGNDF0B",331,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0B",332,0) + new ProgressFn +"RTN","TMGNDF0B",333,0) + set ProgressFn="if IEN#10=1 do ProgressBar^TMGUSRIF(IEN,""Progress"",0,TMGTOTAL,,StartTime)" +"RTN","TMGNDF0B",334,0) + +"RTN","TMGNDF0B",335,0) + for do quit:(IEN'>0)!(abort=1) +"RTN","TMGNDF0B",336,0) + . set IEN=$order(^TMG(22706.5,IEN)) +"RTN","TMGNDF0B",337,0) + . if +IEN'>0 quit +"RTN","TMGNDF0B",338,0) + . do FillGenericName^TMGNDF1C(IEN) +"RTN","TMGNDF0B",339,0) + . if $get(ProgressFn)'="" do +"RTN","TMGNDF0B",340,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF0B",341,0) + . . xecute ProgressFn +"RTN","TMGNDF0B",342,0) + +"RTN","TMGNDF0B",343,0) + quit +"RTN","TMGNDF0B",344,0) + +"RTN","TMGNDF0B",345,0) + +"RTN","TMGNDF0B",346,0) +MkGenByTemplate +"RTN","TMGNDF0B",347,0) + ;"Purpose: To ask for a SORT TEMPLATE, and fill in the GENERIC NAME field for record +"RTN","TMGNDF0B",348,0) + ;" -- for all records listed in the template +"RTN","TMGNDF0B",349,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has GENERIC NAME firecords added. +"RTN","TMGNDF0B",350,0) + +"RTN","TMGNDF0B",351,0) + new pIndex set pIndex=$$GetpVAPIndex^TMGNDF1A() +"RTN","TMGNDF0B",352,0) + +"RTN","TMGNDF0B",353,0) + new IEN,Template +"RTN","TMGNDF0B",354,0) + new DIC,X,Y +"RTN","TMGNDF0B",355,0) + set DIC=.401 +"RTN","TMGNDF0B",356,0) + set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: " +"RTN","TMGNDF0B",357,0) + set DIC(0)="AEQM" +"RTN","TMGNDF0B",358,0) + do ^DIC +"RTN","TMGNDF0B",359,0) + if +Y'>0 goto MGBTDone +"RTN","TMGNDF0B",360,0) + set Template=+Y +"RTN","TMGNDF0B",361,0) + +"RTN","TMGNDF0B",362,0) + new TMGTOTAL set TMGTOTAL=$$CtTemplate^TMGMISC(Template) +"RTN","TMGNDF0B",363,0) + new StartTime set StartTime=$H +"RTN","TMGNDF0B",364,0) + new ProgressFn +"RTN","TMGNDF0B",365,0) + set ProgressFn="if count#10=1 do ProgressBar^TMGUSRIF(count,""Progress"",0,TMGTOTAL,,StartTime)" +"RTN","TMGNDF0B",366,0) + set IEN="" +"RTN","TMGNDF0B",367,0) + new count set count=0 +"RTN","TMGNDF0B",368,0) + for do quit:(+IEN'>0) +"RTN","TMGNDF0B",369,0) + . set IEN=$$IterTemplate^TMGMISC(Template,IEN) +"RTN","TMGNDF0B",370,0) + . if +IEN'>0 quit +"RTN","TMGNDF0B",371,0) + . ;"write IEN,! +"RTN","TMGNDF0B",372,0) + . do FillGenericName^TMGNDF1C(IEN) +"RTN","TMGNDF0B",373,0) + . set count=count+1 +"RTN","TMGNDF0B",374,0) + . if $get(ProgressFn)'="" do +"RTN","TMGNDF0B",375,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF0B",376,0) + . . xecute ProgressFn +"RTN","TMGNDF0B",377,0) + +"RTN","TMGNDF0B",378,0) +MGBTDone +"RTN","TMGNDF0B",379,0) + quit +"RTN","TMGNDF0B",380,0) + +"RTN","TMGNDF0B",381,0) + +"RTN","TMGNDF0B",382,0) +ShowTemplate +"RTN","TMGNDF0B",383,0) + ;"Purpose: To ask for a SORT TEMPLATE, and show the records for IENs stored there. +"RTN","TMGNDF0B",384,0) + +"RTN","TMGNDF0B",385,0) + new IEN,Template +"RTN","TMGNDF0B",386,0) + new DIC,X,Y +"RTN","TMGNDF0B",387,0) + set DIC=.401 +"RTN","TMGNDF0B",388,0) + set DIC("A")="Enter a SORT TEMPLATE to compile FDA entries from: " +"RTN","TMGNDF0B",389,0) + set DIC(0)="AEQM" +"RTN","TMGNDF0B",390,0) + do ^DIC +"RTN","TMGNDF0B",391,0) + if +Y'>0 goto STDone +"RTN","TMGNDF0B",392,0) + set Template=+Y +"RTN","TMGNDF0B",393,0) + +"RTN","TMGNDF0B",394,0) + set IEN="" +"RTN","TMGNDF0B",395,0) + new result,Array +"RTN","TMGNDF0B",396,0) + +"RTN","TMGNDF0B",397,0) + for do quit:(+IEN'>0) +"RTN","TMGNDF0B",398,0) + . set IEN=$$IterTemplate^TMGMISC(Template,IEN) +"RTN","TMGNDF0B",399,0) + . if +IEN'>0 quit +"RTN","TMGNDF0B",400,0) + . write "IEN: ",IEN,! +"RTN","TMGNDF0B",401,0) + . set result=$$GetDrugInfo^TMGNDF1A(IEN,.Array) +"RTN","TMGNDF0B",402,0) + . do Format2Drug(.Array) +"RTN","TMGNDF0B",403,0) + +"RTN","TMGNDF0B",404,0) +STDone +"RTN","TMGNDF0B",405,0) + quit +"RTN","TMGNDF0B",406,0) + +"RTN","TMGNDF0B",407,0) + +"RTN","TMGNDF0B",408,0) +CheckPtrs +"RTN","TMGNDF0B",409,0) + ;"Purpose: check import files for 0 values for pointers. +"RTN","TMGNDF0B",410,0) + +"RTN","TMGNDF0B",411,0) + new Info +"RTN","TMGNDF0B",412,0) + set Info(22706.1,.01)="0;1" +"RTN","TMGNDF0B",413,0) + set Info(22706.2,.01)="0;1" +"RTN","TMGNDF0B",414,0) + set Info(22706.2,3)="1;2" +"RTN","TMGNDF0B",415,0) + set Info(22706.4,.01)="0;1" +"RTN","TMGNDF0B",416,0) + set Info(22706.5,6)="0;7" +"RTN","TMGNDF0B",417,0) + set Info(22706.5,8)="0;9" +"RTN","TMGNDF0B",418,0) + set Info(22706.6,.01)="0;1" +"RTN","TMGNDF0B",419,0) + set Info(22706.7,.01)="0;1" +"RTN","TMGNDF0B",420,0) + +"RTN","TMGNDF0B",421,0) + set Info(22706.8,1)="0;2" +"RTN","TMGNDF0B",422,0) + set Info(22706.8,2)="0;3" +"RTN","TMGNDF0B",423,0) + set Info(22706.82,1)="0;2" +"RTN","TMGNDF0B",424,0) + ;"set Info(22703,.01)="0;1" ;"no pointers +"RTN","TMGNDF0B",425,0) + ;"set Info(22707,.01)="0;1" ;"no pointers +"RTN","TMGNDF0B",426,0) + ;"set Info(22705,.01)="0;1" ;"ignore this one +"RTN","TMGNDF0B",427,0) + ;"set Info(22711,.01)="0;1" +"RTN","TMGNDF0B",428,0) + +"RTN","TMGNDF0B",429,0) + new abort set abort=0 +"RTN","TMGNDF0B",430,0) + new file set file="" +"RTN","TMGNDF0B",431,0) + for set file=$order(Info(file)) quit:(file="")!abort do +"RTN","TMGNDF0B",432,0) + . new field set field="" +"RTN","TMGNDF0B",433,0) + . for set field=$order(Info(file,field)) quit:(field="")!abort do +"RTN","TMGNDF0B",434,0) + . . new node,pce +"RTN","TMGNDF0B",435,0) + . . set node=$piece($get(Info(file,field)),";",1) +"RTN","TMGNDF0B",436,0) + . . set pce=$piece($get(Info(file,field)),";",2) +"RTN","TMGNDF0B",437,0) + . . if (node="")!(pce="") quit +"RTN","TMGNDF0B",438,0) + . . new Itr,IEN +"RTN","TMGNDF0B",439,0) + . . write !,"Scanning file ",file,! +"RTN","TMGNDF0B",440,0) + . . set IEN=$$ItrInit^TMGITR(file,.Itr) +"RTN","TMGNDF0B",441,0) + . . do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF0B",442,0) + . . if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF0B",443,0) + . . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF0B",444,0) + . . . if $piece($get(^TMG(file,IEN,node)),"^",pce)=0 do +"RTN","TMGNDF0B",445,0) + . . . . write !,file,", IEN: #",IEN," has 0 pointer for the ",field,"field.",! +"RTN","TMGNDF0B",446,0) + +"RTN","TMGNDF0B",447,0) + +"RTN","TMGNDF0B",448,0) + quit +"RTN","TMGNDF0C") +0^37^B5013 +"RTN","TMGNDF0C",1,0) +TMGNDF2B ;TMG/kst/FDA Import: Ensure DRUG INGREDIENTS ;03/25/06 +"RTN","TMGNDF0C",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF0C",3,0) + +"RTN","TMGNDF0C",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF0C",5,0) + ;" -- FILLING DRUG INGREDIENTS FILE WITH NEW VALUES +"RTN","TMGNDF0C",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF0C",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF0C",8,0) + ;"11-21-2006 +"RTN","TMGNDF0C",9,0) + +"RTN","TMGNDF0C",10,0) + ;"======================================================================= +"RTN","TMGNDF0C",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF0C",12,0) + ;"======================================================================= +"RTN","TMGNDF0C",13,0) + ;"Menu -- Provide menu to entry points of main routines +"RTN","TMGNDF0C",14,0) + ;"======================================================================= +"RTN","TMGNDF0C",15,0) + ;"CheckIngredients -- To cycle through ingredients and ensure that there is an extry in the +"RTN","TMGNDF0C",16,0) + ;" DRUG INGREDIENTS file. This has to be an interactive process. +"RTN","TMGNDF0C",17,0) + +"RTN","TMGNDF0C",18,0) + ;"======================================================================= +"RTN","TMGNDF0C",19,0) + ;" Private Functions. +"RTN","TMGNDF0C",20,0) + ;"======================================================================= +"RTN","TMGNDF0C",21,0) + ;"ShowInstructions +"RTN","TMGNDF0C",22,0) + ;"LookupRx(ingredient) +"RTN","TMGNDF0C",23,0) + ;"ShowMatches(Array,max,Label) +"RTN","TMGNDF0C",24,0) + ;"AddRangeMatch(ScanArray,Label,StartN,EndN) +"RTN","TMGNDF0C",25,0) + ;"AddMatch(ScanArray,Label,number) +"RTN","TMGNDF0C",26,0) + ;"ULRangeMatch(ScanArray,StartN,EndN) +"RTN","TMGNDF0C",27,0) + ;"ULMatch(ScanArray,number) +"RTN","TMGNDF0C",28,0) + ;"AddOneIngredient(Name) +"RTN","TMGNDF0C",29,0) + ;"FindIgdMatch(Name,Interactive) +"RTN","TMGNDF0C",30,0) + ;"DoAddIgd(Name,ParentIEN) +"RTN","TMGNDF0C",31,0) + +"RTN","TMGNDF0C",32,0) + ;"======================================================================= +"RTN","TMGNDF0C",33,0) + ;"======================================================================= +"RTN","TMGNDF0C",34,0) +Menu +"RTN","TMGNDF0C",35,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF0C",36,0) + +"RTN","TMGNDF0C",37,0) + new Menu,UsrSlct +"RTN","TMGNDF0C",38,0) + set Menu(0)="Pick Option for Checking Import Ingredients (0C)" +"RTN","TMGNDF0C",39,0) + set Menu(1)="Check for NEW ingredients to ADD."_$char(9)_"CheckIngredients" +"RTN","TMGNDF0C",40,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF0C",41,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF0C",42,0) + +"RTN","TMGNDF0C",43,0) +MC1 write # +"RTN","TMGNDF0C",44,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF0C",45,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF0C",46,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF0C",47,0) + +"RTN","TMGNDF0C",48,0) + if UsrSlct="CheckIngredients" do CheckIngredients goto MC1 +"RTN","TMGNDF0C",49,0) + if UsrSlct="Prev" goto Menu^TMGNDF0B ;"quit can occur from there... +"RTN","TMGNDF0C",50,0) + if UsrSlct="Next" goto Menu^TMGNDF1A ;"quit can occur from there... +"RTN","TMGNDF0C",51,0) + goto MC1 +"RTN","TMGNDF0C",52,0) + +"RTN","TMGNDF0C",53,0) +MCDone +"RTN","TMGNDF0C",54,0) + quit +"RTN","TMGNDF0C",55,0) + +"RTN","TMGNDF0C",56,0) + +"RTN","TMGNDF0C",57,0) +CheckIngredients +"RTN","TMGNDF0C",58,0) + ;"Purpose: To cycle through ingredients and ensure that there is an extry in the +"RTN","TMGNDF0C",59,0) + ;" DRUG INGREDIENTS file. This has to be an interactive process. +"RTN","TMGNDF0C",60,0) + ;"Input: none +"RTN","TMGNDF0C",61,0) + ;"Results: none +"RTN","TMGNDF0C",62,0) + ;"Note: if record in 22706.9 (TMG FDA IMPORT COMPILED) for a given listing +"RTN","TMGNDF0C",63,0) + ;" has been marked for SKIPPING, or DONE ADDING, then listing will be skipped. +"RTN","TMGNDF0C",64,0) + +"RTN","TMGNDF0C",65,0) + new Answers,index,ingredient +"RTN","TMGNDF0C",66,0) + write "Collecting list of INGREDIENTS that need to be added to database...",! +"RTN","TMGNDF0C",67,0) + new count set count=1 +"RTN","TMGNDF0C",68,0) + new MissingArray +"RTN","TMGNDF0C",69,0) + +"RTN","TMGNDF0C",70,0) + new Itr,IEN +"RTN","TMGNDF0C",71,0) + new abort set abort=0 +"RTN","TMGNDF0C",72,0) + set index=$$ItrInit^TMGITR(22706.4,.Itr) +"RTN","TMGNDF0C",73,0) + do PrepProgress^TMGITR(.Itr,20,0,"index") +"RTN","TMGNDF0C",74,0) + if index'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.index)'>0)!abort +"RTN","TMGNDF0C",75,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF0C",76,0) + . new listingIEN set listingIEN=+$piece($get(^TMG(22706.4,index,0)),"^",1) ;"Not required... +"RTN","TMGNDF0C",77,0) + . if (listingIEN>0),$piece($get(^TMG(22706.9,listingIEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF0C",78,0) + . set ingredient=$piece($get(^TMG(22706.4,index,0)),"^",4) +"RTN","TMGNDF0C",79,0) + . set ingredient=$extract(ingredient,1,64) +"RTN","TMGNDF0C",80,0) + . if $get(Answers(ingredient))="" do +"RTN","TMGNDF0C",81,0) + . . set Y=$$LookupRx(ingredient) +"RTN","TMGNDF0C",82,0) + . . if +Y'>0 set MissingArray(ingredient)="" +"RTN","TMGNDF0C",83,0) + . . if +Y>0 set Answers(ingredient)=+Y +"RTN","TMGNDF0C",84,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF0C",85,0) + +"RTN","TMGNDF0C",86,0) + do HandleMissing(.MissingArray) +"RTN","TMGNDF0C",87,0) + quit +"RTN","TMGNDF0C",88,0) + +"RTN","TMGNDF0C",89,0) + +"RTN","TMGNDF0C",90,0) +Check1(IEN) ;"finish later +"RTN","TMGNDF0C",91,0) + ;"Purpose: to scan the ingredients for 1 entry in 22706.9 +"RTN","TMGNDF0C",92,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF0C",93,0) + +"RTN","TMGNDF0C",94,0) + new ingredient +"RTN","TMGNDF0C",95,0) + new MissingArray +"RTN","TMGNDF0C",96,0) + +"RTN","TMGNDF0C",97,0) + new fdaIEN,Y +"RTN","TMGNDF0C",98,0) + set fdaIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1) +"RTN","TMGNDF0C",99,0) + set ingredient=$piece($get(^TMG(22706.4,fdaIEN,0)),"^",4) +"RTN","TMGNDF0C",100,0) + set ingredient=$extract(ingredient,1,64) +"RTN","TMGNDF0C",101,0) + set Y=$$LookupRx(ingredient) +"RTN","TMGNDF0C",102,0) + if +Y'>0 do +"RTN","TMGNDF0C",103,0) + . set MissingArray(ingredient)="" +"RTN","TMGNDF0C",104,0) + . do HandleMissing(.MissingArray) +"RTN","TMGNDF0C",105,0) + quit +"RTN","TMGNDF0C",106,0) + +"RTN","TMGNDF0C",107,0) + +"RTN","TMGNDF0C",108,0) +HandleMissing(MissingArray) +"RTN","TMGNDF0C",109,0) + ;"Purpose: To handle and process the array of missing ingredients +"RTN","TMGNDF0C",110,0) + ;"Input: MissingArray(ingredient)="" +"RTN","TMGNDF0C",111,0) + ;" MissingArray(ingredient)="" +"RTN","TMGNDF0C",112,0) + ;"Result: none +"RTN","TMGNDF0C",113,0) + +"RTN","TMGNDF0C",114,0) + new max set max=$$ListCt^TMGMISC("MissingArray") +"RTN","TMGNDF0C",115,0) + write !,"Found ",max," missing INGREDIENTS.",! +"RTN","TMGNDF0C",116,0) + +"RTN","TMGNDF0C",117,0) + new ScanArray,count +"RTN","TMGNDF0C",118,0) + write "Summarizing list...",! +"RTN","TMGNDF0C",119,0) + set count=1 +"RTN","TMGNDF0C",120,0) + set ingredient="" +"RTN","TMGNDF0C",121,0) + for set ingredient=$order(MissingArray(ingredient)) quit:(ingredient="") do +"RTN","TMGNDF0C",122,0) + . if ingredient["ALLERGENIC EXTRACT" do +"RTN","TMGNDF0C",123,0) + . . set Y=$$DoAddIgd(ingredient,0) +"RTN","TMGNDF0C",124,0) + . else do +"RTN","TMGNDF0C",125,0) + . . set Y=$$FindIgdMatch(ingredient,0) +"RTN","TMGNDF0C",126,0) + . . if +Y>0 set ScanArray("MATCHED",count,ingredient)=Y +"RTN","TMGNDF0C",127,0) + . . else set ScanArray("UNMATCHED",count,ingredient)="" +"RTN","TMGNDF0C",128,0) + . set count=count+1 +"RTN","TMGNDF0C",129,0) + . set ingredient=$order(MissingArray(ingredient)) +"RTN","TMGNDF0C",130,0) + write ! +"RTN","TMGNDF0C",131,0) + +"RTN","TMGNDF0C",132,0) + new done set done=0 +"RTN","TMGNDF0C",133,0) + new input set input="R" +"RTN","TMGNDF0C",134,0) + new displaySet set displaySet="MATCHED" +"RTN","TMGNDF0C",135,0) + for do quit:(done=1) +"RTN","TMGNDF0C",136,0) + . if input="R" do +"RTN","TMGNDF0C",137,0) + . . write !!,"Now pick which potential matches are ",displaySet,! +"RTN","TMGNDF0C",138,0) + . . do ShowMatches(.ScanArray,max,displaySet) +"RTN","TMGNDF0C",139,0) + . write " (R to refresh, C custom handle, UL to UnLink)",! +"RTN","TMGNDF0C",140,0) + . write " (# or #-#, ^ to continue, ? for instructions, " +"RTN","TMGNDF0C",141,0) + . if displaySet="MATCHED" write "U show Unmatched)",! +"RTN","TMGNDF0C",142,0) + . else write "M show Matched)",! +"RTN","TMGNDF0C",143,0) + . write "Enter number(s) to ACCEPT (or codes listed above): ?//" +"RTN","TMGNDF0C",144,0) + . read input,! +"RTN","TMGNDF0C",145,0) + . if input="" set input="?" +"RTN","TMGNDF0C",146,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF0C",147,0) + . if input="^" set done=1 +"RTN","TMGNDF0C",148,0) + . if (input="U") do +"RTN","TMGNDF0C",149,0) + . . set displaySet="UNMATCHED" +"RTN","TMGNDF0C",150,0) + . . set input="R" +"RTN","TMGNDF0C",151,0) + . if (input="M") do +"RTN","TMGNDF0C",152,0) + . . set displaySet="MATCHED" +"RTN","TMGNDF0C",153,0) + . . set input="R" +"RTN","TMGNDF0C",154,0) + . if (input="A") do +"RTN","TMGNDF0C",155,0) + . . set displaySet="MATCHED" +"RTN","TMGNDF0C",156,0) + . . set input="R" +"RTN","TMGNDF0C",157,0) + . if (input="?") do +"RTN","TMGNDF0C",158,0) + . . do ShowInstructions +"RTN","TMGNDF0C",159,0) + . . set input="R" +"RTN","TMGNDF0C",160,0) + . if +input=input do +"RTN","TMGNDF0C",161,0) + . . do AddMatch(.ScanArray,displaySet,+input) +"RTN","TMGNDF0C",162,0) + . . set input="R" +"RTN","TMGNDF0C",163,0) + . if input["-" do +"RTN","TMGNDF0C",164,0) + . . new N1,N2 +"RTN","TMGNDF0C",165,0) + . . set N1=$piece(input,"-",1) +"RTN","TMGNDF0C",166,0) + . . set N2=$piece(input,"-",2) +"RTN","TMGNDF0C",167,0) + . . do AddRangeMatch(.ScanArray,displaySet,N1,N2) +"RTN","TMGNDF0C",168,0) + . . set input="R" +"RTN","TMGNDF0C",169,0) + . if input="C" do +"RTN","TMGNDF0C",170,0) + . . read "Enter number for Custom Handling: ",input,! +"RTN","TMGNDF0C",171,0) + . . if +input'=input quit +"RTN","TMGNDF0C",172,0) + . . set ingredient=$order(ScanArray(displaySet,+input,"")) +"RTN","TMGNDF0C",173,0) + . . set Y=$$AddOneIngredient(ingredient) +"RTN","TMGNDF0C",174,0) + . . if +Y>0 kill ScanArray(displaySet,+input,ingredient) +"RTN","TMGNDF0C",175,0) + . . set input="R" +"RTN","TMGNDF0C",176,0) + . if input="UL" do +"RTN","TMGNDF0C",177,0) + . . read "Enter number to Unlink (# or #-#): ",input,! +"RTN","TMGNDF0C",178,0) + . . if +input=input do +"RTN","TMGNDF0C",179,0) + . . . do ULMatch(.ScanArray,input) +"RTN","TMGNDF0C",180,0) + . . else if input["-" do +"RTN","TMGNDF0C",181,0) + . . . new N1,N2 +"RTN","TMGNDF0C",182,0) + . . . set N1=$piece(input,"-",1) +"RTN","TMGNDF0C",183,0) + . . . set N2=$piece(input,"-",2) +"RTN","TMGNDF0C",184,0) + . . . do ULRangeMatch(.ScanArray,N1,N2) +"RTN","TMGNDF0C",185,0) + . . set input="R" +"RTN","TMGNDF0C",186,0) + +"RTN","TMGNDF0C",187,0) + quit +"RTN","TMGNDF0C",188,0) + +"RTN","TMGNDF0C",189,0) + +"RTN","TMGNDF0C",190,0) +ShowInstructions +"RTN","TMGNDF0C",191,0) + write !!,"INSTRUCTIONS:",! +"RTN","TMGNDF0C",192,0) + write "----------------------------------------------------------------------------",! +"RTN","TMGNDF0C",193,0) + write "Before adding any medicines or drugs into the database, the underlying",! +"RTN","TMGNDF0C",194,0) + write "INGREDIENTS must be entered. Each drug will have one or more ingredients",! +"RTN","TMGNDF0C",195,0) + write "that will be linked to these new entries. DRUG INTERACTIONS are based on",! +"RTN","TMGNDF0C",196,0) + write "ingredients rather than on the name of the drug itself.",!! +"RTN","TMGNDF0C",197,0) + write "Often, the name supplied is more specific than an entry already in the",! +"RTN","TMGNDF0C",198,0) + write "database. For example:",! +"RTN","TMGNDF0C",199,0) + write " CAFFEINE <-- already in database",! +"RTN","TMGNDF0C",200,0) + write " CAFFEINE CITRATE <-- new import",! +"RTN","TMGNDF0C",201,0) + write "Clearly, these two compounds are related, and it could be said that:",! +"RTN","TMGNDF0C",202,0) + write "CAFFEINE is the PRIMARY INGREDIENT in CAFFEINE CITRATE, or as will be",! +"RTN","TMGNDF0C",203,0) + write "seen shortly, summarized like this:",! +"RTN","TMGNDF0C",204,0) + write "CAFFEINE <-- CAFFEINE CITRATE",!! +"RTN","TMGNDF0C",205,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF0C",206,0) + write "What follows next will be a listing of all the ingredients to be added into",! +"RTN","TMGNDF0C",207,0) + write "the database. The computer will have made a best guess at linking the new",! +"RTN","TMGNDF0C",208,0) + write "entries to parent compounds (i.e. PRIMARY INGREDIENTS). But not all of these",! +"RTN","TMGNDF0C",209,0) + write "guesses will be correct. IT IS YOUR JOB TO SCREEN THESE.",!! +"RTN","TMGNDF0C",210,0) + write "If a linkage or matching is correct, just type in its number to ACCEPT it.",! +"RTN","TMGNDF0C",211,0) + write "If a linkage or matching is NOT correct, it shoud be UNLINKED.",! +"RTN","TMGNDF0C",212,0) + write "If you feel you can search for a better match, attempt a CUSTOM handling.",!! +"RTN","TMGNDF0C",213,0) + write "When you are done with accepting or rejecting the computers matches, you should",! +"RTN","TMGNDF0C",214,0) + write "then process all the UNMATCHED entries, by selecting 'U' to show UNMATCHED.",! +"RTN","TMGNDF0C",215,0) + write "These very likely may all be accepted at once by entering a range number (e.g.",! +"RTN","TMGNDF0C",216,0) + write "1-1000).",!! +"RTN","TMGNDF0C",217,0) + write "When you have completed processing all the matched and unmatched entries, enter",! +"RTN","TMGNDF0C",218,0) + write "^ to continue.",! +"RTN","TMGNDF0C",219,0) + +"RTN","TMGNDF0C",220,0) + new temp +"RTN","TMGNDF0C",221,0) + read "Press to continue.",temp:$get(DTIME,3600),! +"RTN","TMGNDF0C",222,0) + quit +"RTN","TMGNDF0C",223,0) + +"RTN","TMGNDF0C",224,0) + +"RTN","TMGNDF0C",225,0) +LookupRx(ingredient) +"RTN","TMGNDF0C",226,0) + ;"Purpose: To look up ingredient in the DRUG INGREDIENTS file +"RTN","TMGNDF0C",227,0) + ;"Input: ingredient -- the name of the ingredient to lookup +"RTN","TMGNDF0C",228,0) + ;"Result: -1 if not fount, or 1234^ingredientname format +"RTN","TMGNDF0C",229,0) + +"RTN","TMGNDF0C",230,0) + new DIC,X,Y +"RTN","TMGNDF0C",231,0) + set DIC=50.416 +"RTN","TMGNDF0C",232,0) + set DIC(0)="M" +"RTN","TMGNDF0C",233,0) + new TMGROOT,TMGMSG +"RTN","TMGNDF0C",234,0) + +"RTN","TMGNDF0C",235,0) + set Y=-1 +"RTN","TMGNDF0C",236,0) + do FIND^DIC(50.416,,".01E","M",ingredient,"*",,,,"TMGROOT","TMGMSG") +"RTN","TMGNDF0C",237,0) + if +$get(TMGROOT("DILIST",0))>0 do +"RTN","TMGNDF0C",238,0) + . set Y=$get(TMGROOT("DILIST",2,1),-1)_"^"_$get(TMGROOT("DILIST",1,1)) +"RTN","TMGNDF0C",239,0) + . if +Y'>0 do +"RTN","TMGNDF0C",240,0) + . . set X=ingredient +"RTN","TMGNDF0C",241,0) + . . do ^DIC +"RTN","TMGNDF0C",242,0) + +"RTN","TMGNDF0C",243,0) + quit Y +"RTN","TMGNDF0C",244,0) + +"RTN","TMGNDF0C",245,0) + +"RTN","TMGNDF0C",246,0) +ShowMatches(Array,max,Label) +"RTN","TMGNDF0C",247,0) + new count,ingredient,value +"RTN","TMGNDF0C",248,0) + new someShown set someShown=0 +"RTN","TMGNDF0C",249,0) + for count=1:1:max do +"RTN","TMGNDF0C",250,0) + . set ingredient=$order(ScanArray(Label,count,"")) +"RTN","TMGNDF0C",251,0) + . if ingredient="" quit +"RTN","TMGNDF0C",252,0) + . set someShown=1 +"RTN","TMGNDF0C",253,0) + . set value=$get(ScanArray(Label,count,ingredient)) +"RTN","TMGNDF0C",254,0) + . write " ",count,". " +"RTN","TMGNDF0C",255,0) + . if +value>0 write $piece(value,"^",2) +"RTN","TMGNDF0C",256,0) + . else write "(no parent ingredient)" +"RTN","TMGNDF0C",257,0) + . write " <--- ",ingredient,! +"RTN","TMGNDF0C",258,0) + if someShown=0 do +"RTN","TMGNDF0C",259,0) + . write " --- (List is Empty) ---",! +"RTN","TMGNDF0C",260,0) + +"RTN","TMGNDF0C",261,0) + quit +"RTN","TMGNDF0C",262,0) + +"RTN","TMGNDF0C",263,0) +AddRangeMatch(ScanArray,Label,StartN,EndN) +"RTN","TMGNDF0C",264,0) + new num +"RTN","TMGNDF0C",265,0) + for num=StartN:1:EndN do +"RTN","TMGNDF0C",266,0) + . do AddMatch(.ScanArray,Label,num) +"RTN","TMGNDF0C",267,0) + quit +"RTN","TMGNDF0C",268,0) + +"RTN","TMGNDF0C",269,0) +AddMatch(ScanArray,Label,number) +"RTN","TMGNDF0C",270,0) + new ingredient,Y +"RTN","TMGNDF0C",271,0) + set ingredient=$order(ScanArray(Label,number,"")) +"RTN","TMGNDF0C",272,0) + set Y=$get(ScanArray(Label,number,ingredient)) +"RTN","TMGNDF0C",273,0) + if (ingredient'="") do +"RTN","TMGNDF0C",274,0) + . set Y=$$DoAddIgd(ingredient,Y) +"RTN","TMGNDF0C",275,0) + . kill ScanArray(Label,number,ingredient) +"RTN","TMGNDF0C",276,0) + quit +"RTN","TMGNDF0C",277,0) + +"RTN","TMGNDF0C",278,0) +ULRangeMatch(ScanArray,StartN,EndN) +"RTN","TMGNDF0C",279,0) + new num +"RTN","TMGNDF0C",280,0) + for num=StartN:1:EndN do +"RTN","TMGNDF0C",281,0) + . do ULMatch(.ScanArray,num) +"RTN","TMGNDF0C",282,0) + quit +"RTN","TMGNDF0C",283,0) + +"RTN","TMGNDF0C",284,0) +ULMatch(ScanArray,number) +"RTN","TMGNDF0C",285,0) + new ingredient,Y +"RTN","TMGNDF0C",286,0) + set ingredient=$order(ScanArray("MATCHED",number,"")) +"RTN","TMGNDF0C",287,0) + if (ingredient'="") set ScanArray("UNMATCHED",number,ingredient)="" +"RTN","TMGNDF0C",288,0) + kill ScanArray("MATCHED",number) +"RTN","TMGNDF0C",289,0) + quit +"RTN","TMGNDF0C",290,0) + +"RTN","TMGNDF0C",291,0) + +"RTN","TMGNDF0C",292,0) +AddOneIngredient(Name) +"RTN","TMGNDF0C",293,0) + ;"Purpose: To add ingredient name to the DRUG INGREDIENTS -- will try to find a parent +"RTN","TMGNDF0C",294,0) + ;" ingredient interactively +"RTN","TMGNDF0C",295,0) + ;"Input: Name -- the name of the ingredient to be added. +"RTN","TMGNDF0C",296,0) + ;"Output: DRUG INGREDIENTS file will have records added. +"RTN","TMGNDF0C",297,0) + ;"Results: Will return record number (IEN) of newly added record, or 0 if error +"RTN","TMGNDF0C",298,0) + ;"Note: This function assumes that the ingredient does not already exist in the file. +"RTN","TMGNDF0C",299,0) + +"RTN","TMGNDF0C",300,0) + new result set result=0 +"RTN","TMGNDF0C",301,0) + if $get(Name)="" goto AOIDone +"RTN","TMGNDF0C",302,0) + +"RTN","TMGNDF0C",303,0) + new Y +"RTN","TMGNDF0C",304,0) + set Y=$$FindIgdMatch(Name,1) +"RTN","TMGNDF0C",305,0) + +"RTN","TMGNDF0C",306,0) + new % set %=1 ;"1=YES +"RTN","TMGNDF0C",307,0) + if +Y'>0 do +"RTN","TMGNDF0C",308,0) + . write "A parent primary ingredient was not found for ",! +"RTN","TMGNDF0C",309,0) + . write " ",Name," <-- UNMATCHED COMPOUND (Add Now)",! +"RTN","TMGNDF0C",310,0) + . write "Add Now? " +"RTN","TMGNDF0C",311,0) + . do YN^DICN ;"returns result in % +"RTN","TMGNDF0C",312,0) + . write ! +"RTN","TMGNDF0C",313,0) + +"RTN","TMGNDF0C",314,0) + if %=1 do +"RTN","TMGNDF0C",315,0) + . set result=$$DoAddIgd(Name,Y) +"RTN","TMGNDF0C",316,0) + +"RTN","TMGNDF0C",317,0) +AOIDone +"RTN","TMGNDF0C",318,0) + quit result +"RTN","TMGNDF0C",319,0) + +"RTN","TMGNDF0C",320,0) + +"RTN","TMGNDF0C",321,0) +FindIgdMatch(Name,Interactive) +"RTN","TMGNDF0C",322,0) + ;"Purpose: To find a match for Name from DRUG INGREDIENTS +"RTN","TMGNDF0C",323,0) + ;"Input: Name -- the name of the ingredient to be added. +"RTN","TMGNDF0C",324,0) + ;" Interactive -- OPTIONAL, default=1 +"RTN","TMGNDF0C",325,0) + ;" if 1 then user is asked question, +"RTN","TMGNDF0C",326,0) + ;" if 0 then best guess is returned. +"RTN","TMGNDF0C",327,0) + ;"Results: -1 if not found +"RTN","TMGNDF0C",328,0) + ;" or 1234^Name +"RTN","TMGNDF0C",329,0) + +"RTN","TMGNDF0C",330,0) + if $get(Name)="" goto FMDone +"RTN","TMGNDF0C",331,0) + +"RTN","TMGNDF0C",332,0) + set Interactive=$get(Interactive,1) +"RTN","TMGNDF0C",333,0) + +"RTN","TMGNDF0C",334,0) + if Interactive do +"RTN","TMGNDF0C",335,0) + . write "------------------------------------------",! +"RTN","TMGNDF0C",336,0) + . write "Looking for a parent, PRIMARY INGREDIENT for: ",! +"RTN","TMGNDF0C",337,0) + . write " ",Name," <-- UNMATCHED COMPOUND",! +"RTN","TMGNDF0C",338,0) + +"RTN","TMGNDF0C",339,0) + new DIC,X,Y,% +"RTN","TMGNDF0C",340,0) + set DIC=50.416 +"RTN","TMGNDF0C",341,0) + set DIC(0)="M" +"RTN","TMGNDF0C",342,0) + +"RTN","TMGNDF0C",343,0) + new parent set parent=$$Substitute^TMGSTUTL(Name,", "," ") +"RTN","TMGNDF0C",344,0) + set parent=$translate(parent,","," ") +"RTN","TMGNDF0C",345,0) + for do quit:(+Y>0)!(parent="") +"RTN","TMGNDF0C",346,0) + . new temp +"RTN","TMGNDF0C",347,0) + . set temp=$$ParseLast^TMGMISC(parent,.parent," ") ;"cut last word off from drug name +"RTN","TMGNDF0C",348,0) + . set X=$$Trim^TMGSTUTL(parent) +"RTN","TMGNDF0C",349,0) + . do ^DIC +"RTN","TMGNDF0C",350,0) + . if Interactive'=1 quit +"RTN","TMGNDF0C",351,0) + . if +Y>0 do +"RTN","TMGNDF0C",352,0) + . . ;"At this point, we either have possible match (+Y>0), or no match (parent="") +"RTN","TMGNDF0C",353,0) + . . write " '"_$piece(Y,"^",2)_"' <-- ?? MATCH ??",! +"RTN","TMGNDF0C",354,0) + . . write "Use this as the PRIMARY INGREDIENT? " +"RTN","TMGNDF0C",355,0) + . . set %=1 ;"1=YES +"RTN","TMGNDF0C",356,0) + . . do YN^DICN ;"returns result in % +"RTN","TMGNDF0C",357,0) + . . write ! +"RTN","TMGNDF0C",358,0) + . . if %'=1 set Y=0 +"RTN","TMGNDF0C",359,0) + . else do +"RTN","TMGNDF0C",360,0) + . . if X'="" write " ",X," <-- (not found).",! +"RTN","TMGNDF0C",361,0) + +"RTN","TMGNDF0C",362,0) + if (+Y'>0)&(Interactive) do +"RTN","TMGNDF0C",363,0) + . write " No match found. Let's try a generic lookup..." +"RTN","TMGNDF0C",364,0) + . set DIC(0)="AEQM" +"RTN","TMGNDF0C",365,0) + . set DIC("A")=" LOOKUP: Enter PRIMARY INGREDIENT (or ^ to continue) ^// " +"RTN","TMGNDF0C",366,0) + . do ^DIC +"RTN","TMGNDF0C",367,0) + . write ! +"RTN","TMGNDF0C",368,0) + +"RTN","TMGNDF0C",369,0) +FMDone +"RTN","TMGNDF0C",370,0) + quit Y +"RTN","TMGNDF0C",371,0) + +"RTN","TMGNDF0C",372,0) + +"RTN","TMGNDF0C",373,0) +DoAddIgd(Name,ParentIEN) +"RTN","TMGNDF0C",374,0) + ;"Purpose: to do the actual addition to the DRUG INGREDIENTS file +"RTN","TMGNDF0C",375,0) + ;"Input: Name -- the string of the drug name +"RTN","TMGNDF0C",376,0) + ;" ParentIEN -- a value as returned from DIC (i.e. 1234^Name) +"RTN","TMGNDF0C",377,0) + ;"Results: IEN of added value, or 0 if not added. +"RTN","TMGNDF0C",378,0) + +"RTN","TMGNDF0C",379,0) + new result set result=0 +"RTN","TMGNDF0C",380,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF0C",381,0) + new PrimIngred set PrimIngred=$get(ParentIEN) +"RTN","TMGNDF0C",382,0) + set TMGFDA(50.416,"+1,",.01)=$extract(Name,1,64) +"RTN","TMGNDF0C",383,0) + if +PrimIngred>0 set TMGFDA(50.416,"+1,",2)=$piece(PrimIngred,"^",1) +"RTN","TMGNDF0C",384,0) + do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF0C",385,0) + if $data(TMGMSG)&(+$get(Quiet)=0) do +"RTN","TMGNDF0C",386,0) + . new PriorErrorFound +"RTN","TMGNDF0C",387,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF0C",388,0) + set result=$get(TMGIEN(1)) +"RTN","TMGNDF0C",389,0) + +"RTN","TMGNDF0C",390,0) + quit result +"RTN","TMGNDF0C",391,0) + +"RTN","TMGNDF1A") +0^38^B9060 +"RTN","TMGNDF1A",1,0) +TMGNDF1A ;TMG/kst/FDA Import: Compile FDA files into import file ;03/25/06 +"RTN","TMGNDF1A",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF1A",3,0) + +"RTN","TMGNDF1A",4,0) + ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF1A",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF1A",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF1A",7,0) + ;"11-21-2006 +"RTN","TMGNDF1A",8,0) + +"RTN","TMGNDF1A",9,0) + ;"======================================================================= +"RTN","TMGNDF1A",10,0) + ;" API -- Public Functions. +"RTN","TMGNDF1A",11,0) + ;"======================================================================= +"RTN","TMGNDF1A",12,0) + ;"Menu +"RTN","TMGNDF1A",13,0) + ;"======================================================================= +"RTN","TMGNDF1A",14,0) + ;"Compile -- collect relevent data from the TMG FDA * files and put into one record +"RTN","TMGNDF1A",15,0) + +"RTN","TMGNDF1A",16,0) + ;"GetpVAPIndex() -- return a pointer to an index of the VAProduct file +"RTN","TMGNDF1A",17,0) + ;"ReCompOne(IEN22706d9) +"RTN","TMGNDF1A",18,0) + +"RTN","TMGNDF1A",19,0) + ;"======================================================================= +"RTN","TMGNDF1A",20,0) + ;" Private Functions. +"RTN","TMGNDF1A",21,0) + ;"======================================================================= +"RTN","TMGNDF1A",22,0) + ;"CompileOne(IEN,Quiet,pIndex,ExclArray,OnlyIfNew) +"RTN","TMGNDF1A",23,0) + ;"$$MakeCompRec(Array,Quiet) +"RTN","TMGNDF1A",24,0) + ;"StuffCompRec(IEN,Array,Quiet,ExclArray,Option) +"RTN","TMGNDF1A",25,0) + ;"FillGenericName(IEN) +"RTN","TMGNDF1A",26,0) + ;"MakeGenericName(IEN) +"RTN","TMGNDF1A",27,0) + +"RTN","TMGNDF1A",28,0) + ;"GetVADrugInfo(IEN,Array) +"RTN","TMGNDF1A",29,0) + ;"$$GetDrugInfo(IEN,Array,pIndex,noLink) +"RTN","TMGNDF1A",30,0) + +"RTN","TMGNDF1A",31,0) + ;"GetSingleRec(File,GRef,IEN,Array) +"RTN","TMGNDF1A",32,0) + ;"GetMultRec(File,GRef,IEN,Array) +"RTN","TMGNDF1A",33,0) + ;"LinkToVAProd(Array,Results) +"RTN","TMGNDF1A",34,0) + ;"Link2VAProd(Array,Results,pIndex) +"RTN","TMGNDF1A",35,0) + ;"CheckLink(IEN,Array,Results) +"RTN","TMGNDF1A",36,0) + ;"CheckNDCLink(IEN,Array,Results) +"RTN","TMGNDF1A",37,0) + ;"IndexVAProd(pArray) +"RTN","TMGNDF1A",38,0) + ;"GetIndexList(Ingredient,pIndex,pArray) +"RTN","TMGNDF1A",39,0) + +"RTN","TMGNDF1A",40,0) + ;"FixGenerics +"RTN","TMGNDF1A",41,0) + ;"ScanFor(Name,Array) +"RTN","TMGNDF1A",42,0) + ;"FindSimNames(Name,Array) +"RTN","TMGNDF1A",43,0) + +"RTN","TMGNDF1A",44,0) + ;"======================================================================= +"RTN","TMGNDF1A",45,0) + ;"======================================================================= +"RTN","TMGNDF1A",46,0) +Menu +"RTN","TMGNDF1A",47,0) + ;"Purpose: To give an interactive menu +"RTN","TMGNDF1A",48,0) + +"RTN","TMGNDF1A",49,0) + new Menu,UsrSlct +"RTN","TMGNDF1A",50,0) + set Menu(0)="Pick Option for Compiling FDA Imported Data (1A)" +"RTN","TMGNDF1A",51,0) + set Menu(1)="Compile/Refresh ALL FDA data into IMPORT file"_$char(9)_"CompileAll" +"RTN","TMGNDF1A",52,0) + set Menu(2)="Compile/Refresh JUST NEW FDA data into IMPORT file"_$char(9)_"CompileNew" +"RTN","TMGNDF1A",53,0) + set Menu(3)="Compile/Refresh ONE chosen FDA entry into IMPORT file"_$char(9)_"CompileChosen" +"RTN","TMGNDF1A",54,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF1A",55,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF1A",56,0) + +"RTN","TMGNDF1A",57,0) +CD1 +"RTN","TMGNDF1A",58,0) + write # +"RTN","TMGNDF1A",59,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF1A",60,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF1A",61,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF1A",62,0) + +"RTN","TMGNDF1A",63,0) + if UsrSlct="Prev" goto Menu^TMGNDF0C ;"quit can occur from there... +"RTN","TMGNDF1A",64,0) + if UsrSlct="Next" goto Menu^TMGNDF1D ;"quit can occur from there... +"RTN","TMGNDF1A",65,0) + if UsrSlct="CompileAll" do Compile(0) goto CD1 +"RTN","TMGNDF1A",66,0) + if UsrSlct="CompileNew" do Compile(2) goto CD1 +"RTN","TMGNDF1A",67,0) + if UsrSlct="CompileChosen" do Compile(1) goto CD1 +"RTN","TMGNDF1A",68,0) + goto CDDone +"RTN","TMGNDF1A",69,0) +CDDone +"RTN","TMGNDF1A",70,0) + quit +"RTN","TMGNDF1A",71,0) + +"RTN","TMGNDF1A",72,0) + ;"======================================================================= +"RTN","TMGNDF1A",73,0) + +"RTN","TMGNDF1A",74,0) +Compile(Option) +"RTN","TMGNDF1A",75,0) + ;"Purpose: To collect relevent data from the TMG FDA * files and put into one record +"RTN","TMGNDF1A",76,0) + ;"Input: Option: OPTIONAL. Default=0. +"RTN","TMGNDF1A",77,0) + ;" if 0, all records are added +"RTN","TMGNDF1A",78,0) + ;" If 1, then only ONE record (user chosed) will be compiled. +"RTN","TMGNDF1A",79,0) + ;" If 2, then only records that are NEW will +"RTN","TMGNDF1A",80,0) + ;" be added. Existing records in 22706.9 will not be affected +"RTN","TMGNDF1A",81,0) + ;" If 3, then only record(s) supplied will be compiled. +"RTN","TMGNDF1A",82,0) + ;" Option(IEN)="" +"RTN","TMGNDF1A",83,0) + ;" Option(IEN)="" +"RTN","TMGNDF1A",84,0) + ;" If Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF1A",85,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF1A",86,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has records added. +"RTN","TMGNDF1A",87,0) + ;"Result: none +"RTN","TMGNDF1A",88,0) + +"RTN","TMGNDF1A",89,0) + new pIndex set pIndex=$$GetpVAPIndex() +"RTN","TMGNDF1A",90,0) + +"RTN","TMGNDF1A",91,0) + new abort set abort=0 +"RTN","TMGNDF1A",92,0) + set Option=+$get(Option) +"RTN","TMGNDF1A",93,0) + set OnlyIfNew=(Option=2) +"RTN","TMGNDF1A",94,0) + new CompOption set CompOption=OnlyIfNew +"RTN","TMGNDF1A",95,0) + merge CompOption("FIX CHAIN")=Option("FIX CHAIN") +"RTN","TMGNDF1A",96,0) + +"RTN","TMGNDF1A",97,0) + new % set %=2 +"RTN","TMGNDF1A",98,0) + new ExclArray +"RTN","TMGNDF1A",99,0) + if $data(^TMG(22706.9,"VAP1"))>0 do ;"a test for a prior run +"RTN","TMGNDF1A",100,0) + . if (Option=1)!(Option=2)!(Option=3) quit +"RTN","TMGNDF1A",101,0) + . write "Prior import processing detected.",! +"RTN","TMGNDF1A",102,0) + . if Option=0 write "Import ONLY NEW drugs" do YN^DICN write ! +"RTN","TMGNDF1A",103,0) + . if %=-1 quit +"RTN","TMGNDF1A",104,0) + . if %=1 set OnlyIfNew=1 quit +"RTN","TMGNDF1A",105,0) + . write "Choose fields in import file to NOT to OVER WRITE" do YN^DICN write ! +"RTN","TMGNDF1A",106,0) + . if %=1 do GetExclFields(.ExclArray) +"RTN","TMGNDF1A",107,0) + if %=-1 goto CADone +"RTN","TMGNDF1A",108,0) + +"RTN","TMGNDF1A",109,0) + write "Compiling FDA data into a unified file, for later import.",! +"RTN","TMGNDF1A",110,0) + new Itr,IEN +"RTN","TMGNDF1A",111,0) + if Option=1 do +"RTN","TMGNDF1A",112,0) + . new X,Y,DIC +"RTN","TMGNDF1A",113,0) + . set DIC=22706.5,DIC(0)="MAEQ" +"RTN","TMGNDF1A",114,0) + . set DIC("A")="Select FDA drug for import: " +"RTN","TMGNDF1A",115,0) + . do ^DIC write ! +"RTN","TMGNDF1A",116,0) + . if +Y'>-1 quit +"RTN","TMGNDF1A",117,0) + . do CompileOne(+Y,0,pIndex,.ExclArray,.CompOption) +"RTN","TMGNDF1A",118,0) + . new killthis +"RTN","TMGNDF1A",119,0) + +"RTN","TMGNDF1A",120,0) + if Option=3 do +"RTN","TMGNDF1A",121,0) + . set IEN="" +"RTN","TMGNDF1A",122,0) + . for set IEN=$order(Option(IEN)) quit:(IEN="")!abort do +"RTN","TMGNDF1A",123,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF1A",124,0) + . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption) +"RTN","TMGNDF1A",125,0) + . . new killthis +"RTN","TMGNDF1A",126,0) + +"RTN","TMGNDF1A",127,0) + else do +"RTN","TMGNDF1A",128,0) + . set IEN=$$ItrInit^TMGITR(22706.5,.Itr) +"RTN","TMGNDF1A",129,0) + . do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1A",130,0) + . if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1) +"RTN","TMGNDF1A",131,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF1A",132,0) + . . do CompileOne(IEN,0,pIndex,.ExclArray,.CompOption) +"RTN","TMGNDF1A",133,0) + . . new killthis +"RTN","TMGNDF1A",134,0) +CADone +"RTN","TMGNDF1A",135,0) + write !,"Done.",! +"RTN","TMGNDF1A",136,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1A",137,0) + quit +"RTN","TMGNDF1A",138,0) + +"RTN","TMGNDF1A",139,0) + +"RTN","TMGNDF1A",140,0) +ReCompOne(IEN22706d9,Option) +"RTN","TMGNDF1A",141,0) + ;"Purpose: To recompile a given record in file 22706.9 +"RTN","TMGNDF1A",142,0) + ;"Input: IEN -- IEN from 22706.9 +"RTN","TMGNDF1A",143,0) + ;" OPTION -- Optional. Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF1A",144,0) + ;" to file DRUG, POI, OI, OQV etc. +"RTN","TMGNDF1A",145,0) + ;"Results: none +"RTN","TMGNDF1A",146,0) + +"RTN","TMGNDF1A",147,0) + new fdaIEN +"RTN","TMGNDF1A",148,0) + set fdaIEN=+$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",1) +"RTN","TMGNDF1A",149,0) + new pIndex set pIndex=$$GetpVAPIndex() +"RTN","TMGNDF1A",150,0) + set Option=2 ;"2-> ask for overwrites. +"RTN","TMGNDF1A",151,0) + do CompileOne(fdaIEN,0,pIndex,,.Option) +"RTN","TMGNDF1A",152,0) + +"RTN","TMGNDF1A",153,0) + quit +"RTN","TMGNDF1A",154,0) + +"RTN","TMGNDF1A",155,0) + +"RTN","TMGNDF1A",156,0) +CompileOne(IEN,Quiet,pIndex,ExclArray,Option) +"RTN","TMGNDF1A",157,0) + ;"Purpose: To collect relevent data from the TMG FDA * files, or one entry, and put into one record +"RTN","TMGNDF1A",158,0) + ;"Input: IEN -- the IEN from file 22706.5 (TMG FDA LISTING) that should be added. +"RTN","TMGNDF1A",159,0) + ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. +"RTN","TMGNDF1A",160,0) + ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing +"RTN","TMGNDF1A",161,0) + ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format: +"RTN","TMGNDF1A",162,0) + ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. +"RTN","TMGNDF1A",163,0) + ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. +"RTN","TMGNDF1A",164,0) + ;" Option : OPTIONAL. Default=0. PASS BY REFERECE *if* SUBNODES DEFINED +"RTN","TMGNDF1A",165,0) + ;" 1 -> only records that are NEW will be added. Existing records in 22706.9 will not be affected +"RTN","TMGNDF1A",166,0) + ;" 2 -> User is prompted for overwrites +"RTN","TMGNDF1A",167,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF1A",168,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF1A",169,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) may have data/records added. +"RTN","TMGNDF1A",170,0) + ;"Result: none +"RTN","TMGNDF1A",171,0) + +"RTN","TMGNDF1A",172,0) + new Array,result +"RTN","TMGNDF1A",173,0) + set Quiet=$get(Quiet,1) +"RTN","TMGNDF1A",174,0) + new destIEN +"RTN","TMGNDF1A",175,0) + set Option=+$get(Option) +"RTN","TMGNDF1A",176,0) + new OnlyIfNew set OnlyIfNew=(Option=1) +"RTN","TMGNDF1A",177,0) + new stuffOption set stuffOption="" +"RTN","TMGNDF1A",178,0) + if Option=2 set stuffOption("ASK OVERWRITE")=1 +"RTN","TMGNDF1A",179,0) + +"RTN","TMGNDF1A",180,0) + if +$get(IEN)'>0 goto C1Done +"RTN","TMGNDF1A",181,0) + if $$GetDrugInfo(IEN,.Array,.pIndex)=0 goto C1Done ;"returns 0 for error +"RTN","TMGNDF1A",182,0) + set destIEN=$$FindPriorRec(.Array) +"RTN","TMGNDF1A",183,0) + if (destIEN>0)&(OnlyIfNew=1) goto C1Done ;"Skip preexisting, don't update, per flag +"RTN","TMGNDF1A",184,0) + if destIEN'>0 set destIEN=$$MakeCompRec(.Array,Quiet) +"RTN","TMGNDF1A",185,0) + if destIEN'>0 goto C1Done +"RTN","TMGNDF1A",186,0) + if $$StuffCompRec(destIEN,.Array,.Quiet,.ExclArray,.stuffOption)=1 goto C1Done ;"returns 1 for error +"RTN","TMGNDF1A",187,0) + do FillGenericName(destIEN) +"RTN","TMGNDF1A",188,0) + +"RTN","TMGNDF1A",189,0) + ;"Set link between COMPILED field in 22706.5 and record in 22706.9 +"RTN","TMGNDF1A",190,0) + new TMGFDA,TMGMSG,PriorErrorFound +"RTN","TMGNDF1A",191,0) + set TMGFDA(22706.5,IEN_",",8)=destIEN +"RTN","TMGNDF1A",192,0) + do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF1A",193,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",194,0) + +"RTN","TMGNDF1A",195,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF1A",196,0) + . do Fix1Name^TMGNDF1D(IEN) +"RTN","TMGNDF1A",197,0) + . ;"consider if checking for 1 new ROUTE is need in TMGNDF1F +"RTN","TMGNDF1A",198,0) + . ;"consider if checking for 1 new FORM is need in TMGNDF2A +"RTN","TMGNDF1A",199,0) + . do Make1Alt^TMGNDF2G(IEN) +"RTN","TMGNDF1A",200,0) + . do Check1^TMGNDF2H(IEN) +"RTN","TMGNDF1A",201,0) + . do Refresh1^TMGNDF3C(IEN,.Option) ;"further chaining to occur from this fn. +"RTN","TMGNDF1A",202,0) + .;"NOTE: I also need to go through modules and add code to handle DELETIONS +"RTN","TMGNDF1A",203,0) + . ;" (esp DRUG-->POI etc.) +"RTN","TMGNDF1A",204,0) + +"RTN","TMGNDF1A",205,0) + +"RTN","TMGNDF1A",206,0) +C1Done +"RTN","TMGNDF1A",207,0) + quit +"RTN","TMGNDF1A",208,0) + +"RTN","TMGNDF1A",209,0) + +"RTN","TMGNDF1A",210,0) +FindPriorRec(Array) +"RTN","TMGNDF1A",211,0) + ;"Purpose: To find an entry in file 22706.9 (TMG FDA IMPORT COMPILED) that +"RTN","TMGNDF1A",212,0) + ;" matches data in Array, meaning that the data has been previously +"RTN","TMGNDF1A",213,0) + ;" added. +"RTN","TMGNDF1A",214,0) + ;" Match criteria: +"RTN","TMGNDF1A",215,0) + ;"Input: Array: PASS BY REEFRENCE. The drug info array, as created by GetDrugInfo() +"RTN","TMGNDF1A",216,0) + ;"Result: Returns the IEN from 22706.9, or 0 if no prior match found. +"RTN","TMGNDF1A",217,0) + +"RTN","TMGNDF1A",218,0) + new result set result=0 +"RTN","TMGNDF1A",219,0) + new NDC12 set NDC12=$get(Array("NDC","12DIGIT")) +"RTN","TMGNDF1A",220,0) + if NDC12>0 set result=$order(^TMG(22706.9,"NDC12",NDC12,"")) +"RTN","TMGNDF1A",221,0) + +"RTN","TMGNDF1A",222,0) + quit result +"RTN","TMGNDF1A",223,0) + +"RTN","TMGNDF1A",224,0) + +"RTN","TMGNDF1A",225,0) +MakeCompRec(Array,Quiet) +"RTN","TMGNDF1A",226,0) + ;"Purpose: To create one entry in file 22706.9 (TMG FDA IMPORT COMPILED) +"RTN","TMGNDF1A",227,0) + ;" entry will be essentially empty, to be filled later by StuffCompRec +"RTN","TMGNDF1A",228,0) + ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo() +"RTN","TMGNDF1A",229,0) + ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. +"RTN","TMGNDF1A",230,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified. +"RTN","TMGNDF1A",231,0) + ;"Result: IEN of new record, or 0 if error +"RTN","TMGNDF1A",232,0) + ;"Note: any pre-existing data is removed from record. +"RTN","TMGNDF1A",233,0) + +"RTN","TMGNDF1A",234,0) + new TMGFDA,IENS,TMGIEN,TMGMSG +"RTN","TMGNDF1A",235,0) + new result set result=0 ;"default to failure +"RTN","TMGNDF1A",236,0) + +"RTN","TMGNDF1A",237,0) + set Quiet=$get(Quiet,1) +"RTN","TMGNDF1A",238,0) + +"RTN","TMGNDF1A",239,0) + set IENS="+1," +"RTN","TMGNDF1A",240,0) + set TMGFDA(22706.9,IENS,.01)=IEN +"RTN","TMGNDF1A",241,0) + do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") ;"create new record +"RTN","TMGNDF1A",242,0) + if $data(TMGMSG) do +"RTN","TMGNDF1A",243,0) + . if Quiet=1 quit +"RTN","TMGNDF1A",244,0) + . new PriorErrorFound +"RTN","TMGNDF1A",245,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",246,0) + else set result=+$get(TMGIEN(1)) +"RTN","TMGNDF1A",247,0) + +"RTN","TMGNDF1A",248,0) + quit result +"RTN","TMGNDF1A",249,0) + +"RTN","TMGNDF1A",250,0) +GetExclFields(ExclArray) +"RTN","TMGNDF1A",251,0) + ;"Purpose: to determine if there are fields that should not be overwritten +"RTN","TMGNDF1A",252,0) + ;" during stuffing of records +"RTN","TMGNDF1A",253,0) + ;"Input: ExclArray -- PASS BY REFERENCE, AN OUT PARAMETER. FORMAT: +"RTN","TMGNDF1A",254,0) + ;" ExclArray(FieldNum)=FieldName +"RTN","TMGNDF1A",255,0) + ;" Any preexisting entries will be KILLED +"RTN","TMGNDF1A",256,0) + +"RTN","TMGNDF1A",257,0) + kill ExclArray +"RTN","TMGNDF1A",258,0) + +"RTN","TMGNDF1A",259,0) + new DIC,X,Y +"RTN","TMGNDF1A",260,0) + set DIC="^DD(22706.9," +"RTN","TMGNDF1A",261,0) + set DIC(0)="AEQM" +"RTN","TMGNDF1A",262,0) + set DIC("S")="IF (Y=.05)!(Y=.05)!(Y=1)!(Y=2)!(Y=3)!(Y=3.4)!(Y=4)!(Y=5)!(Y=7)" +"RTN","TMGNDF1A",263,0) + set DIC("A")="Pick field to NOT OVERWRITE (^ when done): " +"RTN","TMGNDF1A",264,0) +GEF1 do ^DIC +"RTN","TMGNDF1A",265,0) + if Y=-1 goto GEF2 +"RTN","TMGNDF1A",266,0) + set ExclArray(+Y)=$piece(Y,"^",2) +"RTN","TMGNDF1A",267,0) + goto GEF1 +"RTN","TMGNDF1A",268,0) +GEF2 +"RTN","TMGNDF1A",269,0) + if $data(ExclArray)=0 goto GEFDone +"RTN","TMGNDF1A",270,0) + write !!,"Will NOT OVERWRITE any preexisting data in these fields:",! +"RTN","TMGNDF1A",271,0) + new i set i="" +"RTN","TMGNDF1A",272,0) + for set i=$order(ExclArray(i)) quit:(i="") do +"RTN","TMGNDF1A",273,0) + . write " ",ExclArray(i)," (",i,")",! +"RTN","TMGNDF1A",274,0) + new % set %=1 +"RTN","TMGNDF1A",275,0) + write "OK" do YN^DICN write ! +"RTN","TMGNDF1A",276,0) + if %=1 goto GEFDone +"RTN","TMGNDF1A",277,0) + kill ExclArray +"RTN","TMGNDF1A",278,0) + set %=2 +"RTN","TMGNDF1A",279,0) + write "Pick again" do YN^DICN write ! +"RTN","TMGNDF1A",280,0) + if %=1 goto GEF1 +"RTN","TMGNDF1A",281,0) + +"RTN","TMGNDF1A",282,0) +GEFDone +"RTN","TMGNDF1A",283,0) + quit +"RTN","TMGNDF1A",284,0) + +"RTN","TMGNDF1A",285,0) + +"RTN","TMGNDF1A",286,0) +StuffCompRec(IEN,Array,Quiet,ExclArray,Option) +"RTN","TMGNDF1A",287,0) + ;"Purpose: To fill in data for one entry in file 22706.9 (TMG FDA IMPORT COMPILED) +"RTN","TMGNDF1A",288,0) + ;"Input: IEN: The IEN of the new record for data to be stuffed into (i.e. IEN22706d9) +"RTN","TMGNDF1A",289,0) + ;" Array: PASS BY REFERENCE. The drug info array, as created by GetDrugInfo() +"RTN","TMGNDF1A",290,0) + ;" Quiet: OPTIONAL (default=1), if 0, then Fileman error messages are displayed. +"RTN","TMGNDF1A",291,0) + ;" ExclArray --OPTIONAL -- an array with fields to NOT OVERWRITE preexisting fields in. Format: +"RTN","TMGNDF1A",292,0) + ;" ExclArray(FieldNum)=FieldName <-- data in 22706.9, FieldNum will not be overwritten. +"RTN","TMGNDF1A",293,0) + ;" Option -- OPTIONAL. PASS BY REFERENCE +"RTN","TMGNDF1A",294,0) + ;" Option("ASK OVERWRITE")=1 --> ask user if overwrites are OK. +"RTN","TMGNDF1A",295,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF1A",296,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF1A",297,0) + ;"Output: The file 22706.9 (TMG FDA IMPORT COMPILED) has one records added or modified. +"RTN","TMGNDF1A",298,0) + ;"Result: 0=OK, 1=fatal error encountered +"RTN","TMGNDF1A",299,0) + ;"Note: any pre-existing data is removed from record. (<--??) +"RTN","TMGNDF1A",300,0) + +"RTN","TMGNDF1A",301,0) + new TMGFDA,IENS,TMGIEN,TMGMSG,newIENS +"RTN","TMGNDF1A",302,0) + new result set result=0 +"RTN","TMGNDF1A",303,0) + new dataAdded set dataAdded=0 +"RTN","TMGNDF1A",304,0) + new askOverwrite set askOverwrite=($get(Option("ASK OVERWRITE"))=1) +"RTN","TMGNDF1A",305,0) + +"RTN","TMGNDF1A",306,0) + set Quiet=$get(Quiet,1) +"RTN","TMGNDF1A",307,0) + new map +"RTN","TMGNDF1A",308,0) + set map(.05)=$name(tradeName) +"RTN","TMGNDF1A",309,0) + set map(1)=$name(Array("STRENGTH")) +"RTN","TMGNDF1A",310,0) + set map(2)=$name(Array("UNIT")) +"RTN","TMGNDF1A",311,0) + set map(3)=$name(Array("ROUTE",1,"NAME")) +"RTN","TMGNDF1A",312,0) + set map(3.4)=$name(Array("DOSE",1,"DOSAGE NAME")) +"RTN","TMGNDF1A",313,0) + set map(4)=$name(Array("NDC")) +"RTN","TMGNDF1A",314,0) + set map(5)=$name(Array("NDC","12DIGIT")) +"RTN","TMGNDF1A",315,0) + set map(7)=$name(codeOTC) +"RTN","TMGNDF1A",316,0) + +"RTN","TMGNDF1A",317,0) + new codeOTC set codeOTC=$get(Array("RX OR OTC")) +"RTN","TMGNDF1A",318,0) + if codeOTC["PRESCRIPTION" set codeOTC="R" +"RTN","TMGNDF1A",319,0) + else if codeOTC["OTC" set codeOTC="O" +"RTN","TMGNDF1A",320,0) + else set codeOTC="" +"RTN","TMGNDF1A",321,0) + +"RTN","TMGNDF1A",322,0) + new tradeName set tradeName=$get(Array("TRADENAME")) +"RTN","TMGNDF1A",323,0) + if $length(tradeName)>64 set tradeName=$extract(tradeName,1,61)_"..." +"RTN","TMGNDF1A",324,0) + +"RTN","TMGNDF1A",325,0) + set IENS=IEN_"," +"RTN","TMGNDF1A",326,0) + +"RTN","TMGNDF1A",327,0) + new oldData +"RTN","TMGNDF1A",328,0) + new field set field="" +"RTN","TMGNDF1A",329,0) + for set field=$order(map(field)) quit:(field="") do +"RTN","TMGNDF1A",330,0) + . new pVar,value +"RTN","TMGNDF1A",331,0) + . set pVar=$get(map(field)) +"RTN","TMGNDF1A",332,0) + . set value=$get(@pVar) +"RTN","TMGNDF1A",333,0) + . if value="" quit +"RTN","TMGNDF1A",334,0) + . set oldData(field)=$$GET1^DIQ(22706.9,IENS,field) +"RTN","TMGNDF1A",335,0) + . if ($data(ExclArray(field))'=0)&(oldData(field)'="") quit +"RTN","TMGNDF1A",336,0) + . set TMGFDA(22706.9,IENS,field)=value +"RTN","TMGNDF1A",337,0) + +"RTN","TMGNDF1A",338,0) + new untrimFDA merge untrimFDA=TMGFDA +"RTN","TMGNDF1A",339,0) + set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. +"RTN","TMGNDF1A",340,0) + if $data(TMGFDA)=0 goto SCR1 +"RTN","TMGNDF1A",341,0) + +"RTN","TMGNDF1A",342,0) + new abort set abort=0 +"RTN","TMGNDF1A",343,0) + if askOverwrite do +"RTN","TMGNDF1A",344,0) + . new field set field="" +"RTN","TMGNDF1A",345,0) + . for set field=$order(TMGFDA(22706.9,IENS,field)) quit:(field="") do +"RTN","TMGNDF1A",346,0) + . . write field,": '",$get(oldData(field)),"' --> '",$get(TMGFDA(22706.9,IENS,field)),"'",! +"RTN","TMGNDF1A",347,0) + . write !,"Stuff this data into file 22706.9, record #",IEN,"? " +"RTN","TMGNDF1A",348,0) + . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF1A",349,0) + . if %=1 quit +"RTN","TMGNDF1A",350,0) + . set abort=1 +"RTN","TMGNDF1A",351,0) + if abort=1 goto MCRDone +"RTN","TMGNDF1A",352,0) + +"RTN","TMGNDF1A",353,0) + do FILE^DIE("E","TMGFDA","TMGMSG") ;" Fill existing record +"RTN","TMGNDF1A",354,0) + if $data(TMGMSG) do goto MCRDone +"RTN","TMGNDF1A",355,0) + . if Quiet=1 quit +"RTN","TMGNDF1A",356,0) + . new PriorErrorFound +"RTN","TMGNDF1A",357,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",358,0) + . set result=1 +"RTN","TMGNDF1A",359,0) + else set dataAdded=1 +"RTN","TMGNDF1A",360,0) + +"RTN","TMGNDF1A",361,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF1A",362,0) + . new opt +"RTN","TMGNDF1A",363,0) + . set opt("FIX CHAIN")=1 +"RTN","TMGNDF1A",364,0) + . set opt("FIX CHAIN","IEN22706d9")=IEN ;"used later in chain +"RTN","TMGNDF1A",365,0) + . ;"pass signal to fix chain forward +"RTN","TMGNDF1A",366,0) + . do Refresh1^TMGNDF3C(IEN,.opt) ;" no results +"RTN","TMGNDF1A",367,0) + +"RTN","TMGNDF1A",368,0) +SCR1 +"RTN","TMGNDF1A",369,0) + new i,MaxCount,subfile +"RTN","TMGNDF1A",370,0) + kill TMGFDA,TMGIEN +"RTN","TMGNDF1A",371,0) + set MaxCount=$get(Array("FILE 50.68 IEN","COUNT")) +"RTN","TMGNDF1A",372,0) + set subfile=22706.914 +"RTN","TMGNDF1A",373,0) + for i=1:1:MaxCount do quit:(abort=1) +"RTN","TMGNDF1A",374,0) + . set IENS="+"_i_","_IEN_"," +"RTN","TMGNDF1A",375,0) + . new addIEN set addIEN=$get(Array("FILE 50.68 IEN",i)) +"RTN","TMGNDF1A",376,0) + . set TMGFDA(subfile,IENS,.01)=addIEN +"RTN","TMGNDF1A",377,0) + . ;"------ +"RTN","TMGNDF1A",378,0) + . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. +"RTN","TMGNDF1A",379,0) + . if $data(TMGFDA)'>0 quit +"RTN","TMGNDF1A",380,0) + . if askOverwrite do quit:(abort=1) +"RTN","TMGNDF1A",381,0) + . . new field set field="" +"RTN","TMGNDF1A",382,0) + . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do +"RTN","TMGNDF1A",383,0) + . . . write field,": ",$$GET1^DIQ(subfile,IENS,field)," --> ",$get(TMGFDA(subfile,IENS,field)),! +"RTN","TMGNDF1A",384,0) + . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " +"RTN","TMGNDF1A",385,0) + . . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF1A",386,0) + . . if %=1 quit +"RTN","TMGNDF1A",387,0) + . . set abort=1 +"RTN","TMGNDF1A",388,0) + . if newIENS'["+" do +"RTN","TMGNDF1A",389,0) + . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) +"RTN","TMGNDF1A",390,0) + . . kill TMGFDA merge TMGFDA=tempFDA +"RTN","TMGNDF1A",391,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1A",392,0) + . else do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF1A",393,0) + . if $data(TMGMSG) do +"RTN","TMGNDF1A",394,0) + . . if Quiet=1 quit +"RTN","TMGNDF1A",395,0) + . . new PriorErrorFound +"RTN","TMGNDF1A",396,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",397,0) + . else set dataAdded=1 +"RTN","TMGNDF1A",398,0) + if abort=1 goto MCRDone +"RTN","TMGNDF1A",399,0) + +"RTN","TMGNDF1A",400,0) +SCR2 +"RTN","TMGNDF1A",401,0) + kill TMGFDA,TMGIEN +"RTN","TMGNDF1A",402,0) + set MaxCount=$get(Array("FILE 50.68 IEN","POSS MATCH","COUNT")) +"RTN","TMGNDF1A",403,0) + set subfile=22706.915 +"RTN","TMGNDF1A",404,0) + for i=1:1:MaxCount do quit:(abort=1) +"RTN","TMGNDF1A",405,0) + . set IENS="+"_i_","_IEN_"," +"RTN","TMGNDF1A",406,0) + . new addIEN set addIEN=$get(Array("FILE 50.68 IEN","POSS MATCH",i)) +"RTN","TMGNDF1A",407,0) + . set TMGFDA(subfile,IENS,.01)=addIEN +"RTN","TMGNDF1A",408,0) + . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. +"RTN","TMGNDF1A",409,0) + . if $data(TMGFDA)'>0 quit +"RTN","TMGNDF1A",410,0) + . if askOverwrite do quit:(abort=1) +"RTN","TMGNDF1A",411,0) + . . new field set field="" +"RTN","TMGNDF1A",412,0) + . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do +"RTN","TMGNDF1A",413,0) + . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),! +"RTN","TMGNDF1A",414,0) + . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " +"RTN","TMGNDF1A",415,0) + . . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF1A",416,0) + . . if %=1 quit +"RTN","TMGNDF1A",417,0) + . . set abort=1 +"RTN","TMGNDF1A",418,0) + . if newIENS'["+" do +"RTN","TMGNDF1A",419,0) + . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) +"RTN","TMGNDF1A",420,0) + . . kill TMGFDA merge TMGFDA=tempFDA +"RTN","TMGNDF1A",421,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1A",422,0) + . else do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF1A",423,0) + . if $data(TMGMSG) do +"RTN","TMGNDF1A",424,0) + . . if Quiet=1 quit +"RTN","TMGNDF1A",425,0) + . . new PriorErrorFound +"RTN","TMGNDF1A",426,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",427,0) + . else set dataAdded=1 +"RTN","TMGNDF1A",428,0) + if abort=1 goto MCRDone +"RTN","TMGNDF1A",429,0) + +"RTN","TMGNDF1A",430,0) +SCR3 +"RTN","TMGNDF1A",431,0) + kill TMGFDA,TMGIEN +"RTN","TMGNDF1A",432,0) + set MaxCount=$get(Array("FORMULATION","COUNT")) +"RTN","TMGNDF1A",433,0) + set subfile=22706.916 +"RTN","TMGNDF1A",434,0) + for i=1:1:MaxCount do +"RTN","TMGNDF1A",435,0) + . set IENS="+"_i_","_IEN_"," +"RTN","TMGNDF1A",436,0) + . set TMGFDA(subfile,IENS,.01)=i +"RTN","TMGNDF1A",437,0) + . set TMGFDA(subfile,IENS,2)=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")) +"RTN","TMGNDF1A",438,0) + . set TMGFDA(subfile,IENS,3)=$get(Array("FORMULATION",i,"STRENGTH")) +"RTN","TMGNDF1A",439,0) + . set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")) ;"should be a ptr +"RTN","TMGNDF1A",440,0) + . ;"set TMGFDA(subfile,IENS,5)=$get(Array("FORMULATION",2,"UNIT")) ;"should be a ptr +"RTN","TMGNDF1A",441,0) + . ;"---------------------- +"RTN","TMGNDF1A",442,0) + . set newIENS=$$TrimFDA^TMGDBAPI(.TMGFDA) ;"remove entries for data already present. +"RTN","TMGNDF1A",443,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDF1A",444,0) + . if askOverwrite do quit:(abort=1) +"RTN","TMGNDF1A",445,0) + . . new field set field="" +"RTN","TMGNDF1A",446,0) + . . for set field=$order(TMGFDA(subfile,IENS,field)) quit:(field="") do +"RTN","TMGNDF1A",447,0) + . . . write field,": '",$$GET1^DIQ(subfile,IENS,field),"' --> ",$get(TMGFDA(subfile,IENS,field)),! +"RTN","TMGNDF1A",448,0) + . . write !,"Stuff this data into subfile ",subfile,", record #",IENS,"? " +"RTN","TMGNDF1A",449,0) + . . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF1A",450,0) + . . if %=1 quit +"RTN","TMGNDF1A",451,0) + . . set abort=1 +"RTN","TMGNDF1A",452,0) + . if newIENS'["+" do +"RTN","TMGNDF1A",453,0) + . . new tempFDA merge tempFDA(subfile,newIENS)=TMGFDA(subfile,IENS) +"RTN","TMGNDF1A",454,0) + . . kill TMGFDA merge TMGFDA=tempFDA +"RTN","TMGNDF1A",455,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1A",456,0) + . else do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF1A",457,0) + . if $data(TMGMSG) do +"RTN","TMGNDF1A",458,0) + . . if Quiet=1 quit +"RTN","TMGNDF1A",459,0) + . . new PriorErrorFound +"RTN","TMGNDF1A",460,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",461,0) + . else set dataAdded=1 +"RTN","TMGNDF1A",462,0) + if abort=1 goto MCRDone +"RTN","TMGNDF1A",463,0) + +"RTN","TMGNDF1A",464,0) +SCR4 +"RTN","TMGNDF1A",465,0) + ;"Add a comment +"RTN","TMGNDF1A",466,0) + if dataAdded=0 goto MCRDone +"RTN","TMGNDF1A",467,0) + kill TMGFDA +"RTN","TMGNDF1A",468,0) + new %DT,X,Y +"RTN","TMGNDF1A",469,0) + set %DT="T",X="NOW" do ^%DT ;"get current time +"RTN","TMGNDF1A",470,0) + set IENS="+1,"_IEN_"," +"RTN","TMGNDF1A",471,0) + set TMGFDA(22706.9001,IENS,.01)="UPDATE VIA AUTOMATIC IMPORT COMPILE" +"RTN","TMGNDF1A",472,0) + set TMGFDA(22706.9001,IENS,1)=Y +"RTN","TMGNDF1A",473,0) + do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF1A",474,0) + if $data(TMGMSG) do +"RTN","TMGNDF1A",475,0) + . if Quiet=1 quit +"RTN","TMGNDF1A",476,0) + . new PriorErrorFound +"RTN","TMGNDF1A",477,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",478,0) + +"RTN","TMGNDF1A",479,0) +MCRDone +"RTN","TMGNDF1A",480,0) + if abort=1 set result=1 +"RTN","TMGNDF1A",481,0) + quit result +"RTN","TMGNDF1A",482,0) + +"RTN","TMGNDF1A",483,0) + +"RTN","TMGNDF1A",484,0) +FillGenericName(IEN) +"RTN","TMGNDF1A",485,0) + ;"Purpose: To create an entry for the GENERIC NAME (field .07) in TMG FDA IMPORT (22706.9) +"RTN","TMGNDF1A",486,0) + ;"Input: IEN -- the IEN in 22706.9 to alter +"RTN","TMGNDF1A",487,0) + ;"Output: the record specified by IEN will be altered (if ingredients are known) +"RTN","TMGNDF1A",488,0) + ;"Result: None +"RTN","TMGNDF1A",489,0) + +"RTN","TMGNDF1A",490,0) + new name +"RTN","TMGNDF1A",491,0) + set name=$$MakeGenericName(IEN) +"RTN","TMGNDF1A",492,0) + if $data(^TMG(22706.9,IEN,0))>0 do +"RTN","TMGNDF1A",493,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1A",494,0) + . set TMGFDA(22706.9,IEN_",",.07)=name +"RTN","TMGNDF1A",495,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1A",496,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1A",497,0) + . ;"set $piece(^TMG(22706.9,IEN,0),"^",6)=name ;"There is no index on this field, so direct write OK +"RTN","TMGNDF1A",498,0) + quit +"RTN","TMGNDF1A",499,0) + +"RTN","TMGNDF1A",500,0) + +"RTN","TMGNDF1A",501,0) +MakeGenericName(IEN) +"RTN","TMGNDF1A",502,0) + ;"Purpose: To create a GENERIC NAME string +"RTN","TMGNDF1A",503,0) + ;"Input: IEN -- the IEN in 22706.9 to use +"RTN","TMGNDF1A",504,0) + ;"Result: returns a string for the generic name. +"RTN","TMGNDF1A",505,0) + +"RTN","TMGNDF1A",506,0) + new Ingredients +"RTN","TMGNDF1A",507,0) + new i +"RTN","TMGNDF1A",508,0) + new result set result="" +"RTN","TMGNDF1A",509,0) + +"RTN","TMGNDF1A",510,0) + set i=$order(^TMG(22706.9,IEN,4,0)) +"RTN","TMGNDF1A",511,0) + if i'="" for do quit:(+i'>0) +"RTN","TMGNDF1A",512,0) + . new IgdIEN,IgdName +"RTN","TMGNDF1A",513,0) + . set IgdIEN=+$piece($get(^TMG(22706.9,IEN,4,i,0)),"^",3) ;"get field#2, INGREDIENT (ptr to 50.416) +"RTN","TMGNDF1A",514,0) + . if IgdIEN>0 do +"RTN","TMGNDF1A",515,0) + . . set IgdName=$$GET1^DIQ(50.416,IgdIEN,.01) +"RTN","TMGNDF1A",516,0) + . . set IgdName=$$Substitute^TMGSTUTL(IgdName,"HYDROCHLORIDE","") ;"This is what the VA does... +"RTN","TMGNDF1A",517,0) + . . new temp set temp=IgdName +"RTN","TMGNDF1A",518,0) + . . set IgdName=$piece(IgdName,",",1) ;"I will also trim off anything after a comma. +"RTN","TMGNDF1A",519,0) + . . if $length(IgdName)<5 set IgdName=temp ;"I had problem with: N,N-1 ACETYL.... --> 'N' +"RTN","TMGNDF1A",520,0) + . . set IgdName=$translate(IgdName,"/","\") ;convert '/' --> '\' ('/' used later to concate ingredients) +"RTN","TMGNDF1A",521,0) + . . set IgdName=$$Trim^TMGSTUTL(IgdName) +"RTN","TMGNDF1A",522,0) + . . if IgdName'="" set Ingredients(IgdName)="" ;"will sort alphabetically +"RTN","TMGNDF1A",523,0) + . set i=$order(^TMG(22706.9,IEN,4,i)) +"RTN","TMGNDF1A",524,0) + +"RTN","TMGNDF1A",525,0) + set i=$order(Ingredients("")) +"RTN","TMGNDF1A",526,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF1A",527,0) + . if result'="" set result=result_"/" +"RTN","TMGNDF1A",528,0) + . set result=result_i +"RTN","TMGNDF1A",529,0) + . set i=$order(Ingredients(i)) +"RTN","TMGNDF1A",530,0) + +"RTN","TMGNDF1A",531,0) + set result=$extract(result,1,64) +"RTN","TMGNDF1A",532,0) + +"RTN","TMGNDF1A",533,0) + quit result +"RTN","TMGNDF1A",534,0) + +"RTN","TMGNDF1A",535,0) + +"RTN","TMGNDF1A",536,0) +GetVADrugInfo(IEN,Array) +"RTN","TMGNDF1A",537,0) + ;"Purpose: To collect info from VA Product file into an array similar (but limited) to +"RTN","TMGNDF1A",538,0) + ;" that returned from GetDrugInfo +"RTN","TMGNDF1A",539,0) + ;"Input: IEN -- the IEN from file 50.68 (VA PRODUCT) +"RTN","TMGNDF1A",540,0) + +"RTN","TMGNDF1A",541,0) + kill Array +"RTN","TMGNDF1A",542,0) + new DIC,X,Y +"RTN","TMGNDF1A",543,0) + +"RTN","TMGNDF1A",544,0) + set Array("TRADENAME")=$$GET1^DIQ(50.68,IEN,.01) +"RTN","TMGNDF1A",545,0) + set Array("STRENGTH")=$$GET1^DIQ(50.68,IEN,2) +"RTN","TMGNDF1A",546,0) + set Array("UNIT")=$$GET1^DIQ(50.68,IEN,3) +"RTN","TMGNDF1A",547,0) + +"RTN","TMGNDF1A",548,0) + set DIC=50.67 +"RTN","TMGNDF1A",549,0) + set DIC(0)="M" +"RTN","TMGNDF1A",550,0) + set X=Array("TRADENAME") +"RTN","TMGNDF1A",551,0) + do ^DIC +"RTN","TMGNDF1A",552,0) + set Array("NDC")=$$GET1^DIQ(50.67,+Y_",",1) +"RTN","TMGNDF1A",553,0) + ;"set Array("NDC 12DIGIT")=ndc (see format below) +"RTN","TMGNDF1A",554,0) + +"RTN","TMGNDF1A",555,0) + new i,count +"RTN","TMGNDF1A",556,0) + set count=0 +"RTN","TMGNDF1A",557,0) + set i=$order(^PSNDF(50.68,IEN,2,0)) +"RTN","TMGNDF1A",558,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF1A",559,0) + . new node set node=$get(^PSNDF(50.68,IEN,2,i,0)) +"RTN","TMGNDF1A",560,0) + . set count=count+1 +"RTN","TMGNDF1A",561,0) + . set Array("FORMULATION","COUNT")=count +"RTN","TMGNDF1A",562,0) + . set Array("FORMULATION",count,"INGREDIENT NAME","FILE 50.416 IEN")=$piece(node,"^",1) +"RTN","TMGNDF1A",563,0) + . set Array("FORMULATION",count,"INGREDIENT NAME")=$$GET1^DIQ(50.416,$piece(node,"^",1),.01) +"RTN","TMGNDF1A",564,0) + . set Array("FORMULATION",count,"STRENGTH")=$piece(node,"^",2) +"RTN","TMGNDF1A",565,0) + . set Array("FORMULATION",count,"UNIT","FILE 50.607 IEN")=$piece(node,"^",3) +"RTN","TMGNDF1A",566,0) + . set Array("FORMULATION",count,"UNIT")=$$GET1^DIQ(50.607,$piece(node,"^",3),.01) +"RTN","TMGNDF1A",567,0) + . set i=$order(^PSNDF(50.68,IEN,2,i)) +"RTN","TMGNDF1A",568,0) + +"RTN","TMGNDF1A",569,0) + quit +"RTN","TMGNDF1A",570,0) + +"RTN","TMGNDF1A",571,0) +GetDrugInfo(IEN,Array,pIndex,noLink) +"RTN","TMGNDF1A",572,0) + ;"Purpose: To collect all info about a drug into one array +"RTN","TMGNDF1A",573,0) + ;"Input: IEN -- the IEN from TMG FDA LISTING file +"RTN","TMGNDF1A",574,0) + ;" Array -- an OUT parameter. See format below +"RTN","TMGNDF1A",575,0) + ;" pIndex -- OPTIONAL -- the NAME OF index (as created by IndexVAProd), for faster processing +"RTN","TMGNDF1A",576,0) + ;" noLink -- OPTIONAL -- default=0. If 1, then linkage to prior VA drugs is NOT attempted. +"RTN","TMGNDF1A",577,0) + ;"Output: Array will be filled with info as above +"RTN","TMGNDF1A",578,0) + ;" Array('FILE 50.68 IEN',1)=IEN +"RTN","TMGNDF1A",579,0) + ;" Array('FILE 50.68 IEN','COUNT') +"RTN","TMGNDF1A",580,0) + ;" Array('LABEL CODE') +"RTN","TMGNDF1A",581,0) + ;" Array('PRODUCT CODE') +"RTN","TMGNDF1A",582,0) + ;" Array('STRENGTH') +"RTN","TMGNDF1A",583,0) + ;" Array('UNIT') +"RTN","TMGNDF1A",584,0) + ;" Array('RX OR OTC') +"RTN","TMGNDF1A",585,0) + ;" Array('FIRM','NAME') +"RTN","TMGNDF1A",586,0) + ;" Array('FIRM','LABEL CODE') +"RTN","TMGNDF1A",587,0) + ;" Array('FIRM','ADDRESS HEADER') +"RTN","TMGNDF1A",588,0) + ;" Array('FIRM','STREET') +"RTN","TMGNDF1A",589,0) + ;" Array('FIRM','PO BOX') +"RTN","TMGNDF1A",590,0) + ;" Array('FIRM','FOREIGN ADDRESS') +"RTN","TMGNDF1A",591,0) + ;" Array('FIRM','CITY') +"RTN","TMGNDF1A",592,0) + ;" Array('FIRM','STATE') +"RTN","TMGNDF1A",593,0) + ;" Array('FIRM','ZIP') +"RTN","TMGNDF1A",594,0) + ;" Array('FIRM','PROVINCE') +"RTN","TMGNDF1A",595,0) + ;" Array('FIRM','COUNTRY') +"RTN","TMGNDF1A",596,0) + ;" Array('TRADENAME') +"RTN","TMGNDF1A",597,0) + ;" Array('PACKAGE',1,'CODE') +"RTN","TMGNDF1A",598,0) + ;" Array('PACKAGE',1,'SIZE') +"RTN","TMGNDF1A",599,0) + ;" Array('PACKAGE',1,'TYPE') +"RTN","TMGNDF1A",600,0) + ;" Array('FORMULATION','COUNT')=1 +"RTN","TMGNDF1A",601,0) + ;" Array('FORMULATION',1,'STRENGTH') +"RTN","TMGNDF1A",602,0) + ;" Array('FORMULATION',1,'UNIT') +"RTN","TMGNDF1A",603,0) + ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found +"RTN","TMGNDF1A",604,0) + ;" Array('FORMULATION',1,'INGREDIENT NAME') +"RTN","TMGNDF1A",605,0) + ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found +"RTN","TMGNDF1A",606,0) + ;" Array('APPLICATION') +"RTN","TMGNDF1A",607,0) + ;" Array('PRODUCT NUMBER') +"RTN","TMGNDF1A",608,0) + ;" Array('ROUTE',1,'CODE' +"RTN","TMGNDF1A",609,0) + ;" Array('ROUTE',1,'NAME') +"RTN","TMGNDF1A",610,0) + ;" Array('DOSE',1,'DOSE FORM') +"RTN","TMGNDF1A",611,0) + ;" Array('DOSE',1,'DO SAGE NAME') +"RTN","TMGNDF1A",612,0) + ;" Array('NDC')=ndc (see format below) +"RTN","TMGNDF1A",613,0) + ;" Array('NDC','12DIGIT')=ndc (see format below) +"RTN","TMGNDF1A",614,0) + ;" Array('FILE 50.68 IEN','COUNT')=1 +"RTN","TMGNDF1A",615,0) + ;" Array('FILE 50.68 IEN',1)=1234 +"RTN","TMGNDF1A",616,0) + ;" Array('FILE 50.68 IEN','POSS MATCH','COUNT')=1 +"RTN","TMGNDF1A",617,0) + ;" Array('FILE 50.68 IEN','POSS MATCH',1)=2345 +"RTN","TMGNDF1A",618,0) + ;"result: 0 if error found, 1 otherwise (i.e. is OKToContinue) +"RTN","TMGNDF1A",619,0) + +"RTN","TMGNDF1A",620,0) + ;"Note the NDC (national drug code) is comprised as follows: +"RTN","TMGNDF1A",621,0) + ;"It is a 10 digit number comprised of three segments +"RTN","TMGNDF1A",622,0) + ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING +"RTN","TMGNDF1A",623,0) + ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING +"RTN","TMGNDF1A",624,0) + ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES +"RTN","TMGNDF1A",625,0) + ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1 +"RTN","TMGNDF1A",626,0) + +"RTN","TMGNDF1A",627,0) + ;" Example Array("NDC")="000002-0351-02" +"RTN","TMGNDF1A",628,0) + ;" Example Array("NDC","12DIGIT")="000002035102" +"RTN","TMGNDF1A",629,0) + +"RTN","TMGNDF1A",630,0) + new TMGARRAY,TMGMSG +"RTN","TMGNDF1A",631,0) + new PriorErrorFound,i +"RTN","TMGNDF1A",632,0) + new IENS set IENS=IEN_"," +"RTN","TMGNDF1A",633,0) + kill Array +"RTN","TMGNDF1A",634,0) + new result set result=1 +"RTN","TMGNDF1A",635,0) + +"RTN","TMGNDF1A",636,0) + do GETS^DIQ(22706.5,IENS,"*","R","TMGARRAY","TMGMSG") +"RTN","TMGNDF1A",637,0) + +"RTN","TMGNDF1A",638,0) + if $data(TMGMSG) do +"RTN","TMGNDF1A",639,0) + . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") +"RTN","TMGNDF1A",640,0) + . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF1A",641,0) + . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",642,0) + . . set result=0 +"RTN","TMGNDF1A",643,0) + +"RTN","TMGNDF1A",644,0) + if result=0 goto GDIDone +"RTN","TMGNDF1A",645,0) + +"RTN","TMGNDF1A",646,0) + merge Array=TMGARRAY(22706.5,IENS) +"RTN","TMGNDF1A",647,0) + +"RTN","TMGNDF1A",648,0) + ;"Now look for entries in TMG FDA APPLICATION (22706.1) +"RTN","TMGNDF1A",649,0) + do GetSingleRec(22706.1,"^TMG(22706.1,""B"",",IEN,.Array) +"RTN","TMGNDF1A",650,0) + set Array("STRENGTH")=$translate(Array("STRENGTH"),",","") ;"remove ',''s from numbers +"RTN","TMGNDF1A",651,0) + +"RTN","TMGNDF1A",652,0) + ;"Now look for entries in TMG FDA DOSAGE FORM (22706.2) +"RTN","TMGNDF1A",653,0) + do GetMultRec(22706.2,"^TMG(22706.2,""B"",",IEN,.Array,"DOSE") +"RTN","TMGNDF1A",654,0) + +"RTN","TMGNDF1A",655,0) + ;"Now look for entries in TMG FDA FIRMS (22706.3) +"RTN","TMGNDF1A",656,0) + do GetSingleRec(22706.3,"^TMG(22706.3,""B"",",IEN,.Array) +"RTN","TMGNDF1A",657,0) + +"RTN","TMGNDF1A",658,0) + ;"Now look for entries in TMG FDA FORMULATION (22706.4) +"RTN","TMGNDF1A",659,0) + do +"RTN","TMGNDF1A",660,0) + . new tempArray,index +"RTN","TMGNDF1A",661,0) + . do GetMultRec(22706.4,"^TMG(22706.4,""B"",",IEN,.tempArray,"FORMULATION") +"RTN","TMGNDF1A",662,0) + . ;"Note: I need instead to screen for duplicates ingredient entries +"RTN","TMGNDF1A",663,0) + . set index=$order(tempArray("FORMULATION","")) +"RTN","TMGNDF1A",664,0) + . if +index>0 for do quit:(+index'>0) +"RTN","TMGNDF1A",665,0) + . . new i2 set i2=index+1 +"RTN","TMGNDF1A",666,0) + . . new name1,name2 +"RTN","TMGNDF1A",667,0) + . . set name1=$name(tempArray("FORMULATION",index)) +"RTN","TMGNDF1A",668,0) + . . for do quit:(+i2'>0) +"RTN","TMGNDF1A",669,0) + . . . set name2=$name(tempArray("FORMULATION",i2)) +"RTN","TMGNDF1A",670,0) + . . . set i2=$order(tempArray("FORMULATION",i2)) +"RTN","TMGNDF1A",671,0) + . . . if $data(@name2)'>0 quit +"RTN","TMGNDF1A",672,0) + . . . if $$CompArray^TMGMISC(name1,name2) do +"RTN","TMGNDF1A",673,0) + . . . . kill @name2 +"RTN","TMGNDF1A",674,0) + . . set index=$order(tempArray("FORMULATION",index)) +"RTN","TMGNDF1A",675,0) + . ;"Now put cleaned results of tempArray into Array +"RTN","TMGNDF1A",676,0) + . set index=$order(tempArray("FORMULATION","")) +"RTN","TMGNDF1A",677,0) + . new count set count=0 +"RTN","TMGNDF1A",678,0) + . set Array("FORMULATION","COUNT")=0 +"RTN","TMGNDF1A",679,0) + . if +index>0 for do quit:(+index'>0) +"RTN","TMGNDF1A",680,0) + . . if $data(tempArray("FORMULATION",index)) do +"RTN","TMGNDF1A",681,0) + . . . set count=count+1 +"RTN","TMGNDF1A",682,0) + . . . merge Array("FORMULATION",count)=tempArray("FORMULATION",index) +"RTN","TMGNDF1A",683,0) + . . . set Array("FORMULATION","COUNT")=count +"RTN","TMGNDF1A",684,0) + . . set index=$order(tempArray("FORMULATION",index)) +"RTN","TMGNDF1A",685,0) + +"RTN","TMGNDF1A",686,0) + ;"Now look for entries in TMG FDA PACKAGES (22706.6) +"RTN","TMGNDF1A",687,0) + do GetMultRec(22706.6,"^TMG(22706.6,""B"",",IEN,.Array,"PACKAGE") +"RTN","TMGNDF1A",688,0) + +"RTN","TMGNDF1A",689,0) + ;"Now look for entries in TMG FDA ROUTES (22706.7) +"RTN","TMGNDF1A",690,0) + do GetMultRec(22706.7,"^TMG(22706.7,""B"",",IEN,.Array,"ROUTE") +"RTN","TMGNDF1A",691,0) + if $length($get(Array("ROUTE",1,"NAME")))>16 do +"RTN","TMGNDF1A",692,0) + . new temp set temp=$$PShortName^TMGSHORT(Array("ROUTE",1,"NAME"),16,1) +"RTN","TMGNDF1A",693,0) + . if temp="^" quit +"RTN","TMGNDF1A",694,0) + . set Array("ROUTE",1,"NAME")=temp +"RTN","TMGNDF1A",695,0) + +"RTN","TMGNDF1A",696,0) + if $get(Array("FORMULATION","COUNT"),1)=1 do +"RTN","TMGNDF1A",697,0) + . new strength,str2 +"RTN","TMGNDF1A",698,0) + . new units,units2 +"RTN","TMGNDF1A",699,0) + . set strength=Array("STRENGTH") +"RTN","TMGNDF1A",700,0) + . set str2=$get(Array("FORMULATION",1,"STRENGTH")) +"RTN","TMGNDF1A",701,0) + . set units=$get(Array("UNIT")) +"RTN","TMGNDF1A",702,0) + . set units2=$get(Array("FORMULATION",1,"UNIT")) +"RTN","TMGNDF1A",703,0) + . if (+str2'>0)!(strength'=str2) do +"RTN","TMGNDF1A",704,0) + . . set Array("FORMULATION",1,"STRENGTH","OLD")=str2 +"RTN","TMGNDF1A",705,0) + . . set Array("FORMULATION",1,"STRENGTH")=strength +"RTN","TMGNDF1A",706,0) + . . set Array("FORMULATION",1,"UNIT","OLD")=units2 +"RTN","TMGNDF1A",707,0) + . . set Array("FORMULATION",1,"UNIT")=units +"RTN","TMGNDF1A",708,0) + +"RTN","TMGNDF1A",709,0) + ;"Now search for IEN in 50.68 of all ingredients, and find IEN for units name(s) +"RTN","TMGNDF1A",710,0) + new i,X,Y,TMGROOT,TMGMSG +"RTN","TMGNDF1A",711,0) + for i=1:1:Array("FORMULATION","COUNT") do +"RTN","TMGNDF1A",712,0) + . new DIC +"RTN","TMGNDF1A",713,0) + . set X=$get(Array("FORMULATION",i,"INGREDIENT NAME")) +"RTN","TMGNDF1A",714,0) + . if X="" quit +"RTN","TMGNDF1A",715,0) + . set Y=$$LookupRx^TMGNDF2B(X) +"RTN","TMGNDF1A",716,0) + . if +Y>0 set Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")=+Y +"RTN","TMGNDF1A",717,0) + . ;"look up unit name to find IEN in file 50.607 +"RTN","TMGNDF1A",718,0) + . set DIC(0)="M" +"RTN","TMGNDF1A",719,0) + . set DIC=50.607 +"RTN","TMGNDF1A",720,0) + . set X=$get(Array("FORMULATION",i,"UNIT")) +"RTN","TMGNDF1A",721,0) + . if X="" quit +"RTN","TMGNDF1A",722,0) + . do ^DIC +"RTN","TMGNDF1A",723,0) + . if +Y>0 set Array("FORMULATION",i,"UNIT","FILE 50.607 IEN")=+Y +"RTN","TMGNDF1A",724,0) + +"RTN","TMGNDF1A",725,0) + ;"Note the NDC (national drug code) is comprised as follows: +"RTN","TMGNDF1A",726,0) + ;"It is a 10 digit number comprised of three segments +"RTN","TMGNDF1A",727,0) + ;" 1st 4-5 digits - producer/packager <--> field#1 (LABEL CODE) in TMG FDA LISTING +"RTN","TMGNDF1A",728,0) + ;" next 3-4 digits -- the product code <--> field#2 (PRODUCT CODE) in TMG FDA LISTING +"RTN","TMGNDF1A",729,0) + ;" next 1-2 digits -- package code, specifying the package size <--> field#1 (CODE) in TMG FDA PACKAGES +"RTN","TMGNDF1A",730,0) + ;" the grouping will be: 4-4-2, or 5-3-2, or 5-4-1 +"RTN","TMGNDF1A",731,0) + +"RTN","TMGNDF1A",732,0) + set Array("NDC")=$get(Array("LABEL CODE"),"????")_"-" +"RTN","TMGNDF1A",733,0) + set Array("NDC")=Array("NDC")_$get(Array("PRODUCT CODE"),"????")_"-" +"RTN","TMGNDF1A",734,0) + set Array("NDC")=Array("NDC")_$get(Array("PACKAGE",1,"CODE"),"??") +"RTN","TMGNDF1A",735,0) + +"RTN","TMGNDF1A",736,0) + set Array("NDC")=$$NewNDC^TMGNDF2E(Array("NDC")) ;"added 5/28/06 //kt +"RTN","TMGNDF1A",737,0) + +"RTN","TMGNDF1A",738,0) + set Array("NDC","12DIGIT")=$translate(Array("NDC"),"-","") +"RTN","TMGNDF1A",739,0) + do ;"ensure length=12 +"RTN","TMGNDF1A",740,0) + . new num set num=Array("NDC","12DIGIT") +"RTN","TMGNDF1A",741,0) + . new l set l=$length(num) +"RTN","TMGNDF1A",742,0) + . if l>12 set num=$extract(num,l-11,99) +"RTN","TMGNDF1A",743,0) + . if l<12 set num=$extract("00000000000",1,12-l)_num ;"pad with leading 0's +"RTN","TMGNDF1A",744,0) + . set Array("NDC","12DIGIT")=num +"RTN","TMGNDF1A",745,0) + +"RTN","TMGNDF1A",746,0) + if $get(noLink)=1 goto GDIDone ;"Skip linkages if requested. +"RTN","TMGNDF1A",747,0) + +"RTN","TMGNDF1A",748,0) + ;"Now try to link to pre-existing VistA entries +"RTN","TMGNDF1A",749,0) + ;"Note--2/12/07 -- I am changing the significance of this link to 50.68 +"RTN","TMGNDF1A",750,0) + ;" I found that many drugs had multiple links to entries in 50.68, i.e. +"RTN","TMGNDF1A",751,0) + ;" there was a one-to-many relationship. And while it is helpful to +"RTN","TMGNDF1A",752,0) + ;" have a connection to *similar* drugs (i.e. to obtain missing +"RTN","TMGNDF1A",753,0) + ;" drug class, ingredients etc.), there is also value from having +"RTN","TMGNDF1A",754,0) + ;" a link to an EXACT match in 50.68 -- i.e. a one-to-one relationship. +"RTN","TMGNDF1A",755,0) + ;" I have therefore renamed the field in TMG FDA IMPORT COMPILED where +"RTN","TMGNDF1A",756,0) + ;" this information is stored to: VA PRODUCT SIMILAR MATCHES, and for +"RTN","TMGNDF1A",757,0) + ;" less certain matches, renamed it to: VA PRODUCT POSSIBLE MATCHES. +"RTN","TMGNDF1A",758,0) + ;" I have introduced a new field: 'NDC --> VA PRODUCT LINK' that +"RTN","TMGNDF1A",759,0) + ;" will hold a pointer to a record with the exact same NDC (national +"RTN","TMGNDF1A",760,0) + ;" drug code). This link will be established in a later stage. +"RTN","TMGNDF1A",761,0) + do +"RTN","TMGNDF1A",762,0) + . new DIC,X,Y +"RTN","TMGNDF1A",763,0) + . set DIC=50.67 +"RTN","TMGNDF1A",764,0) + . set DIC(0)="M" +"RTN","TMGNDF1A",765,0) + . ;"set X=""""_Array("NDC","12DIGIT")_"""" +"RTN","TMGNDF1A",766,0) + . set X=Array("NDC","12DIGIT") +"RTN","TMGNDF1A",767,0) + . do ^DIC +"RTN","TMGNDF1A",768,0) + . if Y=-1 quit +"RTN","TMGNDF1A",769,0) + . new tempIEN set tempIEN=$$GET1^DIQ(50.67,+Y_",",5,"I") +"RTN","TMGNDF1A",770,0) + . new tempResults +"RTN","TMGNDF1A",771,0) + . ;"do CheckNDCLink(tempIEN,.Array,.tempResults) +"RTN","TMGNDF1A",772,0) + . ;"if +$get(tempResults("COUNT"))'>0 do quit +"RTN","TMGNDF1A",773,0) + . ;". set Array("NDC","NOTE")="NDC Conflict found with drug IEN (in 50.68)="_tempIEN +"RTN","TMGNDF1A",774,0) + . set Array("FILE 50.68 IEN",1)=tempIEN +"RTN","TMGNDF1A",775,0) + . set Array("FILE 50.68 IEN","COUNT")=1 +"RTN","TMGNDF1A",776,0) + +"RTN","TMGNDF1A",777,0) + if +$get(Array("FILE 50.68 IEN","COUNT"))=0 do +"RTN","TMGNDF1A",778,0) + . new RArray +"RTN","TMGNDF1A",779,0) + . new temp +"RTN","TMGNDF1A",780,0) + . if $get(pIndex)'="" do +"RTN","TMGNDF1A",781,0) + . . set temp=$$Link2VAProd(.Array,.RArray,pIndex) +"RTN","TMGNDF1A",782,0) + . else do +"RTN","TMGNDF1A",783,0) + . . set temp=$$LinkToVAProd(.Array,.RArray) +"RTN","TMGNDF1A",784,0) + . merge Array("FILE 50.68 IEN")=RArray +"RTN","TMGNDF1A",785,0) + +"RTN","TMGNDF1A",786,0) +GDIDone +"RTN","TMGNDF1A",787,0) + quit result +"RTN","TMGNDF1A",788,0) + +"RTN","TMGNDF1A",789,0) + +"RTN","TMGNDF1A",790,0) +GetSingleRec(File,GRef,IEN,Array) +"RTN","TMGNDF1A",791,0) + ;"Purpose: To get the data from single record, that points to IEN, and put in Array +"RTN","TMGNDF1A",792,0) + ;"Input: File -- the file NUMBER +"RTN","TMGNDF1A",793,0) + ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' ) +"RTN","TMGNDF1A",794,0) + ;" IEN -- The IEN that is pointed to +"RTN","TMGNDF1A",795,0) + ;" Array -- an out parameter. PASS BY REFERENCE +"RTN","TMGNDF1A",796,0) + +"RTN","TMGNDF1A",797,0) + set GRef=GRef_IEN_","""")" +"RTN","TMGNDF1A",798,0) + set i=$order(@GRef) +"RTN","TMGNDF1A",799,0) + if +i>0 do +"RTN","TMGNDF1A",800,0) + . new IENS,TMGARRAY,TMGMSG +"RTN","TMGNDF1A",801,0) + . set IENS=i_"," +"RTN","TMGNDF1A",802,0) + . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG") +"RTN","TMGNDF1A",803,0) + . if $data(TMGMSG) do quit +"RTN","TMGNDF1A",804,0) + . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") +"RTN","TMGNDF1A",805,0) + . . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF1A",806,0) + . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",807,0) + . merge Array=TMGARRAY(File,IENS) +"RTN","TMGNDF1A",808,0) + +"RTN","TMGNDF1A",809,0) + quit +"RTN","TMGNDF1A",810,0) + +"RTN","TMGNDF1A",811,0) +GetMultRec(File,GRef,IEN,Array,Label) +"RTN","TMGNDF1A",812,0) + ;"Purpose: To get the data from mult records, that point to IEN, and put in Array +"RTN","TMGNDF1A",813,0) + ;"Input: File -- the file NUMBER +"RTN","TMGNDF1A",814,0) + ;" GRef -- the OPEN FORMAT global reference of B xref (e.g. '^TMG(22706.1,"B",' ) +"RTN","TMGNDF1A",815,0) + ;" IEN -- The IEN that is pointed to +"RTN","TMGNDF1A",816,0) + ;" Array -- an out parameter. PASS BY REFERENCE +"RTN","TMGNDF1A",817,0) + +"RTN","TMGNDF1A",818,0) + new count set count=1 +"RTN","TMGNDF1A",819,0) + new Ref +"RTN","TMGNDF1A",820,0) + set Ref=GRef_IEN_","""")" +"RTN","TMGNDF1A",821,0) + set i=$order(@Ref) +"RTN","TMGNDF1A",822,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF1A",823,0) + . new IENS,TMGARRAY,TMGMSG +"RTN","TMGNDF1A",824,0) + . set IENS=i_"," +"RTN","TMGNDF1A",825,0) + . do GETS^DIQ(File,IENS,"*","R","TMGARRAY","TMGMSG") +"RTN","TMGNDF1A",826,0) + . if $data(TMGMSG) do quit +"RTN","TMGNDF1A",827,0) + . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("TMGMSG") +"RTN","TMGNDF1A",828,0) + . . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF1A",829,0) + . . . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF1A",830,0) + . kill TMGARRAY(File,IENS,"LISTING") +"RTN","TMGNDF1A",831,0) + . if Label="ROUTE" kill TMGARRAY(File,IENS,"CODE") +"RTN","TMGNDF1A",832,0) + . if Label="DOSE" kill TMGARRAY(File,IENS,"DOSE FORM") +"RTN","TMGNDF1A",833,0) + . merge Array(Label,count)=TMGARRAY(File,IENS) +"RTN","TMGNDF1A",834,0) + . set Ref=GRef_IEN_",i)" +"RTN","TMGNDF1A",835,0) + . set i=$order(@Ref) +"RTN","TMGNDF1A",836,0) + . set count=count+1 +"RTN","TMGNDF1A",837,0) + +"RTN","TMGNDF1A",838,0) + quit +"RTN","TMGNDF1A",839,0) + +"RTN","TMGNDF1A",840,0) + +"RTN","TMGNDF1A",841,0) +LinkToVAProd(Array,Results) +"RTN","TMGNDF1A",842,0) + ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68) +"RTN","TMGNDF1A",843,0) + ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) +"RTN","TMGNDF1A",844,0) + ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array +"RTN","TMGNDF1A",845,0) + ;" if more than one IEN. e.g. +"RTN","TMGNDF1A",846,0) + ;" Results("COUNT")=3 +"RTN","TMGNDF1A",847,0) + ;" Results(1)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",848,0) + ;" Results(2)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",849,0) + ;" Results(3)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",850,0) + ;" Because a full match is sometimes not found (i.e. because minor variance), I +"RTN","TMGNDF1A",851,0) + ;" will return all close (but not necessarily perfect) matches as: +"RTN","TMGNDF1A",852,0) + ;" Results("POSS MATCH","COUNT")=IEN +"RTN","TMGNDF1A",853,0) + ;" Results("POSS MATCH",1)=ien +"RTN","TMGNDF1A",854,0) + ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found +"RTN","TMGNDF1A",855,0) + ;" (in which case all matches will be reported in Results array +"RTN","TMGNDF1A",856,0) + ;"Note: this function will have to scan through tens of thousands of entries in the main +"RTN","TMGNDF1A",857,0) + ;" drug files, so response may be slow. +"RTN","TMGNDF1A",858,0) + +"RTN","TMGNDF1A",859,0) + new result set result=0 +"RTN","TMGNDF1A",860,0) + kill Results +"RTN","TMGNDF1A",861,0) + new lmCount set lmCount=0 +"RTN","TMGNDF1A",862,0) + ;"Cycle through all records in file 50.68 (VA PRODUCT FILE) (global: ^PSNDF(50.68, ) +"RTN","TMGNDF1A",863,0) + new IEN +"RTN","TMGNDF1A",864,0) + set IEN=$order(^PSNDF(50.68,0)) +"RTN","TMGNDF1A",865,0) + if +IEN>0 for do quit:(IEN'>0) +"RTN","TMGNDF1A",866,0) + . if ($get(tmgTEST)=1) write IEN,! +"RTN","TMGNDF1A",867,0) + . do CheckLink(IEN,.Array,.Results) +"RTN","TMGNDF1A",868,0) + . set IEN=$order(^PSNDF(50.68,IEN)) +"RTN","TMGNDF1A",869,0) + +"RTN","TMGNDF1A",870,0) + if $get(Results("COUNT"))=1 do +"RTN","TMGNDF1A",871,0) + . set result=$order(Results("")) +"RTN","TMGNDF1A",872,0) + else if +$get(Results("COUNT"))=0 do +"RTN","TMGNDF1A",873,0) + . set result=0 +"RTN","TMGNDF1A",874,0) + else if $get(Results("COUNT"))>1 do +"RTN","TMGNDF1A",875,0) + . set result=-2 +"RTN","TMGNDF1A",876,0) + +"RTN","TMGNDF1A",877,0) + quit result +"RTN","TMGNDF1A",878,0) + +"RTN","TMGNDF1A",879,0) + +"RTN","TMGNDF1A",880,0) +Link2VAProd(Array,Results,pIndex) +"RTN","TMGNDF1A",881,0) + ;"Purpose: To take a given drug array, and match to an entry in file VA PRODUCT (50.68) +"RTN","TMGNDF1A",882,0) + ;" -- using a faster index method +"RTN","TMGNDF1A",883,0) + ;"Input: Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) +"RTN","TMGNDF1A",884,0) + ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array +"RTN","TMGNDF1A",885,0) + ;" if more than one IEN. e.g. +"RTN","TMGNDF1A",886,0) + ;" Results("COUNT")=3 +"RTN","TMGNDF1A",887,0) + ;" Results(1)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",888,0) + ;" Results(2)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",889,0) + ;" Results(3)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",890,0) + ;" Because a full match is sometimes not found (i.e. because minor variance), I +"RTN","TMGNDF1A",891,0) + ;" will return all close (but not necessarily perfect) matches as: +"RTN","TMGNDF1A",892,0) + ;" Results("POSS MATCH","COUNT")=IEN +"RTN","TMGNDF1A",893,0) + ;" Results("POSS MATCH",1)=ien +"RTN","TMGNDF1A",894,0) + ;" pIndex -- NAME OF index array to use, as created by IndexVAProd() +"RTN","TMGNDF1A",895,0) + ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" +"RTN","TMGNDF1A",896,0) + ;" @pIndex@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" +"RTN","TMGNDF1A",897,0) + ;"Result: Returns IEN in file 50.68, or 0 if not found, or -2 if multiple results found +"RTN","TMGNDF1A",898,0) + ;" (in which case all matches will be reported in Results array +"RTN","TMGNDF1A",899,0) + ;"Note: this function will have to scan through tens of thousands of entries in the main +"RTN","TMGNDF1A",900,0) + ;" drug files, so response may be slow. +"RTN","TMGNDF1A",901,0) + +"RTN","TMGNDF1A",902,0) + new result set result=0 +"RTN","TMGNDF1A",903,0) + kill Results +"RTN","TMGNDF1A",904,0) + new lmCount set lmCount=0 +"RTN","TMGNDF1A",905,0) + +"RTN","TMGNDF1A",906,0) + new PossMatch ;"an array to list all IENs in 50.68 containing ONE specified ingredient +"RTN","TMGNDF1A",907,0) + new IngredList ;"an array to hold IENS of all ingredients for drug info held in Array +"RTN","TMGNDF1A",908,0) + new NumIngredients +"RTN","TMGNDF1A",909,0) + new i +"RTN","TMGNDF1A",910,0) + for i=1:1:$get(Array("FORMULATION","COUNT")) do +"RTN","TMGNDF1A",911,0) + . new IngredIEN +"RTN","TMGNDF1A",912,0) + . set IngredIEN=$get(Array("FORMULATION",i,"INGREDIENT NAME","FILE 50.416 IEN")) +"RTN","TMGNDF1A",913,0) + . set IngredList(IngredIEN)="" +"RTN","TMGNDF1A",914,0) + . do GetIndexList(IngredIEN,pIndex,$name(PossMatch(IngredIEN))) +"RTN","TMGNDF1A",915,0) + ;"Example of Output from code above: +"RTN","TMGNDF1A",916,0) + ;" PossMatch(50,3456)="" +"RTN","TMGNDF1A",917,0) + ;" PossMatch(50,57698)="" +"RTN","TMGNDF1A",918,0) + ;" PossMatch(50,993)="" +"RTN","TMGNDF1A",919,0) + ;" PossMatch(99,3456)="" <-- 3456 has ingredient 99 and 50 +"RTN","TMGNDF1A",920,0) + ;" PossMatch(99,3876)="" +"RTN","TMGNDF1A",921,0) + ;" PossMatch(99,9902)="" +"RTN","TMGNDF1A",922,0) + set NumIngredients=$$ListCt^TMGMISC("PossMatch") +"RTN","TMGNDF1A",923,0) + +"RTN","TMGNDF1A",924,0) + ;"Now, add node to array above, with indexes switched. +"RTN","TMGNDF1A",925,0) + ;" PossMatch("x",3456,50)="" +"RTN","TMGNDF1A",926,0) + ;" PossMatch("x",3456,99)="" <-- 3456 has ingredient 99 and 50 +"RTN","TMGNDF1A",927,0) + ;" PossMatch("x",57698,50)="" +"RTN","TMGNDF1A",928,0) + ;" PossMatch("x",993,50)="" +"RTN","TMGNDF1A",929,0) + ;" PossMatch("x",3876,99)="" +"RTN","TMGNDF1A",930,0) + ;" PossMatch("x",9902,99)="" +"RTN","TMGNDF1A",931,0) + new VAPIEN +"RTN","TMGNDF1A",932,0) + set IngredIEN=$order(PossMatch("")) +"RTN","TMGNDF1A",933,0) + if +IngredIEN>0 for do quit:(+IngredIEN'>0) +"RTN","TMGNDF1A",934,0) + . set VAPIEN=$order(PossMatch(IngredIEN,"")) +"RTN","TMGNDF1A",935,0) + . if +VAPIEN>0 for do quit:(+VAPIEN'>0) +"RTN","TMGNDF1A",936,0) + . . set PossMatch("x",VAPIEN,IngredIEN)="" +"RTN","TMGNDF1A",937,0) + . . set VAPIEN=$order(PossMatch(IngredIEN,VAPIEN)) +"RTN","TMGNDF1A",938,0) + . set IngredIEN=$order(PossMatch(IngredIEN)) +"RTN","TMGNDF1A",939,0) + +"RTN","TMGNDF1A",940,0) + ;"now find those entries containing ALL given ingredients +"RTN","TMGNDF1A",941,0) + ;" PossMatch("+",3456)="" <--- only 3456 is a possible match +"RTN","TMGNDF1A",942,0) + set VAPIEN=$order(PossMatch("x","")) +"RTN","TMGNDF1A",943,0) + if +VAPIEN>0 for do quit:(+VAPIEN'>0) +"RTN","TMGNDF1A",944,0) + . if $$ListCt^TMGMISC($name(PossMatch("x",VAPIEN)))'0 for do quit:(IEN'>0) +"RTN","TMGNDF1A",952,0) + . do CheckLink(IEN,.Array,.Results) +"RTN","TMGNDF1A",953,0) + . set IEN=$order(PossMatch("+",IEN)) +"RTN","TMGNDF1A",954,0) + +"RTN","TMGNDF1A",955,0) + if $get(Results("COUNT"))=1 do +"RTN","TMGNDF1A",956,0) + . set result=$order(Results("")) +"RTN","TMGNDF1A",957,0) + else if +$get(Results("COUNT"))=0 do +"RTN","TMGNDF1A",958,0) + . set result=0 +"RTN","TMGNDF1A",959,0) + else if $get(Results("COUNT"))>1 do +"RTN","TMGNDF1A",960,0) + . set result=-2 +"RTN","TMGNDF1A",961,0) + +"RTN","TMGNDF1A",962,0) +L2VPDone +"RTN","TMGNDF1A",963,0) + quit result +"RTN","TMGNDF1A",964,0) + +"RTN","TMGNDF1A",965,0) + +"RTN","TMGNDF1A",966,0) +CheckLink(IEN,Array,Results) +"RTN","TMGNDF1A",967,0) + ;"Purpose: To take a given drug array, and check for match to an entry in file VA PRODUCT (50.68) +"RTN","TMGNDF1A",968,0) + ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array +"RTN","TMGNDF1A",969,0) + ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) +"RTN","TMGNDF1A",970,0) + ;" partial reference below (See GetDrugInfo for full reference) +"RTN","TMGNDF1A",971,0) + ;" Array('FORMULATION','COUNT')=1 +"RTN","TMGNDF1A",972,0) + ;" Array('FORMULATION',1,'STRENGTH') +"RTN","TMGNDF1A",973,0) + ;" Array('FORMULATION',1,'UNIT') +"RTN","TMGNDF1A",974,0) + ;" Array('FORMULATION',1,'UNIT','FILE 50.607 IEN') ;note may contain -1 if match not found +"RTN","TMGNDF1A",975,0) + ;" Array('FORMULATION',1,'INGREDIENT NAME') +"RTN","TMGNDF1A",976,0) + ;" Array('FORMULATION',1,'INGREDIENT NAME','FILE 50.416 IEN) ;note may contain -1 if match not found +"RTN","TMGNDF1A",977,0) + ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array +"RTN","TMGNDF1A",978,0) + ;" if more than one IEN. e.g. +"RTN","TMGNDF1A",979,0) + ;" Results("COUNT")=3 +"RTN","TMGNDF1A",980,0) + ;" Results(1)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",981,0) + ;" Results(2)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",982,0) + ;" Results(3)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",983,0) + ;" Because a full match is sometimes not found (i.e. because minor variance), I +"RTN","TMGNDF1A",984,0) + ;" will return all close (but not necessarily perfect) matches as: +"RTN","TMGNDF1A",985,0) + ;" Results("POSS MATCH","COUNT")=IEN +"RTN","TMGNDF1A",986,0) + ;" Results("POSS MATCH",1)=ien +"RTN","TMGNDF1A",987,0) + ;"Result: None (but returns results in Results array) +"RTN","TMGNDF1A",988,0) + +"RTN","TMGNDF1A",989,0) + ;"Note: this function will have to scan through tens of thousands of entries in the main +"RTN","TMGNDF1A",990,0) + ;" drug files, so response may be slow. +"RTN","TMGNDF1A",991,0) + +"RTN","TMGNDF1A",992,0) + new result set result=0 +"RTN","TMGNDF1A",993,0) + new lmCount set lmCount=0 +"RTN","TMGNDF1A",994,0) + +"RTN","TMGNDF1A",995,0) + new ingredient,igdIEN +"RTN","TMGNDF1A",996,0) + new match set match=1 ;"default to true +"RTN","TMGNDF1A",997,0) + new numIngredients +"RTN","TMGNDF1A",998,0) + set numIngredients=$get(Array("FORMULATION","COUNT")) +"RTN","TMGNDF1A",999,0) + if numIngredients=0 set match=0 +"RTN","TMGNDF1A",1000,0) + else for ingredient=1:1 do quit:(+igdIEN'>0)!(match=0) +"RTN","TMGNDF1A",1001,0) + . set igdIEN=$get(Array("FORMULATION",ingredient,"INGREDIENT NAME","FILE 50.416 IEN")) +"RTN","TMGNDF1A",1002,0) + . if +igdIEN'>0 do quit +"RTN","TMGNDF1A",1003,0) + . . if igdIEN="" quit ;"just at end of list of ingredients +"RTN","TMGNDF1A",1004,0) + . . if igdIEN=-1 set match=0 ;"here igdIEN must =-1 (prior ^DIC failed to find match) +"RTN","TMGNDF1A",1005,0) + . new node set node=$get(^PSNDF(50.68,IEN,2,igdIEN,0)) +"RTN","TMGNDF1A",1006,0) + . if node="" do quit +"RTN","TMGNDF1A",1007,0) + . . set match=0 quit ;"no match found +"RTN","TMGNDF1A",1008,0) + . ;"If we get here, we have a match. Now check for matching strength and units +"RTN","TMGNDF1A",1009,0) + . set lmCount=lmCount+1 +"RTN","TMGNDF1A",1010,0) + . set Results("POSS MATCH",lmCount)=IEN +"RTN","TMGNDF1A",1011,0) + . set Results("POSS MATCH","COUNT")=lmCount +"RTN","TMGNDF1A",1012,0) + . set Results("POSS MATCH","INDEX",IEN)=lmCount +"RTN","TMGNDF1A",1013,0) + . new strength set strength=$piece(node,"^",2) +"RTN","TMGNDF1A",1014,0) + . new str2 set str2=$get(Array("FORMULATION",ingredient,"STRENGTH")) +"RTN","TMGNDF1A",1015,0) + . if +strength'=+str2 do quit +"RTN","TMGNDF1A",1016,0) + . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage STRENGTH mis-match" +"RTN","TMGNDF1A",1017,0) + . . set Results("POSS MATCH",lmCount,"MSG")="Import="_str2_", VistA="_strength +"RTN","TMGNDF1A",1018,0) + . . set match=0 +"RTN","TMGNDF1A",1019,0) + . new units set units=$piece(node,"^",3) +"RTN","TMGNDF1A",1020,0) + . new units2 set units2=$get(Array("FORMULATION",ingredient,"UNIT","FILE 50.607 IEN")) +"RTN","TMGNDF1A",1021,0) + . if units'=units2 do +"RTN","TMGNDF1A",1022,0) + . . set Results("POSS MATCH",lmCount,"PROBLEM")="dosage UNITS mis-match" +"RTN","TMGNDF1A",1023,0) + . . new s +"RTN","TMGNDF1A",1024,0) + . . set s="Import="_$$GET1^DIQ(50.607,units2_",",".01") +"RTN","TMGNDF1A",1025,0) + . . set s=s_", VistA="_$$GET1^DIQ(50.607,units_",",".01") +"RTN","TMGNDF1A",1026,0) + . . set Results("POSS MATCH",lmCount,"MSG")=s +"RTN","TMGNDF1A",1027,0) + . . set match=0 +"RTN","TMGNDF1A",1028,0) + . ;"Now see if VistA drug has more ingredients than import drug. +"RTN","TMGNDF1A",1029,0) + . new IgdCount set IgdCount=0 +"RTN","TMGNDF1A",1030,0) + . new TempIdx set TempIdx=$order(^PSNDF(50.68,IEN,2,0)) +"RTN","TMGNDF1A",1031,0) + . if TempIdx'="" for do quit:(+TempIdx'>0) +"RTN","TMGNDF1A",1032,0) + . . set IgdCount=IgdCount+1 +"RTN","TMGNDF1A",1033,0) + . . set TempIdx=$order(^PSNDF(50.68,IEN,2,TempIdx)) +"RTN","TMGNDF1A",1034,0) + . if IgdCount'=numIngredients do quit +"RTN","TMGNDF1A",1035,0) + . . set Results("POSS MATCH",lmCount,"PROBLEM")="Number of ingredients mismatch" +"RTN","TMGNDF1A",1036,0) + . . set Results("POSS MATCH",lmCount,"MSG")="Import="_numIngredients_", VistA="_IgdCount +"RTN","TMGNDF1A",1037,0) + . . set match=0 +"RTN","TMGNDF1A",1038,0) + if match=1 do +"RTN","TMGNDF1A",1039,0) + . new count set count=$get(Results("COUNT"))+1 +"RTN","TMGNDF1A",1040,0) + . set Results(count)=IEN +"RTN","TMGNDF1A",1041,0) + . set Results("COUNT")=count +"RTN","TMGNDF1A",1042,0) + +"RTN","TMGNDF1A",1043,0) + ;"Now, remove entries in POSS MATCH that are actual full matches. +"RTN","TMGNDF1A",1044,0) + new SomeKilled set SomeKilled=0 +"RTN","TMGNDF1A",1045,0) + new index +"RTN","TMGNDF1A",1046,0) + for index=1:1:+$get(Results("COUNT")) do +"RTN","TMGNDF1A",1047,0) + . new matchIEN set matchIEN=$get(Results(index)) +"RTN","TMGNDF1A",1048,0) + . new possEntry set possEntry=$get(Results("POSS MATCH","INDEX",matchIEN)) +"RTN","TMGNDF1A",1049,0) + . kill Results("POSS MATCH",possEntry) +"RTN","TMGNDF1A",1050,0) + . kill Results("POSS MATCH","INDEX",matchIEN) +"RTN","TMGNDF1A",1051,0) + . set SomeKilled=1 +"RTN","TMGNDF1A",1052,0) + . set Results("POSS MATCH","COUNT")=$get(Results("POSS MATCH","COUNT"))-1 +"RTN","TMGNDF1A",1053,0) + +"RTN","TMGNDF1A",1054,0) + ;"Now renumber remaining POSS MATCHES +"RTN","TMGNDF1A",1055,0) + if SomeKilled do +"RTN","TMGNDF1A",1056,0) + . do ListPack^TMGMISC($name(Results("POSS MATCH"))) +"RTN","TMGNDF1A",1057,0) + . set Results("POSS MATCH","COUNT")=$$ListCt^TMGMISC($name(Results("POSS MATCH"))) +"RTN","TMGNDF1A",1058,0) + +"RTN","TMGNDF1A",1059,0) + ;"set index=$order(Results("POSS MATCH","")) +"RTN","TMGNDF1A",1060,0) + ;"new newCount set newCount=0 +"RTN","TMGNDF1A",1061,0) + ;"if +index>0 for do quit:(index'>0) +"RTN","TMGNDF1A",1062,0) + ;". set newCount=newCount+1 +"RTN","TMGNDF1A",1063,0) + ;". merge Results("POSS MATCH 2",newCount)=Results("POSS MATCH",index) +"RTN","TMGNDF1A",1064,0) + ;". set Results("POSS MATCH 2","COUNT")=$get(Results("POSS MATCH 2","COUNT"))+1 +"RTN","TMGNDF1A",1065,0) + ;". set index=$order(Results("POSS MATCH",index)) +"RTN","TMGNDF1A",1066,0) + ;"if $data(Results("POSS MATCH 2"))>0 do +"RTN","TMGNDF1A",1067,0) + ;". kill Results("POSS MATCH") +"RTN","TMGNDF1A",1068,0) + ;". merge Results("POSS MATCH")=Results("POSS MATCH 2") +"RTN","TMGNDF1A",1069,0) + ;". kill Results("POSS MATCH 2") +"RTN","TMGNDF1A",1070,0) + +"RTN","TMGNDF1A",1071,0) + quit +"RTN","TMGNDF1A",1072,0) + +"RTN","TMGNDF1A",1073,0) + +"RTN","TMGNDF1A",1074,0) +CheckNDCLink(IEN,Array,Results) +"RTN","TMGNDF1A",1075,0) + ;"This is like CheckLink, except is it a little bit more lenient about the allowed +"RTN","TMGNDF1A",1076,0) + ;" variances. For example if UNITS of measure are different (e.g. MG vs. MG/VIAL). +"RTN","TMGNDF1A",1077,0) + ;"Input: IEN -- An IEN in file 50.68 to try for a match, seeing if matches info in Array +"RTN","TMGNDF1A",1078,0) + ;" Array -- PASS BY REFERENCE. An array holding drug info, as created by GetDrugInfo(IEN,Array) +"RTN","TMGNDF1A",1079,0) + ;" Results -- OPTIONAL, PASS BY REFERENCE, an OUT parameter to receive results array +"RTN","TMGNDF1A",1080,0) + ;" if more than one IEN. e.g. +"RTN","TMGNDF1A",1081,0) + ;" Results("COUNT")=3 +"RTN","TMGNDF1A",1082,0) + ;" Results(1)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",1083,0) + ;" Results(2)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",1084,0) + ;" Results(3)=IEN ;IEN is from file 50.68 +"RTN","TMGNDF1A",1085,0) + ;" Because a full match is sometimes not found (i.e. because minor variance), I +"RTN","TMGNDF1A",1086,0) + ;" will return all close (but not necessarily perfect) matches as: +"RTN","TMGNDF1A",1087,0) + ;" Results("POSS MATCH","COUNT")=IEN +"RTN","TMGNDF1A",1088,0) + ;" Results("POSS MATCH",1)=ien +"RTN","TMGNDF1A",1089,0) + ;"Result: None (but returns results in Results array) +"RTN","TMGNDF1A",1090,0) + +"RTN","TMGNDF1A",1091,0) + ;"Note: this function will have to scan through tens of thousands of entries in the main +"RTN","TMGNDF1A",1092,0) + ;" drug files, so response may be slow. +"RTN","TMGNDF1A",1093,0) + +"RTN","TMGNDF1A",1094,0) + new match +"RTN","TMGNDF1A",1095,0) + +"RTN","TMGNDF1A",1096,0) + do CheckLink(IEN,.Array,.Results) +"RTN","TMGNDF1A",1097,0) + if +$get(Results("COUNT"))<1 do +"RTN","TMGNDF1A",1098,0) + . new i,max,done +"RTN","TMGNDF1A",1099,0) + . set done=0 +"RTN","TMGNDF1A",1100,0) + . set max=$get(Results("POSS MATCH","COUNT")) +"RTN","TMGNDF1A",1101,0) + . for i=1:1:max do quit:(done=1) +"RTN","TMGNDF1A",1102,0) + . . if Results("POSS MATCH",i,"PROBLEM")="dosage UNITS mis-match" do +"RTN","TMGNDF1A",1103,0) + . . . set Results(1)=Results("POSS MATCH",i) +"RTN","TMGNDF1A",1104,0) + . . . kill Results("POSS MATCH",i) +"RTN","TMGNDF1A",1105,0) + . . . do ListPack^TMGMISC($name(Results("POSS MATCH"))) +"RTN","TMGNDF1A",1106,0) + . . . set Results("COUNT")=$$ListCt^TMGMISC("Results") +"RTN","TMGNDF1A",1107,0) + . . . set done=1 +"RTN","TMGNDF1A",1108,0) + +"RTN","TMGNDF1A",1109,0) + quit +"RTN","TMGNDF1A",1110,0) + +"RTN","TMGNDF1A",1111,0) + +"RTN","TMGNDF1A",1112,0) +GetpVAPIndex() +"RTN","TMGNDF1A",1113,0) + ;"Purpose: to return a pointer to an index of the VAProduct file +"RTN","TMGNDF1A",1114,0) + ;"Input: none +"RTN","TMGNDF1A",1115,0) + ;"Output: returns the NAME of index of VAProduct, or ^ for abort +"RTN","TMGNDF1A",1116,0) + +"RTN","TMGNDF1A",1117,0) + new pIndex set pIndex=$name(^TMG("TMP","indexVAProduct")) +"RTN","TMGNDF1A",1118,0) + new abort set abort=0 +"RTN","TMGNDF1A",1119,0) + if $data(@pIndex) do +"RTN","TMGNDF1A",1120,0) + . new % set %=2 +"RTN","TMGNDF1A",1121,0) + . write "Recreate temporary VA PRODUCT file index *IF* there have",! +"RTN","TMGNDF1A",1122,0) + . write "been any changes made to this file since last index.",! +"RTN","TMGNDF1A",1123,0) + . write "Re-index" do YN^DICN write ! +"RTN","TMGNDF1A",1124,0) + . if %=1 kill @pIndex +"RTN","TMGNDF1A",1125,0) + . if %=-1 set abort=1 +"RTN","TMGNDF1A",1126,0) + if abort=1 set pIndex="^" goto GVAPIDone +"RTN","TMGNDF1A",1127,0) + +"RTN","TMGNDF1A",1128,0) + if $data(@pIndex)=0 do IndexVAProd(pIndex) +"RTN","TMGNDF1A",1129,0) + +"RTN","TMGNDF1A",1130,0) +GVAPIDone +"RTN","TMGNDF1A",1131,0) + quit pIndex +"RTN","TMGNDF1A",1132,0) + +"RTN","TMGNDF1A",1133,0) +IndexVAProd(pArray) +"RTN","TMGNDF1A",1134,0) + ;"Purpose: to make a temporary index of the VA PRODUCT file based on the ACTIVE INGREDIENTS field +"RTN","TMGNDF1A",1135,0) + ;"Input: pArray: the NAME OF the array to store index in +"RTN","TMGNDF1A",1136,0) + ;"Output: Index will be stored in array like this: +"RTN","TMGNDF1A",1137,0) + ;" @pArray@(IngredientIEN, 50.68 IEN, 50.6814 IEN)="" +"RTN","TMGNDF1A",1138,0) + ;"Result: none: +"RTN","TMGNDF1A",1139,0) + ;"Note: prior values in pArray will NOT be killed. +"RTN","TMGNDF1A",1140,0) + ;" Also, the VA PRODUCT file is setup such that the 50.6814 IEN will also watch IngredientIEN +"RTN","TMGNDF1A",1141,0) + +"RTN","TMGNDF1A",1142,0) + new IEN,subIEN,node,Ingredient +"RTN","TMGNDF1A",1143,0) + +"RTN","TMGNDF1A",1144,0) + ;"set IEN=$order(^PSNDF(50.68,0)) +"RTN","TMGNDF1A",1145,0) + ;"if (+IEN>0) for do quit:(+IEN'>0) +"RTN","TMGNDF1A",1146,0) + +"RTN","TMGNDF1A",1147,0) + write "Creating a temporary index of VA PRODUCT FILE",! +"RTN","TMGNDF1A",1148,0) + new Itr,IEN +"RTN","TMGNDF1A",1149,0) + set IEN=$$ItrInit^TMGITR(50.68,.Itr) +"RTN","TMGNDF1A",1150,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1A",1151,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF1A",1152,0) + . set subIEN=$order(^PSNDF(50.68,IEN,2,0)) +"RTN","TMGNDF1A",1153,0) + . if (+subIEN>0) for do quit:(+subIEN'>0) +"RTN","TMGNDF1A",1154,0) + . . set node=$get(^PSNDF(50.68,IEN,2,subIEN,0)) +"RTN","TMGNDF1A",1155,0) + . . set Ingredient=$piece(node,"^",1) +"RTN","TMGNDF1A",1156,0) + . . if +Ingredient>0 do +"RTN","TMGNDF1A",1157,0) + . . . set @pArray@(Ingredient,IEN,subIEN)="" +"RTN","TMGNDF1A",1158,0) + . . . ;"set @pArray@("IEN",IEN,subIEN)=Ingredient +"RTN","TMGNDF1A",1159,0) + . . set subIEN=$order(^PSNDF(50.68,IEN,2,subIEN)) +"RTN","TMGNDF1A",1160,0) + . ;"set IEN=$order(^PSNDF(50.68,IEN)) +"RTN","TMGNDF1A",1161,0) + +"RTN","TMGNDF1A",1162,0) + write ! +"RTN","TMGNDF1A",1163,0) + quit +"RTN","TMGNDF1A",1164,0) + +"RTN","TMGNDF1A",1165,0) + +"RTN","TMGNDF1A",1166,0) +GetIndexList(Ingredient,pIndex,pArray) +"RTN","TMGNDF1A",1167,0) + ;"Purpose: for a given Ingredient, return a list of all records containing this ingredient +"RTN","TMGNDF1A",1168,0) + ;"Input: Ingredient -- the IEN (from file 50.416) to scan for +"RTN","TMGNDF1A",1169,0) + ;" pIndex -- NAME OF index array, as created by IndexVaProd() +"RTN","TMGNDF1A",1170,0) + ;" pArray -- NAME OF array to put data into +"RTN","TMGNDF1A",1171,0) + ;"Output: results will be put in like this: +"RTN","TMGNDF1A",1172,0) + ;" @pArray@(IEN from 50.68)="" +"RTN","TMGNDF1A",1173,0) + ;"results: none +"RTN","TMGNDF1A",1174,0) + ;"Note: any prior data in pArray WILL BE KILLED +"RTN","TMGNDF1A",1175,0) + +"RTN","TMGNDF1A",1176,0) + kill @pArray +"RTN","TMGNDF1A",1177,0) + +"RTN","TMGNDF1A",1178,0) + new IEN +"RTN","TMGNDF1A",1179,0) + set IEN=$order(@pIndex@(Ingredient,"")) +"RTN","TMGNDF1A",1180,0) + if +IEN>0 for do quit:(+IEN'>0) +"RTN","TMGNDF1A",1181,0) + . set @pArray@(IEN)="" +"RTN","TMGNDF1A",1182,0) + . set IEN=$order(@pIndex@(Ingredient,IEN)) +"RTN","TMGNDF1A",1183,0) + +"RTN","TMGNDF1A",1184,0) + quit +"RTN","TMGNDF1A",1185,0) + +"RTN","TMGNDF1A",1186,0) + +"RTN","TMGNDF1A",1187,0) +FixGenerics +"RTN","TMGNDF1A",1188,0) + ;"Purpose: After running the Compile function, I found that many records did not have +"RTN","TMGNDF1A",1189,0) + ;" an entry for the GENERIC NAME field. This seems to happen when a drug has no +"RTN","TMGNDF1A",1190,0) + ;" Ingredients listed. But often there are other drugs with the same name that DO +"RTN","TMGNDF1A",1191,0) + ;" have ingredients. If so, then the errent record is essentially a duplicate (except +"RTN","TMGNDF1A",1192,0) + ;" for different NDC etc), and isn't needed. Therefore the SKIP THIS RECORD field +"RTN","TMGNDF1A",1193,0) + ;" can be set to 1 (SKIP). But, if there isn't a duplicate record, then the tradename +"RTN","TMGNDF1A",1194,0) + ;" will be used as the GENERIC name +"RTN","TMGNDF1A",1195,0) + +"RTN","TMGNDF1A",1196,0) + new IEN,count +"RTN","TMGNDF1A",1197,0) + new TMGGeneric,TradeName +"RTN","TMGNDF1A",1198,0) + +"RTN","TMGNDF1A",1199,0) + set IEN=$order(^TMG(22706.9,0)) +"RTN","TMGNDF1A",1200,0) + if IEN'="" for do quit:(+IEN'>0) +"RTN","TMGNDF1A",1201,0) + . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME +"RTN","TMGNDF1A",1202,0) + . if (TMGGeneric="") do +"RTN","TMGNDF1A",1203,0) + . . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME +"RTN","TMGNDF1A",1204,0) + . . new list +"RTN","TMGNDF1A",1205,0) + . . do ScanFor(TradeName,.list) +"RTN","TMGNDF1A",1206,0) + . . set count=$$ListCt^TMGMISC("list") +"RTN","TMGNDF1A",1207,0) + . . if count=1 do +"RTN","TMGNDF1A",1208,0) + . . . write "Unique drug, with no ingredients: ",TradeName,! +"RTN","TMGNDF1A",1209,0) + . . . do FindSimNames(TradeName,.list) +"RTN","TMGNDF1A",1210,0) + . . . if $data(list) zwr list +"RTN","TMGNDF1A",1211,0) + . . else do +"RTN","TMGNDF1A",1212,0) + . . . write "Drug, with no ingredients: ",TradeName," --> ",count," other similar drugs.",! +"RTN","TMGNDF1A",1213,0) + . set IEN=$order(^TMG(22706.9,IEN)) +"RTN","TMGNDF1A",1214,0) + +"RTN","TMGNDF1A",1215,0) + quit +"RTN","TMGNDF1A",1216,0) + +"RTN","TMGNDF1A",1217,0) + +"RTN","TMGNDF1A",1218,0) + +"RTN","TMGNDF1A",1219,0) + +"RTN","TMGNDF1A",1220,0) +ScanFor(Name,Array) +"RTN","TMGNDF1A",1221,0) + ;"Purpose: To scan file 22706.9 (TMG FDA IMPORT COMPILED) for records with field TRADENAME +"RTN","TMGNDF1A",1222,0) + ;" contains to 'TradeName' +"RTN","TMGNDF1A",1223,0) + ;"Input: Name -- the value to search for +"RTN","TMGNDF1A",1224,0) + ;" Array -- PASS BY REFERENCE. An OUT parameter for result: +"RTN","TMGNDF1A",1225,0) + ;" Array(Name,IEN)="" +"RTN","TMGNDF1A",1226,0) + ;" Array(Name,IEN)="" +"RTN","TMGNDF1A",1227,0) + ;" Array(Name,IEN)="" +"RTN","TMGNDF1A",1228,0) + ;"Results: none +"RTN","TMGNDF1A",1229,0) + +"RTN","TMGNDF1A",1230,0) + new IEN +"RTN","TMGNDF1A",1231,0) + new TradeName +"RTN","TMGNDF1A",1232,0) + +"RTN","TMGNDF1A",1233,0) + set IEN=$order(^TMG(22706.9,0)) +"RTN","TMGNDF1A",1234,0) + if IEN'="" for do quit:(+IEN'>0) +"RTN","TMGNDF1A",1235,0) + . set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME +"RTN","TMGNDF1A",1236,0) + . if TradeName[Name do +"RTN","TMGNDF1A",1237,0) + . . set Array(Name,IEN)=TradeName +"RTN","TMGNDF1A",1238,0) + . set IEN=$order(^TMG(22706.9,IEN)) +"RTN","TMGNDF1A",1239,0) + +"RTN","TMGNDF1A",1240,0) + quit +"RTN","TMGNDF1A",1241,0) + +"RTN","TMGNDF1A",1242,0) + +"RTN","TMGNDF1A",1243,0) +FindSimNames(Name,Array) +"RTN","TMGNDF1A",1244,0) + ;"Purpose: to scan TMG FDA IMPORT COMPILED file and return an array of similar entries. +"RTN","TMGNDF1A",1245,0) + ;"Input: Name: the name of the Name drug name to scan for +"RTN","TMGNDF1A",1246,0) + ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed +"RTN","TMGNDF1A",1247,0) + ;"Result: none (output is in Array) +"RTN","TMGNDF1A",1248,0) + +"RTN","TMGNDF1A",1249,0) + new i,i2,s +"RTN","TMGNDF1A",1250,0) + new NumWords,TradeName +"RTN","TMGNDF1A",1251,0) + set NumWords=$length(Name," ") +"RTN","TMGNDF1A",1252,0) + kill Array +"RTN","TMGNDF1A",1253,0) + +"RTN","TMGNDF1A",1254,0) + set i2=$order(^TMG(22706.9,0)) +"RTN","TMGNDF1A",1255,0) + if i2'="" for do quit:(i2="") +"RTN","TMGNDF1A",1256,0) + . set TradeName=$piece($get(^TMG(22706.9,i2,0)),"^",4) ;"get field#.05, TRADENAME +"RTN","TMGNDF1A",1257,0) + . new IEN set IEN=i2 +"RTN","TMGNDF1A",1258,0) + . set i2=$order(^TMG(22706.9,i2)) +"RTN","TMGNDF1A",1259,0) + . if NumWords'=$length(TradeName," ") quit +"RTN","TMGNDF1A",1260,0) + . new temp set temp=TradeName +"RTN","TMGNDF1A",1261,0) + . for i=1:1:NumWords do quit:(s="")!(temp="") +"RTN","TMGNDF1A",1262,0) + . . set s=$piece(Name," ",i) +"RTN","TMGNDF1A",1263,0) + . . set s=$piece(s," ",1) ;"get first word of multi-word drug name +"RTN","TMGNDF1A",1264,0) + . . if s="" quit +"RTN","TMGNDF1A",1265,0) + . . if $extract(TradeName,1,$length(s))'=s set temp="" +"RTN","TMGNDF1A",1266,0) + . if temp'="" do +"RTN","TMGNDF1A",1267,0) + . . set Array(TradeName)=IEN_"^"_TradeName +"RTN","TMGNDF1A",1268,0) + +"RTN","TMGNDF1A",1269,0) + new count +"RTN","TMGNDF1A",1270,0) + set count=$$ListCt^TMGMISC("Array") +"RTN","TMGNDF1A",1271,0) + if count>1 do +"RTN","TMGNDF1A",1272,0) + . do NarrowGenMatches^TMGNDF2C(Name,.Array," ") +"RTN","TMGNDF1A",1273,0) + . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement +"RTN","TMGNDF1A",1274,0) + . . kill Array +"RTN","TMGNDF1A",1275,0) + +"RTN","TMGNDF1A",1276,0) + quit +"RTN","TMGNDF1A",1277,0) + +"RTN","TMGNDF1A",1278,0) + +"RTN","TMGNDF1A",1279,0) +FixLink +"RTN","TMGNDF1A",1280,0) + ;"Purpose: ask user for entry in 22706.9 to fix, then try to fix link +"RTN","TMGNDF1A",1281,0) + +"RTN","TMGNDF1A",1282,0) + new IEN +"RTN","TMGNDF1A",1283,0) + new DIC,X,Y +"RTN","TMGNDF1A",1284,0) + set DIC=22706.9,DIC(0)="MAEQ" +"RTN","TMGNDF1A",1285,0) + do ^DIC write ! +"RTN","TMGNDF1A",1286,0) + if +Y>0 do Fix1Link(+Y) +"RTN","TMGNDF1A",1287,0) + quit +"RTN","TMGNDF1A",1288,0) + +"RTN","TMGNDF1A",1289,0) + +"RTN","TMGNDF1A",1290,0) +Fix1Link(IEN) +"RTN","TMGNDF1A",1291,0) + ;"Purpose: To attemp to fix an entry that doesn't have a link to a VA PRODUCT entry +"RTN","TMGNDF1A",1292,0) + ;"Input: IEN -- an IEN from 22706.9 +"RTN","TMGNDF1A",1293,0) + +"RTN","TMGNDF1A",1294,0) + new array,results,vapIEN +"RTN","TMGNDF1A",1295,0) + new listIEN set listIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",1) +"RTN","TMGNDF1A",1296,0) + if listIEN'>0 goto F1LDone +"RTN","TMGNDF1A",1297,0) + +"RTN","TMGNDF1A",1298,0) + if $$GetDrugInfo(listIEN,.array)=0 goto F1LDone +"RTN","TMGNDF1A",1299,0) + set vapIEN=$$LinkToVAProd(.array,.results) +"RTN","TMGNDF1A",1300,0) + write vapIEN,! +"RTN","TMGNDF1A",1301,0) + if $data(results) zwr results(*) +"RTN","TMGNDF1A",1302,0) + +"RTN","TMGNDF1A",1303,0) + ;"finish.... +"RTN","TMGNDF1A",1304,0) + ;" +"RTN","TMGNDF1A",1305,0) +F1LDone +"RTN","TMGNDF1A",1306,0) + quit +"RTN","TMGNDF1A",1307,0) + +"RTN","TMGNDF1A",1308,0) + ;"======================================================================= +"RTN","TMGNDF1A",1309,0) + +"RTN","TMGNDF1A",1310,0) +Show1Source(IEN) +"RTN","TMGNDF1A",1311,0) + ;"Purpose: to show the source fields for the record +"RTN","TMGNDF1A",1312,0) + ;"Input: IEN -- records number from 22706.9 +"RTN","TMGNDF1A",1313,0) + ;"Output: source data for record is dumped to screen. +"RTN","TMGNDF1A",1314,0) + +"RTN","TMGNDF1A",1315,0) + new fdaIEN +"RTN","TMGNDF1A",1316,0) + set fdaIEN=$piece($get(^TMG(22706.9,IEN,0)),"^",1) +"RTN","TMGNDF1A",1317,0) + +"RTN","TMGNDF1A",1318,0) + do Show1Drug^TMGNDF0B(fdaIEN) +"RTN","TMGNDF1A",1319,0) + quit +"RTN","TMGNDF1D") +0^39^B4671 +"RTN","TMGNDF1D",1,0) +TMGNDF1D ;TMG/kst/FDA Import: Import name cleanup ;03/25/06 +"RTN","TMGNDF1D",2,0) + ;;1.0;TMG-LIB;**1**;01/23/07 +"RTN","TMGNDF1D",3,0) + +"RTN","TMGNDF1D",4,0) + ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF1D",5,0) + ;"Code for cleaning up names. +"RTN","TMGNDF1D",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF1D",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF1D",8,0) + ;"1-23-07 +"RTN","TMGNDF1D",9,0) + +"RTN","TMGNDF1D",10,0) + ;"======================================================================= +"RTN","TMGNDF1D",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF1D",12,0) + ;"======================================================================= +"RTN","TMGNDF1D",13,0) + ;"Menu +"RTN","TMGNDF1D",14,0) + ;"Fix1Name(IEN) -- perform this units fixes for just 1 record +"RTN","TMGNDF1D",15,0) + +"RTN","TMGNDF1D",16,0) + ;"======================================================================= +"RTN","TMGNDF1D",17,0) + ;" Private Functions. +"RTN","TMGNDF1D",18,0) + ;"======================================================================= +"RTN","TMGNDF1D",19,0) + ;"PickSkips -- select records to mark as to be skipped. +"RTN","TMGNDF1D",20,0) + ;"RemoveDups -- Set duplicate records to be skipped +"RTN","TMGNDF1D",21,0) + ;"======================================================================= +"RTN","TMGNDF1D",22,0) + +"RTN","TMGNDF1D",23,0) +Menu +"RTN","TMGNDF1D",24,0) + ;"Purpose: To give an interactive menu of tools to clean up data. +"RTN","TMGNDF1D",25,0) + +"RTN","TMGNDF1D",26,0) + new Menu,UsrSlct +"RTN","TMGNDF1D",27,0) + new i set i=0 +"RTN","TMGNDF1D",28,0) + set Menu(i)="Pick Option for Cleaning Up FDA Imported Data (1D)",i=i+1 +"RTN","TMGNDF1D",29,0) + set Menu(i)="Fix common misspellings etc. in Trade Names"_$char(9)_"NormalizeNames",i=i+1 +"RTN","TMGNDF1D",30,0) + set Menu(i)="SEARCH and REPLACE words in drug TRADE NAME"_$char(9)_"SEARCHd05",i=i+1 +"RTN","TMGNDF1D",31,0) + set Menu(i)="SEARCH and REPLACE words in drug STRENGTH"_$char(9)_"SEARCH1",i=i+1 +"RTN","TMGNDF1D",32,0) + set Menu(i)="SEARCH and REPLACE words in drug UNITS"_$char(9)_"SEARCH2",i=i+1 +"RTN","TMGNDF1D",33,0) + set Menu(i)="Fix dose decimals (e.g. '.5;.125' --> '0.5;0.125')"_$char(9)_"DECIMAL",i=i+1 +"RTN","TMGNDF1D",34,0) + set Menu(i)="Fix units decimals (e.g. 'MG/.5 ML;' --> 'MG/0.5ML')"_$char(9)_"UNITS",i=i+1 +"RTN","TMGNDF1D",35,0) + set Menu(i)="Remove unwanted DOSES from TRADE NAME"_$char(9)_"ScrubDoses",i=i+1 +"RTN","TMGNDF1D",36,0) + set Menu(i)="Edit import TRADE NAME (Caution)"_$char(9)_"EditTradeName",i=i+1 +"RTN","TMGNDF1D",37,0) + set Menu(i)="HELP"_$char(9)_"?" +"RTN","TMGNDF1D",38,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF1D",39,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF1D",40,0) + +"RTN","TMGNDF1D",41,0) +CD1 +"RTN","TMGNDF1D",42,0) + write # +"RTN","TMGNDF1D",43,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF1D",44,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF1D",45,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF1D",46,0) + +"RTN","TMGNDF1D",47,0) + if UsrSlct="Prev" goto Menu^TMGNDF1A ;"quit can occur from there... +"RTN","TMGNDF1D",48,0) + if UsrSlct="Next" goto Menu^TMGNDF1E ;"quit can occur from there... +"RTN","TMGNDF1D",49,0) + +"RTN","TMGNDF1D",50,0) + if UsrSlct="NormalizeNames" do NormalizeNames goto CD1 +"RTN","TMGNDF1D",51,0) + if UsrSlct="SEARCHd05" do Srch5Replace goto CD1 +"RTN","TMGNDF1D",52,0) + if UsrSlct="SEARCH1" do Srch1Replace goto CD1 +"RTN","TMGNDF1D",53,0) + if UsrSlct="SEARCH2" do Srch2Replace goto CD1 +"RTN","TMGNDF1D",54,0) + if UsrSlct="DECIMAL" do FixDecimals goto CD1 +"RTN","TMGNDF1D",55,0) + if UsrSlct="UNITS" do FixUnits goto CD1 +"RTN","TMGNDF1D",56,0) + if UsrSlct="ScrubDoses" do ScrubDoses goto CD1 +"RTN","TMGNDF1D",57,0) + if UsrSlct="EditTradeName" do EditTradename() goto CD1 +"RTN","TMGNDF1D",58,0) + if UsrSlct="?" do ShowHelp goto CD1 +"RTN","TMGNDF1D",59,0) + goto CDDone +"RTN","TMGNDF1D",60,0) +CDDone +"RTN","TMGNDF1D",61,0) + quit +"RTN","TMGNDF1D",62,0) + +"RTN","TMGNDF1D",63,0) +ShowHelp +"RTN","TMGNDF1D",64,0) + ;"Purpose: to display help instructions +"RTN","TMGNDF1D",65,0) + +"RTN","TMGNDF1D",66,0) + write #,! +"RTN","TMGNDF1D",67,0) + write "Q: Why does the data need clean up?",! +"RTN","TMGNDF1D",68,0) + write "A: The FDA database seems to consist of data provided",! +"RTN","TMGNDF1D",69,0) + write " by vendors. As such, there is a big variety in the",! +"RTN","TMGNDF1D",70,0) + write " formats of drug names and in the dose specifications,",! +"RTN","TMGNDF1D",71,0) + write " and also accuracy (many drugs are missing information.)",! +"RTN","TMGNDF1D",72,0) + write ! +"RTN","TMGNDF1D",73,0) + write "Q: Are inaccurate or unwanted drug records deleted?",! +"RTN","TMGNDF1D",74,0) + write "A: No. They are kept so that with the NEXT import, their",! +"RTN","TMGNDF1D",75,0) + write " unwanted status will be remembered. Instead, they are",! +"RTN","TMGNDF1D",76,0) + write " flagged with a SKIP THIS RECORD marker. They will be",! +"RTN","TMGNDF1D",77,0) + write " ignored during further processing.",! +"RTN","TMGNDF1D",78,0) + write ! +"RTN","TMGNDF1D",79,0) + write "Q: How do I flag an unwanted record to be SKIPPED?",! +"RTN","TMGNDF1D",80,0) + write "A: Drug records are browsed in a 'selector' (more below)",! +"RTN","TMGNDF1D",81,0) + write " and all the drugs to be skipped are selected. Then the",! +"RTN","TMGNDF1D",82,0) + write " selector is exited by typing [ESC][ESC], and one is ",! +"RTN","TMGNDF1D",83,0) + write " given a chance to mark all to be SKIPPED at once.",! +"RTN","TMGNDF1D",84,0) + write ! +"RTN","TMGNDF1D",85,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",86,0) + write ! +"RTN","TMGNDF1D",87,0) + write "Q: How do I use the selector?",! +"RTN","TMGNDF1D",88,0) + write "A: The selector is a tool from the VPE library. It has its",! +"RTN","TMGNDF1D",89,0) + write " own help. A quick answer is to move the cursor up and down",! +"RTN","TMGNDF1D",90,0) + write " and press SPACE to select or deselect a record. I recommend",! +"RTN","TMGNDF1D",91,0) + write " using the '+' feature to select all records matching a",! +"RTN","TMGNDF1D",92,0) + write " specified pattern.",! +"RTN","TMGNDF1D",93,0) + write ! +"RTN","TMGNDF1D",94,0) + write "... more later...",! +"RTN","TMGNDF1D",95,0) + +"RTN","TMGNDF1D",96,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",97,0) + quit +"RTN","TMGNDF1D",98,0) + +"RTN","TMGNDF1D",99,0) + +"RTN","TMGNDF1D",100,0) +Fix1Name(IEN) +"RTN","TMGNDF1D",101,0) + ;"Purpose: perform this units fixes for just 1 record +"RTN","TMGNDF1D",102,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF1D",103,0) + ;"results: none +"RTN","TMGNDF1D",104,0) + +"RTN","TMGNDF1D",105,0) + new temp +"RTN","TMGNDF1D",106,0) + +"RTN","TMGNDF1D",107,0) + set temp=$$Fix1Dec(IEN) +"RTN","TMGNDF1D",108,0) + set temp=$$Fix1Unit(IEN) +"RTN","TMGNDF1D",109,0) + set temp=$$Norm1Name(IEN) +"RTN","TMGNDF1D",110,0) + set temp=$$Scrub1Dose(IEN) +"RTN","TMGNDF1D",111,0) + +"RTN","TMGNDF1D",112,0) + quit +"RTN","TMGNDF1D",113,0) + +"RTN","TMGNDF1D",114,0) + +"RTN","TMGNDF1D",115,0) +FixDecimals +"RTN","TMGNDF1D",116,0) + ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH +"RTN","TMGNDF1D",117,0) + +"RTN","TMGNDF1D",118,0) + new Itr,IEN,strength,abort,count,newStr +"RTN","TMGNDF1D",119,0) + set abort=0,count=0 +"RTN","TMGNDF1D",120,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1D",121,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1D",122,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1D",123,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF1D",124,0) + . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit +"RTN","TMGNDF1D",125,0) + . if $$Fix1Dec(IEN)=0 set count=count+1 +"RTN","TMGNDF1D",126,0) + +"RTN","TMGNDF1D",127,0) + write !,count," records changed",! +"RTN","TMGNDF1D",128,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",129,0) + +"RTN","TMGNDF1D",130,0) + quit +"RTN","TMGNDF1D",131,0) + +"RTN","TMGNDF1D",132,0) +Fix1Dec(IEN) +"RTN","TMGNDF1D",133,0) + ;"Purpose: To convert bare decimals (e.g. '.5' --> '0.5') in STRENGTH +"RTN","TMGNDF1D",134,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF1D",135,0) + ;"Results: 1 if modified, 0 if not +"RTN","TMGNDF1D",136,0) + +"RTN","TMGNDF1D",137,0) + new result set result=0 +"RTN","TMGNDF1D",138,0) + set strength=$piece($get(^TMG(22706.9,IEN,0)),"^",2) +"RTN","TMGNDF1D",139,0) + if strength'["." quit +"RTN","TMGNDF1D",140,0) + set newStr=$$FixNum(strength) +"RTN","TMGNDF1D",141,0) + if newStr'=strength do +"RTN","TMGNDF1D",142,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1D",143,0) + . set TMGFDA(22706.9,IEN_",",1)=newStr +"RTN","TMGNDF1D",144,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1D",145,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result) +"RTN","TMGNDF1D",146,0) + +"RTN","TMGNDF1D",147,0) + quit result +"RTN","TMGNDF1D",148,0) + +"RTN","TMGNDF1D",149,0) + +"RTN","TMGNDF1D",150,0) +FixUnits +"RTN","TMGNDF1D",151,0) + ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals) +"RTN","TMGNDF1D",152,0) + +"RTN","TMGNDF1D",153,0) + new Itr,IEN,strength,abort,count,newStr +"RTN","TMGNDF1D",154,0) + set abort=0,count=0 +"RTN","TMGNDF1D",155,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1D",156,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1D",157,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1D",158,0) + . if $$KeyPressed^TMGUSRIF=27 set abort=1 quit +"RTN","TMGNDF1D",159,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF1D",160,0) + . set count=count+$$Fix1Unit(IEN) +"RTN","TMGNDF1D",161,0) + write !,count," records changed",! +"RTN","TMGNDF1D",162,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",163,0) + +"RTN","TMGNDF1D",164,0) + quit +"RTN","TMGNDF1D",165,0) + +"RTN","TMGNDF1D",166,0) + +"RTN","TMGNDF1D",167,0) +Fix1Unit(IEN) +"RTN","TMGNDF1D",168,0) + ;"Purpose: To fix errors in Units (remove spaces, fix hanging decimals) +"RTN","TMGNDF1D",169,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF1D",170,0) + ;"Results: 1 if changed, 0 if not +"RTN","TMGNDF1D",171,0) + +"RTN","TMGNDF1D",172,0) + new result set result=0 +"RTN","TMGNDF1D",173,0) + set units=$piece($get(^TMG(22706.9,IEN,0)),"^",3) +"RTN","TMGNDF1D",174,0) + set newStr=$$FixNum(units) +"RTN","TMGNDF1D",175,0) + set newStr=$$Substitute^TMGSTUTL(newStr,"/PER","/") +"RTN","TMGNDF1D",176,0) + set newStr=$$Substitute^TMGSTUTL(newStr,"/VIL","/VIAL") +"RTN","TMGNDF1D",177,0) + set newStr=$translate(newStr," ","") +"RTN","TMGNDF1D",178,0) + if $extract(newStr,$length(newStr))=";" set newStr=$extract(newStr,1,$length(newStr)-1) +"RTN","TMGNDF1D",179,0) + if newStr'=units do +"RTN","TMGNDF1D",180,0) + . ;"write IEN,": ",units,"-->",newStr,! quit +"RTN","TMGNDF1D",181,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1D",182,0) + . set TMGFDA(22706.9,IEN_",",2)=newStr +"RTN","TMGNDF1D",183,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1D",184,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1D",185,0) + . set result=1 +"RTN","TMGNDF1D",186,0) + +"RTN","TMGNDF1D",187,0) + quit result +"RTN","TMGNDF1D",188,0) + +"RTN","TMGNDF1D",189,0) + +"RTN","TMGNDF1D",190,0) +FixNum(numStr) +"RTN","TMGNDF1D",191,0) + ;"Purpose: to fix hanging decimals in numStr (e.g. '.5' --> '0.5') +"RTN","TMGNDF1D",192,0) + ;"Input: numStr -- the string to be fixed +"RTN","TMGNDF1D",193,0) + ;"Results: returns fixed string +"RTN","TMGNDF1D",194,0) + new result set result=numStr +"RTN","TMGNDF1D",195,0) + new i for i=1:1:$length(result,".")-1 do +"RTN","TMGNDF1D",196,0) + . new p set p=$$Pos^TMGSTUTL(".",result,i) +"RTN","TMGNDF1D",197,0) + . new priorCh set priorCh=$extract(result,p-1) +"RTN","TMGNDF1D",198,0) + . if +priorCh=priorCh quit +"RTN","TMGNDF1D",199,0) + . if (p=1) do +"RTN","TMGNDF1D",200,0) + . . set result="0"_result +"RTN","TMGNDF1D",201,0) + . else do +"RTN","TMGNDF1D",202,0) + . . new sA,sB +"RTN","TMGNDF1D",203,0) + . . set sA=$extract(result,1,p-1),sB=$extract(result,p,9999) +"RTN","TMGNDF1D",204,0) + . . set result=sA_"0"_sB +"RTN","TMGNDF1D",205,0) + +"RTN","TMGNDF1D",206,0) + quit result +"RTN","TMGNDF1D",207,0) + +"RTN","TMGNDF1D",208,0) +Srch5Replace +"RTN","TMGNDF1D",209,0) + ;"Purpose: To provide a mechanism for altering the drug trade names (.05 field) +"RTN","TMGNDF1D",210,0) + ;" e.g. TETRACYCLINE HYDROCHLORIDE --> TETRACYCLINE HCL +"RTN","TMGNDF1D",211,0) + ;" or LISINOPRIL/HYDROCHLOROTHIAZIDE --> LISINOPRIL/HCTZ +"RTN","TMGNDF1D",212,0) + ;" The reason for this is that many drugs are put in BOTH WAYS, leading to +"RTN","TMGNDF1D",213,0) + ;" duplicate entries, differing only in the expansion of these words. +"RTN","TMGNDF1D",214,0) + +"RTN","TMGNDF1D",215,0) + do SrchReplace^TMGMISC(22706.9,.05,"SEARCH & REPLACE in Trade Name of FDA Imported Drugs") +"RTN","TMGNDF1D",216,0) + quit +"RTN","TMGNDF1D",217,0) + +"RTN","TMGNDF1D",218,0) +Srch2Replace +"RTN","TMGNDF1D",219,0) + ;"Purpose: To provide a mechanism for altering the drug UNITS (field 2) +"RTN","TMGNDF1D",220,0) + ;" The reason for this is that many drugs are put in BOTH WAYS, leading to +"RTN","TMGNDF1D",221,0) + ;" duplicate entries, differing only in the expansion of these words. +"RTN","TMGNDF1D",222,0) + +"RTN","TMGNDF1D",223,0) + do SrchReplace^TMGMISC(22706.9,2,"SEARCH & REPLACE in UNITS of FDA Imported Drugs") +"RTN","TMGNDF1D",224,0) + quit +"RTN","TMGNDF1D",225,0) + +"RTN","TMGNDF1D",226,0) +Srch1Replace +"RTN","TMGNDF1D",227,0) + ;"Purpose: To provide a mechanism for altering the drug STRENGTH (field 1) +"RTN","TMGNDF1D",228,0) + ;" The reason for this is that many drugs are put in BOTH WAYS, leading to +"RTN","TMGNDF1D",229,0) + ;" duplicate entries, differing only in the expansion of these words. +"RTN","TMGNDF1D",230,0) + +"RTN","TMGNDF1D",231,0) + do SrchReplace^TMGMISC(22706.9,1,"SEARCH & REPLACE in STRENGTH of FDA Imported Drugs") +"RTN","TMGNDF1D",232,0) + quit +"RTN","TMGNDF1D",233,0) + +"RTN","TMGNDF1D",234,0) + +"RTN","TMGNDF1D",235,0) +NormalizeNames +"RTN","TMGNDF1D",236,0) + ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc. +"RTN","TMGNDF1D",237,0) + +"RTN","TMGNDF1D",238,0) + new map ;"These are numbered to preserve their order +"RTN","TMGNDF1D",239,0) + do SetupMap(.map) +"RTN","TMGNDF1D",240,0) + +"RTN","TMGNDF1D",241,0) + new Itr,IEN,count +"RTN","TMGNDF1D",242,0) + set count=0 +"RTN","TMGNDF1D",243,0) + new abort set abort=0 +"RTN","TMGNDF1D",244,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1D",245,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1D",246,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1D",247,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF1D",248,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF1D",249,0) + . set count=count+$$Norm1Name(IEN,.map) +"RTN","TMGNDF1D",250,0) + +"RTN","TMGNDF1D",251,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF1D",252,0) + +"RTN","TMGNDF1D",253,0) + write count," Trade names (.05 field) modified.",! +"RTN","TMGNDF1D",254,0) + if count>1 write "Because some changes are interdependant, please run this option again.",! +"RTN","TMGNDF1D",255,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",256,0) + +"RTN","TMGNDF1D",257,0) + quit +"RTN","TMGNDF1D",258,0) + +"RTN","TMGNDF1D",259,0) + +"RTN","TMGNDF1D",260,0) +Norm1Name(IEN,map) +"RTN","TMGNDF1D",261,0) + ;"Purpose: To 'normalize' names, meaning replacing common misspellings etc. for 1 record +"RTN","TMGNDF1D",262,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF1D",263,0) + ;" map -- OPTIONAL. Array of changes to be made. If not provided, then +"RTN","TMGNDF1D",264,0) + ;" it will be created here. +"RTN","TMGNDF1D",265,0) + ;"Results: 1 if modified, 0 if not +"RTN","TMGNDF1D",266,0) + +"RTN","TMGNDF1D",267,0) + if $data(map)=0 do SetupMap(.map) +"RTN","TMGNDF1D",268,0) + +"RTN","TMGNDF1D",269,0) + new result set result=0 +"RTN","TMGNDF1D",270,0) + new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05 +"RTN","TMGNDF1D",271,0) + new oldName set oldName=TradeName +"RTN","TMGNDF1D",272,0) + new num set num="" +"RTN","TMGNDF1D",273,0) + for set num=$order(map(num)) quit:(num="") do +"RTN","TMGNDF1D",274,0) + . set srchS=$order(map(num,"")) quit:(srchS="") +"RTN","TMGNDF1D",275,0) + . if TradeName'[srchS quit +"RTN","TMGNDF1D",276,0) + . write !,srchS,"-->",$get(map(num,srchS)),! +"RTN","TMGNDF1D",277,0) + . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,$get(map(num,srchS))) +"RTN","TMGNDF1D",278,0) + +"RTN","TMGNDF1D",279,0) + if TradeName'=oldName do +"RTN","TMGNDF1D",280,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1D",281,0) + . set TMGFDA(22706.9,IEN_",",.05)=TradeName +"RTN","TMGNDF1D",282,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1D",283,0) + . set result=1 +"RTN","TMGNDF1D",284,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1D",285,0) + +"RTN","TMGNDF1D",286,0) + quit result +"RTN","TMGNDF1D",287,0) + +"RTN","TMGNDF1D",288,0) + +"RTN","TMGNDF1D",289,0) +SetupMap(map) +"RTN","TMGNDF1D",290,0) + ;"Purpose: to set up mapping of spelling corrections to be made. +"RTN","TMGNDF1D",291,0) + ;"Input: map -- PASS BY REFERENCE. An OUT parameter. +"RTN","TMGNDF1D",292,0) + +"RTN","TMGNDF1D",293,0) + ;"NOTE: These are numbered to preserve their order +"RTN","TMGNDF1D",294,0) + new i set i=0 +"RTN","TMGNDF1D",295,0) + set i=i+1,map(i,"SOLUTION")="SOLN" +"RTN","TMGNDF1D",296,0) + set i=i+1,map(i,"OINTMENT")="OINT" +"RTN","TMGNDF1D",297,0) + set i=i+1,map(i,"CAPSULES")="CAP" +"RTN","TMGNDF1D",298,0) + set i=i+1,map(i,"CAPSULE")="CAP" +"RTN","TMGNDF1D",299,0) + set i=i+1,map(i,"TALBETS")="TAB" +"RTN","TMGNDF1D",300,0) + set i=i+1,map(i,"INJECTION")="INJ" +"RTN","TMGNDF1D",301,0) + set i=i+1,map(i,"FOR INJ")="INJ" +"RTN","TMGNDF1D",302,0) + set i=i+1,map(i,"EXTENDED")="EXT" +"RTN","TMGNDF1D",303,0) + set i=i+1,map(i,"RELEASE")="REL" +"RTN","TMGNDF1D",304,0) + set i=i+1,map(i,"INH ")="IHNL " +"RTN","TMGNDF1D",305,0) + set i=i+1,map(i,"INHALATION")="INHL" +"RTN","TMGNDF1D",306,0) + set i=i+1,map(i,"SUSPENSION")="SUSP" +"RTN","TMGNDF1D",307,0) + set i=i+1,map(i,"OPHTHALMIC")="OPHTH" +"RTN","TMGNDF1D",308,0) + set i=i+1,map(i,"HYDROCHLORIDE")="HCL" +"RTN","TMGNDF1D",309,0) + set i=i+1,map(i,"FOR INJECTABLE SUSPENSION")="INJ" +"RTN","TMGNDF1D",310,0) + set i=i+1,map(i,"CODEINE PHOSPHATE")="CODEINE" +"RTN","TMGNDF1D",311,0) + set i=i+1,map(i,"WITH CODEINE")="CODEINE" +"RTN","TMGNDF1D",312,0) + set i=i+1,map(i,"SOLN FOR INJ")="INJ SOLN" +"RTN","TMGNDF1D",313,0) + set i=i+1,map(i,"POWDER FOR INJ")="INJ POWDER" +"RTN","TMGNDF1D",314,0) + set i=i+1,map(i,"SOLN OPHTH")="OPHTH SOLN" +"RTN","TMGNDF1D",315,0) + set i=i+1,map(i," SUFATE")=" SULFATE" +"RTN","TMGNDF1D",316,0) + set i=i+1,map(i,"ALBUTEROL SULFATE")="ALBUTEROL" +"RTN","TMGNDF1D",317,0) + set i=i+1,map(i,"FOR INHL")="INHL" +"RTN","TMGNDF1D",318,0) + set i=i+1,map(i,"SOLN INHL")="INHL SOLN" +"RTN","TMGNDF1D",319,0) + set i=i+1,map(i,"SUSTAINED")="SUST" +"RTN","TMGNDF1D",320,0) + set i=i+1,map(i," BITART ")=" BITARTRATE " +"RTN","TMGNDF1D",321,0) + set i=i+1,map(i," BITARTRATERATER")=" BITARTRATER" +"RTN","TMGNDF1D",322,0) + set i=i+1,map(i," BITARTRATER ")=" BITARTRATE " +"RTN","TMGNDF1D",323,0) + set i=i+1,map(i," BITRATE")=" BITARTRATE" +"RTN","TMGNDF1D",324,0) + set i=i+1,map(i,"BITARTARATE")="BITARTRATE" +"RTN","TMGNDF1D",325,0) + set i=i+1,map(i,"BITARTRATERATE")="BITARTRATE" +"RTN","TMGNDF1D",326,0) + set i=i+1,map(i,"HYDROCODONEARATE")="HYDROCODONE" +"RTN","TMGNDF1D",327,0) + set i=i+1,map(i,"HYDROCODONE ACET")="HYDROCODONE APAP" +"RTN","TMGNDF1D",328,0) + set i=i+1,map(i,"HYDROCODONE BITARTRATE")="HYDROCODONE" +"RTN","TMGNDF1D",329,0) + set i=i+1,map(i,"DIHYDROCODEINE BITARTRATE")="DIHYDROCODEINE" +"RTN","TMGNDF1D",330,0) + set i=i+1,map(i,"WITH HYDROCODONE")="HYDROCODONE" +"RTN","TMGNDF1D",331,0) + set i=i+1,map(i,"SOLN FOR IRRIGATION")="IRRIGATION SOLN" +"RTN","TMGNDF1D",332,0) + set i=i+1,map(i,"CAPLETS")="CAP" +"RTN","TMGNDF1D",333,0) + set i=i+1,map(i,"TABLET")="TAB" +"RTN","TMGNDF1D",334,0) + set i=i+1,map(i,"POWDER")="PWDR" +"RTN","TMGNDF1D",335,0) + set i=i+1,map(i,"TAB EXT REL")="EXT REL TAB" +"RTN","TMGNDF1D",336,0) + set i=i+1,map(i,"SOLN ORAL")="ORAL SOLN" +"RTN","TMGNDF1D",337,0) + set i=i+1,map(i,"TAB SUST REL")="SUST REL TAB" +"RTN","TMGNDF1D",338,0) + set i=i+1,map(i,"RELD ")="REL " +"RTN","TMGNDF1D",339,0) + set i=i+1,map(i," ")=" " +"RTN","TMGNDF1D",340,0) + set i=i+1,map(i," SULFATE")="" +"RTN","TMGNDF1D",341,0) + set i=i+1,map(i,"HYDROCHLOROTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",342,0) + set i=i+1,map(i," AND ")=" " +"RTN","TMGNDF1D",343,0) + set i=i+1,map(i,"HYDROCLORIDE")="HCL" +"RTN","TMGNDF1D",344,0) + set i=i+1,map(i,"HYDROCLOROTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",345,0) + set i=i+1,map(i,"HYDROCHLORITHIZIDE")="HCTZ" +"RTN","TMGNDF1D",346,0) + set i=i+1,map(i,"HYDROCHLOROHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",347,0) + set i=i+1,map(i,"HYDROCLORTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",348,0) + set i=i+1,map(i,"HYDROCLORIDE")="HCTZ" +"RTN","TMGNDF1D",349,0) + set i=i+1,map(i,"HYDROCHLORIRDE")="HCTZ" +"RTN","TMGNDF1D",350,0) + set i=i+1,map(i," HCT ")=" HCTZ " +"RTN","TMGNDF1D",351,0) + set i=i+1,map(i,"HYDROCHLORIC ACID")="HCL" +"RTN","TMGNDF1D",352,0) + set i=i+1,map(i,"HYDROCHORIDE")="HCL" +"RTN","TMGNDF1D",353,0) + set i=i+1,map(i,"HYDROCHLORITHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",354,0) + set i=i+1,map(i,"HYDROCHLOROTIAZIDE")="HCTZ" +"RTN","TMGNDF1D",355,0) + set i=i+1,map(i,"HYDROCHOROTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",356,0) + set i=i+1,map(i,"HYDROCHLOROTHIAZED")="HCTZ" +"RTN","TMGNDF1D",357,0) + set i=i+1,map(i,"HYDROCHLOROYTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",358,0) + set i=i+1,map(i,"HYDROCHLOROTHIZED")="HCYZ" +"RTN","TMGNDF1D",359,0) + set i=i+1,map(i,"HYDROCHLROTHIAZIDE")="" +"RTN","TMGNDF1D",360,0) + set i=i+1,map(i,"HYDROCHOLRIDE")="HCL" +"RTN","TMGNDF1D",361,0) + set i=i+1,map(i,"HYDROCHOLORIDE")="HCL" +"RTN","TMGNDF1D",362,0) + set i=i+1,map(i,"HYDROCHLORTHIAZIDE")="HCTZ" +"RTN","TMGNDF1D",363,0) + set i=i+1,map(i,"HYDROCHOLIRDE")="HCL" +"RTN","TMGNDF1D",364,0) + set i=i+1,map(i,"HYDROCHLROIDE")="HCL" +"RTN","TMGNDF1D",365,0) + set i=i+1,map(i,"HYDROCHLORIE")="HCL" +"RTN","TMGNDF1D",366,0) + set i=i+1,map(i,"HYDROCHLORINE")="HCL" +"RTN","TMGNDF1D",367,0) + set i=i+1,map(i,"CODIENE")="CODEINE" +"RTN","TMGNDF1D",368,0) + set i=i+1,map(i,"SOLN INJ")="INJ SOLN" +"RTN","TMGNDF1D",369,0) + set i=i+1,map(i,"SUBSTAINED")="SUST" +"RTN","TMGNDF1D",370,0) + set i=i+1,map(i,"SODIM")="SODIUM" +"RTN","TMGNDF1D",371,0) + set i=i+1,map(i,"CAP EXT REL")="EXT REL CAP" +"RTN","TMGNDF1D",372,0) + set i=i+1,map(i,"CAP SUST REL")="SUST REL CAP" +"RTN","TMGNDF1D",373,0) + set i=i+1,map(i,"INHAL ")="INHL " +"RTN","TMGNDF1D",374,0) + set i=i+1,map(i,"FOR ORAL SOLN")="ORAL SOLN" +"RTN","TMGNDF1D",375,0) + set i=i+1,map(i," I V ")=" IV " +"RTN","TMGNDF1D",376,0) + set i=i+1,map(i,"INTRAVENOUS")="IV" +"RTN","TMGNDF1D",377,0) + set i=i+1,map(i,"FOR ORAL SUSP")="ORAL SUSP" +"RTN","TMGNDF1D",378,0) + set i=i+1,map(i,"CAPLET")="CAP" +"RTN","TMGNDF1D",379,0) + set i=i+1,map(i,"WITH HCTZ")="HCTZ" +"RTN","TMGNDF1D",380,0) + set i=i+1,map(i," HCL ")=" " +"RTN","TMGNDF1D",381,0) + set i=i+1,map(i," HCL/")="" +"RTN","TMGNDF1D",382,0) + set i=i+1,map(i,"SUST REL")="SR" +"RTN","TMGNDF1D",383,0) + set i=i+1,map(i,"SR SR")="SR" +"RTN","TMGNDF1D",384,0) + set i=i+1,map(i,"SUPENSION")="SUSP" +"RTN","TMGNDF1D",385,0) + set i=i+1,map(i,"FOR SUSP")="SUSP" +"RTN","TMGNDF1D",386,0) + set i=i+1,map(i,"SUSP ORAL")="ORAL SUSP" +"RTN","TMGNDF1D",387,0) + set i=i+1,map(i," USP")="" +"RTN","TMGNDF1D",388,0) + set i=i+1,map(i,"PHOSPHATE")="PHOS" +"RTN","TMGNDF1D",389,0) + set i=i+1,map(i,"PHOSPHATES")="PHOS" +"RTN","TMGNDF1D",390,0) + set i=i+1,map(i,"METROPROLOL")="METOPROLOL" +"RTN","TMGNDF1D",391,0) + set i=i+1,map(i,"EXT-REL")="EXT REL" +"RTN","TMGNDF1D",392,0) + set i=i+1,map(i," HCLT")=" HCL" +"RTN","TMGNDF1D",393,0) + set i=i+1,map(i," HCLM")=" HCL" +"RTN","TMGNDF1D",394,0) + set i=i+1,map(i," HCL")="" +"RTN","TMGNDF1D",395,0) + set i=i+1,map(i,"INJECTABLE")="INJ" +"RTN","TMGNDF1D",396,0) + set i=i+1,map(i,"HYDROCHODONE")="HYDROCODONE" +"RTN","TMGNDF1D",397,0) + set i=i+1,map(i,"HYDROCHLOROTHAZIDE")="HCTZ" +"RTN","TMGNDF1D",398,0) + set i=i+1,map(i,"HYDROCHLOROIDE")="HCL" +"RTN","TMGNDF1D",399,0) + set i=i+1,map(i,"SODIUM CHLORIDE")="NACL" +"RTN","TMGNDF1D",400,0) + set i=i+1,map(i," NAD ")=" AND " +"RTN","TMGNDF1D",401,0) + set i=i+1,map(i," SODIUM")="" +"RTN","TMGNDF1D",402,0) + set i=i+1,map(i,"LEVOYHYROXINE")="LEVOTHYROXINE" +"RTN","TMGNDF1D",403,0) + set i=i+1,map(i," ACETAMINOPHEN")=" APAP" +"RTN","TMGNDF1D",404,0) + set i=i+1,map(i,"NAPSLATE")="NAPSYLATE" +"RTN","TMGNDF1D",405,0) + set i=i+1,map(i,"NAPSULATE")="NAPSYLATE" +"RTN","TMGNDF1D",406,0) + set i=i+1,map(i," NAPSYLATE")="" +"RTN","TMGNDF1D",407,0) + set i=i+1,map(i,"DARVOCET-N")="DARVOCET N" +"RTN","TMGNDF1D",408,0) + set i=i+1,map(i,"PROPOX NAP")="PROPOXYPHENE" +"RTN","TMGNDF1D",409,0) + set i=i+1,map(i,"PROPOX ")="PROPOXYPHENE " +"RTN","TMGNDF1D",410,0) + set i=i+1,map(i,"PROPOXY ")="PROPOXYPHENE " +"RTN","TMGNDF1D",411,0) + set i=i+1,map(i,"PROPOXYPHEN ")="PROPOXYPHENE " +"RTN","TMGNDF1D",412,0) + set i=i+1,map(i,"PROPACET ")="PROPOXYPHENE APAP " +"RTN","TMGNDF1D",413,0) + set i=i+1,map(i,"CLAULNATE ")="CLAVULANATE " +"RTN","TMGNDF1D",414,0) + set i=i+1,map(i,"ASPPIRIN ")="ASPIRIN " +"RTN","TMGNDF1D",415,0) + +"RTN","TMGNDF1D",416,0) + set i=i+1,map(i," &")="" +"RTN","TMGNDF1D",417,0) + set i=i+1,map(i," / ")=" " +"RTN","TMGNDF1D",418,0) + set i=i+1,map(i," CAFFINE")=" CAFFEINE" +"RTN","TMGNDF1D",419,0) + set i=i+1,map(i,"MGAPAP")="MG APAP" +"RTN","TMGNDF1D",420,0) + set i=i+1,map(i,"5MG")="5 MG" +"RTN","TMGNDF1D",421,0) + set i=i+1,map(i,"0MG")="0 MG" +"RTN","TMGNDF1D",422,0) + +"RTN","TMGNDF1D",423,0) + quit +"RTN","TMGNDF1D",424,0) + +"RTN","TMGNDF1D",425,0) + +"RTN","TMGNDF1D",426,0) +ScrubDoses +"RTN","TMGNDF1D",427,0) + ;"Purpose: To remove doses from Tradename +"RTN","TMGNDF1D",428,0) + ;" +"RTN","TMGNDF1D",429,0) + +"RTN","TMGNDF1D",430,0) + new skips,ignore,PreSelArray +"RTN","TMGNDF1D",431,0) + do SetScrubMaps(.skips,.ignore) +"RTN","TMGNDF1D",432,0) + +"RTN","TMGNDF1D",433,0) + new Itr,IEN,count +"RTN","TMGNDF1D",434,0) + set count=0 +"RTN","TMGNDF1D",435,0) + new abort set abort=0 +"RTN","TMGNDF1D",436,0) + write "Gathering a list of suggested name changes, removing #'s and doses...",! +"RTN","TMGNDF1D",437,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1D",438,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1D",439,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1D",440,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF1D",441,0) + . set count=count+$$Scrub1Dose(IEN,.skips,.ignore,0,.PreSelArray) +"RTN","TMGNDF1D",442,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF1D",443,0) + +"RTN","TMGNDF1D",444,0) + if $data(PreSelArray)=0 goto SDDone +"RTN","TMGNDF1D",445,0) + new DelArray +"RTN","TMGNDF1D",446,0) + do SelRxList("PreSelArray","DelArray","SELECT ALLOWED NAME CHANGES (COLUMN 1=OLD,2=NEW) ESC ESC WHEN DONE",3) +"RTN","TMGNDF1D",447,0) + if $data(DelArray)=0 goto SDDone +"RTN","TMGNDF1D",448,0) + +"RTN","TMGNDF1D",449,0) + new NewName set NewName="" +"RTN","TMGNDF1D",450,0) + for set NewName=$order(DelArray(NewName)) quit:(NewName="") do +"RTN","TMGNDF1D",451,0) + . new IEN set IEN=0 +"RTN","TMGNDF1D",452,0) + . for set IEN=$order(DelArray(NewName,IEN)) quit:(+IEN'>0) do +"RTN","TMGNDF1D",453,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF1D",454,0) + . . set TMGFDA(22706.9,IEN_",",.05)=NewName +"RTN","TMGNDF1D",455,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1D",456,0) + . . set count=count+1 +"RTN","TMGNDF1D",457,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1D",458,0) + +"RTN","TMGNDF1D",459,0) +SDDone +"RTN","TMGNDF1D",460,0) + write count," Trade names (.05 field) modified.",! +"RTN","TMGNDF1D",461,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",462,0) + +"RTN","TMGNDF1D",463,0) + quit +"RTN","TMGNDF1D",464,0) + +"RTN","TMGNDF1D",465,0) + +"RTN","TMGNDF1D",466,0) +Scrub1Dose(IEN,skips,ignore,askuser,PreSelArray) +"RTN","TMGNDF1D",467,0) + ;"Purpose: To remove doses from Tradename from 1 record +"RTN","TMGNDF1D",468,0) + ;"Input: skips -- PASS BY REFERENCE. OPTIONAL +"RTN","TMGNDF1D",469,0) + ;" ignore -- PASS BY REFERENCE. OPTIONAL +"RTN","TMGNDF1D",470,0) + ;" askuser -- if 1, then user is asked. Default=1 +"RTN","TMGNDF1D",471,0) + ;" Otherwise, PreSelArray is filled with questions for user +"RTN","TMGNDF1D",472,0) + ;" PreSelArray -- PASS BY REFERENCE. OPTIONAL +"RTN","TMGNDF1D",473,0) + ;"Results: 1 if modified, 0 if not (including options put into PreSelArray) +"RTN","TMGNDF1D",474,0) + +"RTN","TMGNDF1D",475,0) + new result set result=0 +"RTN","TMGNDF1D",476,0) + if ($data(skips)=0)!($data(ignore)=0) do +"RTN","TMGNDF1D",477,0) + . kill skips,ignore +"RTN","TMGNDF1D",478,0) + . do SetScrubMaps(.skips,.ignore) +"RTN","TMGNDF1D",479,0) + set askuser=+$get(askuser,1) +"RTN","TMGNDF1D",480,0) + +"RTN","TMGNDF1D",481,0) + new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"field .05 +"RTN","TMGNDF1D",482,0) + new j set j=0 +"RTN","TMGNDF1D",483,0) + new ignore1 set ignore1=0 +"RTN","TMGNDF1D",484,0) + for set j=$order(ignore(j)) quit:(j="") do +"RTN","TMGNDF1D",485,0) + . if TradeName[ignore(j) set ignore1=1 +"RTN","TMGNDF1D",486,0) + if ignore1 quit +"RTN","TMGNDF1D",487,0) + set j=0 +"RTN","TMGNDF1D",488,0) + for set j=$order(skips(j)) quit:(j="") do +"RTN","TMGNDF1D",489,0) + . new srchS set srchS=$get(skips(j)) +"RTN","TMGNDF1D",490,0) + . if TradeName'[srchS quit +"RTN","TMGNDF1D",491,0) + . set TradeName=$$Substitute^TMGSTUTL(TradeName,srchS,"@@@"_$char(64+j)_"@@@") +"RTN","TMGNDF1D",492,0) + new oldName set oldName=TradeName +"RTN","TMGNDF1D",493,0) + set TradeName=$$ScrubNumeric^TMGSTUTL(TradeName) +"RTN","TMGNDF1D",494,0) + if TradeName=oldName quit +"RTN","TMGNDF1D",495,0) + if TradeName="" quit +"RTN","TMGNDF1D",496,0) + if TradeName["@@@" do +"RTN","TMGNDF1D",497,0) + . new j set j=$ascii($piece(TradeName,"@@@",2))-64 +"RTN","TMGNDF1D",498,0) + . set TradeName=$piece(TradeName,"@@@",1)_$get(skips(j))_$piece(TradeName,"@@@",3) +"RTN","TMGNDF1D",499,0) + . set oldName=$piece(oldName,"@@@",1)_$get(skips(j))_$piece(oldName,"@@@",3) +"RTN","TMGNDF1D",500,0) + ;" +"RTN","TMGNDF1D",501,0) + if askuser'=1 set PreSelArray(TradeName,IEN)="" quit ;"bypass user asking... +"RTN","TMGNDF1D",502,0) + ;"------------------ +"RTN","TMGNDF1D",503,0) + write !,IEN,": '",oldName,"' --> '",TradeName,"'",! +"RTN","TMGNDF1D",504,0) + new % set %=2 +"RTN","TMGNDF1D",505,0) + write "Accept Change" do YN^DICN write ! +"RTN","TMGNDF1D",506,0) + if %=-1 set abort=1 quit +"RTN","TMGNDF1D",507,0) + if %'=1 quit +"RTN","TMGNDF1D",508,0) + if TradeName'=oldName do +"RTN","TMGNDF1D",509,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1D",510,0) + . set TMGFDA(22706.9,IEN_",",.05)=TradeName +"RTN","TMGNDF1D",511,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1D",512,0) + . set result=1 +"RTN","TMGNDF1D",513,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1D",514,0) + +"RTN","TMGNDF1D",515,0) + quit result +"RTN","TMGNDF1D",516,0) + +"RTN","TMGNDF1D",517,0) + +"RTN","TMGNDF1D",518,0) +SetScrubMaps(skips,ignore) +"RTN","TMGNDF1D",519,0) + ;"Purpose: setup arrays for removing doses from Tradename +"RTN","TMGNDF1D",520,0) + ;"Input: skips -- PASS BY REFERENCE +"RTN","TMGNDF1D",521,0) + ;" ignore -- PASS BY REFERENCE +"RTN","TMGNDF1D",522,0) + ;"result +"RTN","TMGNDF1D",523,0) + +"RTN","TMGNDF1D",524,0) + new i +"RTN","TMGNDF1D",525,0) + set i=0 ;"NOTE!!! ASCII encoding only allow i up to 63!! +"RTN","TMGNDF1D",526,0) + set i=i+1,skips(i)="5% DEXTROSE" +"RTN","TMGNDF1D",527,0) + set i=i+1,skips(i)="5 % DEXTROSE" +"RTN","TMGNDF1D",528,0) + set i=i+1,skips(i)="10% DEXTROSE" +"RTN","TMGNDF1D",529,0) + set i=i+1,skips(i)="0.9% NA" +"RTN","TMGNDF1D",530,0) + set i=i+1,skips(i)=".9% NA" +"RTN","TMGNDF1D",531,0) + set i=i+1,skips(i)="0.45% NA" +"RTN","TMGNDF1D",532,0) + set i=i+1,skips(i)="7 7 7" +"RTN","TMGNDF1D",533,0) + set i=i+1,skips(i)="70 30" +"RTN","TMGNDF1D",534,0) + set i=i+1,skips(i)="7.4" +"RTN","TMGNDF1D",535,0) + set i=i+1,skips(i)="3 MONTH" +"RTN","TMGNDF1D",536,0) + set i=i+1,skips(i)="4 MONTH" +"RTN","TMGNDF1D",537,0) + set i=i+1,skips(i)="28 TAB" +"RTN","TMGNDF1D",538,0) + set i=i+1,skips(i)="I 131" +"RTN","TMGNDF1D",539,0) + set i=i+1,skips(i)="I-131" +"RTN","TMGNDF1D",540,0) + set i=i+1,skips(i)="I 123" +"RTN","TMGNDF1D",541,0) + set i=i+1,skips(i)="7 VAGINAL" +"RTN","TMGNDF1D",542,0) + set i=i+1,skips(i)="3 VAGINAL" +"RTN","TMGNDF1D",543,0) + set i=i+1,skips(i)="0.3% NACL" +"RTN","TMGNDF1D",544,0) + set i=i+1,skips(i)="0.2% NACL" +"RTN","TMGNDF1D",545,0) + set i=i+1,skips(i)="B12" +"RTN","TMGNDF1D",546,0) + set i=i+1,skips(i)="B6" +"RTN","TMGNDF1D",547,0) + set i=i+1,skips(i)="TC 99M" +"RTN","TMGNDF1D",548,0) + set i=i+1,skips(i)="TC99M" +"RTN","TMGNDF1D",549,0) + set i=i+1,skips(i)="THEO 24" +"RTN","TMGNDF1D",550,0) + set i=i+1,skips(i)="24 H" +"RTN","TMGNDF1D",551,0) + set i=i+1,skips(i)="12 H" +"RTN","TMGNDF1D",552,0) + set i=i+1,skips(i)=" 12 " +"RTN","TMGNDF1D",553,0) + set i=i+1,skips(i)=" 24 " +"RTN","TMGNDF1D",554,0) + set i=i+1,skips(i)="VITAMIN K1" +"RTN","TMGNDF1D",555,0) + set i=i+1,skips(i)="PH7" +"RTN","TMGNDF1D",556,0) + +"RTN","TMGNDF1D",557,0) + ;"Put entries here when the presence of a word is enough to ignore entire drug name. +"RTN","TMGNDF1D",558,0) + ;"if TradeName[ingore(x) then no further check done +"RTN","TMGNDF1D",559,0) + set i=0 ;"no limit on # here... +"RTN","TMGNDF1D",560,0) + set i=i+1,ignore(i)="TERAZOL" +"RTN","TMGNDF1D",561,0) + set i=i+1,ignore(i)="ORTHO " +"RTN","TMGNDF1D",562,0) + set i=i+1,ignore(i)="DARVOCET" +"RTN","TMGNDF1D",563,0) + set i=i+1,ignore(i)="DEMULEN" +"RTN","TMGNDF1D",564,0) + set i=i+1,ignore(i)="LEVLEN" +"RTN","TMGNDF1D",565,0) + set i=i+1,ignore(i)="LEVLITE" +"RTN","TMGNDF1D",566,0) + set i=i+1,ignore(i)="LOESTRIN" +"RTN","TMGNDF1D",567,0) + set i=i+1,ignore(i)="NECON" +"RTN","TMGNDF1D",568,0) + set i=i+1,ignore(i)=" MT " +"RTN","TMGNDF1D",569,0) + set i=i+1,ignore(i)="ORTHOCEPT" +"RTN","TMGNDF1D",570,0) + set i=i+1,ignore(i)="GYNAZOLE" +"RTN","TMGNDF1D",571,0) + set i=i+1,ignore(i)="OVCON" +"RTN","TMGNDF1D",572,0) + set i=i+1,ignore(i)="MONISTAT" +"RTN","TMGNDF1D",573,0) + set i=i+1,ignore(i)="MICROGESTIN" +"RTN","TMGNDF1D",574,0) + set i=i+1,ignore(i)="ULTRASE" +"RTN","TMGNDF1D",575,0) + set i=i+1,ignore(i)="MTE " +"RTN","TMGNDF1D",576,0) + set i=i+1,ignore(i)="M T E " +"RTN","TMGNDF1D",577,0) + set i=i+1,ignore(i)="INSULIN" +"RTN","TMGNDF1D",578,0) + +"RTN","TMGNDF1D",579,0) + quit +"RTN","TMGNDF1D",580,0) + +"RTN","TMGNDF1D",581,0) + +"RTN","TMGNDF1D",582,0) +CautionMsg +"RTN","TMGNDF1D",583,0) + ;"Purpose: To show a caution message. +"RTN","TMGNDF1D",584,0) + +"RTN","TMGNDF1D",585,0) + write !,"**NOTICE**",! +"RTN","TMGNDF1D",586,0) + write "This will use the MULTI-selector to pick imports to be",! +"RTN","TMGNDF1D",587,0) + write "be edited. BE VERY CAREFUL not to select more than one",! +"RTN","TMGNDF1D",588,0) + write "drug before exiting to enter the edit screen.",! +"RTN","TMGNDF1D",589,0) + write "For example: If 3 different drugs were selected, and then",! +"RTN","TMGNDF1D",590,0) + write "ESC ESC pressed, then one will be presented with an opportunity",! +"RTN","TMGNDF1D",591,0) + write "to edit the drug name. BUT NOTE: one would be editing ALL THREE",! +"RTN","TMGNDF1D",592,0) + write "drugs AT ONCE, very likely creating an error in 2 of the drugs.",! +"RTN","TMGNDF1D",593,0) + write ! +"RTN","TMGNDF1D",594,0) + +"RTN","TMGNDF1D",595,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1D",596,0) + quit +"RTN","TMGNDF1D",597,0) + +"RTN","TMGNDF1D",598,0) + +"RTN","TMGNDF1D",599,0) +EditTradename(SkipValue) +"RTN","TMGNDF1D",600,0) + ;"Purpose: to select records to mark as to be skipped. +"RTN","TMGNDF1D",601,0) + ;"Input: SkipValue: OPTIONAL. Default=0. +"RTN","TMGNDF1D",602,0) + ;" 0=show only values NOT marked to be skipped +"RTN","TMGNDF1D",603,0) + ;" 1=show only values MARKED to be skipped +"RTN","TMGNDF1D",604,0) + ;" ALL=show BOTH skip and non-skipped fields. +"RTN","TMGNDF1D",605,0) + ;"Output: User may alter the value of SKIP THIS RECORD field for all records +"RTN","TMGNDF1D",606,0) + ;"Results: none +"RTN","TMGNDF1D",607,0) + +"RTN","TMGNDF1D",608,0) + do CautionMsg +"RTN","TMGNDF1D",609,0) + +"RTN","TMGNDF1D",610,0) + new Options,IEN +"RTN","TMGNDF1D",611,0) + set Options("FIELDS",1)=".04^LONG NAME^25" +"RTN","TMGNDF1D",612,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1D",613,0) + set Options("FIELDS",2)=".05^TRADENAME^64" +"RTN","TMGNDF1D",614,0) + set Options("FIELDS","MAX NUM")=2 +"RTN","TMGNDF1D",615,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF1D",616,0) + +"RTN","TMGNDF1D",617,0) + set SkipValue=$get(SkipValue,0) ;"0=NOT SKIPPED +"RTN","TMGNDF1D",618,0) + ;"Get all records with chosed SKIP THIS RECORD value +"RTN","TMGNDF1D",619,0) + do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST"))) +"RTN","TMGNDF1D",620,0) + +"RTN","TMGNDF1D",621,0) +PSK1 if $$SELED^TMGSELED(.Options)'=2 goto ETNDone +"RTN","TMGNDF1D",622,0) + if $$GetIENs^TMGSELED(.Options)=0 goto ETNDone +"RTN","TMGNDF1D",623,0) + goto PSK1 +"RTN","TMGNDF1D",624,0) + +"RTN","TMGNDF1D",625,0) +ETNDone quit +"RTN","TMGNDF1D",626,0) + +"RTN","TMGNDF1D",627,0) + +"RTN","TMGNDF1D",628,0) + +"RTN","TMGNDF1D",629,0) + +"RTN","TMGNDF1D",630,0) +SelRxList(pList,pSelList,HdrText,mode) +"RTN","TMGNDF1D",631,0) + ;"Purpose: To display the Drug list, and allow user to select from the list. +"RTN","TMGNDF1D",632,0) + ;"Input: pList -- PASS BY NAME -- list of drugs to be added, as created by FillList(pList) +"RTN","TMGNDF1D",633,0) + ;" @pList@(drugName,IEN)="" +"RTN","TMGNDF1D",634,0) + ;" pSelList -- PASS BY NAME, an OUT PARAMETER. +"RTN","TMGNDF1D",635,0) + ;" Returns list of selected items +"RTN","TMGNDF1D",636,0) + ;" @pSelList@(drugName,IEN)="" ;IEN is from 22706.9 +"RTN","TMGNDF1D",637,0) + ;" @pSelList@(drugName,IEN)="" +"RTN","TMGNDF1D",638,0) + ;" HdrText -- optional, some text to show on top of selector +"RTN","TMGNDF1D",639,0) + ;" mode -- OPTIONAL. Default=1 +"RTN","TMGNDF1D",640,0) + ;" 1 --> Display by LONG NAME .04 name +"RTN","TMGNDF1D",641,0) + ;" 2 --> Display by VA PRODUCT (50.68) .01 name +"RTN","TMGNDF1D",642,0) + ;" 3 --> Display by FDA import name +"RTN","TMGNDF1D",643,0) + ;" 4 --> Display by VA GENERIC name +"RTN","TMGNDF1D",644,0) + +"RTN","TMGNDF1D",645,0) + ;"Results: none +"RTN","TMGNDF1D",646,0) + +"RTN","TMGNDF1D",647,0) + new ref set ref="^TMP(""VEE"",$J)" +"RTN","TMGNDF1D",648,0) + kill @ref +"RTN","TMGNDF1D",649,0) + new count set count=1 +"RTN","TMGNDF1D",650,0) + set mode=$get(mode,1) +"RTN","TMGNDF1D",651,0) + +"RTN","TMGNDF1D",652,0) + new pNDCIndex +"RTN","TMGNDF1D",653,0) + set pNDCIndex=$$GetNDCIndex^TMGNDF4A(1) +"RTN","TMGNDF1D",654,0) + +"RTN","TMGNDF1D",655,0) + write "Prepping to display list...",! +"RTN","TMGNDF1D",656,0) + ;"First convert list to a display format +"RTN","TMGNDF1D",657,0) + new name,IEN,Itr +"RTN","TMGNDF1D",658,0) + +"RTN","TMGNDF1D",659,0) + set name=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGNDF1D",660,0) + do PrepProgress^TMGITR(.Itr,20,1,"name") +"RTN","TMGNDF1D",661,0) + if name'="" for do quit:($$ItrANext^TMGITR(.Itr,.name)="") +"RTN","TMGNDF1D",662,0) + . new addedArray,showName +"RTN","TMGNDF1D",663,0) + . set IEN=0 +"RTN","TMGNDF1D",664,0) + . for set IEN=$order(@pList@(name,IEN)) quit:(IEN="") do +"RTN","TMGNDF1D",665,0) + . . new NameInfo do GetInfo^TMGNDF3B(IEN,.NameInfo) +"RTN","TMGNDF1D",666,0) + . . new IdxName set IdxName=$get(NameInfo("MODES",mode)) +"RTN","TMGNDF1D",667,0) + . . if mode=3 do ;"Display by FDA import name (TradeName) +"RTN","TMGNDF1D",668,0) + . . . set showName="" +"RTN","TMGNDF1D",669,0) + . . . for set showName=$order(NameInfo(IdxName,showName)) quit:(showName="") do +"RTN","TMGNDF1D",670,0) + . . . . set @ref@(count)=name_"^"_IEN_$char(9) +"RTN","TMGNDF1D",671,0) + . . . . new newShowName set newShowName=$extract(showName,1,35) +"RTN","TMGNDF1D",672,0) + . . . . set newShowName=$$LJ^XLFSTR(newShowName,35," ") +"RTN","TMGNDF1D",673,0) + . . . . new newName set newName=$extract(name,1,35) +"RTN","TMGNDF1D",674,0) + . . . . set newName=$$LJ^XLFSTR(newName,35," ") +"RTN","TMGNDF1D",675,0) + . . . . set @ref@(count)=@ref@(count)_newShowName_"|"_newName +"RTN","TMGNDF1D",676,0) + . . . . set count=count+1 +"RTN","TMGNDF1D",677,0) + . . . set showName="" ;"prevent duplicate addition below +"RTN","TMGNDF1D",678,0) + . . else if (mode>0)&(mode<5) set showName=$order(NameInfo(IdxName,"")) +"RTN","TMGNDF1D",679,0) + . . if (showName'="") set @ref@(count)=name_"^"_IEN_$char(9)_showName set count=count+1 +"RTN","TMGNDF1D",680,0) + +"RTN","TMGNDF1D",681,0) + set @ref@("HD")=$get(HdrText,"MENU") +"RTN","TMGNDF1D",682,0) + +"RTN","TMGNDF1D",683,0) + ;"Note: Rules of use: +"RTN","TMGNDF1D",684,0) + ;" ref must=^TMP("VEE",$J) +"RTN","TMGNDF1D",685,0) + ;" Each line should be in this format: +"RTN","TMGNDF1D",686,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",687,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",688,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",689,0) + ;" Results come back in: +"RTN","TMGNDF1D",690,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",691,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",692,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF1D",693,0) + +"RTN","TMGNDF1D",694,0) + write !,"Passing off to Selector..." +"RTN","TMGNDF1D",695,0) + D SELECT^%ZVEMKT(ref) +"RTN","TMGNDF1D",696,0) + +"RTN","TMGNDF1D",697,0) + set ref="^TMP(""VPE"",""SELECT"","_$J_")" +"RTN","TMGNDF1D",698,0) + new number set number="" +"RTN","TMGNDF1D",699,0) + for set number=$order(@ref@(number)) quit:(number="") do +"RTN","TMGNDF1D",700,0) + . new ReturnValue set ReturnValue=$piece(@ref@(number),$char(9),1) +"RTN","TMGNDF1D",701,0) + . new drugName set drugName=$piece(ReturnValue,"^",1) +"RTN","TMGNDF1D",702,0) + . new IEN set IEN=$piece(ReturnValue,"^",2) +"RTN","TMGNDF1D",703,0) + . set @pSelList@(drugName,IEN)="" +"RTN","TMGNDF1D",704,0) + +"RTN","TMGNDF1D",705,0) + quit +"RTN","TMGNDF1D",706,0) + +"RTN","TMGNDF1D",707,0) + ;"======================================================== +"RTN","TMGNDF1D",708,0) +PickEdit +"RTN","TMGNDF1D",709,0) + ;"Purpose: ask user to pick record, and then edit. +"RTN","TMGNDF1D",710,0) + +"RTN","TMGNDF1D",711,0) + new DIC,X,Y +"RTN","TMGNDF1D",712,0) + set DIC=22706.9 +"RTN","TMGNDF1D",713,0) + set DIC(0)="MAEQ" +"RTN","TMGNDF1D",714,0) + set DIC("A")="Enter Imported Drug to Edit (^ to abort): " +"RTN","TMGNDF1D",715,0) +PE1 +"RTN","TMGNDF1D",716,0) + do ^DIC write ! +"RTN","TMGNDF1D",717,0) + if +Y>0 do Edit1(+Y) goto PE1 +"RTN","TMGNDF1D",718,0) + +"RTN","TMGNDF1D",719,0) + quit +"RTN","TMGNDF1D",720,0) + +"RTN","TMGNDF1D",721,0) + +"RTN","TMGNDF1D",722,0) +Edit1(IEN) +"RTN","TMGNDF1D",723,0) + ;"Purpose: To edit one record in 22706.9 +"RTN","TMGNDF1D",724,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF1D",725,0) + ;"Results: none +"RTN","TMGNDF1D",726,0) + +"RTN","TMGNDF1D",727,0) + new Options,IENlist +"RTN","TMGNDF1D",728,0) + set IENlist(IEN)="" +"RTN","TMGNDF1D",729,0) + set Options("FILE")=22706.9 +"RTN","TMGNDF1D",730,0) + new temp +"RTN","TMGNDF1D",731,0) + set temp=$$GetFields^TMGSELED(.Options) +"RTN","TMGNDF1D",732,0) + if temp=1 set temp=$$EditRecs^TMGSELED("IENlist",.Options) +"RTN","TMGNDF1D",733,0) + +"RTN","TMGNDF1D",734,0) + quit +"RTN","TMGNDF1D",735,0) + +"RTN","TMGNDF1D",736,0) + +"RTN","TMGNDF1E") +0^40^B4552 +"RTN","TMGNDF1E",1,0) +TMGNDF1E ;TMG/kst/FDA Import: Pick imports to skip ;03/25/06 +"RTN","TMGNDF1E",2,0) + ;;1.0;TMG-LIB;**1**;01/23/07 +"RTN","TMGNDF1E",3,0) + +"RTN","TMGNDF1E",4,0) + ;"FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF1E",5,0) + ;"More code for determining files to skip. +"RTN","TMGNDF1E",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF1E",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF1E",8,0) + ;"1-23-07 +"RTN","TMGNDF1E",9,0) + +"RTN","TMGNDF1E",10,0) + ;"======================================================================= +"RTN","TMGNDF1E",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF1E",12,0) + ;"======================================================================= +"RTN","TMGNDF1E",13,0) + ;"Menu +"RTN","TMGNDF1E",14,0) + +"RTN","TMGNDF1E",15,0) + ;"======================================================================= +"RTN","TMGNDF1E",16,0) + ;" Private Functions. +"RTN","TMGNDF1E",17,0) + ;"======================================================================= +"RTN","TMGNDF1E",18,0) + ;"======================================================================= +"RTN","TMGNDF1E",19,0) + +"RTN","TMGNDF1E",20,0) +Menu +"RTN","TMGNDF1E",21,0) + ;"Purpose: To give an interactive menu of tools to clean up data. +"RTN","TMGNDF1E",22,0) + +"RTN","TMGNDF1E",23,0) + new Menu,UsrSlct +"RTN","TMGNDF1E",24,0) + new i set i=0 +"RTN","TMGNDF1E",25,0) + set Menu(i)="Pick Option for Picking Imports to SKIP (1E)",i=i+1 +"RTN","TMGNDF1E",26,0) + set Menu(i)="Flag DUPLICATE entries to be skipped"_$char(9)_"DUPS",i=i+1 +"RTN","TMGNDF1E",27,0) + set Menu(i)="Flag entries with MISSING STRENGTH to be skipped"_$char(9)_"RemoveStrMissing",i=i+1 +"RTN","TMGNDF1E",28,0) + set Menu(i)="Flag entries with MISSING UNITS to be skipped"_$char(9)_"RemoveUnitMissing",i=i+1 +"RTN","TMGNDF1E",29,0) + set Menu(i)="Flag entries with MISSING INGREDIENTS to be skipped"_$char(9)_"RemoveIngredMissing",i=i+1 +"RTN","TMGNDF1E",30,0) + set Menu(i)="Flag entries with MISSING TRADE NAME to be skipped"_$char(9)_"RemoveTNameMissing",i=i+1 +"RTN","TMGNDF1E",31,0) + set Menu(i)="Flag entries with MISSING GENERIC NAME to be skipped"_$char(9)_"RemoveGNameMissing",i=i+1 +"RTN","TMGNDF1E",32,0) + set Menu(i)="Flag entries with MISSING NDC to be skipped"_$char(9)_"RemoveNDCMissing",i=i+1 +"RTN","TMGNDF1E",33,0) + set Menu(i)="Manually PICK drugs to be skipped: Trade Name, Units, Strength"_$char(9)_"PICK",i=i+1 +"RTN","TMGNDF1E",34,0) + set Menu(i)="Manually PICK drugs to be skipped: Trade Name, Generic Name, Strength"_$char(9)_"PICK2",i=i+1 +"RTN","TMGNDF1E",35,0) + set Menu(i)="Manually PICK drugs to be skipped: Long Name, Trade&Form, Generic&Form"_$char(9)_"PICK3",i=i+1 +"RTN","TMGNDF1E",36,0) + set Menu(i)="Manually PICK drugs to be UNSKIPPED: Trade Name, Units, Strength"_$char(9)_"UNPICK",i=i+1 +"RTN","TMGNDF1E",37,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF1E",38,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF1E",39,0) + +"RTN","TMGNDF1E",40,0) +CD1 +"RTN","TMGNDF1E",41,0) + write # +"RTN","TMGNDF1E",42,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF1E",43,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF1E",44,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF1E",45,0) + +"RTN","TMGNDF1E",46,0) + if UsrSlct="Prev" goto Menu^TMGNDF1D ;"quit can occur from there... +"RTN","TMGNDF1E",47,0) + if UsrSlct="Next" goto Menu^TMGNDF1F ;"quit can occur from there... +"RTN","TMGNDF1E",48,0) + +"RTN","TMGNDF1E",49,0) + if UsrSlct="DUPS" do RemoveDups goto CD1 +"RTN","TMGNDF1E",50,0) + if UsrSlct="RemoveStrMissing" do RemoveStrMissing goto CD1 +"RTN","TMGNDF1E",51,0) + if UsrSlct="RemoveUnitMissing" do RemoveUnitMissing goto CD1 +"RTN","TMGNDF1E",52,0) + if UsrSlct="RemoveTNameMissing" do RemoveTNameMissing goto CD1 +"RTN","TMGNDF1E",53,0) + if UsrSlct="RemoveGNameMissing" do RemoveGNameMissing goto CD1 +"RTN","TMGNDF1E",54,0) + if UsrSlct="RemoveNDCMissing" do RemoveNDCMissing goto CD1 +"RTN","TMGNDF1E",55,0) + if UsrSlct="RemoveIngredMissing" do RemoveIngredMissing goto CD1 +"RTN","TMGNDF1E",56,0) + if UsrSlct="PICK" do PickSkips(,,1,1) goto CD1 +"RTN","TMGNDF1E",57,0) + if UsrSlct="PICK2" do PickSkp2(,) goto CD1 +"RTN","TMGNDF1E",58,0) + if UsrSlct="PICK3" do PickSkp3(,) goto CD1 +"RTN","TMGNDF1E",59,0) + if UsrSlct="UNPICK" do PickSkips(,,,,"ALL") goto CD1 +"RTN","TMGNDF1E",60,0) + goto CDDone +"RTN","TMGNDF1E",61,0) +CDDone +"RTN","TMGNDF1E",62,0) + quit +"RTN","TMGNDF1E",63,0) + +"RTN","TMGNDF1E",64,0) + +"RTN","TMGNDF1E",65,0) + +"RTN","TMGNDF1E",66,0) + +"RTN","TMGNDF1E",67,0) +SelectScan(ScrnCode,editStr,edtUnit) +"RTN","TMGNDF1E",68,0) + ;"Purpose: Set chosen records to be skipped +"RTN","TMGNDF1E",69,0) + ;" This will scan for records passing screen and pre-select +"RTN","TMGNDF1E",70,0) + ;" them. Then display them to the user to allow +"RTN","TMGNDF1E",71,0) + ;" the individual drugs to be de-selected if wanted. +"RTN","TMGNDF1E",72,0) + ;" After finishing the review, then all the selected +"RTN","TMGNDF1E",73,0) + ;" records may be set to SKIP +"RTN","TMGNDF1E",74,0) + ;"Input: ScrnCode -- OPTIONAL. M Code to execute in the following format: +"RTN","TMGNDF1E",75,0) + ;" set flagToSkip=$$SomeTest(IEN) +"RTN","TMGNDF1E",76,0) + ;" Code may use variable IEN, which is record in 22706.9 +"RTN","TMGNDF1E",77,0) + ;" editStr: Optional. Default=0. 1 if Can edit Strength field +"RTN","TMGNDF1E",78,0) + ;" editUnit: Optional. Default=0. 1 if Can edit Unit field +"RTN","TMGNDF1E",79,0) + ;"Output: Records may be set to be skipped if user chooses to do this. +"RTN","TMGNDF1E",80,0) + ;"Results: none +"RTN","TMGNDF1E",81,0) + +"RTN","TMGNDF1E",82,0) + new SelArray,flagToSkip +"RTN","TMGNDF1E",83,0) + set ScrnCode=$get(ScrnCode) +"RTN","TMGNDF1E",84,0) + +"RTN","TMGNDF1E",85,0) + new Itr,IEN,abort,name +"RTN","TMGNDF1E",86,0) + set abort=0 +"RTN","TMGNDF1E",87,0) + write "Scanning drugs for entries to be preselected for skipping...",! +"RTN","TMGNDF1E",88,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1E",89,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1E",90,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1E",91,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)'=0 quit ;"0=KEEP; 1=SKIP +"RTN","TMGNDF1E",92,0) + . if $$KeyPressed^TMGUSRIF=27 set abort=27 quit +"RTN","TMGNDF1E",93,0) + . set flagToSkip=0 +"RTN","TMGNDF1E",94,0) + . new $etrap set $etrap="write !,""Error trapped."",!" +"RTN","TMGNDF1E",95,0) + . if ScrnCode'="" xecute ScrnCode +"RTN","TMGNDF1E",96,0) + . if flagToSkip=1 set SelArray(IEN)="" +"RTN","TMGNDF1E",97,0) + +"RTN","TMGNDF1E",98,0) + new % set %=2 +"RTN","TMGNDF1E",99,0) + write !,"Show ONLY preselected drugs (faster)" +"RTN","TMGNDF1E",100,0) + do YN^DICN write ! +"RTN","TMGNDF1E",101,0) + ;"write "%=",%,! +"RTN","TMGNDF1E",102,0) + if %=-1 goto SScDone +"RTN","TMGNDF1E",103,0) + write !,"Now will show entries PRESELECTED in list of all drugs.",! +"RTN","TMGNDF1E",104,0) + do PickSkips(.SelArray,(%=1),.editStr,.editUnit) +"RTN","TMGNDF1E",105,0) + +"RTN","TMGNDF1E",106,0) +SScDone +"RTN","TMGNDF1E",107,0) + quit +"RTN","TMGNDF1E",108,0) + +"RTN","TMGNDF1E",109,0) + +"RTN","TMGNDF1E",110,0) + +"RTN","TMGNDF1E",111,0) +PickSkips(SelArray,JustSelected,editStr,edtUnit,SkipValue) +"RTN","TMGNDF1E",112,0) + ;"Purpose: to select records to mark as to be skipped. +"RTN","TMGNDF1E",113,0) + ;"Input: SelArray: Optional. PASS BY REFERENCE. An array of preselected IEN's +"RTN","TMGNDF1E",114,0) + ;" Format: SelArray(IEN in 22706.9)="" <-- IEN preselected +"RTN","TMGNDF1E",115,0) + ;" JustSelected: Optional. if 1, then ONLY IENs from SelArray shown. +"RTN","TMGNDF1E",116,0) + ;" editStr: Optional. Default=0. 1 if Can edit Strength field +"RTN","TMGNDF1E",117,0) + ;" editUnit: Optional. Default=0. 1 if Can edit Unit field +"RTN","TMGNDF1E",118,0) + ;" SkipValue: OPTIONAL. Default=0. +"RTN","TMGNDF1E",119,0) + ;" 0=show only values NOT marked to be skipped +"RTN","TMGNDF1E",120,0) + ;" 1=show only values MARKED to be skipped +"RTN","TMGNDF1E",121,0) + ;" ALL=show BOTH skip and non-skipped fields. +"RTN","TMGNDF1E",122,0) + ;"Output: User may alter the value of SKIP THIS RECORD field for all records +"RTN","TMGNDF1E",123,0) + ;"Results: none +"RTN","TMGNDF1E",124,0) + +"RTN","TMGNDF1E",125,0) + new Options,IEN +"RTN","TMGNDF1E",126,0) + set Options("FIELDS",1)=".05^TRADENAME^50" +"RTN","TMGNDF1E",127,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",128,0) + set Options("FIELDS",2)="1^STRENGTH^9" +"RTN","TMGNDF1E",129,0) + if +$get(editStr)=0 set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",130,0) + set Options("FIELDS",3)="2^UNIT^9" +"RTN","TMGNDF1E",131,0) + if +$get(editUnit)=0 set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",132,0) + set Options("FIELDS",4)="6^SKIP THIS RECORD^4" +"RTN","TMGNDF1E",133,0) + set Options("FIELDS","MAX NUM")=4 +"RTN","TMGNDF1E",134,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF1E",135,0) + +"RTN","TMGNDF1E",136,0) + set SkipValue=$get(SkipValue,0) +"RTN","TMGNDF1E",137,0) + if +$get(JustSelected)=0 do +"RTN","TMGNDF1E",138,0) + . ;"Get all records with chosed SKIP THIS RECORD value +"RTN","TMGNDF1E",139,0) + . if SkipValue=0 do +"RTN","TMGNDF1E",140,0) + . . new ScrnCode set ScrnCode="($get(RecValue)=1)" ;"Field has THREE possible values: 0,1,NULL +"RTN","TMGNDF1E",141,0) + . . do GetFldVScreen^TMGSELED(22706.9,6,ScrnCode,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",142,0) + . else do +"RTN","TMGNDF1E",143,0) + . . do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",144,0) + else do +"RTN","TMGNDF1E",145,0) + . merge Options("IEN LIST")=SelArray +"RTN","TMGNDF1E",146,0) + +"RTN","TMGNDF1E",147,0) +PSK1 if $data(SelArray) do +"RTN","TMGNDF1E",148,0) + . set IEN="" +"RTN","TMGNDF1E",149,0) + . for set IEN=$order(SelArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF1E",150,0) + . . if $data(Options("IEN LIST",IEN))>0 do +"RTN","TMGNDF1E",151,0) + . . . set Options("IEN LIST",IEN,"SEL")="" +"RTN","TMGNDF1E",152,0) + +"RTN","TMGNDF1E",153,0) + if $$SELED^TMGSELED(.Options)'=2 goto PSKDone +"RTN","TMGNDF1E",154,0) + if $$GetIENs^TMGSELED(.Options)=0 goto PSKDone +"RTN","TMGNDF1E",155,0) + goto PSK1 +"RTN","TMGNDF1E",156,0) + +"RTN","TMGNDF1E",157,0) +PSKDone quit +"RTN","TMGNDF1E",158,0) + +"RTN","TMGNDF1E",159,0) + +"RTN","TMGNDF1E",160,0) +PickSkp2(SelArray,JustSelected,SkipValue) +"RTN","TMGNDF1E",161,0) + ;"Purpose: to select records to mark as to be skipped. +"RTN","TMGNDF1E",162,0) + ;" Showing Tradename and Generic name +"RTN","TMGNDF1E",163,0) + ;"Input: SelArray: Optional. PASS BY REFERENCE. An array of preselected IEN's +"RTN","TMGNDF1E",164,0) + ;" Format: SelArray(IEN in 22706.9)="" <-- IEN preselected +"RTN","TMGNDF1E",165,0) + ;" JustSelected: Optional. if 1, then ONLY IENs from SelArray shown. +"RTN","TMGNDF1E",166,0) + ;" SkipValue: OPTIONAL. Default=0. +"RTN","TMGNDF1E",167,0) + ;" 0=show only values NOT marked to be skipped +"RTN","TMGNDF1E",168,0) + ;" 1=show only values MARKED to be skipped +"RTN","TMGNDF1E",169,0) + ;" ALL=show BOTH skip and non-skipped fields. +"RTN","TMGNDF1E",170,0) + ;"Output: User may alter the value of SKIP THIS RECORD field for all records +"RTN","TMGNDF1E",171,0) + ;"Results: none +"RTN","TMGNDF1E",172,0) + +"RTN","TMGNDF1E",173,0) + new Options,IEN +"RTN","TMGNDF1E",174,0) + set Options("FIELDS",1)=".05^TRADENAME^30" +"RTN","TMGNDF1E",175,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",176,0) + set Options("FIELDS",2)=".07^GENERIC NAME^30" +"RTN","TMGNDF1E",177,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",178,0) + set Options("FIELDS",3)="1^STRENGTH^9" +"RTN","TMGNDF1E",179,0) + set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",180,0) + set Options("FIELDS",4)="6^SKIP THIS RECORD^4" +"RTN","TMGNDF1E",181,0) + set Options("FIELDS","MAX NUM")=4 +"RTN","TMGNDF1E",182,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF1E",183,0) + +"RTN","TMGNDF1E",184,0) + set SkipValue=$get(SkipValue,0) +"RTN","TMGNDF1E",185,0) + if +$get(JustSelected)=0 do +"RTN","TMGNDF1E",186,0) + . ;"Get all records with chosed SKIP THIS RECORD value +"RTN","TMGNDF1E",187,0) + . if SkipValue=0 do +"RTN","TMGNDF1E",188,0) + . . new ScrnCode set ScrnCode="($get(RecValue)=1)" ;"Field has THREE possible values: 0,1,NULL +"RTN","TMGNDF1E",189,0) + . . do GetFldVScreen^TMGSELED(22706.9,6,ScrnCode,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",190,0) + . else do +"RTN","TMGNDF1E",191,0) + . . do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",192,0) + else do +"RTN","TMGNDF1E",193,0) + . merge Options("IEN LIST")=SelArray +"RTN","TMGNDF1E",194,0) + +"RTN","TMGNDF1E",195,0) +PSK21 if $data(SelArray) do +"RTN","TMGNDF1E",196,0) + . set IEN="" +"RTN","TMGNDF1E",197,0) + . for set IEN=$order(SelArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF1E",198,0) + . . if $data(Options("IEN LIST",IEN))>0 do +"RTN","TMGNDF1E",199,0) + . . . set Options("IEN LIST",IEN,"SEL")="" +"RTN","TMGNDF1E",200,0) + +"RTN","TMGNDF1E",201,0) + if $$SELED^TMGSELED(.Options)'=2 goto PSK2Done +"RTN","TMGNDF1E",202,0) + if $$GetIENs^TMGSELED(.Options)=0 goto PSK2Done +"RTN","TMGNDF1E",203,0) + goto PSK21 +"RTN","TMGNDF1E",204,0) + +"RTN","TMGNDF1E",205,0) +PSK2Done quit +"RTN","TMGNDF1E",206,0) + +"RTN","TMGNDF1E",207,0) + +"RTN","TMGNDF1E",208,0) + +"RTN","TMGNDF1E",209,0) +PickSkp3(SelArray,JustSelected,SkipValue) +"RTN","TMGNDF1E",210,0) + ;"Purpose: to select records to mark as to be skipped. +"RTN","TMGNDF1E",211,0) + ;" Showing Tradename and Generic name +"RTN","TMGNDF1E",212,0) + ;"Input: SelArray: Optional. PASS BY REFERENCE. An array of preselected IEN's +"RTN","TMGNDF1E",213,0) + ;" Format: SelArray(IEN in 22706.9)="" <-- IEN preselected +"RTN","TMGNDF1E",214,0) + ;" JustSelected: Optional. if 1, then ONLY IENs from SelArray shown. +"RTN","TMGNDF1E",215,0) + ;" SkipValue: OPTIONAL. Default=0. +"RTN","TMGNDF1E",216,0) + ;" 0=show only values NOT marked to be skipped +"RTN","TMGNDF1E",217,0) + ;" 1=show only values MARKED to be skipped +"RTN","TMGNDF1E",218,0) + ;" ALL=show BOTH skip and non-skipped fields. +"RTN","TMGNDF1E",219,0) + ;"Output: User may alter the value of SKIP THIS RECORD field for all records +"RTN","TMGNDF1E",220,0) + ;"Results: none +"RTN","TMGNDF1E",221,0) + +"RTN","TMGNDF1E",222,0) + new Options,IEN +"RTN","TMGNDF1E",223,0) + set Options("FIELDS",1)=".04^LONG NAME^30" +"RTN","TMGNDF1E",224,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",225,0) + set Options("FIELDS",2)=".055^TRADE NAME & FORM - 40^20" +"RTN","TMGNDF1E",226,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",227,0) + set Options("FIELDS",3)=".075^GENERIC NAME & FORM - 40^20" +"RTN","TMGNDF1E",228,0) + set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1E",229,0) + set Options("FIELDS",4)="6^SKIP THIS RECORD^4" +"RTN","TMGNDF1E",230,0) + set Options("FIELDS","MAX NUM")=4 +"RTN","TMGNDF1E",231,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF1E",232,0) + +"RTN","TMGNDF1E",233,0) + set SkipValue=$get(SkipValue,0) +"RTN","TMGNDF1E",234,0) + if +$get(JustSelected)=0 do +"RTN","TMGNDF1E",235,0) + . ;"Get all records with chosed SKIP THIS RECORD value +"RTN","TMGNDF1E",236,0) + . if SkipValue=0 do +"RTN","TMGNDF1E",237,0) + . . new ScrnCode set ScrnCode="($get(RecValue)=1)" ;"Field has THREE possible values: 0:keep,1:skip,NULL +"RTN","TMGNDF1E",238,0) + . . do GetFldVScreen^TMGSELED(22706.9,6,ScrnCode,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",239,0) + . else do +"RTN","TMGNDF1E",240,0) + . . do GetFldValue^TMGSELED(22706.9,6,SkipValue,$name(Options("IEN LIST"))) +"RTN","TMGNDF1E",241,0) + else do +"RTN","TMGNDF1E",242,0) + . merge Options("IEN LIST")=SelArray +"RTN","TMGNDF1E",243,0) + +"RTN","TMGNDF1E",244,0) +PSK31 if $data(SelArray) do +"RTN","TMGNDF1E",245,0) + . set IEN="" +"RTN","TMGNDF1E",246,0) + . for set IEN=$order(SelArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF1E",247,0) + . . if $data(Options("IEN LIST",IEN))>0 do +"RTN","TMGNDF1E",248,0) + . . . set Options("IEN LIST",IEN,"SEL")="" +"RTN","TMGNDF1E",249,0) + +"RTN","TMGNDF1E",250,0) + if $$SELED^TMGSELED(.Options)'=2 goto PSK3Done +"RTN","TMGNDF1E",251,0) + if $$GetIENs^TMGSELED(.Options)=0 goto PSK3Done +"RTN","TMGNDF1E",252,0) + goto PSK31 +"RTN","TMGNDF1E",253,0) + +"RTN","TMGNDF1E",254,0) +PSK3Done quit +"RTN","TMGNDF1E",255,0) + +"RTN","TMGNDF1E",256,0) + +"RTN","TMGNDF1E",257,0) + +"RTN","TMGNDF1E",258,0) +RemoveDups +"RTN","TMGNDF1E",259,0) + ;"Purpose: Set duplicate records to be skipped +"RTN","TMGNDF1E",260,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",261,0) + +"RTN","TMGNDF1E",262,0) + new ref set ref=$name(^TMG("TMP","SEL SCAN")) +"RTN","TMGNDF1E",263,0) + kill @ref +"RTN","TMGNDF1E",264,0) + do SelectScan("set flagToSkip=$$DupTest(IEN)",0,0) +"RTN","TMGNDF1E",265,0) + kill @ref +"RTN","TMGNDF1E",266,0) + quit +"RTN","TMGNDF1E",267,0) + +"RTN","TMGNDF1E",268,0) + +"RTN","TMGNDF1E",269,0) +DupTest(IEN) +"RTN","TMGNDF1E",270,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",271,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",272,0) + +"RTN","TMGNDF1E",273,0) + new result set result=0 +"RTN","TMGNDF1E",274,0) + if $get(IEN)'="" do +"RTN","TMGNDF1E",275,0) + . new ref set ref=$name(^TMG("TMP","SEL SCAN")) +"RTN","TMGNDF1E",276,0) + . ;"if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 set result=1 goto DTDone +"RTN","TMGNDF1E",277,0) + . new name set name=$$MakeName^TMGNDF2G(IEN) +"RTN","TMGNDF1E",278,0) + . if $data(@ref@(name))>0 set result=1 +"RTN","TMGNDF1E",279,0) + . else set @ref@(name)="" +"RTN","TMGNDF1E",280,0) + +"RTN","TMGNDF1E",281,0) +DTDone quit result +"RTN","TMGNDF1E",282,0) + +"RTN","TMGNDF1E",283,0) + +"RTN","TMGNDF1E",284,0) +RemoveStrMissing +"RTN","TMGNDF1E",285,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",286,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",287,0) + write "Preselect items with Strength missing...",! +"RTN","TMGNDF1E",288,0) + do SelectScan("set flagToSkip=$$MissStrTest(IEN)",1,1) +"RTN","TMGNDF1E",289,0) + quit +"RTN","TMGNDF1E",290,0) + +"RTN","TMGNDF1E",291,0) +MissStrTest(IEN) +"RTN","TMGNDF1E",292,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",293,0) + ;" Will flag for skipping if missing STRENGTH +"RTN","TMGNDF1E",294,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",295,0) + +"RTN","TMGNDF1E",296,0) + new result set result=0 +"RTN","TMGNDF1E",297,0) + new s set s=$get(^TMG(22706.9,IEN,0)) +"RTN","TMGNDF1E",298,0) + ;"0;2=STENGTH field +"RTN","TMGNDF1E",299,0) + if ($piece(s,"^",2)="") set result=1 +"RTN","TMGNDF1E",300,0) + quit result +"RTN","TMGNDF1E",301,0) + +"RTN","TMGNDF1E",302,0) + +"RTN","TMGNDF1E",303,0) +RemoveUnitMissing +"RTN","TMGNDF1E",304,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",305,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",306,0) + write "Preselect items with Units missing...",! +"RTN","TMGNDF1E",307,0) + do SelectScan("set flagToSkip=$$MissUnitTest(IEN)",1,1) +"RTN","TMGNDF1E",308,0) + quit +"RTN","TMGNDF1E",309,0) + +"RTN","TMGNDF1E",310,0) + +"RTN","TMGNDF1E",311,0) +MissUnitTest(IEN) +"RTN","TMGNDF1E",312,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",313,0) + ;" Will flag for skipping if missing UNITS +"RTN","TMGNDF1E",314,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",315,0) + +"RTN","TMGNDF1E",316,0) + new result set result=0 +"RTN","TMGNDF1E",317,0) + new s set s=$get(^TMG(22706.9,IEN,0)) +"RTN","TMGNDF1E",318,0) + ;"0;3=UNIT field +"RTN","TMGNDF1E",319,0) + if ($piece(s,"^",3)="") set result=1 +"RTN","TMGNDF1E",320,0) + quit result +"RTN","TMGNDF1E",321,0) + +"RTN","TMGNDF1E",322,0) +RemoveTNameMissing +"RTN","TMGNDF1E",323,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",324,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",325,0) + write "Preselect items with Tradename missing...",! +"RTN","TMGNDF1E",326,0) + do SelectScan("set flagToSkip=$$MissTNameTest(IEN)",1,1) +"RTN","TMGNDF1E",327,0) + quit +"RTN","TMGNDF1E",328,0) + +"RTN","TMGNDF1E",329,0) + +"RTN","TMGNDF1E",330,0) +MissTNameTest(IEN) +"RTN","TMGNDF1E",331,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",332,0) + ;" Will flag for skipping if missing TRADENAME +"RTN","TMGNDF1E",333,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",334,0) + +"RTN","TMGNDF1E",335,0) + new result set result=0 +"RTN","TMGNDF1E",336,0) + new s set s=$get(^TMG(22706.9,IEN,0)) +"RTN","TMGNDF1E",337,0) + ;"0;4=TRADENAME +"RTN","TMGNDF1E",338,0) + if ($piece(s,"^",4)="") set result=1 +"RTN","TMGNDF1E",339,0) + quit result +"RTN","TMGNDF1E",340,0) + +"RTN","TMGNDF1E",341,0) +RemoveGNameMissing +"RTN","TMGNDF1E",342,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",343,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",344,0) + write "Preselect items with Generic Name missing...",! +"RTN","TMGNDF1E",345,0) + do SelectScan("set flagToSkip=$$MissGNameTest(IEN)",1,1) +"RTN","TMGNDF1E",346,0) + quit +"RTN","TMGNDF1E",347,0) + +"RTN","TMGNDF1E",348,0) + +"RTN","TMGNDF1E",349,0) +MissGNameTest(IEN) +"RTN","TMGNDF1E",350,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",351,0) + ;" Will flag for skipping if missing GENERIC NAME +"RTN","TMGNDF1E",352,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",353,0) + +"RTN","TMGNDF1E",354,0) + new result set result=0 +"RTN","TMGNDF1E",355,0) + new s set s=$get(^TMG(22706.9,IEN,0)) +"RTN","TMGNDF1E",356,0) + ;"0;6=GENERIC NAME +"RTN","TMGNDF1E",357,0) + if ($piece(s,"^",6)="") set result=1 +"RTN","TMGNDF1E",358,0) + quit result +"RTN","TMGNDF1E",359,0) + +"RTN","TMGNDF1E",360,0) +RemoveNDCMissing +"RTN","TMGNDF1E",361,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",362,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",363,0) + write "Preselect items with NDC missing...",! +"RTN","TMGNDF1E",364,0) + do SelectScan("set flagToSkip=$$MissNDCTest(IEN)",1,1) +"RTN","TMGNDF1E",365,0) + quit +"RTN","TMGNDF1E",366,0) + +"RTN","TMGNDF1E",367,0) + +"RTN","TMGNDF1E",368,0) +MissNDCTest(IEN) +"RTN","TMGNDF1E",369,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",370,0) + ;" Will flag for skipping if missing NDC +"RTN","TMGNDF1E",371,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",372,0) + +"RTN","TMGNDF1E",373,0) + new result set result=0 +"RTN","TMGNDF1E",374,0) + set s=$get(^TMG(22706.9,IEN,1)) +"RTN","TMGNDF1E",375,0) + ;"1;2=NDC 12 DIGIT +"RTN","TMGNDF1E",376,0) + if ($piece(s,"^",2)="") set result=1 +"RTN","TMGNDF1E",377,0) + quit result +"RTN","TMGNDF1E",378,0) + +"RTN","TMGNDF1E",379,0) +RemoveIngredMissing +"RTN","TMGNDF1E",380,0) + ;"Purpose: Set incomplete records to be skipped +"RTN","TMGNDF1E",381,0) + ;" Then allow selected records to be set to SKIP +"RTN","TMGNDF1E",382,0) + write "Preselect items with Ingredients missing...",! +"RTN","TMGNDF1E",383,0) + do SelectScan("set flagToSkip=$$MissIngredTest(IEN)",1,1) +"RTN","TMGNDF1E",384,0) + quit +"RTN","TMGNDF1E",385,0) + +"RTN","TMGNDF1E",386,0) + +"RTN","TMGNDF1E",387,0) +MissIngredTest(IEN) +"RTN","TMGNDF1E",388,0) + ;"Purpose: to determine if record should be selected +"RTN","TMGNDF1E",389,0) + ;" Will flag for skipping if missing NDC +"RTN","TMGNDF1E",390,0) + ;"Returns 1 if should be flagged for skip, otherwise 0 +"RTN","TMGNDF1E",391,0) + +"RTN","TMGNDF1E",392,0) + new result set result=0 +"RTN","TMGNDF1E",393,0) + ;"4th piece of 0 node is total number of records +"RTN","TMGNDF1E",394,0) + new numRecs +"RTN","TMGNDF1E",395,0) + set numRecs=+$piece($get(^TMG(22706.9,IEN,4,0)),"^",4) +"RTN","TMGNDF1E",396,0) + if numRecs=0 set result=1 +"RTN","TMGNDF1E",397,0) + if numRecs=1 do +"RTN","TMGNDF1E",398,0) + . if +$piece($get(^TMG(22706.9,IEN,4,1,0)),"^",3)=0 set result=1 +"RTN","TMGNDF1E",399,0) + quit result +"RTN","TMGNDF1E",400,0) + +"RTN","TMGNDF1F") +0^41^B6001 +"RTN","TMGNDF1F",1,0) +TMGNDF1F ;TMG/kst/FDA Import: Work with drug ROUTES ;03/25/06 +"RTN","TMGNDF1F",2,0) + ;;1.0;TMG-LIB;**1**;02/26/07 +"RTN","TMGNDF1F",3,0) + +"RTN","TMGNDF1F",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF1F",5,0) + ;" -- Working with Dosage ROUTES +"RTN","TMGNDF1F",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF1F",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF1F",8,0) + ;"2-26-07 +"RTN","TMGNDF1F",9,0) + +"RTN","TMGNDF1F",10,0) + ;"======================================================================= +"RTN","TMGNDF1F",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF1F",12,0) + ;"======================================================================= +"RTN","TMGNDF1F",13,0) + ;"Menu +"RTN","TMGNDF1F",14,0) + +"RTN","TMGNDF1F",15,0) + ;"======================================================================= +"RTN","TMGNDF1F",16,0) + ;" Private Functions. +"RTN","TMGNDF1F",17,0) + ;"======================================================================= +"RTN","TMGNDF1F",18,0) + +"RTN","TMGNDF1F",19,0) + ;"======================================================================= +"RTN","TMGNDF1F",20,0) + ;"======================================================================= +"RTN","TMGNDF1F",21,0) + +"RTN","TMGNDF1F",22,0) + ;"ScrnAll -- Fix missing Dose ROUTES from DRUG file +"RTN","TMGNDF1F",23,0) + +"RTN","TMGNDF1F",24,0) + ;"======================================================================= +"RTN","TMGNDF1F",25,0) + ;" Private Functions. +"RTN","TMGNDF1F",26,0) + ;"======================================================================= +"RTN","TMGNDF1F",27,0) +Menu +"RTN","TMGNDF1F",28,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF1F",29,0) + +"RTN","TMGNDF1F",30,0) + new Menu,UsrSlct +"RTN","TMGNDF1F",31,0) + set Menu(0)="Pick Option for Ensuring correct DOSE ROUTES (1F)" +"RTN","TMGNDF1F",32,0) + +"RTN","TMGNDF1F",33,0) + new i set i=1 +"RTN","TMGNDF1F",34,0) + set Menu(i)="Find new import ROUTES"_$char(9)_"FINDNEW" set i=i+1 +"RTN","TMGNDF1F",35,0) + set Menu(i)="Match imports ROUTE --> VA ROUTE"_$char(9)_"MATCH" set i=i+1 +"RTN","TMGNDF1F",36,0) + set Menu(i)="Fix imports with missing ROUTE"_$char(9)_"FixMissingRoute" set i=i+1 +"RTN","TMGNDF1F",37,0) + set Menu(i)="Screen ALL imports for INCORRECT ROUTE"_$char(9)_"ScreenAll" set i=i+1 +"RTN","TMGNDF1F",38,0) + set Menu(i)="Edit match file (IF NEEDED)"_$char(9)_"EditMatch" set i=i+1 +"RTN","TMGNDF1F",39,0) + set Menu(i)="Edit VA ROUTES (file 51.2) (ONLY IF NEEDED)"_$char(9)_"EDITVA" set i=i+1 +"RTN","TMGNDF1F",40,0) + set Menu(i)="USE links for import ROUTE --> VA ROUTE (DO THIS LAST)"_$char(9)_"FillVARoute" set i=i+1 +"RTN","TMGNDF1F",41,0) + +"RTN","TMGNDF1F",42,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF1F",43,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF1F",44,0) + +"RTN","TMGNDF1F",45,0) +MC1 write # +"RTN","TMGNDF1F",46,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF1F",47,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF1F",48,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF1F",49,0) + +"RTN","TMGNDF1F",50,0) + if UsrSlct="FixMissingRoute" do FixMissingRoute goto MC1 +"RTN","TMGNDF1F",51,0) + if UsrSlct="ScreenAll" do ScrnAll goto MC1 +"RTN","TMGNDF1F",52,0) + +"RTN","TMGNDF1F",53,0) + if UsrSlct="FillVARoute" do FillVARoute goto MC1 +"RTN","TMGNDF1F",54,0) + if UsrSlct="EditMatch" do EditMatchFile goto MC1 +"RTN","TMGNDF1F",55,0) + if UsrSlct="FINDNEW" do FindUnmatched goto MC1 +"RTN","TMGNDF1F",56,0) + if UsrSlct="MATCH" do HandleLinks goto MC1 +"RTN","TMGNDF1F",57,0) + if UsrSlct="EDITVA" do EditVARoutes goto MC1 +"RTN","TMGNDF1F",58,0) + +"RTN","TMGNDF1F",59,0) + +"RTN","TMGNDF1F",60,0) + if UsrSlct="Prev" goto Menu^TMGNDF1E ;"quit can occur from there... +"RTN","TMGNDF1F",61,0) + if UsrSlct="Next" goto Menu^TMGNDF2A ;"quit can occur from there... +"RTN","TMGNDF1F",62,0) + goto MC1 +"RTN","TMGNDF1F",63,0) + +"RTN","TMGNDF1F",64,0) +MCDone +"RTN","TMGNDF1F",65,0) + quit +"RTN","TMGNDF1F",66,0) + +"RTN","TMGNDF1F",67,0) + ;"======================================================================= +"RTN","TMGNDF1F",68,0) + +"RTN","TMGNDF1F",69,0) + +"RTN","TMGNDF1F",70,0) +ScrnAll +"RTN","TMGNDF1F",71,0) + ;"Purpose: Fix missing or screen for Dose ROUTES from DRUG file +"RTN","TMGNDF1F",72,0) + ;"Results -- none. +"RTN","TMGNDF1F",73,0) + +"RTN","TMGNDF1F",74,0) + write "Scanning for records to display...",! +"RTN","TMGNDF1F",75,0) + do SelEdRArray() +"RTN","TMGNDF1F",76,0) + quit +"RTN","TMGNDF1F",77,0) + +"RTN","TMGNDF1F",78,0) + +"RTN","TMGNDF1F",79,0) +FixMissingRoute +"RTN","TMGNDF1F",80,0) + ;"Purpose: Fix missing or screen for Dose ROUTES from DRUG file +"RTN","TMGNDF1F",81,0) + ;"Results: none +"RTN","TMGNDF1F",82,0) + +"RTN","TMGNDF1F",83,0) + new PreSelArray,JustSelected +"RTN","TMGNDF1F",84,0) + set JustSelected=0 +"RTN","TMGNDF1F",85,0) + +"RTN","TMGNDF1F",86,0) + write "Scanning for entries with no DOSE ROUTE...",! +"RTN","TMGNDF1F",87,0) + do GetFldVScreen^TMGSELED(22706.9,3,"$$ScrnTest^TMGNDF1F","PreSelArray") +"RTN","TMGNDF1F",88,0) + +"RTN","TMGNDF1F",89,0) + write "Show just those preselected? (Faster)" +"RTN","TMGNDF1F",90,0) + new % set %=1 do YN^DICN write ! +"RTN","TMGNDF1F",91,0) + if %=1 set JustSelected=1 +"RTN","TMGNDF1F",92,0) + else write "Now scanning for the rest of the entries...",! +"RTN","TMGNDF1F",93,0) + do SelEdRArray(.PreSelArray,JustSelected) +"RTN","TMGNDF1F",94,0) + +"RTN","TMGNDF1F",95,0) + do FindUnmatched +"RTN","TMGNDF1F",96,0) + quit +"RTN","TMGNDF1F",97,0) + +"RTN","TMGNDF1F",98,0) + +"RTN","TMGNDF1F",99,0) +ScrnTest() +"RTN","TMGNDF1F",100,0) + ;"Purpose: this is a callback function for GetFldVScreen^TMGSELED +"RTN","TMGNDF1F",101,0) + ;" Screen out if value is null (i.e. LOOK FOR MISSING VALUES), +"RTN","TMGNDF1F",102,0) + ;" or SKIP=true, +"RTN","TMGNDF1F",103,0) + ;"Input: None. But following global-scope variables will be available for use +"RTN","TMGNDF1F",104,0) + ;" File -- the File name or number +"RTN","TMGNDF1F",105,0) + ;" FieldNum -- the field number +"RTN","TMGNDF1F",106,0) + ;" IEN -- the IEN of the current record. +"RTN","TMGNDF1F",107,0) + ;" RecValue -- the current value of the field +"RTN","TMGNDF1F",108,0) + ;"Results: 1 if should be skipped, 0 if should be keps +"RTN","TMGNDF1F",109,0) + +"RTN","TMGNDF1F",110,0) + new result set result=1;" default to SKIP +"RTN","TMGNDF1F",111,0) + if RecValue'="" goto STDone ;"if not null, then skip +"RTN","TMGNDF1F",112,0) + ;"Now see if 22706.9 is marked for SKIP +"RTN","TMGNDF1F",113,0) + if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 goto STDone ;"1;4=SKIP field, 1=SKIP +"RTN","TMGNDF1F",114,0) + set result=0 ;"keep +"RTN","TMGNDF1F",115,0) +STDone +"RTN","TMGNDF1F",116,0) + quit result +"RTN","TMGNDF1F",117,0) + +"RTN","TMGNDF1F",118,0) + +"RTN","TMGNDF1F",119,0) +Scrn2Test() +"RTN","TMGNDF1F",120,0) + ;"Purpose: this is a callback function for GetFldVScreen^TMGSELED +"RTN","TMGNDF1F",121,0) + ;" Screen out if record in 22706.9=SKIP, +"RTN","TMGNDF1F",122,0) + ;"Input: None. But following global-scope variables will be available for use +"RTN","TMGNDF1F",123,0) + ;" File -- the File name or number +"RTN","TMGNDF1F",124,0) + ;" FieldNum -- the field number +"RTN","TMGNDF1F",125,0) + ;" IEN -- the IEN of the current record. +"RTN","TMGNDF1F",126,0) + ;" RecValue -- the current value of the field +"RTN","TMGNDF1F",127,0) + ;"Results: 1 if should be skipped, 0 if should be keps +"RTN","TMGNDF1F",128,0) + +"RTN","TMGNDF1F",129,0) + new result set result=1;" default to SKIP +"RTN","TMGNDF1F",130,0) + ;"Now see if matching record in 22706.9 is marked for SKIP +"RTN","TMGNDF1F",131,0) + if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 goto ST2Done ;"1;4=SKIP field, 1=SKIP +"RTN","TMGNDF1F",132,0) + if $data(^TMG(22706.9,IEN))=0 goto ST2Done ;"if null record (for some reason) +"RTN","TMGNDF1F",133,0) + set result=0 ;"keep +"RTN","TMGNDF1F",134,0) +ST2Done +"RTN","TMGNDF1F",135,0) + quit result +"RTN","TMGNDF1F",136,0) + +"RTN","TMGNDF1F",137,0) + +"RTN","TMGNDF1F",138,0) + +"RTN","TMGNDF1F",139,0) +SelEdRArray(SelArray,JustSelected) +"RTN","TMGNDF1F",140,0) + ;"Purpose: Fix missing or screen for Dose ROUTES from DRUG file +"RTN","TMGNDF1F",141,0) + ;"Input: SelList -- PASS BY REFERENCE. An OUT PARAMETER. Format +"RTN","TMGNDF1F",142,0) + ;" List(IEN)="" +"RTN","TMGNDF1F",143,0) + ;" List(IEN)="" <-- IEN in 50 that was selected. +"RTN","TMGNDF1F",144,0) + ;" Mode -- 0 for missing routes, or "ALL" for screening all +"RTN","TMGNDF1F",145,0) + ;"Results: none +"RTN","TMGNDF1F",146,0) + +"RTN","TMGNDF1F",147,0) + new Options,IEN +"RTN","TMGNDF1F",148,0) + set Options("FIELDS",1)=".05^TRADENAME^40" +"RTN","TMGNDF1F",149,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1F",150,0) + set Options("FIELDS",2)="3.4^FDA DOSAGE FORM^15" +"RTN","TMGNDF1F",151,0) + ;"set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1F",152,0) + set Options("FIELDS",3)="3^FDA ROUTE^15" +"RTN","TMGNDF1F",153,0) + ;"set Options("FIELDS",4)="3.1^VA ROUTE^15" +"RTN","TMGNDF1F",154,0) + set Options("FIELDS","MAX NUM")=3 +"RTN","TMGNDF1F",155,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF1F",156,0) + ;"Get all records with SKIP THIS RECORD = 0 (KEEP) +"RTN","TMGNDF1F",157,0) + +"RTN","TMGNDF1F",158,0) + if +$get(JustSelected)=0 do +"RTN","TMGNDF1F",159,0) + . do GetFldVScreen^TMGSELED(22706.9,3,"$$Scrn2Test^TMGNDF1E",$name(Options("IEN LIST"))) +"RTN","TMGNDF1F",160,0) + else do +"RTN","TMGNDF1F",161,0) + . merge Options("IEN LIST")=SelArray +"RTN","TMGNDF1F",162,0) + . kill SelArray +"RTN","TMGNDF1F",163,0) + +"RTN","TMGNDF1F",164,0) +SE1 if $data(SelArray) do +"RTN","TMGNDF1F",165,0) + . set IEN="" +"RTN","TMGNDF1F",166,0) + . for set IEN=$order(SelArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF1F",167,0) + . . if $data(Options("IEN LIST",IEN))>0 do +"RTN","TMGNDF1F",168,0) + . . . set Options("IEN LIST",IEN,"SEL")="" +"RTN","TMGNDF1F",169,0) + +"RTN","TMGNDF1F",170,0) + if $$SELED^TMGSELED(.Options)'=2 goto SERDone +"RTN","TMGNDF1F",171,0) + if $$GetIENs^TMGSELED(.Options)=0 goto SERDone +"RTN","TMGNDF1F",172,0) + goto SE1 +"RTN","TMGNDF1F",173,0) + +"RTN","TMGNDF1F",174,0) +SERDone quit +"RTN","TMGNDF1F",175,0) + +"RTN","TMGNDF1F",176,0) + +"RTN","TMGNDF1F",177,0) + +"RTN","TMGNDF1F",178,0) + ;"======================================================================= +"RTN","TMGNDF1F",179,0) + +"RTN","TMGNDF1F",180,0) + +"RTN","TMGNDF1F",181,0) +FindUnmatched +"RTN","TMGNDF1F",182,0) + ;"Purpose: Find new, unhandled, FDA dosage forms, and create a new record in +"RTN","TMGNDF1F",183,0) + ;" TMG NDF FORMS VISTA EQUIVALENTS +"RTN","TMGNDF1F",184,0) + +"RTN","TMGNDF1F",185,0) + new Array +"RTN","TMGNDF1F",186,0) + write !,"Checking compiled FDA import records for new FDA drug ROUTES...",! +"RTN","TMGNDF1F",187,0) + do GetFDARoute(.Array) +"RTN","TMGNDF1F",188,0) + do TrimFoundRoutes(.Array) +"RTN","TMGNDF1F",189,0) + if $data(Array) do +"RTN","TMGNDF1F",190,0) + . write $$ListCt^TMGMISC("Array")," new drug ROUTES found. Adding now...",! +"RTN","TMGNDF1F",191,0) + . do StubInNewRec(.Array) +"RTN","TMGNDF1F",192,0) + . do HandleLinks +"RTN","TMGNDF1F",193,0) + . write "Done.",! +"RTN","TMGNDF1F",194,0) + else do +"RTN","TMGNDF1F",195,0) + . write !,"No new FDA drug ROUTES found",! +"RTN","TMGNDF1F",196,0) + +"RTN","TMGNDF1F",197,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1F",198,0) + +"RTN","TMGNDF1F",199,0) + quit +"RTN","TMGNDF1F",200,0) + +"RTN","TMGNDF1F",201,0) + +"RTN","TMGNDF1F",202,0) +GetFDARoute(Array) +"RTN","TMGNDF1F",203,0) + ;"Purpose: to scan file 22706.9 (TMG FDA IMPORT COMPILED) and compile a list of all ROUTES +"RTN","TMGNDF1F",204,0) + ;"Input: Array -- PASS BY REFERENCE. An OUT PARAMETER. Prior entries will be killed +"RTN","TMGNDF1F",205,0) + ;"Results: Data passed back as follows: +"RTN","TMGNDF1F",206,0) + ;" Array(Route)="" +"RTN","TMGNDF1F",207,0) + ;" Array(Route)="" +"RTN","TMGNDF1F",208,0) + ;"Result: none. +"RTN","TMGNDF1F",209,0) + +"RTN","TMGNDF1F",210,0) + new Itr,IEN +"RTN","TMGNDF1F",211,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1F",212,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1F",213,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF1F",214,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF1F",215,0) + . new Route +"RTN","TMGNDF1F",216,0) + . set Route=$piece($get(^TMG(22706.9,IEN,0)),"^",5) +"RTN","TMGNDF1F",217,0) + . if Route="" quit +"RTN","TMGNDF1F",218,0) + . set Array(Route)=IEN +"RTN","TMGNDF1F",219,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF1F",220,0) + +"RTN","TMGNDF1F",221,0) + +"RTN","TMGNDF1F",222,0) + quit +"RTN","TMGNDF1F",223,0) + +"RTN","TMGNDF1F",224,0) + +"RTN","TMGNDF1F",225,0) +TrimFoundRoutes(Array) +"RTN","TMGNDF1F",226,0) + ;"Purpose: To remove entries from Array, for which mapping to a VistA equivilent +"RTN","TMGNDF1F",227,0) + ;" has already ben created +"RTN","TMGNDF1F",228,0) + ;"Input: Array -- PASS BY REFERENCE. Array as created by GetFDARoute +"RTN","TMGNDF1F",229,0) + new Form set Form="" +"RTN","TMGNDF1F",230,0) + for set Form=$order(Array(Form)) quit:(Form="") do +"RTN","TMGNDF1F",231,0) + . new shortForm set shortForm=$extract(Form,1,30) +"RTN","TMGNDF1F",232,0) + . if $order(^TMG(22706.82,"B",shortForm,""))'="" kill Array(Form) +"RTN","TMGNDF1F",233,0) + quit +"RTN","TMGNDF1F",234,0) + +"RTN","TMGNDF1F",235,0) + +"RTN","TMGNDF1F",236,0) +StubInNewRec(Array) +"RTN","TMGNDF1F",237,0) + ;"Purpose: To create new entries in 22706.8 for FDA forms not yet added. +"RTN","TMGNDF1F",238,0) + ;"Input: Array -- PASS BY REFERENCE. An array of Forms to be added, as created +"RTN","TMGNDF1F",239,0) + ;" by GetFDARoute. +"RTN","TMGNDF1F",240,0) + ;"NOTE: ALL entries in Array will be added as new records. Thus, screening for +"RTN","TMGNDF1F",241,0) + ;" prior entries must be performed, such as through TrimFoundRoutes() +"RTN","TMGNDF1F",242,0) + +"RTN","TMGNDF1F",243,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF1F",244,0) + new Form set Form="" +"RTN","TMGNDF1F",245,0) + for set Form=$order(Array(Form)) quit:(Form="") do +"RTN","TMGNDF1F",246,0) + . set TMGFDA(22706.82,"+1,",.01)=Form +"RTN","TMGNDF1F",247,0) + . kill TMGMSG,TMGIEN +"RTN","TMGNDF1F",248,0) + . do UPDATE^DIE("K","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF1F",249,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1F",250,0) + quit +"RTN","TMGNDF1F",251,0) + +"RTN","TMGNDF1F",252,0) + +"RTN","TMGNDF1F",253,0) + +"RTN","TMGNDF1F",254,0) +DisplayRoutes(Answers) +"RTN","TMGNDF1F",255,0) + ;"Purpose: to display the list of Dosage forms that don't have a corresponding VA DOSE FORM +"RTN","TMGNDF1F",256,0) + ;"Input: Answers -- PASS BY REFERENCE, and OUT PARAMETER. Old values killed. +"RTN","TMGNDF1F",257,0) + ;"Output: Answers filled in as follows: +"RTN","TMGNDF1F",258,0) + ;" Answers(n)=RxRoute^IEN in 22706.82 +"RTN","TMGNDF1F",259,0) + ;" Answers(n)=RxRoute^IEN in 22706.82 +"RTN","TMGNDF1F",260,0) + ;"Results: None +"RTN","TMGNDF1F",261,0) + +"RTN","TMGNDF1F",262,0) + kill Answers +"RTN","TMGNDF1F",263,0) + new count set count=0 +"RTN","TMGNDF1F",264,0) + new Itr,IEN +"RTN","TMGNDF1F",265,0) + set IEN=$$ItrInit^TMGITR(22706.82,.Itr) +"RTN","TMGNDF1F",266,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF1F",267,0) + . new VARouteIEN set VARouteIEN=+$piece($get(^TMG(22706.82,IEN,0)),"^",2) +"RTN","TMGNDF1F",268,0) + . if VARouteIEN'=0 quit +"RTN","TMGNDF1F",269,0) + . new FDARoute set FDARoute=$piece($get(^TMG(22706.82,IEN,0)),"^",1) +"RTN","TMGNDF1F",270,0) + . set count=count+1 +"RTN","TMGNDF1F",271,0) + . write count,". ",FDARoute," --> ??",! +"RTN","TMGNDF1F",272,0) + . set Answers(count)=FDARoute_"^"_IEN +"RTN","TMGNDF1F",273,0) + if count=0 do +"RTN","TMGNDF1F",274,0) + . write " -- List is Empty --",! +"RTN","TMGNDF1F",275,0) + +"RTN","TMGNDF1F",276,0) + quit +"RTN","TMGNDF1F",277,0) + +"RTN","TMGNDF1F",278,0) + +"RTN","TMGNDF1F",279,0) +HandleLinks +"RTN","TMGNDF1F",280,0) + ;"Purpose: To interact with user and find a link between FDA dosage forms, and VA dosage forms +"RTN","TMGNDF1F",281,0) + ;"Input: none +"RTN","TMGNDF1F",282,0) + ;"Output: results are stored in 22706.8 +"RTN","TMGNDF1F",283,0) + ;"Results: none +"RTN","TMGNDF1F",284,0) + +"RTN","TMGNDF1F",285,0) + new Answers +"RTN","TMGNDF1F",286,0) + new done set done=0 +"RTN","TMGNDF1F",287,0) + new input set input="R" +"RTN","TMGNDF1F",288,0) + new LastNum +"RTN","TMGNDF1F",289,0) + new VAPIndex +"RTN","TMGNDF1F",290,0) + +"RTN","TMGNDF1F",291,0) + for do quit:(done=1) +"RTN","TMGNDF1F",292,0) + . if input="R" do +"RTN","TMGNDF1F",293,0) + . . write !! +"RTN","TMGNDF1F",294,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF1F",295,0) + . . write "Specify which Dosage ROUTE to Look up",! +"RTN","TMGNDF1F",296,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF1F",297,0) + . . do DisplayRoutes(.Answers) +"RTN","TMGNDF1F",298,0) + . . set LastNum=$order(Answers(""),-1) +"RTN","TMGNDF1F",299,0) + . . if LastNum="" set LastNum="^" +"RTN","TMGNDF1F",300,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF1F",301,0) + . . write "Specify which Dosage ROUTE to Look up",! +"RTN","TMGNDF1F",302,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF1F",303,0) + . write " R to refresh, E show Examples",! +"RTN","TMGNDF1F",304,0) + . write " ^ to continue",! +"RTN","TMGNDF1F",305,0) + . write "Enter number to Lookup (or codes listed above): ",LastNum,"//" +"RTN","TMGNDF1F",306,0) + . read input +"RTN","TMGNDF1F",307,0) + . if input="" set input=LastNum write LastNum +"RTN","TMGNDF1F",308,0) + . write ! +"RTN","TMGNDF1F",309,0) + . ;"if input="" set input="^" +"RTN","TMGNDF1F",310,0) + . if input="" set input=LastNum write LastNum +"RTN","TMGNDF1F",311,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF1F",312,0) + . if input="^" set done=1 +"RTN","TMGNDF1F",313,0) + . if +input=input do +"RTN","TMGNDF1F",314,0) + . . do DoLink(input,.Answers) +"RTN","TMGNDF1F",315,0) + . . set input="R" +"RTN","TMGNDF1F",316,0) + . if input="E" do +"RTN","TMGNDF1F",317,0) + . . write "...Enter number to show examples for: "_LastNum_"//" +"RTN","TMGNDF1F",318,0) + . . read input,! +"RTN","TMGNDF1F",319,0) + . . if input="" set input=LastNum +"RTN","TMGNDF1F",320,0) + . . do ShowExamples(+input,.Answers,.VAPIndex) +"RTN","TMGNDF1F",321,0) + . . set input="R" +"RTN","TMGNDF1F",322,0) + +"RTN","TMGNDF1F",323,0) + quit +"RTN","TMGNDF1F",324,0) + +"RTN","TMGNDF1F",325,0) + +"RTN","TMGNDF1F",326,0) +DoLink(InputNum,Answers) +"RTN","TMGNDF1F",327,0) + ;"Purpose: To try to establish a link between 1 FDA ROUTE and a VA ROUTE +"RTN","TMGNDF1F",328,0) + ;"Input: InputNum -- the number that the user chose to fix. +"RTN","TMGNDF1F",329,0) + ;" Answers -- PASS BY REFERENCE. Array as put out by DisplayRoutes +"RTN","TMGNDF1F",330,0) + ;"Output: if link is established then it will be store in 22706.8 +"RTN","TMGNDF1F",331,0) + ;"Results: none +"RTN","TMGNDF1F",332,0) + +"RTN","TMGNDF1F",333,0) + new RxRoute,IEN +"RTN","TMGNDF1F",334,0) + set RxRoute=$piece($get(Answers(InputNum)),"^",1) +"RTN","TMGNDF1F",335,0) + set IEN=$piece($get(Answers(InputNum)),"^",2) +"RTN","TMGNDF1F",336,0) + if RxRoute="" goto DLDone +"RTN","TMGNDF1F",337,0) + new done set done=0 +"RTN","TMGNDF1F",338,0) + +"RTN","TMGNDF1F",339,0) + new VistaIEN set VistaIEN=0 +"RTN","TMGNDF1F",340,0) + new DIC,X,Y +"RTN","TMGNDF1F",341,0) + set DIC=51.2 +"RTN","TMGNDF1F",342,0) + set X=RxRoute +"RTN","TMGNDF1F",343,0) + set DIC(0)="M" +"RTN","TMGNDF1F",344,0) + do ^DIC +"RTN","TMGNDF1F",345,0) + if +Y>0 do +"RTN","TMGNDF1F",346,0) + . write !,"Match automatically found...",! +"RTN","TMGNDF1F",347,0) + . write "Use '",$piece(Y,"^",2),"' for '",RxRoute,"'" +"RTN","TMGNDF1F",348,0) + . new % set %=1 do YN^DICN +"RTN","TMGNDF1F",349,0) + . if %'=1 quit +"RTN","TMGNDF1F",350,0) + . set VistaIEN=+Y +"RTN","TMGNDF1F",351,0) + if VistaIEN'=0 goto DL2 +"RTN","TMGNDF1F",352,0) + +"RTN","TMGNDF1F",353,0) + set DIC(0)="AEQML" +"RTN","TMGNDF1F",354,0) + set DIC("A")="Enter VA DOSE FORM name: // " +"RTN","TMGNDF1F",355,0) + write !,"Enter name to match '"_RxRoute_"'" +"RTN","TMGNDF1F",356,0) + do ^DIC write ! +"RTN","TMGNDF1F",357,0) + if +Y>0 do +"RTN","TMGNDF1F",358,0) + . write "Use '",$piece(Y,"^",2),"' for '",RxRoute,"'" +"RTN","TMGNDF1F",359,0) + . new % set %=1 do YN^DICN +"RTN","TMGNDF1F",360,0) + . if %'=1 quit +"RTN","TMGNDF1F",361,0) + . set VistaIEN=+Y +"RTN","TMGNDF1F",362,0) + +"RTN","TMGNDF1F",363,0) +DL2 if VistaIEN'=0 do +"RTN","TMGNDF1F",364,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1F",365,0) + . set TMGFDA(22706.82,IEN_",",1)=VistaIEN +"RTN","TMGNDF1F",366,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1F",367,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1F",368,0) + +"RTN","TMGNDF1F",369,0) +DLDone +"RTN","TMGNDF1F",370,0) + quit +"RTN","TMGNDF1F",371,0) + +"RTN","TMGNDF1F",372,0) + +"RTN","TMGNDF1F",373,0) +ShowExamples(InputNum,Answers,Index) +"RTN","TMGNDF1F",374,0) + ;"Purpose: To show all entries using dosage form specified +"RTN","TMGNDF1F",375,0) + ;"Input: InputNum -- the input number from user to show +"RTN","TMGNDF1F",376,0) + ;" Answers -- PASS BY REFERENCE, array as put out by DisplayForms +"RTN","TMGNDF1F",377,0) + ;" Index -- OPTIONAL. An index of VAProduct +"RTN","TMGNDF1F",378,0) + +"RTN","TMGNDF1F",379,0) + new RxRoute +"RTN","TMGNDF1F",380,0) + set RxRoute=$piece($get(Answers(InputNum)),"^",1) +"RTN","TMGNDF1F",381,0) + if RxRoute="" goto SEDone +"RTN","TMGNDF1F",382,0) + +"RTN","TMGNDF1F",383,0) + new count set count=0 +"RTN","TMGNDF1F",384,0) + new IEN set IEN=0 +"RTN","TMGNDF1F",385,0) + new abort set abort=0 +"RTN","TMGNDF1F",386,0) + for set IEN=$order(^TMG(22706.9,"ROUTE",RxRoute,IEN)) quit:(+IEN'>0)!abort do +"RTN","TMGNDF1F",387,0) + . write "#",IEN,": " +"RTN","TMGNDF1F",388,0) + . do DumpRec2^TMGDEBUG(22706.9,IEN_",") +"RTN","TMGNDF1F",389,0) + . set count=count+1 +"RTN","TMGNDF1F",390,0) + . write " -- Press ENTER to Continue (ESC to quit) --" +"RTN","TMGNDF1F",391,0) + . new ch set ch=$$KeyPressed^TMGUSRIF(0,60) +"RTN","TMGNDF1F",392,0) + . write ! +"RTN","TMGNDF1F",393,0) + . if ch=27 set abort=1 quit +"RTN","TMGNDF1F",394,0) + +"RTN","TMGNDF1F",395,0) + if count=0 do +"RTN","TMGNDF1F",396,0) + . write !,"Couldn't find any examples (error occurred).",! +"RTN","TMGNDF1F",397,0) + +"RTN","TMGNDF1F",398,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1F",399,0) +SEDone +"RTN","TMGNDF1F",400,0) + quit +"RTN","TMGNDF1F",401,0) + +"RTN","TMGNDF1F",402,0) + +"RTN","TMGNDF1F",403,0) + ;"======================================== +"RTN","TMGNDF1F",404,0) +EditVARoutes +"RTN","TMGNDF1F",405,0) + ;"Purpose: To edit Vista Routes file file 51.2 +"RTN","TMGNDF1F",406,0) + +"RTN","TMGNDF1F",407,0) + new Options,IEN +"RTN","TMGNDF1F",408,0) + set Options("FIELDS",1)=".01^NAME^30" +"RTN","TMGNDF1F",409,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1F",410,0) + set Options("FIELDS",2)="1^ABBREVIATION^15" +"RTN","TMGNDF1F",411,0) + set Options("FIELDS",3)="3^PACKAGE USE^10" +"RTN","TMGNDF1F",412,0) + set Options("FIELDS",4)="5^INACTIVATION DATE^10" +"RTN","TMGNDF1F",413,0) + set Options("FIELDS",5)="6^IV FLAG^5" +"RTN","TMGNDF1F",414,0) + set Options("FIELDS","MAX NUM")=5 +"RTN","TMGNDF1F",415,0) + set Options("FILE")="51.2^MEDICATION ROUTE" +"RTN","TMGNDF1F",416,0) + +"RTN","TMGNDF1F",417,0) + do GetFldValue^TMGSELED(51.2,.01,"ALL",$name(Options("IEN LIST"))) +"RTN","TMGNDF1F",418,0) + +"RTN","TMGNDF1F",419,0) +EF1 +"RTN","TMGNDF1F",420,0) + if $$SELED^TMGSELED(.Options)'=2 goto EFDone +"RTN","TMGNDF1F",421,0) + if $$GetIENs^TMGSELED(.Options)=0 goto EFDone +"RTN","TMGNDF1F",422,0) + goto EF1 +"RTN","TMGNDF1F",423,0) + +"RTN","TMGNDF1F",424,0) +EFDone quit +"RTN","TMGNDF1F",425,0) + +"RTN","TMGNDF1F",426,0) + ;"======================================== +"RTN","TMGNDF1F",427,0) + +"RTN","TMGNDF1F",428,0) +FillVARoute +"RTN","TMGNDF1F",429,0) + ;"Purpose: To ensure that there is a entry in the VA ROUTE field +"RTN","TMGNDF1F",430,0) + ;" in all records in TMG FDA IMPORT COMPILED +"RTN","TMGNDF1F",431,0) + ;" (that are not marked to be skipped) +"RTN","TMGNDF1F",432,0) + +"RTN","TMGNDF1F",433,0) + new Itr,IEN,abort,count,missingRoute +"RTN","TMGNDF1F",434,0) + set abort=0,count=0,missingRoute=0 +"RTN","TMGNDF1F",435,0) + +"RTN","TMGNDF1F",436,0) + write "Scanning through all imports and applying matches from ROUTE --> VA ROUTE...",! +"RTN","TMGNDF1F",437,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF1F",438,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF1F",439,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF1F",440,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF1F",441,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF1F",442,0) + . new FDARoute set FDARoute=$piece($get(^TMG(22706.9,IEN,0)),"^",5) +"RTN","TMGNDF1F",443,0) + . new VARouteIEN set VARouteIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",7) +"RTN","TMGNDF1F",444,0) + . if FDARoute="" do quit +"RTN","TMGNDF1F",445,0) + . . if VARouteIEN'=0 quit +"RTN","TMGNDF1F",446,0) + . . ;"write !,"No FDA drug ROUTE found for drug in record #",IEN,! +"RTN","TMGNDF1F",447,0) + . . set missingRoute=missingRoute+1 +"RTN","TMGNDF1F",448,0) + . new mapIEN set mapIEN=+$order(^TMG(22706.82,"B",$extract(FDARoute,1,30),"")) +"RTN","TMGNDF1F",449,0) + . new VistaIEN set VistaIEN=+$piece($get(^TMG(22706.82,mapIEN,0)),"^",2) +"RTN","TMGNDF1F",450,0) + . if (VARouteIEN=VistaIEN)&(VistaIEN'=0) quit ;"already set properly +"RTN","TMGNDF1F",451,0) + . if VistaIEN=0 do quit +"RTN","TMGNDF1F",452,0) + . . write !,"Mapping to VA ROUTE incomplete: ",FDARoute," --> ??. Edit Match File.",! +"RTN","TMGNDF1F",453,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF1F",454,0) + . set TMGFDA(22706.9,IEN_",",3.1)=VistaIEN +"RTN","TMGNDF1F",455,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF1F",456,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF1F",457,0) + . ;"write !,IEN," field 3.1 set to `",VistaIEN,! +"RTN","TMGNDF1F",458,0) + . set count=count+1 +"RTN","TMGNDF1F",459,0) + +"RTN","TMGNDF1F",460,0) + write !,count," records changed",! +"RTN","TMGNDF1F",461,0) + if missingRoute>0 write missingRoute," imports are missing a specified ROUTE",! +"RTN","TMGNDF1F",462,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF1F",463,0) + +"RTN","TMGNDF1F",464,0) +FRFDone +"RTN","TMGNDF1F",465,0) + quit +"RTN","TMGNDF1F",466,0) + +"RTN","TMGNDF1F",467,0) + ;"======================================== +"RTN","TMGNDF1F",468,0) + +"RTN","TMGNDF1F",469,0) +EditMatchFile +"RTN","TMGNDF1F",470,0) + ;"Purpose: use Selector to browse and edit TMG FDA ROUTE VISTA EQUIVALENTS (22706.82) +"RTN","TMGNDF1F",471,0) + +"RTN","TMGNDF1F",472,0) + new Options,IEN +"RTN","TMGNDF1F",473,0) + set Options("FIELDS",1)=".01^FDA ROUTE^25" +"RTN","TMGNDF1F",474,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF1F",475,0) + set Options("FIELDS",2)="1^VISTA ROUTE^25" +"RTN","TMGNDF1F",476,0) + set Options("FIELDS","MAX NUM")=2 +"RTN","TMGNDF1F",477,0) + set Options("FILE")="22706.82^TMG FDA ROUTES VISTA EQUIVALENTS" +"RTN","TMGNDF1F",478,0) + +"RTN","TMGNDF1F",479,0) + do GetFldValue^TMGSELED(22706.82,.01,"ALL",$name(Options("IEN LIST"))) +"RTN","TMGNDF1F",480,0) + +"RTN","TMGNDF1F",481,0) +SFM1 +"RTN","TMGNDF1F",482,0) + if $$SELED^TMGSELED(.Options)'=2 goto SFMDone +"RTN","TMGNDF1F",483,0) + if $$GetIENs^TMGSELED(.Options)=0 goto SFMDone +"RTN","TMGNDF1F",484,0) + goto SFM1 +"RTN","TMGNDF1F",485,0) + +"RTN","TMGNDF1F",486,0) +SFMDone quit +"RTN","TMGNDF1F",487,0) + +"RTN","TMGNDF1F",488,0) + +"RTN","TMGNDF1F",489,0) + +"RTN","TMGNDF1F",490,0) + +"RTN","TMGNDF2A") +0^42^B7116 +"RTN","TMGNDF2A",1,0) +TMGNDF2A ;TMG/kst/FDA Import: Work with Drug Forms ;03/25/06 +"RTN","TMGNDF2A",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF2A",3,0) + +"RTN","TMGNDF2A",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2A",5,0) + ;" -- Working with Dosage Forms +"RTN","TMGNDF2A",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2A",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2A",8,0) + ;"11-21-2006 +"RTN","TMGNDF2A",9,0) + +"RTN","TMGNDF2A",10,0) + ;"======================================================================= +"RTN","TMGNDF2A",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF2A",12,0) + ;"======================================================================= +"RTN","TMGNDF2A",13,0) + ;"Menu +"RTN","TMGNDF2A",14,0) + +"RTN","TMGNDF2A",15,0) + ;"======================================================================= +"RTN","TMGNDF2A",16,0) + ;" Private Functions. +"RTN","TMGNDF2A",17,0) + ;"======================================================================= +"RTN","TMGNDF2A",18,0) + ;"FillRxFormRoute -- ensure that there is a dosage form in all records in TMG FDA IMPORT COMPILED +"RTN","TMGNDF2A",19,0) + ;" (that are not marked to be skipped) +"RTN","TMGNDF2A",20,0) + ;"GetRxForms(Array) -- scan file 22706.2 (TMG FDA DOSAGE FORMS) and compile a list of all dosage forms +"RTN","TMGNDF2A",21,0) + ;"DisplayForms(Answers) -- display the list of Dosage forms that don't have a corresponding VA DOSE FORM +"RTN","TMGNDF2A",22,0) + ;"HandleLinks -- interact with user and find a link between FDA dosage forms, and VA dosage forms +"RTN","TMGNDF2A",23,0) + ;"ShowHelp +"RTN","TMGNDF2A",24,0) + ;"DoLink(InputNum,Answers) -- try to establish a link between 1 FDA Dosage form and a VA DOSAGE form +"RTN","TMGNDF2A",25,0) + ;"Unlock50dot606 +"RTN","TMGNDF2A",26,0) + ;"Lock50dot606 +"RTN","TMGNDF2A",27,0) + ;"DoRemove(InputNum,Answers) -- remove an unwanted item from list. +"RTN","TMGNDF2A",28,0) + ;"ShowExamples(InputNum,Answers) -- show all entries using dosage form specified +"RTN","TMGNDF2A",29,0) + ;"FormatDrug(Array) +"RTN","TMGNDF2A",30,0) + ;"SelEditForms -- use the Selector to browse and edit the DOSAGE FORM +"RTN","TMGNDF2A",31,0) + +"RTN","TMGNDF2A",32,0) + +"RTN","TMGNDF2A",33,0) + ;"======================================================================= +"RTN","TMGNDF2A",34,0) + ;"======================================================================= +"RTN","TMGNDF2A",35,0) + +"RTN","TMGNDF2A",36,0) +Menu +"RTN","TMGNDF2A",37,0) + ;"Purpose: To give an interactive menu of tools to clean up data. +"RTN","TMGNDF2A",38,0) + +"RTN","TMGNDF2A",39,0) + new Menu,UsrSlct +"RTN","TMGNDF2A",40,0) + set Menu(0)="Pick Option for Managing Import Dosage FORMS (2A)" +"RTN","TMGNDF2A",41,0) + new i set i=1 +"RTN","TMGNDF2A",42,0) + set Menu(i)="Find new FDA dosage FORMS"_$char(9)_"FINDNEW" set i=i+1 +"RTN","TMGNDF2A",43,0) + set Menu(i)="Match import FORMS --> VA FORMS"_$char(9)_"MATCH" set i=i+1 +"RTN","TMGNDF2A",44,0) + set Menu(i)="Fix Tradenames with MISSING FORMS"_$char(9)_"FixTrade" set i=i+1 +"RTN","TMGNDF2A",45,0) + set Menu(i)="Screen ALL imports for INCORRECT FORM (IF NEEDED)"_$char(9)_"MANUAL" set i=i+1 +"RTN","TMGNDF2A",46,0) + set Menu(i)="Preselect missing and manually edit FORMS"_$char(9)_"MANUAL3" set i=i+1 +"RTN","TMGNDF2A",47,0) + set Menu(i)="Manually edit match file (IF NEEDED)"_$char(9)_"MANUAL2" set i=i+1 +"RTN","TMGNDF2A",48,0) + set Menu(i)="Edit VA forms (file 50.606) (ONLY IF NEEDED)"_$char(9)_"EDITVA" set i=i+1 +"RTN","TMGNDF2A",49,0) + set Menu(i)="USE links for import FORM --> VA FORM (DO THIS LAST)"_$char(9)_"FILL" set i=i+1 +"RTN","TMGNDF2A",50,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF2A",51,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF2A",52,0) + +"RTN","TMGNDF2A",53,0) + set Menu("?")="HELP"_$char(9)_"?" +"RTN","TMGNDF2A",54,0) + +"RTN","TMGNDF2A",55,0) +CD1 +"RTN","TMGNDF2A",56,0) + write # +"RTN","TMGNDF2A",57,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2A",58,0) + if UsrSlct="^" goto CDDone +"RTN","TMGNDF2A",59,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF2A",60,0) + +"RTN","TMGNDF2A",61,0) + if UsrSlct="Prev" goto Menu^TMGNDF1F ;"quit can occur from there... +"RTN","TMGNDF2A",62,0) + if UsrSlct="Next" goto Menu^TMGNDF2C ;"quit can occur from there... +"RTN","TMGNDF2A",63,0) + if UsrSlct="FILL" do FillRxFormRoute goto CD1 +"RTN","TMGNDF2A",64,0) + if UsrSlct="FixTrade" do FixNoForm goto CD1 +"RTN","TMGNDF2A",65,0) + if UsrSlct="FINDNEW" do FindUnmatched goto CD1 +"RTN","TMGNDF2A",66,0) + if UsrSlct="MATCH" do HandleLinks goto CD1 +"RTN","TMGNDF2A",67,0) + if UsrSlct="MANUAL" do SelEditForms() goto CD1 +"RTN","TMGNDF2A",68,0) + if UsrSlct="MANUAL2" do SelFormMap goto CD1 +"RTN","TMGNDF2A",69,0) + if UsrSlct="MANUAL3" do SelMissing goto CD1 +"RTN","TMGNDF2A",70,0) + if UsrSlct="EDITVA" do EditForms goto CD1 +"RTN","TMGNDF2A",71,0) + if UsrSlct="?" do ShowHelp goto CD1 +"RTN","TMGNDF2A",72,0) + goto CD1 +"RTN","TMGNDF2A",73,0) +CDDone +"RTN","TMGNDF2A",74,0) + quit +"RTN","TMGNDF2A",75,0) + +"RTN","TMGNDF2A",76,0) + +"RTN","TMGNDF2A",77,0) + +"RTN","TMGNDF2A",78,0) +FillRxFormRoute +"RTN","TMGNDF2A",79,0) + ;"Purpose: To ensure that there is a dosage form and route +"RTN","TMGNDF2A",80,0) + ;" in all records in TMG FDA IMPORT COMPILED +"RTN","TMGNDF2A",81,0) + ;" (that are not marked to be skipped) +"RTN","TMGNDF2A",82,0) + +"RTN","TMGNDF2A",83,0) + new % set %=2 +"RTN","TMGNDF2A",84,0) + ;"write !,"Fill all TMG FDA IMPORT COMPILED records using current" +"RTN","TMGNDF2A",85,0) + ;"write "mapping FDA dosage forms <--> VA dosage forms" +"RTN","TMGNDF2A",86,0) + ;"do YN^DICN write ! +"RTN","TMGNDF2A",87,0) + ;"if %'=1 goto FRFDone +"RTN","TMGNDF2A",88,0) + +"RTN","TMGNDF2A",89,0) + new Itr,IEN,abort,count +"RTN","TMGNDF2A",90,0) + set abort=0,count=0 +"RTN","TMGNDF2A",91,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2A",92,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2A",93,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2A",94,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2A",95,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2A",96,0) + . new currentIEN set currentIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",7) ;"0;7 = VA DOSAGE FORM, file 50.606 +"RTN","TMGNDF2A",97,0) + . new FDAForm set FDAForm=$piece($get(^TMG(22706.9,IEN,6)),"^",1) ;"text field +"RTN","TMGNDF2A",98,0) + . if FDAForm="" do quit +"RTN","TMGNDF2A",99,0) + . . if currentIEN'=0 quit +"RTN","TMGNDF2A",100,0) + . . write !,"No FDA dose form found for drug in record #",IEN,! +"RTN","TMGNDF2A",101,0) + . new mapIEN set mapIEN=+$order(^TMG(22706.8,"B",$extract(FDAForm,1,30),"")) +"RTN","TMGNDF2A",102,0) + . new VistaIEN set VistaIEN=+$piece($get(^TMG(22706.8,mapIEN,0)),"^",2) +"RTN","TMGNDF2A",103,0) + . if (currentIEN=VistaIEN)&(VistaIEN'=0) quit +"RTN","TMGNDF2A",104,0) + . if VistaIEN=0 do quit +"RTN","TMGNDF2A",105,0) + . . write !,"Mapping to VA FORM incomplete: ",FDAForm," --> ??. Edit Match File.",! +"RTN","TMGNDF2A",106,0) + . new VistaRouteIEN set VistaRouteIEN=+$piece($get(^TMG(22706.8,mapIEN,0)),"^",3) +"RTN","TMGNDF2A",107,0) + . if VistaIEN=0 do quit +"RTN","TMGNDF2A",108,0) + . . write !,"Mapping to VA ROUTE incomplete: ",FDAForm," --> ??. Edit Match File.",! +"RTN","TMGNDF2A",109,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF2A",110,0) + . set TMGFDA(22706.9,IEN_",",3.5)=VistaIEN +"RTN","TMGNDF2A",111,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",112,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",113,0) + . ;"write !,IEN," field 3.5 set to `",VistaIEN,! +"RTN","TMGNDF2A",114,0) + . set count=count+1 +"RTN","TMGNDF2A",115,0) + +"RTN","TMGNDF2A",116,0) + write !,count," records changed",! +"RTN","TMGNDF2A",117,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",118,0) + +"RTN","TMGNDF2A",119,0) +FRFDone +"RTN","TMGNDF2A",120,0) + quit +"RTN","TMGNDF2A",121,0) + +"RTN","TMGNDF2A",122,0) + +"RTN","TMGNDF2A",123,0) +FindUnmatched +"RTN","TMGNDF2A",124,0) + ;"Purpose: Find new, unhandled, FDA dosage forms, and create a new record in +"RTN","TMGNDF2A",125,0) + ;" TMG NDF FORMS VISTA EQUIVALENTS +"RTN","TMGNDF2A",126,0) + +"RTN","TMGNDF2A",127,0) + new Array +"RTN","TMGNDF2A",128,0) + write !,"Checking compiled FDA import records for new FDA drug FORMS...",! +"RTN","TMGNDF2A",129,0) + do GetFDARxForms(.Array) +"RTN","TMGNDF2A",130,0) + do TrimFoundForms(.Array) +"RTN","TMGNDF2A",131,0) + if $data(Array) do +"RTN","TMGNDF2A",132,0) + . do StubInNewRec(.Array) +"RTN","TMGNDF2A",133,0) + . do HandleLinks +"RTN","TMGNDF2A",134,0) + else do +"RTN","TMGNDF2A",135,0) + . write !,"No new FDA drug FORMS found",! +"RTN","TMGNDF2A",136,0) + +"RTN","TMGNDF2A",137,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",138,0) + +"RTN","TMGNDF2A",139,0) + quit +"RTN","TMGNDF2A",140,0) + +"RTN","TMGNDF2A",141,0) + +"RTN","TMGNDF2A",142,0) +GetFDARxForms(Array) +"RTN","TMGNDF2A",143,0) + ;"Purpose: to scan file 22706.9 (TMG FDA IMPORT COMPILED) and compile a list of all dosage forms +"RTN","TMGNDF2A",144,0) + ;"Input: Array -- PASS BY REFERENCE. An OUT PARAMETER. Prior entries will be killed +"RTN","TMGNDF2A",145,0) + ;"Results: Data passed back as follows: +"RTN","TMGNDF2A",146,0) + ;" Array(DosageForm)="" +"RTN","TMGNDF2A",147,0) + ;" Array(DosageForm)="" +"RTN","TMGNDF2A",148,0) + ;"Result: none. +"RTN","TMGNDF2A",149,0) + +"RTN","TMGNDF2A",150,0) + new Itr,IEN +"RTN","TMGNDF2A",151,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2A",152,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2A",153,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2A",154,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2A",155,0) + . new DosageForm +"RTN","TMGNDF2A",156,0) + . set DosageForm=$piece($get(^TMG(22706.9,IEN,6)),"^",1) +"RTN","TMGNDF2A",157,0) + . if DosageForm="" quit +"RTN","TMGNDF2A",158,0) + . set Array(DosageForm)=IEN +"RTN","TMGNDF2A",159,0) + +"RTN","TMGNDF2A",160,0) + quit +"RTN","TMGNDF2A",161,0) + +"RTN","TMGNDF2A",162,0) + +"RTN","TMGNDF2A",163,0) +TrimFoundForms(Array) +"RTN","TMGNDF2A",164,0) + ;"Purpose: To remove entries from Array, for which mapping to a VistA equivilent +"RTN","TMGNDF2A",165,0) + ;" has already ben created +"RTN","TMGNDF2A",166,0) + ;"Input: Array -- PASS BY REFERENCE. Array as created by GetFDARxForms +"RTN","TMGNDF2A",167,0) + new Form set Form="" +"RTN","TMGNDF2A",168,0) + for set Form=$order(Array(Form)) quit:(Form="") do +"RTN","TMGNDF2A",169,0) + . new shortForm set shortForm=$extract(Form,1,30) +"RTN","TMGNDF2A",170,0) + . if $order(^TMG(22706.8,"B",shortForm,""))'="" kill Array(Form) +"RTN","TMGNDF2A",171,0) + quit +"RTN","TMGNDF2A",172,0) + +"RTN","TMGNDF2A",173,0) + +"RTN","TMGNDF2A",174,0) +StubInNewRec(Array) +"RTN","TMGNDF2A",175,0) + ;"Purpose: To create new entries in 22706.8 for FDA forms not yet added. +"RTN","TMGNDF2A",176,0) + ;"Input: Array -- PASS BY REFERENCE. An array of Forms to be added, as created +"RTN","TMGNDF2A",177,0) + ;" by GetFDARxForms. +"RTN","TMGNDF2A",178,0) + ;"NOTE: ALL entries in Array will be added as new records. Thus, screening for +"RTN","TMGNDF2A",179,0) + ;" prior entries must be performed, such as through TrimFoundForms() +"RTN","TMGNDF2A",180,0) + +"RTN","TMGNDF2A",181,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF2A",182,0) + new Form set Form="" +"RTN","TMGNDF2A",183,0) + for set Form=$order(Array(Form)) quit:(Form="") do +"RTN","TMGNDF2A",184,0) + . set TMGFDA(22706.8,"+1,",.01)=Form +"RTN","TMGNDF2A",185,0) + . kill TMGMSG,TMGIEN +"RTN","TMGNDF2A",186,0) + . do UPDATE^DIE("K","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2A",187,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",188,0) + quit +"RTN","TMGNDF2A",189,0) + +"RTN","TMGNDF2A",190,0) + +"RTN","TMGNDF2A",191,0) + +"RTN","TMGNDF2A",192,0) +DisplayForms(Answers) +"RTN","TMGNDF2A",193,0) + ;"Purpose: to display the list of Dosage forms that don't have a corresponding VA DOSE FORM +"RTN","TMGNDF2A",194,0) + ;"Input: Answers -- PASS BY REFERENCE, and OUT PARAMETER. Old values killed. +"RTN","TMGNDF2A",195,0) + ;"Output: Answers filled in as follows: +"RTN","TMGNDF2A",196,0) + ;" Answers(n)=DosageForm^IEN in 22706.8 +"RTN","TMGNDF2A",197,0) + ;" Answers(n)=DosageForm^IEN in 22706.8 +"RTN","TMGNDF2A",198,0) + ;"Results: None +"RTN","TMGNDF2A",199,0) + +"RTN","TMGNDF2A",200,0) + kill Answers +"RTN","TMGNDF2A",201,0) + new count set count=0 +"RTN","TMGNDF2A",202,0) + new Itr,IEN +"RTN","TMGNDF2A",203,0) + set IEN=$$ItrInit^TMGITR(22706.8,.Itr) +"RTN","TMGNDF2A",204,0) + ;"do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2A",205,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2A",206,0) + . new VADoseFormIEN set VADoseFormIEN=+$piece($get(^TMG(22706.8,IEN,0)),"^",2) +"RTN","TMGNDF2A",207,0) + . if VADoseFormIEN'=0 quit +"RTN","TMGNDF2A",208,0) + . new DoseForm set DoseForm=$piece($get(^TMG(22706.8,IEN,0)),"^",1) +"RTN","TMGNDF2A",209,0) + . set count=count+1 +"RTN","TMGNDF2A",210,0) + . write count,". ",DoseForm," --> ??",! +"RTN","TMGNDF2A",211,0) + . set Answers(count)=DoseForm_"^"_IEN +"RTN","TMGNDF2A",212,0) + if count=0 do +"RTN","TMGNDF2A",213,0) + . write " -- List is Empty --",! +"RTN","TMGNDF2A",214,0) + +"RTN","TMGNDF2A",215,0) + quit +"RTN","TMGNDF2A",216,0) + +"RTN","TMGNDF2A",217,0) + +"RTN","TMGNDF2A",218,0) +HandleLinks +"RTN","TMGNDF2A",219,0) + ;"Purpose: To interact with user and find a link between FDA dosage forms, and VA dosage forms +"RTN","TMGNDF2A",220,0) + ;"Input: none +"RTN","TMGNDF2A",221,0) + ;"Output: results are stored in 22706.8 +"RTN","TMGNDF2A",222,0) + ;"Results: none +"RTN","TMGNDF2A",223,0) + +"RTN","TMGNDF2A",224,0) + new Answers +"RTN","TMGNDF2A",225,0) + new done set done=0 +"RTN","TMGNDF2A",226,0) + new input set input="R" +"RTN","TMGNDF2A",227,0) + do Unlock50dot606 +"RTN","TMGNDF2A",228,0) + new LastNum +"RTN","TMGNDF2A",229,0) + new VAPIndex +"RTN","TMGNDF2A",230,0) + +"RTN","TMGNDF2A",231,0) + for do quit:(done=1) +"RTN","TMGNDF2A",232,0) + . if input="R" do +"RTN","TMGNDF2A",233,0) + . . write !! +"RTN","TMGNDF2A",234,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",235,0) + . . write "Specify which Dosage form to Look up",! +"RTN","TMGNDF2A",236,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",237,0) + . . do DisplayForms(.Answers) +"RTN","TMGNDF2A",238,0) + . . set LastNum=$order(Answers(""),-1) +"RTN","TMGNDF2A",239,0) + . . if LastNum="" set LastNum="^" +"RTN","TMGNDF2A",240,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",241,0) + . . write "Specify which Dosage form to Look up",! +"RTN","TMGNDF2A",242,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",243,0) + . write " R to refresh, ? for instructions, E show Examples",! +"RTN","TMGNDF2A",244,0) + . write " ^ to continue",! +"RTN","TMGNDF2A",245,0) + . write "Enter number to Lookup (or codes listed above): ",LastNum,"//" +"RTN","TMGNDF2A",246,0) + . read input +"RTN","TMGNDF2A",247,0) + . if input="" set input=LastNum write LastNum +"RTN","TMGNDF2A",248,0) + . write ! +"RTN","TMGNDF2A",249,0) + . ;"if input="" set input="^" +"RTN","TMGNDF2A",250,0) + . if input="" set input=LastNum write LastNum +"RTN","TMGNDF2A",251,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2A",252,0) + . if input="^" set done=1 +"RTN","TMGNDF2A",253,0) + . if (input="?") do +"RTN","TMGNDF2A",254,0) + . . do ShowHelp,ShowHlp2 +"RTN","TMGNDF2A",255,0) + . . set input="R" +"RTN","TMGNDF2A",256,0) + . if +input=input do +"RTN","TMGNDF2A",257,0) + . . do DoLink(input,.Answers) +"RTN","TMGNDF2A",258,0) + . . set input="R" +"RTN","TMGNDF2A",259,0) + . if input="E" do +"RTN","TMGNDF2A",260,0) + . . read "...Enter number to show examples for: ",input,! +"RTN","TMGNDF2A",261,0) + . . do ShowExamples(+input,.Answers,.VAPIndex) +"RTN","TMGNDF2A",262,0) + . . set input="R" +"RTN","TMGNDF2A",263,0) + +"RTN","TMGNDF2A",264,0) + do Lock50dot606 +"RTN","TMGNDF2A",265,0) + quit +"RTN","TMGNDF2A",266,0) + +"RTN","TMGNDF2A",267,0) + +"RTN","TMGNDF2A",268,0) +ShowHelp +"RTN","TMGNDF2A",269,0) + ;"Purpose: to write out instructions +"RTN","TMGNDF2A",270,0) + +"RTN","TMGNDF2A",271,0) + write #,! +"RTN","TMGNDF2A",272,0) + write "Drugs in the FDA database have drug 'forms', such as 'TABLET', 'CAPSULE' etc.",! +"RTN","TMGNDF2A",273,0) + write "In the VistA database, drugs also will have a drug form specified. However",! +"RTN","TMGNDF2A",274,0) + write "the classification systems don't exctly match. Sometimes the difference",! +"RTN","TMGNDF2A",275,0) + write "is just a matter of formatting, e.g. INJ,SUSP <--> INJECTION FOR SUSPENSION.",! +"RTN","TMGNDF2A",276,0) + write "But other times the exact concepts are different. For example, when the FDA",! +"RTN","TMGNDF2A",277,0) + write "data specified: 'CAPSULE, DELAYED RELEASE PELLETS', I could not find an exact",! +"RTN","TMGNDF2A",278,0) + write "match, and chose: 'CAP,SPRINKLE,SA'. A appropriately trained person should",! +"RTN","TMGNDF2A",279,0) + write "make such determinations.",! +"RTN","TMGNDF2A",280,0) + write ! +"RTN","TMGNDF2A",281,0) + write "This program does allow additions of NEW drug forms to the VistA database.",! +"RTN","TMGNDF2A",282,0) + write "However, this may be against VA policy and should be done only if no possible",! +"RTN","TMGNDF2A",283,0) + write "match can be found. Also, if a new drug form is added, this new entry in file",! +"RTN","TMGNDF2A",284,0) + write "DOSAGE FORM (50.606) should be completed via a Fileman edit to fill in all",! +"RTN","TMGNDF2A",285,0) + write "other fields such as VERB, NOUN etc. for the new dosage form.",! +"RTN","TMGNDF2A",286,0) + write ! +"RTN","TMGNDF2A",287,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",288,0) + quit +"RTN","TMGNDF2A",289,0) + +"RTN","TMGNDF2A",290,0) +ShowHlp2 +"RTN","TMGNDF2A",291,0) + write #,! +"RTN","TMGNDF2A",292,0) + write "To link a FDA drug form to a VA drug form, enter its number, then type in a",! +"RTN","TMGNDF2A",293,0) + write "name to search for in the VistA database. It is best to only type in PART of",! +"RTN","TMGNDF2A",294,0) + write "the name. For example, 'CAP' instead of 'CAPSULE'.",! +"RTN","TMGNDF2A",295,0) + write ! +"RTN","TMGNDF2A",296,0) + write "To see examples of drugs that use a particular drug form, enter 'E'.",! +"RTN","TMGNDF2A",297,0) + write ! +"RTN","TMGNDF2A",298,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",299,0) + quit +"RTN","TMGNDF2A",300,0) + +"RTN","TMGNDF2A",301,0) +DoLink(InputNum,Answers) +"RTN","TMGNDF2A",302,0) + ;"Purpose: To try to establish a link between 1 FDA Dosage form and a VA DOSAGE form +"RTN","TMGNDF2A",303,0) + ;"Input: InputNum -- the number that the user chose to fix. +"RTN","TMGNDF2A",304,0) + ;" Answers -- PASS BY REFERENCE. Array as put out by DisplayForms +"RTN","TMGNDF2A",305,0) + ;"Output: if link is established then it will be store in 22706.8 +"RTN","TMGNDF2A",306,0) + ;"Results: none +"RTN","TMGNDF2A",307,0) + +"RTN","TMGNDF2A",308,0) + new DosageForm,IEN +"RTN","TMGNDF2A",309,0) + set DosageForm=$piece($get(Answers(InputNum)),"^",1) +"RTN","TMGNDF2A",310,0) + set IEN=$piece($get(Answers(InputNum)),"^",2) +"RTN","TMGNDF2A",311,0) + if DosageForm="" goto DLDone +"RTN","TMGNDF2A",312,0) + new done set done=0 +"RTN","TMGNDF2A",313,0) + +"RTN","TMGNDF2A",314,0) + new VistaIEN set VistaIEN=0 +"RTN","TMGNDF2A",315,0) + new DIC,X,Y +"RTN","TMGNDF2A",316,0) + set DIC=50.606 +"RTN","TMGNDF2A",317,0) + set X=DosageForm +"RTN","TMGNDF2A",318,0) + set DIC(0)="M" +"RTN","TMGNDF2A",319,0) + do ^DIC +"RTN","TMGNDF2A",320,0) + if +Y>0 do +"RTN","TMGNDF2A",321,0) + . write !,"Match automatically found...",! +"RTN","TMGNDF2A",322,0) + . write "Use '",$piece(Y,"^",2),"' for '",DosageForm,"'" +"RTN","TMGNDF2A",323,0) + . new % set %=1 do YN^DICN +"RTN","TMGNDF2A",324,0) + . if %'=1 quit +"RTN","TMGNDF2A",325,0) + . set VistaIEN=+Y +"RTN","TMGNDF2A",326,0) + if VistaIEN'=0 goto DL2 +"RTN","TMGNDF2A",327,0) + +"RTN","TMGNDF2A",328,0) + set DIC(0)="AEQML" +"RTN","TMGNDF2A",329,0) + set DIC("A")="Enter VA DOSE FORM name: // " +"RTN","TMGNDF2A",330,0) + write !,"Enter name to match '"_DosageForm_"'" +"RTN","TMGNDF2A",331,0) + do ^DIC write ! +"RTN","TMGNDF2A",332,0) + if +Y>0 do +"RTN","TMGNDF2A",333,0) + . write "Use '",$piece(Y,"^",2),"' for '",DosageForm,"'" +"RTN","TMGNDF2A",334,0) + . new % set %=1 do YN^DICN +"RTN","TMGNDF2A",335,0) + . if %'=1 quit +"RTN","TMGNDF2A",336,0) + . set VistaIEN=+Y +"RTN","TMGNDF2A",337,0) + +"RTN","TMGNDF2A",338,0) +DL2 if VistaIEN'=0 do +"RTN","TMGNDF2A",339,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF2A",340,0) + . set TMGFDA(22706.8,IEN_",",1)=VistaIEN +"RTN","TMGNDF2A",341,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",342,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",343,0) + +"RTN","TMGNDF2A",344,0) +DLDone +"RTN","TMGNDF2A",345,0) + quit +"RTN","TMGNDF2A",346,0) + +"RTN","TMGNDF2A",347,0) + +"RTN","TMGNDF2A",348,0) +Unlock50dot606 +"RTN","TMGNDF2A",349,0) + ;"Purpose: to enable addition of dosage form to file DOSAGE FORM +"RTN","TMGNDF2A",350,0) + set $piece(^DD(50.606,.01,0),"^",5)="K:$L(X)>30!($L(X)<3) X" +"RTN","TMGNDF2A",351,0) + kill ^DD(50.606,.01,"LAYGO",.01,0) +"RTN","TMGNDF2A",352,0) + +"RTN","TMGNDF2A",353,0) + quit +"RTN","TMGNDF2A",354,0) + +"RTN","TMGNDF2A",355,0) +Lock50dot606 +"RTN","TMGNDF2A",356,0) + ;"NOTE: could just set XPDGREF=1 and not change this.... +"RTN","TMGNDF2A",357,0) + +"RTN","TMGNDF2A",358,0) + ;"Purpose: to restore locks on file DOSAGE FORM +"RTN","TMGNDF2A",359,0) + set $piece(^DD(50.606,.01,0),"^",5)="K:$L(X)>30!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X" +"RTN","TMGNDF2A",360,0) + set ^DD(50.606,.01,"LAYGO",.01,0)="D:'$D(XPDGREF) EN^DDIOL(""ADDITIONS ARE NOT ALLOWED"") I $D(XPDGREF)" +"RTN","TMGNDF2A",361,0) + quit +"RTN","TMGNDF2A",362,0) + +"RTN","TMGNDF2A",363,0) + +"RTN","TMGNDF2A",364,0) +ShowExamples(InputNum,Answers,Index) +"RTN","TMGNDF2A",365,0) + ;"Purpose: To show all entries using dosage form specified +"RTN","TMGNDF2A",366,0) + ;"Input: InputNum -- the input number from user to show +"RTN","TMGNDF2A",367,0) + ;" Answers -- PASS BY REFERENCE, array as put out by DisplayForms +"RTN","TMGNDF2A",368,0) + ;" Index -- OPTIONAL. An index of VAProduct +"RTN","TMGNDF2A",369,0) + +"RTN","TMGNDF2A",370,0) + new DosageForm +"RTN","TMGNDF2A",371,0) + set DosageForm=$piece($get(Answers(InputNum)),"^",1) +"RTN","TMGNDF2A",372,0) + if DosageForm="" goto SEDone +"RTN","TMGNDF2A",373,0) + +"RTN","TMGNDF2A",374,0) + if $data(Index)=0 do +"RTN","TMGNDF2A",375,0) + . do IndexVAProd^TMGNDF1C("Index") +"RTN","TMGNDF2A",376,0) + +"RTN","TMGNDF2A",377,0) + new count set count=0 +"RTN","TMGNDF2A",378,0) + new IEN set IEN=0 +"RTN","TMGNDF2A",379,0) + for do quit:(+IEN'>0) +"RTN","TMGNDF2A",380,0) + . set IEN=$order(^TMG(22706.2,"C",DosageForm,IEN)) +"RTN","TMGNDF2A",381,0) + . if +IEN'>0 quit +"RTN","TMGNDF2A",382,0) + . new Array,result,ListingIEN,CompIEN +"RTN","TMGNDF2A",383,0) + . set ListingIEN=$piece($get(^TMG(22706.2,IEN,0)),"^",1) +"RTN","TMGNDF2A",384,0) + . set CompIEN=$piece($get(^TMG(22706.5,ListingIEN,0)),"^",9) +"RTN","TMGNDF2A",385,0) + . if +CompIEN>0,$piece($get(^TMG(22706.9,CompIEN,1)),"^",4)=1 quit ;"check if skip field true +"RTN","TMGNDF2A",386,0) + . set result=$$GetDrugInfo^TMGNDF1C(ListingIEN,.Array,"Index") +"RTN","TMGNDF2A",387,0) + . if result do +"RTN","TMGNDF2A",388,0) + . . write "#",IEN,": " +"RTN","TMGNDF2A",389,0) + . . do FormatDrug(.Array) +"RTN","TMGNDF2A",390,0) + . . set count=count+1 +"RTN","TMGNDF2A",391,0) + . . if count>10 do +"RTN","TMGNDF2A",392,0) + . . . new input +"RTN","TMGNDF2A",393,0) + . . . read "Press ENTER to continue (^ to quit)",input:$get(DTIME,3600),! +"RTN","TMGNDF2A",394,0) + . . . if input="^" set IEN=0 +"RTN","TMGNDF2A",395,0) + . . . set count=0 +"RTN","TMGNDF2A",396,0) + . else do +"RTN","TMGNDF2A",397,0) + . . ;"write !,"Couldn't find any examples (error occurred).",! +"RTN","TMGNDF2A",398,0) + +"RTN","TMGNDF2A",399,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",400,0) +SEDone +"RTN","TMGNDF2A",401,0) + quit +"RTN","TMGNDF2A",402,0) + +"RTN","TMGNDF2A",403,0) + +"RTN","TMGNDF2A",404,0) +FormatDrug(Array) +"RTN","TMGNDF2A",405,0) + +"RTN","TMGNDF2A",406,0) + new s +"RTN","TMGNDF2A",407,0) + if '$data(Array) quit +"RTN","TMGNDF2A",408,0) + new i +"RTN","TMGNDF2A",409,0) + +"RTN","TMGNDF2A",410,0) + set s=$get(Array("TRADENAME"))_" " +"RTN","TMGNDF2A",411,0) + set s=s_$get(Array("STRENGTH"))_" " +"RTN","TMGNDF2A",412,0) + set s=s_$get(Array("UNIT"))_" " +"RTN","TMGNDF2A",413,0) + set i=$order(Array("DOSE","")) +"RTN","TMGNDF2A",414,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF2A",415,0) + . set s=s_$get(Array("DOSE",i,"DOSAGE NAME"))_" " +"RTN","TMGNDF2A",416,0) + . set i=$order(Array("DOSE",i)) +"RTN","TMGNDF2A",417,0) + +"RTN","TMGNDF2A",418,0) + write $extract(s,1,60),! +"RTN","TMGNDF2A",419,0) + +"RTN","TMGNDF2A",420,0) + quit +"RTN","TMGNDF2A",421,0) + +"RTN","TMGNDF2A",422,0) + +"RTN","TMGNDF2A",423,0) + ;"======================================== +"RTN","TMGNDF2A",424,0) +SelEditForms(SelArray,JustSelected) +"RTN","TMGNDF2A",425,0) + ;"Purpose: to use the Selector to browse and edit the TMG FDA IMPORT COMPILED, +"RTN","TMGNDF2A",426,0) + ;" specifically fields 3.4 (FDA DOSAGE FORM) and 3.5 (DOSAGE FORM) +"RTN","TMGNDF2A",427,0) + ;"Input: SelArray: Optional. PASS BY REFERENCE. An array of preselected IEN's +"RTN","TMGNDF2A",428,0) + ;" Format: SelArray(IEN in 22706.9)="" <-- IEN preselected +"RTN","TMGNDF2A",429,0) + ;" JustSelected: Optional. if 1, then ONLY IENs from SelArray shown. +"RTN","TMGNDF2A",430,0) + ;"Output: User may alter the value of SKIP THIS RECORD field for all records +"RTN","TMGNDF2A",431,0) + ;"Results: none +"RTN","TMGNDF2A",432,0) + +"RTN","TMGNDF2A",433,0) + new Options,IEN +"RTN","TMGNDF2A",434,0) + set Options("FIELDS",1)=".05^TRADENAME^30" +"RTN","TMGNDF2A",435,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF2A",436,0) + set Options("FIELDS",2)="2^UNIT^9" +"RTN","TMGNDF2A",437,0) + if +$get(editUnit)=0 set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF2A",438,0) + set Options("FIELDS",3)="3.4^FDA DOSAGE FORM^20" +"RTN","TMGNDF2A",439,0) + set Options("FIELDS",4)="3.5^DOSAGE FORM^21" +"RTN","TMGNDF2A",440,0) + set Options("FIELDS","MAX NUM")=4 +"RTN","TMGNDF2A",441,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF2A",442,0) + +"RTN","TMGNDF2A",443,0) + if +$get(JustSelected)=0 do +"RTN","TMGNDF2A",444,0) + . ;"Get all records with SKIP THIS RECORD = 0 (KEEP) +"RTN","TMGNDF2A",445,0) + . do GetFldValue^TMGSELED(22706.9,6,0,$name(Options("IEN LIST"))) +"RTN","TMGNDF2A",446,0) + else do +"RTN","TMGNDF2A",447,0) + . merge Options("IEN LIST")=SelArray +"RTN","TMGNDF2A",448,0) + +"RTN","TMGNDF2A",449,0) +SE1 if $data(SelArray) do +"RTN","TMGNDF2A",450,0) + . set IEN="" +"RTN","TMGNDF2A",451,0) + . for set IEN=$order(SelArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF2A",452,0) + . . if $data(Options("IEN LIST",IEN))>0 do +"RTN","TMGNDF2A",453,0) + . . . set Options("IEN LIST",IEN,"SEL")="" +"RTN","TMGNDF2A",454,0) + +"RTN","TMGNDF2A",455,0) + if $$SELED^TMGSELED(.Options)'=2 goto SEKDone +"RTN","TMGNDF2A",456,0) + if $$GetIENs^TMGSELED(.Options)=0 goto SEKDone +"RTN","TMGNDF2A",457,0) + goto SE1 +"RTN","TMGNDF2A",458,0) + +"RTN","TMGNDF2A",459,0) +SEKDone quit +"RTN","TMGNDF2A",460,0) + +"RTN","TMGNDF2A",461,0) + +"RTN","TMGNDF2A",462,0) +SelFormMap +"RTN","TMGNDF2A",463,0) + ;"Purpose: use Selector to browse and edit TMG FDA FORMS VISTA EQUIVALENTS +"RTN","TMGNDF2A",464,0) + +"RTN","TMGNDF2A",465,0) + new Options,IEN +"RTN","TMGNDF2A",466,0) + set Options("FIELDS",1)=".01^FDA FORM^35" +"RTN","TMGNDF2A",467,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF2A",468,0) + set Options("FIELDS",2)="1^VISTA FORM^25" +"RTN","TMGNDF2A",469,0) + ;"set Options("FIELDS",3)="2^VISTA ROUTE^20" +"RTN","TMGNDF2A",470,0) + ;"set Options("FIELDS","MAX NUM")=3 +"RTN","TMGNDF2A",471,0) + set Options("FIELDS","MAX NUM")=2 +"RTN","TMGNDF2A",472,0) + set Options("FILE")="22706.8^TMG FDA FORMS VISTA EQUIVALENTS" +"RTN","TMGNDF2A",473,0) + +"RTN","TMGNDF2A",474,0) + do GetFldValue^TMGSELED(22706.8,.01,"ALL",$name(Options("IEN LIST"))) +"RTN","TMGNDF2A",475,0) + +"RTN","TMGNDF2A",476,0) +SFM1 +"RTN","TMGNDF2A",477,0) + if $$SELED^TMGSELED(.Options)'=2 goto SFMDone +"RTN","TMGNDF2A",478,0) + if $$GetIENs^TMGSELED(.Options)=0 goto SFMDone +"RTN","TMGNDF2A",479,0) + goto SFM1 +"RTN","TMGNDF2A",480,0) + +"RTN","TMGNDF2A",481,0) +SFMDone quit +"RTN","TMGNDF2A",482,0) + +"RTN","TMGNDF2A",483,0) + +"RTN","TMGNDF2A",484,0) +SelMissing +"RTN","TMGNDF2A",485,0) + ;"Purpose: To preselect those entries with a missing VISTA FORMS +"RTN","TMGNDF2A",486,0) + +"RTN","TMGNDF2A",487,0) + new PreSelArray +"RTN","TMGNDF2A",488,0) + +"RTN","TMGNDF2A",489,0) + write "Scanning for entries with no VA FORM...",! +"RTN","TMGNDF2A",490,0) + do GetFldValue^TMGSELED(22706.9,3.5,"@","PreSelArray") +"RTN","TMGNDF2A",491,0) + write "Now scanning for the rest of the entries (ignoring skips)...",! +"RTN","TMGNDF2A",492,0) + do SelEditForms(.PreSelArray) +"RTN","TMGNDF2A",493,0) + +"RTN","TMGNDF2A",494,0) + quit +"RTN","TMGNDF2A",495,0) + +"RTN","TMGNDF2A",496,0) +EditForms +"RTN","TMGNDF2A",497,0) + ;"Purpose: To edit Vista drug forms in file 50.606 +"RTN","TMGNDF2A",498,0) + +"RTN","TMGNDF2A",499,0) + new Options,IEN +"RTN","TMGNDF2A",500,0) + set Options("FIELDS",1)=".01^NAME^17" +"RTN","TMGNDF2A",501,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF2A",502,0) + set Options("FIELDS",2)="3^VERB^8" +"RTN","TMGNDF2A",503,0) + set Options("FIELDS",3)="5^PEPOSITION^12" +"RTN","TMGNDF2A",504,0) + set Options("FIELDS",4)="10^CONJUNCTION^12" +"RTN","TMGNDF2A",505,0) + set Options("FIELDS",5)="22706.8^DIVIDABLE^10" +"RTN","TMGNDF2A",506,0) + set Options("FIELDS","MAX NUM")=5 +"RTN","TMGNDF2A",507,0) + set Options("FILE")="50.606^DOSAGE FORM" +"RTN","TMGNDF2A",508,0) + +"RTN","TMGNDF2A",509,0) + do GetFldValue^TMGSELED(50.606,.01,"ALL",$name(Options("IEN LIST"))) +"RTN","TMGNDF2A",510,0) + +"RTN","TMGNDF2A",511,0) +EF1 +"RTN","TMGNDF2A",512,0) + if $$SELED^TMGSELED(.Options)'=2 goto EFDone +"RTN","TMGNDF2A",513,0) + if $$GetIENs^TMGSELED(.Options)=0 goto EFDone +"RTN","TMGNDF2A",514,0) + goto EF1 +"RTN","TMGNDF2A",515,0) + +"RTN","TMGNDF2A",516,0) +EFDone quit +"RTN","TMGNDF2A",517,0) + +"RTN","TMGNDF2A",518,0) + ;"========================================================== +"RTN","TMGNDF2A",519,0) +FixNoForm +"RTN","TMGNDF2A",520,0) + ;"Purpose: To scan through the TRADENAME fields (.05) and fix +"RTN","TMGNDF2A",521,0) + ;" drugs that don't have a drug FORM in the name. +"RTN","TMGNDF2A",522,0) + +"RTN","TMGNDF2A",523,0) + new IEN,Itr,abort,IgnoreList +"RTN","TMGNDF2A",524,0) + new quickMem +"RTN","TMGNDF2A",525,0) + new Suggestions +"RTN","TMGNDF2A",526,0) + set abort=0 +"RTN","TMGNDF2A",527,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2A",528,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2A",529,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2A",530,0) + . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGNDF2A",531,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2A",532,0) + . new tradeName,nameArray +"RTN","TMGNDF2A",533,0) + . set tradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) +"RTN","TMGNDF2A",534,0) + . if tradeName="" write !,"No TRADENAME found for record#: ",IEN,! quit +"RTN","TMGNDF2A",535,0) + . new result set result=$$HandleNameArray(IEN,tradeName,.IgnoreList,1) +"RTN","TMGNDF2A",536,0) + . if result="^" set abort=1 +"RTN","TMGNDF2A",537,0) + . if +result=0 do +"RTN","TMGNDF2A",538,0) + . . set Suggestions(IEN)=$piece(result,"^",2) +"RTN","TMGNDF2A",539,0) + +"RTN","TMGNDF2A",540,0) + if $data(Suggestions) do HndlSuggestions(.Suggestions,.IgnoreList) +"RTN","TMGNDF2A",541,0) + else do +"RTN","TMGNDF2A",542,0) + . write "No changes needed. Great!",! +"RTN","TMGNDF2A",543,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",544,0) + +"RTN","TMGNDF2A",545,0) + quit +"RTN","TMGNDF2A",546,0) + +"RTN","TMGNDF2A",547,0) + +"RTN","TMGNDF2A",548,0) + +"RTN","TMGNDF2A",549,0) +HandleNameArray(IEN,tradeName,IgnoreList,Quiet) +"RTN","TMGNDF2A",550,0) + ;"Purpose: To handle a name array, looking for a form. +"RTN","TMGNDF2A",551,0) + ;"Input: IEN -- IEN in 22706.9 of current drug +"RTN","TMGNDF2A",552,0) + ;" tradeName -- current TRADENAME +"RTN","TMGNDF2A",553,0) + ;" IgnoreList -- OPTIONAL -- a list of forms to be ignored (not perminant). +"RTN","TMGNDF2A",554,0) + ;" Format: IgnoreList(FormName)="" +"RTN","TMGNDF2A",555,0) + ;" Quiet -- OPTIONAL. If =1 then will not ask, but prepair suggested answer. +"RTN","TMGNDF2A",556,0) + ;"NOTE: Makes use of variable with global scope quickMem. Format: +"RTN","TMGNDF2A",557,0) + ;" quickMem(FormNameFound)="" +"RTN","TMGNDF2A",558,0) + ;" quickMem(FormNameFound)="" +"RTN","TMGNDF2A",559,0) + ;"Results: 1=drug FORM found, +"RTN","TMGNDF2A",560,0) + ;" 0 if not found, OR 0^SuggestedNewName +"RTN","TMGNDF2A",561,0) + ;" ^=abort +"RTN","TMGNDF2A",562,0) + +"RTN","TMGNDF2A",563,0) + new Array +"RTN","TMGNDF2A",564,0) + do CleaveToArray^TMGSTUTL(tradeName," ",.Array) +"RTN","TMGNDF2A",565,0) + ;"Returns Array in format: +"RTN","TMGNDF2A",566,0) + ;" Array(1)="This" +"RTN","TMGNDF2A",567,0) + ;" Array(2)="Is" +"RTN","TMGNDF2A",568,0) + ;" Array(3)="A" +"RTN","TMGNDF2A",569,0) + ;" Array(4)="Test" +"RTN","TMGNDF2A",570,0) + ;" Array(MAXNODE)=4 +"RTN","TMGNDF2A",571,0) + +"RTN","TMGNDF2A",572,0) +HNA0 new index,tempS +"RTN","TMGNDF2A",573,0) + new found set found=0 +"RTN","TMGNDF2A",574,0) + new result set result=0 +"RTN","TMGNDF2A",575,0) + set Quiet=+$get(Quiet,0) +"RTN","TMGNDF2A",576,0) + new suggestedName set suggestedName="" +"RTN","TMGNDF2A",577,0) + set tempS="" +"RTN","TMGNDF2A",578,0) + new DIC,X,Y +"RTN","TMGNDF2A",579,0) + new menu,menuIndex,UsrSlct +"RTN","TMGNDF2A",580,0) + new drugForm +"RTN","TMGNDF2A",581,0) + set menuIndex=1 +"RTN","TMGNDF2A",582,0) + new lastWord set lastWord="" +"RTN","TMGNDF2A",583,0) + for index=$get(Array("MAXNODE")):-1:1 do quit:(found=1)!(result="^") +"RTN","TMGNDF2A",584,0) + . new thisWord set thisWord=$get(Array(index)) +"RTN","TMGNDF2A",585,0) + . if thisWord="" quit +"RTN","TMGNDF2A",586,0) + . new % set %=2 +"RTN","TMGNDF2A",587,0) + . if thisWord=lastWord do quit:(result="^")!(%=1) +"RTN","TMGNDF2A",588,0) + . . if Quiet=1 quit +"RTN","TMGNDF2A",589,0) + . . write "Word '",thisWord,"' found more than once",! +"RTN","TMGNDF2A",590,0) + . . write " in '",tradeName,".'",! +"RTN","TMGNDF2A",591,0) + . . write " Delete one of these " +"RTN","TMGNDF2A",592,0) + . . set %=1 do YN^DICN write ! +"RTN","TMGNDF2A",593,0) + . . if %=-1 set result="^" quit +"RTN","TMGNDF2A",594,0) + . . if %=2 quit +"RTN","TMGNDF2A",595,0) + . . if %=1 kill Array(index) quit +"RTN","TMGNDF2A",596,0) + . set lastWord=thisWord +"RTN","TMGNDF2A",597,0) + . if tempS'="" set tempS=" "_tempS +"RTN","TMGNDF2A",598,0) + . set tempS=thisWord_tempS +"RTN","TMGNDF2A",599,0) + . set menuIndex=menuIndex+1 +"RTN","TMGNDF2A",600,0) + . set menu(menuIndex)=tempS +"RTN","TMGNDF2A",601,0) + . new TMGA,TMGMSG +"RTN","TMGNDF2A",602,0) + . if $data(quickMem(tempS)) set found=1 quit +"RTN","TMGNDF2A",603,0) + . do FIND^DIC(22706.8,"",".01","M",tempS,"1","B","","","TMGA","TMGMSG") +"RTN","TMGNDF2A",604,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",605,0) + . if +$get(TMGA("DILIST",0))>0 do quit +"RTN","TMGNDF2A",606,0) + . . set found=1 +"RTN","TMGNDF2A",607,0) + . . set quickMem(tempS)="" +"RTN","TMGNDF2A",608,0) + . if $data(quickMem(thisWord)) set found=1 quit +"RTN","TMGNDF2A",609,0) + . do FIND^DIC(22706.8,"",".01","MC",thisWord,"1","","","","TMGA","TMGMSG") +"RTN","TMGNDF2A",610,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",611,0) + . if +$get(TMGA("DILIST",0))>0 do quit +"RTN","TMGNDF2A",612,0) + . . set found=1 +"RTN","TMGNDF2A",613,0) + . . set quickMem(tempS)="" +"RTN","TMGNDF2A",614,0) + if found goto MCDone +"RTN","TMGNDF2A",615,0) + +"RTN","TMGNDF2A",616,0) + set drugForm=$$GET1^DIQ(22706.9,IEN_",","3.5:.01") +"RTN","TMGNDF2A",617,0) + if $data(IgnoreList(drugForm)) goto MCDone ;" marked to be ignored. +"RTN","TMGNDF2A",618,0) + +"RTN","TMGNDF2A",619,0) + set menu(0)="Which option best shows the drug FORM? (Record #"_IEN_")" +"RTN","TMGNDF2A",620,0) + set menu(1)="None below. Use linked FORM: "_drugForm_$char(9)_"NONE" +"RTN","TMGNDF2A",621,0) + set menuIndex=menuIndex+1 +"RTN","TMGNDF2A",622,0) + set menu(menuIndex)="Manually enter a NEW FULL TRADENAME + FORM for this drug"_$char(9)_"EDIT" +"RTN","TMGNDF2A",623,0) + set menuIndex=menuIndex+1 +"RTN","TMGNDF2A",624,0) + set menu(menuIndex)="Manually change LINKED drug FORM for this drug"_$char(9)_"ChangeForm" +"RTN","TMGNDF2A",625,0) + set menuIndex=menuIndex+1 +"RTN","TMGNDF2A",626,0) + set menu(menuIndex)="Ignore this drug and continue"_$char(9)_"Ignore" +"RTN","TMGNDF2A",627,0) + +"RTN","TMGNDF2A",628,0) + if Quiet=1 set UsrSlct="QUIET" goto MC2 +"RTN","TMGNDF2A",629,0) + +"RTN","TMGNDF2A",630,0) + ;"At this point, no drug form was found. +"RTN","TMGNDF2A",631,0) +MC1 write ! +"RTN","TMGNDF2A",632,0) + set UsrSlct=$$Menu^TMGUSRIF(.menu,menuIndex) +"RTN","TMGNDF2A",633,0) + write ! +"RTN","TMGNDF2A",634,0) + if UsrSlct="^" set result="^" goto MCDone +"RTN","TMGNDF2A",635,0) + if UsrSlct="Ignore" do goto MCDone +"RTN","TMGNDF2A",636,0) + . write "Ignore all drugs with linked drug form of: ",drugForm," " +"RTN","TMGNDF2A",637,0) + . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF2A",638,0) + . if %=-1 set result="^" quit +"RTN","TMGNDF2A",639,0) + . if %=2 quit +"RTN","TMGNDF2A",640,0) + . set IgnoreList(drugForm)="" +"RTN","TMGNDF2A",641,0) + +"RTN","TMGNDF2A",642,0) +MC2 if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF2A",643,0) + +"RTN","TMGNDF2A",644,0) + if UsrSlct>0 do goto MCDone +"RTN","TMGNDF2A",645,0) + . new newForm set newForm=$get(menu(UsrSlct)) +"RTN","TMGNDF2A",646,0) + . new DIC,X,Y set DIC=22706.8 +"RTN","TMGNDF2A",647,0) + . set DIC(0)="MAEQL" +"RTN","TMGNDF2A",648,0) + . set DIC("A")="Select drug FORM to match with '"_newForm_"' ^//" +"RTN","TMGNDF2A",649,0) + . do ^DIC write ! +"RTN","TMGNDF2A",650,0) + . if +Y'>0 quit +"RTN","TMGNDF2A",651,0) + . new vistaForm,vistaRoute +"RTN","TMGNDF2A",652,0) + . set vistaForm=$piece($get(^TMG(22706.8,+Y,0)),"^",2) +"RTN","TMGNDF2A",653,0) + . set vistaRoute=$piece($get(^TMG(22706.8,+Y,0)),"^",3) +"RTN","TMGNDF2A",654,0) + . new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF2A",655,0) + . set TMGFDA(22706.8,"+1,",.01)=newForm +"RTN","TMGNDF2A",656,0) + . set TMGFDA(22706.8,"+1,",1)=vistaForm +"RTN","TMGNDF2A",657,0) + . set TMGFDA(22706.8,"+1,",2)=vistaRoute +"RTN","TMGNDF2A",658,0) + . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2A",659,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",660,0) + . set found=1 +"RTN","TMGNDF2A",661,0) + +"RTN","TMGNDF2A",662,0) + set Y=-1 +"RTN","TMGNDF2A",663,0) + if UsrSlct="ChangeForm" do goto MCDone:(Y=-1),HNA0 +"RTN","TMGNDF2A",664,0) + . new DIC,X,Y +"RTN","TMGNDF2A",665,0) + . set DIC=50.606,DIC(0)="MAEQ" +"RTN","TMGNDF2A",666,0) + . set DIC("A")="Select drug FORM to use: ^// " +"RTN","TMGNDF2A",667,0) + . write "For '",tradeName,"',",! +"RTN","TMGNDF2A",668,0) + . do ^DIC +"RTN","TMGNDF2A",669,0) + . if Y=-1 quit +"RTN","TMGNDF2A",670,0) + . new newForm set newForm=$piece(Y,"^",2) +"RTN","TMGNDF2A",671,0) + . new origName set origName=$$GET1^DIQ(22706.9,IEN_",",.05) +"RTN","TMGNDF2A",672,0) + . set tradeName=origName_" "_newForm +"RTN","TMGNDF2A",673,0) + . if tradeName="" write "?? tradeName=''",! quit +"RTN","TMGNDF2A",674,0) + . new TMGFDA,TMGMSG,TMGA +"RTN","TMGNDF2A",675,0) + . set TMGFDA(22706.9,IEN_",",3.5)=+Y +"RTN","TMGNDF2A",676,0) + . set TMGFDA(22706.9,IEN_",",.05)=tradeName +"RTN","TMGNDF2A",677,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",678,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",679,0) + . do FIND^DIC(22706.8,"",".01","M",newForm,"1","B","","","TMGA","TMGMSG") +"RTN","TMGNDF2A",680,0) + . if +$get(TMGA("DILIST",0))'>0 do +"RTN","TMGNDF2A",681,0) + . . kill TMGFDA,TMGMSG new TMGIEN +"RTN","TMGNDF2A",682,0) + . . set TMGFDA(22706.8,"+1,",.01)=newForm +"RTN","TMGNDF2A",683,0) + . . do UPDATE^DIE("E","TMGFDA","TMGIDE","TMGMSG") +"RTN","TMGNDF2A",684,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",685,0) + . set result="0^"_tradeName +"RTN","TMGNDF2A",686,0) + +"RTN","TMGNDF2A",687,0) + if UsrSlct="QUIET" do goto MCDone +"RTN","TMGNDF2A",688,0) + . set suggestedName=tradeName_" "_drugForm +"RTN","TMGNDF2A",689,0) + . set result="0^"_suggestedName +"RTN","TMGNDF2A",690,0) + +"RTN","TMGNDF2A",691,0) + if UsrSlct="NONE" do goto MCDone +"RTN","TMGNDF2A",692,0) + . new newName +"RTN","TMGNDF2A",693,0) + . if drugForm="" do quit +"RTN","TMGNDF2A",694,0) + . . write "No drug FORM found in field 3.5 for record#: ",IEN,! quit +"RTN","TMGNDF2A",695,0) + . set newName=tradeName_" "_drugForm +"RTN","TMGNDF2A",696,0) + . write "Change TRADENAME to: ",newName," " +"RTN","TMGNDF2A",697,0) + . new % set %=1 do YN^DICN write ! +"RTN","TMGNDF2A",698,0) + . if %=-1 set result="^" quit +"RTN","TMGNDF2A",699,0) + . if %=2 quit +"RTN","TMGNDF2A",700,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF2A",701,0) + . set TMGFDA(22706.9,IEN_",",.05)=newName +"RTN","TMGNDF2A",702,0) + . do UPDATE^DIE("ES","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",703,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",704,0) + . set found=1 +"RTN","TMGNDF2A",705,0) + +"RTN","TMGNDF2A",706,0) + if UsrSlct="EDIT" do goto MCDone +"RTN","TMGNDF2A",707,0) + . write "Enter NEW TRADENAME for drug (^ to abort): " +"RTN","TMGNDF2A",708,0) + . new newName read newName:$get(DTIME,3600),! +"RTN","TMGNDF2A",709,0) + . if newName="^" quit +"RTN","TMGNDF2A",710,0) + . write !,"Change TRADENAME from:",! +"RTN","TMGNDF2A",711,0) + . write tradeName," " +"RTN","TMGNDF2A",712,0) + . write " ----->",! +"RTN","TMGNDF2A",713,0) + . write newName,! +"RTN","TMGNDF2A",714,0) + . new % set Y=1 +"RTN","TMGNDF2A",715,0) + . do YN^DICN write ! +"RTN","TMGNDF2A",716,0) + . if %=-1 set result="^" quit +"RTN","TMGNDF2A",717,0) + . if %='1 quit +"RTN","TMGNDF2A",718,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF2A",719,0) + . set TMGFDA(22706.9,IEN_",",.05)=newName +"RTN","TMGNDF2A",720,0) + . do UPDATE^DIE("ES","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",721,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",722,0) + . set result="0^"_newName +"RTN","TMGNDF2A",723,0) + +"RTN","TMGNDF2A",724,0) +MCDone +"RTN","TMGNDF2A",725,0) + if (found=1)&(result'="^") set result=1 +"RTN","TMGNDF2A",726,0) + quit result +"RTN","TMGNDF2A",727,0) + +"RTN","TMGNDF2A",728,0) + +"RTN","TMGNDF2A",729,0) +HndlSuggestions(Suggestions,IgnoreList) +"RTN","TMGNDF2A",730,0) + ;"Purpose: to interact with user about accepting or editing suggestions +"RTN","TMGNDF2A",731,0) + ;"Input: Suggestions -- PASS BY REFERENCE. Format: +"RTN","TMGNDF2A",732,0) + ;" Suggestions(IEN)=SuggestedNameForTradeName +"RTN","TMGNDF2A",733,0) + ;" Suggestions(IEN)=SuggestedNameForTradeName +"RTN","TMGNDF2A",734,0) + ;" IgnoreList -- PASS BY REFERENCE. A list of words/forms to be ignored +"RTN","TMGNDF2A",735,0) + +"RTN","TMGNDF2A",736,0) + new Answers +"RTN","TMGNDF2A",737,0) + new done set done=0 +"RTN","TMGNDF2A",738,0) + new input set input="R" +"RTN","TMGNDF2A",739,0) + new CompactMode set CompactMode=0 +"RTN","TMGNDF2A",740,0) + new Cancelled set Cancelled=0 +"RTN","TMGNDF2A",741,0) + new LastNum set LastNum=0 +"RTN","TMGNDF2A",742,0) + new EntryList,EntryS +"RTN","TMGNDF2A",743,0) + +"RTN","TMGNDF2A",744,0) + for do quit:(done=1) +"RTN","TMGNDF2A",745,0) + . if input="R" do +"RTN","TMGNDF2A",746,0) + . . write !! +"RTN","TMGNDF2A",747,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",748,0) + . . write "Specify which New TRADENAMES to accept",! +"RTN","TMGNDF2A",749,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",750,0) + . . do DispSuggestions(.Suggestions,.Answers,CompactMode) +"RTN","TMGNDF2A",751,0) + . . set LastNum=$order(Answers(""),-1) +"RTN","TMGNDF2A",752,0) + . . if LastNum="" set LastNum="^" +"RTN","TMGNDF2A",753,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",754,0) + . . write "Specify which New TRADENAMES to accept",! +"RTN","TMGNDF2A",755,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2A",756,0) + . write " R to refresh, I to Ignore some; M to manually edit",! +"RTN","TMGNDF2A",757,0) + . write " C=set Compact ",$select((CompactMode=1):"OFF",1:"ON"),", " +"RTN","TMGNDF2A",758,0) + . write " S to Screen names for a given form to Ignore.",! +"RTN","TMGNDF2A",759,0) + . write " A to show ALTERNATE drugs similar to shown",! +"RTN","TMGNDF2A",760,0) + . write " O to show sOurce (from FDA) for drug; K to mark drug sKipped.",! +"RTN","TMGNDF2A",761,0) + . write " # or #-# or #,#-#,# etc., ^ done, ",! +"RTN","TMGNDF2A",762,0) + . ;"write "Enter number(s) to Accept (or codes listed above): ",LastNum,"//" +"RTN","TMGNDF2A",763,0) + . write "Enter number(s) to Accept (or codes listed above): ^//" +"RTN","TMGNDF2A",764,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF2A",765,0) + . ;"if input="" set input=LastNum write LastNum +"RTN","TMGNDF2A",766,0) + . if input="" set input="^" write "^" +"RTN","TMGNDF2A",767,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2A",768,0) + . if input="^" set done=1 quit +"RTN","TMGNDF2A",769,0) + . if input="A" do ;"--- show alternatives +"RTN","TMGNDF2A",770,0) + . . new valid set valid=1 +"RTN","TMGNDF2A",771,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2A",772,0) + . . . read "...Enter number(s) to show ALTERNATIVES for from list: ^// ",input,! +"RTN","TMGNDF2A",773,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2A",774,0) + . . . if valid set EntryS=input +"RTN","TMGNDF2A",775,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",776,0) + . . do ShowAlts(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",777,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",778,0) + . . set input="R" +"RTN","TMGNDF2A",779,0) + . if input="I" do ;"--- ignore entries. +"RTN","TMGNDF2A",780,0) + . . new valid set valid=1 +"RTN","TMGNDF2A",781,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2A",782,0) + . . . read "...Enter number(s) to IGNORE from list: ^// ",input,! +"RTN","TMGNDF2A",783,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2A",784,0) + . . . if valid set EntryS=input +"RTN","TMGNDF2A",785,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",786,0) + . . do KillSugg(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",787,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",788,0) + . . set input="R" +"RTN","TMGNDF2A",789,0) + . else if input="K" do ;"--- Set to SKIP +"RTN","TMGNDF2A",790,0) + . . new valid set valid=1 +"RTN","TMGNDF2A",791,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2A",792,0) + . . . read "...Enter number(s) to PERMINANTLY SKIP from list: ^// ",input,! +"RTN","TMGNDF2A",793,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2A",794,0) + . . . if valid set EntryS=input +"RTN","TMGNDF2A",795,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",796,0) + . . do SetSkip(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",797,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",798,0) + . . set input="R" +"RTN","TMGNDF2A",799,0) + . else if input="C" do ;"--- toggle compact mode +"RTN","TMGNDF2A",800,0) + . . set CompactMode='CompactMode +"RTN","TMGNDF2A",801,0) + . . set input="R" +"RTN","TMGNDF2A",802,0) + . else if input="M" do ;"--- manually handle entry +"RTN","TMGNDF2A",803,0) + . . new valid set valid=1 +"RTN","TMGNDF2A",804,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2A",805,0) + . . . read "...Enter number(s) to MANUALLY EDIT from list: ^// ",input,! +"RTN","TMGNDF2A",806,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2A",807,0) + . . . if valid set EntryS=input +"RTN","TMGNDF2A",808,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",809,0) + . . do ManualEdit(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",810,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",811,0) + . . set input="R" +"RTN","TMGNDF2A",812,0) + . else if input="O" do ;"--- show FDA source +"RTN","TMGNDF2A",813,0) + . . new valid set valid=1 +"RTN","TMGNDF2A",814,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2A",815,0) + . . . read "...Enter number(s) to show FDA SOURCE for from list: ^// ",input,! +"RTN","TMGNDF2A",816,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2A",817,0) + . . . if valid set EntryS=input +"RTN","TMGNDF2A",818,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",819,0) + . . do ShowSrc(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",820,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",821,0) + . . set input="R" +"RTN","TMGNDF2A",822,0) + . else if input="S" do ;"--- screen for those to ignore +"RTN","TMGNDF2A",823,0) + . . new scrnForm +"RTN","TMGNDF2A",824,0) + . . read "Enter Form to screen for. All entries with this form will be ignored: ",scrnForm,! +"RTN","TMGNDF2A",825,0) + . . if scrnForm="^" quit +"RTN","TMGNDF2A",826,0) + . . kill EntryList,EntryS +"RTN","TMGNDF2A",827,0) + . . new num set num="" +"RTN","TMGNDF2A",828,0) + . . for set num=$order(Answers(num)) quit:(num="") do +"RTN","TMGNDF2A",829,0) + . . . new newName set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",830,0) + . . . if newName[scrnForm set EntryList(num)="" +"RTN","TMGNDF2A",831,0) + . . do KillSugg(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",832,0) + . . set input="R" +"RTN","TMGNDF2A",833,0) + . else if input'="R" do +"RTN","TMGNDF2A",834,0) + . . if $$MkMultList^TMGMISC(input,.EntryList)=0 quit +"RTN","TMGNDF2A",835,0) + . . set EntryS=input +"RTN","TMGNDF2A",836,0) + . . set Cancelled=0 +"RTN","TMGNDF2A",837,0) + . . do AcceptSugg(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",838,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF2A",839,0) + . . set input="R" +"RTN","TMGNDF2A",840,0) + +"RTN","TMGNDF2A",841,0) + quit +"RTN","TMGNDF2A",842,0) + +"RTN","TMGNDF2A",843,0) + +"RTN","TMGNDF2A",844,0) +AcceptSugg(Array,Answers,EntryList,Cancelled) +"RTN","TMGNDF2A",845,0) + ;"Purpose: To accept new suggested name from Array +"RTN","TMGNDF2A",846,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",847,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",848,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",849,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",850,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",851,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",852,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",853,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",854,0) + ;" Format as follows. +"RTN","TMGNDF2A",855,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",856,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",857,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",858,0) + ;"Results: none +"RTN","TMGNDF2A",859,0) + +"RTN","TMGNDF2A",860,0) + new num set num="" +"RTN","TMGNDF2A",861,0) + for set num=$order(EntryList(num)) quit:(num="") do +"RTN","TMGNDF2A",862,0) + . new IEN,newName +"RTN","TMGNDF2A",863,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",864,0) + . if IEN="" quit +"RTN","TMGNDF2A",865,0) + . set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",866,0) + . if $length(newName)>64 do quit:(newName="^") +"RTN","TMGNDF2A",867,0) + . . set newName=$$ShortName^TMGSHORT(newName,64,1," ") +"RTN","TMGNDF2A",868,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF2A",869,0) + . set TMGFDA(22706.9,IEN_",",.05)=newName +"RTN","TMGNDF2A",870,0) + . do UPDATE^DIE("ES","TMGFDA","TMGMSG") +"RTN","TMGNDF2A",871,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",872,0) + +"RTN","TMGNDF2A",873,0) + do KillSugg(.Array,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",874,0) + +"RTN","TMGNDF2A",875,0) + quit +"RTN","TMGNDF2A",876,0) + +"RTN","TMGNDF2A",877,0) +ManualEdit(Suggestions,Answers,EntryList,Cancelled,IgnoreList) +"RTN","TMGNDF2A",878,0) + ;"Purpose: To accept manually edit suggestions from Array +"RTN","TMGNDF2A",879,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",880,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",881,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",882,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",883,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",884,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",885,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",886,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",887,0) + ;" Format as follows. +"RTN","TMGNDF2A",888,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",889,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",890,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",891,0) + ;" IgnoreList -- PASS BY REFERENCE. A list of words/forms to ignore. +"RTN","TMGNDF2A",892,0) + ;"NOTE: function HandleNameArray (called here) uses variable with global +"RTN","TMGNDF2A",893,0) + ;" scope: quickMem +"RTN","TMGNDF2A",894,0) + ;"Results: none +"RTN","TMGNDF2A",895,0) + +"RTN","TMGNDF2A",896,0) + new num set num="" +"RTN","TMGNDF2A",897,0) + set Cancelled=$get(Cancelled,0) +"RTN","TMGNDF2A",898,0) + for set num=$order(EntryList(num)) quit:(num="")!(Cancelled=1) do +"RTN","TMGNDF2A",899,0) + . new IEN,newName +"RTN","TMGNDF2A",900,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",901,0) + . if IEN="" quit +"RTN","TMGNDF2A",902,0) + . ;"set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",903,0) + . set newName=$$GET1^DIQ(22706.9,IEN_",",.05) +"RTN","TMGNDF2A",904,0) + . new result set result=$$HandleNameArray(IEN,newName,.IgnoreList,0) +"RTN","TMGNDF2A",905,0) + . if +result=0 do +"RTN","TMGNDF2A",906,0) + . . set $piece(Answers(num),"^",2)=$piece(result,"^",2) +"RTN","TMGNDF2A",907,0) + . . set Suggestions(IEN)=$piece(result,"^",2) +"RTN","TMGNDF2A",908,0) + . if result="^" set Cancelled=1 +"RTN","TMGNDF2A",909,0) + . if result=1 do quit +"RTN","TMGNDF2A",910,0) + . . write "Entry handled and removed from list.",! +"RTN","TMGNDF2A",911,0) + . . do PressToContinue^TMGUSRIF +"RTN","TMGNDF2A",912,0) + . . kill Answers(num),Suggestions(IEN),EntryList(num) +"RTN","TMGNDF2A",913,0) + +"RTN","TMGNDF2A",914,0) + quit +"RTN","TMGNDF2A",915,0) + +"RTN","TMGNDF2A",916,0) + +"RTN","TMGNDF2A",917,0) +ShowSrc(Suggestions,Answers,EntryList,Cancelled) +"RTN","TMGNDF2A",918,0) + ;"Purpose: To show FDA source for drugs in Array +"RTN","TMGNDF2A",919,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",920,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",921,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",922,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",923,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",924,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",925,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",926,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",927,0) + ;" Format as follows. +"RTN","TMGNDF2A",928,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",929,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",930,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",931,0) + ;"Results: none +"RTN","TMGNDF2A",932,0) + +"RTN","TMGNDF2A",933,0) + new num set num="" +"RTN","TMGNDF2A",934,0) + set Cancelled=$get(Cancelled,0) +"RTN","TMGNDF2A",935,0) + for set num=$order(EntryList(num)) quit:(num="")!(Cancelled=1) do +"RTN","TMGNDF2A",936,0) + . new IEN,newName +"RTN","TMGNDF2A",937,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",938,0) + . if IEN="" quit +"RTN","TMGNDF2A",939,0) + . set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",940,0) + . do Show1Source^TMGNDF1A(IEN) +"RTN","TMGNDF2A",941,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",942,0) + +"RTN","TMGNDF2A",943,0) + quit +"RTN","TMGNDF2A",944,0) + +"RTN","TMGNDF2A",945,0) + +"RTN","TMGNDF2A",946,0) +SetSkip(Suggestions,Answers,EntryList,Cancelled,Quiet) +"RTN","TMGNDF2A",947,0) + ;"Purpose: To set the drugs in the Array as perminantly skipped. +"RTN","TMGNDF2A",948,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",949,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",950,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",951,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",952,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",953,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",954,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",955,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",956,0) + ;" Format as follows. +"RTN","TMGNDF2A",957,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",958,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",959,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",960,0) + ;" Quiet -- OPTIONAL. if 1, then user is not asked. Default=0 +"RTN","TMGNDF2A",961,0) + ;"Results: none +"RTN","TMGNDF2A",962,0) + +"RTN","TMGNDF2A",963,0) + new num set num="" +"RTN","TMGNDF2A",964,0) + set Cancelled=$get(Cancelled,0) +"RTN","TMGNDF2A",965,0) + if $get(Quiet)=1 goto SK1 +"RTN","TMGNDF2A",966,0) + write "For this list of drug TRADENAME:",! +"RTN","TMGNDF2A",967,0) + write "--------------------------------",! +"RTN","TMGNDF2A",968,0) + for set num=$order(EntryList(num)) quit:(num="")!(Cancelled=1) do +"RTN","TMGNDF2A",969,0) + . new IEN,newName +"RTN","TMGNDF2A",970,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",971,0) + . if IEN="" quit +"RTN","TMGNDF2A",972,0) + . set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",973,0) + . write " ",newName," (#",IEN,")",! +"RTN","TMGNDF2A",974,0) + write "--------------------------------",! +"RTN","TMGNDF2A",975,0) + write "Set these drugs to be PERMINANTLY SKIPPED" +"RTN","TMGNDF2A",976,0) + new % set %=2 do YN^DICN write ! +"RTN","TMGNDF2A",977,0) + if %=-1 set Cancelled=1 goto SSDone +"RTN","TMGNDF2A",978,0) + if %=2 goto SSDone +"RTN","TMGNDF2A",979,0) + if %=1 do +"RTN","TMGNDF2A",980,0) +SK1 for set num=$order(EntryList(num)) quit:(num="")!(Cancelled=1) do +"RTN","TMGNDF2A",981,0) + . new IEN,newName +"RTN","TMGNDF2A",982,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",983,0) + . if IEN="" quit +"RTN","TMGNDF2A",984,0) + . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP +"RTN","TMGNDF2A",985,0) + do KillSugg(.Suggestions,.Answers,.EntryList,.Cancelled) +"RTN","TMGNDF2A",986,0) + +"RTN","TMGNDF2A",987,0) +SSDone +"RTN","TMGNDF2A",988,0) + quit +"RTN","TMGNDF2A",989,0) + +"RTN","TMGNDF2A",990,0) + +"RTN","TMGNDF2A",991,0) +ShowAlts(Suggestions,Answers,EntryList,Cancelled) +"RTN","TMGNDF2A",992,0) + ;"Purpose: To show alternate drugs from drugs in Array +"RTN","TMGNDF2A",993,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",994,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",995,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",996,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",997,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",998,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",999,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",1000,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",1001,0) + ;" Format as follows. +"RTN","TMGNDF2A",1002,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",1003,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",1004,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",1005,0) + ;"Results: none +"RTN","TMGNDF2A",1006,0) + +"RTN","TMGNDF2A",1007,0) + new num set num="" +"RTN","TMGNDF2A",1008,0) + set Cancelled=$get(Cancelled,0) +"RTN","TMGNDF2A",1009,0) + new skipList +"RTN","TMGNDF2A",1010,0) + for set num=$order(EntryList(num)) quit:(num="")!(Cancelled=1) do +"RTN","TMGNDF2A",1011,0) + . new IEN,newName,foundList +"RTN","TMGNDF2A",1012,0) + . set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",1013,0) + . if IEN="" quit +"RTN","TMGNDF2A",1014,0) + . set newName=$piece($get(Answers(num)),"^",2) +"RTN","TMGNDF2A",1015,0) + . do GETS^DIQ(22706.9,IEN_",",".04;.05;.07;1;3.5","","TMGA","TMGMSG") +"RTN","TMGNDF2A",1016,0) + . new origName set origName=$get(TMGA(22706.9,IEN_",",.05)) +"RTN","TMGNDF2A",1017,0) + . if origName="" quit +"RTN","TMGNDF2A",1018,0) + . new NameDose set NameDose=origName_" ("_$get(TMGA(22706.9,IEN_",",.07))_") "_$get(TMGA(22706.9,IEN_",",1)) +"RTN","TMGNDF2A",1019,0) + . write !,!,"For drug '",NameDose,"', below are alternatives...",! +"RTN","TMGNDF2A",1020,0) + . do FIND^DIC(22706.9,"",".05","M",origName,"30","B","","","TMGA","TMGMSG") +"RTN","TMGNDF2A",1021,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",1022,0) + . if +$get(TMGA("DILIST",0))=1 do +"RTN","TMGNDF2A",1023,0) + . . do FIND^DIC(22706.9,"",".05","M",$piece(origName," ",1),"30","B","","","TMGA","TMGMSG") +"RTN","TMGNDF2A",1024,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2A",1025,0) + . merge foundList=TMGA("DILIST",2) ;"format foundList(seq#)=IEN22706d9 +"RTN","TMGNDF2A",1026,0) +SAL1 . new numShown set numShown=0 +"RTN","TMGNDF2A",1027,0) + . write "--------------------------",! +"RTN","TMGNDF2A",1028,0) + . if $data(foundList) do +"RTN","TMGNDF2A",1029,0) + . . new seqNum set seqNum="" +"RTN","TMGNDF2A",1030,0) + . . for set seqNum=$order(foundList(seqNum)) quit:(seqNum="") do +"RTN","TMGNDF2A",1031,0) + . . . new TMGA,TMGMSG,IEN2 +"RTN","TMGNDF2A",1032,0) + . . . set IEN2=$get(foundList(seqNum)) +"RTN","TMGNDF2A",1033,0) + . . . if (+IEN2'>0)!(IEN2=IEN) quit +"RTN","TMGNDF2A",1034,0) + . . . if $piece($get(^TMG(22706.9,IEN2,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2A",1035,0) + . . . do GETS^DIQ(22706.9,IEN2_",",".04;.07;1;3.5","","TMGA","TMGMSG") +"RTN","TMGNDF2A",1036,0) + . . . write " ",$get(TMGA(22706.9,IEN2_",",.07)) +"RTN","TMGNDF2A",1037,0) + . . . write " ",$get(TMGA(22706.9,IEN2_",",1)) +"RTN","TMGNDF2A",1038,0) + . . . write " ",$get(TMGA(22706.9,IEN2_",",3.5))," ; " +"RTN","TMGNDF2A",1039,0) + . . . write " ",$get(TMGA(22706.9,IEN2_",",.04)),! +"RTN","TMGNDF2A",1040,0) + . . . set numShown=numShown+1 +"RTN","TMGNDF2A",1041,0) + . if numShown=0 do +"RTN","TMGNDF2A",1042,0) + . . write " -- List is empty --",! +"RTN","TMGNDF2A",1043,0) + . write "--------------------------",! +"RTN","TMGNDF2A",1044,0) + . write "For drug '",NameDose,"', above alternatives were found:",! +"RTN","TMGNDF2A",1045,0) + . write !,"If a similar drug is seen in list above, then SKIP is OK",! +"RTN","TMGNDF2A",1046,0) + . write "Set '",NameDose,"'",! +"RTN","TMGNDF2A",1047,0) + . write " to be PERMINANTLY SKIPPED" +"RTN","TMGNDF2A",1048,0) + . new % set %=2 do YN^DICN write ! +"RTN","TMGNDF2A",1049,0) + . if %=-1 set Cancelled=1 quit +"RTN","TMGNDF2A",1050,0) + . if %=1 set skipList(num)="" quit +"RTN","TMGNDF2A",1051,0) + . set %=2 +"RTN","TMGNDF2A",1052,0) + . write "Lookup a comparison manually" do YN^DICN write ! +"RTN","TMGNDF2A",1053,0) + . if %=-1 set Cancelled=1 quit +"RTN","TMGNDF2A",1054,0) + . if %=2 quit +"RTN","TMGNDF2A",1055,0) + . if %=1 do goto SAL1 +"RTN","TMGNDF2A",1056,0) + . . new DIC,X,Y +"RTN","TMGNDF2A",1057,0) + . . set DIC=22706.9,DIC(0)="MAEQ" +"RTN","TMGNDF2A",1058,0) + . . do ^DIC write ! +"RTN","TMGNDF2A",1059,0) + . . if Y=-1 write !,"NO MATCH.",!,! +"RTN","TMGNDF2A",1060,0) + +"RTN","TMGNDF2A",1061,0) + +"RTN","TMGNDF2A",1062,0) + if $data(skipList) do +"RTN","TMGNDF2A",1063,0) + . do SetSkip(.Suggestions,.Answers,.skipList,.Cancelled,1) +"RTN","TMGNDF2A",1064,0) + +"RTN","TMGNDF2A",1065,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2A",1066,0) + +"RTN","TMGNDF2A",1067,0) + quit +"RTN","TMGNDF2A",1068,0) + +"RTN","TMGNDF2A",1069,0) + +"RTN","TMGNDF2A",1070,0) +KillSugg(Array,Answers,EntryList,Cancelled) +"RTN","TMGNDF2A",1071,0) + ;"Purpose: To accept new suggested name from Array +"RTN","TMGNDF2A",1072,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, +"RTN","TMGNDF2A",1073,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",1074,0) + ;" Array(IEN)=SuggestedNewTradeName +"RTN","TMGNDF2A",1075,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF2A",1076,0) + ;" Array should be the one created by DispSuggestions() +"RTN","TMGNDF2A",1077,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",1078,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",1079,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2A",1080,0) + ;" Format as follows. +"RTN","TMGNDF2A",1081,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",1082,0) + ;" List(Entry number)="" +"RTN","TMGNDF2A",1083,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF2A",1084,0) + ;"Results: none +"RTN","TMGNDF2A",1085,0) + +"RTN","TMGNDF2A",1086,0) + new num set num="" +"RTN","TMGNDF2A",1087,0) + for set num=$order(EntryList(num)) quit:(num="") do +"RTN","TMGNDF2A",1088,0) + . new IEN set IEN=$piece($get(Answers(num)),"^",1) +"RTN","TMGNDF2A",1089,0) + . kill Answers(num) +"RTN","TMGNDF2A",1090,0) + . kill Array(IEN) +"RTN","TMGNDF2A",1091,0) + +"RTN","TMGNDF2A",1092,0) + quit +"RTN","TMGNDF2A",1093,0) + +"RTN","TMGNDF2A",1094,0) + +"RTN","TMGNDF2A",1095,0) +DispSuggestions(Suggestions,Answers,Compact) +"RTN","TMGNDF2A",1096,0) + ;"Purpose: to display list of Suggested name changes +"RTN","TMGNDF2A",1097,0) + ;"Input: Suggestions -- PASS BY REFERENCE. Format: +"RTN","TMGNDF2A",1098,0) + ;" Suggestions(IEN)=SuggestedNameForTradeName +"RTN","TMGNDF2A",1099,0) + ;" Suggestions(IEN)=SuggestedNameForTradeName +"RTN","TMGNDF2A",1100,0) + ;" Answers -- PASS BY REFERENCE. Format: +"RTN","TMGNDF2A",1101,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",1102,0) + ;" Answers(DispNum)=IEN^SuggestedNameForTradeName +"RTN","TMGNDF2A",1103,0) + ;" Compact -- OPTIONAL, Default=0. If 1, only first part of list shown. +"RTN","TMGNDF2A",1104,0) + ;"Results: None +"RTN","TMGNDF2A",1105,0) + +"RTN","TMGNDF2A",1106,0) + kill Answers +"RTN","TMGNDF2A",1107,0) + new count set count=0 +"RTN","TMGNDF2A",1108,0) + set Compact=+$get(Compact) +"RTN","TMGNDF2A",1109,0) + new IEN set IEN="" +"RTN","TMGNDF2A",1110,0) + for set IEN=$order(Suggestions(IEN)) quit:(IEN="")!((Compact=1)&(count>10)) do +"RTN","TMGNDF2A",1111,0) + . new newName set newName=$get(Suggestions(IEN)) +"RTN","TMGNDF2A",1112,0) + . set count=count+1 +"RTN","TMGNDF2A",1113,0) + . write count,". ",newName,! +"RTN","TMGNDF2A",1114,0) + . set Answers(count)=IEN_"^"_newName +"RTN","TMGNDF2A",1115,0) + if count=0 do +"RTN","TMGNDF2A",1116,0) + . write " -- List is Empty --",! +"RTN","TMGNDF2A",1117,0) + +"RTN","TMGNDF2A",1118,0) + quit +"RTN","TMGNDF2A",1119,0) + +"RTN","TMGNDF2C") +0^43^B7038 +"RTN","TMGNDF2C",1,0) +TMGNDF2C ;TMG/kst/FDA Import: Fill VA GENERIC entries;03/25/06 +"RTN","TMGNDF2C",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF2C",3,0) + +"RTN","TMGNDF2C",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2C",5,0) + ;" -- FILLING VA GENERIC FILE WITH NEW VALUES +"RTN","TMGNDF2C",6,0) + ;" -- and linking field .08 (VA GENERIC) in file TMG FDA IMPORT with links to apprpriate values. +"RTN","TMGNDF2C",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2C",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2C",9,0) + ;"11-21-2006 +"RTN","TMGNDF2C",10,0) + +"RTN","TMGNDF2C",11,0) + ;"======================================================================= +"RTN","TMGNDF2C",12,0) + ;" API -- Public Functions. +"RTN","TMGNDF2C",13,0) + ;"======================================================================= +"RTN","TMGNDF2C",14,0) + ;"Menu +"RTN","TMGNDF2C",15,0) + ;"======================================================================= +"RTN","TMGNDF2C",16,0) + ;"FillGenerics -- scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs +"RTN","TMGNDF2C",17,0) + ;" have been added into the VA GENERIC file, or that a link exists between a +"RTN","TMGNDF2C",18,0) + ;" GENERIC name and an existing VA GENERIC name. +"RTN","TMGNDF2C",19,0) + ;" Then use this data and fill in field .08 in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF2C",20,0) + +"RTN","TMGNDF2C",21,0) + ;"======================================================================= +"RTN","TMGNDF2C",22,0) + ;" Private Functions. +"RTN","TMGNDF2C",23,0) + ;"======================================================================= +"RTN","TMGNDF2C",24,0) + ;"CheckGenerics(Results) +"RTN","TMGNDF2C",25,0) + ;"Rescan(Array,Label,number) +"RTN","TMGNDF2C",26,0) + ;"FindSimGenerics(Generic,Array) +"RTN","TMGNDF2C",27,0) + ;"NarrowGenMatches(Generic,Array) +"RTN","TMGNDF2C",28,0) + ;"FindGenContain(name,Array) +"RTN","TMGNDF2C",29,0) + ;"Scan4Generics(Array) +"RTN","TMGNDF2C",30,0) + ;"Unlock50dot6 +"RTN","TMGNDF2C",31,0) + ;"Lock50dot6 +"RTN","TMGNDF2C",32,0) + ;"ShowList(Array,Label) +"RTN","TMGNDF2C",33,0) + ;"ProcessList(Array) -- handle adding generic names, returning a list of linkages +"RTN","TMGNDF2C",34,0) + ;"HandleAdds(Array) -- handle adding those entries in Array that need to be added to VA GENERIC file. +"RTN","TMGNDF2C",35,0) + ;"Remove(Array,Label,Num,EndNum) -- remove name(s) from Array of additions to VA GENERIC file +"RTN","TMGNDF2C",36,0) + ;"CustLookup(Array,Label,Num) -- manually link entry in Array to an existing entry in VA GENERIC file +"RTN","TMGNDF2C",37,0) + ;"DoAdds(Array,Label,Num,EndNum) -- extract name(s) from Array and add to VA GENERIC file, via Add1Generic +"RTN","TMGNDF2C",38,0) + ;"Add1Generic(Name) -- add on entry to the VA GENERIC FILE +"RTN","TMGNDF2C",39,0) + ;"HandleQAdds(Array) -- review 'Uncertain Matches' node of Array and allow user to specify whether +"RTN","TMGNDF2C",40,0) + ;"DoLinks(Array,Num,EndNum) -- change a link from the "Uncertain Matches" node, to a formal link +"RTN","TMGNDF2C",41,0) + ;"DoMltLink(Array,Num,TMGGeneric) -- interact with user and pick which link (amoung multiple) +"RTN","TMGNDF2C",42,0) + ;"FillCompFile(Array) -- fill in field .08 in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF2C",43,0) + +"RTN","TMGNDF2C",44,0) + ;"======================================================================= +"RTN","TMGNDF2C",45,0) + ;"======================================================================= +"RTN","TMGNDF2C",46,0) + +"RTN","TMGNDF2C",47,0) +Menu +"RTN","TMGNDF2C",48,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF2C",49,0) + +"RTN","TMGNDF2C",50,0) + new Menu,UsrSlct +"RTN","TMGNDF2C",51,0) + set Menu(0)="Pick Option for filling VA GENERIC entries (2C)" +"RTN","TMGNDF2C",52,0) + set Menu(1)="Ensure link between import GENERIC name, and VA GENERIC name"_$char(9)_"FillGenerics" +"RTN","TMGNDF2C",53,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF2C",54,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF2C",55,0) + +"RTN","TMGNDF2C",56,0) +MC1 write # +"RTN","TMGNDF2C",57,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2C",58,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF2C",59,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF2C",60,0) + +"RTN","TMGNDF2C",61,0) + if UsrSlct="FillGenerics" do FillGenerics goto MC1 +"RTN","TMGNDF2C",62,0) + if UsrSlct="Prev" goto Menu^TMGNDF2A ;"quit can occur from there... +"RTN","TMGNDF2C",63,0) + if UsrSlct="Next" goto Menu^TMGNDF2E ;"quit can occur from there... +"RTN","TMGNDF2C",64,0) + goto MC1 +"RTN","TMGNDF2C",65,0) + +"RTN","TMGNDF2C",66,0) +MCDone +"RTN","TMGNDF2C",67,0) + quit +"RTN","TMGNDF2C",68,0) + +"RTN","TMGNDF2C",69,0) + +"RTN","TMGNDF2C",70,0) +FillGenerics +"RTN","TMGNDF2C",71,0) + ;"Purpose: To scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs +"RTN","TMGNDF2C",72,0) + ;" have been added into the VA GENERIC file, or that a link exists between a +"RTN","TMGNDF2C",73,0) + ;" GENERIC name and an existing VA GENERIC name. +"RTN","TMGNDF2C",74,0) + ;" Then use this data and fill in field .08 in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF2C",75,0) + +"RTN","TMGNDF2C",76,0) + new list +"RTN","TMGNDF2C",77,0) + +"RTN","TMGNDF2C",78,0) + write # +"RTN","TMGNDF2C",79,0) + write "======================================================",! +"RTN","TMGNDF2C",80,0) + write "Link FDA import entries to entries in VA GENERIC file",! +"RTN","TMGNDF2C",81,0) + write "======================================================",!,! +"RTN","TMGNDF2C",82,0) + new list +"RTN","TMGNDF2C",83,0) + if $data(^TMG("templist")) do +"RTN","TMGNDF2C",84,0) + . write "Data from another work run found. Continue to use this" +"RTN","TMGNDF2C",85,0) + . new % set %=1 do YN^DICN write ! +"RTN","TMGNDF2C",86,0) + . if %=1 merge list=^TMG("templist") +"RTN","TMGNDF2C",87,0) + . if %=2 do +"RTN","TMGNDF2C",88,0) + . . write "Delete old data from prior run" +"RTN","TMGNDF2C",89,0) + . . set %=2 do YN^DICN write ! +"RTN","TMGNDF2C",90,0) + . . if %=1 kill ^TMG("templist"),list +"RTN","TMGNDF2C",91,0) + . . do CheckGenerics(.list) +"RTN","TMGNDF2C",92,0) + else do CheckGenerics(.list) +"RTN","TMGNDF2C",93,0) + kill ^TMG("templist") +"RTN","TMGNDF2C",94,0) + +"RTN","TMGNDF2C",95,0) + if $data(list)=0 goto FGDone +"RTN","TMGNDF2C",96,0) + +"RTN","TMGNDF2C",97,0) + do ProcessList(.list) +"RTN","TMGNDF2C",98,0) + merge ^TMG("templist")=list +"RTN","TMGNDF2C",99,0) + write "Use data to fill in VA GENERIC field in TMG FDA IMPORT COMPILED now" +"RTN","TMGNDF2C",100,0) + set %=1 do YN^DICN write ! +"RTN","TMGNDF2C",101,0) + if %=1 do FillCompFile(.list) +"RTN","TMGNDF2C",102,0) + +"RTN","TMGNDF2C",103,0) +FGDone +"RTN","TMGNDF2C",104,0) + write "Goodbye.",! +"RTN","TMGNDF2C",105,0) + quit +"RTN","TMGNDF2C",106,0) + +"RTN","TMGNDF2C",107,0) + +"RTN","TMGNDF2C",108,0) +CheckGenerics(Results) +"RTN","TMGNDF2C",109,0) + ;"Purpose: To scan TMG FDA IMPORT file and make sure that all of the GENERIC NAMEs +"RTN","TMGNDF2C",110,0) + ;" have been added into the VA GENERIC file, or that a link exists between a +"RTN","TMGNDF2C",111,0) + ;" GENERIC NAME and an existing VA GENERIC name. +"RTN","TMGNDF2C",112,0) + ;"Input: Results -- PASS BY REFERENCE, and OUT PARAMETER. Returns array with results. +"RTN","TMGNDF2C",113,0) + +"RTN","TMGNDF2C",114,0) + new Array,i +"RTN","TMGNDF2C",115,0) + write "Collecting list of imports not linked to a VA GENERIC entry.",! +"RTN","TMGNDF2C",116,0) + do Scan4Generics(.Array) ;"note: result Array will not include SKIPPED records +"RTN","TMGNDF2C",117,0) + if $data(Array)=0 do goto CGDone +"RTN","TMGNDF2C",118,0) + . write "No unmatched entries found--great!",! +"RTN","TMGNDF2C",119,0) + +"RTN","TMGNDF2C",120,0) + write "Processing GENERIC names...",! +"RTN","TMGNDF2C",121,0) + +"RTN","TMGNDF2C",122,0) + new DIC,X,Y +"RTN","TMGNDF2C",123,0) + set DIC=50.6 +"RTN","TMGNDF2C",124,0) + set DIC(0)="M" ;"multiple index, LAYGO (add if not found) +"RTN","TMGNDF2C",125,0) + +"RTN","TMGNDF2C",126,0) + new abort set abort=0 +"RTN","TMGNDF2C",127,0) + new temp set temp="" +"RTN","TMGNDF2C",128,0) + new count set count=1 +"RTN","TMGNDF2C",129,0) + new TMGGeneric +"RTN","TMGNDF2C",130,0) + new Itr,i +"RTN","TMGNDF2C",131,0) + set i=$$ItrAInit^TMGITR("Array",.Itr) +"RTN","TMGNDF2C",132,0) + do PrepProgress^TMGITR(.Itr,20,1,"i") +"RTN","TMGNDF2C",133,0) + if i'="" for do quit:($$ItrANext^TMGITR(.Itr,.i)="")!abort +"RTN","TMGNDF2C",134,0) + . set X=i,TMGGeneric=i +"RTN","TMGNDF2C",135,0) + . set DIC(0)="M" do ^DIC +"RTN","TMGNDF2C",136,0) + . if Y=-1 set DIC(0)="MX" do ^DIC +"RTN","TMGNDF2C",137,0) + . if +Y>0 do quit +"RTN","TMGNDF2C",138,0) + . . set Results("Uncertain Matches",count,TMGGeneric,$piece(Y,"^",2))=Y +"RTN","TMGNDF2C",139,0) + . . set count=count+1 +"RTN","TMGNDF2C",140,0) + . new list +"RTN","TMGNDF2C",141,0) + . do FindSimGenerics(TMGGeneric,.list) +"RTN","TMGNDF2C",142,0) + . if $data(list) do +"RTN","TMGNDF2C",143,0) + . . merge Results("Uncertain Matches",count,TMGGeneric)=list +"RTN","TMGNDF2C",144,0) + . . set count=count+1 ;"is this right??? +"RTN","TMGNDF2C",145,0) + . else do +"RTN","TMGNDF2C",146,0) + . . set Results("Should Add",count,TMGGeneric)="" +"RTN","TMGNDF2C",147,0) + . . set count=count+1 +"RTN","TMGNDF2C",148,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2C",149,0) + +"RTN","TMGNDF2C",150,0) +CGDone +"RTN","TMGNDF2C",151,0) + quit +"RTN","TMGNDF2C",152,0) + +"RTN","TMGNDF2C",153,0) +Rescan(Array,Label,number) +"RTN","TMGNDF2C",154,0) + ;"Purpose: to allow rescan of one entry +"RTN","TMGNDF2C",155,0) + ;"Input: Array -- PASS BY REFERENCE -- Array with drug lists, as used by CheckGenerics +"RTN","TMGNDF2C",156,0) + ;" Label -- i.e. "Uncertain Matches", or "Should Add" +"RTN","TMGNDF2C",157,0) + ;" number -- the number of the listing to rescan +"RTN","TMGNDF2C",158,0) + ;" NOTE: This affects Results from a global scope +"RTN","TMGNDF2C",159,0) + ;" ??? Was this intended ??? +"RTN","TMGNDF2C",160,0) + ;"Output: +"RTN","TMGNDF2C",161,0) + ;"results: none +"RTN","TMGNDF2C",162,0) + +"RTN","TMGNDF2C",163,0) + new DIC,X,Y +"RTN","TMGNDF2C",164,0) + set DIC=50.6 +"RTN","TMGNDF2C",165,0) + set DIC(0)="M" ;"multiple index, LAYGO (add if not found) +"RTN","TMGNDF2C",166,0) + +"RTN","TMGNDF2C",167,0) + set X=$order(Array(Label,number,"")) +"RTN","TMGNDF2C",168,0) + if X'="" do +"RTN","TMGNDF2C",169,0) + . do ^DIC +"RTN","TMGNDF2C",170,0) + . if +Y'>0 do +"RTN","TMGNDF2C",171,0) + . . new list +"RTN","TMGNDF2C",172,0) + . . do FindSimGenerics(X,.list) +"RTN","TMGNDF2C",173,0) + . . if $data(list) do +"RTN","TMGNDF2C",174,0) + . . . merge Results("Uncertain Matches",number,X)=list +"RTN","TMGNDF2C",175,0) + . . else do +"RTN","TMGNDF2C",176,0) + . . . set Results("Should Add",number,X)="" +"RTN","TMGNDF2C",177,0) + . else set Results(X)=Y +"RTN","TMGNDF2C",178,0) + +"RTN","TMGNDF2C",179,0) + quit +"RTN","TMGNDF2C",180,0) + +"RTN","TMGNDF2C",181,0) + +"RTN","TMGNDF2C",182,0) +FindSimGenerics(Generic,Array) +"RTN","TMGNDF2C",183,0) + ;"Purpose: to scan VA GENERIC file and return an array of similar entries. +"RTN","TMGNDF2C",184,0) + ;"Input: Generic: the name of the generic drug name to scan for +"RTN","TMGNDF2C",185,0) + ;" Array: PASS BY REFERENCE, and OUT PARAMETER -- prior entries are killed +"RTN","TMGNDF2C",186,0) + ;"Result: none (output is in Array) +"RTN","TMGNDF2C",187,0) + +"RTN","TMGNDF2C",188,0) + new i,i2,s +"RTN","TMGNDF2C",189,0) + kill Array +"RTN","TMGNDF2C",190,0) + new NumRxs +"RTN","TMGNDF2C",191,0) + set NumRxs=$length(Generic,"/") +"RTN","TMGNDF2C",192,0) + +"RTN","TMGNDF2C",193,0) + set i2=$order(^PSNDF(50.6,0)) +"RTN","TMGNDF2C",194,0) + if i2'="" for do quit:(i2="") +"RTN","TMGNDF2C",195,0) + . new VAGeneric set VAGeneric=$piece($get(^PSNDF(50.6,i2,0)),"^",1) +"RTN","TMGNDF2C",196,0) + . new IEN set IEN=i2 +"RTN","TMGNDF2C",197,0) + . set i2=$order(^PSNDF(50.6,i2)) +"RTN","TMGNDF2C",198,0) + . if NumRxs'=$length(VAGeneric,"/") quit +"RTN","TMGNDF2C",199,0) + . new temp set temp=VAGeneric +"RTN","TMGNDF2C",200,0) + . for i=1:1:NumRxs do quit:(s="")!(temp="") +"RTN","TMGNDF2C",201,0) + . . set s=$piece(Generic,"/",i) +"RTN","TMGNDF2C",202,0) + . . set s=$piece(s," ",1) ;"get first word of multi-word drug name +"RTN","TMGNDF2C",203,0) + . . if s="" quit +"RTN","TMGNDF2C",204,0) + . . if $extract(VAGeneric,1,$length(s))'=s set temp="" +"RTN","TMGNDF2C",205,0) + . if temp'="" do +"RTN","TMGNDF2C",206,0) + . . set Array(VAGeneric)=IEN_"^"_VAGeneric +"RTN","TMGNDF2C",207,0) + +"RTN","TMGNDF2C",208,0) + new count +"RTN","TMGNDF2C",209,0) + set count=$$ListCt^TMGMISC("Array") +"RTN","TMGNDF2C",210,0) + if count>1 do +"RTN","TMGNDF2C",211,0) + . do NarrowGenMatches(Generic,.Array) +"RTN","TMGNDF2C",212,0) + . if (($$ListCt^TMGMISC("Array")/count)>0.5)&(count>5) do ;"i.e. no improvement +"RTN","TMGNDF2C",213,0) + . . kill Array +"RTN","TMGNDF2C",214,0) + +"RTN","TMGNDF2C",215,0) + quit +"RTN","TMGNDF2C",216,0) + +"RTN","TMGNDF2C",217,0) + +"RTN","TMGNDF2C",218,0) +NarrowGenMatches(Generic,Array,DivCh) +"RTN","TMGNDF2C",219,0) + ;"Purpose: To take a number of matches, and weed out bad matches (narrow down the list). +"RTN","TMGNDF2C",220,0) + ;"Input: Generic -- Name of Generic name that ideal match should equal +"RTN","TMGNDF2C",221,0) + ;" Array -- PASS BY REFERENCE, the array that needs trimming. +"RTN","TMGNDF2C",222,0) + ;" DivCH -- OPTIONAL, default="/" +"RTN","TMGNDF2C",223,0) + ;"Output: Array will be thinned if possible. +"RTN","TMGNDF2C",224,0) + ;"Results: none +"RTN","TMGNDF2C",225,0) + +"RTN","TMGNDF2C",226,0) + new i,j,result +"RTN","TMGNDF2C",227,0) + new MaxScore set MaxScore=0 +"RTN","TMGNDF2C",228,0) + set DivCh=$get(DivCh,"/") +"RTN","TMGNDF2C",229,0) + +"RTN","TMGNDF2C",230,0) + set i=$order(Array("")) +"RTN","TMGNDF2C",231,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF2C",232,0) + . new score set score=0 +"RTN","TMGNDF2C",233,0) + . for j=1:1:$length(i,DivCh) do +"RTN","TMGNDF2C",234,0) + . . new GenIgd,ArrayIgd +"RTN","TMGNDF2C",235,0) + . . set GenIgd=$piece(Generic,DivCh,j) +"RTN","TMGNDF2C",236,0) + . . set ArrayIgd=$piece(i,DivCh,j) +"RTN","TMGNDF2C",237,0) + . . set score=score+$$Comp2Strs^TMGSTUTL(GenIgd,ArrayIgd) +"RTN","TMGNDF2C",238,0) + . if score>MaxScore set MaxScore=score +"RTN","TMGNDF2C",239,0) + . if score'0) +"RTN","TMGNDF2C",294,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2C",295,0) + . set name=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME +"RTN","TMGNDF2C",296,0) + . set VAGeneric=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"get field#.08, VA GENERIC +"RTN","TMGNDF2C",297,0) + . if (+name'=name)&(name'="")&(+VAGeneric=0) do +"RTN","TMGNDF2C",298,0) + . . set Array(name)="" +"RTN","TMGNDF2C",299,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2C",300,0) + +"RTN","TMGNDF2C",301,0) + quit +"RTN","TMGNDF2C",302,0) + +"RTN","TMGNDF2C",303,0) + +"RTN","TMGNDF2C",304,0) +ScanNoGenerics(Array) +"RTN","TMGNDF2C",305,0) + ;"Purpose: To scan TMG FDA IMPORT file and collect all entries into the array +"RTN","TMGNDF2C",306,0) + ;" where there is NO GENERIC NAME is provided, and VAGeneric pointer is NULL +"RTN","TMGNDF2C",307,0) + ;"Input -- Array -- PASS BY REFERENCE. An Out parameter +"RTN","TMGNDF2C",308,0) + ;"Results -- the Array is filled with names of drugs missing GENERICS NAME & VAGeneric Ptr +"RTN","TMGNDF2C",309,0) + ;" This will skip records marked to be skipped. +"RTN","TMGNDF2C",310,0) + +"RTN","TMGNDF2C",311,0) + new IEN +"RTN","TMGNDF2C",312,0) + new name,VAGeneric +"RTN","TMGNDF2C",313,0) + +"RTN","TMGNDF2C",314,0) + set IEN=$order(^TMG(22706.9,"")) +"RTN","TMGNDF2C",315,0) + if IEN'="" for do quit:(+IEN'>0) +"RTN","TMGNDF2C",316,0) + . new skip set skip=$piece($get(^TMG(22706.9,IEN,1)),"^",4) +"RTN","TMGNDF2C",317,0) + . if skip=0 do +"RTN","TMGNDF2C",318,0) + . . set name=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"get field#.07, GENERIC NAME +"RTN","TMGNDF2C",319,0) + . . set VAGeneric=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"get field#.08, VA GENERIC +"RTN","TMGNDF2C",320,0) + . . if (name="")&(+VAGeneric=0) do +"RTN","TMGNDF2C",321,0) + . . . if name["ALLERGENIC EXTRACT" quit ;"skip all these... I don't want them +"RTN","TMGNDF2C",322,0) + . . . new tradeName set tradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"get field#.05, TRADENAME +"RTN","TMGNDF2C",323,0) + . . . set Array(tradeName)="" +"RTN","TMGNDF2C",324,0) + . set IEN=$order(^TMG(22706.9,IEN)) +"RTN","TMGNDF2C",325,0) + +"RTN","TMGNDF2C",326,0) + quit +"RTN","TMGNDF2C",327,0) + +"RTN","TMGNDF2C",328,0) + +"RTN","TMGNDF2C",329,0) + +"RTN","TMGNDF2C",330,0) +Unlock50dot6 +"RTN","TMGNDF2C",331,0) + ;"note: could just set DUZ(0)="^" and not remove this... +"RTN","TMGNDF2C",332,0) + +"RTN","TMGNDF2C",333,0) + ;"Purpose: to remove the write restrictions for file 50.6 +"RTN","TMGNDF2C",334,0) + +"RTN","TMGNDF2C",335,0) + kill ^DIC(50.6,0,"LAYGO") +"RTN","TMGNDF2C",336,0) + kill ^DIC(50.6,0,"WR") +"RTN","TMGNDF2C",337,0) + kill ^DIC(50.6,0,"DEL") +"RTN","TMGNDF2C",338,0) + kill ^DD(50.6,.01,9) +"RTN","TMGNDF2C",339,0) + kill ^DD(50.6,.01,"DEL",.01,0) +"RTN","TMGNDF2C",340,0) + +"RTN","TMGNDF2C",341,0) + set XPDGREF=1 +"RTN","TMGNDF2C",342,0) + +"RTN","TMGNDF2C",343,0) + quit +"RTN","TMGNDF2C",344,0) + +"RTN","TMGNDF2C",345,0) + +"RTN","TMGNDF2C",346,0) +Lock50dot6 +"RTN","TMGNDF2C",347,0) + ;"Purpose: to restore the write restrictions for file 50.6 +"RTN","TMGNDF2C",348,0) + +"RTN","TMGNDF2C",349,0) + set ^DIC(50.6,0,"LAYGO")="^" +"RTN","TMGNDF2C",350,0) + set ^DIC(50.6,0,"WR")="^" +"RTN","TMGNDF2C",351,0) + set ^DIC(50.6,0,"DEL")="^" +"RTN","TMGNDF2C",352,0) + set ^DD(50.6,.01,9)="^" +"RTN","TMGNDF2C",353,0) + set ^DD(50.6,.01,"DEL",.01,0)="I 1 D EN^DDIOL(""DELETIONS ARE NOT ALLOWED"")" +"RTN","TMGNDF2C",354,0) + +"RTN","TMGNDF2C",355,0) + kill XPDGREF +"RTN","TMGNDF2C",356,0) + +"RTN","TMGNDF2C",357,0) + quit +"RTN","TMGNDF2C",358,0) + +"RTN","TMGNDF2C",359,0) + +"RTN","TMGNDF2C",360,0) +ShowList(Array,Label) +"RTN","TMGNDF2C",361,0) + ;"Purpose: To display the list generated by CheckGenerics +"RTN","TMGNDF2C",362,0) + ;"Input: Array -- the array containing the data +"RTN","TMGNDF2C",363,0) + ;" Label -- the name of the node to display +"RTN","TMGNDF2C",364,0) + +"RTN","TMGNDF2C",365,0) + new count,ingredient,value,first +"RTN","TMGNDF2C",366,0) + new someShown set someShown=0 +"RTN","TMGNDF2C",367,0) + set count=$order(Array(Label,"")) +"RTN","TMGNDF2C",368,0) + if count'="" for do quit:(count="") +"RTN","TMGNDF2C",369,0) + . new TMGGeneric,VAGeneric +"RTN","TMGNDF2C",370,0) + . set TMGGeneric=$order(Array(Label,count,"")) +"RTN","TMGNDF2C",371,0) + . set first=1 +"RTN","TMGNDF2C",372,0) + . set someShown=1 +"RTN","TMGNDF2C",373,0) + . set VAGeneric=$order(Array(Label,count,TMGGeneric,"")) +"RTN","TMGNDF2C",374,0) + . if VAGeneric'="" for do quit:(VAGeneric="") +"RTN","TMGNDF2C",375,0) + . . new next set next=$order(Array(Label,count,TMGGeneric,VAGeneric)) +"RTN","TMGNDF2C",376,0) + . . if first=1 do +"RTN","TMGNDF2C",377,0) + . . . if next'="" do +"RTN","TMGNDF2C",378,0) + . . . . write count,". ",TMGGeneric," ---> (multiple)",! +"RTN","TMGNDF2C",379,0) + . . . . write " ---> ",VAGeneric,! +"RTN","TMGNDF2C",380,0) + . . . else do +"RTN","TMGNDF2C",381,0) + . . . . write count,". ",TMGGeneric," ---> ",VAGeneric,! +"RTN","TMGNDF2C",382,0) + . . . set first=0 +"RTN","TMGNDF2C",383,0) + . . else write " ---> ",VAGeneric,! +"RTN","TMGNDF2C",384,0) + . . set VAGeneric=$order(Array(Label,count,TMGGeneric,VAGeneric)) +"RTN","TMGNDF2C",385,0) + . else do +"RTN","TMGNDF2C",386,0) + . . write count,". ",TMGGeneric,! +"RTN","TMGNDF2C",387,0) + . set count=$order(Array(Label,count)) +"RTN","TMGNDF2C",388,0) + +"RTN","TMGNDF2C",389,0) + if someShown=0 do +"RTN","TMGNDF2C",390,0) + . write " --- (List is Empty) ---",! +"RTN","TMGNDF2C",391,0) + +"RTN","TMGNDF2C",392,0) + quit +"RTN","TMGNDF2C",393,0) + +"RTN","TMGNDF2C",394,0) +ProcessList(Array) +"RTN","TMGNDF2C",395,0) + ;"Purpose: After list of linkages between GENERIC NAMEs and VA GENERIC names +"RTN","TMGNDF2C",396,0) + ;" is created by CheckGenerics(), then this function will handle adding those +"RTN","TMGNDF2C",397,0) + ;" generic names that need adding, and returning a list of linkages to use those +"RTN","TMGNDF2C",398,0) + ;" cases there an entry already exists that is not exactly the same, but will be +"RTN","TMGNDF2C",399,0) + ;" used as equivalent. +"RTN","TMGNDF2C",400,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics +"RTN","TMGNDF2C",401,0) + ;" Results are passed back in Array +"RTN","TMGNDF2C",402,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",403,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",404,0) + ;"Results: none +"RTN","TMGNDF2C",405,0) + +"RTN","TMGNDF2C",406,0) + new datafound,abort +"RTN","TMGNDF2C",407,0) + set abort=0 +"RTN","TMGNDF2C",408,0) + +"RTN","TMGNDF2C",409,0) + for do quit:(datafound=0)!(abort=1) +"RTN","TMGNDF2C",410,0) + . set datafound=0 +"RTN","TMGNDF2C",411,0) + . if $data(Array("Should Add"))>0 do quit:(abort=1) +"RTN","TMGNDF2C",412,0) + . . set datafound=1 +"RTN","TMGNDF2C",413,0) + . . write !!,"There are entries that should be added to the VA GENERIC file",! +"RTN","TMGNDF2C",414,0) + . . write "Process now (^ to abort)" +"RTN","TMGNDF2C",415,0) + . . new % set %=1 ;"default to YES +"RTN","TMGNDF2C",416,0) + . . do YN^DICN write ! +"RTN","TMGNDF2C",417,0) + . . if %=-1 set abort=1 quit +"RTN","TMGNDF2C",418,0) + . . if %=1 do HandleAdds(.Array) +"RTN","TMGNDF2C",419,0) + . if $data(Array("Uncertain Matches"))>0 do +"RTN","TMGNDF2C",420,0) + . . set datafound=1 +"RTN","TMGNDF2C",421,0) + . . write !!,"There are presumed linkages that need approval.",! +"RTN","TMGNDF2C",422,0) + . . write "Process now (^ to abort)" +"RTN","TMGNDF2C",423,0) + . . new % set %=1 ;"default to YES +"RTN","TMGNDF2C",424,0) + . . do YN^DICN write ! +"RTN","TMGNDF2C",425,0) + . . if %=-1 set abort=1 quit +"RTN","TMGNDF2C",426,0) + . . if %=1 do HandleQAdds(.Array) +"RTN","TMGNDF2C",427,0) + +"RTN","TMGNDF2C",428,0) + quit +"RTN","TMGNDF2C",429,0) + +"RTN","TMGNDF2C",430,0) + +"RTN","TMGNDF2C",431,0) +HandleAdds(Array) +"RTN","TMGNDF2C",432,0) + ;"Purpose: To handle adding those entries in Array that need to be added to VA GENERIC file. +"RTN","TMGNDF2C",433,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics +"RTN","TMGNDF2C",434,0) + ;" Results are passed back in Array +"RTN","TMGNDF2C",435,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",436,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",437,0) + ;"Output: results returned in Array, as above. +"RTN","TMGNDF2C",438,0) + ;"Results: none +"RTN","TMGNDF2C",439,0) + +"RTN","TMGNDF2C",440,0) + do Unlock50dot6 +"RTN","TMGNDF2C",441,0) + +"RTN","TMGNDF2C",442,0) + new done set done=0 +"RTN","TMGNDF2C",443,0) + new input set input="R" +"RTN","TMGNDF2C",444,0) + +"RTN","TMGNDF2C",445,0) + for do quit:(done=1) +"RTN","TMGNDF2C",446,0) + . if input="R" do +"RTN","TMGNDF2C",447,0) + . . write !! +"RTN","TMGNDF2C",448,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",449,0) + . . write "Specify which GENERIC names are OK for ADDITION to VA GENERIC file",! +"RTN","TMGNDF2C",450,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",451,0) + . . do ShowList(.Array,"Should Add") +"RTN","TMGNDF2C",452,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",453,0) + . . write "Specify which GENERIC names are OK for ADDITION to VA GENERIC file",! +"RTN","TMGNDF2C",454,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",455,0) + . write " R to refresh, L lookup, ? for instructions",! +"RTN","TMGNDF2C",456,0) + . write " # or #-#, ^ to continue, X remove from list",! +"RTN","TMGNDF2C",457,0) + . write "Enter number(s) to ACCEPT (or codes listed above): ^//" +"RTN","TMGNDF2C",458,0) + . read input,! +"RTN","TMGNDF2C",459,0) + . if input="" set input="^" +"RTN","TMGNDF2C",460,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2C",461,0) + . if input="^" set done=1 +"RTN","TMGNDF2C",462,0) + . if (input="?") do +"RTN","TMGNDF2C",463,0) + . . ;"do ShowInstructions +"RTN","TMGNDF2C",464,0) + . . set input="R" +"RTN","TMGNDF2C",465,0) + . if +input=input do +"RTN","TMGNDF2C",466,0) + . . do DoAdds(.Array,"Should Add",+input) +"RTN","TMGNDF2C",467,0) + . . set input="R" +"RTN","TMGNDF2C",468,0) + . if input["-" do +"RTN","TMGNDF2C",469,0) + . . new N1,N2 +"RTN","TMGNDF2C",470,0) + . . set N1=$piece(input,"-",1) +"RTN","TMGNDF2C",471,0) + . . set N2=$piece(input,"-",2) +"RTN","TMGNDF2C",472,0) + . . do DoAdds(.Array,"Should Add",N1,N2) +"RTN","TMGNDF2C",473,0) + . . set input="R" +"RTN","TMGNDF2C",474,0) + . if input="L" do +"RTN","TMGNDF2C",475,0) + . . read "Enter number to lookup manually: ",input,! +"RTN","TMGNDF2C",476,0) + . . do CustLookup(.Array,"Should Add",+input) +"RTN","TMGNDF2C",477,0) + . . set input="R" +"RTN","TMGNDF2C",478,0) + . if input="X" do +"RTN","TMGNDF2C",479,0) + . . read "Enter number(s) to REMOVE from list: ",input,! +"RTN","TMGNDF2C",480,0) + . . if +input=input do +"RTN","TMGNDF2C",481,0) + . . . do Remove(.Array,"Should Add",+input) +"RTN","TMGNDF2C",482,0) + . . if input["-" do +"RTN","TMGNDF2C",483,0) + . . . new N1,N2 +"RTN","TMGNDF2C",484,0) + . . . set N1=$piece(input,"-",1) +"RTN","TMGNDF2C",485,0) + . . . set N2=$piece(input,"-",2) +"RTN","TMGNDF2C",486,0) + . . . do Remove(.Array,"Should Add",N1,N2) +"RTN","TMGNDF2C",487,0) + . . set input="R" +"RTN","TMGNDF2C",488,0) + +"RTN","TMGNDF2C",489,0) + do Lock50dot6 +"RTN","TMGNDF2C",490,0) + quit +"RTN","TMGNDF2C",491,0) + +"RTN","TMGNDF2C",492,0) + +"RTN","TMGNDF2C",493,0) +Remove(Array,Label,Num,EndNum) +"RTN","TMGNDF2C",494,0) + ;"Purpose: To remove name(s) from Array of additions to VA GENERIC file +"RTN","TMGNDF2C",495,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics() +"RTN","TMGNDF2C",496,0) + ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.) +"RTN","TMGNDF2C",497,0) + ;" Num -- entry number to add +"RTN","TMGNDF2C",498,0) + ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added. +"RTN","TMGNDF2C",499,0) + ;"Output: Those values that are removed are changed to a different node, i.e. +"RTN","TMGNDF2C",500,0) + ;" Array("Should Add",count,Generic)="" +"RTN","TMGNDF2C",501,0) + ;"Results: none +"RTN","TMGNDF2C",502,0) + +"RTN","TMGNDF2C",503,0) + set EndNum=$get(EndNum,Num) +"RTN","TMGNDF2C",504,0) + new i,Generic,Y +"RTN","TMGNDF2C",505,0) + +"RTN","TMGNDF2C",506,0) + for i=Num:1:EndNum do +"RTN","TMGNDF2C",507,0) + . set Generic=$order(Array(Label,i,"")) +"RTN","TMGNDF2C",508,0) + . if Generic'="" do +"RTN","TMGNDF2C",509,0) + . . ;"set Array("Rescan",i,Generic)="" +"RTN","TMGNDF2C",510,0) + . . set Array("Should Add",i,Generic)="" +"RTN","TMGNDF2C",511,0) + . . kill Array(Label,i) +"RTN","TMGNDF2C",512,0) + +"RTN","TMGNDF2C",513,0) + quit +"RTN","TMGNDF2C",514,0) + +"RTN","TMGNDF2C",515,0) + +"RTN","TMGNDF2C",516,0) +CustLookup(Array,Label,Num) +"RTN","TMGNDF2C",517,0) + ;"Purpose: To manually link entry in Array to an existing entry in VA GENERIC file +"RTN","TMGNDF2C",518,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics() +"RTN","TMGNDF2C",519,0) + ;" Results are passed back in Array +"RTN","TMGNDF2C",520,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",521,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",522,0) + ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.) +"RTN","TMGNDF2C",523,0) + ;" Num -- entry number to add +"RTN","TMGNDF2C",524,0) + ;"Results: none +"RTN","TMGNDF2C",525,0) + +"RTN","TMGNDF2C",526,0) + new DIC,X,Y,Generic +"RTN","TMGNDF2C",527,0) + set DIC=50.6 +"RTN","TMGNDF2C",528,0) + set DIC(0)="AEQM" +"RTN","TMGNDF2C",529,0) + +"RTN","TMGNDF2C",530,0) + set Generic=$order(Array(Label,Num,"")) +"RTN","TMGNDF2C",531,0) + if Generic'="" do +"RTN","TMGNDF2C",532,0) + . write !,"Look up an entry to match with: ",Generic +"RTN","TMGNDF2C",533,0) + . do ^DIC +"RTN","TMGNDF2C",534,0) + . if +Y>0 do +"RTN","TMGNDF2C",535,0) + . . kill Array(Label,Num,Generic) +"RTN","TMGNDF2C",536,0) + . . set Array(Generic)=Y +"RTN","TMGNDF2C",537,0) + +"RTN","TMGNDF2C",538,0) + quit +"RTN","TMGNDF2C",539,0) + +"RTN","TMGNDF2C",540,0) + +"RTN","TMGNDF2C",541,0) +DoAdds(Array,Label,Num,EndNum) +"RTN","TMGNDF2C",542,0) + ;"Purpose: To extract name(s) from Array and add to VA GENERIC file, via Add1Generic +"RTN","TMGNDF2C",543,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by CheckGenerics() +"RTN","TMGNDF2C",544,0) + ;" Results -- PASS BY REFERENCE. An OUT array to received results +"RTN","TMGNDF2C",545,0) + ;" Results(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",546,0) + ;" Results(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",547,0) + ;" Label -- the section of the array to extract from (i.e. "Already Present", or "Should Add" etc.) +"RTN","TMGNDF2C",548,0) + ;" Num -- entry number to add +"RTN","TMGNDF2C",549,0) + ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added. +"RTN","TMGNDF2C",550,0) + ;"Results: none +"RTN","TMGNDF2C",551,0) + +"RTN","TMGNDF2C",552,0) + set EndNum=$get(EndNum,Num) +"RTN","TMGNDF2C",553,0) + new i,Generic,Y +"RTN","TMGNDF2C",554,0) + +"RTN","TMGNDF2C",555,0) + for i=Num:1:EndNum do +"RTN","TMGNDF2C",556,0) + . set Generic=$order(Array(Label,i,"")) +"RTN","TMGNDF2C",557,0) + . if Generic'="" do +"RTN","TMGNDF2C",558,0) + . . set Y=$$Add1Generic(Generic) +"RTN","TMGNDF2C",559,0) + . . if +Y>0 do +"RTN","TMGNDF2C",560,0) + . . . set Array(Generic)=Y +"RTN","TMGNDF2C",561,0) + . . . kill Array(Label,i,Generic) +"RTN","TMGNDF2C",562,0) + . . . ;"set Array("Already Present",i,Generic)=Y +"RTN","TMGNDF2C",563,0) + +"RTN","TMGNDF2C",564,0) + quit +"RTN","TMGNDF2C",565,0) + +"RTN","TMGNDF2C",566,0) + +"RTN","TMGNDF2C",567,0) +Add1Generic(Name) +"RTN","TMGNDF2C",568,0) + ;"Purpose: To add on entry to the VA GENERIC FILE +"RTN","TMGNDF2C",569,0) + ;"Input: the name of the genric to be added. Should be 3-64 characters in length +"RTN","TMGNDF2C",570,0) + ;"Results: returns the added entry: IEN^NAME, or -1 if Fileman error +"RTN","TMGNDF2C",571,0) + ;"Note: This function assumes that the file as been UNLOCKED via Unlock50dot6 +"RTN","TMGNDF2C",572,0) + +"RTN","TMGNDF2C",573,0) + new X,DIC +"RTN","TMGNDF2C",574,0) + set DIC=50.6 +"RTN","TMGNDF2C",575,0) + set DIC(0)="XL" +"RTN","TMGNDF2C",576,0) + set X=Name +"RTN","TMGNDF2C",577,0) + do ^DIC +"RTN","TMGNDF2C",578,0) + +"RTN","TMGNDF2C",579,0) + quit Y +"RTN","TMGNDF2C",580,0) + +"RTN","TMGNDF2C",581,0) + +"RTN","TMGNDF2C",582,0) + ;"-------------------------------- +"RTN","TMGNDF2C",583,0) + +"RTN","TMGNDF2C",584,0) +HandleQAdds(Array) +"RTN","TMGNDF2C",585,0) + ;"Purpose: To review 'Uncertain Matches' node of Array and allow user to specify whether +"RTN","TMGNDF2C",586,0) + ;" to accept equivilence of match, or to disallow link and add new GENERIC name. +"RTN","TMGNDF2C",587,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics +"RTN","TMGNDF2C",588,0) + ;" Results are passed back in Array +"RTN","TMGNDF2C",589,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",590,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",591,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file +"RTN","TMGNDF2C",592,0) + ;"Output: results returned in Results array, as above. +"RTN","TMGNDF2C",593,0) + ;"Results: none +"RTN","TMGNDF2C",594,0) + +"RTN","TMGNDF2C",595,0) + do Unlock50dot6 +"RTN","TMGNDF2C",596,0) + +"RTN","TMGNDF2C",597,0) + new done set done=0 +"RTN","TMGNDF2C",598,0) + new input set input="R" +"RTN","TMGNDF2C",599,0) + +"RTN","TMGNDF2C",600,0) + for do quit:(done=1) +"RTN","TMGNDF2C",601,0) + . if input="R" do +"RTN","TMGNDF2C",602,0) + . . write !! +"RTN","TMGNDF2C",603,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",604,0) + . . write "Specify which links between New --> Existing GENERIC names are OK",! +"RTN","TMGNDF2C",605,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",606,0) + . . do ShowList(.Array,"Uncertain Matches") +"RTN","TMGNDF2C",607,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",608,0) + . . write "Specify which links between New --> Existing GENERIC names are OK",! +"RTN","TMGNDF2C",609,0) + . . write "-------------------------------------------------------------------",! +"RTN","TMGNDF2C",610,0) + . write " R to refresh, ? for instructions",! +"RTN","TMGNDF2C",611,0) + . write " # or #-#, ^ to continue, X remove from list",! +"RTN","TMGNDF2C",612,0) + . write "Enter number(s) to ACCEPT (or codes listed above): ^//" +"RTN","TMGNDF2C",613,0) + . read input,! +"RTN","TMGNDF2C",614,0) + . if input="" set input="^" +"RTN","TMGNDF2C",615,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2C",616,0) + . if input="^" set done=1 +"RTN","TMGNDF2C",617,0) + . if (input="?") do +"RTN","TMGNDF2C",618,0) + . . ;"do ShowInstructions +"RTN","TMGNDF2C",619,0) + . . set input="R" +"RTN","TMGNDF2C",620,0) + . if +input=input do +"RTN","TMGNDF2C",621,0) + . . do DoLinks(.Array,+input) +"RTN","TMGNDF2C",622,0) + . . set input="R" +"RTN","TMGNDF2C",623,0) + . if input["-" do +"RTN","TMGNDF2C",624,0) + . . new N1,N2 +"RTN","TMGNDF2C",625,0) + . . set N1=$piece(input,"-",1) +"RTN","TMGNDF2C",626,0) + . . set N2=$piece(input,"-",2) +"RTN","TMGNDF2C",627,0) + . . do DoLinks(.Array,N1,N2) +"RTN","TMGNDF2C",628,0) + . . set input="R" +"RTN","TMGNDF2C",629,0) + . if input="S" do +"RTN","TMGNDF2C",630,0) + . . read "Enter number to re-SCAN: ",input,! +"RTN","TMGNDF2C",631,0) + . . if +input=input do +"RTN","TMGNDF2C",632,0) + . . . do Rescan(.Array,"Uncertain Matches",+input) +"RTN","TMGNDF2C",633,0) + . if input="X" do +"RTN","TMGNDF2C",634,0) + . . read "Enter number(s) to REMOVE from list: ",input,! +"RTN","TMGNDF2C",635,0) + . . if +input=input do +"RTN","TMGNDF2C",636,0) + . . . do Remove(.Array,"Uncertain Matches",+input) +"RTN","TMGNDF2C",637,0) + . . if input["-" do +"RTN","TMGNDF2C",638,0) + . . . new N1,N2 +"RTN","TMGNDF2C",639,0) + . . . set N1=$piece(input,"-",1) +"RTN","TMGNDF2C",640,0) + . . . set N2=$piece(input,"-",2) +"RTN","TMGNDF2C",641,0) + . . . ;"do Remove(.Array,"Uncertain Matches",N1,N2) +"RTN","TMGNDF2C",642,0) + . . set input="R" +"RTN","TMGNDF2C",643,0) + +"RTN","TMGNDF2C",644,0) + do Lock50dot6 +"RTN","TMGNDF2C",645,0) + quit +"RTN","TMGNDF2C",646,0) + +"RTN","TMGNDF2C",647,0) + +"RTN","TMGNDF2C",648,0) +DoLinks(Array,Num,EndNum) +"RTN","TMGNDF2C",649,0) + ;"Purpose: To change a link from the "Uncertain Matches" node, to a formal link +"RTN","TMGNDF2C",650,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by CheckGenerics +"RTN","TMGNDF2C",651,0) + ;" Results are passed back in Array +"RTN","TMGNDF2C",652,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",653,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",654,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",655,0) + ;" Num -- entry number to add +"RTN","TMGNDF2C",656,0) + ;" EndNum -- OPTIONAL. If supplied, then range of Num-EndNum are all added. +"RTN","TMGNDF2C",657,0) + ;"Results: none +"RTN","TMGNDF2C",658,0) + +"RTN","TMGNDF2C",659,0) + set EndNum=$get(EndNum,Num) +"RTN","TMGNDF2C",660,0) + new i,TMGGeneric,VAGeneric,Y +"RTN","TMGNDF2C",661,0) + +"RTN","TMGNDF2C",662,0) + for i=Num:1:EndNum do +"RTN","TMGNDF2C",663,0) + . set TMGGeneric=$order(Array("Uncertain Matches",i,"")) +"RTN","TMGNDF2C",664,0) + . if TMGGeneric'="" do +"RTN","TMGNDF2C",665,0) + . . if $data(Array("Uncertain Matches",i,TMGGeneric))=1 do +"RTN","TMGNDF2C",666,0) + . . . set VAGeneric=$order(Array("Uncertain Matches",i,TMGGeneric,"")) +"RTN","TMGNDF2C",667,0) + . . . set Y=$get(Array("Uncertain Matches",i,TMGGeneric,VAGeneric)) +"RTN","TMGNDF2C",668,0) + . . else do ;"pick from multiple options. +"RTN","TMGNDF2C",669,0) + . . . set Y=$$DoMltLink(.Array,i,TMGGeneric) +"RTN","TMGNDF2C",670,0) + . . if +Y>0 do +"RTN","TMGNDF2C",671,0) + . . . ;"kill Array("Uncertain Matches",i,TMGGeneric,VAGeneric) +"RTN","TMGNDF2C",672,0) + . . . kill Array("Uncertain Matches",i,TMGGeneric) +"RTN","TMGNDF2C",673,0) + . . . set Array(TMGGeneric)=Y +"RTN","TMGNDF2C",674,0) + +"RTN","TMGNDF2C",675,0) + quit +"RTN","TMGNDF2C",676,0) + +"RTN","TMGNDF2C",677,0) +DoMltLink(Array,Num,TMGGeneric) +"RTN","TMGNDF2C",678,0) + ;"Purpose: To interact with user and pick which link (amoung multiple) +"RTN","TMGNDF2C",679,0) + ;"Input: Array -- PASS BY REFERENCE. Array as created by CheckGenerics +"RTN","TMGNDF2C",680,0) + ;" Num -- The number in the "Uncertain Matches" to pick amoung. +"RTN","TMGNDF2C",681,0) + ;" TMGGeneric -- the Generic Name for to look for a match to +"RTN","TMGNDF2C",682,0) + ;"Results: The selected link: i.e. IEN^Name, or "" if not found +"RTN","TMGNDF2C",683,0) + +"RTN","TMGNDF2C",684,0) + +"RTN","TMGNDF2C",685,0) + new VAGeneric,j,tempResults +"RTN","TMGNDF2C",686,0) + new name,input,result +"RTN","TMGNDF2C",687,0) + new NumAnswers set NumAnswers=0 +"RTN","TMGNDF2C",688,0) + +"RTN","TMGNDF2C",689,0) + set VAGeneric=$order(Array("Uncertain Matches",Num,TMGGeneric,"")) +"RTN","TMGNDF2C",690,0) + if VAGeneric'="" for j=1:1 do quit:(VAGeneric="") +"RTN","TMGNDF2C",691,0) + . set tempResults(j)=$get(Array("Uncertain Matches",Num,TMGGeneric,VAGeneric)) +"RTN","TMGNDF2C",692,0) + . set NumAnswers=j +"RTN","TMGNDF2C",693,0) + . set VAGeneric=$order(Array("Uncertain Matches",Num,TMGGeneric,VAGeneric)) +"RTN","TMGNDF2C",694,0) + +"RTN","TMGNDF2C",695,0) + if NumAnswers=1 set result=$get(tempResult(1)) goto DMLDone +"RTN","TMGNDF2C",696,0) + +"RTN","TMGNDF2C",697,0) + write "Please select match for ",TMGGeneric,! +"RTN","TMGNDF2C",698,0) + for j=1:1 do quit:(name="") +"RTN","TMGNDF2C",699,0) + . set name=$get(tempResult(j)) +"RTN","TMGNDF2C",700,0) + . if name="" quit +"RTN","TMGNDF2C",701,0) + . write " ",j,". ",$piece(name,"^",2),! +"RTN","TMGNDF2C",702,0) + +"RTN","TMGNDF2C",703,0) + read "Enter number of match (^ to quit): ^// ",input,! +"RTN","TMGNDF2C",704,0) + set result=$get(tempResult(+input)) +"RTN","TMGNDF2C",705,0) + +"RTN","TMGNDF2C",706,0) +DMLDone +"RTN","TMGNDF2C",707,0) + quit result +"RTN","TMGNDF2C",708,0) + +"RTN","TMGNDF2C",709,0) + +"RTN","TMGNDF2C",710,0) + ;"=========================================================================== +"RTN","TMGNDF2C",711,0) + +"RTN","TMGNDF2C",712,0) +FillCompFile(Array) +"RTN","TMGNDF2C",713,0) + ;"Purpose: To take the list (generated in FillGenerics(), with its linkages +"RTN","TMGNDF2C",714,0) + ;" between new drug names and existing drug name data, and fill +"RTN","TMGNDF2C",715,0) + ;" in field .08 in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF2C",716,0) + ;"Input: Array -- PASS BY REFERENCE. List of linkages between names. +"RTN","TMGNDF2C",717,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",718,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",719,0) + ;" Array(GENERIC NAME)=IEN in VA GENERIC file^Name +"RTN","TMGNDF2C",720,0) + ;"Output: Data is put into TMG FDA IMPORT COMPILED +"RTN","TMGNDF2C",721,0) + ;"Results: none +"RTN","TMGNDF2C",722,0) + +"RTN","TMGNDF2C",723,0) + write "Filling field .08 (VA GENERIC) in file TMG FDA IMPORT COMPILED",! +"RTN","TMGNDF2C",724,0) + write "based on data from field .07 (GENERIC NAME)...",! +"RTN","TMGNDF2C",725,0) + +"RTN","TMGNDF2C",726,0) + new TMGGeneric,VAGeneric +"RTN","TMGNDF2C",727,0) + new IEN,oldval +"RTN","TMGNDF2C",728,0) + new count set count=0 +"RTN","TMGNDF2C",729,0) + +"RTN","TMGNDF2C",730,0) + new Itr,IEN +"RTN","TMGNDF2C",731,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2C",732,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2C",733,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2C",734,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2C",735,0) + . set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"0;6 --> field .07, GENERIC NAME +"RTN","TMGNDF2C",736,0) + . set oldval=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"1;3 --> field .08, VA GENERIC +"RTN","TMGNDF2C",737,0) + . if (+oldval'=0)!(TMGGeneric="") quit +"RTN","TMGNDF2C",738,0) + . set VAGeneric=$get(Array(TMGGeneric)) +"RTN","TMGNDF2C",739,0) + . if +VAGeneric>0 do +"RTN","TMGNDF2C",740,0) + . . if +VAGeneric'=oldval do +"RTN","TMGNDF2C",741,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2C",742,0) + . . set TMGFDA(22706.9,IEN_",",.08)=+VAGeneric +"RTN","TMGNDF2C",743,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2C",744,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2C",745,0) + . . set count=count+1 +"RTN","TMGNDF2C",746,0) + . . ;"write "Stored ",$piece(VAGeneric,"^",2)," in record# ",IEN,! +"RTN","TMGNDF2C",747,0) + . else do +"RTN","TMGNDF2C",748,0) + . . write !,"Can't find entry for: ",TMGGeneric,! +"RTN","TMGNDF2C",749,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2C",750,0) + write count," records modified.",! +"RTN","TMGNDF2C",751,0) + +"RTN","TMGNDF2C",752,0) + quit +"RTN","TMGNDF2C",753,0) + +"RTN","TMGNDF2C",754,0) + +"RTN","TMGNDF2C",755,0) + +"RTN","TMGNDF2E") +0^44^B10640 +"RTN","TMGNDF2E",1,0) +TMGNDF2E ;TMG/kst/FDA Import: Fix ingredients IEN linkages ;03/25/06 +"RTN","TMGNDF2E",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF2E",3,0) + +"RTN","TMGNDF2E",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2E",5,0) + ;" Further processing, after functions in TMGNDF2D +"RTN","TMGNDF2E",6,0) + ;" Fixing ingredients IEN linkages +"RTN","TMGNDF2E",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2E",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2E",9,0) + ;"11-21-2006 +"RTN","TMGNDF2E",10,0) + +"RTN","TMGNDF2E",11,0) + ;"======================================================================= +"RTN","TMGNDF2E",12,0) + ;" API -- Public Functions. +"RTN","TMGNDF2E",13,0) + ;"======================================================================= +"RTN","TMGNDF2E",14,0) + ;"Menu +"RTN","TMGNDF2E",15,0) + ;"======================================================================= +"RTN","TMGNDF2E",16,0) + ;"FixMissing -- Find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED +"RTN","TMGNDF2E",17,0) + +"RTN","TMGNDF2E",18,0) + ;"======================================================================= +"RTN","TMGNDF2E",19,0) + ;" Private Functions. +"RTN","TMGNDF2E",20,0) + ;"======================================================================= +"RTN","TMGNDF2E",21,0) + ;"FindMissing(Array) +"RTN","TMGNDF2E",22,0) + ;"EasyFix(Array) ;handle the easy fixes from Array (created by FindMissing) +"RTN","TMGNDF2E",23,0) + ;"HardFix(Array) ;handle the more difficult fixes from Array (created by FindMissing) +"RTN","TMGNDF2E",24,0) + ;"GetRxIEN(RxName,pDrugInfo) ;get the IEN of the given drug name +"RTN","TMGNDF2E",25,0) + +"RTN","TMGNDF2E",26,0) + ;"BatchNDCFix -- Scan TMG FDA IMPORT COMPILED file, and fix NDC codes +"RTN","TMGNDF2E",27,0) + ;"NewNDC(NDC) -- convert an NDC code with invalid formatting into one acceptible to VistA +"RTN","TMGNDF2E",28,0) + +"RTN","TMGNDF2E",29,0) + +"RTN","TMGNDF2E",30,0) + ;"======================================================================= +"RTN","TMGNDF2E",31,0) + ;"======================================================================= +"RTN","TMGNDF2E",32,0) + +"RTN","TMGNDF2E",33,0) + ;"Notes: I have discovered, when I went to actually add entries from +"RTN","TMGNDF2E",34,0) + ;" TMG NDF IMPORT COMPILED into VA PRODUCT, that many of the ingredients +"RTN","TMGNDF2E",35,0) + ;" did not have appropriate links to a VA drug. I am not sure how this +"RTN","TMGNDF2E",36,0) + ;" happened. Perhaps the drugs had not been added at the time that the +"RTN","TMGNDF2E",37,0) + ;" compiled entry was create? Perhaps it was drug ingredient that I +"RTN","TMGNDF2E",38,0) + ;" chose to skip? Anyway, the purpose of this code is to fix this problem. +"RTN","TMGNDF2E",39,0) + ;" And since I don't know at which step the problem occured, and I am +"RTN","TMGNDF2E",40,0) + ;" unwilling to put the HOURS of classification work in again if I were +"RTN","TMGNDF2E",41,0) + ;" to start over, I will just fix the problem at this step of the process. +"RTN","TMGNDF2E",42,0) + +"RTN","TMGNDF2E",43,0) + ;"======================================================================= +"RTN","TMGNDF2E",44,0) + +"RTN","TMGNDF2E",45,0) +Menu +"RTN","TMGNDF2E",46,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF2E",47,0) + +"RTN","TMGNDF2E",48,0) + new Menu,UsrSlct +"RTN","TMGNDF2E",49,0) + set Menu(0)="Pick Option for Fixing Missing Ingredients (2E)" +"RTN","TMGNDF2E",50,0) + set Menu(1)="Fix UNMATCHED ingredients in import."_$char(9)_"FixMissing" +"RTN","TMGNDF2E",51,0) + set Menu(2)="Fix MISSING ingredients in import."_$char(9)_"FixMissing2" +"RTN","TMGNDF2E",52,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF2E",53,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF2E",54,0) + +"RTN","TMGNDF2E",55,0) +MC1 write # +"RTN","TMGNDF2E",56,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2E",57,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF2E",58,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF2E",59,0) + +"RTN","TMGNDF2E",60,0) + if UsrSlct="FixMissing" do FixMissing goto MC1 +"RTN","TMGNDF2E",61,0) + if UsrSlct="FixMissing2" do FixMissing^TMGNDF2F goto MC1 +"RTN","TMGNDF2E",62,0) + if UsrSlct="Prev" goto Menu^TMGNDF2C ;"quit can occur from there... +"RTN","TMGNDF2E",63,0) + if UsrSlct="Next" goto Menu^TMGNDF2G ;"quit can occur from there... +"RTN","TMGNDF2E",64,0) + goto MC1 +"RTN","TMGNDF2E",65,0) + +"RTN","TMGNDF2E",66,0) +MCDone +"RTN","TMGNDF2E",67,0) + quit +"RTN","TMGNDF2E",68,0) + +"RTN","TMGNDF2E",69,0) + +"RTN","TMGNDF2E",70,0) + +"RTN","TMGNDF2E",71,0) +FixMissing +"RTN","TMGNDF2E",72,0) + ;"Purpose: To find and fix missing ingredient IEN's in TMG FDA IMPORT COMPILED +"RTN","TMGNDF2E",73,0) + +"RTN","TMGNDF2E",74,0) + new Array +"RTN","TMGNDF2E",75,0) + write "Gathering missing ingredient link entries...",! +"RTN","TMGNDF2E",76,0) + do FindMissing(.Array) +"RTN","TMGNDF2E",77,0) + if $data(Array)=0 do goto FMDone +"RTN","TMGNDF2E",78,0) + . write !,"No missing entries. Great!",! +"RTN","TMGNDF2E",79,0) + write "Fixing easy problems...",! +"RTN","TMGNDF2E",80,0) + do EasyFix(.Array) +"RTN","TMGNDF2E",81,0) + write "Now to fix the more difficult problems...",! +"RTN","TMGNDF2E",82,0) + do HardFix(.Array) +"RTN","TMGNDF2E",83,0) + +"RTN","TMGNDF2E",84,0) +FMDone +"RTN","TMGNDF2E",85,0) + write "Done. Goodbye...",! +"RTN","TMGNDF2E",86,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2E",87,0) + quit +"RTN","TMGNDF2E",88,0) + +"RTN","TMGNDF2E",89,0) + +"RTN","TMGNDF2E",90,0) + +"RTN","TMGNDF2E",91,0) +FindMissing(Array) +"RTN","TMGNDF2E",92,0) + ;"Purpose: to scan TMG FDA IMPORT COMPILED and find ingredients that +"RTN","TMGNDF2E",93,0) + ;" don't have a linkage to a VA drug. +"RTN","TMGNDF2E",94,0) + ;"Input: Array -- PASS BY REFERENCE, it is an OUT PARAMETER. Format below +"RTN","TMGNDF2E",95,0) + ;" prior entries in array are NOT KILLED. +"RTN","TMGNDF2E",96,0) + ;"Output: Array is filled as follows: +"RTN","TMGNDF2E",97,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",98,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",99,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",100,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",101,0) + ;"Results: none. +"RTN","TMGNDF2E",102,0) + +"RTN","TMGNDF2E",103,0) + new Itr,IEN +"RTN","TMGNDF2E",104,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2E",105,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2E",106,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2E",107,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1=SKIP +"RTN","TMGNDF2E",108,0) + . new subIEN set subIEN=0 +"RTN","TMGNDF2E",109,0) + . for set subIEN=+$order(^TMG(22706.9,IEN,4,subIEN)) quit:(+subIEN'>0) do +"RTN","TMGNDF2E",110,0) + . . new node set node=$get(^TMG(22706.9,IEN,4,subIEN,0)) +"RTN","TMGNDF2E",111,0) + . . new ingredients set ingredients=$piece(node,"^",3) ;"INGREDIENTS +"RTN","TMGNDF2E",112,0) + . . if ingredients="" do +"RTN","TMGNDF2E",113,0) + . . . new FDAitemNum +"RTN","TMGNDF2E",114,0) + . . . set FDAitemNum=$piece($get(^TMG(22706.9,IEN,0)),"^",1) +"RTN","TMGNDF2E",115,0) + . . . new DrugInfo +"RTN","TMGNDF2E",116,0) + . . . new result +"RTN","TMGNDF2E",117,0) + . . . set result=$$GetDrugInfo^TMGNDF1C(FDAitemNum,.DrugInfo,"",1) +"RTN","TMGNDF2E",118,0) + . . . if result=0 do quit +"RTN","TMGNDF2E",119,0) + . . . . write "Unable to get drug info for entry: ",FDAitemNum,! +"RTN","TMGNDF2E",120,0) + . . . new ingrName,ingrIEN +"RTN","TMGNDF2E",121,0) + . . . set ingrName=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME")) +"RTN","TMGNDF2E",122,0) + . . . set ingrIEN=$get(DrugInfo("FORMULATION",subIEN,"INGREDIENT NAME","FILE 50.416 IEN")) +"RTN","TMGNDF2E",123,0) + . . . set Array(IEN,subIEN)=ingrName +"RTN","TMGNDF2E",124,0) + . . . set Array(IEN,subIEN,"FILE 50.416 IEN")=ingrIEN +"RTN","TMGNDF2E",125,0) + . . . merge Array(IEN,subIEN,"INFO")=DrugInfo +"RTN","TMGNDF2E",126,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2E",127,0) + +"RTN","TMGNDF2E",128,0) + quit +"RTN","TMGNDF2E",129,0) + +"RTN","TMGNDF2E",130,0) + +"RTN","TMGNDF2E",131,0) +EasyFix(Array) +"RTN","TMGNDF2E",132,0) + ;"Purpose: to handle the easy fixes from Array (created by FindMissing) +"RTN","TMGNDF2E",133,0) + ;"Input: Array -- array as cread by FindMissing() +"RTN","TMGNDF2E",134,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",135,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",136,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",137,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",138,0) + ;"Output: Missing information will be stuffed into records +"RTN","TMGNDF2E",139,0) + +"RTN","TMGNDF2E",140,0) + new IEN,subIEN +"RTN","TMGNDF2E",141,0) + set IEN=$order(Array("")) +"RTN","TMGNDF2E",142,0) + if IEN'="" for do quit:IEN="" +"RTN","TMGNDF2E",143,0) + . set subIEN=$order(Array(IEN,"")) +"RTN","TMGNDF2E",144,0) + . if subIEN'="" for do quit:subIEN="" +"RTN","TMGNDF2E",145,0) + . . new RxIEN set RxIEN=$get(Array(IEN,subIEN,"FILE 50.416 IEN")) +"RTN","TMGNDF2E",146,0) + . . if RxIEN'="" do +"RTN","TMGNDF2E",147,0) + . . . set $piece(^TMG(22706.9,IEN,4,subIEN,0),"^",3)=RxIEN +"RTN","TMGNDF2E",148,0) + . . set subIEN=$order(Array(IEN,subIEN)) +"RTN","TMGNDF2E",149,0) + . set IEN=$order(Array(IEN)) +"RTN","TMGNDF2E",150,0) + +"RTN","TMGNDF2E",151,0) + quit +"RTN","TMGNDF2E",152,0) + +"RTN","TMGNDF2E",153,0) + +"RTN","TMGNDF2E",154,0) +HardFix(Array) +"RTN","TMGNDF2E",155,0) + ;"Purpose: to handle the more difficult fixes from Array (created by FindMissing) +"RTN","TMGNDF2E",156,0) + ;"Input: Array -- array as cread by FindMissing() +"RTN","TMGNDF2E",157,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",158,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",159,0) + ;" Array(IEN,subIEN)=UnmatchedIngredientName +"RTN","TMGNDF2E",160,0) + ;" Array(IEN,subIEN,"FILE 50.416 IEN")=IEN +"RTN","TMGNDF2E",161,0) + ;"Output: Missing information will be stuffed into records +"RTN","TMGNDF2E",162,0) + +"RTN","TMGNDF2E",163,0) + write !,$$ListCt^TMGMISC("Array")," items to fix.",! +"RTN","TMGNDF2E",164,0) + new IEN,subIEN,PriorAnswer +"RTN","TMGNDF2E",165,0) + new abort set abort=0 +"RTN","TMGNDF2E",166,0) + set IEN=$order(Array("")) +"RTN","TMGNDF2E",167,0) + if IEN'="" for do quit:(IEN="")!(abort=1) +"RTN","TMGNDF2E",168,0) + . set subIEN=$order(Array(IEN,"")) +"RTN","TMGNDF2E",169,0) + . if subIEN'="" for do quit:(subIEN="")!(abort=1) +"RTN","TMGNDF2E",170,0) + . . new RxName,RxIEN +"RTN","TMGNDF2E",171,0) + . . set RxName=$get(Array(IEN,subIEN)) +"RTN","TMGNDF2E",172,0) + . . set RxIEN=+$get(PriorAnswer(RxName)) +"RTN","TMGNDF2E",173,0) + . . if (RxIEN=0)!(RxIEN=-1) do +"RTN","TMGNDF2E",174,0) + . . . set RxIEN=$$LookupRx^TMGNDF2B(RxName) +"RTN","TMGNDF2E",175,0) + . . . set PriorAnswer(RxName)=RxIEN +"RTN","TMGNDF2E",176,0) + . . . if RxIEN=-1 do +"RTN","TMGNDF2E",177,0) + . . . . set RxIEN=$$GetRxIEN(RxName,$name(Array(IEN,subIEN,"INFO"))) +"RTN","TMGNDF2E",178,0) + . . . . set PriorAnswer(RxName)=RxIEN +"RTN","TMGNDF2E",179,0) + . . if +RxIEN>0 do +"RTN","TMGNDF2E",180,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF2E",181,0) + . . . set TMGFDA(22706.916,subIEN_","_IEN_",",2)=+RxIEN +"RTN","TMGNDF2E",182,0) + . . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2E",183,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2E",184,0) + . . if RxIEN=-3 set abort=1 quit +"RTN","TMGNDF2E",185,0) + . . if RxIEN=-2 do +"RTN","TMGNDF2E",186,0) + . . . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP +"RTN","TMGNDF2E",187,0) + . . set subIEN=$order(Array(IEN,subIEN)) +"RTN","TMGNDF2E",188,0) + . set IEN=$order(Array(IEN)) +"RTN","TMGNDF2E",189,0) + +"RTN","TMGNDF2E",190,0) + quit +"RTN","TMGNDF2E",191,0) + +"RTN","TMGNDF2E",192,0) +GetRxIEN(RxName,pDrugInfo) +"RTN","TMGNDF2E",193,0) + ;"Purpose: To get the IEN of the given drug name +"RTN","TMGNDF2E",194,0) + ;"Input: RxName -- the name of the drug to find. +"RTN","TMGNDF2E",195,0) + ;" pDrugInfo -- NAME OF array containing drug info (as creaged by GetDrugInfo^TMGNDF2 +"RTN","TMGNDF2E",196,0) + ;"Result: IEN of drug found, or 0 if not found, +"RTN","TMGNDF2E",197,0) + ;" -2 if drug should be excluded from addition to VA PRODUCT file. +"RTN","TMGNDF2E",198,0) + ;" -3 if abort requested +"RTN","TMGNDF2E",199,0) + +"RTN","TMGNDF2E",200,0) + new result set result=0 +"RTN","TMGNDF2E",201,0) + new DrugInfo merge DrugInfo=@pDrugInfo +"RTN","TMGNDF2E",202,0) + +"RTN","TMGNDF2E",203,0) +GRLoop +"RTN","TMGNDF2E",204,0) + write !!,"Can't find a ingredient match for: ",RxName,!! +"RTN","TMGNDF2E",205,0) + write "1. Manual lookup",! +"RTN","TMGNDF2E",206,0) + write "2. Show info of drug containing this ingredient",! +"RTN","TMGNDF2E",207,0) + write "3. Set drug containing this ingredient to NOT BE ADDED",! +"RTN","TMGNDF2E",208,0) + write " to the VA PRODUCT file.",! +"RTN","TMGNDF2E",209,0) + write "0 next",! +"RTN","TMGNDF2E",210,0) + write "^ to quit",! +"RTN","TMGNDF2E",211,0) + write ! +"RTN","TMGNDF2E",212,0) + new temp +"RTN","TMGNDF2E",213,0) + read "Enter selection: 0// ",temp:$get(DTIME,3600),! +"RTN","TMGNDF2E",214,0) + if temp="" set temp="0" +"RTN","TMGNDF2E",215,0) + if temp="^" set result=-3 goto GRDone +"RTN","TMGNDF2E",216,0) + if temp=0 goto GRDone +"RTN","TMGNDF2E",217,0) + if temp=1 do goto:(result>0) GRDone +"RTN","TMGNDF2E",218,0) + . new DIC,Y +"RTN","TMGNDF2E",219,0) + . set DIC=50.416 +"RTN","TMGNDF2E",220,0) + . set DIC(0)="AEQML" +"RTN","TMGNDF2E",221,0) + . do ^DIC +"RTN","TMGNDF2E",222,0) + . if +Y>0 set result=+Y +"RTN","TMGNDF2E",223,0) + if temp=2 do goto GRLoop +"RTN","TMGNDF2E",224,0) + . do FormatDrug^TMGND2A(.DrugInfo) +"RTN","TMGNDF2E",225,0) + if temp=3 do goto GRDone +"RTN","TMGNDF2E",226,0) + . set result=-2 +"RTN","TMGNDF2E",227,0) + goto GRLoop +"RTN","TMGNDF2E",228,0) +GRDone +"RTN","TMGNDF2E",229,0) + quit result +"RTN","TMGNDF2E",230,0) + +"RTN","TMGNDF2E",231,0) + +"RTN","TMGNDF2E",232,0) + ;"======================================================================= +"RTN","TMGNDF2E",233,0) + ;"Code for Fixing NDC's +"RTN","TMGNDF2E",234,0) + ;"======================================================================= +"RTN","TMGNDF2E",235,0) + ;"Note: The NDC's given by the FDA database are not always acceptible by the +"RTN","TMGNDF2E",236,0) + ;" VistA input transform, because they include *'s. The FDA explains +"RTN","TMGNDF2E",237,0) + ;" this as follows: +"RTN","TMGNDF2E",238,0) + ;" Here is the official info from fda.gov on NDC codes: +"RTN","TMGNDF2E",239,0) + ;" +"RTN","TMGNDF2E",240,0) + ;" NDC Number +"RTN","TMGNDF2E",241,0) + ;" +"RTN","TMGNDF2E",242,0) + ;" Each listed drug product listed is assigned a unique 10-digit, 3-segment +"RTN","TMGNDF2E",243,0) + ;" number. This number, known as the NDC, identifies the labeler, product, and +"RTN","TMGNDF2E",244,0) + ;" trade package size. The first segment, the labeler code, is assigned by the +"RTN","TMGNDF2E",245,0) + ;" FDA. A labeler is any firm that manufactures (including repackers or +"RTN","TMGNDF2E",246,0) + ;" relabelers), or distributes (under its own name) the drug. The second +"RTN","TMGNDF2E",247,0) + ;" segment, the product code, identifies a specific strength, dosage form, and +"RTN","TMGNDF2E",248,0) + ;" formulation for a particular firm. The third segment, the package code, +"RTN","TMGNDF2E",249,0) + ;" identifies package sizes and types. Both the product and package codes are +"RTN","TMGNDF2E",250,0) + ;" assigned by the firm. The NDC will be in one of the following +"RTN","TMGNDF2E",251,0) + ;" configurations: 4-4-2, 5-3-2, or 5-4-1. +"RTN","TMGNDF2E",252,0) + ;" +"RTN","TMGNDF2E",253,0) + ;" An asterisk may appear in either a product code or a package code. It +"RTN","TMGNDF2E",254,0) + ;" simply acts as a place holder and indicates the configuration of the NDC. +"RTN","TMGNDF2E",255,0) + ;" Since the NDC is limited to 10 digits, a firm with a 5 digit labeler code +"RTN","TMGNDF2E",256,0) + ;" must choose between a 3 digit product code and 2 digit package code, or a 4 +"RTN","TMGNDF2E",257,0) + ;" digit product code and 1 digit package code. +"RTN","TMGNDF2E",258,0) + ;" +"RTN","TMGNDF2E",259,0) + ;" Thus, you have either a 5-4-1 or a 5-3-2 configuration for the three +"RTN","TMGNDF2E",260,0) + ;" segments of the NDC. Because of a conflict with the HIPAA standard of an 11 +"RTN","TMGNDF2E",261,0) + ;" digit NDC, many programs will pad the product code or package code segments +"RTN","TMGNDF2E",262,0) + ;" of the NDC with a leading zero instead of the asterisk. +"RTN","TMGNDF2E",263,0) + ;" +"RTN","TMGNDF2E",264,0) + ;" kt note: I.e. the problem is how to convert 10 digits --> 11 digits. +"RTN","TMGNDF2E",265,0) + ;" where to put the extra digit? +"RTN","TMGNDF2E",266,0) + ;" +"RTN","TMGNDF2E",267,0) + ;" Since a zero can be a valid digit in the NDC, this can lead to confusion +"RTN","TMGNDF2E",268,0) + ;" when trying to reconstitute the NDC back to its FDA standard. Example: +"RTN","TMGNDF2E",269,0) + ;" 12345-0678-09 (11 digits) could be 12345-678-09 or 12345-678-90 depending on +"RTN","TMGNDF2E",270,0) + ;" the firm's configuration. +"RTN","TMGNDF2E",271,0) + ;" +"RTN","TMGNDF2E",272,0) + ;" kt note: I think the example is wrong. It should be: +"RTN","TMGNDF2E",273,0) + ;" Example: +"RTN","TMGNDF2E",274,0) + ;" 12345-0678-09 (11 digits) could be 12345-678-09 (i.e. 5-3-2) +"RTN","TMGNDF2E",275,0) + ;" or 12345-0678-9 (5-4-1) depending on the firm's configuration. +"RTN","TMGNDF2E",276,0) + +"RTN","TMGNDF2E",277,0) + ;" By storing the segments as character data and +"RTN","TMGNDF2E",278,0) + ;" using the * as place holders we eliminate the confusion. In the example, FDA +"RTN","TMGNDF2E",279,0) + ;" stores the segments as 12345-*678-09 for a 5-3-2 configuration or +"RTN","TMGNDF2E",280,0) + ;" 12345-0678-*9 for a 5-4-1 +"RTN","TMGNDF2E",281,0) + ;" +"RTN","TMGNDF2E",282,0) + ;" +"RTN","TMGNDF2E",283,0) + +"RTN","TMGNDF2E",284,0) +BatchNDCFix +"RTN","TMGNDF2E",285,0) + ;"Purpose: Scan TMG FDA IMPORT COMPILED file, and fix NDC codes +"RTN","TMGNDF2E",286,0) + ;"Output: data in file will be changed, NDC and NDC-12-digit fields will be altered. +"RTN","TMGNDF2E",287,0) + +"RTN","TMGNDF2E",288,0) + new IEN +"RTN","TMGNDF2E",289,0) + set IEN=$order(^TMG(22706.9,0)) +"RTN","TMGNDF2E",290,0) + if +IEN>0 for do quit:(+IEN'>0) +"RTN","TMGNDF2E",291,0) + . new node set node=$get(^TMG(22706.9,IEN,1)) +"RTN","TMGNDF2E",292,0) + . new NDC,newNDC +"RTN","TMGNDF2E",293,0) + . set NDC=$piece(node,"^",1) +"RTN","TMGNDF2E",294,0) + . set newNDC=$$NewNDC(NDC) +"RTN","TMGNDF2E",295,0) + . new digits12NDC set digits12NDC=$translate(newNDC,"-","") +"RTN","TMGNDF2E",296,0) + . new d1 +"RTN","TMGNDF2E",297,0) + . if '$$IsNumeric^TMGMISC(digits12NDC) do +"RTN","TMGNDF2E",298,0) + . . new name set name=$piece(^TMG(22706.9,IEN,0),"^",4) +"RTN","TMGNDF2E",299,0) + . . write IEN,". NDC=",NDC," ",name,! +"RTN","TMGNDF2E",300,0) + . if newNDC'=NDC do +"RTN","TMGNDF2E",301,0) + . . write IEN,". ",NDC," needs --> ",newNDC,! +"RTN","TMGNDF2E",302,0) + . . if $length(digits12NDC)<12 do +"RTN","TMGNDF2E",303,0) + . . . set digits12NDC=$extract("000000",1,12-$length(digits12NDC))_digits12NDC +"RTN","TMGNDF2E",304,0) +BLabel . . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF2E",305,0) + . . set TMGFDA(22706.9,IEN_",",4)=newNDC +"RTN","TMGNDF2E",306,0) + . . set TMGFDA(22706.9,IEN_",",5)=digits12NDC +"RTN","TMGNDF2E",307,0) + . . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2E",308,0) + . . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF2E",309,0) + . . . set result=0 +"RTN","TMGNDF2E",310,0) + . . . if $get(Quiet)=1 quit +"RTN","TMGNDF2E",311,0) + . . . new PriorErrorFound +"RTN","TMGNDF2E",312,0) + . . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2E",313,0) + . set IEN=$order(^TMG(22706.9,IEN)) +"RTN","TMGNDF2E",314,0) + +"RTN","TMGNDF2E",315,0) + quit +"RTN","TMGNDF2E",316,0) + +"RTN","TMGNDF2E",317,0) +NewNDC(NDC) +"RTN","TMGNDF2E",318,0) + ;"Purpose: convert an NDC code with invalid formatting into one acceptible to VistA +"RTN","TMGNDF2E",319,0) + ;"Input: NDC -- the NDC as provided by FDA, with hyphens ('-'s) +"RTN","TMGNDF2E",320,0) + ;"Output: the correctly formatted NDC, or "" if not valid conversion possible. +"RTN","TMGNDF2E",321,0) + +"RTN","TMGNDF2E",322,0) + ;"Examples of conversions: +"RTN","TMGNDF2E",323,0) + ;" 12345-*678-09 --> 12345-678-09 (5-3-2 digits) +"RTN","TMGNDF2E",324,0) + ;" 12345-0678-*9 --> 12345-0678-9 (5-4-1 digits) +"RTN","TMGNDF2E",325,0) + +"RTN","TMGNDF2E",326,0) + ;"Sometimes there are two *'s (i.e. **) (always in the LAST grouping -- the package code +"RTN","TMGNDF2E",327,0) + ;"Here is some examples of how I will convert them: +"RTN","TMGNDF2E",328,0) + ;" 057587-*022-** (6-4-2) --> 57587-022-00 (5-3-2) +"RTN","TMGNDF2E",329,0) + ;" 053360-4189-** (6-4-2) --> 53360-4189-0 (5-4-1) +"RTN","TMGNDF2E",330,0) + ;" 000034-1025-** (6-4-2) --> 00034-1025-0 (5-4-1) +"RTN","TMGNDF2E",331,0) + ;" 046672-*122-** (6-4-2) --> 46672-122-00 (5-3-2) +"RTN","TMGNDF2E",332,0) + +"RTN","TMGNDF2E",333,0) + ;"Also, sometimes the FDA database did not include values for codes. +"RTN","TMGNDF2E",334,0) + ;"Initially, I converted these to ????'s +"RTN","TMGNDF2E",335,0) + ;"Now, that won't be acceptible to VistA, so I will convert these to 0's +"RTN","TMGNDF2E",336,0) + ;"e.g. 000034-????-56 --> 000034-0000-56 +"RTN","TMGNDF2E",337,0) + +"RTN","TMGNDF2E",338,0) + new result,valid,digits +"RTN","TMGNDF2E",339,0) + +"RTN","TMGNDF2E",340,0) + ;"Setup check for valid digits combo. Allowed combos are: +"RTN","TMGNDF2E",341,0) + ;" 4-4-2, 5-3-2, 5-4-1, 5-4-2, or 6-4-2 +"RTN","TMGNDF2E",342,0) + set digits("VALID",4,4,2)=1 ;"total of 10 digits +"RTN","TMGNDF2E",343,0) + set digits("VALID",5,3,2)=1 ;"total of 10 digits +"RTN","TMGNDF2E",344,0) + set digits("VALID",5,4,1)=1 ;"total of 10 digits +"RTN","TMGNDF2E",345,0) + set digits("VALID",5,4,2)=1 ;"total of 11 digits +"RTN","TMGNDF2E",346,0) + set digits("VALID",6,4,2)=1 ;"total of 12 digits +"RTN","TMGNDF2E",347,0) + ;"set digits("VALID",6,3,1)=1 ;"total of 10 digits +"RTN","TMGNDF2E",348,0) + +"RTN","TMGNDF2E",349,0) + ;"Remove single *'s +"RTN","TMGNDF2E",350,0) + set result=$$Substitute^TMGSTUTL(NDC,"**","##") ;"protect double **'s +"RTN","TMGNDF2E",351,0) + ;" 010130-*124-*1 --> 010130-*124-01 +"RTN","TMGNDF2E",352,0) + if ($piece(result,"-",2)["*")&($piece(result,"-",3)["*") do +"RTN","TMGNDF2E",353,0) + . set $piece(result,"-",3)=$translate($piece(result,"-",3),"*","0") +"RTN","TMGNDF2E",354,0) + ;" 010130-*124-01 --> 010130-124-01 +"RTN","TMGNDF2E",355,0) + set result=$translate(result,"*","") +"RTN","TMGNDF2E",356,0) + +"RTN","TMGNDF2E",357,0) + set result=$$Substitute^TMGSTUTL(result,"##","**") +"RTN","TMGNDF2E",358,0) + +"RTN","TMGNDF2E",359,0) + ;"Change ?'s into 0's +"RTN","TMGNDF2E",360,0) + if $length($piece(result,"-",2))=4 do +"RTN","TMGNDF2E",361,0) + . if $piece(result,"-",3)="??" set $piece(result,"-",3)="0" +"RTN","TMGNDF2E",362,0) + set result=$translate(result,"?","0") +"RTN","TMGNDF2E",363,0) + +"RTN","TMGNDF2E",364,0) +NNDCL1 +"RTN","TMGNDF2E",365,0) + set digits(1)=$length($piece(result,"-",1)) +"RTN","TMGNDF2E",366,0) + set digits(2)=$length($piece(result,"-",2)) +"RTN","TMGNDF2E",367,0) + set digits(3)=$length($piece(result,"-",3)) +"RTN","TMGNDF2E",368,0) + +"RTN","TMGNDF2E",369,0) + if result["**" do +"RTN","TMGNDF2E",370,0) + . if digits(2)=3 set result=$$Substitute^TMGSTUTL(result,"**","00") +"RTN","TMGNDF2E",371,0) + . else if digits(2)=4 set result=$$Substitute^TMGSTUTL(result,"**","0") +"RTN","TMGNDF2E",372,0) + . else do +"RTN","TMGNDF2E",373,0) + . . write "Error converting NDC code: ",NDC,! +"RTN","TMGNDF2E",374,0) + . . set result="",digits(1)=-1 +"RTN","TMGNDF2E",375,0) + . set digits(3)=$length($extract(result,"-",3)) +"RTN","TMGNDF2E",376,0) + +"RTN","TMGNDF2E",377,0) + ;"convert 12345-123-x --> 12345-123-0x +"RTN","TMGNDF2E",378,0) + if (digits(1)=5)&(digits(2)=3)&(digits(3)=1) do goto NNDCL1 +"RTN","TMGNDF2E",379,0) + . new value set value=+$piece(result,"-",3) +"RTN","TMGNDF2E",380,0) + . set $piece(result,"-",3)="0"_value +"RTN","TMGNDF2E",381,0) + +"RTN","TMGNDF2E",382,0) + set digits=digits(1)+digits(2)+digits(3) +"RTN","TMGNDF2E",383,0) + set valid=+$get(digits("VALID",digits(1),digits(2),digits(3))) +"RTN","TMGNDF2E",384,0) + +"RTN","TMGNDF2E",385,0) + if (valid'=1)&(digits(1)=6)&($extract(result,1,1)="0") do goto NNDCL1 +"RTN","TMGNDF2E",386,0) + . set result=$extract(result,2,99) +"RTN","TMGNDF2E",387,0) + +"RTN","TMGNDF2E",388,0) + if valid'=1 set result="" +"RTN","TMGNDF2E",389,0) + +"RTN","TMGNDF2E",390,0) + quit result +"RTN","TMGNDF2E",391,0) + +"RTN","TMGNDF2F") +0^45^B9113 +"RTN","TMGNDF2F",1,0) +TMGNDF2F ;TMG/kst/FDA Import: Fix drugs with missing ingredients ;03/25/06 +"RTN","TMGNDF2F",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF2F",3,0) + +"RTN","TMGNDF2F",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2F",5,0) + ;" Further processing, after functions in TMGNDF2E +"RTN","TMGNDF2F",6,0) + ;" Fixing drugs with missing ingredients (i.e. not provided by FDA database) +"RTN","TMGNDF2F",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2F",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2F",9,0) + ;"11-21-2006 +"RTN","TMGNDF2F",10,0) + +"RTN","TMGNDF2F",11,0) + ;"======================================================================= +"RTN","TMGNDF2F",12,0) + ;" API -- Public Functions. +"RTN","TMGNDF2F",13,0) + ;"======================================================================= +"RTN","TMGNDF2F",14,0) + ;" //no Menu -- will launch FixMissing from Menu^TMGNDF2E +"RTN","TMGNDF2F",15,0) + ;"======================================================================= +"RTN","TMGNDF2F",16,0) + ;"FixMissing -- Fix entries in file 22706.9 that don't have any ingredients, +"RTN","TMGNDF2F",17,0) + ;" either by finding similar drugs already present, and using +"RTN","TMGNDF2F",18,0) + ;" their ingredients, or asking user. +"RTN","TMGNDF2F",19,0) + +"RTN","TMGNDF2F",20,0) + ;"======================================================================= +"RTN","TMGNDF2F",21,0) + ;" Private Functions. +"RTN","TMGNDF2F",22,0) + ;"======================================================================= +"RTN","TMGNDF2F",23,0) + ;"GetMissing(List) -- Gather list of drugs that have no ingredients +"RTN","TMGNDF2F",24,0) + ;"GetSuggestions(List) -- expand list such that it contains suggested ingredients +"RTN","TMGNDF2F",25,0) + ;"Suggest1(IEN,Array) -- find a suggested answer for one record +"RTN","TMGNDF2F",26,0) + ;"SgstFromVAP(IEN,vapIEN,Array) -- Return list of ingredient IENs based on IEN from VA PRODUCT +"RTN","TMGNDF2F",27,0) + ;"SgstByName(IEN,Array) -- find suggested ingredients of one drug, based on IEN from 22706.9 +"RTN","TMGNDF2F",28,0) + ;"ShowList(Array,Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode) -- display the list generated by GetSuggestions +"RTN","TMGNDF2F",29,0) + ;"HandleList(Array) -- allow user to manipulate and fix problems found +"RTN","TMGNDF2F",30,0) + ;"XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS) -- carry out the various menu functions +"RTN","TMGNDF2F",31,0) + ;"SetSkip(Array,Answers,EntryList) -- remove entries from consideration for adding to 50.68 +"RTN","TMGNDF2F",32,0) + ;"ShowInfo(Array,Answers,EntryList) -- allow user to explore existing entries in 22706.9 file +"RTN","TMGNDF2F",33,0) + ;"Lookup(Array,Answers,EntryList) -- allow user to explore existing entries in 50.68 file +"RTN","TMGNDF2F",34,0) + ;"FixItems(Array,Answers,EntryList) -- Fix one item +"RTN","TMGNDF2F",35,0) + ;"AskFix1Item(Array,IEN) -- fix one entry, with user input +"RTN","TMGNDF2F",36,0) + ;"Show1(Array,IEN,Answers,ShowIgd) -- display the list generated by GetSuggestions +"RTN","TMGNDF2F",37,0) + ;"Look2Fix(IEN,Array) -- allow user to find a match to use for fixing. +"RTN","TMGNDF2F",38,0) + ;"KillMatch(IEN,Array,Answers,EntryList) -- remove VA PRODUCT matches from consideration +"RTN","TMGNDF2F",39,0) + ;"ArrayKill(IEN,Array) -- remove entry IEN from the Array of drugs to be fixed +"RTN","TMGNDF2F",40,0) + ;"Fix1From(IEN,vapIEN,Array,NoVerify) -- use rec in VA PRODUCT file to fix rec in TMG FDA IMPORT COMPILED +"RTN","TMGNDF2F",41,0) + ;"VerifySource(vapIEN) -- show the drug name, and the drug's ingredients, and ask user to verify choice +"RTN","TMGNDF2F",42,0) + ;"Copy1(vapIEN,IEN) -- fill in missing answers in the record in 22706.9, from record in 50.68 +"RTN","TMGNDF2F",43,0) + ;"ManIngredients(Array,Answers,EntryList) -- Manually Add ingredients to a list of records +"RTN","TMGNDF2F",44,0) + ;"AskManIngred(IEN,IngredArray) -- ask user for a list of ingredients, then add to record in 22706.9 +"RTN","TMGNDF2F",45,0) + ;"ShowIngreds(IngredArray) -- Show list of ingredients in array +"RTN","TMGNDF2F",46,0) + ;"Add1Ingredients(IEN,IngredArray) -- put a list of ingredients into one (1) record in 22706.9 +"RTN","TMGNDF2F",47,0) + +"RTN","TMGNDF2F",48,0) + ;"======================================================================= +"RTN","TMGNDF2F",49,0) + ;"======================================================================= +"RTN","TMGNDF2F",50,0) + +"RTN","TMGNDF2F",51,0) + ;"Note: The FDA database lists some drugs that do not have ingredients specified. +"RTN","TMGNDF2F",52,0) + ;" Some such drugs may not be wanted, and some others might have easily +"RTN","TMGNDF2F",53,0) + ;" identifiable ingredients (i.e. Lasix -->can figure out ingredient of furosemide) +"RTN","TMGNDF2F",54,0) + ;" So the purpose of this module is to handle those drugs that don't have +"RTN","TMGNDF2F",55,0) + ;" enough information for addition into the VistA system. +"RTN","TMGNDF2F",56,0) + +"RTN","TMGNDF2F",57,0) +FixMissing +"RTN","TMGNDF2F",58,0) + ;"Purpose: Fix entries in file 22706.9 that don't have any ingredients, +"RTN","TMGNDF2F",59,0) + ;" either by finding similar drugs already present, and using +"RTN","TMGNDF2F",60,0) + ;" their ingredients, or asking user. +"RTN","TMGNDF2F",61,0) + +"RTN","TMGNDF2F",62,0) + new List,Answers +"RTN","TMGNDF2F",63,0) + write "Scanning TMG FDA IMPORT COMPILED file for drugs with missing information.",! +"RTN","TMGNDF2F",64,0) + do GetMissing(.List) +"RTN","TMGNDF2F",65,0) + write ! +"RTN","TMGNDF2F",66,0) + write "Searching for potential fixes for each drug with missing information",! +"RTN","TMGNDF2F",67,0) + do GetSuggestions(.List) +"RTN","TMGNDF2F",68,0) + write ! +"RTN","TMGNDF2F",69,0) + do HandleList(.List) +"RTN","TMGNDF2F",70,0) + +"RTN","TMGNDF2F",71,0) + ;"do ShowList(.List,.Answers,1,0) +"RTN","TMGNDF2F",72,0) + +"RTN","TMGNDF2F",73,0) + quit +"RTN","TMGNDF2F",74,0) + +"RTN","TMGNDF2F",75,0) + +"RTN","TMGNDF2F",76,0) +GetMissing(List) +"RTN","TMGNDF2F",77,0) + ;"Purpose: Gather list of drugs that have no ingredients +"RTN","TMGNDF2F",78,0) + ;"Input: List -- PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF2F",79,0) + ;" format: +"RTN","TMGNDF2F",80,0) + ;" List(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",81,0) + ;" List(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",82,0) + ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",83,0) + ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",84,0) + ;"results: none +"RTN","TMGNDF2F",85,0) + +"RTN","TMGNDF2F",86,0) + new Itr,IEN +"RTN","TMGNDF2F",87,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2F",88,0) + do PrepProgress^TMGITR(.Itr,2) +"RTN","TMGNDF2F",89,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2F",90,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1;4=SKIP THIS RECORD +"RTN","TMGNDF2F",91,0) + . if +$piece($get(@Itr@(IEN,4,0)),"^",4)=0 do ;"4;0 -> header of INGREDIENTS subfile, part 4=rec count +"RTN","TMGNDF2F",92,0) + . . new TMGTradeName set TMGTradeName=$$GET1^DIQ(22706.9,IEN,.05) +"RTN","TMGNDF2F",93,0) + . . set TMGTradeName=$translate(TMGTradeName,"""","'") +"RTN","TMGNDF2F",94,0) + . . if TMGTradeName="" set TMGTradeName="?" +"RTN","TMGNDF2F",95,0) + . . new TMGGeneric set TMGGeneric=$$GET1^DIQ(22706.9,IEN,.07) +"RTN","TMGNDF2F",96,0) + . . set TMGGeneric=$translate(TMGGeneric,"""","'") +"RTN","TMGNDF2F",97,0) + . . if TMGGeneric="" set TMGGeneric="?" +"RTN","TMGNDF2F",98,0) + . . set List(IEN)=TMGTradeName_"^"_TMGGeneric +"RTN","TMGNDF2F",99,0) + . . if TMGGeneric'="?" set List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",100,0) + . . set List("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",101,0) + +"RTN","TMGNDF2F",102,0) + quit +"RTN","TMGNDF2F",103,0) + +"RTN","TMGNDF2F",104,0) + +"RTN","TMGNDF2F",105,0) +GetSuggestions(List) +"RTN","TMGNDF2F",106,0) + ;"Purpose: expand list such that it contains suggested ingredients +"RTN","TMGNDF2F",107,0) + ;"Input: List -- PASS BY REFERENCE, +"RTN","TMGNDF2F",108,0) + ;" List(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",109,0) + ;" List(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",110,0) + ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",111,0) + ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",112,0) + ;"Output: List is filled in, as follows: +"RTN","TMGNDF2F",113,0) + ;" List(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",114,0) + ;" List(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",115,0) + ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",116,0) + ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",117,0) + ;" List(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",118,0) + ;" List(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",119,0) + ;" List("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",120,0) + ;" List("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",121,0) + +"RTN","TMGNDF2F",122,0) + new IEN,Itr +"RTN","TMGNDF2F",123,0) + set IEN=$$ItrAInit^TMGITR("List",.Itr) +"RTN","TMGNDF2F",124,0) + do PrepProgress^TMGITR(.Itr,10) +"RTN","TMGNDF2F",125,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2F",126,0) + . do Suggest1(IEN,.List) +"RTN","TMGNDF2F",127,0) + +"RTN","TMGNDF2F",128,0) + quit +"RTN","TMGNDF2F",129,0) + +"RTN","TMGNDF2F",130,0) + +"RTN","TMGNDF2F",131,0) +Suggest1(IEN,Array) +"RTN","TMGNDF2F",132,0) + ;"Purpose: To find a suggested answer for one record +"RTN","TMGNDF2F",133,0) + ;"Input: IEN -- the IEN in file 22706.9 to find answer for +"RTN","TMGNDF2F",134,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. FORMAT: +"RTN","TMGNDF2F",135,0) + ;" Array(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",136,0) + ;" Array(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",137,0) + ;"Output: Array is returned +"RTN","TMGNDF2F",138,0) + ;" Note: RxIEN is IEN in file 50.416 +"RTN","TMGNDF2F",139,0) + ;" Array(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",140,0) + ;" Array(IEN)=TMGTradeName^VAGeneric +"RTN","TMGNDF2F",141,0) + ;" List(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",142,0) + ;" List(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",143,0) + ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",144,0) + ;" List(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",145,0) + ;"Results: none +"RTN","TMGNDF2F",146,0) + +"RTN","TMGNDF2F",147,0) + new Itr,RxIEN,vapIEN +"RTN","TMGNDF2F",148,0) + set vapIEN=$$ItrFInit^TMGITR(22706.914,.Itr,.RxIEN,.01,IEN,"I") +"RTN","TMGNDF2F",149,0) + if vapIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.RxIEN,.vapIEN)'>0) +"RTN","TMGNDF2F",150,0) + . do SgstFromVAP(IEN,vapIEN,.Array) +"RTN","TMGNDF2F",151,0) + +"RTN","TMGNDF2F",152,0) + kill Itr +"RTN","TMGNDF2F",153,0) + set RxIEN=$$ItrFInit^TMGITR(22706.915,.Itr,.RxIEN,.01,IEN,"I") +"RTN","TMGNDF2F",154,0) + if RxIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.RxIEN,.vapIEN)'>0) +"RTN","TMGNDF2F",155,0) + . do SgstFromVAP(IEN,RxIEN,.Array) +"RTN","TMGNDF2F",156,0) + +"RTN","TMGNDF2F",157,0) + do SgstByName(IEN,.Array) +"RTN","TMGNDF2F",158,0) + +"RTN","TMGNDF2F",159,0) + quit +"RTN","TMGNDF2F",160,0) + +"RTN","TMGNDF2F",161,0) + +"RTN","TMGNDF2F",162,0) +SgstFromVAP(IEN,vapIEN,Array) +"RTN","TMGNDF2F",163,0) + ;"Purpose: Return list of ingredient IENs based on IEN from VA PRODUCT +"RTN","TMGNDF2F",164,0) + ;"Input: IEN -- the IEN in file 22706.9 +"RTN","TMGNDF2F",165,0) + ;" vapIEN -- an IEN to file 50.68 (VA PRODUCT) +"RTN","TMGNDF2F",166,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. format: +"RTN","TMGNDF2F",167,0) + ;" Note: RxIEN is IEN in file 50.416 +"RTN","TMGNDF2F",168,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",169,0) + ;"Output: Array is filled with data, if found +"RTN","TMGNDF2F",170,0) + ;" Note: RxIEN is IEN in file 50.416 +"RTN","TMGNDF2F",171,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",172,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",173,0) + ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",174,0) + ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",175,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",176,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",177,0) + ;"Results: none. +"RTN","TMGNDF2F",178,0) + +"RTN","TMGNDF2F",179,0) + new Itr,igdIEN,IEN2 +"RTN","TMGNDF2F",180,0) + set igdIEN=$$ItrFInit^TMGITR(50.6814,.Itr,.IEN2,.01,vapIEN,"I") +"RTN","TMGNDF2F",181,0) + if igdIEN'="" for do quit:($$ItrFNext^TMGITR(.Itr,.IEN2,.igdIEN)'>0) +"RTN","TMGNDF2F",182,0) + . if igdIEN'=0 do +"RTN","TMGNDF2F",183,0) + . . new IENS set IENS=igdIEN_","_IEN_"," +"RTN","TMGNDF2F",184,0) + . . new IngredName set IngredName=$$GET1^DIQ(50.416,IENS,.01) +"RTN","TMGNDF2F",185,0) + . . set Array(IEN,"POSS IGD MATCH",igdIEN)=IngredName +"RTN","TMGNDF2F",186,0) + +"RTN","TMGNDF2F",187,0) + quit +"RTN","TMGNDF2F",188,0) + +"RTN","TMGNDF2F",189,0) + +"RTN","TMGNDF2F",190,0) +SgstByName(IEN,Array) +"RTN","TMGNDF2F",191,0) + ;"Purpose: to find suggested ingredients of one drug, based on IEN from 22706.9 +"RTN","TMGNDF2F",192,0) + ;"Input: IEN -- IEN from 22706.9 +"RTN","TMGNDF2F",193,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. format: +"RTN","TMGNDF2F",194,0) + ;" Note: RxIEN is IEN in file 50.416 +"RTN","TMGNDF2F",195,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",196,0) + ;"Output: Array is filled with data, if found +"RTN","TMGNDF2F",197,0) + ;" Note: RxIEN is IEN in file 50.416 +"RTN","TMGNDF2F",198,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",199,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",200,0) + ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",201,0) + ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",202,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",203,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",204,0) + ;"Results: none. +"RTN","TMGNDF2F",205,0) + +"RTN","TMGNDF2F",206,0) + new TMGTradeName,TMGFDA,TMGMSG,PriorErrorFound +"RTN","TMGNDF2F",207,0) + set TMGTradeName=$piece($get(Array(IEN)),"^",1) +"RTN","TMGNDF2F",208,0) + if (TMGTradeName="")!(TMGTradeName="?") goto SBNDone +"RTN","TMGNDF2F",209,0) + new Value set Value=$piece(TMGTradeName," ",1) +"RTN","TMGNDF2F",210,0) + do FIND^DIC(50.68,,.01,"M",Value,"*",,,,"TMGFDA","TMGMSG") +"RTN","TMGNDF2F",211,0) + if $data(TMGMSG("DIERR"))'=0 do goto SBNDone +"RTN","TMGNDF2F",212,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2F",213,0) + +"RTN","TMGNDF2F",214,0) + ;"Now gather ingredient list from results found +"RTN","TMGNDF2F",215,0) + new i,vapIEN +"RTN","TMGNDF2F",216,0) + for i=1:1:$piece($get(TMGFDA("DILIST",0)),"^",1) do +"RTN","TMGNDF2F",217,0) + . set vapIEN=+$get(TMGFDA("DILIST",2,i)) +"RTN","TMGNDF2F",218,0) + . new vapName set vapName=$$GET1^DIQ(50.68,vapIEN,.01) +"RTN","TMGNDF2F",219,0) + . set Array(IEN,"POSS RX MATCH",vapIEN)=vapName +"RTN","TMGNDF2F",220,0) + . do SgstFromVAP(IEN,vapIEN,.Array) +"RTN","TMGNDF2F",221,0) + +"RTN","TMGNDF2F",222,0) +SBNDone +"RTN","TMGNDF2F",223,0) + quit +"RTN","TMGNDF2F",224,0) + +"RTN","TMGNDF2F",225,0) + ;"======================================================================= +"RTN","TMGNDF2F",226,0) + +"RTN","TMGNDF2F",227,0) +ShowList(Array,Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode) +"RTN","TMGNDF2F",228,0) + ;"Purpose: To display the list generated by GetSuggestions +"RTN","TMGNDF2F",229,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format: +"RTN","TMGNDF2F",230,0) + ;" note IEN is from 22706.9 +"RTN","TMGNDF2F",231,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",232,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",233,0) + ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",234,0) + ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",235,0) + ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",236,0) + ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",237,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",238,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",239,0) + ;" Answers -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF2F",240,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",241,0) + ;" Answer(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",242,0) + ;" Answer(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",243,0) + ;" ShowBoth -- OPTIONAL, if value=1, thenTMGGeneric & TMGTrade names will both be shown. Default=0 +"RTN","TMGNDF2F",244,0) + ;" ByGeneric -- OPTIONAL, if value=1, then list is shown sorted by Generic Name. Default=0 +"RTN","TMGNDF2F",245,0) + ;" ShowIngred -- OPTIONAL, if value=1 then all possible ingredients are shown. Default=0 +"RTN","TMGNDF2F",246,0) + ;" CompactMode -- OPTIONAL, if value=1 then only 20 entries are shown. +"RTN","TMGNDF2F",247,0) + ;"Output: List is shown, and the Answers array is established and passed back. +"RTN","TMGNDF2F",248,0) + ;"Results: none. +"RTN","TMGNDF2F",249,0) + +"RTN","TMGNDF2F",250,0) + new someShown set someShown=0 +"RTN","TMGNDF2F",251,0) + new count +"RTN","TMGNDF2F",252,0) + set count=1 +"RTN","TMGNDF2F",253,0) + kill Answers +"RTN","TMGNDF2F",254,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF2F",255,0) + set ByGeneric=$get(ByGeneric,0) +"RTN","TMGNDF2F",256,0) + set ShowIngred=$get(ShowIngred,0) +"RTN","TMGNDF2F",257,0) + set CompactMode=$get(CompactMode,0) +"RTN","TMGNDF2F",258,0) + new NodeName set NodeName="BY TRADE" +"RTN","TMGNDF2F",259,0) + if ByGeneric=1 set NodeName="BY GENERIC" +"RTN","TMGNDF2F",260,0) + new ShortLen set ShortLen=25 +"RTN","TMGNDF2F",261,0) + +"RTN","TMGNDF2F",262,0) + write NodeName,! +"RTN","TMGNDF2F",263,0) + +"RTN","TMGNDF2F",264,0) + new done set done=0 +"RTN","TMGNDF2F",265,0) + new Itr,RxName,OtherName,IEN +"RTN","TMGNDF2F",266,0) + set RxName=$$ItrAInit^TMGITR("Array("""_NodeName_""")",.Itr) +"RTN","TMGNDF2F",267,0) + if RxName'="" for do quit:($$ItrANext^TMGITR(.Itr,.RxName)="")!(done=1) +"RTN","TMGNDF2F",268,0) + . new Itr2 +"RTN","TMGNDF2F",269,0) + . set IEN=$$ItrAInit^TMGITR("Array("""_NodeName_""","""_RxName_""")",.Itr2) +"RTN","TMGNDF2F",270,0) + . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN)'>0)!(done=1) +"RTN","TMGNDF2F",271,0) + . . set OtherName=$get(Array(NodeName,RxName,IEN)) +"RTN","TMGNDF2F",272,0) + . . set Answers(count)=IEN +"RTN","TMGNDF2F",273,0) + . . if (CompactMode=0)!(count'>ShortLen) do +"RTN","TMGNDF2F",274,0) + . . . new NumMatches set NumMatches=$$ListCt^TMGMISC("Array("""_IEN_""",""POSS RX MATCH"")") +"RTN","TMGNDF2F",275,0) + . . . write count,". ",RxName +"RTN","TMGNDF2F",276,0) + . . . if (ShowBoth)&(OtherName'="?") write " (",OtherName,")" +"RTN","TMGNDF2F",277,0) + . . . write " (",NumMatches," possible matches)",! +"RTN","TMGNDF2F",278,0) + . . set someShown=1 +"RTN","TMGNDF2F",279,0) + . . set count=count+1 +"RTN","TMGNDF2F",280,0) + . . if (CompactMode=1)&(count>ShortLen) quit +"RTN","TMGNDF2F",281,0) + . . new Itr3,IngredIEN set IngredIEN="" +"RTN","TMGNDF2F",282,0) + . . if ShowIngred=0 quit +"RTN","TMGNDF2F",283,0) + . . set IngredIEN=$$ItrAInit^TMGITR("Array("""_IEN_""",""POSS IGD MATCH"")",.Itr3) +"RTN","TMGNDF2F",284,0) + . . if IngredIEN'="" for do quit:($$ItrANext^TMGITR(.Itr3,.IngredIEN)="") +"RTN","TMGNDF2F",285,0) + . . . new IngredName set IngredName=$get(Array(IEN,"POSS IGD MATCH",IngredIEN)) +"RTN","TMGNDF2F",286,0) + . . . if IngredName'="" write " -- ",IngredName,! +"RTN","TMGNDF2F",287,0) + if (CompactMode=1)&(count>ShortLen) do +"RTN","TMGNDF2F",288,0) + . write "... ",(count-ShortLen-1)," other items truncated.",! +"RTN","TMGNDF2F",289,0) + +"RTN","TMGNDF2F",290,0) +SL2 if 'someShown write " --- (List is Empty) ---",! +"RTN","TMGNDF2F",291,0) + +"RTN","TMGNDF2F",292,0) +SLDone quit +"RTN","TMGNDF2F",293,0) + +"RTN","TMGNDF2F",294,0) + +"RTN","TMGNDF2F",295,0) +HandleList(Array) +"RTN","TMGNDF2F",296,0) + ;"Purpose: to allow user to manipulate and fix problems found +"RTN","TMGNDF2F",297,0) + ;"Input: Array -- PASS BY REFERENCE. The list as created by GetSuggestions() +"RTN","TMGNDF2F",298,0) + ;" note IEN is from 22706.9 +"RTN","TMGNDF2F",299,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",300,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",301,0) + ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",302,0) + ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",303,0) + ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",304,0) + ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",305,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",306,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",307,0) + +"RTN","TMGNDF2F",308,0) + new done set done=0 +"RTN","TMGNDF2F",309,0) + new input set input="R" +"RTN","TMGNDF2F",310,0) + new Answers +"RTN","TMGNDF2F",311,0) + new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verbose) +"RTN","TMGNDF2F",312,0) + new ShowBoth set ShowBoth=0 +"RTN","TMGNDF2F",313,0) + new ShowIngred set ShowIngred=0 +"RTN","TMGNDF2F",314,0) + new ByGeneric set ByGeneric=0 +"RTN","TMGNDF2F",315,0) + new EntryList,EntryS,Fn,Cancelled +"RTN","TMGNDF2F",316,0) + new CompactMode set CompactMode=1 +"RTN","TMGNDF2F",317,0) + set Cancelled=0 +"RTN","TMGNDF2F",318,0) + +"RTN","TMGNDF2F",319,0) + for do quit:(done=1) +"RTN","TMGNDF2F",320,0) + . if input="R" do +"RTN","TMGNDF2F",321,0) + . . write !! +"RTN","TMGNDF2F",322,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",323,0) + . . write "Specify which drugs to FIX",! +"RTN","TMGNDF2F",324,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",325,0) + . . do ShowList(.Array,.Answers,ShowBoth,ByGeneric,ShowIngred,CompactMode) +"RTN","TMGNDF2F",326,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",327,0) + . . write "Specify which drugs to FIX",! +"RTN","TMGNDF2F",328,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",329,0) + . . write " R to refresh, L lookup X remove from list, N iNfo",! +"RTN","TMGNDF2F",330,0) + . . write " M to Manually add Ingredients",! +"RTN","TMGNDF2F",331,0) + . . write " C turn Compact display ",$select((CompactMode=1):"OFF",1:"ON") +"RTN","TMGNDF2F",332,0) + . . write " I turn Show Ingredients display ",$select((ShowIngred=1):"OFF",1:"ON"),! +"RTN","TMGNDF2F",333,0) + . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! +"RTN","TMGNDF2F",334,0) + . . write " # or #-# or #,#-#,# etc., ^ done, ",! +"RTN","TMGNDF2F",335,0) + . write "Enter number(s) to Fix (or codes listed above): ^//" +"RTN","TMGNDF2F",336,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF2F",337,0) + . if input="" set input="^" +"RTN","TMGNDF2F",338,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2F",339,0) + . if input="^" set done=1 quit +"RTN","TMGNDF2F",340,0) + . if input="R" quit +"RTN","TMGNDF2F",341,0) + . else if input="I" do quit +"RTN","TMGNDF2F",342,0) + . . set ShowIngred='ShowIngred +"RTN","TMGNDF2F",343,0) + . . set input="R" +"RTN","TMGNDF2F",344,0) + . else if input="C" do quit +"RTN","TMGNDF2F",345,0) + . . set CompactMode='CompactMode +"RTN","TMGNDF2F",346,0) + . . set input="R" +"RTN","TMGNDF2F",347,0) + . else if input="M" do quit;"<----- Manual add Ingredients +"RTN","TMGNDF2F",348,0) + . . set Fn="do ManIngredients(.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",349,0) + . . do XMenuOption("MANUALLY add INGREDIENTS to",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",350,0) + . . set input="R" +"RTN","TMGNDF2F",351,0) + . else if input="D" do quit;"---- delete set +"RTN","TMGNDF2F",352,0) + . . kill EntryList,EntryS +"RTN","TMGNDF2F",353,0) + . . set input="R" +"RTN","TMGNDF2F",354,0) + . else if input="L" do quit;"<----- Do Lookup +"RTN","TMGNDF2F",355,0) + . . set input=1 ;"a dummy entry, not needed. +"RTN","TMGNDF2F",356,0) + . . set Fn="do Lookup(.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",357,0) + . . do XMenuOption("",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",358,0) + . else if input="N" do quit;"<----- Show Info +"RTN","TMGNDF2F",359,0) + . . set Fn="do ShowInfo(.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",360,0) + . . do XMenuOption("show INFO about",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",361,0) + . else if input="X" do quit;"<----- Set Skip +"RTN","TMGNDF2F",362,0) + . . set Fn="do SetSkip(.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",363,0) + . . do XMenuOption("specify NOT to ADD",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",364,0) + . . set input="R" +"RTN","TMGNDF2F",365,0) + . else do ;"default is ACCEPT +"RTN","TMGNDF2F",366,0) + . . set Cancelled=0 +"RTN","TMGNDF2F",367,0) + . . set Fn="do FixItems(.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",368,0) + . . do XMenuOption("",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",369,0) + . . set input="R" +"RTN","TMGNDF2F",370,0) + +"RTN","TMGNDF2F",371,0) + quit +"RTN","TMGNDF2F",372,0) + +"RTN","TMGNDF2F",373,0) + +"RTN","TMGNDF2F",374,0) +XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS) +"RTN","TMGNDF2F",375,0) + ;"Purpose: To carry out the various menu functions +"RTN","TMGNDF2F",376,0) + ;"Input: Prompt: the message to use to prompt user to enter numbers etc. +"RTN","TMGNDF2F",377,0) + ;" "Enter the Number(s) to" will be automatically provided +"RTN","TMGNDF2F",378,0) + ;" and ": (? help) ^// " will be added at end +"RTN","TMGNDF2F",379,0) + ;" FnStr: -- code to execute, e.g. "do DoLookup(.Array,.Answers,.Classes,.EntryList)" +"RTN","TMGNDF2F",380,0) + ;" HlpFn: e.g. FindHelp, SimHelp, LookupHelp, etc Don't add () to name +"RTN","TMGNDF2F",381,0) + ;" EntryList -- PASS BY REFERENCE +"RTN","TMGNDF2F",382,0) + ;" EntryS -- PASS BY REFERENCE. a string showing current set as a string +"RTN","TMGNDF2F",383,0) + ;"Note: makes use of global scope of 'input', and 'CompactMode', 'Cancelled' +"RTN","TMGNDF2F",384,0) + ;"Result: none. +"RTN","TMGNDF2F",385,0) + +"RTN","TMGNDF2F",386,0) + if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF2F",387,0) + . if Prompt'="" do +"RTN","TMGNDF2F",388,0) +XMO1 . . write "Enter the Number(s) to ",Prompt,": (? help) ^// " +"RTN","TMGNDF2F",389,0) + . . read input,! +"RTN","TMGNDF2F",390,0) + . . if (input="?") do goto XMO1 +"RTN","TMGNDF2F",391,0) + . . . if Hlpfn="" write "(Sorry, no help available)",! quit +"RTN","TMGNDF2F",392,0) + . . . new Code set Code="do "_HlpFn_"()" +"RTN","TMGNDF2F",393,0) + . . . Xecute code +"RTN","TMGNDF2F",394,0) + . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF2F",395,0) + . if valid set EntryS=input +"RTN","TMGNDF2F",396,0) + Xecute FnStr +"RTN","TMGNDF2F",397,0) + if $get(CompactMode)=1 set input="R" +"RTN","TMGNDF2F",398,0) + if $get(Cancelled)=0 kill EntryList,EntryS +"RTN","TMGNDF2F",399,0) + +"RTN","TMGNDF2F",400,0) + quit +"RTN","TMGNDF2F",401,0) + +"RTN","TMGNDF2F",402,0) + +"RTN","TMGNDF2F",403,0) +SetSkip(Array,Answers,EntryList) +"RTN","TMGNDF2F",404,0) + ;"Purpose: To remove entries from consideration for adding to 50.68 +"RTN","TMGNDF2F",405,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",406,0) + ;" Answers -- PASS BY REFERENCE +"RTN","TMGNDF2F",407,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",408,0) + ;" Answers(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",409,0) + ;" Answers(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",410,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",411,0) + ;" Format as follows. +"RTN","TMGNDF2F",412,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",413,0) + ;" EntryList(Entry number)="" +"RTN","TMGNDF2F",414,0) + ;"Results: none +"RTN","TMGNDF2F",415,0) + +"RTN","TMGNDF2F",416,0) + new Itr,Count,IEN +"RTN","TMGNDF2F",417,0) + set Count=$$ItrAInit^TMGITR("EntryList",.Itr) +"RTN","TMGNDF2F",418,0) + if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0) +"RTN","TMGNDF2F",419,0) + . set IEN=$piece($get(Answers(Count)),"^",1) +"RTN","TMGNDF2F",420,0) + . if IEN="" quit +"RTN","TMGNDF2F",421,0) + . new TMGTradeName,TMGGeneric +"RTN","TMGNDF2F",422,0) + . set TMGTradeName=$piece($get(Array(IEN)),"^",1) +"RTN","TMGNDF2F",423,0) + . set TMGGeneric=$piece($get(Array(IEN)),"^",2) +"RTN","TMGNDF2F",424,0) + . ;"I could put in some undo code here... +"RTN","TMGNDF2F",425,0) + . set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"set skipflag to true +"RTN","TMGNDF2F",426,0) + . ;"Now delete data from display data +"RTN","TMGNDF2F",427,0) + . kill Array(IEN) +"RTN","TMGNDF2F",428,0) + . if (TMGGeneric'="") kill Array("BY GENERIC",TMGGeneric,IEN) +"RTN","TMGNDF2F",429,0) + . if (TMGTradeName'="") kill Array("BY TRADE",TMGTradeName,IEN) +"RTN","TMGNDF2F",430,0) + +"RTN","TMGNDF2F",431,0) + quit +"RTN","TMGNDF2F",432,0) + +"RTN","TMGNDF2F",433,0) + +"RTN","TMGNDF2F",434,0) +ShowInfo(Array,Answers,EntryList) +"RTN","TMGNDF2F",435,0) + ;"Purpose: To allow user to explore existing entries in 22706.9 file +"RTN","TMGNDF2F",436,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",437,0) + ;" Answers -- PASS BY REFERENCE, +"RTN","TMGNDF2F",438,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",439,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",440,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",441,0) + ;" Format as follows. +"RTN","TMGNDF2F",442,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",443,0) + +"RTN","TMGNDF2F",444,0) + new Itr,Count,IEN +"RTN","TMGNDF2F",445,0) + set Count=$$ItrAInit^TMGITR("EntryList",.Itr) +"RTN","TMGNDF2F",446,0) + if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0) +"RTN","TMGNDF2F",447,0) + . set IEN=$piece($get(Answers(Count)),"^",1) +"RTN","TMGNDF2F",448,0) + . do DumpRec2^TMGDEBUG(22706.9,IEN,0) +"RTN","TMGNDF2F",449,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2F",450,0) + +"RTN","TMGNDF2F",451,0) + quit +"RTN","TMGNDF2F",452,0) + +"RTN","TMGNDF2F",453,0) + +"RTN","TMGNDF2F",454,0) +Lookup(Array,Answers,EntryList) +"RTN","TMGNDF2F",455,0) + ;"Purpose: To allow user to explore existing entries in 50.68 file +"RTN","TMGNDF2F",456,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",457,0) + ;" Answers -- PASS BY REFERENCE, +"RTN","TMGNDF2F",458,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",459,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",460,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",461,0) + ;" Format as follows. +"RTN","TMGNDF2F",462,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",463,0) + +"RTN","TMGNDF2F",464,0) + new DIC,Y +"RTN","TMGNDF2F",465,0) + set DIC=50.68 +"RTN","TMGNDF2F",466,0) + set DIC(0)="MAEQ" +"RTN","TMGNDF2F",467,0) + do ^DIC write ! +"RTN","TMGNDF2F",468,0) + if +Y>0 do +"RTN","TMGNDF2F",469,0) + . do DumpRec2^TMGDEBUG(50.68,+Y,0) +"RTN","TMGNDF2F",470,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2F",471,0) + +"RTN","TMGNDF2F",472,0) + quit +"RTN","TMGNDF2F",473,0) + +"RTN","TMGNDF2F",474,0) +FixItems(Array,Answers,EntryList) +"RTN","TMGNDF2F",475,0) + ;"Purpose: To Fix one item +"RTN","TMGNDF2F",476,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",477,0) + ;" Answers -- PASS BY REFERENCE +"RTN","TMGNDF2F",478,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",479,0) + ;" Answers(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",480,0) + ;" Answers(count)=IEN^TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",481,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",482,0) + ;" Format as follows. +"RTN","TMGNDF2F",483,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",484,0) + ;" EntryList(Entry number)="" +"RTN","TMGNDF2F",485,0) + ;"Results: none +"RTN","TMGNDF2F",486,0) + +"RTN","TMGNDF2F",487,0) + new Itr,Count,IEN +"RTN","TMGNDF2F",488,0) + new done set done=0 +"RTN","TMGNDF2F",489,0) + new vapIEN set vapIEN=0 ;"for first cycle, no ready answer available. +"RTN","TMGNDF2F",490,0) + +"RTN","TMGNDF2F",491,0) + set Count=$$ItrAInit^TMGITR("EntryList",.Itr) +"RTN","TMGNDF2F",492,0) + if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0)!(done=1) +"RTN","TMGNDF2F",493,0) + . set IEN=$piece($get(Answers(Count)),"^",1) +"RTN","TMGNDF2F",494,0) + . if vapIEN'=0 do ;"If we've already fixed on, use same answer for rest of list +"RTN","TMGNDF2F",495,0) + . . if $$Fix1From(IEN,vapIEN,.Array,1)=0 set done=1 +"RTN","TMGNDF2F",496,0) + . else do +"RTN","TMGNDF2F",497,0) + . . set vapIEN=$$AskFix1Item(.Array,IEN) +"RTN","TMGNDF2F",498,0) + . . if vapIEN=0 set done=1 +"RTN","TMGNDF2F",499,0) + . if done=1 quit +"RTN","TMGNDF2F",500,0) + . do ArrayKill(IEN,.Array) ;"delete data from display data +"RTN","TMGNDF2F",501,0) + +"RTN","TMGNDF2F",502,0) + quit +"RTN","TMGNDF2F",503,0) + +"RTN","TMGNDF2F",504,0) + +"RTN","TMGNDF2F",505,0) +AskFix1Item(Array,IEN) +"RTN","TMGNDF2F",506,0) + ;"Purpose: to fix one entry, with user input +"RTN","TMGNDF2F",507,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",508,0) + ;" IEN -- the Record to fix. +"RTN","TMGNDF2F",509,0) + ;"Results: 1 if item Fixed, 0 if not +"RTN","TMGNDF2F",510,0) + +"RTN","TMGNDF2F",511,0) + ;"First, ask if the drug is similar enough that a copy of that other drug +"RTN","TMGNDF2F",512,0) + ;" is allowed +"RTN","TMGNDF2F",513,0) + ;"Next, (if above fails), ask for matching of possible ingredients +"RTN","TMGNDF2F",514,0) + ;"If no ingredient found, even consider adding a new ingredient to INGREDIENT file +"RTN","TMGNDF2F",515,0) + +"RTN","TMGNDF2F",516,0) + new done set done=0 +"RTN","TMGNDF2F",517,0) + new input set input="R" +"RTN","TMGNDF2F",518,0) + new Answers,Fn +"RTN","TMGNDF2F",519,0) + new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verbose) +"RTN","TMGNDF2F",520,0) + new ShowBoth set ShowBoth=0 +"RTN","TMGNDF2F",521,0) + new ShowIngred set ShowIngred=0 +"RTN","TMGNDF2F",522,0) + new ByGeneric set ByGeneric=0 +"RTN","TMGNDF2F",523,0) + new EntryList,EntryS,Fn,Cancelled +"RTN","TMGNDF2F",524,0) + new FixedWithIEN set FixedWithIEN=0 +"RTN","TMGNDF2F",525,0) + +"RTN","TMGNDF2F",526,0) + for do quit:(done=1) +"RTN","TMGNDF2F",527,0) + . if input="R" do +"RTN","TMGNDF2F",528,0) + . . write !! +"RTN","TMGNDF2F",529,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",530,0) + . . write "Specify CLOSEST MATCH (IGNORE DOSE & FORM)",! +"RTN","TMGNDF2F",531,0) + . . do Show1(.Array,IEN,.Answers,0) +"RTN","TMGNDF2F",532,0) + . . if $$ListCt^TMGMISC("Answers")>20 do +"RTN","TMGNDF2F",533,0) + . . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",534,0) + . . . write "Specify CLOSEST MATCH (IGNORE DOSE & FORM)",! +"RTN","TMGNDF2F",535,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF2F",536,0) + . . write " R to refresh, F to find Match",! +"RTN","TMGNDF2F",537,0) + . . write " X to remove from list",! +"RTN","TMGNDF2F",538,0) + . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! +"RTN","TMGNDF2F",539,0) + . . write " ^ if done, ",! +"RTN","TMGNDF2F",540,0) + . write "Enter number to ACCEPT (or codes listed above): ^//" +"RTN","TMGNDF2F",541,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF2F",542,0) + . if input="" set input="^" +"RTN","TMGNDF2F",543,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2F",544,0) + . if input="^" set done=1 quit +"RTN","TMGNDF2F",545,0) + . if input="R" quit +"RTN","TMGNDF2F",546,0) + . else if input="D" do quit;"---- delete set +"RTN","TMGNDF2F",547,0) + . . kill EntryList,EntryS +"RTN","TMGNDF2F",548,0) + . . set input="R" +"RTN","TMGNDF2F",549,0) + . else if input="F" do quit;"<----- Look for answer +"RTN","TMGNDF2F",550,0) + . . set FixedWithIEN=$$Look2Fix(IEN,.Array) +"RTN","TMGNDF2F",551,0) + . . if FixedWithIEN'=0 set done=1 +"RTN","TMGNDF2F",552,0) + . . else set input="R" +"RTN","TMGNDF2F",553,0) + . else if input="X" do quit;"<----- Set Skip +"RTN","TMGNDF2F",554,0) + . . set Fn="do KillMatch(IEN,.Array,.Answers,.EntryList)" +"RTN","TMGNDF2F",555,0) + . . do XMenuOption("specify match NOT to USE",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF2F",556,0) + . else do ;"default is ACCEPT +"RTN","TMGNDF2F",557,0) + . . if (input["-")!(input[",") write "ENTER ONLY *ONE* ENTRY NUMBER",! quit +"RTN","TMGNDF2F",558,0) + . . new vapIEN set vapIEN=+$get(Answers(+input)) +"RTN","TMGNDF2F",559,0) + . . if vapIEN>0 set FixedWithIEN=$$Fix1From(IEN,vapIEN,.Array) +"RTN","TMGNDF2F",560,0) + . . if FixedWithIEN'=0 set done=1 +"RTN","TMGNDF2F",561,0) + . . else set input="R" +"RTN","TMGNDF2F",562,0) + +"RTN","TMGNDF2F",563,0) + quit FixedWithIEN +"RTN","TMGNDF2F",564,0) + +"RTN","TMGNDF2F",565,0) + +"RTN","TMGNDF2F",566,0) +Show1(Array,IEN,Answers,ShowIgd) +"RTN","TMGNDF2F",567,0) + ;"Purpose: To display the list generated by GetSuggestions +"RTN","TMGNDF2F",568,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",569,0) + ;" IEN -- the One entry to display +"RTN","TMGNDF2F",570,0) + ;" Answers -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF2F",571,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",572,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",573,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",574,0) + ;" ShowIgd -- OPTIONAL, if value=1 then ingredients will be shown, otherwise +"RTN","TMGNDF2F",575,0) + ;" matches in VA PRODUCT FILE are shown. +"RTN","TMGNDF2F",576,0) + ;"Output: List is shown, and the Answers array is established and passed back. +"RTN","TMGNDF2F",577,0) + ;"Results: none. +"RTN","TMGNDF2F",578,0) + +"RTN","TMGNDF2F",579,0) + new someShown set someShown=0 +"RTN","TMGNDF2F",580,0) + new count set count=1 +"RTN","TMGNDF2F",581,0) + kill Answers +"RTN","TMGNDF2F",582,0) + new NodeName set NodeName="POSS RX MATCH" +"RTN","TMGNDF2F",583,0) + if $get(ShowIgd)=1 set NodeName="POSS IGD MATCH" +"RTN","TMGNDF2F",584,0) + +"RTN","TMGNDF2F",585,0) + new Itr,subIEN +"RTN","TMGNDF2F",586,0) + new TMGTradeName,TMGGeneric +"RTN","TMGNDF2F",587,0) + +"RTN","TMGNDF2F",588,0) + set TMGTradeName=$piece($get(Array(IEN)),"^",1) +"RTN","TMGNDF2F",589,0) + set TMGGeneric=$piece($get(Array(IEN)),"^",2) +"RTN","TMGNDF2F",590,0) + write " For: ",TMGTradeName +"RTN","TMGNDF2F",591,0) + if (TMGGeneric'="?")&(TMGGeneric'="") write " (",TMGGeneric,")" +"RTN","TMGNDF2F",592,0) + write ! +"RTN","TMGNDF2F",593,0) + write "--------------------------------------------------",! +"RTN","TMGNDF2F",594,0) + +"RTN","TMGNDF2F",595,0) + if $get(IEN)="" goto S1Done +"RTN","TMGNDF2F",596,0) + +"RTN","TMGNDF2F",597,0) + set subIEN=$$ItrAInit^TMGITR("Array("_IEN_","""_NodeName_""")",.Itr) +"RTN","TMGNDF2F",598,0) + if subIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.subIEN)="") +"RTN","TMGNDF2F",599,0) + . set Answers(count)=subIEN +"RTN","TMGNDF2F",600,0) + . new Name set Name=$get(Array(IEN,NodeName,subIEN)) +"RTN","TMGNDF2F",601,0) + . write count,". ",Name,! +"RTN","TMGNDF2F",602,0) + . set count=count+1 +"RTN","TMGNDF2F",603,0) + . set someShown=1 +"RTN","TMGNDF2F",604,0) + +"RTN","TMGNDF2F",605,0) +S1Done +"RTN","TMGNDF2F",606,0) + if 'someShown write " --- (List is Empty) ---",! +"RTN","TMGNDF2F",607,0) + quit +"RTN","TMGNDF2F",608,0) + +"RTN","TMGNDF2F",609,0) + +"RTN","TMGNDF2F",610,0) +Look2Fix(IEN,Array) +"RTN","TMGNDF2F",611,0) + ;"Purpose: To allow user to find a match to use for fixing. +"RTN","TMGNDF2F",612,0) + ;"Input: IEN -- the IEN to fix +"RTN","TMGNDF2F",613,0) + ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",614,0) + ;"Result: 0 if no fix, or vapIEN (IEN in 50.68) otherwise +"RTN","TMGNDF2F",615,0) + +"RTN","TMGNDF2F",616,0) + new result set result=0 ;"default to failure +"RTN","TMGNDF2F",617,0) + +"RTN","TMGNDF2F",618,0) + write "SEARCH for a drug that can be used to fix incomplete entry.",! +"RTN","TMGNDF2F",619,0) + new DIC,Y +"RTN","TMGNDF2F",620,0) + set DIC=50.68 +"RTN","TMGNDF2F",621,0) + set DIC(0)="MAEQ" +"RTN","TMGNDF2F",622,0) + do ^DIC write ! +"RTN","TMGNDF2F",623,0) + if +Y>0 do +"RTN","TMGNDF2F",624,0) + . if $$Fix1From(IEN,+Y,.Array)=1 set result=+Y +"RTN","TMGNDF2F",625,0) + +"RTN","TMGNDF2F",626,0) + quit result +"RTN","TMGNDF2F",627,0) + +"RTN","TMGNDF2F",628,0) + +"RTN","TMGNDF2F",629,0) +KillMatch(IEN,Array,Answers,EntryList) +"RTN","TMGNDF2F",630,0) + ;"Purpose: To remove VA PRODUCT matches from consideration +"RTN","TMGNDF2F",631,0) + ;"Input: IEN -- the IEN in 22706.9, +"RTN","TMGNDF2F",632,0) + ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",633,0) + ;" Answers -- PASS BY REFERENCE, +"RTN","TMGNDF2F",634,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",635,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",636,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",637,0) + ;" Format as follows. +"RTN","TMGNDF2F",638,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",639,0) + +"RTN","TMGNDF2F",640,0) + new Itr,Count,subIEN +"RTN","TMGNDF2F",641,0) + set Count=$$ItrAInit^TMGITR("EntryList",.Itr) +"RTN","TMGNDF2F",642,0) + if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0) +"RTN","TMGNDF2F",643,0) + . set subIEN=$piece($get(Answers(Count)),"^",1) +"RTN","TMGNDF2F",644,0) + . new TMGTradeName,TMGGeneric +"RTN","TMGNDF2F",645,0) + . set TMGTradeName=$piece($get(Array(IEN)),"^",1) +"RTN","TMGNDF2F",646,0) + . set TMGGeneric=$piece($get(Array(IEN)),"^",2) +"RTN","TMGNDF2F",647,0) + . ;"I could put in some undo code here... +"RTN","TMGNDF2F",648,0) + . ;"Now delete data from display data +"RTN","TMGNDF2F",649,0) + . ;"kill Array(IEN,"POSS RX MATCH",subIEN) +"RTN","TMGNDF2F",650,0) + . do ArrayKill(IEN,.Array) +"RTN","TMGNDF2F",651,0) + quit +"RTN","TMGNDF2F",652,0) + +"RTN","TMGNDF2F",653,0) + +"RTN","TMGNDF2F",654,0) +ArrayKill(IEN,Array) +"RTN","TMGNDF2F",655,0) + ;"Purpose: to remove entry IEN from the Array of drugs to be fixed +"RTN","TMGNDF2F",656,0) + ;"Input: IEN -- the IEN to remove +"RTN","TMGNDF2F",657,0) + ;" Array -- the array with the drug info. Format as follows: +"RTN","TMGNDF2F",658,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",659,0) + ;" Array(IEN)=TMGTradeName^TMGGeneric +"RTN","TMGNDF2F",660,0) + ;" Array("BY GENERIC",TMGGeneric,IEN)=TMGTradeName +"RTN","TMGNDF2F",661,0) + ;" Array("BY TRADE",TMGTradeName,IEN)=TMGGeneric +"RTN","TMGNDF2F",662,0) + ;" Array(IEN,"POSS IGD MATCH",igdIEN)=IngredientName +"RTN","TMGNDF2F",663,0) + ;" Array(IEN,"POSS IGD MATCH"igdIEN)=IngredientName +"RTN","TMGNDF2F",664,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",665,0) + ;" Array(IEN,"POSS RX MATCH",RxIEN)=vapEntryName +"RTN","TMGNDF2F",666,0) + +"RTN","TMGNDF2F",667,0) + new TMGTradeName,TMGGeneric +"RTN","TMGNDF2F",668,0) + set TMGTradeName=$piece($get(Array(IEN)),"^",1) +"RTN","TMGNDF2F",669,0) + set TMGGeneric=$piece($get(Array(IEN)),"^",2) +"RTN","TMGNDF2F",670,0) + if TMGTradeName="" set TMGTradeName="?" +"RTN","TMGNDF2F",671,0) + if TMGGeneric="" set TMGGeneric="?" +"RTN","TMGNDF2F",672,0) + kill Array(IEN) +"RTN","TMGNDF2F",673,0) + kill Array("BY TRADE",TMGTradeName,IEN) +"RTN","TMGNDF2F",674,0) + kill Array("BY GENERIC",TMGGeneric,IEN) +"RTN","TMGNDF2F",675,0) + +"RTN","TMGNDF2F",676,0) + quit +"RTN","TMGNDF2F",677,0) + +"RTN","TMGNDF2F",678,0) + +"RTN","TMGNDF2F",679,0) +Fix1From(IEN,vapIEN,Array,NoVerify) +"RTN","TMGNDF2F",680,0) + ;"Purpose: To take a record in VA PRODUCT file (50.68) and use this to fix record in +"RTN","TMGNDF2F",681,0) + ;" TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF2F",682,0) + ;"Input: IEN -- the IEN in 22706.9, +"RTN","TMGNDF2F",683,0) + ;" vapIEN -- the IEN in 50.68 to fix from +"RTN","TMGNDF2F",684,0) + ;" Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",685,0) + ;" NoVerify -- OPTIONAL, if value=1 no user verification asked. Default=0 +"RTN","TMGNDF2F",686,0) + ;"result: 1 if OK to continue, 0 if user abort +"RTN","TMGNDF2F",687,0) + +"RTN","TMGNDF2F",688,0) + new result set result=0 ;"default to failure +"RTN","TMGNDF2F",689,0) + +"RTN","TMGNDF2F",690,0) + if $get(NoVerify,0)=0,$$VerifySource(vapIEN)=0 goto F1FDone +"RTN","TMGNDF2F",691,0) + ;"I could put in some undo code here... BUT undoing changes from Copy1 would be HARD +"RTN","TMGNDF2F",692,0) + if $$Copy1(vapIEN,IEN)=0 goto F1FDone +"RTN","TMGNDF2F",693,0) + do ArrayKill(IEN,.Array) +"RTN","TMGNDF2F",694,0) + set result=1 ;"success +"RTN","TMGNDF2F",695,0) + +"RTN","TMGNDF2F",696,0) +F1FDone +"RTN","TMGNDF2F",697,0) + quit result +"RTN","TMGNDF2F",698,0) + +"RTN","TMGNDF2F",699,0) + +"RTN","TMGNDF2F",700,0) +VerifySource(vapIEN) +"RTN","TMGNDF2F",701,0) + ;"Purpose: to show the drug name, and the drug's ingredients, and ask user to verify choice +"RTN","TMGNDF2F",702,0) + ;"Input: vapIEN -- IEN in file 50.68 +"RTN","TMGNDF2F",703,0) + ;"Result: 1 if OK to use this drug. 0 if don't use +"RTN","TMGNDF2F",704,0) + +"RTN","TMGNDF2F",705,0) + new PriorErrorFound +"RTN","TMGNDF2F",706,0) + new result set result=0 +"RTN","TMGNDF2F",707,0) + write "-------------------------------------------------",! +"RTN","TMGNDF2F",708,0) + write "Drug Information:",! +"RTN","TMGNDF2F",709,0) + write "-------------------------------------------------",! +"RTN","TMGNDF2F",710,0) + ;"write "NAME: ",$$GET1^DIQ(50.68,vapIEN,.01),! +"RTN","TMGNDF2F",711,0) + write "GENERIC NAME: ",$$GET1^DIQ(50.68,vapIEN,.05),! +"RTN","TMGNDF2F",712,0) + write "INGREDIENTS:",! +"RTN","TMGNDF2F",713,0) + new TMGMSG,TMGFDA +"RTN","TMGNDF2F",714,0) + do LIST^DIC(50.6814,","_vapIEN_",",".01;1","","*",,,,,,"TMGFDA","TMGMSG") +"RTN","TMGNDF2F",715,0) + if $data(TMGMSG("DIERR"))'=0 do goto VSDone +"RTN","TMGNDF2F",716,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2F",717,0) + new i +"RTN","TMGNDF2F",718,0) + for i=1:1:+$get(TMGFDA("DILIST",0)) do +"RTN","TMGNDF2F",719,0) + . write " ",$get(TMGFDA("DILIST",1,i)),! +"RTN","TMGNDF2F",720,0) + write "-------------------------------------------------",! +"RTN","TMGNDF2F",721,0) + write "Use this drug to fix entry in FDA database" +"RTN","TMGNDF2F",722,0) + new % set %=1 +"RTN","TMGNDF2F",723,0) + do YN^DICN write ! +"RTN","TMGNDF2F",724,0) + if %=1 set result=1 +"RTN","TMGNDF2F",725,0) + +"RTN","TMGNDF2F",726,0) +VSDone +"RTN","TMGNDF2F",727,0) + quit result +"RTN","TMGNDF2F",728,0) + +"RTN","TMGNDF2F",729,0) + +"RTN","TMGNDF2F",730,0) +Copy1(vapIEN,IEN) +"RTN","TMGNDF2F",731,0) + ;"Purpose: to fill in missing answers in the record in 22706.9, from record in 50.68 +"RTN","TMGNDF2F",732,0) + ;"Input: vapIEN -- IEN in 50.68 +"RTN","TMGNDF2F",733,0) + ;" IEN -- IEN in 22706.9 +"RTN","TMGNDF2F",734,0) + ;"Result: 1 if OK to continue, 0 if error +"RTN","TMGNDF2F",735,0) + +"RTN","TMGNDF2F",736,0) + new result set result=0 ;"default to failure +"RTN","TMGNDF2F",737,0) + new error set error=0 +"RTN","TMGNDF2F",738,0) + new PriorErrorFound +"RTN","TMGNDF2F",739,0) + +"RTN","TMGNDF2F",740,0) + new CompFields set CompFields=".08;.05^.09;15" +"RTN","TMGNDF2F",741,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF2F",742,0) + new i,TMGField,vapField +"RTN","TMGNDF2F",743,0) + for i=1:1:$length(CompFields,"^") do +"RTN","TMGNDF2F",744,0) + . new field1,field2,comp +"RTN","TMGNDF2F",745,0) + . new Value1,Value2 +"RTN","TMGNDF2F",746,0) + . set comp=$piece(CompFields,"^",i) +"RTN","TMGNDF2F",747,0) + . set field1=$piece(comp,";",1) +"RTN","TMGNDF2F",748,0) + . set field2=$piece(comp,";",2) +"RTN","TMGNDF2F",749,0) + . set Value1=$$GET1^DIQ(22706.9,IEN,field1) +"RTN","TMGNDF2F",750,0) + . set Value2=$$GET1^DIQ(50.68,vapIEN,field2) +"RTN","TMGNDF2F",751,0) + . if (Value1="")&(Value2'="") do +"RTN","TMGNDF2F",752,0) + . . set TMGFDA(22706.9,IEN_",",field1)=Value2 +"RTN","TMGNDF2F",753,0) + +"RTN","TMGNDF2F",754,0) + if $data(TMGFDA) do goto:(error=1) C1Done +"RTN","TMGNDF2F",755,0) + . do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF2F",756,0) + . if $data(TMGMSG("DIERR"))'=0 do +"RTN","TMGNDF2F",757,0) + . . set error=1 +"RTN","TMGNDF2F",758,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2F",759,0) + +"RTN","TMGNDF2F",760,0) + ;"Now prep to copy over ingredients... +"RTN","TMGNDF2F",761,0) +X1 new Itr,subIEN,IngredArray,tempIEN +"RTN","TMGNDF2F",762,0) + set subIEN=$$ItrInit^TMGITR(50.6814,.Itr,vapIEN) +"RTN","TMGNDF2F",763,0) + if subIEN>0 for do quit:($$ItrNext^TMGITR(.Itr,.subIEN)'>0)!(error=1) +"RTN","TMGNDF2F",764,0) + . set tempIEN=+$piece($get(^PSNDF(50.68,vapIEN,2,subIEN,0)),"^",1) +"RTN","TMGNDF2F",765,0) + . if tempIEN'>0 quit +"RTN","TMGNDF2F",766,0) + . kill TMGFDA +"RTN","TMGNDF2F",767,0) + . do FIND^DIC(22706.916,","_IEN_",",".01","AQ",tempIEN,"*",,,,"TMGFDA","TMGMSG") +"RTN","TMGNDF2F",768,0) + . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF2F",769,0) + . . set error=1 +"RTN","TMGNDF2F",770,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2F",771,0) + . if $get(TMGFDA("DILIST",0))>0 quit +"RTN","TMGNDF2F",772,0) + . set IngredArray(tempIEN)="" ;"store ingredients. Next I'll see if they are new +"RTN","TMGNDF2F",773,0) + +"RTN","TMGNDF2F",774,0) + set result=$$Add1Ingredients(IEN,.IngredArray) +"RTN","TMGNDF2F",775,0) + +"RTN","TMGNDF2F",776,0) +C1Done +"RTN","TMGNDF2F",777,0) + quit result +"RTN","TMGNDF2F",778,0) + +"RTN","TMGNDF2F",779,0) + +"RTN","TMGNDF2F",780,0) +ManIngredients(Array,Answers,EntryList) +"RTN","TMGNDF2F",781,0) + ;"Purpose: to Manually Add ingredients to a list of records +"RTN","TMGNDF2F",782,0) + ;"Input: Array -- PASS BY REFERENCE. Array with data. Format same as for HandleList +"RTN","TMGNDF2F",783,0) + ;" Answers -- PASS BY REFERENCE, +"RTN","TMGNDF2F",784,0) + ;" An array that will link display numbers with IENs +"RTN","TMGNDF2F",785,0) + ;" Answer(count)=IEN +"RTN","TMGNDF2F",786,0) + ;" EntryList -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF2F",787,0) + ;" Format as follows. +"RTN","TMGNDF2F",788,0) + ;" EntryList(Entry number)="" (same as count above) +"RTN","TMGNDF2F",789,0) + ;"Result: None +"RTN","TMGNDF2F",790,0) + +"RTN","TMGNDF2F",791,0) + new Itr,Count,IEN +"RTN","TMGNDF2F",792,0) + new IngredArray +"RTN","TMGNDF2F",793,0) + new result set result=1 +"RTN","TMGNDF2F",794,0) + +"RTN","TMGNDF2F",795,0) + set Count=$$ItrAInit^TMGITR("EntryList",.Itr) +"RTN","TMGNDF2F",796,0) + if Count>0 for do quit:($$ItrANext^TMGITR(.Itr,.Count)'>0) +"RTN","TMGNDF2F",797,0) + . set IEN=$piece($get(Answers(Count)),"^",1) +"RTN","TMGNDF2F",798,0) + . if $data(IngredArray)=0 do +"RTN","TMGNDF2F",799,0) + . . set result=$$AskManIngred(IEN,.IngredArray) +"RTN","TMGNDF2F",800,0) + . else do +"RTN","TMGNDF2F",801,0) + . . set result=$$Add1Ingredients(IEN,.IngredArray) +"RTN","TMGNDF2F",802,0) + . ;"I could put in some undo code here... +"RTN","TMGNDF2F",803,0) + . if result=0 kill IngredArray quit +"RTN","TMGNDF2F",804,0) + . do ArrayKill(IEN,.Array) +"RTN","TMGNDF2F",805,0) + +"RTN","TMGNDF2F",806,0) + quit +"RTN","TMGNDF2F",807,0) + +"RTN","TMGNDF2F",808,0) + +"RTN","TMGNDF2F",809,0) +AskManIngred(IEN,IngredArray) +"RTN","TMGNDF2F",810,0) + ;"Purpose: To ask user for a list of ingredients, then add to record in 22706.9 +"RTN","TMGNDF2F",811,0) + ;"Input: IEN -- the IEN in 22706.9 to have ingredients added to +"RTN","TMGNDF2F",812,0) + ;" IngredArray -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF2F",813,0) + ;" Ised to pass back out list of ingredients, so they can be used for other enteries +"RTN","TMGNDF2F",814,0) + ;" Any former entries in list will be killed +"RTN","TMGNDF2F",815,0) + ;"Result: 1 = OK To Continue, 0 if abort +"RTN","TMGNDF2F",816,0) + +"RTN","TMGNDF2F",817,0) + new result set result=0 +"RTN","TMGNDF2F",818,0) + kill IngredArray +"RTN","TMGNDF2F",819,0) + +"RTN","TMGNDF2F",820,0) + new DIC,Y +"RTN","TMGNDF2F",821,0) + set DIC=50.416,DIC(0)="AEQML" +"RTN","TMGNDF2F",822,0) + set DIC("A")="Enter a drug INGREDIENT to add (^ when done): " +"RTN","TMGNDF2F",823,0) + +"RTN","TMGNDF2F",824,0) + for do quit:(+Y'>0) +"RTN","TMGNDF2F",825,0) + . do ^DIC +"RTN","TMGNDF2F",826,0) + . if +Y>0 set IngredArray(+Y)="" +"RTN","TMGNDF2F",827,0) + . else write ! quit +"RTN","TMGNDF2F",828,0) + . write " ... OK, added.",! +"RTN","TMGNDF2F",829,0) + +"RTN","TMGNDF2F",830,0) + if $data(IngredArray)=0 goto AMIDone +"RTN","TMGNDF2F",831,0) + +"RTN","TMGNDF2F",832,0) + write "Done adding new ingredients.",!! +"RTN","TMGNDF2F",833,0) + new % set %=1 +"RTN","TMGNDF2F",834,0) + write "Ingredient List:",! +"RTN","TMGNDF2F",835,0) + write "------------------------------",! +"RTN","TMGNDF2F",836,0) + do ShowIngreds(.IngredArray) +"RTN","TMGNDF2F",837,0) + write "Add INGREDIENT(S) to selected drugs:" +"RTN","TMGNDF2F",838,0) + do YN^DICN write ! +"RTN","TMGNDF2F",839,0) + if %'=1 goto AMIDone +"RTN","TMGNDF2F",840,0) + +"RTN","TMGNDF2F",841,0) + set result=$$Add1Ingredients(IEN,.IngredArray) +"RTN","TMGNDF2F",842,0) + +"RTN","TMGNDF2F",843,0) +AMIDone +"RTN","TMGNDF2F",844,0) + quit result +"RTN","TMGNDF2F",845,0) + +"RTN","TMGNDF2F",846,0) + +"RTN","TMGNDF2F",847,0) +ShowIngreds(IngredArray) +"RTN","TMGNDF2F",848,0) + ;"Purpose: to Show list of ingredients in array +"RTN","TMGNDF2F",849,0) + +"RTN","TMGNDF2F",850,0) + new IEN,Itr +"RTN","TMGNDF2F",851,0) + set IEN=$$ItrAInit^TMGITR("IngredArray",.Itr) +"RTN","TMGNDF2F",852,0) + if IEN>0 for do quit:($$ItrANext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF2F",853,0) + . write " ",$$GET1^DIQ(50.416,IEN,.01),! +"RTN","TMGNDF2F",854,0) + +"RTN","TMGNDF2F",855,0) + quit +"RTN","TMGNDF2F",856,0) + +"RTN","TMGNDF2F",857,0) + +"RTN","TMGNDF2F",858,0) +Add1Ingredients(IEN,IngredArray) +"RTN","TMGNDF2F",859,0) + ;"Purpose: To put a list of ingredients into one (1) record in 22706.9 +"RTN","TMGNDF2F",860,0) + ;"Input: IEN -- the IEN in 22706.9 to load ingredients into +"RTN","TMGNDF2F",861,0) + ;" IngredArray -- array with list of ingredients. Format as follows: +"RTN","TMGNDF2F",862,0) + ;" IngredArray(ingredIEN)="" +"RTN","TMGNDF2F",863,0) + ;" IngredArray(ingredIEN)="" +"RTN","TMGNDF2F",864,0) + ;"Output: Ingredients will be added to 22706.9. Note: If ingredients are already present, they +"RTN","TMGNDF2F",865,0) + ;" will be added a second time. +"RTN","TMGNDF2F",866,0) + ;" Also, FillGenericName will be called to fill in TMGGeneric Name +"RTN","TMGNDF2F",867,0) + ;"Results: 1 if OK to continue, 0 if error +"RTN","TMGNDF2F",868,0) + +"RTN","TMGNDF2F",869,0) + new Itr,TMGFDA,TMGMSG,tempIEN +"RTN","TMGNDF2F",870,0) + new result set result=0 ;"default to failure +"RTN","TMGNDF2F",871,0) + new error set error=0 +"RTN","TMGNDF2F",872,0) + +"RTN","TMGNDF2F",873,0) + ;"Cycle through IngredArray, and set up FDA for adding to 22706.9 +"RTN","TMGNDF2F",874,0) + kill Itr,TMGFDA +"RTN","TMGNDF2F",875,0) + set tempIEN=$$ItrAInit^TMGITR("IngredArray",.Itr) +"RTN","TMGNDF2F",876,0) + if tempIEN'="" for do quit:(+$$ItrANext^TMGITR(.Itr,.tempIEN)'>0) +"RTN","TMGNDF2F",877,0) + . new IENS set IENS="+"_tempIEN_","_IEN_"," ;" +# format with # as arbitrary unique number +"RTN","TMGNDF2F",878,0) + . set TMGFDA(22706.916,IENS,.01)=tempIEN ;"an arbitrary index number +"RTN","TMGNDF2F",879,0) + . set TMGFDA(22706.916,IENS,2)=tempIEN ;"a pointer to the ingredent +"RTN","TMGNDF2F",880,0) + +"RTN","TMGNDF2F",881,0) + ;"Call UPDATE^DIE with FDA +"RTN","TMGNDF2F",882,0) + if $data(TMGFDA) do goto:(error=1) ADIDone +"RTN","TMGNDF2F",883,0) + . new TMGIEN +"RTN","TMGNDF2F",884,0) + . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2F",885,0) + . if $data(TMGMSG("DIERR"))'=0 do +"RTN","TMGNDF2F",886,0) + . . set error=1 +"RTN","TMGNDF2F",887,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2F",888,0) + +"RTN","TMGNDF2F",889,0) + ;"Create a generic name from ingredients +"RTN","TMGNDF2F",890,0) + do FillGenericName^TMGNDF1C(IEN) +"RTN","TMGNDF2F",891,0) + +"RTN","TMGNDF2F",892,0) + set result=1 ;"success +"RTN","TMGNDF2F",893,0) +ADIDone +"RTN","TMGNDF2F",894,0) + quit result +"RTN","TMGNDF2G") +0^46^B7234 +"RTN","TMGNDF2G",1,0) +TMGNDF2G ;TMG/kst/FDA Import: Setup shortened drug names ;03/25/06 +"RTN","TMGNDF2G",2,0) + ;;1.0;TMG-LIB;**1**;02/24/07 +"RTN","TMGNDF2G",3,0) + +"RTN","TMGNDF2G",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2G",5,0) + ;" Creation of shortened version of drug names +"RTN","TMGNDF2G",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2G",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2G",8,0) + ;"2-24-2007 +"RTN","TMGNDF2G",9,0) + +"RTN","TMGNDF2G",10,0) + ;"======================================================================= +"RTN","TMGNDF2G",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF2G",12,0) + ;"======================================================================= +"RTN","TMGNDF2G",13,0) + +"RTN","TMGNDF2G",14,0) + ;"Menu -- Ensure other version of drug names available. +"RTN","TMGNDF2G",15,0) + +"RTN","TMGNDF2G",16,0) + ;"======================================================================= +"RTN","TMGNDF2G",17,0) + ;" Private Functions. +"RTN","TMGNDF2G",18,0) + ;"======================================================================= +"RTN","TMGNDF2G",19,0) + ;"MakeAltNames -- scan through all entries and set up shortened names. +"RTN","TMGNDF2G",20,0) + ;"Make1Alt(IEN) --fix the names for just 1 record in 22706.9 +"RTN","TMGNDF2G",21,0) + ;"GetIENArray(Array) -- Gather IENS to work on +"RTN","TMGNDF2G",22,0) + ;"GetPrepArray(IENArray,PrepArray) -- Prepare names for addition into 40 length fields +"RTN","TMGNDF2G",23,0) + ;"PrepNames(IEN,Value55,Value56,Value75,Value76,PrepArray,AllowCut) -- Get names for IEN +"RTN","TMGNDF2G",24,0) + ;"AskArray(IENArray,PrepArray) -- get array with possible fixes for 1 record +"RTN","TMGNDF2G",25,0) + ;"Write1(IEN,name55,name56,name75,namd76) --write 1 record in 22706.9 file +"RTN","TMGNDF2G",26,0) + ;"DispFixArray(PrepArray,MapArray,compactMode) -- Display values in PrepArray +"RTN","TMGNDF2G",27,0) + +"RTN","TMGNDF2G",28,0) + +"RTN","TMGNDF2G",29,0) + ;"======================================================================= +"RTN","TMGNDF2G",30,0) + +"RTN","TMGNDF2G",31,0) +Menu +"RTN","TMGNDF2G",32,0) + ;"Purpose: -- Ensure shortened version of drug names available. +"RTN","TMGNDF2G",33,0) + +"RTN","TMGNDF2G",34,0) + new Menu,UsrSlct +"RTN","TMGNDF2G",35,0) + set Menu(0)="Pick Option to Ensure All Versions of Names (2G)" +"RTN","TMGNDF2G",36,0) + set Menu(1)="Ensure all drug names are ready"_$char(9)_"MakeAltNames" +"RTN","TMGNDF2G",37,0) + set Menu(2)="Check for blank names"_$char(9)_"CheckForBlanks" +"RTN","TMGNDF2G",38,0) + set Menu(3)="Check for BAD names"_$char(9)_"ScanBadName" +"RTN","TMGNDF2G",39,0) + set Menu(4)="Ask and fix name for ONE import"_$char(9)_"FixOneName" +"RTN","TMGNDF2G",40,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF2G",41,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF2G",42,0) + +"RTN","TMGNDF2G",43,0) +M1 write # +"RTN","TMGNDF2G",44,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2G",45,0) + +"RTN","TMGNDF2G",46,0) + if UsrSlct="MakeAltNames" do MakeAltNames goto M1 +"RTN","TMGNDF2G",47,0) + if UsrSlct="CheckForBlanks" do CheckForBlanks goto M1 +"RTN","TMGNDF2G",48,0) + if UsrSlct="FixOneName" do AskMake1 goto M1 +"RTN","TMGNDF2G",49,0) + if UsrSlct="ScanBadName" do ScanBadName goto M1 +"RTN","TMGNDF2G",50,0) + if UsrSlct="Prev" goto Menu^TMGNDF2E ;"quit can occur from there... +"RTN","TMGNDF2G",51,0) + if UsrSlct="Next" goto Menu^TMGNDF2H ;"quit can occur from there... +"RTN","TMGNDF2G",52,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF2G",53,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF2G",54,0) + goto M1 +"RTN","TMGNDF2G",55,0) + +"RTN","TMGNDF2G",56,0) +MenuDone +"RTN","TMGNDF2G",57,0) + quit +"RTN","TMGNDF2G",58,0) + +"RTN","TMGNDF2G",59,0) + ;"======================================================================================= +"RTN","TMGNDF2G",60,0) + +"RTN","TMGNDF2G",61,0) + +"RTN","TMGNDF2G",62,0) + ;"======================================================================================= +"RTN","TMGNDF2G",63,0) +MakeAltNames +"RTN","TMGNDF2G",64,0) + ;"Purpose: To scan through all entries and set up alternative names. +"RTN","TMGNDF2G",65,0) + ;"Input: none +"RTN","TMGNDF2G",66,0) + ;"Results: none. +"RTN","TMGNDF2G",67,0) + ;"Output: Fields .055, .056, .075, .076 will be filled +"RTN","TMGNDF2G",68,0) + ;"Results: none +"RTN","TMGNDF2G",69,0) + +"RTN","TMGNDF2G",70,0) + new IENArray,PrepArray +"RTN","TMGNDF2G",71,0) + write "Scanning existing names of imports not skipped...",! +"RTN","TMGNDF2G",72,0) + do GetIENArray(.IENArray) +"RTN","TMGNDF2G",73,0) + +"RTN","TMGNDF2G",74,0) + write "Preparing suggested names...",! +"RTN","TMGNDF2G",75,0) + do GetPrepArray(.IENArray,.PrepArray) +"RTN","TMGNDF2G",76,0) + +"RTN","TMGNDF2G",77,0) + if $data(PrepArray)=0 do goto MKSNDone +"RTN","TMGNDF2G",78,0) + . write "No fixes required. Great!",! +"RTN","TMGNDF2G",79,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2G",80,0) + +"RTN","TMGNDF2G",81,0) + do AskArray(.IENArray,.PrepArray) +"RTN","TMGNDF2G",82,0) + +"RTN","TMGNDF2G",83,0) +MKSNDone +"RTN","TMGNDF2G",84,0) + write "Goodbye.",! +"RTN","TMGNDF2G",85,0) + quit +"RTN","TMGNDF2G",86,0) + +"RTN","TMGNDF2G",87,0) + +"RTN","TMGNDF2G",88,0) +AskMake1 +"RTN","TMGNDF2G",89,0) + ;"Purpose: Ask user for record in 22706.9, and then fix +"RTN","TMGNDF2G",90,0) + +"RTN","TMGNDF2G",91,0) + new DIC,X,Y +"RTN","TMGNDF2G",92,0) + set DIC=22706.9,DIC(0)="MAEQ" +"RTN","TMGNDF2G",93,0) + do ^DIC write ! +"RTN","TMGNDF2G",94,0) + if +Y>0 do Make1Alt(+Y) +"RTN","TMGNDF2G",95,0) + quit +"RTN","TMGNDF2G",96,0) + +"RTN","TMGNDF2G",97,0) + +"RTN","TMGNDF2G",98,0) +Make1Alt(IEN,Option) +"RTN","TMGNDF2G",99,0) + ;"Purpose: to fix the names for just 1 record in 22706.9 +"RTN","TMGNDF2G",100,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF2G",101,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF2G",102,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF2G",103,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF2G",104,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF2G",105,0) + ;"Note: ignores if drug is to be skipped. +"RTN","TMGNDF2G",106,0) + +"RTN","TMGNDF2G",107,0) + new IENArray,PrepArray +"RTN","TMGNDF2G",108,0) + +"RTN","TMGNDF2G",109,0) + set IENArray(IEN,.04)=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;" .04, LONG NAME +"RTN","TMGNDF2G",110,0) + set IENArray(IEN,.055)=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;".055, TRADENAME - 40 +"RTN","TMGNDF2G",111,0) + set IENArray(IEN,.056)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".056, TRADENAME DOSE UNIT FORM - 40 +"RTN","TMGNDF2G",112,0) + set IENArray(IEN,.075)=$piece($get(^TMG(22706.9,IEN,7)),"^",4) ;".075, GENERIC NAME - 40 +"RTN","TMGNDF2G",113,0) + set IENArray(IEN,.076)=$piece($get(^TMG(22706.9,IEN,8)),"^",1) ;".076 GENERICNAME DOSE UNT FORM - 40 +"RTN","TMGNDF2G",114,0) + +"RTN","TMGNDF2G",115,0) + do GetPrepArray(.IENArray,.PrepArray,0) ;"0=no allow cut +"RTN","TMGNDF2G",116,0) + +"RTN","TMGNDF2G",117,0) + if $data(PrepArray)=0 do goto MKSNDone +"RTN","TMGNDF2G",118,0) + . write "No drug name fixes required. Great!",! +"RTN","TMGNDF2G",119,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2G",120,0) + +"RTN","TMGNDF2G",121,0) + do AskArray(.IENArray,.PrepArray) +"RTN","TMGNDF2G",122,0) + +"RTN","TMGNDF2G",123,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF2G",124,0) + . set OPTION("FIX CHAIN","IEN22706d9")=IEN +"RTN","TMGNDF2G",125,0) + . do Refresh1^TMGNDF3C(IEN22706d9,.Option) +"RTN","TMGNDF2G",126,0) + +"RTN","TMGNDF2G",127,0) +M1ADone +"RTN","TMGNDF2G",128,0) + write "Goodbye.",! +"RTN","TMGNDF2G",129,0) + quit +"RTN","TMGNDF2G",130,0) + +"RTN","TMGNDF2G",131,0) + +"RTN","TMGNDF2G",132,0) + +"RTN","TMGNDF2G",133,0) +GetIENArray(Array) +"RTN","TMGNDF2G",134,0) + ;"Purpose: Gather IENS to work on +"RTN","TMGNDF2G",135,0) + ;"Input: Array -- PASS BY REFERENCE Output Format: +"RTN","TMGNDF2G",136,0) + ;" Note: IEN is from file 22706.9 +"RTN","TMGNDF2G",137,0) + ;" Array(IEN,.04)=currentValue +"RTN","TMGNDF2G",138,0) + ;" Array(IEN,.05)=currentValue +"RTN","TMGNDF2G",139,0) + ;" Array(IEN,.055)=currentValue +"RTN","TMGNDF2G",140,0) + ;" Array(IEN,.056)=currentValue +"RTN","TMGNDF2G",141,0) + ;" Array(IEN,.07)=currentValue +"RTN","TMGNDF2G",142,0) + ;" Array(IEN,.075)=currentValue +"RTN","TMGNDF2G",143,0) + ;" Array(IEN,.076)=currentValue +"RTN","TMGNDF2G",144,0) + ;"Results: none +"RTN","TMGNDF2G",145,0) + +"RTN","TMGNDF2G",146,0) + new Itr,IEN +"RTN","TMGNDF2G",147,0) + new abort set abort=0 +"RTN","TMGNDF2G",148,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2G",149,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2G",150,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2G",151,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2G",152,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2G",153,0) + . new s0,s7,s8 +"RTN","TMGNDF2G",154,0) + . set s0=$get(^TMG(22706.9,IEN,0)) +"RTN","TMGNDF2G",155,0) + . set s7=$get(^TMG(22706.9,IEN,7)) +"RTN","TMGNDF2G",156,0) + . set s8=$get(^TMG(22706.9,IEN,8)) +"RTN","TMGNDF2G",157,0) + . set Array(IEN,.04)=$piece(s7,"^",6) ;" .04 LONG NAME +"RTN","TMGNDF2G",158,0) + . set Array(IEN,.05)=$piece(s0,"^",4) ;" .05 TRADENAME +"RTN","TMGNDF2G",159,0) + . set Array(IEN,.055)=$piece(s7,"^",3) ;".055 TRADENAME - 40 +"RTN","TMGNDF2G",160,0) + . set Array(IEN,.056)=$piece(s8,"^",1) ;".056 TRADENAME DOSE UNIT FORM - 40 +"RTN","TMGNDF2G",161,0) + . set Array(IEN,.07)=$piece(s0,"^",6) ;" .07 GENERIC NAME +"RTN","TMGNDF2G",162,0) + . set Array(IEN,.075)=$piece(s7,"^",4) ;".075 GENERIC NAME - 40 +"RTN","TMGNDF2G",163,0) + . set Array(IEN,.076)=$piece(s8,"^",2) ;".076 GENERICNAME DOSE UNT FORM - 40 +"RTN","TMGNDF2G",164,0) + +"RTN","TMGNDF2G",165,0) + quit +"RTN","TMGNDF2G",166,0) + +"RTN","TMGNDF2G",167,0) + +"RTN","TMGNDF2G",168,0) +GetPrepArray(IENArray,PrepArray,AllowCut) +"RTN","TMGNDF2G",169,0) + ;"Purpose: Prepare names for addition into .055 (TRADENAME - 40) +"RTN","TMGNDF2G",170,0) + ;" and .075 (GENERIC NAME - 40) fields +"RTN","TMGNDF2G",171,0) + ;"Input: IENArray -- PASS BY REFERENCE Format: +"RTN","TMGNDF2G",172,0) + ;" Array(IEN,.04)=currentValue +"RTN","TMGNDF2G",173,0) + ;" Array(IEN,.055)=currentValue +"RTN","TMGNDF2G",174,0) + ;" Array(IEN,.075)=currentValue +"RTN","TMGNDF2G",175,0) + ;" PrepArray -- PASS BY REFERENCE Format: +"RTN","TMGNDF2G",176,0) + ;" PrepArray(IEN1,.04)=Name for .04 +"RTN","TMGNDF2G",177,0) + ;" PrepArray(IEN1,.055)=Name for .055 +"RTN","TMGNDF2G",178,0) + ;" PrepArray(IEN1,.056)=Name for .056 +"RTN","TMGNDF2G",179,0) + ;" PrepArray(IEN1,.075)=Name for .075 +"RTN","TMGNDF2G",180,0) + ;" PrepArray(IEN1,.076)=Name for .076 +"RTN","TMGNDF2G",181,0) + ;" AllowCut -- OPTIONAL. Default=1. If 1, then automatic shortening of names allowed +"RTN","TMGNDF2G",182,0) + ;"Output: PrepArray is Filled +"RTN","TMGNDF2G",183,0) + ;"Results: none +"RTN","TMGNDF2G",184,0) + +"RTN","TMGNDF2G",185,0) + set AllowCut=$get(AllowCut,1) +"RTN","TMGNDF2G",186,0) + new Itr,IEN,abort +"RTN","TMGNDF2G",187,0) + set abort=0 +"RTN","TMGNDF2G",188,0) + set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) +"RTN","TMGNDF2G",189,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN") +"RTN","TMGNDF2G",190,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2G",191,0) + . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGNDF2G",192,0) + . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04)) +"RTN","TMGNDF2G",193,0) + . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055)) +"RTN","TMGNDF2G",194,0) + . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056)) +"RTN","TMGNDF2G",195,0) + . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075)) +"RTN","TMGNDF2G",196,0) + . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076)) +"RTN","TMGNDF2G",197,0) + . set abort=$$PrepNames(IEN,Cur04Value,Cur55Value,Cur56Value,Cur75Value,Cur76Value,.PrepArray,AllowCut) +"RTN","TMGNDF2G",198,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2G",199,0) + +"RTN","TMGNDF2G",200,0) + quit +"RTN","TMGNDF2G",201,0) + +"RTN","TMGNDF2G",202,0) + +"RTN","TMGNDF2G",203,0) +PrepNames(IEN,Value04,Value55,Value56,Value75,Value76,PrepArray,AllowCut) +"RTN","TMGNDF2G",204,0) + ;"Purpose: To get names for IEN +"RTN","TMGNDF2G",205,0) + ;"Input: IEN -- the ien in file 22706.9 +"RTN","TMGNDF2G",206,0) + ;" Value04 -- the current value for field .04 +"RTN","TMGNDF2G",207,0) + ;" Value55 -- the current value for field .055 +"RTN","TMGNDF2G",208,0) + ;" Value56 -- the current value for field .056 +"RTN","TMGNDF2G",209,0) + ;" Value75 -- the current value for field .075 +"RTN","TMGNDF2G",210,0) + ;" Value76 -- the current value for field .076 +"RTN","TMGNDF2G",211,0) + ;" PrepArray -- PASS BY REFERENCE. and OUT PARAMETER. +"RTN","TMGNDF2G",212,0) + ;" Format: +"RTN","TMGNDF2G",213,0) + ;" PrepArray(IEN,.04)=Name for .04 +"RTN","TMGNDF2G",214,0) + ;" PrepArray(IEN,.055)=Name for .055 +"RTN","TMGNDF2G",215,0) + ;" PrepArray(IEN,.056)=Name for .056 +"RTN","TMGNDF2G",216,0) + ;" PrepArray(IEN,.075)=Name for .075 +"RTN","TMGNDF2G",217,0) + ;" PrepArray(IEN,.076)=Name for .076 +"RTN","TMGNDF2G",218,0) + ;" AllowCut -- OPTIONAL. Default=1. If 1 then user not prompted to shorten names +"RTN","TMGNDF2G",219,0) + ;"Output: PrepArray is Filled +"RTN","TMGNDF2G",220,0) + ;"Results: 0=OK to Continue, 1=abort +"RTN","TMGNDF2G",221,0) + +"RTN","TMGNDF2G",222,0) + new result set result=0 +"RTN","TMGNDF2G",223,0) + set AllowCut=$get(AllowCut,1) +"RTN","TMGNDF2G",224,0) + new MaxLen set MaxLen=40 +"RTN","TMGNDF2G",225,0) + +"RTN","TMGNDF2G",226,0) + ;"==Set up .04 Name (LONG NAME) ========================== +"RTN","TMGNDF2G",227,0) + new New04Value set New04Value=$$MakeName(IEN,63,AllowCut,1) ;",1) Mode=Full Name +"RTN","TMGNDF2G",228,0) + if New04Value="^" set result=1 goto PNDone +"RTN","TMGNDF2G",229,0) + if $length(New04Value)>63 do +"RTN","TMGNDF2G",230,0) + . set New04Value=$extract(New04Value,1,63-3)_"..." +"RTN","TMGNDF2G",231,0) + if (New04Value["...")&(Value04'["...")&(Value04'="") set New04Value="" +"RTN","TMGNDF2G",232,0) + if (New04Value'=Value04)&(New04Value'="") do +"RTN","TMGNDF2G",233,0) + . set PrepArray(IEN,.04)=New04Value +"RTN","TMGNDF2G",234,0) + +"RTN","TMGNDF2G",235,0) + ;"==Set up .075 Name (GENERIC NAME & FORM - 40)=========== +"RTN","TMGNDF2G",236,0) + new New75Value set New75Value=$$MakeName(IEN,MaxLen,AllowCut,5) ;",5) Mode=Generic Name +"RTN","TMGNDF2G",237,0) + if New75Value="^" set result=1 goto PNDone +"RTN","TMGNDF2G",238,0) + if $length(New75Value)>MaxLen do +"RTN","TMGNDF2G",239,0) + . set New75Value=$extract(New75Value,1,MaxLen-3)_"..." +"RTN","TMGNDF2G",240,0) + if (New75Value["...")&(Value75'["...")&(Value75'="") set New75Value="" +"RTN","TMGNDF2G",241,0) + if (New75Value'=Value75)&(New75Value'="") do +"RTN","TMGNDF2G",242,0) + . set PrepArray(IEN,.075)=New75Value +"RTN","TMGNDF2G",243,0) + +"RTN","TMGNDF2G",244,0) + ;"==Set up .076 Name (GENERICNAME FORM DOSE UNT - 40) ==== +"RTN","TMGNDF2G",245,0) + new New76Value set New76Value=$$MakeName(IEN,MaxLen,AllowCut,3) ;"3 -> GenericName DrugForm Strength Units +"RTN","TMGNDF2G",246,0) + if New76Value="^" set result=1 goto PNDone +"RTN","TMGNDF2G",247,0) + if $length(New76Value)>MaxLen do +"RTN","TMGNDF2G",248,0) + . set New76Value=$extract(New76Value,1,MaxLen-3)_"..." +"RTN","TMGNDF2G",249,0) + if (New76Value["...")&(Value76'["...")&(Value76'="") set New76Value="" +"RTN","TMGNDF2G",250,0) + if (New76Value'=Value76)&(New76Value'="") do +"RTN","TMGNDF2G",251,0) + . set PrepArray(IEN,.076)=New76Value +"RTN","TMGNDF2G",252,0) + +"RTN","TMGNDF2G",253,0) + ;"==Set up .055 Name (TRADE NAME & FORM - 40) ============ +"RTN","TMGNDF2G",254,0) + new New55Value set New55Value=$$MakeName(IEN,MaxLen,AllowCut,4) ;",4) Mode=TradeName +"RTN","TMGNDF2G",255,0) + if New55Value="^" set result=1 goto PNDone +"RTN","TMGNDF2G",256,0) + if $length(New55Value)>MaxLen do +"RTN","TMGNDF2G",257,0) + . set New55Value=$extract(New55Value,1,MaxLen-3)_"..." +"RTN","TMGNDF2G",258,0) + if (New55Value["...")&(Value55'["...")&(Value55'="") set New55Value="" +"RTN","TMGNDF2G",259,0) + if New55Value=New75Value set New55Value="" ;"WAS "@" +"RTN","TMGNDF2G",260,0) + if (New55Value'=Value55)&(New55Value'="") do +"RTN","TMGNDF2G",261,0) + . ;"if (New55Value="@")&(Value55="") quit +"RTN","TMGNDF2G",262,0) + . set PrepArray(IEN,.055)=New55Value +"RTN","TMGNDF2G",263,0) + +"RTN","TMGNDF2G",264,0) + ;"==Set up .056 Name (TRADENAME FORM DOSE UNIT - 40) ==== +"RTN","TMGNDF2G",265,0) + new New56Value set New56Value=$$MakeName(IEN,MaxLen,AllowCut,6) ;"6 -> TradeName DrugForm Strength Units +"RTN","TMGNDF2G",266,0) + if New56Value="^" set result=1 goto PNDone +"RTN","TMGNDF2G",267,0) + if $length(New56Value)>MaxLen do +"RTN","TMGNDF2G",268,0) + . set New56Value=$extract(New56Value,1,MaxLen-3)_"..." +"RTN","TMGNDF2G",269,0) + if (New56Value["...")&(Value56'["...")&(Value56'="") set New56Value="" +"RTN","TMGNDF2G",270,0) + if New56Value=New76Value set New56Value="" ;"WAS "@" +"RTN","TMGNDF2G",271,0) + if (New56Value'=Value56)&(New56Value'="") do +"RTN","TMGNDF2G",272,0) + . ;"if (New56Value="@")&(Value56="") quit +"RTN","TMGNDF2G",273,0) + . set PrepArray(IEN,.056)=New56Value +"RTN","TMGNDF2G",274,0) + +"RTN","TMGNDF2G",275,0) +PNDone quit result +"RTN","TMGNDF2G",276,0) + +"RTN","TMGNDF2G",277,0) + +"RTN","TMGNDF2G",278,0) +MakeName(IEN,MaxLen,AllowCut,Mode) +"RTN","TMGNDF2G",279,0) + ;"Purpose: to make a special name from drug info +"RTN","TMGNDF2G",280,0) + ;"Input: IEN -- IEN in file 22706.9 +"RTN","TMGNDF2G",281,0) + ;" MaxLen -- OPTIONAL. default=256. The maximum length +"RTN","TMGNDF2G",282,0) + ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length +"RTN","TMGNDF2G",283,0) + ;" If 2 then name will be shorteneded as much as possible, but the +"RTN","TMGNDF2G",284,0) + ;" name will NOT be cut off to reach MaxLen +"RTN","TMGNDF2G",285,0) + ;" default=1 +"RTN","TMGNDF2G",286,0) + ;" Mode -- OPTIONAL. Default=1. +"RTN","TMGNDF2G",287,0) + ;" //1 -> GenericName (TradeName) Strength Units +"RTN","TMGNDF2G",288,0) + ;" 1 -> TradeName (GenericName) Strength Units ;changed 10/30/07 +"RTN","TMGNDF2G",289,0) + ;" 2 -> TradeName Strength Units +"RTN","TMGNDF2G",290,0) + ;" 3 -> GenericName DrugForm Strength Units +"RTN","TMGNDF2G",291,0) + ;" 4 -> TradeName (includes Drug Form) +"RTN","TMGNDF2G",292,0) + ;" 5 -> GenericName DrugForm +"RTN","TMGNDF2G",293,0) + ;" 6 -> TradeName DrugForm Strength Units +"RTN","TMGNDF2G",294,0) + ;"results: special composite name, or "^" for user abort +"RTN","TMGNDF2G",295,0) + +"RTN","TMGNDF2G",296,0) + set AllowCut=$get(AllowCut,1) +"RTN","TMGNDF2G",297,0) + set MaxLen=$get(MaxLen,256) +"RTN","TMGNDF2G",298,0) + set Mode=$get(Mode,1) +"RTN","TMGNDF2G",299,0) + new TMGunits,TMGstrength,TMGTradeName,tempS +"RTN","TMGNDF2G",300,0) + new vaGeneric,vagIEN +"RTN","TMGNDF2G",301,0) + set vagIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",3) ;"VA GENERIC <-Pntr [P50.6'] +"RTN","TMGNDF2G",302,0) + set vaGeneric=$$GET1^DIQ(50.6,vagIEN,.01) +"RTN","TMGNDF2G",303,0) + if vaGeneric="" set vaGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) +"RTN","TMGNDF2G",304,0) + set TMGTradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;".05 TRADENAME [F] ;e.g. DILTIAZEM HCL SR CAPSULES +"RTN","TMGNDF2G",305,0) + if $extract(TMGTradeName,1)="." set TMGTradeName="0"_TMGTradeName ;".9% saline (rejected) --> 0.9% (acceptible) +"RTN","TMGNDF2G",306,0) + if TMGTradeName["..." set TMGTradeName=$$Substitute^TMGSTUTL(TMGTradeName,"...","") +"RTN","TMGNDF2G",307,0) + +"RTN","TMGNDF2G",308,0) + set TMGstrength=$piece($get(^TMG(22706.9,IEN,0)),"^",2) ;"1 STRENGTH [F] ;e.g. 240 +"RTN","TMGNDF2G",309,0) + +"RTN","TMGNDF2G",310,0) + set TMGunits=$piece($get(^TMG(22706.9,IEN,0)),"^",3) ;"2 UNIT [F] ;e.g. MG +"RTN","TMGNDF2G",311,0) + +"RTN","TMGNDF2G",312,0) + new vadfIEN set vadfIEN=+$piece($get(^TMG(22706.9,IEN,0)),"^",7) ;"3.5 VA DOSAGE FORM +"RTN","TMGNDF2G",313,0) + new vaDoseForm +"RTN","TMGNDF2G",314,0) + if vadfIEN>0 set vaDoseForm=$piece($get(^PS(50.606,vadfIEN,0)),"^",1) ;".01 NAME +"RTN","TMGNDF2G",315,0) + else set vaDoseForm="" +"RTN","TMGNDF2G",316,0) + +"RTN","TMGNDF2G",317,0) + new hideGeneric set hideGeneric=0 +"RTN","TMGNDF2G",318,0) + new tempS +"RTN","TMGNDF2G",319,0) + if Mode=1 do ;"1 -> TradeName (GenericName) Strength Units +"RTN","TMGNDF2G",320,0) + . if $extract(TMGTradeName,1,$length(vaGenericName))=vaGenericName do +"RTN","TMGNDF2G",321,0) + . . set tempS=TMGTradeName +"RTN","TMGNDF2G",322,0) + . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength +"RTN","TMGNDF2G",323,0) + . . if TMGunits'="" set tempS=tempS_" "_TMGunits +"RTN","TMGNDF2G",324,0) + . . set hideGeneric=1 +"RTN","TMGNDF2G",325,0) + . else do +"RTN","TMGNDF2G",326,0) + . . ;"set tempS=vaGeneric_" ("_TMGTradeName_")" +"RTN","TMGNDF2G",327,0) + . . set tempS=TMGTradeName_" ("_vaGeneric_")" +"RTN","TMGNDF2G",328,0) + . . if TMGstrength'="" set tempS=tempS_" "_TMGstrength +"RTN","TMGNDF2G",329,0) + . . if TMGunits'="" set tempS=tempS_" "_TMGunits +"RTN","TMGNDF2G",330,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",331,0) + . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) +"RTN","TMGNDF2G",332,0) + if Mode=2 do ;"2 -> TradeName Strength Units +"RTN","TMGNDF2G",333,0) + . set tempS=TMGTradeName +"RTN","TMGNDF2G",334,0) + . if TMGstrength'="" set tempS=tempS_" "_TMGstrength +"RTN","TMGNDF2G",335,0) + . if TMGunits'="" set tempS=tempS_" "_TMGunits +"RTN","TMGNDF2G",336,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",337,0) + . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) +"RTN","TMGNDF2G",338,0) + if Mode=3 do ;"3 -> GenericName DrugForm Strength Units +"RTN","TMGNDF2G",339,0) + . set tempS=vaGeneric +"RTN","TMGNDF2G",340,0) + . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm +"RTN","TMGNDF2G",341,0) + . if TMGstrength'="" set tempS=tempS_" "_TMGstrength +"RTN","TMGNDF2G",342,0) + . if TMGunits'="" set tempS=tempS_" "_TMGunits +"RTN","TMGNDF2G",343,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",344,0) + . . set tempS=$$ShortNetName^TMGSHORT(vaGeneric,,TMGstrength,TMGunits,MaxLen,.AllowCut) +"RTN","TMGNDF2G",345,0) + if Mode=4 do ;"4 -> TradeName (includes Drug Form) +"RTN","TMGNDF2G",346,0) + . set tempS=TMGTradeName +"RTN","TMGNDF2G",347,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",348,0) + . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,,,MaxLen,.AllowCut) +"RTN","TMGNDF2G",349,0) + if Mode=5 do ;"5 -> GenericName DrugForm +"RTN","TMGNDF2G",350,0) + . set tempS=vaGeneric +"RTN","TMGNDF2G",351,0) + . if vaDoseForm'="" set tempS=tempS_" "_vaDoseForm +"RTN","TMGNDF2G",352,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",353,0) + . . set tempS=$$ShortNetName^TMGSHORT(tempS,,,,MaxLen,.AllowCut) +"RTN","TMGNDF2G",354,0) + if Mode=6 do ;" 6 -> TradeName DrugForm Strength Units +"RTN","TMGNDF2G",355,0) + . set tempS=TMGTradeName ;"Note: TradeName includes Drug Form +"RTN","TMGNDF2G",356,0) + . if TMGstrength'="" set tempS=tempS_" "_TMGstrength +"RTN","TMGNDF2G",357,0) + . if TMGunits'="" set tempS=tempS_" "_TMGunits +"RTN","TMGNDF2G",358,0) + . if $length(tempS)>MaxLen do +"RTN","TMGNDF2G",359,0) + . . set tempS=$$ShortNetName^TMGSHORT(,TMGTradeName,TMGstrength,TMGunits,MaxLen,.AllowCut) +"RTN","TMGNDF2G",360,0) + +"RTN","TMGNDF2G",361,0) + set tempS=$$Trim^TMGSTUTL(tempS) +"RTN","TMGNDF2G",362,0) + if $extract(tempS,1,1)="(" do ;"Input transform doesn't allow first chart to be '(' +"RTN","TMGNDF2G",363,0) + . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s +"RTN","TMGNDF2G",364,0) + . set tempS=$translate(tempS,"(","") +"RTN","TMGNDF2G",365,0) + . set tempS=$translate(tempS,")","") +"RTN","TMGNDF2G",366,0) + if $extract(tempS,1,1)="/" do ;"Input transform doesn't allow first chart to be '/' +"RTN","TMGNDF2G",367,0) + . set tempS=$extract(tempS,2,999) +"RTN","TMGNDF2G",368,0) + +"RTN","TMGNDF2G",369,0) + set tempS=$translate(tempS,";",":") ;"some input transforms don't allow ';' character +"RTN","TMGNDF2G",370,0) + quit tempS +"RTN","TMGNDF2G",371,0) + +"RTN","TMGNDF2G",372,0) + +"RTN","TMGNDF2G",373,0) +AskArray(IENArray,PrepArray) +"RTN","TMGNDF2G",374,0) + ;"Purpose: to get array with possible fixes for one record in 22706.9 file +"RTN","TMGNDF2G",375,0) + ;"Input: Array -- PASS BY REFERENCE (Used if rescanning needed) +"RTN","TMGNDF2G",376,0) + ;" Array(IEN)="" +"RTN","TMGNDF2G",377,0) + ;" Array(IEN)="" +"RTN","TMGNDF2G",378,0) + ;" FixArray -- PASS BY REFERENCE. Format: +"RTN","TMGNDF2G",379,0) + ;" FixArray(IEN,.04)=Name for .04 +"RTN","TMGNDF2G",380,0) + ;" FixArray(IEN,.055)=Name for .055 +"RTN","TMGNDF2G",381,0) + ;" FixArray(IEN,.056)=Name for .056 +"RTN","TMGNDF2G",382,0) + ;" FixArray(IEN,.075)=Name for .075 +"RTN","TMGNDF2G",383,0) + ;" FixArray(IEN,.076)=Name for .076 +"RTN","TMGNDF2G",384,0) + ;"Results: None +"RTN","TMGNDF2G",385,0) + ;"Output: records in 50.68 will be changed, field .055,.056,.075, and .076 will be checked and fixed +"RTN","TMGNDF2G",386,0) + +"RTN","TMGNDF2G",387,0) + new input,list +"RTN","TMGNDF2G",388,0) + new cmd,nums +"RTN","TMGNDF2G",389,0) + new compactMode set compactMode=1 +"RTN","TMGNDF2G",390,0) + new MapArray +"RTN","TMGNDF2G",391,0) +AA1 +"RTN","TMGNDF2G",392,0) + do DispFixArray(.PrepArray,.MapArray,compactMode) +"RTN","TMGNDF2G",393,0) + write !,"E to manually edit entries; D to delete (skip) entries",! +"RTN","TMGNDF2G",394,0) + write "R to rescan; A To accept entries",! +"RTN","TMGNDF2G",395,0) + write "C turn Compact display ",$select((compactMode=1):"OFF",1:"ON"),! +"RTN","TMGNDF2G",396,0) + write "ALL to accept all entries WITHOUT any '...'s",!! +"RTN","TMGNDF2G",397,0) + read "Enter Option: ^// ",input:$get(DTIME,3600),! +"RTN","TMGNDF2G",398,0) + if input="" set input="^" +"RTN","TMGNDF2G",399,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGNDF2G",400,0) + if input="^" goto AADone +"RTN","TMGNDF2G",401,0) + set nums="" +"RTN","TMGNDF2G",402,0) + set cmd=input +"RTN","TMGNDF2G",403,0) + if cmd="E" do goto AA1 +"RTN","TMGNDF2G",404,0) + . if nums="" do +"RTN","TMGNDF2G",405,0) + . . write "Enter number(s) to edit (#,#-#, etc; ^ to quit): " +"RTN","TMGNDF2G",406,0) + . . read nums:$get(DTIME,3600),! +"RTN","TMGNDF2G",407,0) + . if '$$MkMultList^TMGMISC(nums,.list) quit +"RTN","TMGNDF2G",408,0) + . new num set num="" +"RTN","TMGNDF2G",409,0) + . for set num=$order(list(num)) quit:(num="") do +"RTN","TMGNDF2G",410,0) + . . new IEN,name04,name55,name75,result +"RTN","TMGNDF2G",411,0) + . . set IEN=$get(MapArray(num)) if IEN="" quit +"RTN","TMGNDF2G",412,0) + . . set name04=$get(PrepArray(IEN,.04)) +"RTN","TMGNDF2G",413,0) + . . set name55=$get(PrepArray(IEN,.055)) +"RTN","TMGNDF2G",414,0) + . . set name56=$get(PrepArray(IEN,.056)) +"RTN","TMGNDF2G",415,0) + . . set name75=$get(PrepArray(IEN,.075)) +"RTN","TMGNDF2G",416,0) + . . set name76=$get(PrepArray(IEN,.076)) +"RTN","TMGNDF2G",417,0) +AA2 . . set result=$$PrepNames(IEN,name04,name55,name56,name75,name76,.PrepArray,0) +"RTN","TMGNDF2G",418,0) + . . if result=1 quit +"RTN","TMGNDF2G",419,0) + . . new new04Name set new04Name=$get(PrepArray(IEN,.004)) +"RTN","TMGNDF2G",420,0) + . . new new55Name set new55Name=$get(PrepArray(IEN,.055)) +"RTN","TMGNDF2G",421,0) + . . new new56Name set new56Name=$get(PrepArray(IEN,.056)) +"RTN","TMGNDF2G",422,0) + . . new new75Name set new75Name=$get(PrepArray(IEN,.075)) +"RTN","TMGNDF2G",423,0) + . . new new76Name set new76Name=$get(PrepArray(IEN,.076)) +"RTN","TMGNDF2G",424,0) + . . if new04Name=name04 set new04Name="" +"RTN","TMGNDF2G",425,0) + . . if new55Name=name55 set new55Name="" +"RTN","TMGNDF2G",426,0) + . . if new56Name=name56 set new56Name="" +"RTN","TMGNDF2G",427,0) + . . if new75Name=name75 set new75Name="" +"RTN","TMGNDF2G",428,0) + . . if new76Name=name76 set new76Name="" +"RTN","TMGNDF2G",429,0) + . . set result=$$Write1(IEN,new04Name,new55Name,new56Name,new75Name,new76Name) +"RTN","TMGNDF2G",430,0) + . . if result=0 kill PrepArray(IEN) +"RTN","TMGNDF2G",431,0) + if cmd="C" do goto AA1 +"RTN","TMGNDF2G",432,0) + . set compactMode='compactMode +"RTN","TMGNDF2G",433,0) + if cmd="ALL" do GOTO AA1 +"RTN","TMGNDF2G",434,0) + . new Itr,IEN,abort +"RTN","TMGNDF2G",435,0) + . set abort=0 +"RTN","TMGNDF2G",436,0) + . set IEN=$$ItrAInit^TMGITR("PrepArray",.Itr) +"RTN","TMGNDF2G",437,0) + . write "Storing accepted names for future use...",! +"RTN","TMGNDF2G",438,0) + . do PrepProgress^TMGITR(.Itr,20,1,"IEN") +"RTN","TMGNDF2G",439,0) + . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2G",440,0) + . . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGNDF2G",441,0) + . . new name04,name55,name56,name75,name76,result +"RTN","TMGNDF2G",442,0) + . . set name04=$get(PrepArray(IEN,.04)) +"RTN","TMGNDF2G",443,0) + . . set name55=$get(PrepArray(IEN,.055)) +"RTN","TMGNDF2G",444,0) + . . set name56=$get(PrepArray(IEN,.056)) +"RTN","TMGNDF2G",445,0) + . . set name75=$get(PrepArray(IEN,.075)) +"RTN","TMGNDF2G",446,0) + . . set name76=$get(PrepArray(IEN,.076)) +"RTN","TMGNDF2G",447,0) + . . if name04["..." set name04="" +"RTN","TMGNDF2G",448,0) + . . if name55["..." set name55="" +"RTN","TMGNDF2G",449,0) + . . if name56["..." set name56="" +"RTN","TMGNDF2G",450,0) + . . if name75["..." set name75="" +"RTN","TMGNDF2G",451,0) + . . if name76["..." set name76="" +"RTN","TMGNDF2G",452,0) + . . if (name04="")&(name55="")&(name56="")&(name75="")&(name76="") quit ;"avoid delete of names with ... +"RTN","TMGNDF2G",453,0) + . . set result=$$Write1(IEN,name04,name55,name56,name75,name76) +"RTN","TMGNDF2G",454,0) + . . if result=0 kill IENArray(IEN),PrepArray(IEN) +"RTN","TMGNDF2G",455,0) + . do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2G",456,0) + ;"if (cmd="A")!(+cmd=cmd) do goto AA1 +"RTN","TMGNDF2G",457,0) + if (cmd="A") do goto AA1 +"RTN","TMGNDF2G",458,0) + . if nums="" do +"RTN","TMGNDF2G",459,0) + . . write "Enter number(s) to accept (#,#-#, etc; ^ to quit): " +"RTN","TMGNDF2G",460,0) + . . read nums:$get(DTIME,3600),! +"RTN","TMGNDF2G",461,0) + . if '$$MkMultList^TMGMISC(nums,.list) quit +"RTN","TMGNDF2G",462,0) + . new num set num="" +"RTN","TMGNDF2G",463,0) + . for set num=$order(list(num)) quit:(num="") do +"RTN","TMGNDF2G",464,0) + . . new IEN set IEN=$get(MapArray(num)) if IEN="" quit +"RTN","TMGNDF2G",465,0) + . . new name04,name55,name75,result +"RTN","TMGNDF2G",466,0) + . . set name04=$get(PrepArray(IEN,.04)) +"RTN","TMGNDF2G",467,0) + . . set name55=$get(PrepArray(IEN,.055)) +"RTN","TMGNDF2G",468,0) + . . set name56=$get(PrepArray(IEN,.056)) +"RTN","TMGNDF2G",469,0) + . . set name75=$get(PrepArray(IEN,.075)) +"RTN","TMGNDF2G",470,0) + . . set name76=$get(PrepArray(IEN,.076)) +"RTN","TMGNDF2G",471,0) + . . new result set result=$$Write1(IEN,name04,name55,name56,name75,name76) +"RTN","TMGNDF2G",472,0) + . . if result=0 kill IENArray(IEN),PrepArray(IEN) +"RTN","TMGNDF2G",473,0) + else if $extract(cmd,1)="D" do goto AA1 +"RTN","TMGNDF2G",474,0) + . new Perm,% set Perm=0,%=2 +"RTN","TMGNDF2G",475,0) + . write "Will remove from display list.",! +"RTN","TMGNDF2G",476,0) + . write "Also perminantly mark drug so be SKIPPED" +"RTN","TMGNDF2G",477,0) + . do YN^DICN write ! +"RTN","TMGNDF2G",478,0) + . if %=-1 quit +"RTN","TMGNDF2G",479,0) + . if %=1 set Perm=1 +"RTN","TMGNDF2G",480,0) + . set nums=$extract(cmd,2,999) +"RTN","TMGNDF2G",481,0) + . if nums="" do +"RTN","TMGNDF2G",482,0) + . . write "Enter number(s) to delete (#,#-#, etc; ^ to quit): " +"RTN","TMGNDF2G",483,0) + . . read nums:$get(DTIME,3600),! +"RTN","TMGNDF2G",484,0) + . if '$$MkMultList^TMGMISC(nums,.list) quit +"RTN","TMGNDF2G",485,0) + . new num set num="" +"RTN","TMGNDF2G",486,0) + . for set num=$order(list(num)) quit:(num="") do +"RTN","TMGNDF2G",487,0) + . . new IEN set IEN=+$get(MapArray(num)) if IEN="" quit +"RTN","TMGNDF2G",488,0) + . . kill PrepArray(IEN),IENArray(IEN) +"RTN","TMGNDF2G",489,0) + . . if (Perm=1)&(IEN>0) set $piece(^TMG(22706.9,IEN,1),"^",4)=1 ;"1=SKIP +"RTN","TMGNDF2G",490,0) + else if cmd="R" do goto AA1 +"RTN","TMGNDF2G",491,0) + . kill PrepArray +"RTN","TMGNDF2G",492,0) + . do GetPrepArray(.IENArray,.PrepArray) +"RTN","TMGNDF2G",493,0) + +"RTN","TMGNDF2G",494,0) + goto AA1 +"RTN","TMGNDF2G",495,0) +AADone +"RTN","TMGNDF2G",496,0) + quit +"RTN","TMGNDF2G",497,0) + +"RTN","TMGNDF2G",498,0) + +"RTN","TMGNDF2G",499,0) +Write1(IEN,name04,name55,name56,name75,name76) +"RTN","TMGNDF2G",500,0) + ;"Purpose to write 1 record in 22706.9 file +"RTN","TMGNDF2G",501,0) + ;"Input: IEN -- the ien in file 22706.9 +"RTN","TMGNDF2G",502,0) + ;" name04 -- OPTIONAL name for .04 field +"RTN","TMGNDF2G",503,0) + ;" name55 -- OPTIONAL name for .055 field +"RTN","TMGNDF2G",504,0) + ;" name56 -- OPTIONAL name for .056 field +"RTN","TMGNDF2G",505,0) + ;" name75 -- OPTIONAL name for .075 field +"RTN","TMGNDF2G",506,0) + ;" name76 -- OPTIONAL name for .076 field +"RTN","TMGNDF2G",507,0) + ;"Output: records in 22706.9 will be changed, field .055 and .075 will be checked and fixed +"RTN","TMGNDF2G",508,0) + ;"Results: 0 = OK. -1=error +"RTN","TMGNDF2G",509,0) + +"RTN","TMGNDF2G",510,0) + new result set result=0 ;"default to success +"RTN","TMGNDF2G",511,0) + new TMGFDA,TMGIEN,TMGMSG,IENS +"RTN","TMGNDF2G",512,0) + set IENS=IEN_"," +"RTN","TMGNDF2G",513,0) + +"RTN","TMGNDF2G",514,0) + if $get(name04)'="" set TMGFDA(22706.9,IENS,.04)=name04 +"RTN","TMGNDF2G",515,0) + if $get(name55)'="" set TMGFDA(22706.9,IENS,.055)=name55 +"RTN","TMGNDF2G",516,0) + if $get(name56)'="" set TMGFDA(22706.9,IENS,.056)=name56 +"RTN","TMGNDF2G",517,0) + if $get(name75)'="" set TMGFDA(22706.9,IENS,.075)=name75 +"RTN","TMGNDF2G",518,0) + if $get(name76)'="" set TMGFDA(22706.9,IENS,.076)=name76 +"RTN","TMGNDF2G",519,0) + +"RTN","TMGNDF2G",520,0) + if $data(TMGFDA)>0 do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF2G",521,0) + if $data(TMGMSG("DIERR")) do goto W1NDone +"RTN","TMGNDF2G",522,0) + . set result=-1 +"RTN","TMGNDF2G",523,0) + . if $get(Quiet)=1 quit +"RTN","TMGNDF2G",524,0) + . write !,"Error writing names to file 22706.9, record# ",IEN,! +"RTN","TMGNDF2G",525,0) + . new PriorErrorFound +"RTN","TMGNDF2G",526,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2G",527,0) + +"RTN","TMGNDF2G",528,0) + set result=0 +"RTN","TMGNDF2G",529,0) + +"RTN","TMGNDF2G",530,0) +W1NDone +"RTN","TMGNDF2G",531,0) + quit result +"RTN","TMGNDF2G",532,0) + +"RTN","TMGNDF2G",533,0) + +"RTN","TMGNDF2G",534,0) + +"RTN","TMGNDF2G",535,0) +DispFixArray(PrepArray,MapArray,compactMode) +"RTN","TMGNDF2G",536,0) + ;"Purpose: to Display values in PrepArray +"RTN","TMGNDF2G",537,0) + ;"Input: PrepArray array will be filled as follows: +"RTN","TMGNDF2G",538,0) + ;" PrepArray(IEN1,.04)=Name for .04 +"RTN","TMGNDF2G",539,0) + ;" PrepArray(IEN1,.055)=Name for .055 +"RTN","TMGNDF2G",540,0) + ;" PrepArray(IEN1,.056)=Name for .056 +"RTN","TMGNDF2G",541,0) + ;" PrepArray(IEN1,.075)=Name for .075 +"RTN","TMGNDF2G",542,0) + ;" PrepArray(IEN1,.076)=Name for .076 +"RTN","TMGNDF2G",543,0) + ;" MapArray PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF2G",544,0) + ;" MapPrep(1)=IEN +"RTN","TMGNDF2G",545,0) + ;" MapPrep(2)=IEN +"RTN","TMGNDF2G",546,0) + ;" MapPrep(3)=IEN +"RTN","TMGNDF2G",547,0) + ;" MapPrep(4)=IEN +"RTN","TMGNDF2G",548,0) + ;" compactMode -- OPTIONAL. Default=1 +"RTN","TMGNDF2G",549,0) + ;" if =1, then only end of list shown +"RTN","TMGNDF2G",550,0) + ;"Output: will dump array +"RTN","TMGNDF2G",551,0) + ;"Result: none +"RTN","TMGNDF2G",552,0) + +"RTN","TMGNDF2G",553,0) + write ! +"RTN","TMGNDF2G",554,0) + write "--------------------",! +"RTN","TMGNDF2G",555,0) + kill MapArray +"RTN","TMGNDF2G",556,0) + new IEN,Num +"RTN","TMGNDF2G",557,0) + set Num=1 +"RTN","TMGNDF2G",558,0) + set compactMode=$get(compactMode,1) +"RTN","TMGNDF2G",559,0) + new someShown set someShown=0 +"RTN","TMGNDF2G",560,0) + if compactMode=0 do +"RTN","TMGNDF2G",561,0) + set IEN=$order(PrepArray("")) +"RTN","TMGNDF2G",562,0) + else do +"RTN","TMGNDF2G",563,0) + . new i +"RTN","TMGNDF2G",564,0) + . set IEN="" +"RTN","TMGNDF2G",565,0) + . for i=1:1:10 do quit:(IEN="") +"RTN","TMGNDF2G",566,0) + . . set IEN=$order(PrepArray(IEN),-1) +"RTN","TMGNDF2G",567,0) + . if IEN="" set IEN=$order(PrepArray("")) +"RTN","TMGNDF2G",568,0) + if +IEN>0 for do quit:(IEN="") +"RTN","TMGNDF2G",569,0) + . new s,s2,name04,name55,name56,name75,name76 +"RTN","TMGNDF2G",570,0) + . set MapArray(Num)=IEN +"RTN","TMGNDF2G",571,0) + . set someShown=1 +"RTN","TMGNDF2G",572,0) + . set s=Num_". " +"RTN","TMGNDF2G",573,0) + . set s=s_"["_IEN_"] " ;"temporary +"RTN","TMGNDF2G",574,0) + . set s2=$extract(" ",1,$length(s)) +"RTN","TMGNDF2G",575,0) + . set name04=$get(PrepArray(IEN,.04)) +"RTN","TMGNDF2G",576,0) + . set name55=$get(PrepArray(IEN,.055)) +"RTN","TMGNDF2G",577,0) + . set name56=$get(PrepArray(IEN,.056)) +"RTN","TMGNDF2G",578,0) + . set name75=$get(PrepArray(IEN,.075)) +"RTN","TMGNDF2G",579,0) + . set name76=$get(PrepArray(IEN,.076)) +"RTN","TMGNDF2G",580,0) + . write s +"RTN","TMGNDF2G",581,0) + . if name04'="" do +"RTN","TMGNDF2G",582,0) + . . write name04,! +"RTN","TMGNDF2G",583,0) + . . if name55'="" write s2 +"RTN","TMGNDF2G",584,0) + . if name55'="" do +"RTN","TMGNDF2G",585,0) + . . write name55,! +"RTN","TMGNDF2G",586,0) + . . if name75'="" write s2 +"RTN","TMGNDF2G",587,0) + . if name75'="" write name75,! +"RTN","TMGNDF2G",588,0) + . if name56'="" write name56,! +"RTN","TMGNDF2G",589,0) + . if name76'="" write name76,! +"RTN","TMGNDF2G",590,0) + . set IEN=$order(PrepArray(IEN)) +"RTN","TMGNDF2G",591,0) + . set Num=Num+1 +"RTN","TMGNDF2G",592,0) + if someShown=0 write " (List is empty)",! +"RTN","TMGNDF2G",593,0) + write "--------------------",! +"RTN","TMGNDF2G",594,0) + +"RTN","TMGNDF2G",595,0) + quit +"RTN","TMGNDF2G",596,0) + +"RTN","TMGNDF2G",597,0) + +"RTN","TMGNDF2G",598,0) +CheckForBlanks +"RTN","TMGNDF2G",599,0) + new IENArray,BlankArray +"RTN","TMGNDF2G",600,0) + new PrepArray +"RTN","TMGNDF2G",601,0) + write "Scanning existing names of imports not skipped...",! +"RTN","TMGNDF2G",602,0) + do GetIENArray(.IENArray) +"RTN","TMGNDF2G",603,0) + +"RTN","TMGNDF2G",604,0) + write "Checking for blank names...",! +"RTN","TMGNDF2G",605,0) + do Check4Blanks(.IENArray,.BlankArray) +"RTN","TMGNDF2G",606,0) + +"RTN","TMGNDF2G",607,0) + new fixNeeded set fixNeeded=0 +"RTN","TMGNDF2G",608,0) + +"RTN","TMGNDF2G",609,0) + if $data(BlankArray)'=0 do +"RTN","TMGNDF2G",610,0) + . write "Preparing suggested names...",! +"RTN","TMGNDF2G",611,0) + . do GetPrepArray(.BlankArray,.PrepArray) +"RTN","TMGNDF2G",612,0) + . if $data(PrepArray)'=0 do +"RTN","TMGNDF2G",613,0) + . . set fixNeeded=1 +"RTN","TMGNDF2G",614,0) + . . do AskArray(.BlankArray,.PrepArray) +"RTN","TMGNDF2G",615,0) + +"RTN","TMGNDF2G",616,0) + if fixNeeded=0 do +"RTN","TMGNDF2G",617,0) + . write "No fixes required. Great!",! +"RTN","TMGNDF2G",618,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2G",619,0) + +"RTN","TMGNDF2G",620,0) + quit +"RTN","TMGNDF2G",621,0) + +"RTN","TMGNDF2G",622,0) + +"RTN","TMGNDF2G",623,0) +Check4Blanks(IENArray,BlankArray) +"RTN","TMGNDF2G",624,0) + ;"Purpose: Check if any of the fields are blank and allow fixing +"RTN","TMGNDF2G",625,0) + ;"Input: IENArray -- PASS BY REFERENCE (Used if rescanning needed) +"RTN","TMGNDF2G",626,0) + ;" IENArray(IEN,.04)=currentValue +"RTN","TMGNDF2G",627,0) + ;" IENArray(IEN,.055)=currentValue +"RTN","TMGNDF2G",628,0) + ;" IENArray(IEN,.056)=currentValue +"RTN","TMGNDF2G",629,0) + ;" IENArray(IEN,.075)=currentValue +"RTN","TMGNDF2G",630,0) + ;" IENArray(IEN,.076)=currentValue +"RTN","TMGNDF2G",631,0) + ;" BlankArray -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF2G",632,0) + ;" BlankArray(IEN,.04)=Name for .04 +"RTN","TMGNDF2G",633,0) + ;" BlankArray(IEN,.055)=Name for .055 +"RTN","TMGNDF2G",634,0) + ;" BlankArray(IEN,.056)=Name for .056 +"RTN","TMGNDF2G",635,0) + ;" BlankArray(IEN,.075)=Name for .075 +"RTN","TMGNDF2G",636,0) + ;" BlankArray(IEN,.076)=Name for .076 +"RTN","TMGNDF2G",637,0) + ;"Results: none +"RTN","TMGNDF2G",638,0) + +"RTN","TMGNDF2G",639,0) + new Itr,IEN,abort +"RTN","TMGNDF2G",640,0) + set abort=0 +"RTN","TMGNDF2G",641,0) + set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) +"RTN","TMGNDF2G",642,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2G",643,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2G",644,0) + . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGNDF2G",645,0) + . new Cur04Value set Cur04Value=$get(IENArray(IEN,.04)) +"RTN","TMGNDF2G",646,0) + . new Cur55Value set Cur55Value=$get(IENArray(IEN,.055)) +"RTN","TMGNDF2G",647,0) + . new Cur56Value set Cur56Value=$get(IENArray(IEN,.056)) +"RTN","TMGNDF2G",648,0) + . new Cur75Value set Cur75Value=$get(IENArray(IEN,.075)) +"RTN","TMGNDF2G",649,0) + . new Cur76Value set Cur76Value=$get(IENArray(IEN,.076)) +"RTN","TMGNDF2G",650,0) + . if (Cur04Value="")!(Cur55Value="")!(Cur56Value="")!(Cur75Value="")!(Cur76Value="") do +"RTN","TMGNDF2G",651,0) + . . write IEN,?8," .04 (LONG NAME) = ",Cur04Value,! +"RTN","TMGNDF2G",652,0) + . . write ?8,".055 (TRADENAME) = ",Cur55Value,! +"RTN","TMGNDF2G",653,0) + . . write ?8,".056 (TRADENAME FORM DOSE UNIT)= ",Cur56Value,! +"RTN","TMGNDF2G",654,0) + . . write ?8,".075 (GENERIC NAME & FORM) = ",Cur75Value,! +"RTN","TMGNDF2G",655,0) + . . write ?8,".076 (GENERICNAME FORM DOSE UNT) = ",Cur76Value,! +"RTN","TMGNDF2G",656,0) + . . merge BlankArray(IEN)=IENArray(IEN) +"RTN","TMGNDF2G",657,0) + +"RTN","TMGNDF2G",658,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2G",659,0) + +"RTN","TMGNDF2G",660,0) + quit +"RTN","TMGNDF2G",661,0) + +"RTN","TMGNDF2G",662,0) + ;"========================================== +"RTN","TMGNDF2G",663,0) + +"RTN","TMGNDF2G",664,0) +ScanBadName +"RTN","TMGNDF2G",665,0) + ;"Purpose: scan for bad names, and debug the problem. +"RTN","TMGNDF2G",666,0) + ;"Input: none +"RTN","TMGNDF2G",667,0) + ;"Results: none +"RTN","TMGNDF2G",668,0) + +"RTN","TMGNDF2G",669,0) + new IENArray,PrepArray +"RTN","TMGNDF2G",670,0) + write "Scanning existing names of imports not skipped...",! +"RTN","TMGNDF2G",671,0) + do GetIENArray(.IENArray) +"RTN","TMGNDF2G",672,0) + +"RTN","TMGNDF2G",673,0) + new Menu,UsrSlct +"RTN","TMGNDF2G",674,0) + set Menu(0)="Pick Which Name to Examine (2G)" +"RTN","TMGNDF2G",675,0) + set Menu(1)=" .04 LONG NAME"_$char(9)_"LongName" +"RTN","TMGNDF2G",676,0) + set Menu(2)=" .05 TRADENAME"_$char(9)_"TradeName" +"RTN","TMGNDF2G",677,0) + set Menu(3)=".055 TRADE NAME & FORM - 40"_$char(9)_"TradeF" +"RTN","TMGNDF2G",678,0) + set Menu(4)=".056 TRADENAME FORM DOSE UNIT - 40"_$char(9)_"TradeFDU" +"RTN","TMGNDF2G",679,0) + set Menu(5)=" .07 GENERIC NAME"_$char(9)_"Generic" +"RTN","TMGNDF2G",680,0) + set Menu(6)=".075 GENERIC NAME & FORM - 40"_$char(9)_"GenericF" +"RTN","TMGNDF2G",681,0) + set Menu(7)=".076 GENERICNAME FORM DOSE UNT - 40"_$char(9)_"GenrcFDU" +"RTN","TMGNDF2G",682,0) + +"RTN","TMGNDF2G",683,0) +SBN1 write # +"RTN","TMGNDF2G",684,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2G",685,0) + +"RTN","TMGNDF2G",686,0) + if UsrSlct="LongName" do Scan(.IENArray,.04,"LONG NAME") goto SBN1 +"RTN","TMGNDF2G",687,0) + if UsrSlct="TradeName" do Scan(.IENArray,.055,"TRADENAME") goto SBN1 +"RTN","TMGNDF2G",688,0) + if UsrSlct="TradeF" do Scan(.IENArray,.055,"TRADE NAME & FORM - 40") goto SBN1 +"RTN","TMGNDF2G",689,0) + if UsrSlct="TradeFDU" do Scan(.IENArray,.056,"TRADENAME FORM DOSE UNIT - 40") goto SBN1 +"RTN","TMGNDF2G",690,0) + if UsrSlct="Generic" do Scan(.IENArray,.07,"GENERIC NAME") goto SBN1 +"RTN","TMGNDF2G",691,0) + if UsrSlct="GenericF" do Scan(.IENArray,.075,"GENERIC NAME & FORM - 40") goto SBN1 +"RTN","TMGNDF2G",692,0) + if UsrSlct="GenrcFDU" do Scan(.IENArray,.076,"GENERICNAME FORM DOSE UNT - 40") goto SBN1 +"RTN","TMGNDF2G",693,0) + if UsrSlct="^" goto SBN2 +"RTN","TMGNDF2G",694,0) + goto SBN1 +"RTN","TMGNDF2G",695,0) + +"RTN","TMGNDF2G",696,0) +SBN2 quit +"RTN","TMGNDF2G",697,0) + +"RTN","TMGNDF2G",698,0) + +"RTN","TMGNDF2G",699,0) +Scan(IENArray,FieldNum,FldName) +"RTN","TMGNDF2G",700,0) + ;"Purpose: to do scan +"RTN","TMGNDF2G",701,0) + ;"Input: -- IENArray -- PASS BY REFERENCE. Format: +"RTN","TMGNDF2G",702,0) + ;" Note: IEN is from file 22706.9 +"RTN","TMGNDF2G",703,0) + ;" Array(IEN,.04)=currentValue +"RTN","TMGNDF2G",704,0) + ;" Array(IEN,.05)=currentValue +"RTN","TMGNDF2G",705,0) + ;" Array(IEN,.055)=currentValue +"RTN","TMGNDF2G",706,0) + ;" Array(IEN,.056)=currentValue +"RTN","TMGNDF2G",707,0) + ;" Array(IEN,.07)=currentValue +"RTN","TMGNDF2G",708,0) + ;" Array(IEN,.075)=currentValue +"RTN","TMGNDF2G",709,0) + ;" Array(IEN,.076)=currentValue +"RTN","TMGNDF2G",710,0) + +"RTN","TMGNDF2G",711,0) + new SrchRec +"RTN","TMGNDF2G",712,0) + new Itr,IEN,abort +"RTN","TMGNDF2G",713,0) + set abort=0 +"RTN","TMGNDF2G",714,0) + set IEN=$$ItrAInit^TMGITR("IENArray",.Itr) +"RTN","TMGNDF2G",715,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2G",716,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2G",717,0) + . if $$UserAborted^TMGUSRIF() set abort=1 quit +"RTN","TMGNDF2G",718,0) + . new s set s=$get(IENArray(IEN,FieldNum)) +"RTN","TMGNDF2G",719,0) + . if (s="")!(s="") quit +"RTN","TMGNDF2G",720,0) + . set SrchRec(s_" (#"_IEN_")",IEN_"^22706.9")="" +"RTN","TMGNDF2G",721,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2G",722,0) + +"RTN","TMGNDF2G",723,0) + new Results +"RTN","TMGNDF2G",724,0) + write "Passing off to selector...",! +"RTN","TMGNDF2G",725,0) + do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Bad Drugs Names. [ESC][ESC] when done.") +"RTN","TMGNDF2G",726,0) + +"RTN","TMGNDF2G",727,0) + do HandleChain^TMGNDF4G(.Results) ;"Show forward array +"RTN","TMGNDF2G",728,0) + +"RTN","TMGNDF2G",729,0) + write "Done.",! +"RTN","TMGNDF2G",730,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2G",731,0) + +"RTN","TMGNDF2G",732,0) + quit +"RTN","TMGNDF2H") +0^47^B7403 +"RTN","TMGNDF2H",1,0) +TMGNDF2H ;TMG/kst/FDA Import: Fill VA Product entries ;03/25/06 +"RTN","TMGNDF2H",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF2H",3,0) + +"RTN","TMGNDF2H",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF2H",5,0) + ;" Addition of records from TMG FDA IMPORT COMPILED into VA PRODUCT file. +"RTN","TMGNDF2H",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF2H",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF2H",8,0) + ;"11-21-2006 +"RTN","TMGNDF2H",9,0) + +"RTN","TMGNDF2H",10,0) + ;"======================================================================= +"RTN","TMGNDF2H",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF2H",12,0) + ;"======================================================================= +"RTN","TMGNDF2H",13,0) + ;"Menu +"RTN","TMGNDF2H",14,0) + +"RTN","TMGNDF2H",15,0) + ;"======================================================================= +"RTN","TMGNDF2H",16,0) + ;"Link2VAP -- fill file 22706.9, field 5.5 in with link 50.68 with SAME NDC +"RTN","TMGNDF2H",17,0) + ;"Batch2VAP -- Batch add drugs to VA PRODUCT file (50.68) and NDC/UPC +"RTN","TMGNDF2H",18,0) + +"RTN","TMGNDF2H",19,0) + ;"======================================================================= +"RTN","TMGNDF2H",20,0) + ;" Private Functions. +"RTN","TMGNDF2H",21,0) + ;"======================================================================= +"RTN","TMGNDF2H",22,0) + ;"Add2VAProd(IEN,Quiet) +"RTN","TMGNDF2H",23,0) + ;"EnsureNDC(IEN) Make record in NDC/UPN file (50.67). +"RTN","TMGNDF2H",24,0) + ;"EnsureUnits(UnitS) -- ensure that the UnitS is valid in file 50.607 +"RTN","TMGNDF2H",25,0) + ;"Unlock50dot607 +"RTN","TMGNDF2H",26,0) + ;"Lock50dot607 +"RTN","TMGNDF2H",27,0) + +"RTN","TMGNDF2H",28,0) + +"RTN","TMGNDF2H",29,0) + ;"======================================================================= +"RTN","TMGNDF2H",30,0) + ;"======================================================================= +"RTN","TMGNDF2H",31,0) + +"RTN","TMGNDF2H",32,0) +Menu +"RTN","TMGNDF2H",33,0) + new Menu,UsrSlct +"RTN","TMGNDF2H",34,0) + set Menu(0)="Pick Option to Add imports to VA PRODUCT & NDC/UPN file (2H)" +"RTN","TMGNDF2H",35,0) + set Menu(1)="Link imports to VA PRODUCT via NDC-- *DO THIS FIRST*"_$char(9)_"Link2VAP" +"RTN","TMGNDF2H",36,0) + set Menu(2)="ADD unlinked imports to VA PRODUCT file."_$char(9)_"Batch2VAP" +"RTN","TMGNDF2H",37,0) + set Menu(3)="Synchronize VA PRODUCT file with import data."_$char(9)_"Sync2VAP" +"RTN","TMGNDF2H",38,0) + ;"set Menu(3)="Fix Names with '...'s (SHOULD run AFTER Batch Add)"_$char(9)_"FixNames" +"RTN","TMGNDF2H",39,0) + ;"set Menu(4)="Check/Fix ALL Names (May be run AFTER Batch Add)"_$char(9)_"FixNames2" +"RTN","TMGNDF2H",40,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF2H",41,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF2H",42,0) + +"RTN","TMGNDF2H",43,0) +M1 write # +"RTN","TMGNDF2H",44,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF2H",45,0) + +"RTN","TMGNDF2H",46,0) + if UsrSlct="Link2VAP" do Link2VAP goto M1 +"RTN","TMGNDF2H",47,0) + if UsrSlct="Batch2VAP" do Batch2VAP goto M1 +"RTN","TMGNDF2H",48,0) + if UsrSlct="Sync2VAP" do Sync2VAP goto M1 +"RTN","TMGNDF2H",49,0) + ;"if UsrSlct="FixNames" do FixNames(0) goto M1 +"RTN","TMGNDF2H",50,0) + ;"if UsrSlct="FixNames2" do FixNames(1) goto M1 +"RTN","TMGNDF2H",51,0) + if UsrSlct="Prev" goto Menu^TMGNDF2G ;"quit can occur from there... +"RTN","TMGNDF2H",52,0) + if UsrSlct="Next" goto Menu^TMGNDF3A ;"quit can occur from there... +"RTN","TMGNDF2H",53,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF2H",54,0) + goto M1 +"RTN","TMGNDF2H",55,0) + +"RTN","TMGNDF2H",56,0) +MenuDone +"RTN","TMGNDF2H",57,0) + quit +"RTN","TMGNDF2H",58,0) + +"RTN","TMGNDF2H",59,0) + +"RTN","TMGNDF2H",60,0) + ;"========================================================================== +"RTN","TMGNDF2H",61,0) + +"RTN","TMGNDF2H",62,0) + +"RTN","TMGNDF2H",63,0) +Batch2VAP +"RTN","TMGNDF2H",64,0) + ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of +"RTN","TMGNDF2H",65,0) + ;" possible entries for addition to VA PRODUCT, also creating an entry in +"RTN","TMGNDF2H",66,0) + ;" the NDC/UPC file. +"RTN","TMGNDF2H",67,0) + ;"Input: none +"RTN","TMGNDF2H",68,0) + ;"Output: database will be filled with data (records added to VA PRODUCT file) +"RTN","TMGNDF2H",69,0) + ;"Results: none +"RTN","TMGNDF2H",70,0) + +"RTN","TMGNDF2H",71,0) + ;"Note: After making this function, I changed the function MakeName such that it is better +"RTN","TMGNDF2H",72,0) + ;" at shortening long names to fit into the field limits. +"RTN","TMGNDF2H",73,0) + ;" So I wrote the code FixNames to go back and correct the names for better fits. +"RTN","TMGNDF2H",74,0) + ;" The problem is that it takes user interaction to do this well (asking for abbreviations etc) +"RTN","TMGNDF2H",75,0) + ;" And this is best done in a batch manner (i.e. not asking each drug, one at a time). +"RTN","TMGNDF2H",76,0) + ;" So this function was modified such that it shortens the names non-interactively +"RTN","TMGNDF2H",77,0) + ;" (i.e. AllowCut=1), and then FixNames can be run to review all of the abbreviations +"RTN","TMGNDF2H",78,0) + ;" are appropriate +"RTN","TMGNDF2H",79,0) + +"RTN","TMGNDF2H",80,0) + +"RTN","TMGNDF2H",81,0) + new AddList +"RTN","TMGNDF2H",82,0) + do GetAddList(.AddList) +"RTN","TMGNDF2H",83,0) + new count set count=$$ListCt^TMGMISC("AddList") +"RTN","TMGNDF2H",84,0) + if count=0 do goto B2VDone +"RTN","TMGNDF2H",85,0) + . write "No entries need to be be added to VA PRODUCT file.",! +"RTN","TMGNDF2H",86,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",87,0) + write count," entries will now be added to VA PRODUCT file.",! +"RTN","TMGNDF2H",88,0) + new % set %=1 +"RTN","TMGNDF2H",89,0) + write "Continue" do YN^DICN write ! +"RTN","TMGNDF2H",90,0) + if %=1 do DoAdd(.AddList) +"RTN","TMGNDF2H",91,0) +B2VDone +"RTN","TMGNDF2H",92,0) + quit +"RTN","TMGNDF2H",93,0) + +"RTN","TMGNDF2H",94,0) + +"RTN","TMGNDF2H",95,0) +Check1(IEN) +"RTN","TMGNDF2H",96,0) + ;"Purpose: to check one record in TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF2H",97,0) + ;"NOTE: this just checks if one exists, NOT if correct link is present. +"RTN","TMGNDF2H",98,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF2H",99,0) + +"RTN","TMGNDF2H",100,0) + new AddList,vapIEN,syncList +"RTN","TMGNDF2H",101,0) + +"RTN","TMGNDF2H",102,0) + set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) +"RTN","TMGNDF2H",103,0) + set AddList(IEN)="" +"RTN","TMGNDF2H",104,0) + if vapIEN=0 set vapIEN=$$Add2VAProd(IEN) +"RTN","TMGNDF2H",105,0) + set syncList(IEN)=vapIEN +"RTN","TMGNDF2H",106,0) + do DoSync(.syncList) +"RTN","TMGNDF2H",107,0) + +"RTN","TMGNDF2H",108,0) +C1Done quit +"RTN","TMGNDF2H",109,0) + +"RTN","TMGNDF2H",110,0) + +"RTN","TMGNDF2H",111,0) +Sync2VAP +"RTN","TMGNDF2H",112,0) + ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF2H",113,0) + ;" and synchronize data with records in VA PRODUCT. +"RTN","TMGNDF2H",114,0) + ;"Input: none +"RTN","TMGNDF2H",115,0) + ;"Output: database will be modified with data from 22706.9 +"RTN","TMGNDF2H",116,0) + ;"Results: none +"RTN","TMGNDF2H",117,0) + +"RTN","TMGNDF2H",118,0) + new SyncList +"RTN","TMGNDF2H",119,0) + do GetSyncList(.SyncList) +"RTN","TMGNDF2H",120,0) + new count set count=$$ListCt^TMGMISC("SyncList") +"RTN","TMGNDF2H",121,0) + if count=0 do goto S2VDone +"RTN","TMGNDF2H",122,0) + . write "No entries available to update VA PRODUCT file with.",! +"RTN","TMGNDF2H",123,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",124,0) + write count," entries will now be used to update VA PRODUCT file.",! +"RTN","TMGNDF2H",125,0) + new % set %=1 +"RTN","TMGNDF2H",126,0) + write "Continue" do YN^DICN write ! +"RTN","TMGNDF2H",127,0) + if %=1 do DoSync(.SyncList) +"RTN","TMGNDF2H",128,0) +S2VDone +"RTN","TMGNDF2H",129,0) + quit +"RTN","TMGNDF2H",130,0) + +"RTN","TMGNDF2H",131,0) + +"RTN","TMGNDF2H",132,0) +GetAddList(AddList) +"RTN","TMGNDF2H",133,0) + ;"Purpose: to create a list of IEN's that need addition +"RTN","TMGNDF2H",134,0) + ;"Input: AddList-- PASS BY REFERENCE. An OUT PARAMETER. +"RTN","TMGNDF2H",135,0) + ;"Output: AddList is filled: Format: +"RTN","TMGNDF2H",136,0) + ;" AddList(IEN)="" ;IEN is from file 22706.9 +"RTN","TMGNDF2H",137,0) + ;" AddList(IEN)="" +"RTN","TMGNDF2H",138,0) + ;"Results: none. +"RTN","TMGNDF2H",139,0) + +"RTN","TMGNDF2H",140,0) + write "Scanning for imports to be added into VA PRODUCT file...",! +"RTN","TMGNDF2H",141,0) + new Itr,IEN,success +"RTN","TMGNDF2H",142,0) + new abort set abort=0 +"RTN","TMGNDF2H",143,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2H",144,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2H",145,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2H",146,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2H",147,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2H",148,0) + . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)>0 quit ;"IEN of linked entry in 50.68 +"RTN","TMGNDF2H",149,0) + . set AddList(IEN)="" +"RTN","TMGNDF2H",150,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2H",151,0) + +"RTN","TMGNDF2H",152,0) + quit +"RTN","TMGNDF2H",153,0) + +"RTN","TMGNDF2H",154,0) + +"RTN","TMGNDF2H",155,0) +GetSyncList(SyncList) +"RTN","TMGNDF2H",156,0) + ;"Purpose: to create a list of IEN's can be used for syncing data +"RTN","TMGNDF2H",157,0) + ;"Input: SyncList-- PASS BY REFERENCE. An OUT PARAMETER. +"RTN","TMGNDF2H",158,0) + ;"Output: SyncList is filled: Format: +"RTN","TMGNDF2H",159,0) + ;" SyncList(IEN22706d9)=vapIEN +"RTN","TMGNDF2H",160,0) + ;"Results: none. +"RTN","TMGNDF2H",161,0) + +"RTN","TMGNDF2H",162,0) + write "Scanning for imports to be synchronized with VA PRODUCT file...",! +"RTN","TMGNDF2H",163,0) + new Itr,IEN,success +"RTN","TMGNDF2H",164,0) + new abort set abort=0 +"RTN","TMGNDF2H",165,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2H",166,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2H",167,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2H",168,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2H",169,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF2H",170,0) + . new vapIEN set vapIEN=$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"IEN of linked entry in 50.68 +"RTN","TMGNDF2H",171,0) + . if vapIEN=0 quit +"RTN","TMGNDF2H",172,0) + . set SyncList(IEN)=vapIEN +"RTN","TMGNDF2H",173,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2H",174,0) + +"RTN","TMGNDF2H",175,0) + quit +"RTN","TMGNDF2H",176,0) + +"RTN","TMGNDF2H",177,0) + +"RTN","TMGNDF2H",178,0) +DoAdd(AddList) +"RTN","TMGNDF2H",179,0) + ;"Purpose: To process the AddList, doing actual adds. +"RTN","TMGNDF2H",180,0) + ;"Input: AddList-- PASS BY REFERENCE. Format: +"RTN","TMGNDF2H",181,0) + ;" AddList(IEN)="" ;IEN is from file 22706.9 +"RTN","TMGNDF2H",182,0) + ;" AddList(IEN)="" +"RTN","TMGNDF2H",183,0) + ;"Results: none. +"RTN","TMGNDF2H",184,0) + +"RTN","TMGNDF2H",185,0) + do Unlock50dot607 +"RTN","TMGNDF2H",186,0) + do Unlock50^TMGNDF3C +"RTN","TMGNDF2H",187,0) + +"RTN","TMGNDF2H",188,0) + write "Adding records into VA PRODUCT file from import information...",! +"RTN","TMGNDF2H",189,0) + new count set count=0 +"RTN","TMGNDF2H",190,0) + new Itr,IEN,success,addedIEN +"RTN","TMGNDF2H",191,0) + new abort set abort=0 +"RTN","TMGNDF2H",192,0) + set IEN=$$ItrAInit^TMGITR("AddList",.Itr) +"RTN","TMGNDF2H",193,0) + do PrepProgress^TMGITR(.Itr,1,1,"IEN") +"RTN","TMGNDF2H",194,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2H",195,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2H",196,0) +L1 . set addedIEN=$$Add2VAProd(IEN,0,1) ;"0=not quiet, 1=quiet,Allow Cut automatically +"RTN","TMGNDF2H",197,0) + . if addedIEN>0 do +"RTN","TMGNDF2H",198,0) + . . set count=count+1 +"RTN","TMGNDF2H",199,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2H",200,0) + . . set TMGFDA(22706.9,IEN_",",5.5)=addedIEN +"RTN","TMGNDF2H",201,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",202,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2H",203,0) + . else do +"RTN","TMGNDF2H",204,0) + . . write !,"Unable to add record# ",IEN," from file 22706.9 to file 50.68.",! +"RTN","TMGNDF2H",205,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2H",206,0) + +"RTN","TMGNDF2H",207,0) + do Lock50dot607 +"RTN","TMGNDF2H",208,0) + do Lock50^TMGNDF3C +"RTN","TMGNDF2H",209,0) + +"RTN","TMGNDF2H",210,0) + write count," imports added to VA PRODUCT (file 50.68 )",! +"RTN","TMGNDF2H",211,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",212,0) + +"RTN","TMGNDF2H",213,0) + quit +"RTN","TMGNDF2H",214,0) + +"RTN","TMGNDF2H",215,0) + +"RTN","TMGNDF2H",216,0) +DoSync(SyncList) +"RTN","TMGNDF2H",217,0) + ;"Purpose: To process the SyncList, doing actual synchronization. +"RTN","TMGNDF2H",218,0) + ;"Input: SyncList-- PASS BY REFERENCE. Format: +"RTN","TMGNDF2H",219,0) + ;" SyncList(IEN)=vapIEN ;IEN is from file 22706.9; vapIEN=IEN 50.68 +"RTN","TMGNDF2H",220,0) + ;"Results: none. +"RTN","TMGNDF2H",221,0) + +"RTN","TMGNDF2H",222,0) + do Unlock50dot607 +"RTN","TMGNDF2H",223,0) + do Unlock50^TMGNDF3C +"RTN","TMGNDF2H",224,0) + +"RTN","TMGNDF2H",225,0) + write "Synchronizing VA PRODUCT file from import information...",! +"RTN","TMGNDF2H",226,0) + new count set count=0 +"RTN","TMGNDF2H",227,0) + new Itr,IEN,success +"RTN","TMGNDF2H",228,0) + new abort set abort=0 +"RTN","TMGNDF2H",229,0) + set IEN=$$ItrAInit^TMGITR("SyncList",.Itr) +"RTN","TMGNDF2H",230,0) + do PrepProgress^TMGITR(.Itr,1,1,"IEN") +"RTN","TMGNDF2H",231,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!abort +"RTN","TMGNDF2H",232,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2H",233,0) + . new vapIEN set vapIEN=+$get(SyncList(IEN)) +"RTN","TMGNDF2H",234,0) + . if +vapIEN=0 quit +"RTN","TMGNDF2H",235,0) + . set success=$$Sync1Rec(IEN,vapIEN) +"RTN","TMGNDF2H",236,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2H",237,0) + +"RTN","TMGNDF2H",238,0) + do Lock50dot607 +"RTN","TMGNDF2H",239,0) + do Lock50^TMGNDF3C +"RTN","TMGNDF2H",240,0) + +"RTN","TMGNDF2H",241,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",242,0) + +"RTN","TMGNDF2H",243,0) + quit +"RTN","TMGNDF2H",244,0) + +"RTN","TMGNDF2H",245,0) + +"RTN","TMGNDF2H",246,0) +Add2VAProd(IEN,Quiet,AllowCut) +"RTN","TMGNDF2H",247,0) + ;"Purpose: to take drug information from Array and use this to create a new entry +"RTN","TMGNDF2H",248,0) + ;" in file #50.68 (VA PRODUCT)--and any supporting files needed. +"RTN","TMGNDF2H",249,0) + ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add +"RTN","TMGNDF2H",250,0) + ;" Quiet -- OPTIONAL -- default = 1 (quiet), if 1 no output generated to console. +"RTN","TMGNDF2H",251,0) + ;" AllowCut -- OPTIONAL -- default = 0 (no cut). +"RTN","TMGNDF2H",252,0) + ;" If value=1 then names will be shortened to needed length without +"RTN","TMGNDF2H",253,0) + ;" asking user for abbreviations etc. +"RTN","TMGNDF2H",254,0) + ;"Output: A new record will be created in 50.68, and any supporint files (such as +"RTN","TMGNDF2H",255,0) + ;" drug manufacturer, package type etc if needed) +"RTN","TMGNDF2H",256,0) + ;"Result: the IEN in 50.68 of added record, 0 if error +"RTN","TMGNDF2H",257,0) + +"RTN","TMGNDF2H",258,0) + +"RTN","TMGNDF2H",259,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF2H",260,0) + set IENS="+1," +"RTN","TMGNDF2H",261,0) + do SetupFDA(IEN,IENS,.TMGFDA) +"RTN","TMGNDF2H",262,0) + +"RTN","TMGNDF2H",263,0) +ALabel +"RTN","TMGNDF2H",264,0) + do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2H",265,0) + if $data(TMGMSG("DIERR")) do goto A2VPDone +"RTN","TMGNDF2H",266,0) + . set result=0 +"RTN","TMGNDF2H",267,0) + . if Quiet=1 quit +"RTN","TMGNDF2H",268,0) + . write !,"Error adding new record to 50.68",! +"RTN","TMGNDF2H",269,0) + . new PriorErrorFound +"RTN","TMGNDF2H",270,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2H",271,0) + +"RTN","TMGNDF2H",272,0) + ;"Check that record was added, then then add subfile entries: active ingredients... +"RTN","TMGNDF2H",273,0) + new AddedIEN set AddedIEN=$get(TMGIEN(1)) ;"also used to create NDC/UPC record; +"RTN","TMGNDF2H",274,0) + if +AddedIEN=0 do goto A2VPDone +"RTN","TMGNDF2H",275,0) + . set result=0 if Quiet=1 quit +"RTN","TMGNDF2H",276,0) + . write !,"Can't find record number of added record to 50.68",! +"RTN","TMGNDF2H",277,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",278,0) + +"RTN","TMGNDF2H",279,0) + set result=$$EnsureIngredients(IEN,AddedIEN) if result=0 goto A2VPDone +"RTN","TMGNDF2H",280,0) + +"RTN","TMGNDF2H",281,0) +BLabel ;"set result=$$Add2NDC(IEN,.DrugInfo) +"RTN","TMGNDF2H",282,0) + set result=$$EnsureNDC(IEN) if result=0 goto A2VPDone +"RTN","TMGNDF2H",283,0) + +"RTN","TMGNDF2H",284,0) +A2VPDone +"RTN","TMGNDF2H",285,0) + ;"1=OK to continue, 0 if error +"RTN","TMGNDF2H",286,0) + if result=1 set result=+$get(AddedIEN) +"RTN","TMGNDF2H",287,0) + quit result ;"changed to return IEN in 50.68 +"RTN","TMGNDF2H",288,0) + +"RTN","TMGNDF2H",289,0) + +"RTN","TMGNDF2H",290,0) +Sync1Rec(IEN,vapIEN) +"RTN","TMGNDF2H",291,0) + ;"Purpose: to take drug information from Array and use this to create a new entry +"RTN","TMGNDF2H",292,0) + ;" in file #50.68 (VA PRODUCT)--and any supporting files needed. +"RTN","TMGNDF2H",293,0) + ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add +"RTN","TMGNDF2H",294,0) + ;" vapIEN -- IEN in 50.68 that is the target of the synchronization. +"RTN","TMGNDF2H",295,0) + ;"Output: data in VA PRODUCT will be updated as needed to match the info in +"RTN","TMGNDF2H",296,0) + ;" file 22706.9 +"RTN","TMGNDF2H",297,0) + ;"Result: 1 if OK, 0 if error +"RTN","TMGNDF2H",298,0) + +"RTN","TMGNDF2H",299,0) + new result set result=0 +"RTN","TMGNDF2H",300,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF2H",301,0) + set IENS=vapIEN_"," +"RTN","TMGNDF2H",302,0) + do SetupFDA(IEN,IENS,.TMGFDA) +"RTN","TMGNDF2H",303,0) + new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF2H",304,0) + +"RTN","TMGNDF2H",305,0) + if $data(TMGFDA) do +"RTN","TMGNDF2H",306,0) + . do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",307,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2H",308,0) + +"RTN","TMGNDF2H",309,0) + set result=$$EnsureIngredients(IEN,vapIEN) +"RTN","TMGNDF2H",310,0) + if result=0 goto S2VPDone +"RTN","TMGNDF2H",311,0) + set result=$$EnsureNDC(IEN) if result=0 goto S2VPDone +"RTN","TMGNDF2H",312,0) +S2VPDone +"RTN","TMGNDF2H",313,0) + quit result ;"changed to return IEN in 50.68 +"RTN","TMGNDF2H",314,0) + +"RTN","TMGNDF2H",315,0) + +"RTN","TMGNDF2H",316,0) +SetupFDA(IEN,IENS,TMGFDA,vapIEN) +"RTN","TMGNDF2H",317,0) + ;"Purpose: to set up FDA for data in a#50.68 (VA PRODUCT) entry +"RTN","TMGNDF2H",318,0) + ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add +"RTN","TMGNDF2H",319,0) + ;" IENS -- a standard FM IENS for FDA to use +"RTN","TMGNDF2H",320,0) + ;" TMGFDA -- PASS BY REFEERNCE. A standard FM FDA +"RTN","TMGNDF2H",321,0) + ;" vapIEN -- OPTIONAL. If provided, then the FDA wil be trimmed to contain +"RTN","TMGNDF2H",322,0) + ;" only those fields that need to be changed +"RTN","TMGNDF2H",323,0) + ;"Output: TMGFDA is filled +"RTN","TMGNDF2H",324,0) + ;"Result: none +"RTN","TMGNDF2H",325,0) + +"RTN","TMGNDF2H",326,0) + ;"NOTE: this function will create an FDA in EXTERNAL form +"RTN","TMGNDF2H",327,0) + +"RTN","TMGNDF2H",328,0) + ;"VA PRODUCT FILE RECORD STRUCTURE +"RTN","TMGNDF2H",329,0) + ;"----------------------------------- +"RTN","TMGNDF2H",330,0) + ;" .01 NAME [RFa] +"RTN","TMGNDF2H",331,0) + ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",332,0) + ;" .05 VA GENERIC NAME <-Pntr [P50.6'a] +"RTN","TMGNDF2H",333,0) + ;" e.g. VA GENERIC NAME: DILTIAZEM +"RTN","TMGNDF2H",334,0) + ;" 1 DOSAGE FORM <-Pntr [P50.606'a] +"RTN","TMGNDF2H",335,0) + ;" e.g. DOSAGE FORM: CAP,SA +"RTN","TMGNDF2H",336,0) + ;" 2 STRENGTH [Fa] +"RTN","TMGNDF2H",337,0) + ;" e.g. STRENGTH: 240 +"RTN","TMGNDF2H",338,0) + ;" 3 UNITS <-Pntr [P50.607'a] +"RTN","TMGNDF2H",339,0) + ;" e.g. UNITS: MG +"RTN","TMGNDF2H",340,0) + ;" 4 NATIONAL FORMULARY NAME [Fa] +"RTN","TMGNDF2H",341,0) + ;" e.g. NATIONAL FORMULARY NAME: DILTIAZEM CAP,SA +"RTN","TMGNDF2H",342,0) + ;" 5 VA PRINT NAME [Fa] +"RTN","TMGNDF2H",343,0) + ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",344,0) + ;" 6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0^TMG ADDED" +"RTN","TMGNDF2H",345,0) + ;" e.g. VA PRODUCT IDENTIFIER: D0230 +"RTN","TMGNDF2H",346,0) + ;" 8 VA DISPENSE UNIT <-Pntr [P50.64a] +"RTN","TMGNDF2H",347,0) + ;" e.g. VA DISPENSE UNIT: CAPNSE UNIT <-Pntr [P50.64a] <-- plan to leave blank, for CMOP use +"RTN","TMGNDF2H",348,0) + ;" 14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P] +"RTN","TMGNDF2H",349,0) + ;" .01 -ACTIVE INGREDIENTS <-Pntr [P50.416'Xa] +"RTN","TMGNDF2H",350,0) + ;" e.g. ACTIVE INGREDIENTS: DILTIAZEM HYDROCHLORIDE +"RTN","TMGNDF2H",351,0) + ;" 1 -STRENGTH [Fa] +"RTN","TMGNDF2H",352,0) + ;" e.g. STRENGTH: 240 +"RTN","TMGNDF2H",353,0) + ;" 2 -UNITS <-Pntr [P50.607'a] +"RTN","TMGNDF2H",354,0) + ;" e.g. UNITS: MG +"RTN","TMGNDF2H",355,0) + ;" 15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a] +"RTN","TMGNDF2H",356,0) + ;" e.g. PRIMARY VA DRUG CLASS: CV200 +"RTN","TMGNDF2H",357,0) + ;" 16 SECONDARY VA DRUG CLASS W:^ D:^ <-Mult [50.6816P] +"RTN","TMGNDF2H",358,0) + ;" .01 -SECONDARY VA DRUG CLASS <-Pntr [MP50.605'aX] +"RTN","TMGNDF2H",359,0) + ;" 17 NATIONAL FORMULARY INDICATOR [Sa] +"RTN","TMGNDF2H",360,0) + ;" e.g. NATIONAL FORMULARY INDICATOR: NO +"RTN","TMGNDF2H",361,0) + ;" 18 NATIONAL FORMULARY RESTRICTIONW:^ D:^ <-WP [50.6818] +"RTN","TMGNDF2H",362,0) + ;" .01 -NATIONAL FORMULARY RESTRICTION [W] +"RTN","TMGNDF2H",363,0) + ;" 19 CS FEDERAL SCHEDULE [Sa] +"RTN","TMGNDF2H",364,0) + ;" 20 SINGLE/MULTI SOURCE PRODUCT [Sa] +"RTN","TMGNDF2H",365,0) + ;" 21 INACTIVATION DATE [Da] +"RTN","TMGNDF2H",366,0) + ;" 23 EXCLUDE DRG-DRG INTERACTION CK [S] +"RTN","TMGNDF2H",367,0) + ;" 25 MAX SINGLE DOSE [NJ13,4a] +"RTN","TMGNDF2H",368,0) + ;" 26 MIN SINGLE DOSE [NJ13,4a] +"RTN","TMGNDF2H",369,0) + ;" 27 MAX DAILY DOSE [NJ13,4a] +"RTN","TMGNDF2H",370,0) + ;" 28 MIN DAILY DOSE [NJ13,4a] +"RTN","TMGNDF2H",371,0) + ;" 29 MAX CUMULATIVE DOSE [NJ13,4a] +"RTN","TMGNDF2H",372,0) + ;" 30 DSS NUMBER [NJ6,0a] +"RTN","TMGNDF2H",373,0) + +"RTN","TMGNDF2H",374,0) + ;"--------------------------------------------------------- +"RTN","TMGNDF2H",375,0) + +"RTN","TMGNDF2H",376,0) + +"RTN","TMGNDF2H",377,0) + ;"File: TMG FDA IMPORT COMPILED Branch: 1 +"RTN","TMGNDF2H",378,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGNDF2H",379,0) + ;"=============================================================================== +"RTN","TMGNDF2H",380,0) + ;" 1 0;1 .01 TMG FDA LISTING ENTRY <-Pntr [RP22706.5'] +"RTN","TMGNDF2H",381,0) + ;" e.g. TMG FDA LISTING ENTRY: 154001 +"RTN","TMGNDF2H",382,0) + ;" 2 0;4 .05 TRADENAME [F] +"RTN","TMGNDF2H",383,0) + ;" e.g. TRADENAME: DILTIAZEM HCL SR CAPSULES +"RTN","TMGNDF2H",384,0) + ;" 3 0;6 .07 GENERIC NAME [F] +"RTN","TMGNDF2H",385,0) + ;" 4 1;3 .08 VA GENERIC <-Pntr [P50.6'] +"RTN","TMGNDF2H",386,0) + ;" 5 1;5 .09 VA DRUG CLASS <-Pntr [P50.605'] +"RTN","TMGNDF2H",387,0) + ;" 6 0;2 1 STRENGTH [F] +"RTN","TMGNDF2H",388,0) + ;" e.g. STRENGTH: 240 +"RTN","TMGNDF2H",389,0) + ;" 7 0;3 2 UNIT [F] +"RTN","TMGNDF2H",390,0) + ;" e.g. UNIT: MG +"RTN","TMGNDF2H",391,0) + ;" 8 0;5 3 ROUTE [F] +"RTN","TMGNDF2H",392,0) + ;" e.g. ??? +"RTN","TMGNDF2H",393,0) + ;" 9 0;7 3.5 DOSAGE FORM <-Pntr [P50.606] +"RTN","TMGNDF2H",394,0) + ;" 9 1;1 4 NDC [F] +"RTN","TMGNDF2H",395,0) + ;" e.g. NDC: 053978-3062-*3 +"RTN","TMGNDF2H",396,0) + ;" 10 1;2 5 NDC 12-DIGIT [F] +"RTN","TMGNDF2H",397,0) + ;" e.g. NDC: 0539783062*3 +"RTN","TMGNDF2H",398,0) + ;" 11 1;4 6 SKIP THIS RECORD [S] +"RTN","TMGNDF2H",399,0) + ;" 12 1;7 7 DONE ADDING TO 50.68 [S] +"RTN","TMGNDF2H",400,0) + ;" 2;0 14 VA PRODUCT MATCHES <-Mult [22706.914P] +"RTN","TMGNDF2H",401,0) + ;" 13 -0;1 .01 -ONE MATCH <-Pntr [P50.68'] +"RTN","TMGNDF2H",402,0) + ;" e.g. ONE MATCH: DILTIAZEM (DILACOR XR) 240MG SA CAP +"RTN","TMGNDF2H",403,0) + ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",404,0) + ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP +"RTN","TMGNDF2H",405,0) + ;" e.g. ONE MATCH: DILTIAZEM (WATSON-XR) 240MG SA CAP +"RTN","TMGNDF2H",406,0) + ;" e.g. ONE MATCH: DILTIAZEM (TIAZAC) 240MG SA CAP,UD +"RTN","TMGNDF2H",407,0) + ;" e.g. ONE MATCH: DILTIAZEM (CARDIZEM CD) 240MG SA CAP,UD +"RTN","TMGNDF2H",408,0) + ;" 3;0 15 VA PRODUCT POSS MATCH <-Mult [22706.915P] +"RTN","TMGNDF2H",409,0) + ;" 14 -0;1 .01 -POSS MATCH <-Pntr [P50.68'] +"RTN","TMGNDF2H",410,0) + ;" 4;0 16 INGREDIENTS <-Mult [22706.916] +"RTN","TMGNDF2H",411,0) + ;" 15 -0;1 .01 -NUMBER [NJ3,0] +"RTN","TMGNDF2H",412,0) + ;" e.g. NUMBER: 1 +"RTN","TMGNDF2H",413,0) + ;" 17 -0;3 2 -INGREDIENT <-Pntr [P50.416'] +"RTN","TMGNDF2H",414,0) + ;" e.g. INGREDIENT: DILTIAZEM HYDROCHLORIDE +"RTN","TMGNDF2H",415,0) + ;" 18 -0;4 3 -STRENGTH [F] +"RTN","TMGNDF2H",416,0) + ;" e.g. STRENGTH: 240 +"RTN","TMGNDF2H",417,0) + ;" 19 -0;6 5 -UNIT <-Pntr [P50.607'] +"RTN","TMGNDF2H",418,0) + ;" e.g. ??? +"RTN","TMGNDF2H",419,0) + ;" +"RTN","TMGNDF2H",420,0) + ;"=============================================================================== +"RTN","TMGNDF2H",421,0) + ;"<> 'n',I=FldDD DA=Data F=Find G=Goto N=Node P=Pointer VGL=VGL ?=Help +"RTN","TMGNDF2H",422,0) + ;" +"RTN","TMGNDF2H",423,0) + +"RTN","TMGNDF2H",424,0) + ;"new FDAitemNum +"RTN","TMGNDF2H",425,0) + ;"set FDAitemNum=$$GET1^DIQ(22706.9,IEN,.01) +"RTN","TMGNDF2H",426,0) + ;"new DrugInfo +"RTN","TMGNDF2H",427,0) + ;"set result=$$GetDrugInfo^TMGNDF1A(FDAitemNum,.DrugInfo,"",1) +"RTN","TMGNDF2H",428,0) + ;"if result=0 do goto A2VPDone +"RTN","TMGNDF2H",429,0) + ;". if Quiet=1 quit +"RTN","TMGNDF2H",430,0) + ;". write !,"Unable to Get Drug Info for record: ",FDAitemNum,! +"RTN","TMGNDF2H",431,0) + +"RTN","TMGNDF2H",432,0) + ;".01 NAME [RFa] +"RTN","TMGNDF2H",433,0) + ;" e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",434,0) + set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;"7;6= field .04 LONG NAME +"RTN","TMGNDF2H",435,0) + set TMGFDA(50.68,IENS,.01)=tempS ;".01 NAME [RFa] ;e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",436,0) + ;"set DrugInfo("ADDED","GENERIC+BRAND")=tempS +"RTN","TMGNDF2H",437,0) + +"RTN","TMGNDF2H",438,0) + ;".05 VA GENERIC NAME <-Pntr [P50.6'a] +"RTN","TMGNDF2H",439,0) + ;" e.g. VA GENERIC NAME: DILTIAZEM +"RTN","TMGNDF2H",440,0) + set TMGFDA(50.68,IENS,.05)=$$GET1^DIQ(22706.9,IEN,.08) +"RTN","TMGNDF2H",441,0) + +"RTN","TMGNDF2H",442,0) + ;"1 DOSAGE FORM <-Pntr [P50.606'a] +"RTN","TMGNDF2H",443,0) + ;" e.g. DOSAGE FORM: CAP,SA +"RTN","TMGNDF2H",444,0) + set TMGFDA(50.68,IENS,1)=$$GET1^DIQ(22706.9,IEN,3.5) +"RTN","TMGNDF2H",445,0) + +"RTN","TMGNDF2H",446,0) + ;"2 STRENGTH [Fa] +"RTN","TMGNDF2H",447,0) + ;" e.g. STRENGTH: 240 +"RTN","TMGNDF2H",448,0) + set TMGFDA(50.68,IENS,2)=$$GET1^DIQ(22706.9,IEN,1) +"RTN","TMGNDF2H",449,0) + +"RTN","TMGNDF2H",450,0) + ;"3 UNITS <-Pntr [P50.607'a] +"RTN","TMGNDF2H",451,0) + ;" e.g. UNITS: MG +"RTN","TMGNDF2H",452,0) + new tempUnits set tempUnits=$$GET1^DIQ(22706.9,IEN,2) +"RTN","TMGNDF2H",453,0) + if tempUnits'="" do +"RTN","TMGNDF2H",454,0) + . do EnsureUnits(tempUnits) +"RTN","TMGNDF2H",455,0) + . set TMGFDA(50.68,IENS,3)=tempUnits +"RTN","TMGNDF2H",456,0) + +"RTN","TMGNDF2H",457,0) + ;"5 VA PRINT NAME [Fa] +"RTN","TMGNDF2H",458,0) + ;" e.g. VA PRINT NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF2H",459,0) + ;"set tempS=$$MakeName(IEN,40,AllowCut) +"RTN","TMGNDF2H",460,0) + ;"if tempS="^" set result=0 goto A2VPDone +"RTN","TMGNDF2H",461,0) + set tempS=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = .055 TRADEBANE - 40 +"RTN","TMGNDF2H",462,0) + set TMGFDA(50.68,IENS,5)=tempS ;" 5=VA PRINT NAME +"RTN","TMGNDF2H",463,0) + +"RTN","TMGNDF2H",464,0) + ;"6 VA PRODUCT IDENTIFIER [Fa] <--- will use to store "0;TMG" +"RTN","TMGNDF2H",465,0) + ;" e.g. VA PRODUCT IDENTIFIER: D0230 +"RTN","TMGNDF2H",466,0) + set TMGFDA(50.68,IENS,6)="0;TMG" +"RTN","TMGNDF2H",467,0) + +"RTN","TMGNDF2H",468,0) + ;"14 ACTIVE INGREDIENTS W:^ D:^ <-Mult [50.6814P] +"RTN","TMGNDF2H",469,0) + ;"(multiple/subfile, add after this record added) +"RTN","TMGNDF2H",470,0) + +"RTN","TMGNDF2H",471,0) + ;"15 PRIMARY VA DRUG CLASS <-Pntr [P50.605'a] +"RTN","TMGNDF2H",472,0) + ;" e.g. PRIMARY VA DRUG CLASS: CV200 +"RTN","TMGNDF2H",473,0) + set TMGFDA(50.68,IENS,15)=$$GET1^DIQ(22706.9,IEN,.09) +"RTN","TMGNDF2H",474,0) + +"RTN","TMGNDF2H",475,0) + quit +"RTN","TMGNDF2H",476,0) + +"RTN","TMGNDF2H",477,0) + +"RTN","TMGNDF2H",478,0) +EnsureIngredients(fdaIEN,vapIEN) +"RTN","TMGNDF2H",479,0) + ;"Purpose: to ensure that all the ingredients from the FDA record (22706.9) are in the +"RTN","TMGNDF2H",480,0) + ;" VA PRODUCT record (50.68) +"RTN","TMGNDF2H",481,0) + ;"Input: fdaIEN -- the IEN from 22706.9 +"RTN","TMGNDF2H",482,0) + ;" vapIEN -- the target IEN in 50.68 +"RTN","TMGNDF2H",483,0) + ;"result: 1= OK to continue, 0=error +"RTN","TMGNDF2H",484,0) + +"RTN","TMGNDF2H",485,0) + new result set result=1 ;"default to success +"RTN","TMGNDF2H",486,0) + new recNum set recNum=1 +"RTN","TMGNDF2H",487,0) + ;"new IENS set IENS=fdaIEN_"," +"RTN","TMGNDF2H",488,0) + new IENS set IENS=vapIEN_"," +"RTN","TMGNDF2H",489,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF2H",490,0) + +"RTN","TMGNDF2H",491,0) + new subIEN set subIEN=0 ;"INGREDIENTS +"RTN","TMGNDF2H",492,0) + for set subIEN=+$order(^TMG(22706.9,fdaIEN,4,subIEN)) quit:(+subIEN'>0) do +"RTN","TMGNDF2H",493,0) + . new node set node=$get(^TMG(22706.9,fdaIEN,4,subIEN,0)) +"RTN","TMGNDF2H",494,0) + . new pIngredients,strength,units +"RTN","TMGNDF2H",495,0) + . set pIngredients=$piece(node,"^",3) ;"INGREDIENTS (a POINTER) +"RTN","TMGNDF2H",496,0) + . set strength=$piece(node,"^",4) ;"STRENGTH +"RTN","TMGNDF2H",497,0) + . set units=$piece(node,"^",6) ;"UNITS +"RTN","TMGNDF2H",498,0) + . ;"First search to ensure ingredient is not already present. +"RTN","TMGNDF2H",499,0) + . new subIEN2 set subIEN2=0 +"RTN","TMGNDF2H",500,0) + . new found set found=0 +"RTN","TMGNDF2H",501,0) + . for set subIEN2=$order(^PSNDF(50.68,vapIEN,2,subIEN2)) quit:(+subIEN2'>0)!found do +"RTN","TMGNDF2H",502,0) + . . new ptr set ptr=$piece($get(^PSNDF(50.68,vapIEN,2,subIEN2,0)),"^",1) +"RTN","TMGNDF2H",503,0) + . . if ptr=pIngredients set found=1 +"RTN","TMGNDF2H",504,0) + . if found=1 quit +"RTN","TMGNDF2H",505,0) + . if pIngredients="" do quit +"RTN","TMGNDF2H",506,0) + . . write !,"Ingredient entry is missing actual ingredient, so that subpart was DELETED.",! +"RTN","TMGNDF2H",507,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2H",508,0) + . . set TMGFDA(22706.916,subIEN_","_fdaIEN_",",.01)="@" ;"delete entry. +"RTN","TMGNDF2H",509,0) + . . do FILE^DIE("E","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",510,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2H",511,0) + . set TMGFDA(50.6814,"+"_recNum_","_IENS,.01)=pIngredients +"RTN","TMGNDF2H",512,0) + . if strength'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,1)=strength +"RTN","TMGNDF2H",513,0) + . if units'="" set TMGFDA(50.6814,"+"_recNum_","_IENS,2)=units +"RTN","TMGNDF2H",514,0) + . set recNum=recNum+1 +"RTN","TMGNDF2H",515,0) + +"RTN","TMGNDF2H",516,0) + if $data(TMGFDA)=0 goto EIDone +"RTN","TMGNDF2H",517,0) + do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2H",518,0) + if $data(TMGMSG("DIERR")) do goto A2VPDone +"RTN","TMGNDF2H",519,0) + . set result=0 if $get(Quiet)=1 quit +"RTN","TMGNDF2H",520,0) + . write !,"Error adding ingredients subrecord. IEN in 22706.9=",fdaIEN,! +"RTN","TMGNDF2H",521,0) + . new PriorErrorFound +"RTN","TMGNDF2H",522,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2H",523,0) +EIDone +"RTN","TMGNDF2H",524,0) + quit result +"RTN","TMGNDF2H",525,0) + +"RTN","TMGNDF2H",526,0) + +"RTN","TMGNDF2H",527,0) +EnsureNDC(IEN) +"RTN","TMGNDF2H",528,0) + ;"Purpose: Ensure record exists in NDC/UPN file (50.67). +"RTN","TMGNDF2H",529,0) + ;"Input: IEN -- IEN from file 22706.9 (TMG FDA IMPORT COMPILED) to add from +"RTN","TMGNDF2H",530,0) + ;"Output: An entry to be added to file 50.67 +"RTN","TMGNDF2H",531,0) + ;"Result: 1=OK to continue, 0 if error +"RTN","TMGNDF2H",532,0) + +"RTN","TMGNDF2H",533,0) + ;"Make record in NDC/UPN file (50.67). +"RTN","TMGNDF2H",534,0) + ;"File: NDC/UPN Branch: 1 +"RTN","TMGNDF2H",535,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGNDF2H",536,0) + ;"=============================================================================== +"RTN","TMGNDF2H",537,0) + ;" 1 0;1 .01 SEQUENCE NUMBER [RNJ9,0aX] +"RTN","TMGNDF2H",538,0) + ;" 2 0;2 1 NDC [Fa] +"RTN","TMGNDF2H",539,0) + ;" 3 0;3 2 UPN [Fa] +"RTN","TMGNDF2H",540,0) + ;" 4 0;4 3 MANUFACTURER <-Pntr [P55.95'a] +"RTN","TMGNDF2H",541,0) + ;" 5 0;5 4 TRADE NAME [Fa] +"RTN","TMGNDF2H",542,0) + ;" 6 0;6 5 VA PRODUCT NAME <-Pntr [P50.68'a] +"RTN","TMGNDF2H",543,0) + ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A] +"RTN","TMGNDF2H",544,0) + ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX] +"RTN","TMGNDF2H",545,0) + ;" 8 0;7 7 INACTIVATION DATE [Da] +"RTN","TMGNDF2H",546,0) + ;" 9 0;8 8 PACKAGE SIZE <-Pntr [P50.609'a] +"RTN","TMGNDF2H",547,0) + ;" 10 0;9 9 PACKAGE TYPE <-Pntr [P50.608'a] +"RTN","TMGNDF2H",548,0) + ;" 11 0;10 10 OTX/RX INDICATOR [Sa] +"RTN","TMGNDF2H",549,0) + ;" 2;0 11 PREVIOUS NDC W:^ D:^ <-Mult [50.6711A] +"RTN","TMGNDF2H",550,0) + ;" 12 -0;1 .01 -PREVIOUS NDC [Fa] +"RTN","TMGNDF2H",551,0) + ;" 3;0 12 PREVIOUS UPN W:^ D:^ <-Mult [50.6712A] +"RTN","TMGNDF2H",552,0) + ;" 13 -0;1 .01 -PREVIOUS UPN [Fa] +"RTN","TMGNDF2H",553,0) + ;" <> <> <> +"RTN","TMGNDF2H",554,0) + +"RTN","TMGNDF2H",555,0) + new result set result=0 ;" default to failure +"RTN","TMGNDF2H",556,0) + +"RTN","TMGNDF2H",557,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF2H",558,0) + +"RTN","TMGNDF2H",559,0) + new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) ;"1;2= field 5, NDC 12 digit +"RTN","TMGNDF2H",560,0) + new ndcIEN set ndcIEN=$order(^PSNDF(50.67,"NDC",NDC,"")) +"RTN","TMGNDF2H",561,0) + if +ndcIEN>0 set IENS=ndcIEN_"," goto EN1 +"RTN","TMGNDF2H",562,0) + +"RTN","TMGNDF2H",563,0) + ;"Below is for NEW records. DINUM at play here... +"RTN","TMGNDF2H",564,0) + new newIEN set newIEN="" +"RTN","TMGNDF2H",565,0) + for set newIEN=$order(^PSNDF(50.67,newIEN),-1) quit:(+newIEN=newIEN)!(newIEN="") +"RTN","TMGNDF2H",566,0) + if +newIEN=0 do write "Unable to create NDF entry for ",IEN,! goto ENDone +"RTN","TMGNDF2H",567,0) + set newIEN=newIEN+1 +"RTN","TMGNDF2H",568,0) + set TMGFDA(50.67,IENS,.01)=newIEN ;" .01 SEQUENCE NUMBER +"RTN","TMGNDF2H",569,0) + set IENS="+1," +"RTN","TMGNDF2H",570,0) + +"RTN","TMGNDF2H",571,0) +EN1 if NDC'="" set TMGFDA(50.67,IENS,1)=NDC ;"1=NDC +"RTN","TMGNDF2H",572,0) + +"RTN","TMGNDF2H",573,0) + ;"**Must add manufacturer if to be used! +"RTN","TMGNDF2H",574,0) + ;" 3 MANUFACTURER <-Pntr [P55.95'a] +"RTN","TMGNDF2H",575,0) + ;"new Firm set Firm=$get(DrugInfo("FIRM","NAME")) +"RTN","TMGNDF2H",576,0) + ;"if Firm'="" set TMGFDA(50.67,IENS,3)=Firm +"RTN","TMGNDF2H",577,0) + +"RTN","TMGNDF2H",578,0) + new tName set tName=$piece($get(^TMG(22706.9,IEN,7)),"^",3) ;"7;3 = TRADE NAME - 40 +"RTN","TMGNDF2H",579,0) + if tName'="" set TMGFDA(50.67,IENS,4)=tName ;" 4 TRADE NAME +"RTN","TMGNDF2H",580,0) + +"RTN","TMGNDF2H",581,0) + new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) ;"6;2=field 5.5, VA PRODUCT LINK +"RTN","TMGNDF2H",582,0) + if vapIEN>0 set TMGFDA(50.67,IENS,5)=vapIEN;" 5 VA PRODUCT NAME --pointer to newly added 50.68 record +"RTN","TMGNDF2H",583,0) + +"RTN","TMGNDF2H",584,0) + ;" 10 OTX/RX INDICATOR +"RTN","TMGNDF2H",585,0) + new codeOTC set codeOTC=$piece($get(^TMG(22706.9,IEN,7)),"^",5) ;"7;5= field 7, RX or OTC +"RTN","TMGNDF2H",586,0) + if codeOTC'="" set TMGFDA(50.67,IENS,10)=codeOTC +"RTN","TMGNDF2H",587,0) + +"RTN","TMGNDF2H",588,0) + ;"If I decide to add this, must do it after adding parent record. +"RTN","TMGNDF2H",589,0) + ;" 1;0 6 ROUTE OF ADMINISTRATION W:^ D:^ <-Mult [50.676A] +"RTN","TMGNDF2H",590,0) + ;" 7 -0;1 .01 -ROUTE OF ADMINISTRATION [FaX] +"RTN","TMGNDF2H",591,0) + +"RTN","TMGNDF2H",592,0) + if IENS'["+" do goto EN2 ;"update existing record +"RTN","TMGNDF2H",593,0) + . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF2H",594,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDF2H",595,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") ;"FDA is in INTERNAL format +"RTN","TMGNDF2H",596,0) + +"RTN","TMGNDF2H",597,0) + else do ;"add new record +"RTN","TMGNDF2H",598,0) + . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF2H",599,0) +EN2 +"RTN","TMGNDF2H",600,0) + if $data(TMGMSG("DIERR")) do goto ENDone +"RTN","TMGNDF2H",601,0) + . set result=0 +"RTN","TMGNDF2H",602,0) + . new PriorErrorFound +"RTN","TMGNDF2H",603,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF2H",604,0) + +"RTN","TMGNDF2H",605,0) + set result=1 ;"ensure we are at success. +"RTN","TMGNDF2H",606,0) + +"RTN","TMGNDF2H",607,0) +ENDone +"RTN","TMGNDF2H",608,0) + quit result +"RTN","TMGNDF2H",609,0) + +"RTN","TMGNDF2H",610,0) + +"RTN","TMGNDF2H",611,0) + ;"========================================================== +"RTN","TMGNDF2H",612,0) + ;"========================================================== +"RTN","TMGNDF2H",613,0) +EnsureUnits(UnitS) +"RTN","TMGNDF2H",614,0) + ;"Purpose: to ensure that the UnitS is valid in file 50.607 +"RTN","TMGNDF2H",615,0) + ;"Input: UnitS -- the string such as "mg;mg" +"RTN","TMGNDF2H",616,0) + ;"Output: If UnitS is not found in 50.607, then it will be added +"RTN","TMGNDF2H",617,0) + ;"Results: none +"RTN","TMGNDF2H",618,0) + +"RTN","TMGNDF2H",619,0) + new TMGROOT,TMGMSG +"RTN","TMGNDF2H",620,0) + +"RTN","TMGNDF2H",621,0) + ;"Finish later... +"RTN","TMGNDF2H",622,0) + +"RTN","TMGNDF2H",623,0) + ;"do FIND^DIC(50.607,"","","",UnitS,"*",,,,"TMGROOT","TMGMSG") +"RTN","TMGNDF2H",624,0) + ;"if +$get(TMGROOT("DILIST",0))=1 goto EUDone +"RTN","TMGNDF2H",625,0) + ;"goto EUDone +"RTN","TMGNDF2H",626,0) + +"RTN","TMGNDF2H",627,0) + ;"Note: if there are duplicate entries (i.e. 2 entries for MG/0.5ML), then Y=-1 +"RTN","TMGNDF2H",628,0) + new X,Y,DIC +"RTN","TMGNDF2H",629,0) + set DIC=50.607 +"RTN","TMGNDF2H",630,0) + set DIC(0)="XML" +"RTN","TMGNDF2H",631,0) + set X=UnitS +"RTN","TMGNDF2H",632,0) + do ^DIC +"RTN","TMGNDF2H",633,0) + if +Y'>0 do +"RTN","TMGNDF2H",634,0) + . if $get(Quiet)=1 quit +"RTN","TMGNDF2H",635,0) + . write !,"Can't find or add: ",UnitS,! +"RTN","TMGNDF2H",636,0) + +"RTN","TMGNDF2H",637,0) +EUDone +"RTN","TMGNDF2H",638,0) + quit +"RTN","TMGNDF2H",639,0) + +"RTN","TMGNDF2H",640,0) +Unlock50dot607 +"RTN","TMGNDF2H",641,0) + ;"Purpose to allow deletion in file 50.607 +"RTN","TMGNDF2H",642,0) + +"RTN","TMGNDF2H",643,0) + kill ^DD(50.607,.01,8.5) +"RTN","TMGNDF2H",644,0) + kill ^DD(50.607,.01,9) +"RTN","TMGNDF2H",645,0) + +"RTN","TMGNDF2H",646,0) + quit +"RTN","TMGNDF2H",647,0) + +"RTN","TMGNDF2H",648,0) +Lock50dot607 +"RTN","TMGNDF2H",649,0) + ;"Purpose: to restore lock on file 50.607 +"RTN","TMGNDF2H",650,0) + +"RTN","TMGNDF2H",651,0) + set ^DD(50.607,.01,8.5)="^" +"RTN","TMGNDF2H",652,0) + set ^DD(50.607,.01,9)="^" +"RTN","TMGNDF2H",653,0) + +"RTN","TMGNDF2H",654,0) + quit +"RTN","TMGNDF2H",655,0) + +"RTN","TMGNDF2H",656,0) +Link2VAP +"RTN","TMGNDF2H",657,0) + ;"Purpose: to fill file 22706.9, field 5.5 in with link to a record +"RTN","TMGNDF2H",658,0) + ;" in VA PRODUCT file (50.68) that has the SAME national drug +"RTN","TMGNDF2H",659,0) + ;" code (NDC). It checks for and handles situations where there +"RTN","TMGNDF2H",660,0) + ;" are multiple entries in 50.68 with the same NDC. It picks +"RTN","TMGNDF2H",661,0) + ;" the entry with the closest name as the one to use. +"RTN","TMGNDF2H",662,0) + ;" --It also removes such a link from the VA PRODUCT SIMILAR MATCHES +"RTN","TMGNDF2H",663,0) + ;" field. I.e. it is not a 'similar' match if it is an exact match. +"RTN","TMGNDF2H",664,0) + ;" --It also removes such a link from the VA PRODUCT POSSIBLE MATCHES +"RTN","TMGNDF2H",665,0) + ;" field. I.e. it is not a 'possible' match if it is an exact match. +"RTN","TMGNDF2H",666,0) + ;"Results: none. +"RTN","TMGNDF2H",667,0) + +"RTN","TMGNDF2H",668,0) + ;"new pNDCIndex +"RTN","TMGNDF2H",669,0) + ;"set pNDCIndex=$name(^TMG("TMP","INDEX NDC-->VAP")) +"RTN","TMGNDF2H",670,0) + set pNDCIndex=$name(^PSNDF(50.67,"NDC")) +"RTN","TMGNDF2H",671,0) + +"RTN","TMGNDF2H",672,0) + new Itr,IEN,success +"RTN","TMGNDF2H",673,0) + new abort set abort=0 +"RTN","TMGNDF2H",674,0) + new modCount set modCount=0 +"RTN","TMGNDF2H",675,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF2H",676,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF2H",677,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF2H",678,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF2H",679,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP THIS RECORD +"RTN","TMGNDF2H",680,0) + . new NDC set NDC=$piece($get(^TMG(22706.9,IEN,1)),"^",2) +"RTN","TMGNDF2H",681,0) + . if NDC="" quit ;"Can't link if no NDC. Fix later? +"RTN","TMGNDF2H",682,0) + . new count set count=$$ListCt^TMGMISC($name(@pNDCIndex@(NDC))) +"RTN","TMGNDF2H",683,0) + . new VAP set VAP=0 +"RTN","TMGNDF2H",684,0) + . if count=1 do +"RTN","TMGNDF2H",685,0) + . . new ndcP1 +"RTN","TMGNDF2H",686,0) + . . set ndcP1=+$order(@pNDCIndex@(NDC,"")) +"RTN","TMGNDF2H",687,0) + . . set VAP=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6) +"RTN","TMGNDF2H",688,0) + . else do +"RTN","TMGNDF2H",689,0) + . . new vap1,s1,fdaS,ndcP1 +"RTN","TMGNDF2H",690,0) + . . new bestScore set bestScore=0 +"RTN","TMGNDF2H",691,0) + . . new bestVAP set bestVAP=0 +"RTN","TMGNDF2H",692,0) + . . new bestS set bestS="" +"RTN","TMGNDF2H",693,0) + . . set fdaS=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TradeName, field .05 +"RTN","TMGNDF2H",694,0) + . . set ndcP1=+$order(@pNDCIndex@(NDC,"")) +"RTN","TMGNDF2H",695,0) + . . for do set ndcP1=+$order(@pNDCIndex@(NDC,ndcP1)) quit:(+ndcP1'>0) +"RTN","TMGNDF2H",696,0) + . . . set vap1=+$piece($get(^PSNDF(50.67,ndcP1,0)),"^",6) +"RTN","TMGNDF2H",697,0) + . . . set s1=$piece($get(^PSNDF(50.68,vap1,0)),"^",1) +"RTN","TMGNDF2H",698,0) + . . . new tempScore set tempScore=$$Comp2Strs^TMGSTUTL(fdaS,s1) +"RTN","TMGNDF2H",699,0) + . . . if tempScore>bestScore set bestScore=tempScore,bestVAP=vap1,bestS=s1 +"RTN","TMGNDF2H",700,0) + . . if bestScore'>1 set bestVAP=0 +"RTN","TMGNDF2H",701,0) + . . set VAP=bestVAP +"RTN","TMGNDF2H",702,0) + . if VAP=0 quit +"RTN","TMGNDF2H",703,0) + . if $piece($get(^TMG(22706.9,IEN,6)),"^",2)'=VAP do +"RTN","TMGNDF2H",704,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2H",705,0) + . . set TMGFDA(22706.9,IEN_",",5.5)=VAP +"RTN","TMGNDF2H",706,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",707,0) + . . do ShowIfDIERR^TMGDEBUG("TMGMSG") +"RTN","TMGNDF2H",708,0) + . . set modCount=modCount+1 +"RTN","TMGNDF2H",709,0) + . new subIEN set subIEN=0 +"RTN","TMGNDF2H",710,0) + . for set subIEN=$order(^TMG(22706.9,IEN,2,subIEN)) quit:(+subIEN'>0) do +"RTN","TMGNDF2H",711,0) + . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,2,subIEN,0)),"^",1) +"RTN","TMGNDF2H",712,0) + . . if nearVAP'=VAP quit +"RTN","TMGNDF2H",713,0) + . . ;"write "SIMILAR MATCH contains this link. Deleting...",! +"RTN","TMGNDF2H",714,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2H",715,0) + . . set TMGFDA(22706.914,subIEN_","_IEN_",",.01)="@" +"RTN","TMGNDF2H",716,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",717,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2H",718,0) + . . set modCount=modCount+1 +"RTN","TMGNDF2H",719,0) + . for set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) quit:(+subIEN'>0) do +"RTN","TMGNDF2H",720,0) + . . new nearVAP set nearVAP=$piece($get(^TMG(22706.9,IEN,3,subIEN,0)),"^",1) +"RTN","TMGNDF2H",721,0) + . . if nearVAP'=VAP quit +"RTN","TMGNDF2H",722,0) + . . ;"write "POSS SIMILAR MATCH contains this link. Deleting...",! +"RTN","TMGNDF2H",723,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF2H",724,0) + . . set TMGFDA(22706.915,subIEN_","_IEN_",",.01)="@" +"RTN","TMGNDF2H",725,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF2H",726,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF2H",727,0) + . . set modCount=modCount+1 +"RTN","TMGNDF2H",728,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF2H",729,0) + +"RTN","TMGNDF2H",730,0) + write modCount," modifications made.",! +"RTN","TMGNDF2H",731,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF2H",732,0) + quit +"RTN","TMGNDF2H",733,0) + +"RTN","TMGNDF3A") +0^48^B12884 +"RTN","TMGNDF3A",1,0) +TMGNDF3A ;TMG/kst/FDA Import: Drug class stuff ;03/25/06 +"RTN","TMGNDF3A",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF3A",3,0) + +"RTN","TMGNDF3A",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF3A",5,0) + ;" Further processing, after functions in TMGNDF2C +"RTN","TMGNDF3A",6,0) + ;" Primarily working VA DRUG CLASS stuff. +"RTN","TMGNDF3A",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF3A",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF3A",9,0) + ;"11-21-2006 +"RTN","TMGNDF3A",10,0) + +"RTN","TMGNDF3A",11,0) + ;"======================================================================= +"RTN","TMGNDF3A",12,0) + ;" API -- Public Functions. +"RTN","TMGNDF3A",13,0) + ;"======================================================================= +"RTN","TMGNDF3A",14,0) + ;"Menu +"RTN","TMGNDF3A",15,0) + ;"======================================================================= +"RTN","TMGNDF3A",16,0) + ;"FillFromVADrugClass -- ensure that all the entries in TMG FDA IMPORT COMPILED +"RTN","TMGNDF3A",17,0) + ;" have a value for field VA DRUG CLASS +"RTN","TMGNDF3A",18,0) + ;"HandleEmptyClasses -- allow classification of all unclassified drugs (ones +"RTN","TMGNDF3A",19,0) + ;" with no potential match found in VistA database as a +"RTN","TMGNDF3A",20,0) + ;" starting point) +"RTN","TMGNDF3A",21,0) + +"RTN","TMGNDF3A",22,0) + ;"======================================================================= +"RTN","TMGNDF3A",23,0) + ;" Private Functions. +"RTN","TMGNDF3A",24,0) + ;"======================================================================= +"RTN","TMGNDF3A",25,0) + ;"ShowClasses -- Display all the drug classes, in a heirarchy. +"RTN","TMGNDF3A",26,0) + ;"GetClasses(Array) -- Purpose: To get an array back the shows the heirarchy of all VA DRUG classes +"RTN","TMGNDF3A",27,0) + ;"KillIntro(Array) One of the drug classes is AA000, INTRODUCTION. This will kill entry from the Array +"RTN","TMGNDF3A",28,0) + ;"GetClHeirarchy(ClassIEN,Array) -- get an array back the shows the heirarchy of one VA DRUG class +"RTN","TMGNDF3A",29,0) + ;"FixClasses -- fix VA DRUG CLASS records which are not properly linked into the heirarchy. +"RTN","TMGNDF3A",30,0) + ;"Fix1Class(IEN) -- fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy. +"RTN","TMGNDF3A",31,0) + ;"GetInfo(IEN,Array) -- fill record from VA DRUG CLASS file into a usable array +"RTN","TMGNDF3A",32,0) + ;"TestSelectClass +"RTN","TMGNDF3A",33,0) + ;"$$SelectClass(Array,AskSub) -- Allow user to browse Array and select drug class +"RTN","TMGNDF3A",34,0) + ;"Search4Class() -- use Fileman to search for a drug class +"RTN","TMGNDF3A",35,0) + ;"$$SelectFrom(pRef) -- Allow user to browse Array and select drug class +"RTN","TMGNDF3A",36,0) + ;"SrchItems(input,Items) -- Search through Items array for input, and return index number if found +"RTN","TMGNDF3A",37,0) + ;"TestGather +"RTN","TMGNDF3A",38,0) + ;"GatherClasses(Array) +"RTN","TMGNDF3A",39,0) + ;"GetPossClass(IEN,Array) -- gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS +"RTN","TMGNDF3A",40,0) + ;"VerifyClasses(Array) -- allow user to accept or reject proposed drug class for new drugs. +"RTN","TMGNDF3A",41,0) + ;"ShowInstructions() +"RTN","TMGNDF3A",42,0) + ;"LookupHelp() +"RTN","TMGNDF3A",43,0) + ;"FindHelp() +"RTN","TMGNDF3A",44,0) + ;"SimHelp() +"RTN","TMGNDF3A",45,0) + ;"ShowList(Array,Answers,CompactMode,ShowBoth) -- To display the list generated by GatherClasses, by class orginization +"RTN","TMGNDF3A",46,0) + ;"DoSetClass(Array,Answers,List) -- add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF3A",47,0) + ;"ShowInfo(Array,Answers,Num) -- show more about the specified drug +"RTN","TMGNDF3A",48,0) + ;"DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled) -- remove entries from Array and Answers +"RTN","TMGNDF3A",49,0) + ;"DoLookup(Array,Answers,Classes,List,Cancelled) -- Manually lookup class for entries +"RTN","TMGNDF3A",50,0) + ;"WriteClass(ClassIEN,Array,Answers,List) -- do the actual setting of the class +"RTN","TMGNDF3A",51,0) + ;"ClrAnswers(Array,Answers,List,FromECode,UndoArray) -- remove entries from Array and Answers array. +"RTN","TMGNDF3A",52,0) + ;"VerifyWrite(ClassName,Answers,List) -- display list of entries and ask user if class set is desired +"RTN","TMGNDF3A",53,0) + ;"Disp2List(Answers,List,ByTradeName,ShowBoth) -- interfact to DisplayList function, to allow easier input. +"RTN","TMGNDF3A",54,0) + ;"DisplayList(Answers,List,Piece,AlsoPiece) -- display list of entries +"RTN","TMGNDF3A",55,0) + ;"SimilarPick(Array,Answers,List,Cancelled) -- allow user to specify that a set of numbers should use the same class as +"RTN","TMGNDF3A",56,0) + ;"FindPick(Array,Answers,List,FromECode,Cancelled) -- allow user to look up a drug already in the VistA database, and use the +"RTN","TMGNDF3A",57,0) + +"RTN","TMGNDF3A",58,0) + ;"GatherEmpties(Array) -- scan through all records in TMG FDA IMPORT COMPILED, and create an array of +"RTN","TMGNDF3A",59,0) + ;"ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth) -- display the list of 'Empty' classes generated by GatherEmpties +"RTN","TMGNDF3A",60,0) + ;"ClassEClasses(Array) -- allow user to classify drugs with empty (none) VA Drug Class +"RTN","TMGNDF3A",61,0) + ;"DoGuess(Array,Answers,EntryList,Cancelled,Classes) -- a wrapper for DoEGuess +"RTN","TMGNDF3A",62,0) + ;"DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FormECode,Classes) - guess as classification for entries. +"RTN","TMGNDF3A",63,0) + ;"GGuessList(Array,Answers,List,Results) -- gather a guessing list of possible classes for each entry in List +"RTN","TMGNDF3A",64,0) + ;"AutoEClassification(Array) -- attempt to automatically classiffy drugs that have not potential match +"RTN","TMGNDF3A",65,0) + ;"Guess1(Array,Answers,List) -- return a guessed class, IF there is only one possible guess. +"RTN","TMGNDF3A",66,0) + ;"DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth) -- tools for managing SETS to be worked on (List) +"RTN","TMGNDF3A",67,0) + ;"MkSrchList(Answers,List,ByTradeName,ShowBoth) -- search through Answers for string +"RTN","TMGNDF3A",68,0) + +"RTN","TMGNDF3A",69,0) + ;"======================================================================= +"RTN","TMGNDF3A",70,0) + ;"======================================================================= +"RTN","TMGNDF3A",71,0) + +"RTN","TMGNDF3A",72,0) + ;"This block of code will deal with establishing the VA DRUG CLASS +"RTN","TMGNDF3A",73,0) + +"RTN","TMGNDF3A",74,0) +Menu +"RTN","TMGNDF3A",75,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF3A",76,0) + +"RTN","TMGNDF3A",77,0) + new Menu,UsrSlct +"RTN","TMGNDF3A",78,0) + set Menu(0)="Pick Option for Filling Import Drug Class (3A)" +"RTN","TMGNDF3A",79,0) + set Menu(1)="Set class by Linked VA PRODUCT entry if Possible"_$char(9)_"FillByLink" +"RTN","TMGNDF3A",80,0) + set Menu(2)="Fill DRUG class for IMPORT entries from best guess."_$char(9)_"FillFromVADrugClass" +"RTN","TMGNDF3A",81,0) + set Menu(3)="Fill DRUG class for IMPORT entries with no guess."_$char(9)_"HandleEmptyClasses" +"RTN","TMGNDF3A",82,0) + set Menu(4)="Use SELECTOR to browse and edit IMPORT classes"_$char(9)_"SelEdClasses" +"RTN","TMGNDF3A",83,0) + set Menu(5)="Pick just 1 import and edit drug Class"_$char(9)_"Edit1" +"RTN","TMGNDF3A",84,0) + set Menu(6)="Pick imports to SKIP based on their drug CLASS"_$char(9)_"PickSkips" +"RTN","TMGNDF3A",85,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF3A",86,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF3A",87,0) + +"RTN","TMGNDF3A",88,0) +MC1 +"RTN","TMGNDF3A",89,0) + write # +"RTN","TMGNDF3A",90,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF3A",91,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF3A",92,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF3A",93,0) + +"RTN","TMGNDF3A",94,0) + if UsrSlct="FillFromVADrugClass" do FillFromVADrugClass goto MC1 +"RTN","TMGNDF3A",95,0) + if UsrSlct="HandleEmptyClasses" do HandleEmptyClasses goto MC1 +"RTN","TMGNDF3A",96,0) + if UsrSlct="FillByLink" do FillByLink goto MC1 +"RTN","TMGNDF3A",97,0) + if UsrSlct="SelEdClasses" do SelEdClasses goto MC1 +"RTN","TMGNDF3A",98,0) + if UsrSlct="Edit1" do Ed1Classes goto MC1 +"RTN","TMGNDF3A",99,0) + +"RTN","TMGNDF3A",100,0) + if UsrSlct="PickSkips" do PickSkips^TMGNDF3B goto MC1 +"RTN","TMGNDF3A",101,0) + +"RTN","TMGNDF3A",102,0) + if UsrSlct="Prev" goto Menu^TMGNDF2H ;"quit can occur from there... +"RTN","TMGNDF3A",103,0) + if UsrSlct="Next" goto Menu^TMGNDF3C ;"quit can occur from there... +"RTN","TMGNDF3A",104,0) + +"RTN","TMGNDF3A",105,0) + goto MC1 +"RTN","TMGNDF3A",106,0) +MCDone +"RTN","TMGNDF3A",107,0) + quit +"RTN","TMGNDF3A",108,0) + +"RTN","TMGNDF3A",109,0) + +"RTN","TMGNDF3A",110,0) + +"RTN","TMGNDF3A",111,0) +FillFromVADrugClass +"RTN","TMGNDF3A",112,0) + ;"Purpose: to provide a high-level entry point for ensuring that all the entries +"RTN","TMGNDF3A",113,0) + ;" in TMG FDA IMPORT COMPILED have a value for field VA DRUG CLASS +"RTN","TMGNDF3A",114,0) + +"RTN","TMGNDF3A",115,0) + write # +"RTN","TMGNDF3A",116,0) + write "======================================================",! +"RTN","TMGNDF3A",117,0) + write "Link FDA import entries to proper VA DRUG CLASS",! +"RTN","TMGNDF3A",118,0) + write "======================================================",!,! +"RTN","TMGNDF3A",119,0) + +"RTN","TMGNDF3A",120,0) + ;"do FillByLink ;"see if any easy links are all ready to go... +"RTN","TMGNDF3A",121,0) + new list +"RTN","TMGNDF3A",122,0) + new % set %=2 +"RTN","TMGNDF3A",123,0) + if $data(^TMG("TMP","DRUGS NEEDING CLASS"))>0 do +"RTN","TMGNDF3A",124,0) + . write !,"Infomation from a prior run found.",! +"RTN","TMGNDF3A",125,0) + . write "Use older info (recommended only during the same import cycle)" +"RTN","TMGNDF3A",126,0) + . set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",127,0) + . if %=1 do +"RTN","TMGNDF3A",128,0) + . . write "Loading... " +"RTN","TMGNDF3A",129,0) + . . merge list=^TMG("TMP","DRUGS NEEDING CLASS") +"RTN","TMGNDF3A",130,0) + . . write "Done.",! +"RTN","TMGNDF3A",131,0) + if (%=-1) goto FDCDone +"RTN","TMGNDF3A",132,0) + if (%=2) do +"RTN","TMGNDF3A",133,0) + . write "Scanning drug file...",! +"RTN","TMGNDF3A",134,0) + . do GatherClasses(.list) +"RTN","TMGNDF3A",135,0) + . do AutoEClassification(.list) +"RTN","TMGNDF3A",136,0) + do VerifyClasses(.list) +"RTN","TMGNDF3A",137,0) + +"RTN","TMGNDF3A",138,0) + set %=1 +"RTN","TMGNDF3A",139,0) + write "Save information for future use" +"RTN","TMGNDF3A",140,0) + do YN^DICN write ! +"RTN","TMGNDF3A",141,0) + if %=1 do SaveList(.list) +"RTN","TMGNDF3A",142,0) + +"RTN","TMGNDF3A",143,0) +FDCDone write "Done.",! +"RTN","TMGNDF3A",144,0) + quit +"RTN","TMGNDF3A",145,0) + +"RTN","TMGNDF3A",146,0) + +"RTN","TMGNDF3A",147,0) +SaveList(List) +"RTN","TMGNDF3A",148,0) + ;"Purpse: save list +"RTN","TMGNDF3A",149,0) + kill ^TMG("TMP","DRUGS NEEDING CLASS") +"RTN","TMGNDF3A",150,0) + merge ^TMG("TMP","DRUGS NEEDING CLASS")=list +"RTN","TMGNDF3A",151,0) + +"RTN","TMGNDF3A",152,0) + quit +"RTN","TMGNDF3A",153,0) + +"RTN","TMGNDF3A",154,0) + +"RTN","TMGNDF3A",155,0) +FillByLink +"RTN","TMGNDF3A",156,0) + ;"Purpose: Fill Drug class for any drug that has an empty class, but points to +"RTN","TMGNDF3A",157,0) + ;" an entry in 50.68 +"RTN","TMGNDF3A",158,0) + +"RTN","TMGNDF3A",159,0) + write "Setting DRUG CLASS of imports from VA PRODUCT link, if possible.",! +"RTN","TMGNDF3A",160,0) + new count set count=0 +"RTN","TMGNDF3A",161,0) + new Itr,IEN +"RTN","TMGNDF3A",162,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3A",163,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3A",164,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF3A",165,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3A",166,0) + . new CurClass,newClass +"RTN","TMGNDF3A",167,0) + . set CurClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) +"RTN","TMGNDF3A",168,0) + . if CurClass=0 do +"RTN","TMGNDF3A",169,0) + . . new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,2,1,0)),"^",1) +"RTN","TMGNDF3A",170,0) + . . if vapIEN=0 quit +"RTN","TMGNDF3A",171,0) + . . set newClass=+$piece($get(^PSDNF(50.68,vapIEN,3)),"^",1) +"RTN","TMGNDF3A",172,0) + . . if newClass'=0 do +"RTN","TMGNDF3A",173,0) + . . . ;"write IEN," can be loaded with class: ",newClass,! +"RTN","TMGNDF3A",174,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF3A",175,0) + . . . set TMGFDA(22706.9,IEN_",",.09)=newClass +"RTN","TMGNDF3A",176,0) + . . . ;"set $piece(^TMG(22706.9,IEN,1),"^",5)=newClass +"RTN","TMGNDF3A",177,0) + . . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3A",178,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3A",179,0) + . . . set count=count+1 +"RTN","TMGNDF3A",180,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3A",181,0) + +"RTN","TMGNDF3A",182,0) + write count," entries modified.",! +"RTN","TMGNDF3A",183,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3A",184,0) + quit +"RTN","TMGNDF3A",185,0) + +"RTN","TMGNDF3A",186,0) + +"RTN","TMGNDF3A",187,0) +ShowClasses +"RTN","TMGNDF3A",188,0) + ;"Purpose: to display all the drug classes, in a heirarchy. +"RTN","TMGNDF3A",189,0) + +"RTN","TMGNDF3A",190,0) + new Array +"RTN","TMGNDF3A",191,0) + do GetClasses(.Array) +"RTN","TMGNDF3A",192,0) + do ArrayDump^TMGDEBUG("Array") +"RTN","TMGNDF3A",193,0) + quit +"RTN","TMGNDF3A",194,0) + +"RTN","TMGNDF3A",195,0) + +"RTN","TMGNDF3A",196,0) +GetClasses(Array) +"RTN","TMGNDF3A",197,0) + ;"Purpose: To get an array back the shows the heirarchy of all VA DRUG classes +"RTN","TMGNDF3A",198,0) + ;" Array -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF3A",199,0) + ;"Output: Array will be filled as follows: +"RTN","TMGNDF3A",200,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3A",201,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3A",202,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3A",203,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3A",204,0) + ;" Note: prior entries in Array are NOT killed. +"RTN","TMGNDF3A",205,0) + ;"Results: none +"RTN","TMGNDF3A",206,0) + +"RTN","TMGNDF3A",207,0) + new IEN +"RTN","TMGNDF3A",208,0) + set IEN=$order(^PS(50.605,0)) +"RTN","TMGNDF3A",209,0) + if +IEN>0 for do quit:(+IEN'>0) +"RTN","TMGNDF3A",210,0) + . do GetClHeirarchy(IEN,.Array) +"RTN","TMGNDF3A",211,0) + . set IEN=$order(^PS(50.605,IEN)) +"RTN","TMGNDF3A",212,0) + +"RTN","TMGNDF3A",213,0) + quit +"RTN","TMGNDF3A",214,0) + +"RTN","TMGNDF3A",215,0) +KillIntro(Array) +"RTN","TMGNDF3A",216,0) + ;"Purpose: One of the drug classes is AA000, INTRODUCTION. This will kill this +"RTN","TMGNDF3A",217,0) + ;" entry from the Array +"RTN","TMGNDF3A",218,0) + ;"Input: Array -- Array, as created by GetClasses +"RTN","TMGNDF3A",219,0) + +"RTN","TMGNDF3A",220,0) + new IEN +"RTN","TMGNDF3A",221,0) + set IEN=$order(Array("")) +"RTN","TMGNDF3A",222,0) + if IEN'="" for do quit:(IEN="") +"RTN","TMGNDF3A",223,0) + . new temp set temp=IEN +"RTN","TMGNDF3A",224,0) + . set IEN=$order(Array(IEN)) +"RTN","TMGNDF3A",225,0) + . if $piece(Array(temp),"^",1)="AA000" kill Array(temp) +"RTN","TMGNDF3A",226,0) + +"RTN","TMGNDF3A",227,0) + quit +"RTN","TMGNDF3A",228,0) + +"RTN","TMGNDF3A",229,0) + +"RTN","TMGNDF3A",230,0) +GetClHeirarchy(ClassIEN,Array) +"RTN","TMGNDF3A",231,0) + ;"Purpose: To get an array back the shows the heirarchy of one VA DRUG class +"RTN","TMGNDF3A",232,0) + ;"Input: ClassIEN -- the IEN in file VA DRUG CLASS (50.605) +"RTN","TMGNDF3A",233,0) + ;" Array -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF3A",234,0) + ;"Output: Array will be filled as follows: +"RTN","TMGNDF3A",235,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3A",236,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3A",237,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3A",238,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3A",239,0) + ;" Note: prior entries in Array are NOT killed. +"RTN","TMGNDF3A",240,0) + ;"Results: none +"RTN","TMGNDF3A",241,0) + +"RTN","TMGNDF3A",242,0) + new ParentClass,indent +"RTN","TMGNDF3A",243,0) + new ResultArray +"RTN","TMGNDF3A",244,0) + +"RTN","TMGNDF3A",245,0) + if (+ClassIEN'=0) for do quit:(+ClassIEN=0) +"RTN","TMGNDF3A",246,0) + . new tempArray +"RTN","TMGNDF3A",247,0) + . if $data(ResultArray) do +"RTN","TMGNDF3A",248,0) + . . new temp merge temp=ResultArray +"RTN","TMGNDF3A",249,0) + . . kill ResultArray +"RTN","TMGNDF3A",250,0) + . . merge ResultArray(ClassIEN)=temp +"RTN","TMGNDF3A",251,0) + . new Curnode,Code,Name,CodeNum +"RTN","TMGNDF3A",252,0) + . set Curnode=$get(^PS(50.605,ClassIEN,0)) +"RTN","TMGNDF3A",253,0) + . set Code=$piece(Curnode,"^",1) +"RTN","TMGNDF3A",254,0) + . set CodeNum=+$extract(Code,3,5) +"RTN","TMGNDF3A",255,0) + . set Name=$piece(Curnode,"^",2) +"RTN","TMGNDF3A",256,0) + . set tempArray(ClassIEN)=Code_"^"_Name +"RTN","TMGNDF3A",257,0) + . set ParentClass=$piece(Curnode,"^",3) +"RTN","TMGNDF3A",258,0) + . if ParentClass=ClassIEN set ParentClass=0 ;"I found at least one circular ref. +"RTN","TMGNDF3A",259,0) + . if (ParentClass=0)&(CodeNum'=0) do +"RTN","TMGNDF3A",260,0) + . . write IEN,": ",Name," appears broken: ",Code," Will fix...",! +"RTN","TMGNDF3A",261,0) + . . do Fix1Class(IEN) +"RTN","TMGNDF3A",262,0) + . set ClassIEN=ParentClass +"RTN","TMGNDF3A",263,0) + . merge ResultArray=tempArray +"RTN","TMGNDF3A",264,0) + +"RTN","TMGNDF3A",265,0) + merge Array=ResultArray +"RTN","TMGNDF3A",266,0) + +"RTN","TMGNDF3A",267,0) + quit +"RTN","TMGNDF3A",268,0) + +"RTN","TMGNDF3A",269,0) + +"RTN","TMGNDF3A",270,0) +FixClasses +"RTN","TMGNDF3A",271,0) + ;"Purpose: I have found a few instances in the VA DRUG CLASS file where records are +"RTN","TMGNDF3A",272,0) + ;" not properly linked into the heirarchy. They either give themselves as +"RTN","TMGNDF3A",273,0) + ;" their own parents, or list no parent, though one should be present. +"RTN","TMGNDF3A",274,0) + ;" If any such entries exist, this function will fix them. +"RTN","TMGNDF3A",275,0) + +"RTN","TMGNDF3A",276,0) + new IEN +"RTN","TMGNDF3A",277,0) + set IEN=$order(^PS(50.605,0)) +"RTN","TMGNDF3A",278,0) + if +IEN>0 for do quit:(+IEN'>0) +"RTN","TMGNDF3A",279,0) + . new Curnode,Code,CodeNum,Name +"RTN","TMGNDF3A",280,0) + . set Curnode=$get(^PS(50.605,IEN,0)) +"RTN","TMGNDF3A",281,0) + . set Code=$piece(Curnode,"^",1) +"RTN","TMGNDF3A",282,0) + . set CodeNum=+$extract(Code,3,5) +"RTN","TMGNDF3A",283,0) + . set Name=$piece(Curnode,"^",2) +"RTN","TMGNDF3A",284,0) + . set ParentClass=+$piece(Curnode,"^",3) +"RTN","TMGNDF3A",285,0) + . if ParentClass=IEN set ParentClass=0 +"RTN","TMGNDF3A",286,0) + . if (ParentClass=0)&(CodeNum'=0) do +"RTN","TMGNDF3A",287,0) + . . write IEN,": ",Name," appears broken: ",Code," Will fix...",! +"RTN","TMGNDF3A",288,0) + . . do Fix1Class(IEN) +"RTN","TMGNDF3A",289,0) + . set IEN=$order(^PS(50.605,IEN)) +"RTN","TMGNDF3A",290,0) + +"RTN","TMGNDF3A",291,0) + quit +"RTN","TMGNDF3A",292,0) + +"RTN","TMGNDF3A",293,0) + +"RTN","TMGNDF3A",294,0) +Fix1Class(IEN) +"RTN","TMGNDF3A",295,0) + ;"Purpose: To fix the parent entry of one erroneous class, in the VA DRUG CLASS heirarchy. +"RTN","TMGNDF3A",296,0) + ;"Input: IEN -- the record number in VA DRUG CLASS to fix +"RTN","TMGNDF3A",297,0) + ;"Output: the database will be changed +"RTN","TMGNDF3A",298,0) + ;"Results: none. +"RTN","TMGNDF3A",299,0) + +"RTN","TMGNDF3A",300,0) + new Curnode,Code,CodeNum,ParentCode +"RTN","TMGNDF3A",301,0) + new ParentClass,NewParentClass +"RTN","TMGNDF3A",302,0) + +"RTN","TMGNDF3A",303,0) + set Curnode=$get(^PS(50.605,IEN,0)) +"RTN","TMGNDF3A",304,0) + set Code=$piece(Curnode,"^",1) +"RTN","TMGNDF3A",305,0) + set ParentClass=+$piece(Curnode,"^",3) +"RTN","TMGNDF3A",306,0) + +"RTN","TMGNDF3A",307,0) + set ParentCode=$extract(Code,1,2)_"000" +"RTN","TMGNDF3A",308,0) + set NewParentClass=+$order(^PS(50.605,"B",ParentCode,"")) +"RTN","TMGNDF3A",309,0) + +"RTN","TMGNDF3A",310,0) + if NewParentClass'=0 do +"RTN","TMGNDF3A",311,0) + . set $piece(^PS(50.605,IEN,0),"^",3)=NewParentClass +"RTN","TMGNDF3A",312,0) + +"RTN","TMGNDF3A",313,0) + quit +"RTN","TMGNDF3A",314,0) + +"RTN","TMGNDF3A",315,0) + +"RTN","TMGNDF3A",316,0) +GetInfo(IEN,Array) +"RTN","TMGNDF3A",317,0) + ;"Purpose: to fill record from VA DRUG CLASS file into a usable array +"RTN","TMGNDF3A",318,0) + ;"Input: IEN -- the IEN from VA DRUG CLASS file to get info for +"RTN","TMGNDF3A",319,0) + ;" Array -- PASS BY REFERENCE, to be filled in with data. Old data is KILLED. +"RTN","TMGNDF3A",320,0) + ;"Output: Array is filled with data: +"RTN","TMGNDF3A",321,0) + ;" Array("NAME")=name +"RTN","TMGNDF3A",322,0) + ;" Array("CODE")=code +"RTN","TMGNDF3A",323,0) + ;" Array("PARENT IEN")=parent IEN +"RTN","TMGNDF3A",324,0) + ;"Result: none +"RTN","TMGNDF3A",325,0) + +"RTN","TMGNDF3A",326,0) + new Curnode +"RTN","TMGNDF3A",327,0) + kill Array +"RTN","TMGNDF3A",328,0) + +"RTN","TMGNDF3A",329,0) + set Curnode=$get(^PS(50.605,IEN,0)) +"RTN","TMGNDF3A",330,0) + set Array("CODE")=$piece(Curnode,"^",1) +"RTN","TMGNDF3A",331,0) + set Array("NAME")=$piece(Curnode,"^",2) +"RTN","TMGNDF3A",332,0) + set Array("PARENT IEN")=+$piece(Curnode,"^",3) +"RTN","TMGNDF3A",333,0) + +"RTN","TMGNDF3A",334,0) + quit +"RTN","TMGNDF3A",335,0) + +"RTN","TMGNDF3A",336,0) + ;"---------------------- +"RTN","TMGNDF3A",337,0) +TestSelectClass +"RTN","TMGNDF3A",338,0) + +"RTN","TMGNDF3A",339,0) + new Array,IEN +"RTN","TMGNDF3A",340,0) + +"RTN","TMGNDF3A",341,0) + do GetClasses(.Array) +"RTN","TMGNDF3A",342,0) + do KillIntro(.Array) +"RTN","TMGNDF3A",343,0) + set IEN=$$SelectClass(.Array,1) +"RTN","TMGNDF3A",344,0) + +"RTN","TMGNDF3A",345,0) + write "IEN=",IEN,! +"RTN","TMGNDF3A",346,0) + +"RTN","TMGNDF3A",347,0) + quit +"RTN","TMGNDF3A",348,0) + +"RTN","TMGNDF3A",349,0) + +"RTN","TMGNDF3A",350,0) +SelectClass(Array,AskSub) +"RTN","TMGNDF3A",351,0) + ;"Purpose: Allow user to browse Array and select drug class +"RTN","TMGNDF3A",352,0) + ;"Input: Array -- An Array containing Drug Class info, as created by GetClasses() +"RTN","TMGNDF3A",353,0) + ;" AskSub -- OPTIONAL. If 1, user is asked if they want to browse sub-class (auto otherwise) +"RTN","TMGNDF3A",354,0) + ;"Results: Returns IEN of selected class, or 0 if not selected +"RTN","TMGNDF3A",355,0) + +"RTN","TMGNDF3A",356,0) + new IEN,done +"RTN","TMGNDF3A",357,0) + set done=0 +"RTN","TMGNDF3A",358,0) + set AskSub=$get(AskSub,0) ;"default=automatic browse of subclasses +"RTN","TMGNDF3A",359,0) + new pRef set pRef=$name(Array) +"RTN","TMGNDF3A",360,0) + +"RTN","TMGNDF3A",361,0) + for do quit:(done=1) +"RTN","TMGNDF3A",362,0) + . set IEN=$$SelectFrom(pRef) +"RTN","TMGNDF3A",363,0) + . if IEN=0 do quit +"RTN","TMGNDF3A",364,0) + . . if $qlength(pRef)>0 do +"RTN","TMGNDF3A",365,0) + . . . set pRef=$name(@pRef,$qlength(pRef)-1) +"RTN","TMGNDF3A",366,0) + . . else set done=1 +"RTN","TMGNDF3A",367,0) + . new skipSub set skipSub=0 +"RTN","TMGNDF3A",368,0) + . if (AskSub=1)&($data(Array(IEN))>1) do +"RTN","TMGNDF3A",369,0) + . . new % +"RTN","TMGNDF3A",370,0) + . . write "Browse sub-categories" +"RTN","TMGNDF3A",371,0) + . . set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",372,0) + . . if %'=1 set skipSub=1 +"RTN","TMGNDF3A",373,0) + . if ($data(Array(IEN))>1)&(skipSub=0) set pRef=$name(@pRef@(IEN)) +"RTN","TMGNDF3A",374,0) + . else do +"RTN","TMGNDF3A",375,0) + . . new info,% +"RTN","TMGNDF3A",376,0) + . . do GetInfo(IEN,.info) +"RTN","TMGNDF3A",377,0) + . . write "Select: ",info("NAME") +"RTN","TMGNDF3A",378,0) + . . set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",379,0) + . . if %=1 set done=1 +"RTN","TMGNDF3A",380,0) + +"RTN","TMGNDF3A",381,0) + quit IEN +"RTN","TMGNDF3A",382,0) + +"RTN","TMGNDF3A",383,0) + +"RTN","TMGNDF3A",384,0) +Search4Class() +"RTN","TMGNDF3A",385,0) + ;"Purpose: to use Fileman to search for a drug class +"RTN","TMGNDF3A",386,0) + ;"Results: Returns IEN of selected class, or 0 if not selected +"RTN","TMGNDF3A",387,0) + +"RTN","TMGNDF3A",388,0) + new DIC,X,Y +"RTN","TMGNDF3A",389,0) + set DIC=50.605 +"RTN","TMGNDF3A",390,0) + set DIC(0)="AEQM" +"RTN","TMGNDF3A",391,0) + set DIC("A")="Enter a DRUG CLASS to search for // " +"RTN","TMGNDF3A",392,0) + do ^DIC write ! +"RTN","TMGNDF3A",393,0) + new result set result=0 +"RTN","TMGNDF3A",394,0) + if +Y>0 set result=+Y +"RTN","TMGNDF3A",395,0) + quit result +"RTN","TMGNDF3A",396,0) + +"RTN","TMGNDF3A",397,0) + +"RTN","TMGNDF3A",398,0) +SelectFrom(pRef) +"RTN","TMGNDF3A",399,0) + ;"Purpose: Allow user to browse Array and select drug class +"RTN","TMGNDF3A",400,0) + ;"Input: pRef -- NAME OF part of array to browse, containing Drug Class info +"RTN","TMGNDF3A",401,0) + ;"Results: Returns IEN of selected class, or 0 if not selected +"RTN","TMGNDF3A",402,0) + +"RTN","TMGNDF3A",403,0) + new temp,Items,Answers +"RTN","TMGNDF3A",404,0) + new i,count +"RTN","TMGNDF3A",405,0) + new result set result=0 +"RTN","TMGNDF3A",406,0) + +"RTN","TMGNDF3A",407,0) + set i=$order(@pRef@("")) +"RTN","TMGNDF3A",408,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF3A",409,0) + . new name set name=$piece($get(@pRef@(i)),"^",2) +"RTN","TMGNDF3A",410,0) + . new class set class=$piece($get(@pRef@(i)),"^",1) +"RTN","TMGNDF3A",411,0) + . set temp(name)=i +"RTN","TMGNDF3A",412,0) + . set temp(name,class)="" +"RTN","TMGNDF3A",413,0) + . set i=$order(@pRef@(i)) +"RTN","TMGNDF3A",414,0) + +"RTN","TMGNDF3A",415,0) + set count=1 +"RTN","TMGNDF3A",416,0) + new name +"RTN","TMGNDF3A",417,0) + set name=$order(temp("")) +"RTN","TMGNDF3A",418,0) + if name'="" for do quit:(name="") +"RTN","TMGNDF3A",419,0) + . set Items(count)=name +"RTN","TMGNDF3A",420,0) + . set Items(count,"CLASS")=$order(temp(name,"")) +"RTN","TMGNDF3A",421,0) + . set Answers(count)=$get(temp(name)) +"RTN","TMGNDF3A",422,0) + . set count=count+1 +"RTN","TMGNDF3A",423,0) + . set name=$order(temp(name)) +"RTN","TMGNDF3A",424,0) + +"RTN","TMGNDF3A",425,0) + new done set done=0 +"RTN","TMGNDF3A",426,0) + for do quit:(done=1) +"RTN","TMGNDF3A",427,0) + . new name set name=$piece($get(@pRef),"^",2) +"RTN","TMGNDF3A",428,0) + . if name="" set name="Major Drug Classes" +"RTN","TMGNDF3A",429,0) + . write !,"Select from one of these ",name,! +"RTN","TMGNDF3A",430,0) + . set i=$order(Items(0)) +"RTN","TMGNDF3A",431,0) + . if +i>0 for do quit:(+i'>0) +"RTN","TMGNDF3A",432,0) + . . write i,". " +"RTN","TMGNDF3A",433,0) + . . new class set class=$get(Items(i,"CLASS")) +"RTN","TMGNDF3A",434,0) + . . if class'="" write class,": " +"RTN","TMGNDF3A",435,0) + . . write Items(i),! +"RTN","TMGNDF3A",436,0) + . . set i=$order(Items(i)) +"RTN","TMGNDF3A",437,0) + . write !,"Enter # of Drug Class to Pick (^ to Backup, S to Search): ^// " +"RTN","TMGNDF3A",438,0) + . new input +"RTN","TMGNDF3A",439,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF3A",440,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",441,0) + . if input="" set input="^" +"RTN","TMGNDF3A",442,0) + . if input="S" do quit:(done=1) +"RTN","TMGNDF3A",443,0) + . . new UsrIEN set UsrIEN=$$Search4Class +"RTN","TMGNDF3A",444,0) + . . if UsrIEN>0 set result=UsrIEN,done=1 +"RTN","TMGNDF3A",445,0) + . if input="?" do quit +"RTN","TMGNDF3A",446,0) + . . do LookupHelp() +"RTN","TMGNDF3A",447,0) + . . new temp read "-- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",448,0) + . if input="" set input="^" +"RTN","TMGNDF3A",449,0) + . if input="^" set done=1 quit +"RTN","TMGNDF3A",450,0) + . if +input=input do +"RTN","TMGNDF3A",451,0) + . . set result=Answers(input) +"RTN","TMGNDF3A",452,0) + . . set done=1 +"RTN","TMGNDF3A",453,0) + . else do +"RTN","TMGNDF3A",454,0) + . . new temp set temp=$$SrchItems(input,.Items) +"RTN","TMGNDF3A",455,0) + . . if +temp>0 set result=Answers(temp),done=1 +"RTN","TMGNDF3A",456,0) + . . else write "Invalid input. Please try again.",! +"RTN","TMGNDF3A",457,0) + +"RTN","TMGNDF3A",458,0) + quit result +"RTN","TMGNDF3A",459,0) + +"RTN","TMGNDF3A",460,0) + +"RTN","TMGNDF3A",461,0) +SrchItems(input,Items) +"RTN","TMGNDF3A",462,0) + ;"Purpose: to Search through Items array for input, and return index number if found +"RTN","TMGNDF3A",463,0) + ;"Input: input -- the user input -- may be a partial match for the name. +"RTN","TMGNDF3A",464,0) + ;" Items -- PASS BY REFERENCE -- Input array, as created in SelectFrom() +"RTN","TMGNDF3A",465,0) + ;" Items(1)=value +"RTN","TMGNDF3A",466,0) + ;" Items(2)=value +"RTN","TMGNDF3A",467,0) + ;" Items(3)=value +"RTN","TMGNDF3A",468,0) + ;" +"RTN","TMGNDF3A",469,0) + ;"Result: returns index of the FIRST match +"RTN","TMGNDF3A",470,0) + +"RTN","TMGNDF3A",471,0) + new result set result="" +"RTN","TMGNDF3A",472,0) + new done set done=0 +"RTN","TMGNDF3A",473,0) + new value +"RTN","TMGNDF3A",474,0) + set input=$$UP^XLFSTR($get(input)) +"RTN","TMGNDF3A",475,0) + new i set i=$order(Items("")) +"RTN","TMGNDF3A",476,0) + if i'="" for do quit:(i="")!(done=1) +"RTN","TMGNDF3A",477,0) + . set value=$get(Items(i)) +"RTN","TMGNDF3A",478,0) + . set value=$extract(value,1,$length(input)) +"RTN","TMGNDF3A",479,0) + . if input=value set result=i,done=1 +"RTN","TMGNDF3A",480,0) + . set i=$order(Items(i)) +"RTN","TMGNDF3A",481,0) + +"RTN","TMGNDF3A",482,0) + quit result +"RTN","TMGNDF3A",483,0) + +"RTN","TMGNDF3A",484,0) + +"RTN","TMGNDF3A",485,0) + ;"============================================= +"RTN","TMGNDF3A",486,0) +GatherClasses(Array) +"RTN","TMGNDF3A",487,0) + ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of +"RTN","TMGNDF3A",488,0) + ;" possible entries for VA DRUG CLASS +"RTN","TMGNDF3A",489,0) + ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF3A",490,0) + ;"Output: Array will be filled as follows: +"RTN","TMGNDF3A",491,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode +"RTN","TMGNDF3A",492,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode +"RTN","TMGNDF3A",493,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",494,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",495,0) + ;"Results: none +"RTN","TMGNDF3A",496,0) + ;"Note: if SKIP THIS RECORD field is set, then record will be skipped. +"RTN","TMGNDF3A",497,0) + ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped. +"RTN","TMGNDF3A",498,0) + +"RTN","TMGNDF3A",499,0) + write "Gathering information about entries with no current DRUG CLASS",! +"RTN","TMGNDF3A",500,0) + new Itr,IEN +"RTN","TMGNDF3A",501,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3A",502,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3A",503,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF3A",504,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3A",505,0) + . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) +"RTN","TMGNDF3A",506,0) + . if PriorClass>0 quit +"RTN","TMGNDF3A",507,0) + . new numRecs set numRecs=+$piece($get(^TMG(22706.9,IEN,3,0)),"^",4) ;"VA PRODUCT POSS MATCH +"RTN","TMGNDF3A",508,0) + . if numRecs=0 quit +"RTN","TMGNDF3A",509,0) + . do GetPossClass(IEN,.Array) +"RTN","TMGNDF3A",510,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3A",511,0) + +"RTN","TMGNDF3A",512,0) + quit +"RTN","TMGNDF3A",513,0) + +"RTN","TMGNDF3A",514,0) + +"RTN","TMGNDF3A",515,0) +GetPossClass(IEN,Array) +"RTN","TMGNDF3A",516,0) + ;"Purpose: To gather, from a list of possible drug matches, a list of possible VA DRUG CLASSESS +"RTN","TMGNDF3A",517,0) + ;"Input: IEN -- IEN from TMG FDA IMPORT COMPILED (22706.9) file, to check. +"RTN","TMGNDF3A",518,0) + ;" Array -- PASS BY REFERENCE. An OUT PARAMETER +"RTN","TMGNDF3A",519,0) + ;"Output: Array filled as follows: +"RTN","TMGNDF3A",520,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",521,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",522,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",523,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",524,0) + +"RTN","TMGNDF3A",525,0) + new subIEN +"RTN","TMGNDF3A",526,0) + new TMGTradename set TMGTradename=$piece($get(^TMG(22706.9,IEN,0)),"^",4) +"RTN","TMGNDF3A",527,0) + set subIEN=$order(^TMG(22706.9,IEN,3,0)) +"RTN","TMGNDF3A",528,0) + new Dose set Dose=$piece($get(^TMG(22706.9,IEN,0)),"^",2) +"RTN","TMGNDF3A",529,0) + new Units set Units=$piece($get(^TMG(22706.9,IEN,0)),"^",3) +"RTN","TMGNDF3A",530,0) + +"RTN","TMGNDF3A",531,0) + if +subIEN>0 for do quit:(+subIEN'>0) +"RTN","TMGNDF3A",532,0) + . new DrugIEN set DrugIEN=+$get(^TMG(22706.9,IEN,3,subIEN,0)) +"RTN","TMGNDF3A",533,0) + . set subIEN=$order(^TMG(22706.9,IEN,3,subIEN)) +"RTN","TMGNDF3A",534,0) + . if DrugIEN=0 set Array(IEN,"?")="" quit +"RTN","TMGNDF3A",535,0) + . new ClassIEN set ClassIEN=+$get(^PSNDF(50.68,DrugIEN,3)) +"RTN","TMGNDF3A",536,0) + . if ClassIEN=0 set Array(IEN,"??")="" quit +"RTN","TMGNDF3A",537,0) + . new Info +"RTN","TMGNDF3A",538,0) + . do GetInfo(ClassIEN,.Info) +"RTN","TMGNDF3A",539,0) + . set Array("POSS MATCH",$get(Info("NAME")),TMGTradename,IEN)=ClassIEN_"^"_$get(Info("CODE"))_"^"_Dose_" "_Units +"RTN","TMGNDF3A",540,0) + else do +"RTN","TMGNDF3A",541,0) + . set Array(IEN,"?")="" +"RTN","TMGNDF3A",542,0) + . set Array("?",IEN)="" +"RTN","TMGNDF3A",543,0) + +"RTN","TMGNDF3A",544,0) + quit +"RTN","TMGNDF3A",545,0) + +"RTN","TMGNDF3A",546,0) + +"RTN","TMGNDF3A",547,0) + +"RTN","TMGNDF3A",548,0) +VerifyClasses(Array) +"RTN","TMGNDF3A",549,0) + ;"Purpose: To allow user to accept or reject proposed drug class for new drugs. +"RTN","TMGNDF3A",550,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by GatherClasses +"RTN","TMGNDF3A",551,0) + ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS) +"RTN","TMGNDF3A",552,0) + ;"Results: none +"RTN","TMGNDF3A",553,0) + +"RTN","TMGNDF3A",554,0) + new done set done=0 +"RTN","TMGNDF3A",555,0) + new input set input="R" +"RTN","TMGNDF3A",556,0) + new Answers +"RTN","TMGNDF3A",557,0) + new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb +"RTN","TMGNDF3A",558,0) + new ShowBoth set ShowBoth=1 +"RTN","TMGNDF3A",559,0) + new ByIngred set ByIngred=0 +"RTN","TMGNDF3A",560,0) + new EntryList,EntryS,Fn,Cancelled +"RTN","TMGNDF3A",561,0) + set Cancelled=0 +"RTN","TMGNDF3A",562,0) + +"RTN","TMGNDF3A",563,0) + new Classes +"RTN","TMGNDF3A",564,0) + do GetClasses(.Classes) +"RTN","TMGNDF3A",565,0) + do KillIntro(.Classes) +"RTN","TMGNDF3A",566,0) + +"RTN","TMGNDF3A",567,0) + for do quit:(done=1) +"RTN","TMGNDF3A",568,0) + . if input="R" do +"RTN","TMGNDF3A",569,0) + . . write !! +"RTN","TMGNDF3A",570,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",571,0) + . . write "Specify which drugs are in the correct DRUG CLASS",! +"RTN","TMGNDF3A",572,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",573,0) + . . do ShowList(.Array,.Answers,CompactMode,ShowBoth,ByIngred) +"RTN","TMGNDF3A",574,0) + . . do SaveList(.Array) ;"1/31/07 I got tired of loosing work after crashes, so will save each time... +"RTN","TMGNDF3A",575,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",576,0) + . . write "Specify which drugs are in the correct DRUG CLASS",! +"RTN","TMGNDF3A",577,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",578,0) + . . write " R to refresh, L lookup, ? for instructions, U to undo, V saVe",! +"RTN","TMGNDF3A",579,0) + . . write " X remove from list, N iNfo, S similar, F find",! +"RTN","TMGNDF3A",580,0) + . . write " C turn compact display ",$select((CompactMode=1):"OFF",1:"ON"),", B turn show Both names ",$select((ShowBoth=1):"OFF",1:"ON"),! +"RTN","TMGNDF3A",581,0) + . . write " I turn sort by Ingredients ",$select((ByIngred=1):"OFF",1:"ON")," G Guess class",! +"RTN","TMGNDF3A",582,0) + . . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! +"RTN","TMGNDF3A",583,0) + . . write " # or #-# or #,#-#,# etc., ^ done, ",! +"RTN","TMGNDF3A",584,0) + . write "Enter number(s) to ACCEPT drug class (or codes listed above): ^//" +"RTN","TMGNDF3A",585,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF3A",586,0) + . if input="" set input="^" +"RTN","TMGNDF3A",587,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",588,0) + . if input="^" set done=1 quit +"RTN","TMGNDF3A",589,0) + . else if (input="?") do +"RTN","TMGNDF3A",590,0) + . . do ShowInstructions() +"RTN","TMGNDF3A",591,0) + . . set input="R" +"RTN","TMGNDF3A",592,0) + . else if input="N" do quit +"RTN","TMGNDF3A",593,0) + . . read "Enter number of drug to get info about: ^//",input,! +"RTN","TMGNDF3A",594,0) + . . do ShowInfo(.Array,.Answers,+input) +"RTN","TMGNDF3A",595,0) + . . set input="R" +"RTN","TMGNDF3A",596,0) + . else if input="C" do quit +"RTN","TMGNDF3A",597,0) + . . set CompactMode='CompactMode +"RTN","TMGNDF3A",598,0) + . . set input="R" +"RTN","TMGNDF3A",599,0) + . else if input="D" do quit;"---- delete set +"RTN","TMGNDF3A",600,0) + . . kill EntryList,EntryS +"RTN","TMGNDF3A",601,0) + . . set input="R" +"RTN","TMGNDF3A",602,0) + . else if input="U" do quit +"RTN","TMGNDF3A",603,0) + . . do Undo(.Array) +"RTN","TMGNDF3A",604,0) + . . set input="R" +"RTN","TMGNDF3A",605,0) + . else if input="V" do quit +"RTN","TMGNDF3A",606,0) + . . do SaveList(.Array) +"RTN","TMGNDF3A",607,0) + . . write "List Saved.",! +"RTN","TMGNDF3A",608,0) + . else if input="I" do quit +"RTN","TMGNDF3A",609,0) + . . set ByIngred='ByIngred +"RTN","TMGNDF3A",610,0) + . . set input="R" +"RTN","TMGNDF3A",611,0) + . else if input="B" do quit +"RTN","TMGNDF3A",612,0) + . . set ShowBoth='ShowBoth +"RTN","TMGNDF3A",613,0) + . . set input="R" +"RTN","TMGNDF3A",614,0) + . else if input="L" do quit;"<----- Lookup manually +"RTN","TMGNDF3A",615,0) + . . set Fn="do DoLookup(.Array,.Answers,.Classes,.EntryList,0,.Cancelled)" +"RTN","TMGNDF3A",616,0) + . . do XMenuOption("lookup manually",Fn,"LookupHelp",.EntryList,.EntryS) +"RTN","TMGNDF3A",617,0) + . else if input="G" do quit;" ---- guess drugs +"RTN","TMGNDF3A",618,0) + . . set Fn="do DoGuess(.Array,.Answers,.EntryList,.Cancelled,.Classes)" +"RTN","TMGNDF3A",619,0) + . . do XMenuOption("Guess Class",Fn,"LookupHelp",.EntryList,.EntryS) +"RTN","TMGNDF3A",620,0) + . else if input="S" do quit +"RTN","TMGNDF3A",621,0) + . . set Fn="do SimilarPick(.Array,.Answers,.EntryList,.Cancelled)" +"RTN","TMGNDF3A",622,0) + . . do XMenuOption("classify by SIMILARITY","do SimilarPick(.Array,.Answers,.EntryList)","LookupHelp",.EntryList,.EntryS) +"RTN","TMGNDF3A",623,0) + . else if input="X" do quit +"RTN","TMGNDF3A",624,0) + . . set Fn="do DoRemove(.Array,.Answers,.EntryList,0,0,.Cancelled)" +"RTN","TMGNDF3A",625,0) + . . do XMenuOption("REMOVE from list",Fn,"SimHelp",.EntryList,.EntryS) +"RTN","TMGNDF3A",626,0) + . else if input="F" do quit +"RTN","TMGNDF3A",627,0) + . . set Fn="do FindPick(.Array,.Answers,.EntryList,0,.Cancelled)" +"RTN","TMGNDF3A",628,0) + . . do XMenuOption("classify by FINDING a similar drug",Fn,"FindHelp",.EntryList,.EntryS) +"RTN","TMGNDF3A",629,0) + . else do ;"default is ACCEPT +"RTN","TMGNDF3A",630,0) + . . set Cancelled=0 +"RTN","TMGNDF3A",631,0) + . . set Fn="do DoSetClass(.Array,.Answers,.EntryList)" +"RTN","TMGNDF3A",632,0) + . . do XMenuOption("",Fn,"",.EntryList,.EntryS) +"RTN","TMGNDF3A",633,0) + quit +"RTN","TMGNDF3A",634,0) + +"RTN","TMGNDF3A",635,0) +XMenuOption(Prompt,FnStr,HlpFn,EntryList,EntryS) +"RTN","TMGNDF3A",636,0) + ;"Purpose: To carry out the various menu functions +"RTN","TMGNDF3A",637,0) + ;"Input: Prompt: the message to use to prompt user to enter numbers etc. +"RTN","TMGNDF3A",638,0) + ;" "Enter the Number(s) to" will be automatically provided +"RTN","TMGNDF3A",639,0) + ;" and ": (? help) ^// " will be added at end +"RTN","TMGNDF3A",640,0) + ;" FnStr: -- code to execute, e.g. "do DoLookup(.Array,.Answers,.Classes,.EntryList)" +"RTN","TMGNDF3A",641,0) + ;" HlpFn: e.g. FindHelp, SimHelp, LookupHelp, etc Don't add () to name +"RTN","TMGNDF3A",642,0) + ;" EntryList -- PASS BY REFERENCE +"RTN","TMGNDF3A",643,0) + ;" EntryS -- PASS BY REFERENCE. a string showing current set as a string +"RTN","TMGNDF3A",644,0) + ;"Note: makes use of global scope of 'input', and 'CompactMode', 'Cancelled' +"RTN","TMGNDF3A",645,0) + ;"Result: none. +"RTN","TMGNDF3A",646,0) + +"RTN","TMGNDF3A",647,0) + if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF3A",648,0) + . if Prompt'="" do +"RTN","TMGNDF3A",649,0) +XMO1 . . write "Enter the Number(s) to ",Prompt,": (? help) ^// " +"RTN","TMGNDF3A",650,0) + . . read input,! +"RTN","TMGNDF3A",651,0) + . . if input="?" do goto XMO1 +"RTN","TMGNDF3A",652,0) + . . . new Code set Code="do "_HlpFn_"()" +"RTN","TMGNDF3A",653,0) + . . . Xecute code +"RTN","TMGNDF3A",654,0) + . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF3A",655,0) + . if valid set EntryS=input +"RTN","TMGNDF3A",656,0) + Xecute FnStr +"RTN","TMGNDF3A",657,0) + if CompactMode=1 set input="R" +"RTN","TMGNDF3A",658,0) + if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF3A",659,0) + +"RTN","TMGNDF3A",660,0) + quit +"RTN","TMGNDF3A",661,0) + +"RTN","TMGNDF3A",662,0) +ShowInstructions() +"RTN","TMGNDF3A",663,0) + ;"Purpose: to explain the matching proces +"RTN","TMGNDF3A",664,0) + +"RTN","TMGNDF3A",665,0) + new temp +"RTN","TMGNDF3A",666,0) + write !,"Instruction:",!! +"RTN","TMGNDF3A",667,0) + write "Each drug that is to be added to the VistA database should have a drug CLASS.",! +"RTN","TMGNDF3A",668,0) + write "This class is used by VistA for drug interaction and drug allergy screening.",! +"RTN","TMGNDF3A",669,0) + write "As drugs are imported from the FDA database, the program attempts to determine",! +"RTN","TMGNDF3A",670,0) + write "the class automatically by comparing the drug to other drugs that have already",! +"RTN","TMGNDF3A",671,0) + write "been classified. This process is far from perfect and often produces incorrect",! +"RTN","TMGNDF3A",672,0) + write "matches. A knowledgable user (you) must review each of these potential ",! +"RTN","TMGNDF3A",673,0) + write "classifications and either accept them if accurate, or manually correct them.",!! +"RTN","TMGNDF3A",674,0) + write "If a match is correct, it may be accepted by simply entering the number of the entry.",! +"RTN","TMGNDF3A",675,0) + write "Multiple correct entries may be accepted at once by entering a range of numbers,",! +"RTN","TMGNDF3A",676,0) + write "e.g. 3-18. A list may also be entered, e.g. 3,7,9,15. A combination of these may",! +"RTN","TMGNDF3A",677,0) + write "also be entered, e.g. 1-20,32-45,50,75-100 etc.",! +"RTN","TMGNDF3A",678,0) + write ! +"RTN","TMGNDF3A",679,0) + write "The list of drugs to be reviewed can be quite long (i.e. tens of thousands of ",! +"RTN","TMGNDF3A",680,0) + write "drugs long), so a 'compact' mode is provided. When compact mode is ON, only",! +"RTN","TMGNDF3A",681,0) + write "the last classifaction grouping is shown. This mode may be turned on or off by",! +"RTN","TMGNDF3A",682,0) + write "entering 'C'",! +"RTN","TMGNDF3A",683,0) + write ! +"RTN","TMGNDF3A",684,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",685,0) + write # +"RTN","TMGNDF3A",686,0) + write !,"Instruction (continued):",!! +"RTN","TMGNDF3A",687,0) + write "Because many drug names may be unfamiliar, one may need to review the details of the",! +"RTN","TMGNDF3A",688,0) + write "drug entry before being able to classify it. This may be done by typing 'I'. This",! +"RTN","TMGNDF3A",689,0) + write "makes use of a standard Fileman record inquiry tool. Accept the default answers to",! +"RTN","TMGNDF3A",690,0) + write "the questions 'STANDARD CAPTIONED OUTPUT?' and 'Include COMPUTED fields?'. The",! +"RTN","TMGNDF3A",691,0) + write "entry in the file TMG FDA IMPORT COMPILED (a temporary file) will be displayed.",! +"RTN","TMGNDF3A",692,0) + write "After displaying the info, it will ask to select another entry to display.",! +"RTN","TMGNDF3A",693,0) + write "Just press enter exit and return to the matching process.",! +"RTN","TMGNDF3A",694,0) + write ! +"RTN","TMGNDF3A",695,0) + write "A faster way to review the ingredients of drug entries is to turn on the ingredient-",! +"RTN","TMGNDF3A",696,0) + write "display mode with 'G'. This will display the ingredient list after each drug in",! +"RTN","TMGNDF3A",697,0) + write "the display.",! +"RTN","TMGNDF3A",698,0) + write ! +"RTN","TMGNDF3A",699,0) + write "Once one is ready to correct a classification, a variety of tools are provided.",! +"RTN","TMGNDF3A",700,0) + write "Each tool will first ask for the drug entry or entries that are to be classified.",! +"RTN","TMGNDF3A",701,0) + write ! +"RTN","TMGNDF3A",702,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",703,0) + write # +"RTN","TMGNDF3A",704,0) + write !,"Instruction (continued):",!! +"RTN","TMGNDF3A",705,0) + write "The first classification tool is the 'F' (find) command." +"RTN","TMGNDF3A",706,0) + do FindHelp() +"RTN","TMGNDF3A",707,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",708,0) + write # +"RTN","TMGNDF3A",709,0) + write !,"Instruction (continued):",!! +"RTN","TMGNDF3A",710,0) + write "The next classification tool is the 'L' (lookup) command.",! +"RTN","TMGNDF3A",711,0) + do LookupHelp() +"RTN","TMGNDF3A",712,0) + +"RTN","TMGNDF3A",713,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",714,0) + write # +"RTN","TMGNDF3A",715,0) + write !,"Instruction (continued):",!! +"RTN","TMGNDF3A",716,0) + write "The next tool is the 'S' (similarity) command." +"RTN","TMGNDF3A",717,0) + do SimHelp() +"RTN","TMGNDF3A",718,0) + +"RTN","TMGNDF3A",719,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",720,0) + write # +"RTN","TMGNDF3A",721,0) + write !,"Instruction (continued):",!! +"RTN","TMGNDF3A",722,0) + write "And lastly entries may simply be removed from the list with the 'X' command.",! +"RTN","TMGNDF3A",723,0) + write "They may be removed perminantly from consideration for addition to the Vista",! +"RTN","TMGNDF3A",724,0) + write "database. This is appropriate for a drug that will never be used at your",! +"RTN","TMGNDF3A",725,0) + write "location. Or, the drug may be just removed from the current work list.",! +"RTN","TMGNDF3A",726,0) + write "This will leave the drugs unclassified and may cause DANGEROUS drug interactions",! +"RTN","TMGNDF3A",727,0) + write "or drug allergies to be UNDETECTED when this drug is prescribed for a patient",! +"RTN","TMGNDF3A",728,0) + write "later",! +"RTN","TMGNDF3A",729,0) + write ! +"RTN","TMGNDF3A",730,0) + read " --- Press ENTER to continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",731,0) + +"RTN","TMGNDF3A",732,0) + quit +"RTN","TMGNDF3A",733,0) + +"RTN","TMGNDF3A",734,0) + +"RTN","TMGNDF3A",735,0) +LookupHelp() +"RTN","TMGNDF3A",736,0) + ;"Purpose: Show help for the Lookup functionality +"RTN","TMGNDF3A",737,0) + +"RTN","TMGNDF3A",738,0) + write "A list of drug classifications is shown to pick from. The VA DRUG CLASS system",! +"RTN","TMGNDF3A",739,0) + write "arranges drug classes into a heirarchy. And initially only the highest level",! +"RTN","TMGNDF3A",740,0) + write "classes are shown. Enter the number of a class to select it. If that class has",! +"RTN","TMGNDF3A",741,0) + write "subclasses, then these will be shown. Select the subclass, and then verify it.",! +"RTN","TMGNDF3A",742,0) + write "To backup, press ENTER or ^.",! +"RTN","TMGNDF3A",743,0) + write ! +"RTN","TMGNDF3A",744,0) + quit +"RTN","TMGNDF3A",745,0) + +"RTN","TMGNDF3A",746,0) + +"RTN","TMGNDF3A",747,0) +FindHelp() +"RTN","TMGNDF3A",748,0) + ;"Purpose: to show help for the FIND functionality +"RTN","TMGNDF3A",749,0) + +"RTN","TMGNDF3A",750,0) + write ! +"RTN","TMGNDF3A",751,0) + write "This command allows one to find a drug already in the VistA database, and use",! +"RTN","TMGNDF3A",752,0) + write "it's classification for the new drug in question.",! +"RTN","TMGNDF3A",753,0) + write "For example, if one is asked to classify POTASSIUM GLUCONATE ELIXIR 20 MEQ,",! +"RTN","TMGNDF3A",754,0) + write "there is a high likelihood that a similar drug already exists, and the matching",! +"RTN","TMGNDF3A",755,0) + write "process failed to find it. So search for the drug as follows:",! +"RTN","TMGNDF3A",756,0) + write "Enter drug name with desired DRUG CLASS// potassium gluc <--partial name entered",! +"RTN","TMGNDF3A",757,0) + write " 1 POTASSIUM GLUCONATE 2.2MEQ TAB",! +"RTN","TMGNDF3A",758,0) + write " 2 POTASSIUM GLUCONATE 2.6MEQ TAB",! +"RTN","TMGNDF3A",759,0) + write " 3 POTASSIUM GLUCONATE 20MEQ/15ML (SF) ELIXIR",! +"RTN","TMGNDF3A",760,0) + write " 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR",! +"RTN","TMGNDF3A",761,0) + write " 5 POTASSIUM GLUCONATE 20MEQ/15ML LIQUID",! +"RTN","TMGNDF3A",762,0) + write " Press to see more, '^' to exit this list, OR",! +"RTN","TMGNDF3A",763,0) + write " CHOOSE 1-5: 4 POTASSIUM GLUCONATE 20MEQ/15ML ELIXIR <-- 4 entered",! +"RTN","TMGNDF3A",764,0) + write ! +"RTN","TMGNDF3A",765,0) + write " DRUG CLASS: POTASSIUM",! +"RTN","TMGNDF3A",766,0) + write " Use this for drug(s) below?:",! +"RTN","TMGNDF3A",767,0) + write " entry: POTASSIUM GLUCONATE ELIXIR",! +"RTN","TMGNDF3A",768,0) + write " --------------------------------------",! +"RTN","TMGNDF3A",769,0) + write " Use DRUG CLASS [POTASSIUM] for drug(s) above? Yes// (Yes)",!! +"RTN","TMGNDF3A",770,0) + quit +"RTN","TMGNDF3A",771,0) + +"RTN","TMGNDF3A",772,0) +SimHelp() +"RTN","TMGNDF3A",773,0) + ;"Purpose: To show help for the Find Similar functionality +"RTN","TMGNDF3A",774,0) + +"RTN","TMGNDF3A",775,0) + write ! +"RTN","TMGNDF3A",776,0) + write "This command allows one to set the drug class of the drug in question to be",! +"RTN","TMGNDF3A",777,0) + write "the same as another drug shown in the display. For example:",! +"RTN","TMGNDF3A",778,0) + write ! +"RTN","TMGNDF3A",779,0) + write "CLASS: CEPHALOSPORIN 3RD GENERATION",! +"RTN","TMGNDF3A",780,0) + write "6068. TAZICEF FOR INJECTION 1 GM/VIAL",! +"RTN","TMGNDF3A",781,0) + write ! +"RTN","TMGNDF3A",782,0) + write "CLASS: DENTIFRICES",! +"RTN","TMGNDF3A",783,0) + write "7113. ALBION D PASTE DESENSITIZING DENTAL PROPHYLACTIC PASTE 8 %",! +"RTN","TMGNDF3A",784,0) + write "7114. PLUS + WHITE DESENTIZING FLUORIDE TOOTHPASTE",! +"RTN","TMGNDF3A",785,0) + write "7115. TAZICEF FOR INJECTION 1 GM",! +"RTN","TMGNDF3A",786,0) + write ! +"RTN","TMGNDF3A",787,0) + write "Here it would be useful to specify that entry 7115 is SIMILAR to 6068.",! +"RTN","TMGNDF3A",788,0) + write "This would set the class of 7155 to be CEPHALOSPORIN 3RD GENERATION.",!! +"RTN","TMGNDF3A",789,0) + quit +"RTN","TMGNDF3A",790,0) + +"RTN","TMGNDF3A",791,0) + +"RTN","TMGNDF3A",792,0) +Undo(Array) +"RTN","TMGNDF3A",793,0) + ;"Purpose: To allow user to undo an action that was done in error +"RTN","TMGNDF3A",794,0) + ;"Input: Array -- PASS BY REFERENCE the array containing the data, AND UNDO info +"RTN","TMGNDF3A",795,0) + ;" Array("UNDO","COUNT")=number of undo steps avail +"RTN","TMGNDF3A",796,0) + ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step. +"RTN","TMGNDF3A",797,0) + +"RTN","TMGNDF3A",798,0) + ;"Note: Later, I may allow user to choose which items to undo, but for now, will +"RTN","TMGNDF3A",799,0) + ;" just undo the very LAST action +"RTN","TMGNDF3A",800,0) + +"RTN","TMGNDF3A",801,0) + new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) +"RTN","TMGNDF3A",802,0) + new i set i=$order(Array("UNDO",UndoCt,"")) +"RTN","TMGNDF3A",803,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",804,0) + . new code set code=$get(Array("UNDO",UndoCt,i)) +"RTN","TMGNDF3A",805,0) + . do +"RTN","TMGNDF3A",806,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF3A",807,0) + . . write code,!! +"RTN","TMGNDF3A",808,0) + . . xecute code +"RTN","TMGNDF3A",809,0) + . new oldI set oldI=i +"RTN","TMGNDF3A",810,0) + . set i=$order(Array("UNDO",UndoCt,i)) +"RTN","TMGNDF3A",811,0) + . kill Array("UNDO",UndoCt,oldI) +"RTN","TMGNDF3A",812,0) + . set Array("UNDO","COUNT")=UndoCt-1 +"RTN","TMGNDF3A",813,0) + +"RTN","TMGNDF3A",814,0) + quit +"RTN","TMGNDF3A",815,0) + +"RTN","TMGNDF3A",816,0) + +"RTN","TMGNDF3A",817,0) +ShowList(Array,Answers,CompactMode,ShowBoth,ByIngred) +"RTN","TMGNDF3A",818,0) + ;"Purpose: To display the list generated by GatherClasses, by class orginization +"RTN","TMGNDF3A",819,0) + ;"Input: Array -- the array containing the data +"RTN","TMGNDF3A",820,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",821,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",822,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional +"RTN","TMGNDF3A",823,0) + ;" Answers -- PASS BY REFERENCE. An array that will like display numbers with IENs +"RTN","TMGNDF3A",824,0) + ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",825,0) + ;" Answer(count)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",826,0) + ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be +"RTN","TMGNDF3A",827,0) + ;" expanded (a potientially long list). Others will just show heading. +"RTN","TMGNDF3A",828,0) + ;" ShowBoth -- OPTIONAL, if value=1, then VA GENERIC field & Tradename will be shown for each entry +"RTN","TMGNDF3A",829,0) + ;" ByIngred -- OPTIONAL, if value=1, then list is shown sorted by Generic Name +"RTN","TMGNDF3A",830,0) + ;"Output: List is shown, and the Answers array is established and passed back. +"RTN","TMGNDF3A",831,0) + ;" Sometimes array is modified such that ingredient node is added +"RTN","TMGNDF3A",832,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN,"INGRED")=Ingredients <--- optional +"RTN","TMGNDF3A",833,0) + ;"Results: none. +"RTN","TMGNDF3A",834,0) + +"RTN","TMGNDF3A",835,0) + new someShown set someShown=0 +"RTN","TMGNDF3A",836,0) + new count,ClassName,LastClass +"RTN","TMGNDF3A",837,0) + set count=1 +"RTN","TMGNDF3A",838,0) + kill Answers +"RTN","TMGNDF3A",839,0) + set CompactMode=$get(CompactMode,0) +"RTN","TMGNDF3A",840,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF3A",841,0) + set ByIngred=$get(ByIngred,0) +"RTN","TMGNDF3A",842,0) + +"RTN","TMGNDF3A",843,0) + if ByIngred=0 goto SL1 ;"Rather than try to merge the two processes, I just duplicated and modified +"RTN","TMGNDF3A",844,0) + +"RTN","TMGNDF3A",845,0) + ;"Display sorted by ingredients +"RTN","TMGNDF3A",846,0) + +"RTN","TMGNDF3A",847,0) + ;"First, resort array, by ingredients +"RTN","TMGNDF3A",848,0) + ;" IngredArray format: +"RTN","TMGNDF3A",849,0) + ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName +"RTN","TMGNDF3A",850,0) + ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName +"RTN","TMGNDF3A",851,0) + new IngredArray +"RTN","TMGNDF3A",852,0) + set LastClass=$order(Array("POSS MATCH",""),-1) +"RTN","TMGNDF3A",853,0) + set ClassName=$order(Array("POSS MATCH","")) +"RTN","TMGNDF3A",854,0) + if ClassName'="" for do quit:(ClassName="") +"RTN","TMGNDF3A",855,0) + . write !,"CLASS: ",ClassName,! +"RTN","TMGNDF3A",856,0) + . new TMGTradeName +"RTN","TMGNDF3A",857,0) + . new tempCount set tempCount=0 +"RTN","TMGNDF3A",858,0) + . set TMGTradeName=$order(Array("POSS MATCH",ClassName,"")) +"RTN","TMGNDF3A",859,0) + . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName="" +"RTN","TMGNDF3A",860,0) + . if TMGTradeName'="" for do quit:(TMGTradeName="") +"RTN","TMGNDF3A",861,0) + . . new IEN,ClassIEN +"RTN","TMGNDF3A",862,0) + . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,"")) +"RTN","TMGNDF3A",863,0) + . . if IEN>0 for do quit:(IEN'>0) +"RTN","TMGNDF3A",864,0) + . . . new Ingred,value,dose +"RTN","TMGNDF3A",865,0) + . . . set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) +"RTN","TMGNDF3A",866,0) + . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")) +"RTN","TMGNDF3A",867,0) + . . . if Ingred="" do +"RTN","TMGNDF3A",868,0) + . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08) +"RTN","TMGNDF3A",869,0) + . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred +"RTN","TMGNDF3A",870,0) + . . . if Ingred="" do +"RTN","TMGNDF3A",871,0) + . . . . write "Couldn't find an ingredient name for file 22706.9, IEN=",IEN,! +"RTN","TMGNDF3A",872,0) + . . . . set Ingred="?" +"RTN","TMGNDF3A",873,0) + . . . if Ingred'="" do +"RTN","TMGNDF3A",874,0) + . . . . set IngredArray(ClassName,Ingred,IEN)=value +"RTN","TMGNDF3A",875,0) + . . . . set $piece(IngredArray(ClassName,Ingred,IEN),"^",4)=TMGTradeName +"RTN","TMGNDF3A",876,0) + . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) +"RTN","TMGNDF3A",877,0) + . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName)) +"RTN","TMGNDF3A",878,0) + . set ClassName=$order(Array("POSS MATCH",ClassName)) +"RTN","TMGNDF3A",879,0) + +"RTN","TMGNDF3A",880,0) + +"RTN","TMGNDF3A",881,0) + ;"Now display IngredArray +"RTN","TMGNDF3A",882,0) + ;" IngredArray format: +"RTN","TMGNDF3A",883,0) + ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName +"RTN","TMGNDF3A",884,0) + ;" IngredArray(ClassName,Ingred,IEN)=ClassIEN^ClassCode^DrugDose^TradeName +"RTN","TMGNDF3A",885,0) + set LastClass=$order(IngredArray(""),-1) +"RTN","TMGNDF3A",886,0) + set ClassName=$order(IngredArray("")) +"RTN","TMGNDF3A",887,0) + if ClassName'="" for do quit:(ClassName="") +"RTN","TMGNDF3A",888,0) + . write !,"CLASS: ",ClassName,! +"RTN","TMGNDF3A",889,0) + . new IngredName +"RTN","TMGNDF3A",890,0) + . new tempCount set tempCount=0 +"RTN","TMGNDF3A",891,0) + . set IngredName=$order(IngredArray(ClassName,"")) +"RTN","TMGNDF3A",892,0) + . if (CompactMode=1)&(ClassName'=LastClass) set IngredName="" +"RTN","TMGNDF3A",893,0) + . if IngredName'="" for do quit:(IngredName="") +"RTN","TMGNDF3A",894,0) + . . new IEN,ClassIEN +"RTN","TMGNDF3A",895,0) + . . set IEN=$order(IngredArray(ClassName,IngredName,"")) +"RTN","TMGNDF3A",896,0) + . . if IEN>0 for do quit:(IEN'>0) +"RTN","TMGNDF3A",897,0) + . . . new value,dose,TMGTradeName +"RTN","TMGNDF3A",898,0) + . . . set value=$get(IngredArray(ClassName,IngredName,IEN)) +"RTN","TMGNDF3A",899,0) + . . . set ClassIEN=$piece(value,"^",1) +"RTN","TMGNDF3A",900,0) + . . . set dose=$piece(value,"^",3) +"RTN","TMGNDF3A",901,0) + . . . set TMGTradeName=$piece(value,"^",4) +"RTN","TMGNDF3A",902,0) + . . . write count,". ",IngredName," ",dose +"RTN","TMGNDF3A",903,0) + . . . if ShowBoth write " (#",IEN,")" +"RTN","TMGNDF3A",904,0) + . . . write ! +"RTN","TMGNDF3A",905,0) + . . . set tempCount=tempCount+1 +"RTN","TMGNDF3A",906,0) + . . . if (ShowBoth)&(TMGTradeName'="") write " (",TMGTradeName,")",! +"RTN","TMGNDF3A",907,0) + . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName +"RTN","TMGNDF3A",908,0) + . . . set count=count+1 +"RTN","TMGNDF3A",909,0) + . . . set someShown=1 +"RTN","TMGNDF3A",910,0) + . . . set IEN=$order(IngredArray(ClassName,IngredName,IEN)) +"RTN","TMGNDF3A",911,0) + . . set IngredName=$order(IngredArrayArray(ClassName,IngredName)) +"RTN","TMGNDF3A",912,0) + . if tempCount>20 do +"RTN","TMGNDF3A",913,0) + . . write "END CLASS: ",ClassName,! +"RTN","TMGNDF3A",914,0) + . . set tempCount=0 +"RTN","TMGNDF3A",915,0) + . set ClassName=$order(IngredArray(ClassName)) +"RTN","TMGNDF3A",916,0) + +"RTN","TMGNDF3A",917,0) + goto SL2 +"RTN","TMGNDF3A",918,0) + +"RTN","TMGNDF3A",919,0) +SL1 ;"Display sorted by tradename +"RTN","TMGNDF3A",920,0) + set LastClass=$order(Array("POSS MATCH",""),-1) +"RTN","TMGNDF3A",921,0) + set ClassName=$order(Array("POSS MATCH","")) +"RTN","TMGNDF3A",922,0) + if ClassName'="" for do quit:(ClassName="") +"RTN","TMGNDF3A",923,0) + . write !,"CLASS: ",ClassName,! +"RTN","TMGNDF3A",924,0) + . new TMGTradeName +"RTN","TMGNDF3A",925,0) + . new tempCount set tempCount=0 +"RTN","TMGNDF3A",926,0) + . set TMGTradeName=$order(Array("POSS MATCH",ClassName,"")) +"RTN","TMGNDF3A",927,0) + . if (CompactMode=1)&(ClassName'=LastClass) set TMGTradeName="" +"RTN","TMGNDF3A",928,0) + . if TMGTradeName'="" for do quit:(TMGTradeName="") +"RTN","TMGNDF3A",929,0) + . . new IEN,ClassIEN +"RTN","TMGNDF3A",930,0) + . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,"")) +"RTN","TMGNDF3A",931,0) + . . if IEN>0 for do quit:(IEN'>0) +"RTN","TMGNDF3A",932,0) + . . . new value set value=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) +"RTN","TMGNDF3A",933,0) + . . . set ClassIEN=$piece(value,"^",1) +"RTN","TMGNDF3A",934,0) + . . . new dose set dose=$piece(value,"^",3) +"RTN","TMGNDF3A",935,0) + . . . ;"write count,". (",IEN,") ",TMGTradeName," ",dose,! +"RTN","TMGNDF3A",936,0) + . . . write count,". ",TMGTradeName," ",dose +"RTN","TMGNDF3A",937,0) + . . . if ShowBoth write " (#",IEN,")" +"RTN","TMGNDF3A",938,0) + . . . write ! +"RTN","TMGNDF3A",939,0) + . . . set tempCount=tempCount+1 +"RTN","TMGNDF3A",940,0) + . . . if ShowBoth do +"RTN","TMGNDF3A",941,0) + . . . . new Ingred +"RTN","TMGNDF3A",942,0) + . . . . set Ingred=$get(Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")) +"RTN","TMGNDF3A",943,0) + . . . . if Ingred="" do +"RTN","TMGNDF3A",944,0) + . . . . . set Ingred=$$GET1^DIQ(22706.9,IEN,.08) +"RTN","TMGNDF3A",945,0) + . . . . . set Array("POSS MATCH",ClassName,TMGTradeName,IEN,"INGRED")=Ingred +"RTN","TMGNDF3A",946,0) + . . . . if Ingred'="" write " (Same class as: ",Ingred,")",! +"RTN","TMGNDF3A",947,0) + . . . set Answers(count)=IEN_"^"_TMGTradeName_"^"_ClassIEN_"^"_ClassName +"RTN","TMGNDF3A",948,0) + . . . set count=count+1 +"RTN","TMGNDF3A",949,0) + . . . set someShown=1 +"RTN","TMGNDF3A",950,0) + . . . set IEN=$order(Array("POSS MATCH",ClassName,TMGTradeName,IEN)) +"RTN","TMGNDF3A",951,0) + . . set TMGTradeName=$order(Array("POSS MATCH",ClassName,TMGTradeName)) +"RTN","TMGNDF3A",952,0) + . if tempCount>20 do +"RTN","TMGNDF3A",953,0) + . . write "END CLASS: ",ClassName,! +"RTN","TMGNDF3A",954,0) + . . set tempCount=0 +"RTN","TMGNDF3A",955,0) + . set ClassName=$order(Array("POSS MATCH",ClassName)) +"RTN","TMGNDF3A",956,0) + +"RTN","TMGNDF3A",957,0) +SL2 if 'someShown write " --- (List is Empty) ---",! +"RTN","TMGNDF3A",958,0) + +"RTN","TMGNDF3A",959,0) +SLDone quit +"RTN","TMGNDF3A",960,0) + +"RTN","TMGNDF3A",961,0) + +"RTN","TMGNDF3A",962,0) +DoSetClass(Array,Answers,List) +"RTN","TMGNDF3A",963,0) + ;"Purpose: To add ClassIEN to field .09 (VA DRUG CLASS) in file TMG FDA IMPORT COMPILED +"RTN","TMGNDF3A",964,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",965,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",966,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",967,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",968,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",969,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",970,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",971,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",972,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",973,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",974,0) + ;" Format as follows. +"RTN","TMGNDF3A",975,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",976,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",977,0) + ;"Results: none +"RTN","TMGNDF3A",978,0) + +"RTN","TMGNDF3A",979,0) + new DrugIEN,DrugName,ClassIEN,ClassName +"RTN","TMGNDF3A",980,0) + +"RTN","TMGNDF3A",981,0) + new i +"RTN","TMGNDF3A",982,0) + set i=$order(List("")) +"RTN","TMGNDF3A",983,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",984,0) + . set DrugIEN=+$piece($get(Answers(i)),"^",1) +"RTN","TMGNDF3A",985,0) + . set DrugName=$piece($get(Answers(i)),"^",2) +"RTN","TMGNDF3A",986,0) + . set ClassIEN=+$piece($get(Answers(i)),"^",3) +"RTN","TMGNDF3A",987,0) + . set ClassName=$piece($get(Answers(i)),"^",4) +"RTN","TMGNDF3A",988,0) + . if (DrugIEN'=0)&(ClassIEN'=0) do +"RTN","TMGNDF3A",989,0) + . . new UndoCt set UndoCt=+$get(Array("UNDO","COUNT"))+1 +"RTN","TMGNDF3A",990,0) + . . new OldValue set OldValue=$piece($get(^TMG(22706.9,DrugIEN,1)),"^",5) +"RTN","TMGNDF3A",991,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",992,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",993,0) + . . set Array("UNDO",UndoCt,1)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue +"RTN","TMGNDF3A",994,0) + . . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set. +"RTN","TMGNDF3A",995,0) + . . kill Answers(i) +"RTN","TMGNDF3A",996,0) + . . set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN)) +"RTN","TMGNDF3A",997,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",998,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",999,0) + . . set Array("UNDO",UndoCt,2)="set Array(""POSS MATCH"","""_ClassName_""","""_DrugName_""","_DrugIEN_")="_OldValue +"RTN","TMGNDF3A",1000,0) + . . set Array("UNDO","COUNT")=UndoCt +"RTN","TMGNDF3A",1001,0) + . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN) +"RTN","TMGNDF3A",1002,0) + . set i=$order(List(i)) +"RTN","TMGNDF3A",1003,0) + +"RTN","TMGNDF3A",1004,0) + quit +"RTN","TMGNDF3A",1005,0) + +"RTN","TMGNDF3A",1006,0) + +"RTN","TMGNDF3A",1007,0) +ShowInfo(Array,Answers,Num) +"RTN","TMGNDF3A",1008,0) + ;"Purpose: to show more about the specified drug +"RTN","TMGNDF3A",1009,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1010,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1011,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1012,0) + ;" Num -- entry number to show +"RTN","TMGNDF3A",1013,0) + +"RTN","TMGNDF3A",1014,0) + new DrugIEN set DrugIEN=+$piece($get(Answers(Num)),"^",1) +"RTN","TMGNDF3A",1015,0) + if DrugIEN=0 quit +"RTN","TMGNDF3A",1016,0) + do DumpRec^TMGDEBUG(22706.9,DrugIEN) +"RTN","TMGNDF3A",1017,0) + quit +"RTN","TMGNDF3A",1018,0) + +"RTN","TMGNDF3A",1019,0) + +"RTN","TMGNDF3A",1020,0) +DoRemove(Array,Answers,List,ByTradeName,FromECode,Cancelled) +"RTN","TMGNDF3A",1021,0) + ;"Purpose: To remove entries from Empty-class Array +"RTN","TMGNDF3A",1022,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1023,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1024,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1025,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1026,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1027,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1028,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",1029,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1030,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1031,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1032,0) + ;" Format as follows. +"RTN","TMGNDF3A",1033,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1034,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1035,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",1036,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1037,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1038,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF3A",1039,0) + ;"Results: none +"RTN","TMGNDF3A",1040,0) + +"RTN","TMGNDF3A",1041,0) + set ByTradeName=$get(ByTradeName,0) +"RTN","TMGNDF3A",1042,0) + set Cancelled=1 ;"default is cancellation +"RTN","TMGNDF3A",1043,0) + +"RTN","TMGNDF3A",1044,0) + write !,"Remove these drugs perminantly (i.e. don't add to VistA database)?",! +"RTN","TMGNDF3A",1045,0) + do Disp2List(.Answers,.List,.ByTradeName) +"RTN","TMGNDF3A",1046,0) + +"RTN","TMGNDF3A",1047,0) + write "Remove these drugs perminantly (i.e. don't add to VistA database)" +"RTN","TMGNDF3A",1048,0) + new % set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",1049,0) + new SetSkipFlag set SetSkipFlag=(%=1) +"RTN","TMGNDF3A",1050,0) + +"RTN","TMGNDF3A",1051,0) + if %=2 do +"RTN","TMGNDF3A",1052,0) + . write "Temporarily remove drugs from category listing" +"RTN","TMGNDF3A",1053,0) + . do YN^DICN write ! +"RTN","TMGNDF3A",1054,0) + if %=2 goto DERMDone +"RTN","TMGNDF3A",1055,0) + +"RTN","TMGNDF3A",1056,0) + new UndoArray +"RTN","TMGNDF3A",1057,0) + new DrugIEN,DrugName,TradeName +"RTN","TMGNDF3A",1058,0) + new i set i=$order(List("")) +"RTN","TMGNDF3A",1059,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1060,0) + . set DrugIEN=+$piece($get(Answers(i)),"^",1) +"RTN","TMGNDF3A",1061,0) + . new UndoCt set UndoCt=$order(UndoArray(i,""),-1)+1 +"RTN","TMGNDF3A",1062,0) + . if (DrugIEN>0)&(SetSkipFlag) do +"RTN","TMGNDF3A",1063,0) + . . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",4) +"RTN","TMGNDF3A",1064,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",1065,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",1066,0) + . . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",4)="_OldValue +"RTN","TMGNDF3A",1067,0) + . . set $piece(^TMG(22706.9,DrugIEN,1),"^",4)=1 ;"I own file, and there are no XREF, so OK to direct set. +"RTN","TMGNDF3A",1068,0) + . if (SetSkipFlag=0)&(FromECode=0) do +"RTN","TMGNDF3A",1069,0) + . . set UndoArray(i,UndoCt)="kill Array("_DrugIEN_",""?"")" +"RTN","TMGNDF3A",1070,0) + . . set UndoArray(i,UndoCt+1)="kill Array(""?"","_DrugIEN_")" +"RTN","TMGNDF3A",1071,0) + . . set Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1072,0) + . . set Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1073,0) + . set i=$order(List(i)) +"RTN","TMGNDF3A",1074,0) + +"RTN","TMGNDF3A",1075,0) + do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray) +"RTN","TMGNDF3A",1076,0) + +"RTN","TMGNDF3A",1077,0) + new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) +"RTN","TMGNDF3A",1078,0) + set i="" +"RTN","TMGNDF3A",1079,0) + for set i=$order(UndoArray(i)) quit:(i="") do +"RTN","TMGNDF3A",1080,0) + . merge Array("UNDO",UndoCt)=UndoArray(i) +"RTN","TMGNDF3A",1081,0) + . set UndoCt=UndoCt+1 +"RTN","TMGNDF3A",1082,0) + set Array("UNDO","COUNT")=UndoCt +"RTN","TMGNDF3A",1083,0) + +"RTN","TMGNDF3A",1084,0) + set Cancelled=0 ;"set success here +"RTN","TMGNDF3A",1085,0) + +"RTN","TMGNDF3A",1086,0) +DERMDone +"RTN","TMGNDF3A",1087,0) + quit +"RTN","TMGNDF3A",1088,0) + +"RTN","TMGNDF3A",1089,0) + +"RTN","TMGNDF3A",1090,0) +DoLookup(Array,Answers,Classes,List,FromECode,Cancelled) +"RTN","TMGNDF3A",1091,0) + ;"Purpose: To Manually lookup class for entries +"RTN","TMGNDF3A",1092,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1093,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1094,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1095,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1096,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1097,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1098,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1099,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1100,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1101,0) + ;" Classes -- PASS BY REFERENCE, an array containing classes +"RTN","TMGNDF3A",1102,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1103,0) + ;" Format as follows. +"RTN","TMGNDF3A",1104,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1105,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1106,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1107,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1108,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF3A",1109,0) + ;"Results: none +"RTN","TMGNDF3A",1110,0) + +"RTN","TMGNDF3A",1111,0) + set Cancelled=1 ;"default to cancellation +"RTN","TMGNDF3A",1112,0) + +"RTN","TMGNDF3A",1113,0) + new UsrClassIEN +"RTN","TMGNDF3A",1114,0) + set UsrClassIEN=$$SelectClass(.Classes) +"RTN","TMGNDF3A",1115,0) + if UsrClassIEN=0 goto DLUDone +"RTN","TMGNDF3A",1116,0) + +"RTN","TMGNDF3A",1117,0) + new ClassName set ClassName=$$GET1^DIQ(50.605,UsrClassIEN,1) +"RTN","TMGNDF3A",1118,0) + +"RTN","TMGNDF3A",1119,0) + if $$VerifyWrite(ClassName,.Answers,.List)=0 goto DLUDone +"RTN","TMGNDF3A",1120,0) + +"RTN","TMGNDF3A",1121,0) + do WriteClass(UsrClassIEN,.Array,.Answers,.List,.FromECode) +"RTN","TMGNDF3A",1122,0) + set Cancelled=0 ;"set success here +"RTN","TMGNDF3A",1123,0) + +"RTN","TMGNDF3A",1124,0) +DLUDone +"RTN","TMGNDF3A",1125,0) + quit +"RTN","TMGNDF3A",1126,0) + +"RTN","TMGNDF3A",1127,0) + +"RTN","TMGNDF3A",1128,0) +WriteClass(ClassIEN,Array,Answers,List,FromECode) +"RTN","TMGNDF3A",1129,0) + ;"Purpose: To do the actual setting of the class +"RTN","TMGNDF3A",1130,0) + ;"Input: ClassIEN -- the IEN of the class to set. +"RTN","TMGNDF3A",1131,0) + ;" Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1132,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1133,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1134,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1135,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1136,0) + ;" Note: Only needed to clear out entries that are no longer needed. +"RTN","TMGNDF3A",1137,0) + ;" OR, if FromECode=1, then this Array format is used: +"RTN","TMGNDF3A",1138,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1139,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1140,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1141,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1142,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1143,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1144,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1145,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1146,0) + ;" OR, if FromECode=1, then this format is used: +"RTN","TMGNDF3A",1147,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1148,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1149,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1150,0) + ;" Format as follows. +"RTN","TMGNDF3A",1151,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1152,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1153,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1154,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1155,0) + ;"Output: Data will be altered in file 22706.9 +"RTN","TMGNDF3A",1156,0) + ;" Array will be modified: Undo information will be added: +"RTN","TMGNDF3A",1157,0) + ;" Array("UNDO","COUNT")=number of undo steps avail +"RTN","TMGNDF3A",1158,0) + ;" Array("UNDO",Event#,part#)=code to be eXecuted to reverse step. +"RTN","TMGNDF3A",1159,0) + ;"Results: none +"RTN","TMGNDF3A",1160,0) + +"RTN","TMGNDF3A",1161,0) + new DrugIEN,DrugName,ClassName +"RTN","TMGNDF3A",1162,0) + new UndoArray set UndoArray("")="" +"RTN","TMGNDF3A",1163,0) + new i set i=$order(List("")) +"RTN","TMGNDF3A",1164,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1165,0) + . set DrugIEN=+$piece($get(Answers(i)),"^",1) +"RTN","TMGNDF3A",1166,0) + . if DrugIEN=0 goto WC1 +"RTN","TMGNDF3A",1167,0) + . new UndoCt set UndoCt=$order(UndoArray(i,""))+1 +"RTN","TMGNDF3A",1168,0) + . new OldValue set OldValue=$piece(^TMG(22706.9,DrugIEN,1),"^",5) +"RTN","TMGNDF3A",1169,0) + . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",1170,0) + . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",1171,0) + . set UndoArray(i,UndoCt)="set $piece(^TMG(22706.9,"_DrugIEN_",1),""^"",5)="_OldValue +"RTN","TMGNDF3A",1172,0) + . set $piece(^TMG(22706.9,DrugIEN,1),"^",5)=ClassIEN ;"I own file, and there are no XREF, so OK to direct set. +"RTN","TMGNDF3A",1173,0) +WC1 . set i=$order(List(i)) +"RTN","TMGNDF3A",1174,0) + +"RTN","TMGNDF3A",1175,0) + do ClrAnswers(.Array,.Answers,.List,.FromECode,.UndoArray) +"RTN","TMGNDF3A",1176,0) + +"RTN","TMGNDF3A",1177,0) + set i=$order(UndoArray("")) +"RTN","TMGNDF3A",1178,0) + new UndoCt set UndoCt=$get(Array("UNDO","COUNT")) +"RTN","TMGNDF3A",1179,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1180,0) + . merge Array("UNDO",UndoCt)=UndoArray(i) +"RTN","TMGNDF3A",1181,0) + . set UndoCt=UndoCt+1 +"RTN","TMGNDF3A",1182,0) + . set i=$order(UndoArray(i)) +"RTN","TMGNDF3A",1183,0) + set Array("UNDO","COUNT")=UndoCt +"RTN","TMGNDF3A",1184,0) + +"RTN","TMGNDF3A",1185,0) +WCDone +"RTN","TMGNDF3A",1186,0) + quit +"RTN","TMGNDF3A",1187,0) + +"RTN","TMGNDF3A",1188,0) + +"RTN","TMGNDF3A",1189,0) +ClrAnswers(Array,Answers,List,FromECode,UndoArray) +"RTN","TMGNDF3A",1190,0) + ;"Purpose: To remove entries from Array and Answers array. +"RTN","TMGNDF3A",1191,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1192,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1193,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1194,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1195,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1196,0) + ;" Note: Only needed to clear out entries that are no longer needed. +"RTN","TMGNDF3A",1197,0) + ;" OR, if FromECode=1, then this Array format is used: +"RTN","TMGNDF3A",1198,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1199,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1200,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1201,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1202,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1203,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1204,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1205,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1206,0) + ;" OR, if FromECode=1, then this format is used: +"RTN","TMGNDF3A",1207,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1208,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1209,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1210,0) + ;" Format as follows. +"RTN","TMGNDF3A",1211,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1212,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1213,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1214,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1215,0) + ;" UndoArray -- PASS BY REFERENCE -- an array to be filled with undo info +"RTN","TMGNDF3A",1216,0) + ;" format as follows: +"RTN","TMGNDF3A",1217,0) + ;" Array(list#,step#)=CodeToBeExecuted +"RTN","TMGNDF3A",1218,0) + ;" Array(list#,step#)=CodeToBeExecuted +"RTN","TMGNDF3A",1219,0) + ;"Output: Entries will be removed from list. +"RTN","TMGNDF3A",1220,0) + +"RTN","TMGNDF3A",1221,0) + ;"Results: none +"RTN","TMGNDF3A",1222,0) + +"RTN","TMGNDF3A",1223,0) + new DrugIEN,DrugName,ClassName +"RTN","TMGNDF3A",1224,0) + new i +"RTN","TMGNDF3A",1225,0) + set i=$order(List("")) +"RTN","TMGNDF3A",1226,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1227,0) + . set DrugIEN=+$piece($get(Answers(i)),"^",1) +"RTN","TMGNDF3A",1228,0) + . if DrugIEN=0 goto CA1 +"RTN","TMGNDF3A",1229,0) + . new UndoCt set UndoCt=$order(UndoArray(i,""))+1 +"RTN","TMGNDF3A",1230,0) + . if $get(FromECode)=1 do +"RTN","TMGNDF3A",1231,0) + . . new GenericName,TradeName +"RTN","TMGNDF3A",1232,0) + . . set GenericName=$piece($get(Answers(i)),"^",2) +"RTN","TMGNDF3A",1233,0) + . . set TradeName=$piece($get(Answers(i)),"^",3) +"RTN","TMGNDF3A",1234,0) + . . ;"save info for possible undo in the future +"RTN","TMGNDF3A",1235,0) + . . new OldValue set OldValue=$get(Array("GENERIC NAME",GenericName,DrugIEN)) +"RTN","TMGNDF3A",1236,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",1237,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",1238,0) + . . set UndoArray(i,UndoCt)="set Array(""GENERIC NAME"","_GenericName_","_DrugIEN_")="_OldValue +"RTN","TMGNDF3A",1239,0) + . . set UndoCt=UndoCt+1 +"RTN","TMGNDF3A",1240,0) + . . new OldValue set OldValue=$get(Array("TRADE NAME",TradeName,DrugIEN)) +"RTN","TMGNDF3A",1241,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",1242,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",1243,0) + . . set UndoArray(i,UndoCt)="set Array(""TRADE NAME"","_TradeName_","_DrugIEN_")="_OldValue +"RTN","TMGNDF3A",1244,0) + . . ;"Now do real removal +"RTN","TMGNDF3A",1245,0) + . . kill Array("GENERIC NAME",GenericName,DrugIEN) +"RTN","TMGNDF3A",1246,0) + . . kill Array("TRADE NAME",TradeName,DrugIEN) +"RTN","TMGNDF3A",1247,0) + . else do +"RTN","TMGNDF3A",1248,0) + . . set DrugName=$piece($get(Answers(i)),"^",2) +"RTN","TMGNDF3A",1249,0) + . . set ClassName=$piece($get(Answers(i)),"^",4) +"RTN","TMGNDF3A",1250,0) + . . new OldValue set OldValue=$get(Array("POSS MATCH",ClassName,DrugName,DrugIEN)) +"RTN","TMGNDF3A",1251,0) + . . if OldValue="" set OldValue="""""" +"RTN","TMGNDF3A",1252,0) + . . if +OldValue'=OldValue set OldValue=""""_OldValue_"""" +"RTN","TMGNDF3A",1253,0) + . . set UndoArray(i,UndoCt)="set Array(""POSS MATCH"","_ClassName_","_DrugName_","_DrugIEN_")="_OldValue +"RTN","TMGNDF3A",1254,0) + . . kill Array("POSS MATCH",ClassName,DrugName,DrugIEN) +"RTN","TMGNDF3A",1255,0) + . kill Answers(i) ;"I'm not sure how to undo this part. I think it's regenerated with each display of list +"RTN","TMGNDF3A",1256,0) +CA1 . set i=$order(List(i)) +"RTN","TMGNDF3A",1257,0) + +"RTN","TMGNDF3A",1258,0) + quit +"RTN","TMGNDF3A",1259,0) + +"RTN","TMGNDF3A",1260,0) + +"RTN","TMGNDF3A",1261,0) +VerifyWrite(ClassName,Answers,List,ByTradeName,ShowBoth) +"RTN","TMGNDF3A",1262,0) + ;"Purpose: To display list of entries and ask user if class set is desired +"RTN","TMGNDF3A",1263,0) + ;"Input: ClassName -- the name of the VA DRUG CLASS +"RTN","TMGNDF3A",1264,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1265,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1266,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1267,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1268,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1269,0) + ;" Format as follows. +"RTN","TMGNDF3A",1270,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1271,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1272,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",1273,0) + ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. +"RTN","TMGNDF3A",1274,0) + ;"Result: 1 if writing is OK, other 0 +"RTN","TMGNDF3A",1275,0) + +"RTN","TMGNDF3A",1276,0) + write !,"DRUG CLASS: ",ClassName,! +"RTN","TMGNDF3A",1277,0) + write "Use this for drug(s) below?: ",! +"RTN","TMGNDF3A",1278,0) + do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) +"RTN","TMGNDF3A",1279,0) + write "Use DRUG CLASS [",ClassName,"] for drug(s) above" +"RTN","TMGNDF3A",1280,0) + new % set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",1281,0) + +"RTN","TMGNDF3A",1282,0) + quit (%=1) +"RTN","TMGNDF3A",1283,0) + +"RTN","TMGNDF3A",1284,0) + +"RTN","TMGNDF3A",1285,0) +Disp2List(Answers,List,ByTradeName,ShowBoth) +"RTN","TMGNDF3A",1286,0) + ;"Purpose: An interfact to DisplayList function, to allow easier input. +"RTN","TMGNDF3A",1287,0) + ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. See DisplayList +"RTN","TMGNDF3A",1288,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. See DisplayList +"RTN","TMGNDF3A",1289,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",1290,0) + ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. +"RTN","TMGNDF3A",1291,0) + +"RTN","TMGNDF3A",1292,0) + set ByTradeName=$get(ByTradeName,0) +"RTN","TMGNDF3A",1293,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF3A",1294,0) + new part,alsoPart +"RTN","TMGNDF3A",1295,0) + set alsoPart=0 +"RTN","TMGNDF3A",1296,0) + +"RTN","TMGNDF3A",1297,0) + if ByTradeName=1 do +"RTN","TMGNDF3A",1298,0) + . set part=3 ;"i.e. show TradeName +"RTN","TMGNDF3A",1299,0) + . if ShowBoth set alsoPart=2 +"RTN","TMGNDF3A",1300,0) + else do +"RTN","TMGNDF3A",1301,0) + . set part=2 ;"i.e. show GenericName +"RTN","TMGNDF3A",1302,0) + . if ShowBoth set alsoPart=3 +"RTN","TMGNDF3A",1303,0) + +"RTN","TMGNDF3A",1304,0) + do DisplayList(.Answers,.List,part,alsoPart) +"RTN","TMGNDF3A",1305,0) + +"RTN","TMGNDF3A",1306,0) + quit +"RTN","TMGNDF3A",1307,0) + +"RTN","TMGNDF3A",1308,0) +DisplayList(Answers,List,Piece,AlsoPiece) +"RTN","TMGNDF3A",1309,0) + ;"Purpose: To display list of entries +"RTN","TMGNDF3A",1310,0) + ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1311,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1312,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1313,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1314,0) + ;" OR, Array as created by ShowEList +"RTN","TMGNDF3A",1315,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1316,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1317,0) + +"RTN","TMGNDF3A",1318,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1319,0) + ;" Format as follows. +"RTN","TMGNDF3A",1320,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1321,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1322,0) + ;" Piece -- OPTIONAL, default=2. The piece number of Answer value to show. +"RTN","TMGNDF3A",1323,0) + ;" AlsoPiece -- OPTIONAL, default="", If specified, then this piece of the Answer +"RTN","TMGNDF3A",1324,0) + ;" will also be shown in paretheses under the original answer. +"RTN","TMGNDF3A",1325,0) + ;"Result: none +"RTN","TMGNDF3A",1326,0) + +"RTN","TMGNDF3A",1327,0) + new someShown set someShown=0 +"RTN","TMGNDF3A",1328,0) + set Piece=$get(Piece,2) +"RTN","TMGNDF3A",1329,0) + new i +"RTN","TMGNDF3A",1330,0) + set i=$order(List("")) +"RTN","TMGNDF3A",1331,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1332,0) + . write " ",i,". ",$piece($get(Answers(i)),"^",Piece),! +"RTN","TMGNDF3A",1333,0) + . set someShown=1 +"RTN","TMGNDF3A",1334,0) + . if +$get(AlsoPiece)>0 do +"RTN","TMGNDF3A",1335,0) + . . write " (",$piece($get(Answers(i)),"^",AlsoPiece),")",! +"RTN","TMGNDF3A",1336,0) + . set i=$order(List(i)) +"RTN","TMGNDF3A",1337,0) + +"RTN","TMGNDF3A",1338,0) + if someShown=0 write " -- List is EMPTY -- ",! +"RTN","TMGNDF3A",1339,0) + write "--------------------------------------",! +"RTN","TMGNDF3A",1340,0) + quit +"RTN","TMGNDF3A",1341,0) + +"RTN","TMGNDF3A",1342,0) + +"RTN","TMGNDF3A",1343,0) +SimilarPick(Array,Answers,List,FromECode,Cancelled) +"RTN","TMGNDF3A",1344,0) + ;"Purpose: To allow user to specify that a set of numbers should use the same class as +"RTN","TMGNDF3A",1345,0) + ;" another entry. +"RTN","TMGNDF3A",1346,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1347,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1348,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1349,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1350,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1351,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1352,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1353,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1354,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1355,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1356,0) + ;" Format as follows. +"RTN","TMGNDF3A",1357,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1358,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1359,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1360,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1361,0) + ;"Results: none +"RTN","TMGNDF3A",1362,0) + +"RTN","TMGNDF3A",1363,0) + set Cancelled=1 ;"default to cancellation +"RTN","TMGNDF3A",1364,0) + +"RTN","TMGNDF3A",1365,0) + new input +"RTN","TMGNDF3A",1366,0) + read "Which entry has the CORRECT CLASS? ",input:$get(DTIME,3600),! +"RTN","TMGNDF3A",1367,0) + if +input'=input goto SPDone +"RTN","TMGNDF3A",1368,0) + +"RTN","TMGNDF3A",1369,0) + new SimClName set SimClName=$piece($get(Answers(input)),"^",4) +"RTN","TMGNDF3A",1370,0) + new SimClIEN set SimClIEN=+$piece($get(Answers(input)),"^",3) +"RTN","TMGNDF3A",1371,0) + +"RTN","TMGNDF3A",1372,0) + if $$VerifyWrite(SimClName,.Answers,.List)=1 goto SPDone +"RTN","TMGNDF3A",1373,0) + do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode) +"RTN","TMGNDF3A",1374,0) + set Cancelled=0 ;"signal success +"RTN","TMGNDF3A",1375,0) + +"RTN","TMGNDF3A",1376,0) +SPDone +"RTN","TMGNDF3A",1377,0) + quit +"RTN","TMGNDF3A",1378,0) + +"RTN","TMGNDF3A",1379,0) + +"RTN","TMGNDF3A",1380,0) + +"RTN","TMGNDF3A",1381,0) +FindPick(Array,Answers,List,FromECode,Cancelled) +"RTN","TMGNDF3A",1382,0) + ;"Purpose: To allow user to look up a drug already in the VistA database, and use the +"RTN","TMGNDF3A",1383,0) + ;" VA DRUG CLASS assigned to that drug. +"RTN","TMGNDF3A",1384,0) + ;" another entry. +"RTN","TMGNDF3A",1385,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1386,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1387,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode^DrugDose +"RTN","TMGNDF3A",1388,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1389,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1390,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1391,0) + ;" Array should be the one created by ShowList +"RTN","TMGNDF3A",1392,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1393,0) + ;" Answer(num)=DrugIEN^DrugName^ClassIEN^ClassName +"RTN","TMGNDF3A",1394,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1395,0) + ;" Format as follows. +"RTN","TMGNDF3A",1396,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1397,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1398,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1399,0) + ;" code modules (ie HandleEmptyClasses) +"RTN","TMGNDF3A",1400,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF3A",1401,0) + ;"Results: none +"RTN","TMGNDF3A",1402,0) + +"RTN","TMGNDF3A",1403,0) + set Cancelled=1 ;"default is cancellation +"RTN","TMGNDF3A",1404,0) + write "Classify drug by finding ANOTHER drug in the SAME CLASS",! +"RTN","TMGNDF3A",1405,0) +FPLoop +"RTN","TMGNDF3A",1406,0) + new DIC,X,Y +"RTN","TMGNDF3A",1407,0) + set DIC=50.68 +"RTN","TMGNDF3A",1408,0) + set DIC(0)="AEQM" +"RTN","TMGNDF3A",1409,0) + set DIC("A")="Enter DRUG NAME OF EXAMPLE with desired CLASS// " +"RTN","TMGNDF3A",1410,0) + do ^DIC write ! +"RTN","TMGNDF3A",1411,0) + if +Y'>0 do goto FPDone +"RTN","TMGNDF3A",1412,0) + . write "No usable value found.",! +"RTN","TMGNDF3A",1413,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF3A",1414,0) + +"RTN","TMGNDF3A",1415,0) + new SimClName,SimClIEN +"RTN","TMGNDF3A",1416,0) + set SimClIEN=$$GET1^DIQ(50.68,+Y,15,"I") ;"50.68=VA PRODUCT file +"RTN","TMGNDF3A",1417,0) + if SimClIEN'>0 do goto FPDone +"RTN","TMGNDF3A",1418,0) + . write "No usable value found.",! +"RTN","TMGNDF3A",1419,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF3A",1420,0) + set SimClName=$$GET1^DIQ(50.605,SimClIEN,1) ;"50.605 is VA DRUG CLASS +"RTN","TMGNDF3A",1421,0) + +"RTN","TMGNDF3A",1422,0) + new IsOK set IsOK=$$VerifyWrite(SimClName,.Answers,.List) +"RTN","TMGNDF3A",1423,0) + new TryAgain set TryAgain=0 +"RTN","TMGNDF3A",1424,0) + if IsOK=1 do +"RTN","TMGNDF3A",1425,0) + . do WriteClass(SimClIEN,.Array,.Answers,.List,.FromECode) +"RTN","TMGNDF3A",1426,0) + . set Cancelled=0 ;"set success here +"RTN","TMGNDF3A",1427,0) + else do +"RTN","TMGNDF3A",1428,0) + . write "Pick another DRUG CLASS" +"RTN","TMGNDF3A",1429,0) + . new % set %=1 do YN^DICN write ! +"RTN","TMGNDF3A",1430,0) + . set TryAgain=(%=1) +"RTN","TMGNDF3A",1431,0) + if TryAgain=1 goto FPLoop +"RTN","TMGNDF3A",1432,0) + +"RTN","TMGNDF3A",1433,0) +FPDone +"RTN","TMGNDF3A",1434,0) + quit +"RTN","TMGNDF3A",1435,0) + +"RTN","TMGNDF3A",1436,0) + ;"======================================================================= +"RTN","TMGNDF3A",1437,0) + ;"======================================================================= +"RTN","TMGNDF3A",1438,0) + +"RTN","TMGNDF3A",1439,0) +HandleEmptyClasses +"RTN","TMGNDF3A",1440,0) + ;"Purpose: To allow classification of all unclassified drugs (ones with not potential +"RTN","TMGNDF3A",1441,0) + ;" match found in VistA database as a starting point) +"RTN","TMGNDF3A",1442,0) + +"RTN","TMGNDF3A",1443,0) + new array +"RTN","TMGNDF3A",1444,0) + write "Gathering information...",! +"RTN","TMGNDF3A",1445,0) + do GatherEmpties(.array) +"RTN","TMGNDF3A",1446,0) + do ClassEClasses(.array) +"RTN","TMGNDF3A",1447,0) + +"RTN","TMGNDF3A",1448,0) + quit +"RTN","TMGNDF3A",1449,0) + +"RTN","TMGNDF3A",1450,0) + +"RTN","TMGNDF3A",1451,0) + +"RTN","TMGNDF3A",1452,0) +GatherEmpties(Array) +"RTN","TMGNDF3A",1453,0) + ;"Purpose: To scan through all records in TMG FDA IMPORT COMPILED, and create an array of +"RTN","TMGNDF3A",1454,0) + ;" possible entries for VA DRUG CLASS, from ones that have NO possible VA PRODUCT MATCH +"RTN","TMGNDF3A",1455,0) + ;"Input: Array -- PASS BY REFERENCE, and OUT PARAMETER +"RTN","TMGNDF3A",1456,0) + ;"Output: Array will be filled as follows: +"RTN","TMGNDF3A",1457,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1458,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1459,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1460,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1461,0) + ;"Results: none +"RTN","TMGNDF3A",1462,0) + ;"Note: if SKIP THIS RECORD field is set, then record will be skipped. +"RTN","TMGNDF3A",1463,0) + ;" Also, if there is already an antry for the VA DRUG CLASS field, then will be skipped. +"RTN","TMGNDF3A",1464,0) + +"RTN","TMGNDF3A",1465,0) + new Itr,IEN +"RTN","TMGNDF3A",1466,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3A",1467,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3A",1468,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGNDF3A",1469,0) + . new tempIEN set IEN=IEN +"RTN","TMGNDF3A",1470,0) + . new skipFlag set skipFlag=+$piece($get(^TMG(22706.9,IEN,1)),"^",4) +"RTN","TMGNDF3A",1471,0) + . new PriorClass set PriorClass=+$piece($get(^TMG(22706.9,IEN,1)),"^",5) +"RTN","TMGNDF3A",1472,0) + . ;"write IEN," --> ",PriorClass,! +"RTN","TMGNDF3A",1473,0) + . if skipFlag=1 quit +"RTN","TMGNDF3A",1474,0) + . if PriorClass>0 quit +"RTN","TMGNDF3A",1475,0) + . new TMGGeneric set TMGGeneric=$piece($get(^TMG(22706.9,IEN,0)),"^",6) ;"GENERIC NAME +"RTN","TMGNDF3A",1476,0) + . new TradeName set TradeName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"TRADENAME +"RTN","TMGNDF3A",1477,0) + . if TMGGeneric'="" set Array("GENERIC NAME",TMGGeneric,IEN)="" +"RTN","TMGNDF3A",1478,0) + . if TradeName'="" set Array("TRADE NAME",TradeName,IEN)="" +"RTN","TMGNDF3A",1479,0) + . if (TMGGeneric'="")&(TradeName'="") do +"RTN","TMGNDF3A",1480,0) + . . set Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1481,0) + . . set Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1482,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3A",1483,0) + +"RTN","TMGNDF3A",1484,0) + quit +"RTN","TMGNDF3A",1485,0) + +"RTN","TMGNDF3A",1486,0) +ShowEList(Array,Answers,CompactMode,ByTradeName,ShowBoth) +"RTN","TMGNDF3A",1487,0) + ;"Purpose: To display the list of 'Empty' classes generated by GatherEmpties +"RTN","TMGNDF3A",1488,0) + ;"Input: Array -- the array containing the data +"RTN","TMGNDF3A",1489,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1490,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1491,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1492,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1493,0) + ;" Answers -- PASS BY REFERENCE. An OUT PARAMATER. +"RTN","TMGNDF3A",1494,0) + ;" Array will receive display numbers with IENs +"RTN","TMGNDF3A",1495,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1496,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1497,0) + ;" CompactMode -- OPTIONAL, if value=1, then only the LAST drug class will be +"RTN","TMGNDF3A",1498,0) + ;" expanded (a potientially long list). Others will just show heading. +"RTN","TMGNDF3A",1499,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",1500,0) + ;" ShowBoth -- OPTIONAL, if value=1 then both Generic and TradeName shown. +"RTN","TMGNDF3A",1501,0) + ;"Output: List is shown, and the Answers array is established and passed back. +"RTN","TMGNDF3A",1502,0) + ;"Results: none. +"RTN","TMGNDF3A",1503,0) + +"RTN","TMGNDF3A",1504,0) + new someShown set someShown=0 +"RTN","TMGNDF3A",1505,0) + new count set count=1 +"RTN","TMGNDF3A",1506,0) + kill Answers +"RTN","TMGNDF3A",1507,0) + set CompactMode=$get(CompactMode,0) +"RTN","TMGNDF3A",1508,0) + set ByTradeName=$get(ByTradeName,0) +"RTN","TMGNDF3A",1509,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF3A",1510,0) + new IEN +"RTN","TMGNDF3A",1511,0) + new GenericName,TradeName,DrugName +"RTN","TMGNDF3A",1512,0) + new CountLimit set CountLimit=99999 +"RTN","TMGNDF3A",1513,0) + if CompactMode=1 do +"RTN","TMGNDF3A",1514,0) + . if ShowBoth=1 set CountLimit=8 +"RTN","TMGNDF3A",1515,0) + . else set CountLimit=10 +"RTN","TMGNDF3A",1516,0) + new Label set Label="GENERIC NAME" +"RTN","TMGNDF3A",1517,0) + if ByTradeName=1 set Label="TRADE NAME" +"RTN","TMGNDF3A",1518,0) + +"RTN","TMGNDF3A",1519,0) + set DrugName=$order(Array(Label,"")) +"RTN","TMGNDF3A",1520,0) + if DrugName'="" for do quit:(DrugName="")!(count>CountLimit) +"RTN","TMGNDF3A",1521,0) + . set IEN=$order(Array(Label,DrugName,"")) +"RTN","TMGNDF3A",1522,0) + . if IEN'="" for do quit:(IEN="")!(count>CountLimit) +"RTN","TMGNDF3A",1523,0) + . . write count,". ",DrugName,! +"RTN","TMGNDF3A",1524,0) + . . new OtherName +"RTN","TMGNDF3A",1525,0) + . . if ByTradeName=0 do +"RTN","TMGNDF3A",1526,0) + . . . set GenericName=DrugName +"RTN","TMGNDF3A",1527,0) + . . . set TradeName=$get(Array("LINK GENERIC TO TRADE",GenericName)) +"RTN","TMGNDF3A",1528,0) + . . . set OtherName=TradeName +"RTN","TMGNDF3A",1529,0) + . . else do +"RTN","TMGNDF3A",1530,0) + . . . set TradeName=DrugName +"RTN","TMGNDF3A",1531,0) + . . . set GenericName=$get(Array("LINK TRADE TO GENERIC",TradeName)) +"RTN","TMGNDF3A",1532,0) + . . . set OtherName=GenericName +"RTN","TMGNDF3A",1533,0) + . . if ShowBoth=1 write " (",OtherName,")",! +"RTN","TMGNDF3A",1534,0) + . . set Answers(count)=IEN_"^"_GenericName_"^"_TradeName +"RTN","TMGNDF3A",1535,0) + . . set count=count+1 +"RTN","TMGNDF3A",1536,0) + . . set IEN=$order(Array(Label,DrugName,IEN)) +"RTN","TMGNDF3A",1537,0) + . set DrugName=$order(Array(Label,DrugName)) +"RTN","TMGNDF3A",1538,0) + . set someShown=1 +"RTN","TMGNDF3A",1539,0) + +"RTN","TMGNDF3A",1540,0) + if 'someShown write " --- (List is Empty) ---",! +"RTN","TMGNDF3A",1541,0) + quit +"RTN","TMGNDF3A",1542,0) + +"RTN","TMGNDF3A",1543,0) + +"RTN","TMGNDF3A",1544,0) + +"RTN","TMGNDF3A",1545,0) +ClassEClasses(Array) +"RTN","TMGNDF3A",1546,0) + ;"Purpose: To allow user to classify drugs with empty (none) VA Drug Class +"RTN","TMGNDF3A",1547,0) + ;"Input: Array -- PASS BY REFERENCE the array generated by GatherEmpties +"RTN","TMGNDF3A",1548,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1549,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1550,0) + ;"Output: Database is changed, by adding data to field .09 (VA DRUG CLASS) +"RTN","TMGNDF3A",1551,0) + ;"Results: none +"RTN","TMGNDF3A",1552,0) + +"RTN","TMGNDF3A",1553,0) + new done set done=0 +"RTN","TMGNDF3A",1554,0) + new input set input="R" +"RTN","TMGNDF3A",1555,0) + new Answers +"RTN","TMGNDF3A",1556,0) + new CompactMode set CompactMode=1 ;" (list display mode: 1=compact, 0=verb +"RTN","TMGNDF3A",1557,0) + new ShowBoth set ShowBoth=0 +"RTN","TMGNDF3A",1558,0) + new ByTrade set ByTrade=1 +"RTN","TMGNDF3A",1559,0) + new EntryList,EntryS +"RTN","TMGNDF3A",1560,0) + +"RTN","TMGNDF3A",1561,0) + new Classes +"RTN","TMGNDF3A",1562,0) + do GetClasses(.Classes) +"RTN","TMGNDF3A",1563,0) + do KillIntro(.Classes) +"RTN","TMGNDF3A",1564,0) + +"RTN","TMGNDF3A",1565,0) + for do quit:(done=1) +"RTN","TMGNDF3A",1566,0) + . if input="R" do +"RTN","TMGNDF3A",1567,0) + . . write !! +"RTN","TMGNDF3A",1568,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",1569,0) + . . write "Pick drug(s) to specify a DRUG CLASS",! +"RTN","TMGNDF3A",1570,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",1571,0) + . . do ShowEList(.Array,.Answers,CompactMode,ByTrade,ShowBoth) +"RTN","TMGNDF3A",1572,0) + . . write "--------------------------------------------------",! +"RTN","TMGNDF3A",1573,0) + . . write "Pick drug(s) to specify a DRUG CLASS",! +"RTN","TMGNDF3A",1574,0) + . write "--------------------------------------------------",! +"RTN","TMGNDF3A",1575,0) + . write " R=refresh, ?=instructions, X=remove from list, I=info, F=find",! +"RTN","TMGNDF3A",1576,0) + . write " G=Guess, L Lookup",! +"RTN","TMGNDF3A",1577,0) + . write " C=set Compact ",$select((CompactMode=1):"OFF",1:"ON"),", " +"RTN","TMGNDF3A",1578,0) + . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON") +"RTN","TMGNDF3A",1579,0) + . write ", ",! +"RTN","TMGNDF3A",1580,0) + . write " # or #-# or #,#-#,# etc., S=SET tools, ^ done, ",! +"RTN","TMGNDF3A",1581,0) + . if $get(EntryS)'="" write " Current SET #'s: ",EntryS,", D to delete SET",! +"RTN","TMGNDF3A",1582,0) + . write "Enter number(s) to LOOKUP drug class (or codes listed above): R//" +"RTN","TMGNDF3A",1583,0) + . read input:$get(DTIME,3600),! +"RTN","TMGNDF3A",1584,0) + . if input="" set input="R" +"RTN","TMGNDF3A",1585,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",1586,0) + . if input="^" set done=1 quit +"RTN","TMGNDF3A",1587,0) + . else if (input="?") do ;"---- instructions +"RTN","TMGNDF3A",1588,0) + . . ;"do ShowInstructions() +"RTN","TMGNDF3A",1589,0) + . . set input="R" +"RTN","TMGNDF3A",1590,0) + . else if input="I" do ;" ---- drug info +"RTN","TMGNDF3A",1591,0) + . . read "...Enter number of drug to get info about: ^//",input,! +"RTN","TMGNDF3A",1592,0) + . . do ShowInfo(.Array,.Answers,+input) +"RTN","TMGNDF3A",1593,0) + . . set input="R" +"RTN","TMGNDF3A",1594,0) + . else if input="C" do ;"--- toggle compact mode +"RTN","TMGNDF3A",1595,0) + . . set CompactMode='CompactMode +"RTN","TMGNDF3A",1596,0) + . . set input="R" +"RTN","TMGNDF3A",1597,0) + . else if input="T" do ;"---- toggle display by tradename +"RTN","TMGNDF3A",1598,0) + . . set ByTrade='ByTrade +"RTN","TMGNDF3A",1599,0) + . . set input="R" +"RTN","TMGNDF3A",1600,0) + . else if input="B" do ;" ---- toggle display of both names. +"RTN","TMGNDF3A",1601,0) + . . set ShowBoth='ShowBoth +"RTN","TMGNDF3A",1602,0) + . . set input="R" +"RTN","TMGNDF3A",1603,0) + . else if input="D" do ;"---- delete set +"RTN","TMGNDF3A",1604,0) + . . kill EntryList,EntryS +"RTN","TMGNDF3A",1605,0) + . . set input="R" +"RTN","TMGNDF3A",1606,0) + . else if input="X" do ;" ---- delete entries +"RTN","TMGNDF3A",1607,0) + . . new valid set valid=1 +"RTN","TMGNDF3A",1608,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF3A",1609,0) + . . . read "...Enter number(s) to REMOVE from list: ^// ",input,! +"RTN","TMGNDF3A",1610,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF3A",1611,0) + . . . if valid set EntryS=input +"RTN","TMGNDF3A",1612,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1613,0) + . . new Cancelled +"RTN","TMGNDF3A",1614,0) + . . do DoRemove(.Array,.Answers,.EntryList,ByTrade,1,.Cancelled) +"RTN","TMGNDF3A",1615,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF3A",1616,0) + . else if input="S" do ;"---- set tools +"RTN","TMGNDF3A",1617,0) + . . do DoSetTools(.Array,.Answers,.EntryList,.EntryS,.ByTrade,.ShowBoth) +"RTN","TMGNDF3A",1618,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1619,0) + . else if input="F" do ;" ---- find drugs +"RTN","TMGNDF3A",1620,0) + . . new valid set valid=1 +"RTN","TMGNDF3A",1621,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF3A",1622,0) +EFL . . . read "...Enter number(s) to classify by FINDING a similar drug: (? help) ^// ",input,! +"RTN","TMGNDF3A",1623,0) + . . . if input="?" do FindHelp() goto EFL +"RTN","TMGNDF3A",1624,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF3A",1625,0) + . . . if valid set EntryS=input +"RTN","TMGNDF3A",1626,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1627,0) + . . new Cancelled +"RTN","TMGNDF3A",1628,0) + . . do FindPick(.Array,.Answers,.EntryList,1,.Cancelled) +"RTN","TMGNDF3A",1629,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF3A",1630,0) + . else if (input="L")!(+input>0) do ;" ----- lookup drugs +"RTN","TMGNDF3A",1631,0) + . . new valid set valid=1 +"RTN","TMGNDF3A",1632,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF3A",1633,0) + . . . if input="L" read "...Enter number(s) to LOOKUP from list: ^// ",input,! +"RTN","TMGNDF3A",1634,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF3A",1635,0) + . . . if valid set EntryS=input +"RTN","TMGNDF3A",1636,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1637,0) + . . new Cancelled +"RTN","TMGNDF3A",1638,0) + . . do DoLookup(.Array,.Answers,.Classes,.EntryList,1,.Cancelled) +"RTN","TMGNDF3A",1639,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF3A",1640,0) + . else if input="G" do ;" ---- guess drugs +"RTN","TMGNDF3A",1641,0) + . . new valid set valid=1 +"RTN","TMGNDF3A",1642,0) + . . if $get(EntryS)="" do quit:(valid=0) +"RTN","TMGNDF3A",1643,0) +EGL . . . read "...Enter number(s) to classify by GUESSING: (? help) ^// ",input,! +"RTN","TMGNDF3A",1644,0) + . . . if input="?" do FindHelp() goto EFL +"RTN","TMGNDF3A",1645,0) + . . . set valid=$$MkMultList^TMGMISC(input,.EntryList) +"RTN","TMGNDF3A",1646,0) + . . . if valid set EntryS=input +"RTN","TMGNDF3A",1647,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1648,0) + . . new Cancelled +"RTN","TMGNDF3A",1649,0) + . . do DoEGuess(.Array,.Answers,.EntryList,ByTrade,ShowBoth,.Cancelled,1,.Classes) +"RTN","TMGNDF3A",1650,0) + . . if Cancelled=0 kill EntryList,EntryS +"RTN","TMGNDF3A",1651,0) + . else if input'="R" do ;"---- accept numeric input etc. +"RTN","TMGNDF3A",1652,0) + . . if $$MkMultList^TMGMISC(input,.EntryList)=0 quit +"RTN","TMGNDF3A",1653,0) + . . set EntryS=input +"RTN","TMGNDF3A",1654,0) + . . if CompactMode=1 set input="R" +"RTN","TMGNDF3A",1655,0) + +"RTN","TMGNDF3A",1656,0) + quit +"RTN","TMGNDF3A",1657,0) + +"RTN","TMGNDF3A",1658,0) + +"RTN","TMGNDF3A",1659,0) +DoGuess(Array,Answers,EntryList,Cancelled,Classes) +"RTN","TMGNDF3A",1660,0) + ;"Purpose: A wrapper for DoEGuess, with some automatically provided paremeters +"RTN","TMGNDF3A",1661,0) + do DoEGuess(.Array,.Answers,.EntryList,0,0,.Cancelled,0,.Classes) +"RTN","TMGNDF3A",1662,0) + quit +"RTN","TMGNDF3A",1663,0) + +"RTN","TMGNDF3A",1664,0) +DoEGuess(Array,Answers,List,ByTradeName,ShowBoth,Cancelled,FromECode,Classes) +"RTN","TMGNDF3A",1665,0) + ;"Purpose: To guess as classification for entries. +"RTN","TMGNDF3A",1666,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by GatherEmpties(Array) +"RTN","TMGNDF3A",1667,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1668,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1669,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1670,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1671,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1672,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",1673,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1674,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1675,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1676,0) + ;" Format as follows. +"RTN","TMGNDF3A",1677,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1678,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1679,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",1680,0) + ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. +"RTN","TMGNDF3A",1681,0) + ;" Cancelled -- OPTIONAL, PASS BY REFERENCE, will be set to 1 if user cancelled. +"RTN","TMGNDF3A",1682,0) + ;" FromECode -- OPTIONAL, if value=1, then code is handled as if called from the 'empty' +"RTN","TMGNDF3A",1683,0) + ;" code modules (ie HandleEmptyClasses). Default=0 +"RTN","TMGNDF3A",1684,0) + ;" Classes -- PASS BY REFERENCE -- An array holding classes. +"RTN","TMGNDF3A",1685,0) + ;"Results: none +"RTN","TMGNDF3A",1686,0) + +"RTN","TMGNDF3A",1687,0) + set FromECode=$get(FromECode,0) +"RTN","TMGNDF3A",1688,0) + set Cancelled=1 ;"default to cancellation +"RTN","TMGNDF3A",1689,0) + +"RTN","TMGNDF3A",1690,0) + new Results +"RTN","TMGNDF3A",1691,0) + write "Searching for guesses...",$char(10) +"RTN","TMGNDF3A",1692,0) + +"RTN","TMGNDF3A",1693,0) + do GGuessList(.Array,.Answers,.List,.Results) +"RTN","TMGNDF3A",1694,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1695,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1696,0) + ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1697,0) + ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1698,0) + ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName +"RTN","TMGNDF3A",1699,0) + ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" +"RTN","TMGNDF3A",1700,0) + +"RTN","TMGNDF3A",1701,0) + new showExamples set showExamples=1 +"RTN","TMGNDF3A",1702,0) + +"RTN","TMGNDF3A",1703,0) +DEGL0 write !,"GUESSES of class for these drugs: ",! +"RTN","TMGNDF3A",1704,0) + do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) +"RTN","TMGNDF3A",1705,0) + +"RTN","TMGNDF3A",1706,0) + new subAnswers +"RTN","TMGNDF3A",1707,0) + new someShown set someShown=0 +"RTN","TMGNDF3A",1708,0) + new count set count=0 +"RTN","TMGNDF3A",1709,0) + new classIEN set classIEN="" +"RTN","TMGNDF3A",1710,0) + for set classIEN=+$order(Results("ALL CLASSES",classIEN)) quit:(classIEN'>0) do +"RTN","TMGNDF3A",1711,0) + . set count=count+1 +"RTN","TMGNDF3A",1712,0) + . new node set node=$get(Results("ALL CLASSES",classIEN)) +"RTN","TMGNDF3A",1713,0) + . write " ",count,". CLASS: ",$piece(node,"^",3),! +"RTN","TMGNDF3A",1714,0) + . set someShown=1 +"RTN","TMGNDF3A",1715,0) + . set subAnswers(count)=node +"RTN","TMGNDF3A",1716,0) + . new matchName set matchName="" +"RTN","TMGNDF3A",1717,0) + . new temp set temp=0 +"RTN","TMGNDF3A",1718,0) + . for set matchName=$order(Results("ALL CLASSES",classIEN,matchName)) quit:(matchName="")!(temp>5) do +"RTN","TMGNDF3A",1719,0) + . . new vapIEN set vapIEN="" +"RTN","TMGNDF3A",1720,0) + . . for set vapIEN=+$order(Results("ALL CLASSES",classIEN,matchName,vapIEN)) quit:(vapIEN'>0)!(temp>5) do +"RTN","TMGNDF3A",1721,0) + . . . if showExamples=0 quit +"RTN","TMGNDF3A",1722,0) + . . . write " e.g. ",matchName," (",vapIEN,")",! +"RTN","TMGNDF3A",1723,0) + . . . set temp=temp+1 +"RTN","TMGNDF3A",1724,0) + +"RTN","TMGNDF3A",1725,0) + if someShown=0 do goto DEGDone +"RTN","TMGNDF3A",1726,0) + . write " -- (None Suggestions found) -- ",!! +"RTN","TMGNDF3A",1727,0) + . new temp read "Press ENTER to continue.",temp,! +"RTN","TMGNDF3A",1728,0) + +"RTN","TMGNDF3A",1729,0) + new input,UsrClassIEN,className +"RTN","TMGNDF3A",1730,0) + new defInput set defInput="^" +"RTN","TMGNDF3A",1731,0) + if count=1 set defInput=1 +"RTN","TMGNDF3A",1732,0) + new fixing +"RTN","TMGNDF3A",1733,0) +DEGL1 +"RTN","TMGNDF3A",1734,0) + set fixing=0 +"RTN","TMGNDF3A",1735,0) + write "[Enter F to fix (change) the class of a drug listed above.]",! +"RTN","TMGNDF3A",1736,0) + write "[Enter E to toggle Examples ON/OFF]",! +"RTN","TMGNDF3A",1737,0) + write "Enter number of CLASS to select (^ to abort): "_defInput_"// " +"RTN","TMGNDF3A",1738,0) + read input:$get(DTIME,3600),! +"RTN","TMGNDF3A",1739,0) + if input="" set input=defInput +"RTN","TMGNDF3A",1740,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",1741,0) + if input="^" goto DEGDone +"RTN","TMGNDF3A",1742,0) + if input="E" do goto DEGL0 +"RTN","TMGNDF3A",1743,0) + . set showExamples='showExamples +"RTN","TMGNDF3A",1744,0) + if input="F" do goto:(input="^") DEGL1 +"RTN","TMGNDF3A",1745,0) + . set fixing=1 +"RTN","TMGNDF3A",1746,0) + . write !,"Enter number of CLASS containing erroneously classified drug (^ to abort): "_defInput_"// " +"RTN","TMGNDF3A",1747,0) + . read input:$get(DTIME,3600) write ! +"RTN","TMGNDF3A",1748,0) + . if input="" set input=defInput +"RTN","TMGNDF3A",1749,0) + set UsrClassIEN=+$get(subAnswers(input)) +"RTN","TMGNDF3A",1750,0) + if UsrClassIEN'>0 goto DEGL1 +"RTN","TMGNDF3A",1751,0) + if fixing=1 do goto DEGL0 +"RTN","TMGNDF3A",1752,0) + . do FixBadClass(.Results,UsrClassIEN,.Classes) +"RTN","TMGNDF3A",1753,0) + set className=$piece($get(subAnswers(input)),"^",3) +"RTN","TMGNDF3A",1754,0) + write !! +"RTN","TMGNDF3A",1755,0) + if $$VerifyWrite(className,.Answers,.List,ByTradeName,ShowBoth)=0 goto DEGDone +"RTN","TMGNDF3A",1756,0) + do WriteClass(UsrClassIEN,.Array,.Answers,.List,FromECode) +"RTN","TMGNDF3A",1757,0) + set Cancelled=0 ;"set success here. +"RTN","TMGNDF3A",1758,0) +DEGDone +"RTN","TMGNDF3A",1759,0) + quit +"RTN","TMGNDF3A",1760,0) + +"RTN","TMGNDF3A",1761,0) + +"RTN","TMGNDF3A",1762,0) +FixBadClass(GuessArray,UsrClassIEN,Classes) +"RTN","TMGNDF3A",1763,0) + ;"Purpose: If guessing reveals that an existing drug has been misclassified, then +"RTN","TMGNDF3A",1764,0) + ;" this function will allow correction of that drug (50.68 entry) +"RTN","TMGNDF3A",1765,0) + ;"Input: GuessArray -- PASS BY REFERENCE. Format: +"RTN","TMGNDF3A",1766,0) + ;" GuessArray(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName^vapIEN +"RTN","TMGNDF3A",1767,0) + ;" GuessArray(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName +"RTN","TMGNDF3A",1768,0) + ;" GuessArray("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className +"RTN","TMGNDF3A",1769,0) + ;" GuessArray("ALL CLASSES",classIEN,matchName)=vapIEN +"RTN","TMGNDF3A",1770,0) + +"RTN","TMGNDF3A",1771,0) + ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1772,0) + ;" GuessArray(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1773,0) + ;" GuessArray("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName +"RTN","TMGNDF3A",1774,0) + ;" GuessArray("ALL CLASSES",ClassIEN,matchName,vapIEN)="" +"RTN","TMGNDF3A",1775,0) + +"RTN","TMGNDF3A",1776,0) + +"RTN","TMGNDF3A",1777,0) + ;" UsrClassIEN -- The class containing the incorrectly classified drug +"RTN","TMGNDF3A",1778,0) + ;" Classes -- PASS BY REFERENCE. An array holding classes. +"RTN","TMGNDF3A",1779,0) + +"RTN","TMGNDF3A",1780,0) + if $get(UsrClassIEN)="" goto FBCDone +"RTN","TMGNDF3A",1781,0) + new className +"RTN","TMGNDF3A",1782,0) + set className=$piece($get(GuessArray("ALL CLASSES",UsrClassIEN)),"^",3) +"RTN","TMGNDF3A",1783,0) + +"RTN","TMGNDF3A",1784,0) + new Menu,UsrSlct +"RTN","TMGNDF3A",1785,0) + new menuNum set menuNum=0 +"RTN","TMGNDF3A",1786,0) + new matchName set matchName="" +"RTN","TMGNDF3A",1787,0) + new lastMatchName,lastvapIEN +"RTN","TMGNDF3A",1788,0) + new AllArray,IENArray,vapIEN +"RTN","TMGNDF3A",1789,0) + set Menu(0)="Pick Which Drug does NOT belong in class: "_className +"RTN","TMGNDF3A",1790,0) + for set matchName=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName)) quit:(matchName="") do +"RTN","TMGNDF3A",1791,0) + . set vapIEN="" +"RTN","TMGNDF3A",1792,0) + . for set vapIEN=$order(GuessArray("ALL CLASSES",UsrClassIEN,matchName,vapIEN)) quit:(vapIEN="") do +"RTN","TMGNDF3A",1793,0) + . . set menuNum=menuNum+1 +"RTN","TMGNDF3A",1794,0) + . . set Menu(menuNum)=matchName_" (#"_vapIEN_")"_$char(9)_"@^"_vapIEN_"^"_matchName +"RTN","TMGNDF3A",1795,0) + . . set AllArray(vapIEN)=matchName +"RTN","TMGNDF3A",1796,0) + . . set AllArray("NAME",matchName,vapIEN)="" +"RTN","TMGNDF3A",1797,0) + . . set lastMatchName=matchName,lastvapIEN=vapIEN +"RTN","TMGNDF3A",1798,0) + if menuNum>1 do +"RTN","TMGNDF3A",1799,0) + . set menuNum=menuNum+1 +"RTN","TMGNDF3A",1800,0) + . set Menu(menuNum)="ALL of the above drugs"_$char(9)_"ALL" +"RTN","TMGNDF3A",1801,0) + . if menuNum'>3 quit +"RTN","TMGNDF3A",1802,0) + . set menuNum=menuNum+1 +"RTN","TMGNDF3A",1803,0) + . set Menu(menuNum)="OR you may enter #-#, or #,#,#-#,# etc."_$char(9)_"#" +"RTN","TMGNDF3A",1804,0) + +"RTN","TMGNDF3A",1805,0) +FBCMC1 +"RTN","TMGNDF3A",1806,0) + if menuNum>1 do +"RTN","TMGNDF3A",1807,0) + . write ! set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") ;"@^vapIEN^matchName +"RTN","TMGNDF3A",1808,0) + else do +"RTN","TMGNDF3A",1809,0) + . set UsrSlct="@^"_lastvapIEN_"^"_lastMatchName +"RTN","TMGNDF3A",1810,0) + +"RTN","TMGNDF3A",1811,0) + if UsrSlct="ALL" do +"RTN","TMGNDF3A",1812,0) + . merge IENArray=AllArray +"RTN","TMGNDF3A",1813,0) + else if +UsrSlct>0 do +"RTN","TMGNDF3A",1814,0) + . new EntryList,Entry +"RTN","TMGNDF3A",1815,0) + . if $$MkMultList^TMGMISC(UsrSlct,.EntryList)>0 do +"RTN","TMGNDF3A",1816,0) + . . set Entry="" +"RTN","TMGNDF3A",1817,0) + . . for set Entry=$order(EntryList(Entry)) quit:(Entry="") do +"RTN","TMGNDF3A",1818,0) + . . . new vapIEN,vapName,s +"RTN","TMGNDF3A",1819,0) + . . . set s=$piece(Menu(Entry),$char(9),2) +"RTN","TMGNDF3A",1820,0) + . . . if s="" quit +"RTN","TMGNDF3A",1821,0) + . . . set vapIEN=$piece(s,"^",2),vapName=$piece(s,"^",3) +"RTN","TMGNDF3A",1822,0) + . . . set IENArray(vapIEN)=vapName +"RTN","TMGNDF3A",1823,0) + . . . set IENArray("NAME",vapIEN)="" +"RTN","TMGNDF3A",1824,0) + else if $piece(UsrSlct,"^",1)="@" do +"RTN","TMGNDF3A",1825,0) + . set IENArray($piece(UsrSlct,"^",2))=$piece(UsrSlct,"^",3) +"RTN","TMGNDF3A",1826,0) + . set IENArray("NAME",$piece(UsrSlct,"^",3),$piece(UsrSlct,"^",2))="" +"RTN","TMGNDF3A",1827,0) + else if UsrSlct="^" goto FBCDone +"RTN","TMGNDF3A",1828,0) + else if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF3A",1829,0) + else if UsrSlct="??" do goto FBCDone +"RTN","TMGNDF3A",1830,0) + . write !,"For some reason, IEN of selected drug couldn't be found. Sorry.",! +"RTN","TMGNDF3A",1831,0) + else if menuNum>1 goto FBCMC1 +"RTN","TMGNDF3A",1832,0) + else goto FBCDone +"RTN","TMGNDF3A",1833,0) + +"RTN","TMGNDF3A",1834,0) + write "Now pick CORRECT drug class for the chosen drug(s)",! +"RTN","TMGNDF3A",1835,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3A",1836,0) + new newClassIEN set newClassIEN=$$SelectClass(.Classes,0) +"RTN","TMGNDF3A",1837,0) + if newClassIEN=0 goto FBCDone +"RTN","TMGNDF3A",1838,0) + ;"new className set className=$$GET1^DIQ(50.605,newClassIEN,1) +"RTN","TMGNDF3A",1839,0) + ;"write "Set CLASS for VA PRODUCT entry: "_$piece(UsrSlct,"^",2),! +"RTN","TMGNDF3A",1840,0) + ;"write "to be: ",className,"?" +"RTN","TMGNDF3A",1841,0) + ;"new % set %=1 +"RTN","TMGNDF3A",1842,0) + ;"do YN^DICN write ! +"RTN","TMGNDF3A",1843,0) + ;"if %=-1 goto FBCDone +"RTN","TMGNDF3A",1844,0) + +"RTN","TMGNDF3A",1845,0) + new vapName set vapName="" +"RTN","TMGNDF3A",1846,0) + for set vapName=$order(IENArray("NAME",vapName)) quit:(vapName="") do +"RTN","TMGNDF3A",1847,0) + . new entryNum set entryNum="" +"RTN","TMGNDF3A",1848,0) + . ;" GuessArray(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1849,0) + . for set entryNum=$order(GuessArray(entryNum)) quit:(+entryNum'>0) do +"RTN","TMGNDF3A",1850,0) + . . set vapIEN="" +"RTN","TMGNDF3A",1851,0) + . . for set vapIEN=$order(GuessArray(entryNum,"NAME",vapName,vapIEN)) quit:(vapIEN="") do +"RTN","TMGNDF3A",1852,0) + . . . new s set s=$get(GuessArray(entryNum,"NAME",vapName,vapIEN)) +"RTN","TMGNDF3A",1853,0) + . . . if s="" quit +"RTN","TMGNDF3A",1854,0) + . . . new classIEN set classIEN=+s +"RTN","TMGNDF3A",1855,0) + . . . if classIEN=newClassIEN quit ;"already at correct class +"RTN","TMGNDF3A",1856,0) + . . . set IENArray(vapIEN)=vapName +"RTN","TMGNDF3A",1857,0) + +"RTN","TMGNDF3A",1858,0) + set vapIEN="" +"RTN","TMGNDF3A",1859,0) + for set vapIEN=$order(IENArray(vapIEN)) quit:(+vapIEN'>0) do +"RTN","TMGNDF3A",1860,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3A",1861,0) + . set TMGFDA(50.68,vapIEN_",",15)=newClassIEN ;"className +"RTN","TMGNDF3A",1862,0) + . do FILE^DIE("I","TMGFDA","TMGMSG") +"RTN","TMGNDF3A",1863,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3A",1864,0) + . kill GuessArray("ALL CLASSES",UsrClassIEN,$get(IENArray(vapIEN),"xx")) +"RTN","TMGNDF3A",1865,0) + +"RTN","TMGNDF3A",1866,0) +FBCDone +"RTN","TMGNDF3A",1867,0) + quit +"RTN","TMGNDF3A",1868,0) + +"RTN","TMGNDF3A",1869,0) +GGuessList(Array,Answers,List,Results) +"RTN","TMGNDF3A",1870,0) + ;"Purpose: To gather a guessing list of possible classes for each entry in List +"RTN","TMGNDF3A",1871,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",1872,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1873,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1874,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1875,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1876,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",1877,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",1878,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1879,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1880,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",1881,0) + ;" Format as follows. +"RTN","TMGNDF3A",1882,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1883,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",1884,0) + ;" Results -- PASS BY REFERENCE -- and OUT PARAMETER to receive results, as follows: +"RTN","TMGNDF3A",1885,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1886,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1887,0) + ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1888,0) + ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",1889,0) + ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName +"RTN","TMGNDF3A",1890,0) + ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" +"RTN","TMGNDF3A",1891,0) + ;"Results: none +"RTN","TMGNDF3A",1892,0) + +"RTN","TMGNDF3A",1893,0) + new Guesses,GenericName,TradeName +"RTN","TMGNDF3A",1894,0) + new i +"RTN","TMGNDF3A",1895,0) + set i=$order(List("")) +"RTN","TMGNDF3A",1896,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",1897,0) + . set GenericName=$piece($get(Answers(i)),"^",2) +"RTN","TMGNDF3A",1898,0) + . set TradeName=$piece($get(Answers(i)),"^",3) +"RTN","TMGNDF3A",1899,0) + . set i=$order(List(i)) +"RTN","TMGNDF3A",1900,0) + . if $data(Guesses("TRY",TradeName))>0 quit +"RTN","TMGNDF3A",1901,0) + . set Guesses("TRY",TradeName)=1 +"RTN","TMGNDF3A",1902,0) + . new name +"RTN","TMGNDF3A",1903,0) + . new j,p,done set done=0 +"RTN","TMGNDF3A",1904,0) + . new X,TMGARRAY,TMGMSG +"RTN","TMGNDF3A",1905,0) + . for j=$length(GenericName,"/"):-1:1 do +"RTN","TMGNDF3A",1906,0) + . . set name=$piece(GenericName,"/",j) +"RTN","TMGNDF3A",1907,0) + . . for p=$length(name," "):-1:1 do quit:(done=1) +"RTN","TMGNDF3A",1908,0) + . . . new TMGSRCH set TMGSRCH=$piece(name," ",1,p) +"RTN","TMGNDF3A",1909,0) + . . . do FIND^DIC(50.68,"","","",TMGSRCH,"*","","","","TMGARRAY","TMGMSG") +"RTN","TMGNDF3A",1910,0) + . . . if +$get(TMGARRAY("DILIST",0))>0 do +"RTN","TMGNDF3A",1911,0) + . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"NAME")=TMGARRAY("DILIST",1) +"RTN","TMGNDF3A",1912,0) + . . . . merge Guesses("POS MATCH",GenericName,TMGSRCH,"IEN")=TMGARRAY("DILIST",2) +"RTN","TMGNDF3A",1913,0) + . . . . set done=1 +"RTN","TMGNDF3A",1914,0) + kill Guesses("TRY") ;"temporary use of those items already searched. +"RTN","TMGNDF3A",1915,0) + +"RTN","TMGNDF3A",1916,0) + ;"Now convert matching IENs into drug classes. +"RTN","TMGNDF3A",1917,0) + set GenericName="" +"RTN","TMGNDF3A",1918,0) + for set GenericName=$order(Guesses("POS MATCH",GenericName)) quit:(GenericName="") do +"RTN","TMGNDF3A",1919,0) + . new namePart set namePart="" +"RTN","TMGNDF3A",1920,0) + . for set namePart=$order(Guesses("POS MATCH",GenericName,namePart)) quit:(namePart="") do +"RTN","TMGNDF3A",1921,0) + . . new j set j=0 +"RTN","TMGNDF3A",1922,0) + . . for set j=$order(Guesses("POS MATCH",GenericName,namePart,"IEN",j)) quit:(j'>0) do +"RTN","TMGNDF3A",1923,0) + . . . new vapIEN set vapIEN=+$get(Guesses("POS MATCH",GenericName,namePart,"IEN",j)) +"RTN","TMGNDF3A",1924,0) + . . . if vapIEN>0 do +"RTN","TMGNDF3A",1925,0) + . . . . new classIEN,matchName +"RTN","TMGNDF3A",1926,0) + . . . . set classIEN=+$$GET1^DIQ(50.68,vapIEN,15,"I") +"RTN","TMGNDF3A",1927,0) + . . . . set matchName=$$GET1^DIQ(50.68,vapIEN,.01) ;"was 5 (print name) +"RTN","TMGNDF3A",1928,0) + . . . . if (classIEN'>0)!(matchName="") quit +"RTN","TMGNDF3A",1929,0) + . . . . set Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)="" +"RTN","TMGNDF3A",1930,0) + +"RTN","TMGNDF3A",1931,0) + ;"Now compose results +"RTN","TMGNDF3A",1932,0) + set i="" +"RTN","TMGNDF3A",1933,0) + for set i=$order(List(i)) quit:(i="") do +"RTN","TMGNDF3A",1934,0) + . set GenericName=$piece($get(Answers(i)),"^",2) +"RTN","TMGNDF3A",1935,0) + . set TradeName=$piece($get(Answers(i)),"^",3) +"RTN","TMGNDF3A",1936,0) + . new matchName set matchName="" +"RTN","TMGNDF3A",1937,0) + . for set matchName=$order(Guesses("POS MATCH",GenericName,"CLASS",matchName)) quit:(matchName="") do +"RTN","TMGNDF3A",1938,0) + . . new classIEN set classIEN="" +"RTN","TMGNDF3A",1939,0) + . . for set classIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN)) quit:(classIEN'>0) do +"RTN","TMGNDF3A",1940,0) + . . . new classCode,className +"RTN","TMGNDF3A",1941,0) + . . . set classCode=$$GET1^DIQ(50.605,classIEN,.01) +"RTN","TMGNDF3A",1942,0) + . . . set className=$$GET1^DIQ(50.605,classIEN,1) +"RTN","TMGNDF3A",1943,0) + . . . new vapIEN set vapIEN="" +"RTN","TMGNDF3A",1944,0) + . . . for set vapIEN=+$order(Guesses("POS MATCH",GenericName,"CLASS",matchName,classIEN,vapIEN)) quit:(vapIEN'>0) do +"RTN","TMGNDF3A",1945,0) + . . . . set Results(i,"NAME",matchName,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN +"RTN","TMGNDF3A",1946,0) + . . . . set Results(i,"CLASS",classIEN,vapIEN)=classIEN_"^"_classCode_"^"_className_"^"_vapIEN +"RTN","TMGNDF3A",1947,0) + . . . . set Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className +"RTN","TMGNDF3A",1948,0) + . . . . set Results("ALL CLASSES",classIEN,matchName,vapIEN)="" +"RTN","TMGNDF3A",1949,0) + +"RTN","TMGNDF3A",1950,0) + quit +"RTN","TMGNDF3A",1951,0) + +"RTN","TMGNDF3A",1952,0) + +"RTN","TMGNDF3A",1953,0) + +"RTN","TMGNDF3A",1954,0) +AutoEClassification(Array) +"RTN","TMGNDF3A",1955,0) + ;"Purpose: To attempt to automatically classify drugs that have not potential match +"RTN","TMGNDF3A",1956,0) + ;"Input: -- Array PASS BY REFERENCE, an OUT PARAMETER. Prior entries are NOT killed. +"RTN","TMGNDF3A",1957,0) + ;"Output: Array will be filled as follows: +"RTN","TMGNDF3A",1958,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode +"RTN","TMGNDF3A",1959,0) + ;" Array("POSS MATCH",ClassName,TMGTradename,DrugIEN)=ClassIEN^ClassCode +"RTN","TMGNDF3A",1960,0) + ;" Array(DrugIEN,"?")="" +"RTN","TMGNDF3A",1961,0) + ;" Array("?",DrugIEN)="" +"RTN","TMGNDF3A",1962,0) + ;"Results: none +"RTN","TMGNDF3A",1963,0) + +"RTN","TMGNDF3A",1964,0) + new tempArray +"RTN","TMGNDF3A",1965,0) + new Classes +"RTN","TMGNDF3A",1966,0) + new Answers +"RTN","TMGNDF3A",1967,0) + write "Gathering drugs with no CLASS information and no existing match...",! +"RTN","TMGNDF3A",1968,0) + +"RTN","TMGNDF3A",1969,0) + new CompactMode set CompactMode=0 ;" (list display mode: 1=compact, 0=verb +"RTN","TMGNDF3A",1970,0) + new ShowBoth set ShowBoth=0 +"RTN","TMGNDF3A",1971,0) + new ByTrade set ByTrade=1 +"RTN","TMGNDF3A",1972,0) + +"RTN","TMGNDF3A",1973,0) + do GatherEmpties(.tempArray) +"RTN","TMGNDF3A",1974,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",1975,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",1976,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",1977,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",1978,0) + +"RTN","TMGNDF3A",1979,0) + do GetClasses(.Classes) +"RTN","TMGNDF3A",1980,0) + do KillIntro(.Classes) +"RTN","TMGNDF3A",1981,0) + +"RTN","TMGNDF3A",1982,0) + do ShowEList(.tempArray,.Answers,CompactMode,ByTrade,ShowBoth) +"RTN","TMGNDF3A",1983,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1984,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",1985,0) + +"RTN","TMGNDF3A",1986,0) + write !,"Now scanning unclassified drugs for possible CLASS matches...",! +"RTN","TMGNDF3A",1987,0) + +"RTN","TMGNDF3A",1988,0) + new TMGTOTAL set TMGTOTAL=$$ListCt^TMGMISC("Answers") +"RTN","TMGNDF3A",1989,0) + new TMGCUR +"RTN","TMGNDF3A",1990,0) + new StartTime set StartTime=$H +"RTN","TMGNDF3A",1991,0) + new ProgressFn +"RTN","TMGNDF3A",1992,0) + set ProgressFn="if TMGCUR#10=1 do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",0,TMGTOTAL,,StartTime)" +"RTN","TMGNDF3A",1993,0) + new abort set abort=0 +"RTN","TMGNDF3A",1994,0) + new i set i=$order(Answers("")) +"RTN","TMGNDF3A",1995,0) + if i'="" for do quit:(i="")!abort +"RTN","TMGNDF3A",1996,0) + . if $$KeyPressed^TMGUSRIF()=27 do quit:abort=1 +"RTN","TMGNDF3A",1997,0) + . . new % set %=2 +"RTN","TMGNDF3A",1998,0) + . . write !,"Abort" do YN^DICN write ! +"RTN","TMGNDF3A",1999,0) + . . if %=1 set abort=1 +"RTN","TMGNDF3A",2000,0) + . new List set List(i)="" +"RTN","TMGNDF3A",2001,0) + . new class set class=$$Guess1(.Array,.Answers,.List) +"RTN","TMGNDF3A",2002,0) + . if +class>0 do +"RTN","TMGNDF3A",2003,0) + . . new ClassName,ClassCode,ClassIEN,TMGTradeName,DrugIEN +"RTN","TMGNDF3A",2004,0) + . . set ClassName=$piece(class,"^",3) +"RTN","TMGNDF3A",2005,0) + . . set ClassCode=$piece(class,"^",2) +"RTN","TMGNDF3A",2006,0) + . . set ClassIEN=$piece(class,"^",1) +"RTN","TMGNDF3A",2007,0) + . . set TMGTradeName=$piece(Answers(i),"^",3) +"RTN","TMGNDF3A",2008,0) + . . set DrugIEN=$piece(Answers(i),"^",1) +"RTN","TMGNDF3A",2009,0) + . . set Array("POSS MATCH",ClassName,TMGTradeName,DrugIEN)=ClassIEN_"^"_ClassCode +"RTN","TMGNDF3A",2010,0) + . . do CUU^TMGTERM(2) write ! +"RTN","TMGNDF3A",2011,0) + . . new s set s="Found: "_TMGTradeName_" --> "_ClassName +"RTN","TMGNDF3A",2012,0) + . . set s=s_" " +"RTN","TMGNDF3A",2013,0) + . . write $extract(s,1,79),! +"RTN","TMGNDF3A",2014,0) + . if $get(ProgressFn)'="" do +"RTN","TMGNDF3A",2015,0) + . . set TMGCUR=i +"RTN","TMGNDF3A",2016,0) + . . new $etrap set $etrap="w ""??Progress function -- error trapped??"",!" +"RTN","TMGNDF3A",2017,0) + . . xecute ProgressFn +"RTN","TMGNDF3A",2018,0) + . set i=$order(Answers(i)) +"RTN","TMGNDF3A",2019,0) + +"RTN","TMGNDF3A",2020,0) + quit +"RTN","TMGNDF3A",2021,0) + +"RTN","TMGNDF3A",2022,0) + +"RTN","TMGNDF3A",2023,0) + +"RTN","TMGNDF3A",2024,0) +Guess1(Array,Answers,List) +"RTN","TMGNDF3A",2025,0) + ;"Purpose: To return a guessed class, IF there is only one possible guess. +"RTN","TMGNDF3A",2026,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",2027,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",2028,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",2029,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",2030,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",2031,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",2032,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",2033,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2034,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2035,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to process. +"RTN","TMGNDF3A",2036,0) + ;" Format as follows. +"RTN","TMGNDF3A",2037,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",2038,0) + ;" List(Entry number)="" +"RTN","TMGNDF3A",2039,0) + ;"Results: If only 1 matching class found, then classIEN^classCode^className, otherwise 0 +"RTN","TMGNDF3A",2040,0) + +"RTN","TMGNDF3A",2041,0) + new ResultArray +"RTN","TMGNDF3A",2042,0) + new result set result=0 +"RTN","TMGNDF3A",2043,0) + do GGuessList(.Array,.Answers,.List,.ResultArray) +"RTN","TMGNDF3A",2044,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName)=ClassIEN^ClassCode^ClassName +"RTN","TMGNDF3A",2045,0) + ;" Results(Entry Number,"CLASS",ClassIEN)=ClassIEN^ClassCode^ClassName +"RTN","TMGNDF3A",2046,0) + ;" Results("ALL CLASSES",classIEN)=classIEN_"^"_classCode_"^"_className +"RTN","TMGNDF3A",2047,0) + ;" Results("ALL CLASSES",classIEN,matchName)="" +"RTN","TMGNDF3A",2048,0) + +"RTN","TMGNDF3A",2049,0) + ;" Results(Entry Number,"NAME",VASimilarDrugName,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",2050,0) + ;" Results(Entry Number,"CLASS",ClassIEN,vapIEN)=ClassIEN^ClassCode^ClassName_vapIEN +"RTN","TMGNDF3A",2051,0) + ;" Results("ALL CLASSES",ClassIEN)=ClassIEN_"^"_ClassCode_"^"_ClassName +"RTN","TMGNDF3A",2052,0) + ;" Results("ALL CLASSES",ClassIEN,matchName,vapIEN)="" +"RTN","TMGNDF3A",2053,0) + +"RTN","TMGNDF3A",2054,0) + +"RTN","TMGNDF3A",2055,0) + if $$ListCt^TMGMISC($name(ResultArray("ALL CLASSES")))=1 do +"RTN","TMGNDF3A",2056,0) + . new classIEN +"RTN","TMGNDF3A",2057,0) + . set classIEN=$order(ResultArray("ALL CLASSES","")) +"RTN","TMGNDF3A",2058,0) + . set result=$get(ResultArray("ALL CLASSES",classIEN)) +"RTN","TMGNDF3A",2059,0) + +"RTN","TMGNDF3A",2060,0) + quit result +"RTN","TMGNDF3A",2061,0) + +"RTN","TMGNDF3A",2062,0) + +"RTN","TMGNDF3A",2063,0) +DoSetTools(Array,Answers,List,EntryS,ByTradeName,ShowBoth) +"RTN","TMGNDF3A",2064,0) + ;"Purpose: to provide tools for managing SETS to be worked on (List) +"RTN","TMGNDF3A",2065,0) + ;"Input: Array -- PASS BY REFERENCE, array holding data, As created by Gather Classes +"RTN","TMGNDF3A",2066,0) + ;" Array("GENERIC NAME",VA GENERIC Name,DrugIEN)="" +"RTN","TMGNDF3A",2067,0) + ;" Array("TRADE NAME",TradeName,DrugIEN)="" +"RTN","TMGNDF3A",2068,0) + ;" Array("LINK GENERIC TO TRADE",TMGGeneric)=TradeName +"RTN","TMGNDF3A",2069,0) + ;" Array("LINK TRADE TO GENERIC",TradeName)=TMGGeneric +"RTN","TMGNDF3A",2070,0) + ;" Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",2071,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",2072,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2073,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2074,0) + ;" List -- PASS BY REFERENCE -- an array of entries (user input values) to modify. +"RTN","TMGNDF3A",2075,0) + ;" EntryS -- PASS BY REFERENCE -- a string representing the current set. +"RTN","TMGNDF3A",2076,0) + ;" ByTradeName -- OPTIONAL, PASS BY REFERENCE, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",2077,0) + ;" ShowBoth -- OPTIONAL, PASS BY REFERENCE, if value=1 then trade name and generic names both shown. +"RTN","TMGNDF3A",2078,0) + +"RTN","TMGNDF3A",2079,0) + set ByTradeName=$get(ByTradeName,0) +"RTN","TMGNDF3A",2080,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF3A",2081,0) + +"RTN","TMGNDF3A",2082,0) + new input,done +"RTN","TMGNDF3A",2083,0) + set EntryS=$get(EntryS) +"RTN","TMGNDF3A",2084,0) + set done=0 +"RTN","TMGNDF3A",2085,0) + +"RTN","TMGNDF3A",2086,0) + for do quit:(done=1) +"RTN","TMGNDF3A",2087,0) + . write !,"Tools to modify SET of entry numbers",! +"RTN","TMGNDF3A",2088,0) + . write "------------------------------------",! +"RTN","TMGNDF3A",2089,0) + . write "A=Add, X=Remove from SET, C=Clear, D=Display, S=Search, ^ Return",! +"RTN","TMGNDF3A",2090,0) + . write "T=set TradeName ",$select((ByTrade=1):"OFF",1:"ON"),", B=set Both names ",$select((ShowBoth=1):"OFF",1:"ON"),! +"RTN","TMGNDF3A",2091,0) + . read "Enter Option: ^// ",input:$get(DTIME,3600),! +"RTN","TMGNDF3A",2092,0) + . if input="" set input="^" +"RTN","TMGNDF3A",2093,0) + . set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",2094,0) + . if input="^" write ! set done=1 quit +"RTN","TMGNDF3A",2095,0) + . if (input="?") do +"RTN","TMGNDF3A",2096,0) + . . ;"do ShowInstructions() +"RTN","TMGNDF3A",2097,0) + . . set input="R" +"RTN","TMGNDF3A",2098,0) + . else if input="A" do +"RTN","TMGNDF3A",2099,0) + . . read "Enter number(s) to ADD to list: ",input:$get(DTIME,3600),! +"RTN","TMGNDF3A",2100,0) + . . if $$MkMultList^TMGMISC(input,.List) set EntryS=EntryS_" & "_input +"RTN","TMGNDF3A",2101,0) + . else if input="X" do +"RTN","TMGNDF3A",2102,0) + . . new tempList +"RTN","TMGNDF3A",2103,0) + . . read "Enter number(s) to REMOVE to list: ",input:$get(DTIME,3600),! +"RTN","TMGNDF3A",2104,0) + . . if $$MkMultList^TMGMISC(input,.tempList)=0 quit +"RTN","TMGNDF3A",2105,0) + . . new i set i=$order(tempList("")) +"RTN","TMGNDF3A",2106,0) + . . if i'="" for do quit:(i="") +"RTN","TMGNDF3A",2107,0) + . . . kill List(i) +"RTN","TMGNDF3A",2108,0) + . . . set i=$order(tempList(i)) +"RTN","TMGNDF3A",2109,0) + . . set EntryS=EntryS_" - "_input +"RTN","TMGNDF3A",2110,0) + . else if input="C" do +"RTN","TMGNDF3A",2111,0) + . . kill List set EntryS="" +"RTN","TMGNDF3A",2112,0) + . . set input="D" +"RTN","TMGNDF3A",2113,0) + . else if input="S" do +"RTN","TMGNDF3A",2114,0) + . . if $$MkSrchList(.Answers,.List,.ByTradeName,.ShowBoth)=1 do +"RTN","TMGNDF3A",2115,0) + . . . if EntryS'="" set EntryS=EntryS_" & " +"RTN","TMGNDF3A",2116,0) + . . . set EntryS=EntryS_" (SEARCH)" +"RTN","TMGNDF3A",2117,0) + . . set input="D" +"RTN","TMGNDF3A",2118,0) + . else if input="T" do +"RTN","TMGNDF3A",2119,0) + . . set ByTrade='ByTrade +"RTN","TMGNDF3A",2120,0) + . . set input="D" +"RTN","TMGNDF3A",2121,0) + . else if input="B" do +"RTN","TMGNDF3A",2122,0) + . . set ShowBoth='ShowBoth +"RTN","TMGNDF3A",2123,0) + . . set input="D" +"RTN","TMGNDF3A",2124,0) + . if input="D" do +"RTN","TMGNDF3A",2125,0) + . . write !,"Here is the current SET: ",EntryS,! +"RTN","TMGNDF3A",2126,0) + . . do Disp2List(.Answers,.List,.ByTradeName,.ShowBoth) +"RTN","TMGNDF3A",2127,0) + . . ;"new temp read " -- Press [ENTER] to Continue --",temp:$get(DTIME,3600),! +"RTN","TMGNDF3A",2128,0) + +"RTN","TMGNDF3A",2129,0) + quit +"RTN","TMGNDF3A",2130,0) + +"RTN","TMGNDF3A",2131,0) +MkSrchList(Answers,List,ByTradeName,ShowBoth) +"RTN","TMGNDF3A",2132,0) + ;"Purpose: to search through Answers for string +"RTN","TMGNDF3A",2133,0) + ;"Input: Answers -- PASS BY REFERENCE, an array linking display number to IENS. +"RTN","TMGNDF3A",2134,0) + ;" Array should be the one created by ShowEList +"RTN","TMGNDF3A",2135,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2136,0) + ;" Answer(count)=DrugIEN^GenericDrugName^TradeName +"RTN","TMGNDF3A",2137,0) + ;" List -- PASS BY REFERENCE -- an OUT PARAMETER, to hold array of entries (user input values) +"RTN","TMGNDF3A",2138,0) + ;" prior entries are NOT KILLED +"RTN","TMGNDF3A",2139,0) + ;" ByTradeName -- OPTIONAL, if value=1, then values are shown by TradeName +"RTN","TMGNDF3A",2140,0) + ;" ShowBoth -- OPTIONAL, if value=1 then trade name and generic names both shown. +"RTN","TMGNDF3A",2141,0) + ;"Results: 1=some added to list, 0=none added to list. +"RTN","TMGNDF3A",2142,0) + +"RTN","TMGNDF3A",2143,0) + set ByTradeName=$get(ByTradeName,0) +"RTN","TMGNDF3A",2144,0) + set ShowBoth=$get(ShowBoth,0) +"RTN","TMGNDF3A",2145,0) + new result set result=0 +"RTN","TMGNDF3A",2146,0) + +"RTN","TMGNDF3A",2147,0) + new input +"RTN","TMGNDF3A",2148,0) + write !,"Search in ",$select((ByTradeName=1):"TRADE NAME",1:"GENRIC NAME") +"RTN","TMGNDF3A",2149,0) + if ShowBoth write " and ",$select((ByTradeName=0):"TRADE NAME",1:"GENRIC NAME") +"RTN","TMGNDF3A",2150,0) + read !,"Entry text to SEARCH for in entries: ^// ",input:$get(DTIME,3600),! +"RTN","TMGNDF3A",2151,0) + if input="" set input="^" +"RTN","TMGNDF3A",2152,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGNDF3A",2153,0) + if input="^" goto MSLDone +"RTN","TMGNDF3A",2154,0) + new i set i=$order(Answers("")) +"RTN","TMGNDF3A",2155,0) + if i'="" for do quit:(i="") +"RTN","TMGNDF3A",2156,0) + . new TradeName,GenericName +"RTN","TMGNDF3A",2157,0) + . set GenericName=$$UP^XLFSTR($piece($get(Answers(i)),"^",2)) +"RTN","TMGNDF3A",2158,0) + . set TradeName=$$UP^XLFSTR($piece($get(Answers(i)),"^",3)) +"RTN","TMGNDF3A",2159,0) + . if (ByTradeName=1)!(ShowBoth=1) do +"RTN","TMGNDF3A",2160,0) + . . if TradeName[input set List(i)="",result=1 +"RTN","TMGNDF3A",2161,0) + . if (ByTradeName=0)!(ShowBoth=1) do +"RTN","TMGNDF3A",2162,0) + . . if GenericName[input set List(i)="",result=1 +"RTN","TMGNDF3A",2163,0) + . set i=$order(Answers(i)) +"RTN","TMGNDF3A",2164,0) + +"RTN","TMGNDF3A",2165,0) +MSLDone +"RTN","TMGNDF3A",2166,0) + quit result +"RTN","TMGNDF3A",2167,0) + +"RTN","TMGNDF3A",2168,0) + ;"================================================================= +"RTN","TMGNDF3A",2169,0) + +"RTN","TMGNDF3A",2170,0) +SelEdClasses +"RTN","TMGNDF3A",2171,0) + ;"Purpose: Allow user to browse classes with selector +"RTN","TMGNDF3A",2172,0) + ;"Input: none +"RTN","TMGNDF3A",2173,0) + ;"Results: none +"RTN","TMGNDF3A",2174,0) + +"RTN","TMGNDF3A",2175,0) + new Options,IEN +"RTN","TMGNDF3A",2176,0) + set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24" +"RTN","TMGNDF3A",2177,0) + set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()" +"RTN","TMGNDF3A",2178,0) + set Options("FIELDS",2)=".05^TRADENAME^24" +"RTN","TMGNDF3A",2179,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3A",2180,0) + set Options("FIELDS",3)=".07^GENERIC NAME^24" +"RTN","TMGNDF3A",2181,0) + set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3A",2182,0) + set Options("FIELDS","MAX NUM")=3 +"RTN","TMGNDF3A",2183,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF3A",2184,0) + ;"Get all records with SKIP THIS RECORD = 0 (KEEP) +"RTN","TMGNDF3A",2185,0) + +"RTN","TMGNDF3A",2186,0) + write "Finding records not marked to be skipped...",! +"RTN","TMGNDF3A",2187,0) + do GetFldValue^TMGSELED(22706.9,6,0,$name(Options("IEN LIST"))) +"RTN","TMGNDF3A",2188,0) + +"RTN","TMGNDF3A",2189,0) +SEC1 +"RTN","TMGNDF3A",2190,0) + if $$SELED^TMGSELED(.Options)'=2 goto SECDone +"RTN","TMGNDF3A",2191,0) + if $$GetIENs^TMGSELED(.Options)=0 goto SECDone +"RTN","TMGNDF3A",2192,0) + goto SEC1 +"RTN","TMGNDF3A",2193,0) + +"RTN","TMGNDF3A",2194,0) +SECDone quit +"RTN","TMGNDF3A",2195,0) + +"RTN","TMGNDF3A",2196,0) + +"RTN","TMGNDF3A",2197,0) +Ed1Classes +"RTN","TMGNDF3A",2198,0) + ;"Purpose: Allow user to browse classes with selector +"RTN","TMGNDF3A",2199,0) + ;"Input: none +"RTN","TMGNDF3A",2200,0) + ;"Results: none +"RTN","TMGNDF3A",2201,0) + +"RTN","TMGNDF3A",2202,0) + new Options,IEN +"RTN","TMGNDF3A",2203,0) + set Options("FIELDS",1)=".09:1^VA DRUG CLASS^24" +"RTN","TMGNDF3A",2204,0) + set Options("FIELDS",1,"LOOKUP FN")="$$SECLookup^TMGNDF3A()" +"RTN","TMGNDF3A",2205,0) + set Options("FIELDS",2)=".05^TRADENAME^24" +"RTN","TMGNDF3A",2206,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3A",2207,0) + set Options("FIELDS",3)=".07^GENERIC NAME^24" +"RTN","TMGNDF3A",2208,0) + set Options("FIELDS",3,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3A",2209,0) + set Options("FIELDS","MAX NUM")=3 +"RTN","TMGNDF3A",2210,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF3A",2211,0) + ;"Get all records with SKIP THIS RECORD = 0 (KEEP) +"RTN","TMGNDF3A",2212,0) + +"RTN","TMGNDF3A",2213,0) + new DIC,X,Y +"RTN","TMGNDF3A",2214,0) + set DIC=22706.9 +"RTN","TMGNDF3A",2215,0) + set DIC(0)="MAEQ" +"RTN","TMGNDF3A",2216,0) + do ^DIC write ! +"RTN","TMGNDF3A",2217,0) + if +Y'>0 goto E1Done +"RTN","TMGNDF3A",2218,0) + set Options("IEN LIST",+Y)="" +"RTN","TMGNDF3A",2219,0) + +"RTN","TMGNDF3A",2220,0) +E1 +"RTN","TMGNDF3A",2221,0) + if $$SELED^TMGSELED(.Options)'=2 goto E1Done +"RTN","TMGNDF3A",2222,0) + if $$GetIENs^TMGSELED(.Options)=0 goto E1Done +"RTN","TMGNDF3A",2223,0) + goto E1 +"RTN","TMGNDF3A",2224,0) + +"RTN","TMGNDF3A",2225,0) +E1Done quit +"RTN","TMGNDF3A",2226,0) + +"RTN","TMGNDF3A",2227,0) + +"RTN","TMGNDF3A",2228,0) +SECLookup() +"RTN","TMGNDF3A",2229,0) + ;"Purpose: A custom call-back function that the selector will use +"RTN","TMGNDF3A",2230,0) + ;" for looking up class of a given record or list of records. +"RTN","TMGNDF3A",2231,0) + ;"Input: None (because this is to be used only for ONE field) +"RTN","TMGNDF3A",2232,0) + ;"Results: Returns IEN for Class, or 0 if not found or abort. +"RTN","TMGNDF3A",2233,0) + +"RTN","TMGNDF3A",2234,0) + new Classes,UsrClassIEN +"RTN","TMGNDF3A",2235,0) + +"RTN","TMGNDF3A",2236,0) + do GetClasses(.Classes) +"RTN","TMGNDF3A",2237,0) + do KillIntro(.Classes) +"RTN","TMGNDF3A",2238,0) + set UsrClassIEN=$$SelectClass(.Classes) +"RTN","TMGNDF3A",2239,0) + +"RTN","TMGNDF3A",2240,0) + quit UsrClassIEN +"RTN","TMGNDF3B") +0^49^B4797 +"RTN","TMGNDF3B",1,0) +TMGNDF3B ;TMG/kst/FDA Import: Set skip flag based on drug class ;03/25/06 +"RTN","TMGNDF3B",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF3B",3,0) + +"RTN","TMGNDF3B",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF3B",5,0) + ;" Set skip flag based on CLASS +"RTN","TMGNDF3B",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF3B",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF3B",8,0) + ;"11-21-2006 +"RTN","TMGNDF3B",9,0) + +"RTN","TMGNDF3B",10,0) + ;"======================================================================= +"RTN","TMGNDF3B",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF3B",12,0) + ;"======================================================================= +"RTN","TMGNDF3B",13,0) + ;"PickSkips -- allow user to scan for drugs by class and choose which to skip. +"RTN","TMGNDF3B",14,0) + ;" -- NOTE: This is called from menu in TMGNDF3A +"RTN","TMGNDF3B",15,0) + +"RTN","TMGNDF3B",16,0) + ;"======================================================================= +"RTN","TMGNDF3B",17,0) + ;" Private Functions. +"RTN","TMGNDF3B",18,0) + ;"======================================================================= +"RTN","TMGNDF3B",19,0) + ;"GetChildClasses(Array,Result) -- get a child array block showing the heirarchy of all VA DRUG classes +"RTN","TMGNDF3B",20,0) + ;"GetRxClasses(pList,Array) -- create an array of drug classes for the input List +"RTN","TMGNDF3B",21,0) + ;"GetMatch(RxClasses,ChildClasses,ClassIEN,Results) -- return those Drugs contained in class IEN +"RTN","TMGNDF3B",22,0) + ;"WeedClasses(Classes,RxClasses,ChildClasses) -- remove entries from Classes that don't have any children in RxClasses +"RTN","TMGNDF3B",23,0) + ;"NumDescendents(ClassIEN,Classes,ChildClasses,CountArray) -- return num having class, or descendent class +"RTN","TMGNDF3B",24,0) + ;"DoWeedBySel(pList,mode) -- remove items, view all drugs, & select to remove +"RTN","TMGNDF3B",25,0) + ;"GetInfo(IEN,array) -- get all the associated names linked to a DRUG file entry +"RTN","TMGNDF3B",26,0) + +"RTN","TMGNDF3B",27,0) + ;"======================================================================= +"RTN","TMGNDF3B",28,0) + ;"======================================================================= +"RTN","TMGNDF3B",29,0) +PickSkips +"RTN","TMGNDF3B",30,0) + ;"Purpose: To allow user to scan for drugs by class and choose which to skip. +"RTN","TMGNDF3B",31,0) + +"RTN","TMGNDF3B",32,0) + new List +"RTN","TMGNDF3B",33,0) + do GetList("List") +"RTN","TMGNDF3B",34,0) + do WeedByClass("List") +"RTN","TMGNDF3B",35,0) + +"RTN","TMGNDF3B",36,0) + quit +"RTN","TMGNDF3B",37,0) + +"RTN","TMGNDF3B",38,0) +GetList(pList) +"RTN","TMGNDF3B",39,0) + ;"Purpose: To create a list of records not currently marked to be skipped +"RTN","TMGNDF3B",40,0) + ;"Input: pList -- PASS BY NAME -- an OUT PARAMETER. Format: +"RTN","TMGNDF3B",41,0) + ;" @pList@(DrugName,IENin22706.9)="" +"RTN","TMGNDF3B",42,0) + ;" @pList@(DrugName,IENin22706.9)="" +"RTN","TMGNDF3B",43,0) + +"RTN","TMGNDF3B",44,0) + new Itr,IEN +"RTN","TMGNDF3B",45,0) + new abort set abort=0 +"RTN","TMGNDF3B",46,0) + write "Gathering names of the current imports not flagged to be SKIPPED...",! +"RTN","TMGNDF3B",47,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3B",48,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3B",49,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF3B",50,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3B",51,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3B",52,0) + . new DrugName set DrugName=$piece($get(^TMG(22706.9,IEN,7)),"^",6) +"RTN","TMGNDF3B",53,0) + . set @pList@(DrugName,IEN)="" +"RTN","TMGNDF3B",54,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3B",55,0) + +"RTN","TMGNDF3B",56,0) + quit +"RTN","TMGNDF3B",57,0) + +"RTN","TMGNDF3B",58,0) +WeedByClass(pList) +"RTN","TMGNDF3B",59,0) + ;"Purpose: To allow the user to weed the list of drugs for addition, by drug class +"RTN","TMGNDF3B",60,0) + ;"Input: pList -- PASS BY NAME -- list of drugs to be added, as created by FillList(pList) +"RTN","TMGNDF3B",61,0) + ;"Output: the List will be edited. +"RTN","TMGNDF3B",62,0) + ;"Result: none +"RTN","TMGNDF3B",63,0) + +"RTN","TMGNDF3B",64,0) + new Classes,ParentArray,ChildArray,IEN,RxClasses +"RTN","TMGNDF3B",65,0) + +"RTN","TMGNDF3B",66,0) + write "Gathering information about drug CLASSES from the imports..." +"RTN","TMGNDF3B",67,0) + do GetClasses^TMGNDF3A(.Classes) +"RTN","TMGNDF3B",68,0) + do KillIntro^TMGNDF3A(.Classes) +"RTN","TMGNDF3B",69,0) + do GetChildClasses(.Classes,.ChildArray) +"RTN","TMGNDF3B",70,0) + do GetRxClasses(pList,.RxClasses) +"RTN","TMGNDF3B",71,0) + do WeedClasses(.Classes,.RxClasses,.ChildArray) +"RTN","TMGNDF3B",72,0) + +"RTN","TMGNDF3B",73,0) + new done set done=0 +"RTN","TMGNDF3B",74,0) + for do quit:(done=1) +"RTN","TMGNDF3B",75,0) + . new classIEN +"RTN","TMGNDF3B",76,0) + . set classIEN=$$SelectClass^TMGNDF3A(.Classes,1) +"RTN","TMGNDF3B",77,0) + . if classIEN=0 set done=1 quit +"RTN","TMGNDF3B",78,0) + . new Match +"RTN","TMGNDF3B",79,0) + . do GetMatch(.RxClasses,.ChildArray,classIEN,.Match) +"RTN","TMGNDF3B",80,0) + . if $data(Match) do +"RTN","TMGNDF3B",81,0) + . . new delList +"RTN","TMGNDF3B",82,0) + . . do SelRxList("Match","delList","SELECT DRUGS TO BE DELETED. [ESC][ESC] WHEN DONE") +"RTN","TMGNDF3B",83,0) + . . do DoWeed(pList,"delList") +"RTN","TMGNDF3B",84,0) + . . new name set name="" +"RTN","TMGNDF3B",85,0) + . . for set name=$order(delList(name)) quit:(name="") do +"RTN","TMGNDF3B",86,0) + . . . new IEN set IEN="" +"RTN","TMGNDF3B",87,0) + . . . for set IEN=$order(delList(name,IEN)) quit:(+IEN'>0) do +"RTN","TMGNDF3B",88,0) + . . . . new TMGFDA,TMGMSG +"RTN","TMGNDF3B",89,0) + . . . . set TMGFDA(22706.9,IEN_",",6)=1 ;"1=SKIP +"RTN","TMGNDF3B",90,0) + . . . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3B",91,0) + . . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3B",92,0) + . . . . new classIEN set classIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",5) +"RTN","TMGNDF3B",93,0) + . . . . if $data(RxClasses(classIEN,name,IEN)) do +"RTN","TMGNDF3B",94,0) + . . . . . kill RxClasses(classIEN,name,IEN) +"RTN","TMGNDF3B",95,0) + . . ;"kill RxClasses +"RTN","TMGNDF3B",96,0) + . . ;"write "Gathering drug classes..." +"RTN","TMGNDF3B",97,0) + . . ;"do GetRxClasses(pList,.RxClasses) +"RTN","TMGNDF3B",98,0) + . . do WeedClasses(.Classes,.RxClasses,.ChildArray) +"RTN","TMGNDF3B",99,0) + . else write "(No matches found.)",! +"RTN","TMGNDF3B",100,0) + +"RTN","TMGNDF3B",101,0) + ;"write "Counting drugs in list... " +"RTN","TMGNDF3B",102,0) + ;"set @pList@(-1)=$$ListCt^TMGMISC(pList)-1 ;"recount ItemsCount node +"RTN","TMGNDF3B",103,0) + +"RTN","TMGNDF3B",104,0) + quit +"RTN","TMGNDF3B",105,0) + +"RTN","TMGNDF3B",106,0) + +"RTN","TMGNDF3B",107,0) +GetRxClasses(pList,Array) +"RTN","TMGNDF3B",108,0) + ;"Purpose: To create an array of drug classes for the input List +"RTN","TMGNDF3B",109,0) + ;"Input: pList -- PASS BY NAME, +"RTN","TMGNDF3B",110,0) + ;" format: @List@(-1)=ItemsCount <-- REMOVED +"RTN","TMGNDF3B",111,0) + ;" @List@(DrugName,IEN)="" ;IEN is IEN in file 22706.9 +"RTN","TMGNDF3B",112,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF3B",113,0) + ;" format: Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",114,0) + ;" Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",115,0) + ;" Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",116,0) + ;"Output: Array -- prior entries are not deleted. +"RTN","TMGNDF3B",117,0) + ;"Result: none +"RTN","TMGNDF3B",118,0) + +"RTN","TMGNDF3B",119,0) + new Itr,DrugName +"RTN","TMGNDF3B",120,0) + new IEN,ClassIEN +"RTN","TMGNDF3B",121,0) + new abort set abort=0 +"RTN","TMGNDF3B",122,0) + set DrugName=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGNDF3B",123,0) + do PrepProgress^TMGITR(.Itr,20,1,"DrugName") +"RTN","TMGNDF3B",124,0) + write ! +"RTN","TMGNDF3B",125,0) + if DrugName'="" for do quit:($$ItrANext^TMGITR(.Itr,.DrugName)="")!abort +"RTN","TMGNDF3B",126,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3B",127,0) + . set IEN=0 +"RTN","TMGNDF3B",128,0) + . for set IEN=$order(@pList@(DrugName,IEN)) quit:(+IEN'>0) do +"RTN","TMGNDF3B",129,0) + . . set ClassIEN=$piece($get(^TMG(22706.9,IEN,1)),"^",5) +"RTN","TMGNDF3B",130,0) + . . if ClassIEN>0 set Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",131,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3B",132,0) + +"RTN","TMGNDF3B",133,0) + quit +"RTN","TMGNDF3B",134,0) + +"RTN","TMGNDF3B",135,0) + +"RTN","TMGNDF3B",136,0) + +"RTN","TMGNDF3B",137,0) +GetChildClasses(Array,Result) +"RTN","TMGNDF3B",138,0) + ;"Purpose: To get a child array block showing the heirarchy of all VA DRUG classes +"RTN","TMGNDF3B",139,0) + ;"Input: Array -- PASS BY REFERENCE, array as created by GetClasses^TMGNDF3A(.Array) +"RTN","TMGNDF3B",140,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3B",141,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3B",142,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3B",143,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3B",144,0) + ;" Note: There are no more than 3 levels +"RTN","TMGNDF3B",145,0) + ;" Result -- PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF3B",146,0) + ;"Output: Result filled as follows: +"RTN","TMGNDF3B",147,0) + ;" Note: the IEN's here are IEN's in VA DRUG CLASS file +"RTN","TMGNDF3B",148,0) + ;" Result (IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",149,0) + ;" Result (IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",150,0) + ;" Result (IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",151,0) + ;" Result (IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",152,0) + ;" e.g. ChildArray(1)= 2,3,240, means that 2,3,240 are children of 1 +"RTN","TMGNDF3B",153,0) + ;"Results: none +"RTN","TMGNDF3B",154,0) + +"RTN","TMGNDF3B",155,0) + new parentIEN,IEN +"RTN","TMGNDF3B",156,0) + +"RTN","TMGNDF3B",157,0) + new i1,i2,i3,i4 +"RTN","TMGNDF3B",158,0) + set i1=$order(Array("")) +"RTN","TMGNDF3B",159,0) + if i1'="" for do quit:(i1="") +"RTN","TMGNDF3B",160,0) + . set i2=$order(Array(i1,"")) +"RTN","TMGNDF3B",161,0) + . if i2'="" for do quit:(i2="") +"RTN","TMGNDF3B",162,0) + . . if $data(Array(i1,i2))#10>0 do +"RTN","TMGNDF3B",163,0) + . . . set Result(i1)=$get(Result(i1))_i2_"," +"RTN","TMGNDF3B",164,0) + . . set i3=$order(Array(i1,i2,"")) +"RTN","TMGNDF3B",165,0) + . . if i3'="" for do quit:(i3="") +"RTN","TMGNDF3B",166,0) + . . . if $data(Array(i1,i2,i3))#10>0 do +"RTN","TMGNDF3B",167,0) + . . . . set Result(i1)=$get(Result(i1))_i3_"," +"RTN","TMGNDF3B",168,0) + . . . set i3=$order(Array(i1,i2,i3)) +"RTN","TMGNDF3B",169,0) + . . set i2=$order(Array(i1,i2)) +"RTN","TMGNDF3B",170,0) + . set i1=$order(Array(i1)) +"RTN","TMGNDF3B",171,0) + +"RTN","TMGNDF3B",172,0) + quit +"RTN","TMGNDF3B",173,0) + +"RTN","TMGNDF3B",174,0) + +"RTN","TMGNDF3B",175,0) +WeedClasses(Classes,RxClasses,ChildClasses) +"RTN","TMGNDF3B",176,0) + ;"Purpose: To removed entries from Classes that don't have any children in RxClasses +"RTN","TMGNDF3B",177,0) + ;"Input: +"RTN","TMGNDF3B",178,0) + ;" Classes -- PASS BY REFERENCE. Array filled as follows: +"RTN","TMGNDF3B",179,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3B",180,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3B",181,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3B",182,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3B",183,0) + ;" RxClasses: PASS BY REFERENCE +"RTN","TMGNDF3B",184,0) + ;" format: Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",185,0) + ;" Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",186,0) + ;" Array(ClassIEN,DrugName,IEN)="" +"RTN","TMGNDF3B",187,0) + ;" ChildClasses: PASS BY REFERENCE +"RTN","TMGNDF3B",188,0) + ;" Note: the IEN's here are IEN's in VA DRUG CLASS file +"RTN","TMGNDF3B",189,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",190,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",191,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",192,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",193,0) + ;" e.g. Array(1)= 2,3,240, means that 2,3,240 are children of 1 +"RTN","TMGNDF3B",194,0) + ;"Output: Classes Array will be edited with empty clases removed +"RTN","TMGNDF3B",195,0) + ;"Results: none +"RTN","TMGNDF3B",196,0) + +"RTN","TMGNDF3B",197,0) + ;"First count all entries for each drug class IEN +"RTN","TMGNDF3B",198,0) + +"RTN","TMGNDF3B",199,0) + new CountArray +"RTN","TMGNDF3B",200,0) + ;"Format: CountArray(ClassIEN)=CountOfDrugsWithThisClass +"RTN","TMGNDF3B",201,0) + +"RTN","TMGNDF3B",202,0) + new count +"RTN","TMGNDF3B",203,0) + new ClassIEN set ClassIEN=$order(RxClasses("")) +"RTN","TMGNDF3B",204,0) + if ClassIEN'="" for do quit:(ClassIEN="") +"RTN","TMGNDF3B",205,0) + . set count=0 +"RTN","TMGNDF3B",206,0) + . new DrugName set DrugName=$order(RxClasses(ClassIEN,"")) +"RTN","TMGNDF3B",207,0) + . if DrugName'="" for do quit:(DrugName="") +"RTN","TMGNDF3B",208,0) + . . new DrugIEN set DrugIEN=$order(RxClasses(ClassIEN,DrugName,"")) +"RTN","TMGNDF3B",209,0) + . . if DrugIEN'="" for do quit:(DrugIEN="") +"RTN","TMGNDF3B",210,0) + . . . set count=count+1 +"RTN","TMGNDF3B",211,0) + . . . set DrugIEN=$order(RxClasses(ClassIEN,DrugName,DrugIEN)) +"RTN","TMGNDF3B",212,0) + . . set DrugName=$order(RxClasses(ClassIEN,DrugName)) +"RTN","TMGNDF3B",213,0) + . set CountArray(ClassIEN)=count +"RTN","TMGNDF3B",214,0) + . set ClassIEN=$order(RxClasses(ClassIEN)) +"RTN","TMGNDF3B",215,0) + +"RTN","TMGNDF3B",216,0) + +"RTN","TMGNDF3B",217,0) + ;"Now remove all ClassIENs that don't have any entries, or children or grandchildren etc. +"RTN","TMGNDF3B",218,0) + ;" Classes -- Array will be filled as follows: +"RTN","TMGNDF3B",219,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3B",220,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3B",221,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3B",222,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3B",223,0) + +"RTN","TMGNDF3B",224,0) + new i1,i2,i3,i4 +"RTN","TMGNDF3B",225,0) + set i1=$order(Classes("")) +"RTN","TMGNDF3B",226,0) + if i1'="" for do quit:(i1="") +"RTN","TMGNDF3B",227,0) + . if $$NumDescendents(i1,.Classes,.ChildClasses,.CountArray)=0 do quit +"RTN","TMGNDF3B",228,0) + . . new temp set temp=i1 +"RTN","TMGNDF3B",229,0) + . . set i1=$order(Classes(i1)) +"RTN","TMGNDF3B",230,0) + . . kill Classes(temp) +"RTN","TMGNDF3B",231,0) + . . ;"write "Removing class ",temp,"... It doesn't have any entries or descendents",! +"RTN","TMGNDF3B",232,0) + . set i2=$order(Classes(i1,"")) +"RTN","TMGNDF3B",233,0) + . if i2'="" for do quit:(i2="") +"RTN","TMGNDF3B",234,0) + . . if $$NumDescendents(i2,.Classes,.ChildClasses,.CountArray)=0 do quit +"RTN","TMGNDF3B",235,0) + . . . new temp set temp=i2 +"RTN","TMGNDF3B",236,0) + . . . set i2=$order(Classes(i1,i2)) +"RTN","TMGNDF3B",237,0) + . . . kill Classes(i1,temp) +"RTN","TMGNDF3B",238,0) + . . . ;"write "Removing class ",temp,"... It doesn't have any entries or descendents",! +"RTN","TMGNDF3B",239,0) + . . set i3=$order(Classes(i1,i2,"")) +"RTN","TMGNDF3B",240,0) + . . if i3'="" for do quit:(i3="") +"RTN","TMGNDF3B",241,0) + . . . if $$NumDescendents(i3,.Classes,.ChildClasses,.CountArray)=0 do quit +"RTN","TMGNDF3B",242,0) + . . . . new temp set temp=i3 +"RTN","TMGNDF3B",243,0) + . . . . set i3=$order(Classes(i1,i2,i3)) +"RTN","TMGNDF3B",244,0) + . . . . kill Classes(i1,i2,temp) +"RTN","TMGNDF3B",245,0) + . . . . ;"write "Removing class ",temp,"... It doesn't have any entries or descendents",! +"RTN","TMGNDF3B",246,0) + . . . set i3=$order(Classes(i1,i2,i3)) +"RTN","TMGNDF3B",247,0) + . . set i2=$order(Classes(i1,i2)) +"RTN","TMGNDF3B",248,0) + . set i1=$order(Classes(i1)) +"RTN","TMGNDF3B",249,0) + +"RTN","TMGNDF3B",250,0) + quit +"RTN","TMGNDF3B",251,0) + +"RTN","TMGNDF3B",252,0) + +"RTN","TMGNDF3B",253,0) +GetMatch(RxClasses,ChildClasses,ClassIEN,Results) +"RTN","TMGNDF3B",254,0) + ;"Purpose: To return those Drugs contained in class IEN +"RTN","TMGNDF3B",255,0) + ;"Input: RxClasses: PASS BY REFERENCE Array as created by GetRxClasses(pList,Array) +"RTN","TMGNDF3B",256,0) + ;" -- a list of drugs arranged by class +"RTN","TMGNDF3B",257,0) + ;" ChildClasses: PASS BY REFERENCE Array as created by GetChildClasses(Array,Result) +"RTN","TMGNDF3B",258,0) + ;" -- a list of child class for any given class IEN +"RTN","TMGNDF3B",259,0) + ;" ClassIEN: The IEN from file VA DRUG CLASS to match against. +"RTN","TMGNDF3B",260,0) + ;" Results: PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF3B",261,0) + ;"Output: Results -- List of matches, if found. Format as follows: +"RTN","TMGNDF3B",262,0) + ;" format: Results(-1)=ItemsCount <-- REMOVED +"RTN","TMGNDF3B",263,0) + ;" Results(DrugName,IEN)="" +"RTN","TMGNDF3B",264,0) + ;" +"RTN","TMGNDF3B",265,0) + ;"Results: none +"RTN","TMGNDF3B",266,0) + +"RTN","TMGNDF3B",267,0) + ;"First get all matches for ClassIEN +"RTN","TMGNDF3B",268,0) + merge Results=RxClasses(ClassIEN) +"RTN","TMGNDF3B",269,0) + +"RTN","TMGNDF3B",270,0) + ;"Now get matches for all descenents +"RTN","TMGNDF3B",271,0) + new i,kids +"RTN","TMGNDF3B",272,0) + set kids=$get(ChildClasses(ClassIEN)) +"RTN","TMGNDF3B",273,0) + for i=1:1:$length(kids,",") do +"RTN","TMGNDF3B",274,0) + . new kidIEN set kidIEN=$piece(kids,",",i) +"RTN","TMGNDF3B",275,0) + . merge Results=RxClasses(kidIEN) +"RTN","TMGNDF3B",276,0) + quit +"RTN","TMGNDF3B",277,0) + +"RTN","TMGNDF3B",278,0) + +"RTN","TMGNDF3B",279,0) +NumDescendents(ClassIEN,Classes,ChildClasses,CountArray) +"RTN","TMGNDF3B",280,0) + ;"Purpose: For a given drug class, return the number of drugs that have this class, or one +"RTN","TMGNDF3B",281,0) + ;" of it's descendent classes as its assigned drug class +"RTN","TMGNDF3B",282,0) + ;"Input: ClassIEN -- the IEN to evaluate +"RTN","TMGNDF3B",283,0) + ;" Classes -- Array will be filled as follows: +"RTN","TMGNDF3B",284,0) + ;" Array(GGF-IEN)=e.g. ""AD000^ANTIDOTES,DETERRENTS AND POISON CONTROL" +"RTN","TMGNDF3B",285,0) + ;" Array(GGF-IEN,GF-IEN)=e.g. "AD100^ALCOHOL DETERRENTS" +"RTN","TMGNDF3B",286,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN)=e.g. "AD150^ALCOHOL DETERRENTS -- GENERAL TYPE 1" +"RTN","TMGNDF3B",287,0) + ;" Array(GGF-IEN,GF-IEN,F-IEN,IEN)=e.g. "AD152^ALCOHOL DETERRENTS -- GENERAL TYPE 1b" +"RTN","TMGNDF3B",288,0) + ;" ChildClasses: +"RTN","TMGNDF3B",289,0) + ;" Note: the IEN's here are IEN's in VA DRUG CLASS file +"RTN","TMGNDF3B",290,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",291,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",292,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",293,0) + ;" Array(IEN)="IEN1,IEN2,IEN3,IEN4,IEN5,IEN6," a list of all child IENs +"RTN","TMGNDF3B",294,0) + ;" e.g. Array(1)= 2,3,240, means that 2,3,240 are children of 1 +"RTN","TMGNDF3B",295,0) + ;" CountArray: Array filled with a counting of drugs using each class (pre-counted array) +"RTN","TMGNDF3B",296,0) + ;" CountArray(ClassIEN)=CountOfDrugsWithThisClass +"RTN","TMGNDF3B",297,0) + ;" CountArray(ClassIEN)=CountOfDrugsWithThisClass +"RTN","TMGNDF3B",298,0) + ;" CountArray(ClassIEN)=CountOfDrugsWithThisClass +"RTN","TMGNDF3B",299,0) + ;"Result: returns the number using this class, or a descendent class. +"RTN","TMGNDF3B",300,0) + +"RTN","TMGNDF3B",301,0) + new result +"RTN","TMGNDF3B",302,0) + set result=+$get(CountArray(ClassIEN)) +"RTN","TMGNDF3B",303,0) + +"RTN","TMGNDF3B",304,0) + new ChildList set ChildList=$get(ChildClasses(ClassIEN)) +"RTN","TMGNDF3B",305,0) + new i for i=1:1:$length(ChildList,",") do +"RTN","TMGNDF3B",306,0) + . new subClassIEN set subClassIEN=+$piece(ChildList,",",i) +"RTN","TMGNDF3B",307,0) + . if subClassIEN=0 quit +"RTN","TMGNDF3B",308,0) + . set result=result+$$NumDescendents(subClassIEN,.Classes,.ChildClasses,.CountArray) +"RTN","TMGNDF3B",309,0) + +"RTN","TMGNDF3B",310,0) + quit result +"RTN","TMGNDF3B",311,0) + +"RTN","TMGNDF3B",312,0) + +"RTN","TMGNDF3B",313,0) + +"RTN","TMGNDF3B",314,0) +SelRxList(pList,pSelList,HdrText,mode) +"RTN","TMGNDF3B",315,0) + ;"Purpose: To display the Drug list, and allow user to select from the list. +"RTN","TMGNDF3B",316,0) + ;"Input: pList -- PASS BY NAME -- list of drugs to be added, as created by FillList(pList) +"RTN","TMGNDF3B",317,0) + ;" @pList@(drugName,IEN)="" +"RTN","TMGNDF3B",318,0) + ;" pSelList -- PASS BY NAME, an OUT PARAMETER. +"RTN","TMGNDF3B",319,0) + ;" Returns list of selected items +"RTN","TMGNDF3B",320,0) + ;" @pSelList@(drugName,IEN)="" ;IEN is from 22706.9 +"RTN","TMGNDF3B",321,0) + ;" @pSelList@(drugName,IEN)="" +"RTN","TMGNDF3B",322,0) + ;" HdrText -- optional, some text to show on top of selector +"RTN","TMGNDF3B",323,0) + ;" mode -- OPTIONAL. Default=1 +"RTN","TMGNDF3B",324,0) + ;" 1 --> Display by LONG NAME .04 name +"RTN","TMGNDF3B",325,0) + ;" 2 --> Display by VA PRODUCT (50.68) .01 name +"RTN","TMGNDF3B",326,0) + ;" 3 --> Display by FDA import name +"RTN","TMGNDF3B",327,0) + ;" 4 --> Display by VA GENERIC name +"RTN","TMGNDF3B",328,0) + +"RTN","TMGNDF3B",329,0) + ;"Results: none +"RTN","TMGNDF3B",330,0) + +"RTN","TMGNDF3B",331,0) + new ref set ref="^TMP(""VEE"",$J)" +"RTN","TMGNDF3B",332,0) + kill @ref +"RTN","TMGNDF3B",333,0) + new count set count=1 +"RTN","TMGNDF3B",334,0) + set mode=$get(mode,1) +"RTN","TMGNDF3B",335,0) + +"RTN","TMGNDF3B",336,0) + new pNDCIndex +"RTN","TMGNDF3B",337,0) + set pNDCIndex=$$GetNDCIndex^TMGNDF4A(1) +"RTN","TMGNDF3B",338,0) + +"RTN","TMGNDF3B",339,0) + write "Prepping to display list...",! +"RTN","TMGNDF3B",340,0) + ;"First convert list to a display format +"RTN","TMGNDF3B",341,0) + new name,IEN,Itr +"RTN","TMGNDF3B",342,0) + +"RTN","TMGNDF3B",343,0) + set name=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGNDF3B",344,0) + do PrepProgress^TMGITR(.Itr,20,1,"name") +"RTN","TMGNDF3B",345,0) + if name'="" for do quit:($$ItrANext^TMGITR(.Itr,.name)="") +"RTN","TMGNDF3B",346,0) + . new addedArray,showName +"RTN","TMGNDF3B",347,0) + . set IEN=0 +"RTN","TMGNDF3B",348,0) + . for set IEN=$order(@pList@(name,IEN)) quit:(IEN="") do +"RTN","TMGNDF3B",349,0) + . . new NameInfo do GetInfo(IEN,.NameInfo) +"RTN","TMGNDF3B",350,0) + . . new IdxName set IdxName=$get(NameInfo("MODES",mode)) +"RTN","TMGNDF3B",351,0) + . . if mode=3 do ;"Display by FDA import name +"RTN","TMGNDF3B",352,0) + . . . set showName="" +"RTN","TMGNDF3B",353,0) + . . . for set showName=$order(NameInfo(IdxName,showName)) quit:(showName="") do +"RTN","TMGNDF3B",354,0) + . . . . set @ref@(count)=name_"^"_IEN_$char(9)_showName set count=count+1 +"RTN","TMGNDF3B",355,0) + . . . set showName="" ;"prevent duplicate addition below +"RTN","TMGNDF3B",356,0) + . . else if (mode>0)&(mode<5) set showName=$order(NameInfo(IdxName,"")) +"RTN","TMGNDF3B",357,0) + . . if (showName'="") set @ref@(count)=name_"^"_IEN_$char(9)_showName set count=count+1 +"RTN","TMGNDF3B",358,0) + +"RTN","TMGNDF3B",359,0) + set @ref@("HD")=$get(HdrText,"MENU") +"RTN","TMGNDF3B",360,0) + +"RTN","TMGNDF3B",361,0) + ;"Note: Rules of use: +"RTN","TMGNDF3B",362,0) + ;" ref must=^TMP("VEE",$J) +"RTN","TMGNDF3B",363,0) + ;" Each line should be in this format: +"RTN","TMGNDF3B",364,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",365,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",366,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",367,0) + ;" Results come back in: +"RTN","TMGNDF3B",368,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",369,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",370,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGNDF3B",371,0) + +"RTN","TMGNDF3B",372,0) + write !,"Passing off to Selector..." +"RTN","TMGNDF3B",373,0) + D SELECT^%ZVEMKT(ref) +"RTN","TMGNDF3B",374,0) + +"RTN","TMGNDF3B",375,0) + set ref="^TMP(""VPE"",""SELECT"","_$J_")" +"RTN","TMGNDF3B",376,0) + new number set number="" +"RTN","TMGNDF3B",377,0) + for set number=$order(@ref@(number)) quit:(number="") do +"RTN","TMGNDF3B",378,0) + . new ReturnValue set ReturnValue=$piece(@ref@(number),$char(9),1) +"RTN","TMGNDF3B",379,0) + . new drugName set drugName=$piece(ReturnValue,"^",1) +"RTN","TMGNDF3B",380,0) + . new IEN set IEN=$piece(ReturnValue,"^",2) +"RTN","TMGNDF3B",381,0) + . set @pSelList@(drugName,IEN)="" +"RTN","TMGNDF3B",382,0) + +"RTN","TMGNDF3B",383,0) + quit +"RTN","TMGNDF3B",384,0) + +"RTN","TMGNDF3B",385,0) + +"RTN","TMGNDF3B",386,0) +DoWeed(pList,pDelList) +"RTN","TMGNDF3B",387,0) + ;"Purpose: To remove all items in pDelList from pList +"RTN","TMGNDF3B",388,0) + ;"Input: pList -- PASS BY NAME-- list of drugs to be edited, as created by FillList(pList) +"RTN","TMGNDF3B",389,0) + ;" format: @pList@(-1)=ItemsCount <-- REMOVED +"RTN","TMGNDF3B",390,0) + ;" @pList@(DrugName,IEN)="" +"RTN","TMGNDF3B",391,0) + ;" @pList@(DrugName,IEN)="" +"RTN","TMGNDF3B",392,0) + ;" pDelList -- PASS BY NAME -- list of drugs to be removed, as created by UsrWeedList +"RTN","TMGNDF3B",393,0) + ;" format: @pDelList@(DrugName,IEN)="" +"RTN","TMGNDF3B",394,0) + ;" @pDelList@(DrugName,IEN)="" +"RTN","TMGNDF3B",395,0) + +"RTN","TMGNDF3B",396,0) + new % set %=2 +"RTN","TMGNDF3B",397,0) + if '$data(pDelList) goto DWDone +"RTN","TMGNDF3B",398,0) + +"RTN","TMGNDF3B",399,0) + write "Setting selected imports to be SKIPPED... " +"RTN","TMGNDF3B",400,0) + new drugName +"RTN","TMGNDF3B",401,0) + set drugName=$order(@pDelList@(0)) +"RTN","TMGNDF3B",402,0) + if drugName'="" for do quit:(drugName="") +"RTN","TMGNDF3B",403,0) + . new IEN set IEN=$order(@pDelList@(drugName,0)) +"RTN","TMGNDF3B",404,0) + . if IEN'="" for do quit:(IEN="") +"RTN","TMGNDF3B",405,0) + . . kill @pList@(drugName,IEN) +"RTN","TMGNDF3B",406,0) + . . set IEN=$order(@pDelList@(drugName,IEN)) +"RTN","TMGNDF3B",407,0) + . set drugName=$order(@pDelList@(drugName)) +"RTN","TMGNDF3B",408,0) + +"RTN","TMGNDF3B",409,0) + ;"write "Counting drugs in list... " +"RTN","TMGNDF3B",410,0) + ;"set @pList@(-1)=$$ListCt^TMGMISC(pList)-1 ;"remove count of ItemsCount node +"RTN","TMGNDF3B",411,0) + +"RTN","TMGNDF3B",412,0) +DWDone +"RTN","TMGNDF3B",413,0) + quit +"RTN","TMGNDF3B",414,0) + +"RTN","TMGNDF3B",415,0) + +"RTN","TMGNDF3B",416,0) +GetInfo(IEN,array) +"RTN","TMGNDF3B",417,0) + ;"Purpose: to get all the associated names linked to a DRUG file entry +"RTN","TMGNDF3B",418,0) + ;"Input: IEN -- the IEN in file 22706.9 +"RTN","TMGNDF3B",419,0) + ;" array -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF3B",420,0) + ;" array("DRUG NAME",Name)="" NAME (.04) FROM 22706.9 +"RTN","TMGNDF3B",421,0) + ;" array("VAP NAME",Name)="" Name from VA PRODUCT file +"RTN","TMGNDF3B",422,0) + ;" array("FDA IMPORT NAME",Names)="" Name from .05 TRADE NAME IN 22706.9 +"RTN","TMGNDF3B",423,0) + ;" array("VA GENERIC NAME",Name)="" Name from VA GENERIC file +"RTN","TMGNDF3B",424,0) + ;" array("MODES",1)="DRUG NAME" +"RTN","TMGNDF3B",425,0) + ;" array("MODES",2)="VAP NAME" +"RTN","TMGNDF3B",426,0) + ;" array("MODES",3)="FDA IMPORT NAME" +"RTN","TMGNDF3B",427,0) + ;" array("MODES",4)="VA GENERIC NAME" +"RTN","TMGNDF3B",428,0) + ;"results: none +"RTN","TMGNDF3B",429,0) + +"RTN","TMGNDF3B",430,0) + new showName +"RTN","TMGNDF3B",431,0) + kill array +"RTN","TMGNDF3B",432,0) + +"RTN","TMGNDF3B",433,0) + set array("MODES",1)="DRUG NAME" +"RTN","TMGNDF3B",434,0) + set array("MODES",2)="VAP NAME" +"RTN","TMGNDF3B",435,0) + set array("MODES",3)="FDA IMPORT NAME" +"RTN","TMGNDF3B",436,0) + set array("MODES",4)="VA GENERIC NAME" +"RTN","TMGNDF3B",437,0) + +"RTN","TMGNDF3B",438,0) + ;"new vapIEN set vapIEN=+$piece($get(^PSDRUG(IEN,"ND")),"^",3) +"RTN","TMGNDF3B",439,0) + new vapIEN set vapIEN=+$piece($get(^TMG(22706.9,IEN,6)),"^",2) +"RTN","TMGNDF3B",440,0) + if vapIEN'=0 do +"RTN","TMGNDF3B",441,0) + . set showName=$piece($get(^PSNDF(50.68,vapIEN,0)),"^",1) +"RTN","TMGNDF3B",442,0) + . set:(showName'="") array("VAP NAME",showName)="" +"RTN","TMGNDF3B",443,0) + . . else if mode=3 do ;"Display by FDA import name +"RTN","TMGNDF3B",444,0) + +"RTN","TMGNDF3B",445,0) + ;"new vagIEN set vagIEN=+$piece($get(^PSNDF(50.68,vapIEN,0)),"^",2) +"RTN","TMGNDF3B",446,0) + new vagIEN set vagIEN=+$piece($get(^TMG(22706.9,IEN,1)),"^",3) +"RTN","TMGNDF3B",447,0) + if vagIEN'=0 do +"RTN","TMGNDF3B",448,0) + . set showName=$piece($get(^PSNDF(50.6,vagIEN,0)),"^",1) +"RTN","TMGNDF3B",449,0) + . set:(showName'="") array("VA GENERIC NAME",showName)="" +"RTN","TMGNDF3B",450,0) + +"RTN","TMGNDF3B",451,0) + ;"set showName=$piece($get(^PSDRUG(IEN,0)),"^",1) +"RTN","TMGNDF3B",452,0) + set showName=$piece($get(^TMG(22706.9,IEN,7)),"^",6) ;"7;6 = LONG NAME +"RTN","TMGNDF3B",453,0) + set:(showName'="") array("DRUG NAME",showName)="" +"RTN","TMGNDF3B",454,0) + +"RTN","TMGNDF3B",455,0) + set showName=$piece($get(^TMG(22706.9,IEN,0)),"^",4) ;"0;4 = TRADENAME +"RTN","TMGNDF3B",456,0) + set:(showName'="") array("FDA IMPORT NAME",showName)="" +"RTN","TMGNDF3B",457,0) + +"RTN","TMGNDF3B",458,0) + quit +"RTN","TMGNDF3B",459,0) + +"RTN","TMGNDF3B",460,0) + +"RTN","TMGNDF3B",461,0) + +"RTN","TMGNDF3B",462,0) + +"RTN","TMGNDF3C") +0^50^B5446 +"RTN","TMGNDF3C",1,0) +TMGNDF3C ;TMG/kst/FDA Import: Create DRUG entries ;03/25/06 +"RTN","TMGNDF3C",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF3C",3,0) + +"RTN","TMGNDF3C",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF3C",5,0) + ;" Creation of records in file 50 (DRUG file) +"RTN","TMGNDF3C",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF3C",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF3C",8,0) + ;"11-21-2006 +"RTN","TMGNDF3C",9,0) + +"RTN","TMGNDF3C",10,0) + ;"======================================================================= +"RTN","TMGNDF3C",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF3C",12,0) + ;"======================================================================= +"RTN","TMGNDF3C",13,0) + ;"Menu +"RTN","TMGNDF3C",14,0) + +"RTN","TMGNDF3C",15,0) + ;"Refresh1(IEN22706d9,Option) -- Refresh one drug from 22706.9 +"RTN","TMGNDF3C",16,0) + ;"RefreshBatch(IENArray,Option) -- Refres batch entries in 22706.9 +"RTN","TMGNDF3C",17,0) + +"RTN","TMGNDF3C",18,0) + ;"======================================================================= +"RTN","TMGNDF3C",19,0) + ;" Private Functions. +"RTN","TMGNDF3C",20,0) + ;"======================================================================= +"RTN","TMGNDF3C",21,0) + ;"RefreshNonSkips -- Refresh all non-skipped records in 22706.9 +"RTN","TMGNDF3C",22,0) + ;"GetAddList(List): get list of entries in VA PRODUCT (50.68) not having corresponding entry in DRUG file (50) +"RTN","TMGNDF3C",23,0) + ;"EnsureFromList(List) -- Add to DRUG file (50) from TMG FDA IMPORT COMPILED +"RTN","TMGNDF3C",24,0) + ;"Update50(IEN50,DrugInfo,Option) -- refresh info in DRUG (50) file, or add if it doesn't exist (or delete if needed) +"RTN","TMGNDF3C",25,0) + ;"GetTMGDrugInfo(fdaIEN,DrugInfo) -- Create a very abbreviated version of the DrugInfo array +"RTN","TMGNDF3C",26,0) + ;"Stuff50(IEN50,DrugInfo,Option) -- synch record(s) in the DRUG file, based on entry from VA PRODUCT file +"RTN","TMGNDF3C",27,0) + ;"SetupFDA(DrugInfo,IENS,TMGFDA) -- setup FDA for data for record in DRUG file +"RTN","TMGNDF3C",28,0) + ;"AddMsg(IEN50,Msg) -- Add a message in the Activity log field +"RTN","TMGNDF3C",29,0) + +"RTN","TMGNDF3C",30,0) + ;"======================================================================= +"RTN","TMGNDF3C",31,0) + ;"======================================================================= +"RTN","TMGNDF3C",32,0) + ;"NOTE: Data mapping: +"RTN","TMGNDF3C",33,0) + ;" File 50, .01 field (name) is filled with data from file 22706.9, from on +"RTN","TMGNDF3C",34,0) + ;" of two possible fields: +"RTN","TMGNDF3C",35,0) + ;" If entry in 50 represents a GENERICNAME drug, then .01 <--- .076 +"RTN","TMGNDF3C",36,0) + ;" If entry in 50 represents a TRADENAME drug, then .01 <--- .056 +"RTN","TMGNDF3C",37,0) + ;"======================================================================= +"RTN","TMGNDF3C",38,0) + ;"======================================================================= +"RTN","TMGNDF3C",39,0) + ;"Q: Where is BatchTo50 (i.e. 50.68-->50)?? +"RTN","TMGNDF3C",40,0) + ;"A: There are many entries in 50.68 that I don't want put into 50, so I need +"RTN","TMGNDF3C",41,0) + ;" to do this: 22706.9 --> 50.68 +"RTN","TMGNDF3C",42,0) + ;" 22706.9 --> 50 +"RTN","TMGNDF3C",43,0) + ;" instead of this: 22706.9 --> 50.68 --> 50 +"RTN","TMGNDF3C",44,0) + ;"======================================================================= +"RTN","TMGNDF3C",45,0) +Menu +"RTN","TMGNDF3C",46,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF3C",47,0) + +"RTN","TMGNDF3C",48,0) + new Menu,UsrSlct +"RTN","TMGNDF3C",49,0) + set Menu(0)="Pick Option for Synchronizing Imports Data to file 50 (3C)" +"RTN","TMGNDF3C",50,0) + set Menu(1)="Synchronize DRUG file with import data"_$char(9)_"RefreshNonSkips" +"RTN","TMGNDF3C",51,0) + set Menu(2)="Verify Synchronization"_$char(9)_"VerifySync" +"RTN","TMGNDF3C",52,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF3C",53,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF3C",54,0) + +"RTN","TMGNDF3C",55,0) +MC1 write # +"RTN","TMGNDF3C",56,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF3C",57,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF3C",58,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF3C",59,0) + +"RTN","TMGNDF3C",60,0) + if UsrSlct="RefreshNonSkips" do RefreshNonSkips goto MC1 +"RTN","TMGNDF3C",61,0) + if UsrSlct="VerifySync" do VerifySync goto MC1 +"RTN","TMGNDF3C",62,0) + if UsrSlct="Prev" goto Menu^TMGNDF3A ;"quit can occur from there... +"RTN","TMGNDF3C",63,0) + if UsrSlct="Next" goto Menu^TMGNDF3D ;"quit can occur from there... +"RTN","TMGNDF3C",64,0) + goto MC1 +"RTN","TMGNDF3C",65,0) + +"RTN","TMGNDF3C",66,0) +MCDone +"RTN","TMGNDF3C",67,0) + quit +"RTN","TMGNDF3C",68,0) + +"RTN","TMGNDF3C",69,0) + +"RTN","TMGNDF3C",70,0) +RefreshNonSkips +"RTN","TMGNDF3C",71,0) + ;"Purpose: To work on ALL records in 22706.9 that are not marked to be +"RTN","TMGNDF3C",72,0) + ;" skipped, and ensure that all is refreshed appropriately +"RTN","TMGNDF3C",73,0) + +"RTN","TMGNDF3C",74,0) + new tempList +"RTN","TMGNDF3C",75,0) + +"RTN","TMGNDF3C",76,0) + new AddCt,OKCt +"RTN","TMGNDF3C",77,0) + set AddCt=0,OKCt=0 +"RTN","TMGNDF3C",78,0) + new Itr,IEN +"RTN","TMGNDF3C",79,0) + new abort set abort=0 +"RTN","TMGNDF3C",80,0) + write !,"Gathering list of imports to use (those not marked to be skipped)...",! +"RTN","TMGNDF3C",81,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3C",82,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF3C",83,0) + if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF3C",84,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3C",85,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3C",86,0) + . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF3C",87,0) + . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF3C",88,0) + . set tempList(IEN22706d9)="" +"RTN","TMGNDF3C",89,0) + . if (tIEN50>0)&(gIEN50>0) set OKCt=OKCt+1 +"RTN","TMGNDF3C",90,0) + . else set AddCt=AddCt+1 +"RTN","TMGNDF3C",91,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3C",92,0) + +"RTN","TMGNDF3C",93,0) + write !,AddCt," items may be added to DRUG file (if appropriate).",! +"RTN","TMGNDF3C",94,0) + write OKCt," items will be refreshed in DRUG file.",! +"RTN","TMGNDF3C",95,0) + +"RTN","TMGNDF3C",96,0) + new % set %=1 +"RTN","TMGNDF3C",97,0) + write "Proceed" do YN^DICN write ! +"RTN","TMGNDF3C",98,0) + if %'=1 goto RNSDone +"RTN","TMGNDF3C",99,0) + +"RTN","TMGNDF3C",100,0) + do EnsureFromList(.tempList) +"RTN","TMGNDF3C",101,0) + +"RTN","TMGNDF3C",102,0) +RNSDone +"RTN","TMGNDF3C",103,0) + quit +"RTN","TMGNDF3C",104,0) + +"RTN","TMGNDF3C",105,0) +RefreshBatch(IENArray,Option) +"RTN","TMGNDF3C",106,0) + ;"Purpose: To take entries in 22706.9 and refresh them +"RTN","TMGNDF3C",107,0) + ;"Input: IENArray -- PASS BY REFERENCE. Array of IENs from 22706.9 +"RTN","TMGNDF3C",108,0) + ;" IENArray(IEN22706d9)="" +"RTN","TMGNDF3C",109,0) + ;" IENArray(IEN22706d9)="" +"RTN","TMGNDF3C",110,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF3C",111,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF3C",112,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF3C",113,0) + ;" Option("QUIET")=1 +"RTN","TMGNDF3C",114,0) + +"RTN","TMGNDF3C",115,0) + ;"Results: none +"RTN","TMGNDF3C",116,0) + +"RTN","TMGNDF3C",117,0) + new IEN22706d9,Itr +"RTN","TMGNDF3C",118,0) + new abort set abort=0 +"RTN","TMGNDF3C",119,0) + set IEN22706d9=$$ItrAInit^TMGITR("IENArray",.Itr) +"RTN","TMGNDF3C",120,0) + do PrepProgress^TMGITR(.Itr,1,1,"IEN22706d9") +"RTN","TMGNDF3C",121,0) + if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN22706d9)="")!abort +"RTN","TMGNDF3C",122,0) + . ;"write !,"Refreshing compiled entry #",IEN227606d9,! +"RTN","TMGNDF3C",123,0) + . do Refresh1(IEN22706d9,.Option) +"RTN","TMGNDF3C",124,0) + quit +"RTN","TMGNDF3C",125,0) + +"RTN","TMGNDF3C",126,0) + +"RTN","TMGNDF3C",127,0) +Refresh1(IEN22706d9,Option) +"RTN","TMGNDF3C",128,0) + ;"Purpose: To take one entry in 22706.9 and refresh it +"RTN","TMGNDF3C",129,0) + ;"Input: IEN22706d9 -- IEN from 22706.9 +"RTN","TMGNDF3C",130,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF3C",131,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF3C",132,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF3C",133,0) + ;"Results: none +"RTN","TMGNDF3C",134,0) + +"RTN","TMGNDF3C",135,0) + new gIEN50,tIEN50 +"RTN","TMGNDF3C",136,0) + new skip +"RTN","TMGNDF3C",137,0) + set skip=($piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1) +"RTN","TMGNDF3C",138,0) + +"RTN","TMGNDF3C",139,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF3C",140,0) + . new temp +"RTN","TMGNDF3C",141,0) + . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF3C",142,0) + . set Option("IEN50","TRADE")=tIEN50 +"RTN","TMGNDF3C",143,0) + . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF3C",144,0) + . set Option("IEN50","GENERIC")=gIEN50 +"RTN","TMGNDF3C",145,0) + . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9 +"RTN","TMGNDF3C",146,0) + +"RTN","TMGNDF3C",147,0) + new List +"RTN","TMGNDF3C",148,0) + if skip set List(IEN22706d9)="S" +"RTN","TMGNDF3C",149,0) + else set List(IEN22706d9)="" +"RTN","TMGNDF3C",150,0) + +"RTN","TMGNDF3C",151,0) + do EnsureFromList(.List,.Option) +"RTN","TMGNDF3C",152,0) + +"RTN","TMGNDF3C",153,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF3C",154,0) + . if tIEN50>0 set temp=$$Fix1Drug^TMGNDF3D(tIEN50,IEN22706d9) +"RTN","TMGNDF3C",155,0) + . if gIEN50>0 set temp=$$Fix1Drug^TMGNDF3D(gIEN50,IEN22706d9) +"RTN","TMGNDF3C",156,0) + +"RTN","TMGNDF3C",157,0) + quit +"RTN","TMGNDF3C",158,0) + +"RTN","TMGNDF3C",159,0) + +"RTN","TMGNDF3C",160,0) +EnsureFromList(List,Option) +"RTN","TMGNDF3C",161,0) + ;"Purpose: to add entries to, or refresh fields in, DRUG file (50) based on +"RTN","TMGNDF3C",162,0) + ;" data from TMG FDA IMPORT COMPILED (22706.9), +"RTN","TMGNDF3C",163,0) + ;" OR to ensure that the linked records are properly refreshed. +"RTN","TMGNDF3C",164,0) + ;" OR ensure that records liked from a skipped record are deleted +"RTN","TMGNDF3C",165,0) + ;"Input: List -- PASS BY REFERENCE, format: +"RTN","TMGNDF3C",166,0) + ;" List(IEN22706d9)="" +"RTN","TMGNDF3C",167,0) + ;" List(IEN22706d9)="" +"RTN","TMGNDF3C",168,0) + ;" List(IEN22706d9)="S" <-- record now skipped, so ensure linked records are removed +"RTN","TMGNDF3C",169,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF3C",170,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF3C",171,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF3C",172,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF3C",173,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF3C",174,0) + ;"Results: none +"RTN","TMGNDF3C",175,0) + +"RTN","TMGNDF3C",176,0) + new IEN22706d9,Itr +"RTN","TMGNDF3C",177,0) + new error set error=0 +"RTN","TMGNDF3C",178,0) + new abort set abort=0 +"RTN","TMGNDF3C",179,0) + new ChangeCt set ChangeCt=0 +"RTN","TMGNDF3C",180,0) + new quiet set quiet=($get(Option("QUIET"))=1) +"RTN","TMGNDF3C",181,0) + do Unlock50^TMGNDFUT +"RTN","TMGNDF3C",182,0) + +"RTN","TMGNDF3C",183,0) + if 'quiet write "Scanning import file, to ensure all records in DRUG file are updated...",! +"RTN","TMGNDF3C",184,0) + set IEN22706d9=$$ItrAInit^TMGITR("List",.Itr) +"RTN","TMGNDF3C",185,0) + if 'quiet do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF3C",186,0) + if IEN22706d9>0 for do quit:($$ItrANext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF3C",187,0) + . new DrugInfo,ndcIEN,tempS,error,temp,vapIEN,temp +"RTN","TMGNDF3C",188,0) + . new skip set skip=($get(List(IEN22706d9))="S") +"RTN","TMGNDF3C",189,0) + . set error=0,temp=0,tempS="" +"RTN","TMGNDF3C",190,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3C",191,0) + . set vapIEN=+$piece($get(^TMG(22706.9,IEN22706d9,6)),"^",2) +"RTN","TMGNDF3C",192,0) + . if skip=0,vapIEN>0,$data(^PSNDF(50.68,vapIEN))=0 do +"RTN","TMGNDF3C",193,0) + . . if 'quiet write "Pointer to VA PRODUCT from File 22709.9, IEN# ",IEN22706d9," is invalid. Will delete.",! +"RTN","TMGNDF3C",194,0) + . . set vapIEN=0 +"RTN","TMGNDF3C",195,0) + . . new TMGMSG,TMGFDA +"RTN","TMGNDF3C",196,0) + . . set TMGFDA(22706.9,fdaIEN_",",5.5)="@" +"RTN","TMGNDF3C",197,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3C",198,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) ;"show errors, even if quiet +"RTN","TMGNDF3C",199,0) + . if skip=0,vapIEN'>0 set error=1 quit +"RTN","TMGNDF3C",200,0) + . set temp=$$GetTMGDrugInfo(IEN22706d9,.DrugInfo) +"RTN","TMGNDF3C",201,0) + . if skip=0,temp=0 set error=1 quit +"RTN","TMGNDF3C",202,0) + . if skip=1 set Option("DELETING")=1 +"RTN","TMGNDF3C",203,0) + . ;"--- work on Trade Name link --- +"RTN","TMGNDF3C",204,0) + . if ($get(DrugInfo("NAME","TRADE"))=$get(DrugInfo("NAME","GENERIC"))) set DrugInfo("NAME","TRADE")="" +"RTN","TMGNDF3C",205,0) + . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) ;"DRUG TRADENAME LINK +"RTN","TMGNDF3C",206,0) + . set Option("CUR MODE")="TRADE" +"RTN","TMGNDF3C",207,0) + . set temp=$$Update50(tIEN50,.DrugInfo,.Option) ;"may chain forward +"RTN","TMGNDF3C",208,0) + . if temp=1 set ChangeCt=ChangeCt+1 +"RTN","TMGNDF3C",209,0) + . else if temp=-1 set error=1 ;"quit +"RTN","TMGNDF3C",210,0) + . ;"--- work on Generic Name link --- +"RTN","TMGNDF3C",211,0) + . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) ;"DRUG GENERIC LINK +"RTN","TMGNDF3C",212,0) + . if gIEN50=tIEN50 set gIEN50=0 +"RTN","TMGNDF3C",213,0) + . set Option("CUR MODE")="GENERIC" +"RTN","TMGNDF3C",214,0) + . set temp=$$Update50(gIEN50,.DrugInfo,.Option) ;"may chain forward +"RTN","TMGNDF3C",215,0) + . if temp=1 set ChangeCt=ChangeCt+1 +"RTN","TMGNDF3C",216,0) + . else if temp=-1 set error=1 ;"quit +"RTN","TMGNDF3C",217,0) + if error write "Error with import : IEN22706d9=",IEN22706d9,! +"RTN","TMGNDF3C",218,0) + +"RTN","TMGNDF3C",219,0) + if 'quiet do +"RTN","TMGNDF3C",220,0) + . write ChangeCt," Records Modified.",! +"RTN","TMGNDF3C",221,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF3C",222,0) + +"RTN","TMGNDF3C",223,0) + do Unlock50^TMGNDFUT +"RTN","TMGNDF3C",224,0) + quit +"RTN","TMGNDF3C",225,0) + +"RTN","TMGNDF3C",226,0) + +"RTN","TMGNDF3C",227,0) +GetTMGDrugInfo(IEN22706d9,DrugInfo) +"RTN","TMGNDF3C",228,0) + ;"Purpose: Create a very abbreviated version of the DrugInfo array +"RTN","TMGNDF3C",229,0) + ;" This is because calling GetDrugInfo^TMGNDF1A is unneccesarily SLOW +"RTN","TMGNDF3C",230,0) + ;" Also, it makes one dependant on FDA primary files. +"RTN","TMGNDF3C",231,0) + ;"Input: IEN22706d9 -- IEN in file 22706.9 +"RTN","TMGNDF3C",232,0) + ;" DrugInfo -- PASS BY REFERENCE. Format: +"RTN","TMGNDF3C",233,0) + ;" DrugInfo("NDC") +"RTN","TMGNDF3C",234,0) + ;"Output: DrugInfo("NAME","TRADE")=.056 field +"RTN","TMGNDF3C",235,0) + ;" DrugInfo("NAME","GENERIC")=.076 field +"RTN","TMGNDF3C",236,0) + ;" DrugInfo("SOURCE IEN")=source IEN in 22706.9 +"RTN","TMGNDF3C",237,0) + ;" DrugInfo("IEN 50.68")=field 5.5, a pointer to 50.68 (VA PRODUCT) +"RTN","TMGNDF3C",238,0) + ;"Results: 1=OK to continue, 0=error +"RTN","TMGNDF3C",239,0) + ;"NOTE: 11/5/07 Modifying to make use of fields .055 and .075, where name is +"RTN","TMGNDF3C",240,0) + ;" prepaired and stored in a previous step. +"RTN","TMGNDF3C",241,0) + ;"NOTE: 11/10/07 Modifying to make use of fields .056 and .076, where name is +"RTN","TMGNDF3C",242,0) + ;" prepaired and stored in a previous step. +"RTN","TMGNDF3C",243,0) + +"RTN","TMGNDF3C",244,0) + kill DrugInfo +"RTN","TMGNDF3C",245,0) + new result set result=1 +"RTN","TMGNDF3C",246,0) + set DrugInfo("NDC")=$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",1) +"RTN","TMGNDF3C",247,0) + if DrugInfo("NDC")="" set result=0 +"RTN","TMGNDF3C",248,0) + +"RTN","TMGNDF3C",249,0) + set DrugInfo("SOURCE IEN")=IEN22706d9 +"RTN","TMGNDF3C",250,0) + set DrugInfo("IEN 50.68")=+$piece($get(^TMG(22706.9,IEN22706d9,6)),"^",2) +"RTN","TMGNDF3C",251,0) + +"RTN","TMGNDF3C",252,0) + new tempS set tempS=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",1) ;".056 TRADENAME FORM DOSE UNIT - 40 +"RTN","TMGNDF3C",253,0) + if tempS'="" set DrugInfo("NAME","TRADE")=tempS +"RTN","TMGNDF3C",254,0) + +"RTN","TMGNDF3C",255,0) + new tempS set tempS=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",2) ;".076 GENERICNAME FORM DOSE UNT - 40 +"RTN","TMGNDF3C",256,0) + if tempS'="" set DrugInfo("NAME","GENERIC")=tempS +"RTN","TMGNDF3C",257,0) + +"RTN","TMGNDF3C",258,0) +GDIDone +"RTN","TMGNDF3C",259,0) + quit result +"RTN","TMGNDF3C",260,0) + +"RTN","TMGNDF3C",261,0) + +"RTN","TMGNDF3C",262,0) +Update50(IEN50,DrugInfo,Option) +"RTN","TMGNDF3C",263,0) + ;"Purpose: to refresh info in DRUG file, or add if it doesn't exist (or delete if needed) +"RTN","TMGNDF3C",264,0) + ;"Input: IEN50: Target IEN to refresh, or 0 if needs to be added +"RTN","TMGNDF3C",265,0) + ;" DrugInfo -- PASS BY REFERENCE. Format: +"RTN","TMGNDF3C",266,0) + ;" DrugInfo("NDC") +"RTN","TMGNDF3C",267,0) + ;" DrugInfo("NAME","TRADE")=.056 field +"RTN","TMGNDF3C",268,0) + ;" DrugInfo("NAME","GENERIC")=.076 field +"RTN","TMGNDF3C",269,0) + ;" DrugInfo("SOURCE IEN")=source IEN in 22706.9 +"RTN","TMGNDF3C",270,0) + ;" DrugInfo("IEN 50.68")=field 5.5, a pointer to 50.68 (VA PRODUCT) +"RTN","TMGNDF3C",271,0) + ;" Option -- NON-OPTIONAL part. Format: +"RTN","TMGNDF3C",272,0) + ;" Option("CUR MODE")="TRADE" +"RTN","TMGNDF3C",273,0) + ;" Option -- OPTIONAL part. Format: +"RTN","TMGNDF3C",274,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF3C",275,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF3C",276,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF3C",277,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF3C",278,0) + ;" Option("DELETING")=1 <-- deleting chain (not IEN22706d9) +"RTN","TMGNDF3C",279,0) + ;"Result: -1 = error, 0=info refreshed, 1=record added. +"RTN","TMGNDF3C",280,0) + +"RTN","TMGNDF3C",281,0) + new result set result=0 +"RTN","TMGNDF3C",282,0) + new quiet set quiet=$get(Option("QUIET"))=1 +"RTN","TMGNDF3C",283,0) + new IEN22706d9 set IEN22706d9=+$get(DrugInfo("SOURCE IEN")) +"RTN","TMGNDF3C",284,0) + new mode set mode=$get(Option("CUR MODE")) +"RTN","TMGNDF3C",285,0) + if (mode'="TRADE")&(mode'="GENERIC") set result=-1 goto UDDone +"RTN","TMGNDF3C",286,0) + +"RTN","TMGNDF3C",287,0) + new StoreField,node,pce +"RTN","TMGNDF3C",288,0) + if mode="TRADE" set StoreField=5.6,node=7,pce=1 +"RTN","TMGNDF3C",289,0) + else set StoreField=5.7,node=7,pce=2 +"RTN","TMGNDF3C",290,0) + +"RTN","TMGNDF3C",291,0) + new drugName set drugName=$get(DrugInfo("NAME",mode)) +"RTN","TMGNDF3C",292,0) + set DrugInfo("NAME",mode)=drugName +"RTN","TMGNDF3C",293,0) + if (drugName="")!(drugName="")!($get(Option("DELETING"))=1) do goto UDDone +"RTN","TMGNDF3C",294,0) + . do Kill50^TMGNDFUT(IEN50,IEN22706d9,mode,quiet) ;"is OK if IEN50=0 +"RTN","TMGNDF3C",295,0) + . set result=-1 +"RTN","TMGNDF3C",296,0) + +"RTN","TMGNDF3C",297,0) + if (IEN50>0),$data(^PSDRUG(IEN50))=0 do +"RTN","TMGNDF3C",298,0) + . set IEN50=0 ;"I found case of dangling pointer +"RTN","TMGNDF3C",299,0) + +"RTN","TMGNDF3C",300,0) + if IEN50=0 do ;"Create stub entry with drug name in .01 field +"RTN","TMGNDF3C",301,0) + . new PSSZ set PSSZ=1 ;"allows code to add entries into DRUG file. +"RTN","TMGNDF3C",302,0) + . new TMGFDA,TMGMSG,TMGIEN,IENS +"RTN","TMGNDF3C",303,0) + . set TMGFDA(50,"+1,",.01)=drugName +"RTN","TMGNDF3C",304,0) + . do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF3C",305,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3C",306,0) + . set IEN50=+$get(TMGIEN(1)) if IEN50=0 quit +"RTN","TMGNDF3C",307,0) + . do AddMsg(IEN50,"TMG AUTOADDED FROM FDA") +"RTN","TMGNDF3C",308,0) + . set Option("IEN50",mode)=IEN50 +"RTN","TMGNDF3C",309,0) + . set Option("IEN50",mode,"NAME")=drugName +"RTN","TMGNDF3C",310,0) + +"RTN","TMGNDF3C",311,0) + set DrugInfo("CUR MODE")=mode +"RTN","TMGNDF3C",312,0) + set temp=$$Stuff50(IEN50,.DrugInfo,.Option) ;"no chain forward +"RTN","TMGNDF3C",313,0) + if temp=0 set result=-1 +"RTN","TMGNDF3C",314,0) + if temp=2 set result=1 +"RTN","TMGNDF3C",315,0) + +"RTN","TMGNDF3C",316,0) + ;"Ensure pointer to DRUG (50) is stored in 22706.9 +"RTN","TMGNDF3C",317,0) + if $piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce)'=IEN50 do +"RTN","TMGNDF3C",318,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3C",319,0) + . set TMGFDA(22706.9,IEN22706d9_",",StoreField)=IEN50 +"RTN","TMGNDF3C",320,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3C",321,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3C",322,0) + . set Option("IEN50",mode)=IEN50 +"RTN","TMGNDF3C",323,0) + +"RTN","TMGNDF3C",324,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF3C",325,0) + . new temp set temp=$$POIFromTMG^TMGNDF4A(IEN22706d9,.Option) ;" --> more chain from here +"RTN","TMGNDF3C",326,0) + . ;"if $get(Option("DELETING"))=1 do +"RTN","TMGNDF3C",327,0) + . ;". do Kill50^TMGNDFUT(IEN50,IEN22706d9,mode,quiet) ;"is OK if IEN50=0 +"RTN","TMGNDF3C",328,0) + +"RTN","TMGNDF3C",329,0) +UDDone +"RTN","TMGNDF3C",330,0) + quit result +"RTN","TMGNDF3C",331,0) + +"RTN","TMGNDF3C",332,0) + +"RTN","TMGNDF3C",333,0) +Stuff50(IEN50,DrugInfo,Option) +"RTN","TMGNDF3C",334,0) + ;"Purpose: To synch record(s) in the DRUG file +"RTN","TMGNDF3C",335,0) + ;"Input: IEN50 -- IEN of record in file 50 to update +"RTN","TMGNDF3C",336,0) + ;" DrugInfo -- PASS BY REFERENCE -- Drug info array. Format: +"RTN","TMGNDF3C",337,0) + ;" DrugInfo("NAME","GENERIC")=e.g. NAME: DILTIAZEM 240MG +"RTN","TMGNDF3C",338,0) + ;" DrugInfo("NAME","TRADE")=e.g. NAME: CARDIZEM CD 240MG +"RTN","TMGNDF3C",339,0) + ;" DrugInfo("NDC") +"RTN","TMGNDF3C",340,0) + ;" DrugInfo("SOURCE IEN")=source IEN in 22706.9 +"RTN","TMGNDF3C",341,0) + ;" DrugInfo("IEN 50.68")=field 5.5, a pointer to 50.68 (VA PRODUCT) +"RTN","TMGNDF3C",342,0) + ;" Option -- NON-OPTIONAL part. Format: +"RTN","TMGNDF3C",343,0) + ;" Option("CUR MODE")="TRADE" +"RTN","TMGNDF3C",344,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF3C",345,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF3C",346,0) + ;" to file 50, POI, OI, OQV etc. +"RTN","TMGNDF3C",347,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF3C",348,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF3C",349,0) + ;"Output: A record will be added to file DRUG (50) +"RTN","TMGNDF3C",350,0) + ;"Result: 1=OK to continue, 2=change made, 0 if error +"RTN","TMGNDF3C",351,0) + +"RTN","TMGNDF3C",352,0) + ;"Note: must set PSSZ=1 to be allowed to enter entries into DRUG file. +"RTN","TMGNDF3C",353,0) + +"RTN","TMGNDF3C",354,0) + new result set result=1 ;"default to success -- don't change. +"RTN","TMGNDF3C",355,0) + new PSSZ set PSSZ=1 ;"allows code to add entries into DRUG file. +"RTN","TMGNDF3C",356,0) + +"RTN","TMGNDF3C",357,0) + ;"Remove any synonyms +"RTN","TMGNDF3C",358,0) +RF1 new numSyns +"RTN","TMGNDF3C",359,0) + for do quit:(numSyns'>0) +"RTN","TMGNDF3C",360,0) + . set numSyns=+$piece($get(^PSDRUG(IEN50,1,0)),"^",4) ;"number of records +"RTN","TMGNDF3C",361,0) + . if numSyns=0 quit +"RTN","TMGNDF3C",362,0) +RF2 . set subIEN=$order(^PSDRUG(IEN50,1,0)) +"RTN","TMGNDF3C",363,0) + . if (subIEN'>0) set numSyns=0 quit +"RTN","TMGNDF3C",364,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3C",365,0) + . set TMGFDA(50.1,subIEN_","_IEN50_",",.01)="@" +"RTN","TMGNDF3C",366,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3C",367,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3C",368,0) + . set result=2 +"RTN","TMGNDF3C",369,0) + +"RTN","TMGNDF3C",370,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF3C",371,0) + +"RTN","TMGNDF3C",372,0) + set result=$$SetupFDA(.DrugInfo,IEN50_",",.TMGFDA) +"RTN","TMGNDF3C",373,0) + if result=0 goto RFDone +"RTN","TMGNDF3C",374,0) + new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF3C",375,0) + if $data(TMGFDA)=0 goto RFDone +"RTN","TMGNDF3C",376,0) + +"RTN","TMGNDF3C",377,0) + do FILE^DIE("KS","TMGFDA","TMGMSG") +"RTN","TMGNDF3C",378,0) + if $data(TMGMSG("DIERR")) do goto RFDone +"RTN","TMGNDF3C",379,0) + . set result=0 +"RTN","TMGNDF3C",380,0) + . if $get(Quiet)=1 quit +"RTN","TMGNDF3C",381,0) + . write !,"Error editing record in file 50",! +"RTN","TMGNDF3C",382,0) + . new PriorErrorFound +"RTN","TMGNDF3C",383,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF3C",384,0) + +"RTN","TMGNDF3C",385,0) + do AddMsg(IEN50,"TMG AUTO UPDATED FROM FDA") +"RTN","TMGNDF3C",386,0) + set result=2 ;"update made. +"RTN","TMGNDF3C",387,0) + +"RTN","TMGNDF3C",388,0) +RFDone quit result +"RTN","TMGNDF3C",389,0) + +"RTN","TMGNDF3C",390,0) + +"RTN","TMGNDF3C",391,0) +AddMsg(IEN50,Msg) +"RTN","TMGNDF3C",392,0) + ;"Purpose: to Add a message in the Activity log field +"RTN","TMGNDF3C",393,0) + ;"Input: IEN50 -- the IEN in DRUG file +"RTN","TMGNDF3C",394,0) + ;" Msg -- the Message to add (a string) +"RTN","TMGNDF3C",395,0) + ;"results: none. +"RTN","TMGNDF3C",396,0) + +"RTN","TMGNDF3C",397,0) + ;"Check that record was added, then then add subfile entries: +"RTN","TMGNDF3C",398,0) + set IENS="+1,"_IEN50_"," +"RTN","TMGNDF3C",399,0) + kill TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF3C",400,0) + ;" 214 ACTIVITY LOG <-Mult [50.0214DA] +"RTN","TMGNDF3C",401,0) + ;" .01 -ACTIVITY LOG [D] +"RTN","TMGNDF3C",402,0) + ;" 1 -REASON [S] +"RTN","TMGNDF3C",403,0) + ;" 2 -INITIATOR OF ACTIVITY <-Pntr [P200'] +"RTN","TMGNDF3C",404,0) + ;" 3 -FIELD EDITED [F] +"RTN","TMGNDF3C",405,0) + ;" 4 -NEW VALUE [F] +"RTN","TMGNDF3C",406,0) + ;" 5 -NDF UPDATE [F] +"RTN","TMGNDF3C",407,0) + set TMGFDA(50.0214,IENS,.01)="NOW" +"RTN","TMGNDF3C",408,0) + set TMGFDA(50.0214,IENS,1)="E" +"RTN","TMGNDF3C",409,0) + set TMGFDA(50.0214,IENS,2)="`"_DUZ +"RTN","TMGNDF3C",410,0) + set TMGFDA(50.0214,IENS,3)="ALL FIELDS" +"RTN","TMGNDF3C",411,0) + set TMGFDA(50.0214,IENS,4)=Msg +"RTN","TMGNDF3C",412,0) + +"RTN","TMGNDF3C",413,0) + do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF3C",414,0) + if $get(Quiet)'=1 do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3C",415,0) + +"RTN","TMGNDF3C",416,0) + quit +"RTN","TMGNDF3C",417,0) + +"RTN","TMGNDF3C",418,0) + +"RTN","TMGNDF3C",419,0) +SetupFDA(DrugInfo,IENS,TMGFDA) +"RTN","TMGNDF3C",420,0) + ;"Purpose: To set up the FDA (Filman data array) for the data that will go into +"RTN","TMGNDF3C",421,0) + ;" a record to the DRUG file, based on entry from VA PRODUCT file +"RTN","TMGNDF3C",422,0) + ;"Input: DrugInfo -- PASS BY REFERENCE -- Drug info from array GetTMGDrugInfo, and +"RTN","TMGNDF3C",423,0) + ;" as modified by Add2VAProd^TMGNDF3A +"RTN","TMGNDF3C",424,0) + ;" Fields used are: +"RTN","TMGNDF3C",425,0) + ;" DrugInfo("CUR MODE")="GENERIC" or "TRADE" +"RTN","TMGNDF3C",426,0) + ;" DrugInfo("NAME","GENERIC")=e.g. NAME: DILTIAZEM 240MG +"RTN","TMGNDF3C",427,0) + ;" DrugInfo("NAME","TRADE")=e.g. NAME: CARDIZEM CD 240MG +"RTN","TMGNDF3C",428,0) + ;" DrugInfo("NDC") +"RTN","TMGNDF3C",429,0) + ;" DrugInfo("SOURCE IEN")=source IEN in 22706.9 +"RTN","TMGNDF3C",430,0) + ;" DrugInfo("IEN 50.68")=field 5.5, a pointer to 50.68 (VA PRODUCT) +"RTN","TMGNDF3C",431,0) + ;" IENS -- a standard fileman IENS for this FDA to be created with +"RTN","TMGNDF3C",432,0) + ;" TMGFDA -- PASS BY REFERENCE -- an OUT PARAMETER. This will be a standard +"RTN","TMGNDF3C",433,0) + ;" fileman FDA +"RTN","TMGNDF3C",434,0) + ;"Output: TMGFDA will be filled +"RTN","TMGNDF3C",435,0) + ;"Result: 1=OK to continue, 0 if error +"RTN","TMGNDF3C",436,0) + +"RTN","TMGNDF3C",437,0) + ;"NOTE: The FDA that this function contains will contain INTERNAL values +"RTN","TMGNDF3C",438,0) + +"RTN","TMGNDF3C",439,0) + new result set result=1 ;"default to success -- don't change. +"RTN","TMGNDF3C",440,0) + new mode set mode=$get(DrugInfo("CUR MODE")) +"RTN","TMGNDF3C",441,0) + if (mode'="TRADE")&(mode'="GENERIC") set result=0 goto SUFDone +"RTN","TMGNDF3C",442,0) + +"RTN","TMGNDF3C",443,0) + new TMGMSG,TMGIEN +"RTN","TMGNDF3C",444,0) + new tempS,tempIEN +"RTN","TMGNDF3C",445,0) + new IEN22706d9 set IEN22706d9=+$get(DrugInfo("SOURCE IEN")) +"RTN","TMGNDF3C",446,0) + +"RTN","TMGNDF3C",447,0) + ;"Example Entry. (Edited for fields I care about) +"RTN","TMGNDF3C",448,0) + ;"#50 .01 GENERIC NAME: DILTIAZEM CD 120MG CAP +"RTN","TMGNDF3C",449,0) + ;"#50.68 .01 NAME [RFa] +"RTN","TMGNDF3C",450,0) + ;"#50.68 e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF3C",451,0) + set tempS=$get(DrugInfo("NAME",mode)) +"RTN","TMGNDF3C",452,0) + set tempS=$translate(tempS,";",":") ;" for some reason ';' is not allowed in .01 field +"RTN","TMGNDF3C",453,0) + if $length(tempS)>40 set tempS=$extract(tempS,1,37)_"..." +"RTN","TMGNDF3C",454,0) + set TMGFDA(50,IENS,.01)=tempS +"RTN","TMGNDF3C",455,0) + +"RTN","TMGNDF3C",456,0) + ;"#50 22 PSNDF VA PRODUCT NAME ENTRY: DILTIAZEM (CARDIZEM CD) 120MG SA CAP +"RTN","TMGNDF3C",457,0) + ;"#50.68 .01 NAME [RFa] +"RTN","TMGNDF3C",458,0) + ;"#50.68 e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF3C",459,0) + new vapIEN set vapIEN=+$get(DrugInfo("IEN 50.68")) +"RTN","TMGNDF3C",460,0) + if +vapIEN>0 DO +"RTN","TMGNDF3C",461,0) + . set TMGFDA(50,IENS,22)=vapIEN +"RTN","TMGNDF3C",462,0) + . new vapName +"RTN","TMGNDF3C",463,0) + . set vapName=$$GET1^DIQ(50.68,vapIEN,.01) +"RTN","TMGNDF3C",464,0) + . ;"#50 21 VA PRODUCT NAME: DILTIAZEM (CARDIZEM CD) 120MG SA CAP +"RTN","TMGNDF3C",465,0) + . ;"#50.68 .01 NAME [RFa] +"RTN","TMGNDF3C",466,0) + . ;"#50.68 e.g. NAME: DILTIAZEM (CARDIZEM CD) 240MG SA CAP +"RTN","TMGNDF3C",467,0) + . set TMGFDA(50,IENS,21)=vapName +"RTN","TMGNDF3C",468,0) + . ;"set TMGFDA(50,IENS,21)=tempS +"RTN","TMGNDF3C",469,0) + +"RTN","TMGNDF3C",470,0) + ;"#50 5 STANDARD SIG: T1 CAP QD +"RTN","TMGNDF3C",471,0) + ;" plan "USE AS DIRECTED" +"RTN","TMGNDF3C",472,0) + set TMGFDA(50,IENS,5)="USE AS DIRECTED" +"RTN","TMGNDF3C",473,0) + +"RTN","TMGNDF3C",474,0) + ;"#50 20 NATIONAL DRUG FILE ENTRY: DILTIAZEM <-Pntr [P50.6, VA GENERIC] +"RTN","TMGNDF3C",475,0) + set tempIEN=+$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",3) ;"1;3 = field .08 VA GENERIC +"RTN","TMGNDF3C",476,0) + if tempIEN>0 set TMGFDA(50,IENS,20)=tempIEN +"RTN","TMGNDF3C",477,0) + +"RTN","TMGNDF3C",478,0) + ;"#50 25 NATIONAL DRUG CLASS <-Pntr [P50.605'] +"RTN","TMGNDF3C",479,0) + ;"#50 2 VA CLASSIFICATION [FX] +"RTN","TMGNDF3C",480,0) + set tempIEN=+$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",5) ;"1;5 = field .09 VA DRUG CLASS +"RTN","TMGNDF3C",481,0) + set TMGFDA(50,IENS,25)=tempIEN +"RTN","TMGNDF3C",482,0) + set tempClass=$$GET1^DIQ(50.605,tempIEN_",",.01) +"RTN","TMGNDF3C",483,0) + if tempClass'="" set TMGFDA(50,IENS,2)=tempClass +"RTN","TMGNDF3C",484,0) + +"RTN","TMGNDF3C",485,0) + ;"#50 29 NATIONAL FORMULARY INDICATOR: NO +"RTN","TMGNDF3C",486,0) + set TMGFDA(50,IENS,29)=0 ;"0=NO, 1=YES +"RTN","TMGNDF3C",487,0) + +"RTN","TMGNDF3C",488,0) + ;"#50 31 NDC: 0088-1795-30 +"RTN","TMGNDF3C",489,0) + new NDC set NDC=$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",1) +"RTN","TMGNDF3C",490,0) + set NDC=$extract(NDC,2,20) ;"should be in 5-4-2 format, but must be 11 digits, 1st is not significant +"RTN","TMGNDF3C",491,0) + if NDC'="" set TMGFDA(50,IENS,31)=NDC +"RTN","TMGNDF3C",492,0) + +"RTN","TMGNDF3C",493,0) + ;"#50 901 STRENGTH: 120 +"RTN","TMGNDF3C",494,0) + new tempStr set tempStr=$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",2) ;"0;2=field 1 STRENGTH +"RTN","TMGNDF3C",495,0) + if tempStr'="" set TMGFDA(50,IENS,901)=tempStr +"RTN","TMGNDF3C",496,0) + +"RTN","TMGNDF3C",497,0) + ;"#50 902 UNIT: MG +"RTN","TMGNDF3C",498,0) + ;"#50.68 3 UNITS <-Pntr [P50.607'a] +"RTN","TMGNDF3C",499,0) + ;"#50.68 e.g. UNITS: MG +"RTN","TMGNDF3C",500,0) + new tempUnit set tempUnit=$$GET1^DIQ(50.68,vapIEN,3,"I") +"RTN","TMGNDF3C",501,0) + if tempUnit'="" set TMGFDA(50,IENS,902)=tempUnit +"RTN","TMGNDF3C",502,0) + +"RTN","TMGNDF3C",503,0) + ;"#50 62.02 UNIT DOSE MED ROUTE <-Pntr [*P51.2'] +"RTN","TMGNDF3C",504,0) + ;"#22706.9 3.1 VA ROUTE <-Pntr [P51.2'] +"RTN","TMGNDF3C",505,0) + set tempIEN=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",7) ;"7;7 3.1 VA ROUTE +"RTN","TMGNDF3C",506,0) + if tempIEN>0 set TMGFDA(50,IENS,62.02)=tempIEN +"RTN","TMGNDF3C",507,0) + +"RTN","TMGNDF3C",508,0) +SUFDone +"RTN","TMGNDF3C",509,0) + quit result +"RTN","TMGNDF3C",510,0) + +"RTN","TMGNDF3C",511,0) + +"RTN","TMGNDF3C",512,0) +VerifySync +"RTN","TMGNDF3C",513,0) + ;"To verify the synchronization, i.e. looking for dangling pointers etc. +"RTN","TMGNDF3C",514,0) + +"RTN","TMGNDF3C",515,0) + new ChangeCt set ChangeCt=0 +"RTN","TMGNDF3C",516,0) + new Itr,IEN22706d9 +"RTN","TMGNDF3C",517,0) + new abort set abort=0 +"RTN","TMGNDF3C",518,0) + write !,"Checking Synchronization",! +"RTN","TMGNDF3C",519,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3C",520,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF3C",521,0) + if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF3C",522,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3C",523,0) + . ;"if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3C",524,0) + . new tIEN50 set tIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF3C",525,0) + . set ChangeCt=ChangeCt+$$Verify1(IEN22706d9,tIEN50,"TRADE") +"RTN","TMGNDF3C",526,0) + . new gIEN50 set gIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF3C",527,0) + . set ChangeCt=ChangeCt+$$Verify1(IEN22706d9,gIEN50,"GENERIC") +"RTN","TMGNDF3C",528,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3C",529,0) + +"RTN","TMGNDF3C",530,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3C",531,0) + +"RTN","TMGNDF3C",532,0) + quit +"RTN","TMGNDF3C",533,0) + +"RTN","TMGNDF3C",534,0) +Verify1(IEN22706d9,IEN50,mode) +"RTN","TMGNDF3C",535,0) + ;"To Verify one +"RTN","TMGNDF3C",536,0) + ;"Input: IEN22706d9 +"RTN","TMGNDF3C",537,0) + ;" IEN50 -- link to DRUG file (either for Generic Drug, or Trade Drug) +"RTN","TMGNDF3C",538,0) + ;" mode - "GENERIC" or "TRADE" +"RTN","TMGNDF3C",539,0) + ;"Result: 0 -- no change, 1= change made +"RTN","TMGNDF3C",540,0) + +"RTN","TMGNDF3C",541,0) + new result set result=0 +"RTN","TMGNDF3C",542,0) + new field50 set field50="" +"RTN","TMGNDF3C",543,0) + new fieldName set fieldName="" +"RTN","TMGNDF3C",544,0) + new node,pce set (node,pce)="" +"RTN","TMGNDF3C",545,0) + if mode="GENERIC" do +"RTN","TMGNDF3C",546,0) + . set field50=5.7 +"RTN","TMGNDF3C",547,0) + . set fieldName=.076 +"RTN","TMGNDF3C",548,0) + . set node=8,pce=2 +"RTN","TMGNDF3C",549,0) + else if mode="TRADE" do +"RTN","TMGNDF3C",550,0) + . set field50=5.6 +"RTN","TMGNDF3C",551,0) + . set fieldName=.056 +"RTN","TMGNDF3C",552,0) + . set node=8,pce=1 +"RTN","TMGNDF3C",553,0) + if (field50="") goto V1Done +"RTN","TMGNDF3C",554,0) + if (IEN50="") goto V1Done +"RTN","TMGNDF3C",555,0) + +"RTN","TMGNDF3C",556,0) + new drugName set drugName=$piece($get(^PSDRUG(IEN50,0)),"^",1) +"RTN","TMGNDF3C",557,0) + new TMGName set TMGName=$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce) +"RTN","TMGNDF3C",558,0) + set TMGName=$translate(TMGName,";",":") +"RTN","TMGNDF3C",559,0) + +"RTN","TMGNDF3C",560,0) + if $data(^PSDRUG(+$get(IEN50)))=0 do +"RTN","TMGNDF3C",561,0) + . write "Bad pointer: ",IEN50 +"RTN","TMGNDF3C",562,0) + . set IEN50=0 +"RTN","TMGNDF3C",563,0) + +"RTN","TMGNDF3C",564,0) + if drugName'=TMGName do +"RTN","TMGNDF3C",565,0) + . write IEN22706d9," (",$extract(mode,1),"): Name mismatch: ",drugName," vs ",TMGName,! +"RTN","TMGNDF3C",566,0) + . if TMGName="" set IEN50=0 +"RTN","TMGNDF3C",567,0) + +"RTN","TMGNDF3C",568,0) + if $get(IEN50)=0 do goto V1Done +"RTN","TMGNDF3C",569,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3C",570,0) + . set TMGFDA(22706.9,IEN22706d9_",",field50)="@" +"RTN","TMGNDF3C",571,0) + . do UPDATE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF3C",572,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3C",573,0) + . write " ... fixed.",! +"RTN","TMGNDF3C",574,0) + . set result=1 +"RTN","TMGNDF3C",575,0) + +"RTN","TMGNDF3C",576,0) + +"RTN","TMGNDF3C",577,0) +V1Done +"RTN","TMGNDF3C",578,0) + quit result +"RTN","TMGNDF3D") +0^51^B9007 +"RTN","TMGNDF3D",1,0) +TMGNDF3D ;TMG/kst/FDA Import: Ensure Possible DRUG doses ;03/25/06 +"RTN","TMGNDF3D",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF3D",3,0) + +"RTN","TMGNDF3D",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF3D",5,0) + ;" Ensuring POSSIBLE DOSAGES field correct for File 50 Entries. +"RTN","TMGNDF3D",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF3D",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF3D",8,0) + ;"11-21-2006 +"RTN","TMGNDF3D",9,0) + +"RTN","TMGNDF3D",10,0) + ;"======================================================================= +"RTN","TMGNDF3D",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF3D",12,0) + ;"======================================================================= +"RTN","TMGNDF3D",13,0) + ;"Menu +"RTN","TMGNDF3D",14,0) + +"RTN","TMGNDF3D",15,0) + ;"======================================================================= +"RTN","TMGNDF3D",16,0) + ;"FixPosDoses -- cycle through all records in file 50 and ensure Possible Doses are +"RTN","TMGNDF3D",17,0) + ;" as desired, I.e. that field 903 has a listing of possible doses +"RTN","TMGNDF3D",18,0) + ;" for use in CPRS +"RTN","TMGNDF3D",19,0) + +"RTN","TMGNDF3D",20,0) + ;"FixAppUse -- cycle through all records in file 50 and ensure drugs are marked +"RTN","TMGNDF3D",21,0) + ;" with needed code for Application Use, I.e. that field 63 has +"RTN","TMGNDF3D",22,0) + ;" a listing of possible doses for use in CPRS +"RTN","TMGNDF3D",23,0) + +"RTN","TMGNDF3D",24,0) + ;"FixPkgDoses -- to ensure that a package code has been put in for all possible doses +"RTN","TMGNDF3D",25,0) + ;" NOTE: FixPosDoses has not yet been fixed so that this is done +"RTN","TMGNDF3D",26,0) + ;" the first time around. +"RTN","TMGNDF3D",27,0) + +"RTN","TMGNDF3D",28,0) + ;"======================================================================= +"RTN","TMGNDF3D",29,0) + ;" Private Functions. +"RTN","TMGNDF3D",30,0) + ;"======================================================================= +"RTN","TMGNDF3D",31,0) + ;"$$Fix1Drug(IEN50,IEN22706d9) -- ensure Possible Doses are as desired for one record +"RTN","TMGNDF3D",32,0) + ;"FixMissingDoses(IEN,rxDose,rxUnit) +"RTN","TMGNDF3D",33,0) + ;"EnsureMult(IEN,Mult,UnitDose,IEN50d606) -- ensure that one dosage multiple exists +"RTN","TMGNDF3D",34,0) + ;"MultExists(IEN,Mult) -- return if one dosage multiple exists +"RTN","TMGNDF3D",35,0) + ;"AddMult(IEN,Mult) -- add a blank record for later filling +"RTN","TMGNDF3D",36,0) + ;"CheckForBad(IEN) -- Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field +"RTN","TMGNDF3D",37,0) + ;"Clear1Bad(IEN,subIEN) -- kill Subrecord number subIEN in record IEN +"RTN","TMGNDF3D",38,0) + ;"Unlock902 -- remove restrictions on field 902 of file 50 +"RTN","TMGNDF3D",39,0) + ;"Lock902 -- replace restrictions on field 902 of file 50 +"RTN","TMGNDF3D",40,0) + ;"UL50d68 -- unlock fields 2 & 3 in field 50.68 +"RTN","TMGNDF3D",41,0) + ;"L50d68 -- restore locks on fields 4 & 5 in field 50.68 +"RTN","TMGNDF3D",42,0) + +"RTN","TMGNDF3D",43,0) + +"RTN","TMGNDF3D",44,0) + ;"======================================================================= +"RTN","TMGNDF3D",45,0) + ;"======================================================================= +"RTN","TMGNDF3D",46,0) +Menu +"RTN","TMGNDF3D",47,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF3D",48,0) + +"RTN","TMGNDF3D",49,0) + new Menu,UsrSlct +"RTN","TMGNDF3D",50,0) + set Menu(0)="Pick Option for Ensuring Available Doses in DRUG file (3D)" +"RTN","TMGNDF3D",51,0) + set Menu(1)="Edit which drug FORMS are dividable"_$char(9)_"EditDividable" +"RTN","TMGNDF3D",52,0) + set Menu(2)="Setup Possible Doses in DRUG File"_$char(9)_"FixPosDoses" +"RTN","TMGNDF3D",53,0) + set Menu(3)="Mark DRUGs with proper APPLICATION & PACKAGE codes"_$char(9)_"FixAppUseAndPkg" +"RTN","TMGNDF3D",54,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF3D",55,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF3D",56,0) + +"RTN","TMGNDF3D",57,0) +MC1 write # +"RTN","TMGNDF3D",58,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF3D",59,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF3D",60,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF3D",61,0) + +"RTN","TMGNDF3D",62,0) + if UsrSlct="FixPosDoses" do FixPosDoses goto MC1 +"RTN","TMGNDF3D",63,0) + if UsrSlct="FixAppUseAndPkg" do FixAppUseAndPkg goto MC1 +"RTN","TMGNDF3D",64,0) + if UsrSlct="EditDividable" do EditForms^TMGNDF2A goto MC1 +"RTN","TMGNDF3D",65,0) + if UsrSlct="Prev" goto Menu^TMGNDF3C ;"quit can occur from there... +"RTN","TMGNDF3D",66,0) + if UsrSlct="Next" goto Menu^TMGNDF3E ;"quit can occur from there... +"RTN","TMGNDF3D",67,0) + goto MC1 +"RTN","TMGNDF3D",68,0) + +"RTN","TMGNDF3D",69,0) +MCDone +"RTN","TMGNDF3D",70,0) + quit +"RTN","TMGNDF3D",71,0) + +"RTN","TMGNDF3D",72,0) + ;"======================================================================= +"RTN","TMGNDF3D",73,0) + +"RTN","TMGNDF3D",74,0) +FixPosDoses +"RTN","TMGNDF3D",75,0) + ;"Purpose: To cycle through all imports in file 50 and ensure Possible Doses are as desired +"RTN","TMGNDF3D",76,0) + ;" I.e. that field 903 has a listing of possible doses for use in CPRS +"RTN","TMGNDF3D",77,0) + ;"Output: Field 903 in all records might be changed +"RTN","TMGNDF3D",78,0) + ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903 +"RTN","TMGNDF3D",79,0) + ;" *** Also, I am going to add dosing combinations that may not be appriate or correct +"RTN","TMGNDF3D",80,0) + ;" doses for a particular drug. This is because I don't have a database for maximum +"RTN","TMGNDF3D",81,0) + ;" doses. In those drugs that already have VA data added, I will still add extra +"RTN","TMGNDF3D",82,0) + ;" possible combinations. For example, I plan to add ability for the doctor to give +"RTN","TMGNDF3D",83,0) + ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID) +"RTN","TMGNDF3D",84,0) + ;" If the dosage form is CAP, CAPSULE, then I won't add 0.25 or 0.5 forms. +"RTN","TMGNDF3D",85,0) + ;" Addendum: I have added a field (22706.8) to file 50.606 (DRUG FORMS) which +"RTN","TMGNDF3D",86,0) + ;" will be used to see if the drug is dividable or not (i.e. if to add the 0.25 +"RTN","TMGNDF3D",87,0) + ;" etc. dose multipliers). +"RTN","TMGNDF3D",88,0) + +"RTN","TMGNDF3D",89,0) + do Unlock902 +"RTN","TMGNDF3D",90,0) + +"RTN","TMGNDF3D",91,0) + new count set count=0 +"RTN","TMGNDF3D",92,0) + new Itr,IEN22706d9 +"RTN","TMGNDF3D",93,0) + new abort set abort=0 +"RTN","TMGNDF3D",94,0) + new success set success=1 +"RTN","TMGNDF3D",95,0) + +"RTN","TMGNDF3D",96,0) + write !,"Prepairing possible doses for DRUG entries from import data...",! +"RTN","TMGNDF3D",97,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3D",98,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF3D",99,0) + if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF3D",100,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3D",101,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3D",102,0) + . new RxIEN set RxIEN=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF3D",103,0) + . new RxIEN2 set RxIEN2=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF3D",104,0) + . if RxIEN>0 do +"RTN","TMGNDF3D",105,0) + . . set success=$$Fix1Drug(RxIEN,IEN22706d9) if success=-1 quit +"RTN","TMGNDF3D",106,0) + . . set count=count+1 +"RTN","TMGNDF3D",107,0) + . if RxIEN2>0 do +"RTN","TMGNDF3D",108,0) + . . set success=$$Fix1Drug(RxIEN2,IEN22706d9) if success=-1 quit +"RTN","TMGNDF3D",109,0) + . . set count=count+1 +"RTN","TMGNDF3D",110,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3D",111,0) + +"RTN","TMGNDF3D",112,0) + write count," records updated.",! +"RTN","TMGNDF3D",113,0) + if success=-1 write "Process ended prematurely due to error.",! +"RTN","TMGNDF3D",114,0) + +"RTN","TMGNDF3D",115,0) + do Lock902 +"RTN","TMGNDF3D",116,0) + +"RTN","TMGNDF3D",117,0) + quit +"RTN","TMGNDF3D",118,0) + +"RTN","TMGNDF3D",119,0) + +"RTN","TMGNDF3D",120,0) +Fix1Drug(IEN50,IEN22706d9) +"RTN","TMGNDF3D",121,0) + ;"Purpose: To ensure Possible Doses are as desired for one record +"RTN","TMGNDF3D",122,0) + ;"Input: IEN50 = IEN in file 50 +"RTN","TMGNDF3D",123,0) + ;" IEN22706d9 -- IEN in 22706.9, the origin of the import +"RTN","TMGNDF3D",124,0) + ;"Output: Field 903 might be changed +"RTN","TMGNDF3D",125,0) + ;"Notes: I am going to delete duplicate, unuseful entries in the multiple field 903 +"RTN","TMGNDF3D",126,0) + ;" *** Also, I am going to add dosing combinations that may not be appriate or correct +"RTN","TMGNDF3D",127,0) + ;" doses for a particular drug. This is because I don't have a database for maximum +"RTN","TMGNDF3D",128,0) + ;" doses. In those drugs that already have VA data added, I will still add extra +"RTN","TMGNDF3D",129,0) + ;" possible combinations. For example, I plan to add ability for the doctor to give +"RTN","TMGNDF3D",130,0) + ;" 0.25, 0.5, 1, 2, 3, or 4 units together for a given dose (i.e. ibuprofen 200, 4 PO TID) +"RTN","TMGNDF3D",131,0) + ;" Note: If the dosage form is CAP, then I won't add 0.25 or 0.5 forms. +"RTN","TMGNDF3D",132,0) + ;" Also, if there is no dosage strength or unit in the record, but it is available in the +"RTN","TMGNDF3D",133,0) + ;" linked record in 50.68, then we will copy the information over. +"RTN","TMGNDF3D",134,0) + ;" ADDENDUM: I will check the drug form to see if it is dividable. +"RTN","TMGNDF3D",135,0) + ;"Result: 0 if OK to continue. -1 if abort +"RTN","TMGNDF3D",136,0) + +"RTN","TMGNDF3D",137,0) + new result set result=0 +"RTN","TMGNDF3D",138,0) + new Mult,rxDose,rxUnit,vapRxForm,vapIEN +"RTN","TMGNDF3D",139,0) + new IEN50d606 +"RTN","TMGNDF3D",140,0) + new abort set abort=0 +"RTN","TMGNDF3D",141,0) + if +$get(IEN50)=0 goto FODDone +"RTN","TMGNDF3D",142,0) + if +$get(IEN22706d9)=0 goto FODDone +"RTN","TMGNDF3D",143,0) + do CheckForBad(IEN50) +"RTN","TMGNDF3D",144,0) + set rxDose=$piece($get(^PSDRUG(IEN50,"DOS")),"^",1) ;"DOS;1 = field 901; STRENGTH +"RTN","TMGNDF3D",145,0) + set rxUnit=$$GET1^DIQ(50,IEN50,902) ;"902 = UNIT +"RTN","TMGNDF3D",146,0) + set IEN50d606=$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",7) +"RTN","TMGNDF3D",147,0) + if (+rxDose'>0)!(rxUnit="") do +"RTN","TMGNDF3D",148,0) +FOD1 . set result=$$FixMissingDoses(IEN50,.rxDose,.rxUnit) +"RTN","TMGNDF3D",149,0) + if result'=0 goto FODDone +"RTN","TMGNDF3D",150,0) + +"RTN","TMGNDF3D",151,0) + for Mult=0.25,0.5,1,2,3,4 do quit:(result=-1) +"RTN","TMGNDF3D",152,0) + . ;"set result=$$EnsureMult(IEN50,Mult,rxDose,rxUnit) +"RTN","TMGNDF3D",153,0) + . set result=$$EnsureMult(IEN50,Mult,rxDose,IEN50d606) +"RTN","TMGNDF3D",154,0) + +"RTN","TMGNDF3D",155,0) +FODDone +"RTN","TMGNDF3D",156,0) + quit result +"RTN","TMGNDF3D",157,0) + +"RTN","TMGNDF3D",158,0) + +"RTN","TMGNDF3D",159,0) +FixMissingDoses(IEN50,rxDose,rxUnit) +"RTN","TMGNDF3D",160,0) + ;"Purpose: If there is no dosage strength or unit in the record, but it is available in the +"RTN","TMGNDF3D",161,0) + ;" linked record in 50.68, then we will copy the information over. +"RTN","TMGNDF3D",162,0) + ;"Input: IEN50 - IEN in file 50 +"RTN","TMGNDF3D",163,0) + ;" rxDose -- PASS BY REFERENCE, OUT PARAMETER +"RTN","TMGNDF3D",164,0) + ;" rxUnit -- PASS BY REFERENCE, OUT PARAMETER +"RTN","TMGNDF3D",165,0) + ;"Result: 0 if OK to continue. -1 if abort 1=unable to fix +"RTN","TMGNDF3D",166,0) + +"RTN","TMGNDF3D",167,0) + new vapRxForm,vapIEN +"RTN","TMGNDF3D",168,0) + new result set result=1 ;"default to failure +"RTN","TMGNDF3D",169,0) + new ErrFound set ErrFound=0 +"RTN","TMGNDF3D",170,0) + +"RTN","TMGNDF3D",171,0) + set rxDose=$$GET1^DIQ(50,IEN50,901) +"RTN","TMGNDF3D",172,0) + set rxUnit=$$GET1^DIQ(50,IEN50,902) +"RTN","TMGNDF3D",173,0) + set vapIEN=$$GET1^DIQ(50,IEN50,22,"I") +"RTN","TMGNDF3D",174,0) + set vapRxForm=$$GET1^DIQ(50.68,vapIEN,1) ;50.68=VA PRODUCT, field 1=DOSAGE FORM +"RTN","TMGNDF3D",175,0) + set vapRxStrength=$$GET1^DIQ(50.68,vapIEN,2) ;"50.68=VA PRODUCT, field 2=STRENGTH +"RTN","TMGNDF3D",176,0) + set vapRxUnits=$$GET1^DIQ(50.68,vapIEN,3) ;"50.68=VA PRODUCT, field 3=UNITS +"RTN","TMGNDF3D",177,0) + set vapRxIUnits=$$GET1^DIQ(50.68,vapIEN,3,"I") ;"50.68=VA PRODUCT, field 3=UNITS +"RTN","TMGNDF3D",178,0) + +"RTN","TMGNDF3D",179,0) + ;"For some reason the units must be put in FIRST +"RTN","TMGNDF3D",180,0) + if (rxUnit="")&(vapRxUnits'="") do +"RTN","TMGNDF3D",181,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3D",182,0) + . set TMGFDA(50,IEN50_",",902)=vapRxIUnits +"RTN","TMGNDF3D",183,0) + . set rxUnit=vapRxUnits +"RTN","TMGNDF3D",184,0) + . set result=0 ;"set for tenative success +"RTN","TMGNDF3D",185,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3D",186,0) + . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF3D",187,0) + . . set ErrFound=1 +"RTN","TMGNDF3D",188,0) + . . new PriorErrorFound +"RTN","TMGNDF3D",189,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF3D",190,0) + . . set result=-1 +"RTN","TMGNDF3D",191,0) + if ErrFound goto FMDDone +"RTN","TMGNDF3D",192,0) + +"RTN","TMGNDF3D",193,0) + if (rxDose="")&(vapRxStrength'="") do +"RTN","TMGNDF3D",194,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3D",195,0) + . set TMGFDA(50,IEN50_",",901)=vapRxStrength +"RTN","TMGNDF3D",196,0) + . set rxDose=vapRxStrength +"RTN","TMGNDF3D",197,0) + . set result=0 ;"set for tenative success +"RTN","TMGNDF3D",198,0) + . do FILE^DIE("ETK","TMGFDA","TMGMSG") +"RTN","TMGNDF3D",199,0) + . if $data(TMGMSG("DIERR"))'=0 do quit +"RTN","TMGNDF3D",200,0) + . . new PriorErrorFound +"RTN","TMGNDF3D",201,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF3D",202,0) + . . set result=-1 +"RTN","TMGNDF3D",203,0) + if ErrFound goto FMDDone +"RTN","TMGNDF3D",204,0) + +"RTN","TMGNDF3D",205,0) +FMDDone +"RTN","TMGNDF3D",206,0) + quit result +"RTN","TMGNDF3D",207,0) + +"RTN","TMGNDF3D",208,0) + +"RTN","TMGNDF3D",209,0) +EnsureMult(IEN50,Mult,UnitDose,IEN50d606) +"RTN","TMGNDF3D",210,0) + ;"Purpose: To ensure that one dosage multiple exists +"RTN","TMGNDF3D",211,0) + ;"Input: IEN50 - the IEN in file 50 +"RTN","TMGNDF3D",212,0) + ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4) +"RTN","TMGNDF3D",213,0) + ;" UnitDose -- the dose for a Multiple of 1 +"RTN","TMGNDF3D",214,0) + ;" IEN50d606 -- IEN in 50.606 (DRUG FORMS) +"RTN","TMGNDF3D",215,0) + ;"Result: 0 if OK to continue. -1 if abort +"RTN","TMGNDF3D",216,0) + ;"Note: The DRUG FORM is checked for dividability. If the particular dose +"RTN","TMGNDF3D",217,0) + ;" is not dividable (e.g. a capsule), then it ensures that a divided +"RTN","TMGNDF3D",218,0) + ;" dose does NOT exist (removing if needed) +"RTN","TMGNDF3D",219,0) + +"RTN","TMGNDF3D",220,0) + new result set result=0 +"RTN","TMGNDF3D",221,0) + new subIEN +"RTN","TMGNDF3D",222,0) + set subIEN=+$$MultExists(IEN50,Mult) +"RTN","TMGNDF3D",223,0) + if (Mult<1),($$IsDividable(IEN50d606)=0),(subIEN'=0) do goto EMDone +"RTN","TMGNDF3D",224,0) + . new temp set temp=$$Clear1Bad(IEN50,subIEN) +"RTN","TMGNDF3D",225,0) + if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult) +"RTN","TMGNDF3D",226,0) + ;"if subIEN'>0 set subIEN=$$AddMult(IEN50,Mult,Mult*UnitDose) +"RTN","TMGNDF3D",227,0) + if subIEN=0 set result=1 goto EMDone +"RTN","TMGNDF3D",228,0) + new dosage set dosage=$$GetDosage(UnitDose,Mult) +"RTN","TMGNDF3D",229,0) + set result=$$StuffMult(IEN50,subIEN,Mult,dosage) +"RTN","TMGNDF3D",230,0) + +"RTN","TMGNDF3D",231,0) +EMDone quit result +"RTN","TMGNDF3D",232,0) + +"RTN","TMGNDF3D",233,0) + +"RTN","TMGNDF3D",234,0) +IsDividable(IEN50d606) +"RTN","TMGNDF3D",235,0) + ;"Purpose: to determine if a particular drug form is dividable +"RTN","TMGNDF3D",236,0) + ;" (as stored in the DRUG FORM file) +"RTN","TMGNDF3D",237,0) + ;"Results: 1 if dividable, 0 otherwise +"RTN","TMGNDF3D",238,0) + +"RTN","TMGNDF3D",239,0) + new result +"RTN","TMGNDF3D",240,0) + set result=(+$piece($get(^PS(50.606,IEN50d606,"TMG")),"^",1)=1) ;"field 22706.8, DIVIDABLE +"RTN","TMGNDF3D",241,0) + quit result +"RTN","TMGNDF3D",242,0) + +"RTN","TMGNDF3D",243,0) + +"RTN","TMGNDF3D",244,0) +GetDosage(UnitDose,Mult) +"RTN","TMGNDF3D",245,0) + ;"Purpose to return UnitDose*Mult, but allow for 160;25 --> 80;12.5 +"RTN","TMGNDF3D",246,0) + ;"Input: UnitDose -- the dose for a Multiple of 1 +"RTN","TMGNDF3D",247,0) + ;" Mult - The unit multiple to use (e.g. 0.25, 0.5, 1, 2, 3, 4) +"RTN","TMGNDF3D",248,0) + ;"Results: returns UnitDose*Mult. +"RTN","TMGNDF3D",249,0) + ;" E.g. 80 * 2 ==> 160, or +"RTN","TMGNDF3D",250,0) + ;" 10;12.5 * 2 ==> 20;25 +"RTN","TMGNDF3D",251,0) + +"RTN","TMGNDF3D",252,0) + new i,result +"RTN","TMGNDF3D",253,0) + set result="" +"RTN","TMGNDF3D",254,0) + for i=1:1:$length(UnitDose,";") do +"RTN","TMGNDF3D",255,0) + . new oneDose set oneDose=+$piece(UnitDose,";",i) +"RTN","TMGNDF3D",256,0) + . if i>1 set result=result_";" +"RTN","TMGNDF3D",257,0) + . set result=result_(oneDose*Mult) +"RTN","TMGNDF3D",258,0) + +"RTN","TMGNDF3D",259,0) + quit result +"RTN","TMGNDF3D",260,0) + +"RTN","TMGNDF3D",261,0) +MultExists(IEN50,Mult) +"RTN","TMGNDF3D",262,0) + ;"Purpose: To return if one dosage multiple exists +"RTN","TMGNDF3D",263,0) + ;"Input: IEN50 - the IEN in file 50 +"RTN","TMGNDF3D",264,0) + ;" Mult - The unit multiple to be check for (e.g. 0.25, 0.5, 1, 2, 3, 4) +"RTN","TMGNDF3D",265,0) + ;"Results: subIEN if found, 0 otherwise +"RTN","TMGNDF3D",266,0) + +"RTN","TMGNDF3D",267,0) + new result set result=0 +"RTN","TMGNDF3D",268,0) + new subIEN,Mults +"RTN","TMGNDF3D",269,0) + new found set found=0 +"RTN","TMGNDF3D",270,0) + set subIEN=0 +"RTN","TMGNDF3D",271,0) + for set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN)) quit:(+subIEN'>0) do quit:(found>0) +"RTN","TMGNDF3D",272,0) + . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0)) +"RTN","TMGNDF3D",273,0) + . new numUnits set numUnits=$piece(node,"^",1) +"RTN","TMGNDF3D",274,0) + . if numUnits=Mult set found=1 +"RTN","TMGNDF3D",275,0) + +"RTN","TMGNDF3D",276,0) + if (found=1) set result=subIEN +"RTN","TMGNDF3D",277,0) + quit result +"RTN","TMGNDF3D",278,0) + +"RTN","TMGNDF3D",279,0) + +"RTN","TMGNDF3D",280,0) +AddMult(IEN50,Mult) +"RTN","TMGNDF3D",281,0) + ;"Purpose: To create a stub-in record for later filling +"RTN","TMGNDF3D",282,0) + ;"Input: IEN50 - the IEN in file 50 +"RTN","TMGNDF3D",283,0) + ;" Mult - The unit multiple to be ensured exists (e.g. 0.25, 0.5, 1, 2, 3, 4) +"RTN","TMGNDF3D",284,0) + ;"Output: Records are added to multiple field 903 +"RTN","TMGNDF3D",285,0) + ;"Result: returns IEN50 of added record +"RTN","TMGNDF3D",286,0) + +"RTN","TMGNDF3D",287,0) + new result set result=0 +"RTN","TMGNDF3D",288,0) + +"RTN","TMGNDF3D",289,0) + ;"Force value into DOS;2 to overcome input transform restriction on field .01 +"RTN","TMGNDF3D",290,0) + ;"(will be removed below) +"RTN","TMGNDF3D",291,0) + new temp set temp=$piece($get(^PSDRUG(IEN50,"DOS")),"^",2) +"RTN","TMGNDF3D",292,0) + if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)="(temp value)" +"RTN","TMGNDF3D",293,0) + +"RTN","TMGNDF3D",294,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF3D",295,0) + set TMGFDA(50.0903,"+1,"_IEN50_",",.01)=Mult +"RTN","TMGNDF3D",296,0) + do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF3D",297,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3D",298,0) + +"RTN","TMGNDF3D",299,0) + ;"remove temporary value forced in above. +"RTN","TMGNDF3D",300,0) + if temp="" set $piece(^PSDRUG(IEN50,"DOS"),"^",2)="" +"RTN","TMGNDF3D",301,0) + +"RTN","TMGNDF3D",302,0) + set result=$get(TMGIEN(1)) ;"get new record number +"RTN","TMGNDF3D",303,0) +AMDone +"RTN","TMGNDF3D",304,0) + quit result +"RTN","TMGNDF3D",305,0) + +"RTN","TMGNDF3D",306,0) + +"RTN","TMGNDF3D",307,0) +StuffMult(IEN50,subIEN,Mult,Dosage) +"RTN","TMGNDF3D",308,0) + ;"Purpose: To add a dosage multiple to IEN50 record +"RTN","TMGNDF3D",309,0) + ;"Input: IEN50 - the IEN in file 50 +"RTN","TMGNDF3D",310,0) + ;" subIEN -- the IEN in subfile 50.0903 +"RTN","TMGNDF3D",311,0) + ;" Dosage - the value to go into field 1 (e.g. 160, or 160;12.5) +"RTN","TMGNDF3D",312,0) + ;"Output: Records are added to multiple field 903 +"RTN","TMGNDF3D",313,0) + ;"Result: 0 if OK to continue. -1 if abort +"RTN","TMGNDF3D",314,0) + ;"Note: if Dosage < 1 then Mult values < 1 will be ignored +"RTN","TMGNDF3D",315,0) + ;" This is because 0.625*0.25 --> such a small a number that input transform rejects value. +"RTN","TMGNDF3D",316,0) + +"RTN","TMGNDF3D",317,0) + new result set result=0 +"RTN","TMGNDF3D",318,0) + if (Dosage<1)&(Mult<1) goto SMDone +"RTN","TMGNDF3D",319,0) + set Dosage=$$ClipDDigits^TMGMISC(Dosage,5) +"RTN","TMGNDF3D",320,0) + +"RTN","TMGNDF3D",321,0) + new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF3D",322,0) + set TMGFDA(50.0903,subIEN_","_IEN50_",",1)=Dosage +"RTN","TMGNDF3D",323,0) + do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF3D",324,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG,.result) ;"result=1 if error +"RTN","TMGNDF3D",325,0) + +"RTN","TMGNDF3D",326,0) +SMDone +"RTN","TMGNDF3D",327,0) + quit result +"RTN","TMGNDF3D",328,0) + +"RTN","TMGNDF3D",329,0) + +"RTN","TMGNDF3D",330,0) +CheckForBad(IEN50) +"RTN","TMGNDF3D",331,0) + ;"Purpose: Clear records in multiple field 903 that are duplicates, or have no value for DOSE (1) field +"RTN","TMGNDF3D",332,0) + ;"Input: IEN50= IEN in file 50 +"RTN","TMGNDF3D",333,0) + ;"Example: +"RTN","TMGNDF3D",334,0) + ;" 903-POSSIBLE DOSAGES : +"RTN","TMGNDF3D",335,0) + ;" Multiple Entry #1 +"RTN","TMGNDF3D",336,0) + ;" .01-DISPENSE UNITS PER DOSE : 1 <---- no DOSE, so kill +"RTN","TMGNDF3D",337,0) + ;" 2-PACKAGE : IO +"RTN","TMGNDF3D",338,0) + ;" Multiple Entry #2 +"RTN","TMGNDF3D",339,0) + ;" .01-DISPENSE UNITS PER DOSE : 2 <---- no DOSE, so kill +"RTN","TMGNDF3D",340,0) + ;" 2-PACKAGE : IO +"RTN","TMGNDF3D",341,0) + ;" Multiple Entry #3 +"RTN","TMGNDF3D",342,0) + ;" .01-DISPENSE UNITS PER DOSE : 1 +"RTN","TMGNDF3D",343,0) + ;" 1-DOSE : 250 +"RTN","TMGNDF3D",344,0) + ;" 2-PACKAGE : IO +"RTN","TMGNDF3D",345,0) + ;" Multiple Entry #4 +"RTN","TMGNDF3D",346,0) + ;" .01-DISPENSE UNITS PER DOSE : 2 +"RTN","TMGNDF3D",347,0) + ;" 1-DOSE : 500 +"RTN","TMGNDF3D",348,0) + ;" 2-PACKAGE : IO +"RTN","TMGNDF3D",349,0) + +"RTN","TMGNDF3D",350,0) + new subIEN,Mults +"RTN","TMGNDF3D",351,0) + set subIEN=$order(^PSDRUG(IEN50,"DOS1",0)) +"RTN","TMGNDF3D",352,0) + if subIEN>0 for do quit:(+subIEN'>0) +"RTN","TMGNDF3D",353,0) + . new deleted set deleted=0 +"RTN","TMGNDF3D",354,0) + . new node set node=$get(^PSDRUG(IEN50,"DOS1",subIEN,0)) +"RTN","TMGNDF3D",355,0) + . new dose set dose=$piece(node,"^",2) +"RTN","TMGNDF3D",356,0) + . if +dose'>0 set deleted=$$Clear1Bad(IEN50,subIEN) +"RTN","TMGNDF3D",357,0) + . new numUnits set numUnits=$piece(node,"^",1) +"RTN","TMGNDF3D",358,0) + . if $data(Mults(numUnits))=0 do +"RTN","TMGNDF3D",359,0) + . . if deleted=1 quit +"RTN","TMGNDF3D",360,0) + . . set Mults(numUnits)=subIEN +"RTN","TMGNDF3D",361,0) + . else do ;"here we have a duplicate entry. +"RTN","TMGNDF3D",362,0) + . . if deleted=1 quit +"RTN","TMGNDF3D",363,0) + . . set deleted=$$Clear1Bad(IEN50,subIEN) +"RTN","TMGNDF3D",364,0) + . set subIEN=$order(^PSDRUG(IEN50,"DOS1",subIEN)) +"RTN","TMGNDF3D",365,0) + +"RTN","TMGNDF3D",366,0) + quit +"RTN","TMGNDF3D",367,0) + +"RTN","TMGNDF3D",368,0) + +"RTN","TMGNDF3D",369,0) +Clear1Bad(IEN50,subIEN) +"RTN","TMGNDF3D",370,0) + ;"Purpose: To kill Subrecord number subIEN in record IEN +"RTN","TMGNDF3D",371,0) + ;"Input: IEN50 = IEN in file 50 +"RTN","TMGNDF3D",372,0) + ;" subIEN = IEN in subfile for field 903 (50.0903) +"RTN","TMGNDF3D",373,0) + ;"Results: 1 if kill done, 0 otherwise +"RTN","TMGNDF3D",374,0) + +"RTN","TMGNDF3D",375,0) + new DA,DIK +"RTN","TMGNDF3D",376,0) + set DIK="^PSDRUG("_IEN50_",""DOS1""," +"RTN","TMGNDF3D",377,0) + set DA=subIEN +"RTN","TMGNDF3D",378,0) + set DA(1)=IEN50 +"RTN","TMGNDF3D",379,0) + +"RTN","TMGNDF3D",380,0) + ;"write "Should delete: IEN50=",IEN50,", subIEN=",subIEN,! +"RTN","TMGNDF3D",381,0) + do ^DIK +"RTN","TMGNDF3D",382,0) + +"RTN","TMGNDF3D",383,0) + quit 1 +"RTN","TMGNDF3D",384,0) + +"RTN","TMGNDF3D",385,0) + +"RTN","TMGNDF3D",386,0) +Unlock902 +"RTN","TMGNDF3D",387,0) + ;"Purpose: remove restrictions on field 902 of file 50 +"RTN","TMGNDF3D",388,0) + kill ^DD(50,902,8.5) +"RTN","TMGNDF3D",389,0) + kill ^DD(50,902,9) +"RTN","TMGNDF3D",390,0) + quit +"RTN","TMGNDF3D",391,0) + +"RTN","TMGNDF3D",392,0) +Lock902 +"RTN","TMGNDF3D",393,0) + ;"Purpose: replace restrictions on field 902 of file 50 +"RTN","TMGNDF3D",394,0) + +"RTN","TMGNDF3D",395,0) + set ^DD(50,902,8.5)="^" +"RTN","TMGNDF3D",396,0) + set ^DD(50,902,9)="^" +"RTN","TMGNDF3D",397,0) + quit +"RTN","TMGNDF3D",398,0) + +"RTN","TMGNDF3D",399,0) +UL50d68 +"RTN","TMGNDF3D",400,0) + ;"Purpose: unlock fields 2 & 3 in field 50.68 +"RTN","TMGNDF3D",401,0) + +"RTN","TMGNDF3D",402,0) + kill ^DD(50.68,2,8.5) +"RTN","TMGNDF3D",403,0) + kill ^DD(50.68,2,9) +"RTN","TMGNDF3D",404,0) + kill ^DD(50.68,3,8.5) +"RTN","TMGNDF3D",405,0) + kill ^DD(50.68,3,9) +"RTN","TMGNDF3D",406,0) + +"RTN","TMGNDF3D",407,0) + quit +"RTN","TMGNDF3D",408,0) + +"RTN","TMGNDF3D",409,0) + +"RTN","TMGNDF3D",410,0) +L50d68 +"RTN","TMGNDF3D",411,0) + ;"Purpose: restore locks on fields 4 & 5 in field 50.68 +"RTN","TMGNDF3D",412,0) + +"RTN","TMGNDF3D",413,0) + set ^DD(50.68,2,8.5)="^" +"RTN","TMGNDF3D",414,0) + set ^DD(50.68,2,9)="^" +"RTN","TMGNDF3D",415,0) + set ^DD(50.68,2,8.5)="^" +"RTN","TMGNDF3D",416,0) + set ^DD(50.68,2,9)="^" +"RTN","TMGNDF3D",417,0) + +"RTN","TMGNDF3D",418,0) + quit +"RTN","TMGNDF3D",419,0) + +"RTN","TMGNDF3D",420,0) + ;"======================================================================= +"RTN","TMGNDF3D",421,0) + ;"======================================================================= +"RTN","TMGNDF3D",422,0) + +"RTN","TMGNDF3D",423,0) + +"RTN","TMGNDF3D",424,0) +FixAppUseAndPkg +"RTN","TMGNDF3D",425,0) + ;"Purpose: To cycle through all records in file 50 and ensure drugs are marked +"RTN","TMGNDF3D",426,0) + ;" with needed code for Application Use, I.e. that field 63 has +"RTN","TMGNDF3D",427,0) + ;" a listing of possible doses for use in CPRS +"RTN","TMGNDF3D",428,0) + ;" ALSO will ensure that Package is properly set. +"RTN","TMGNDF3D",429,0) + +"RTN","TMGNDF3D",430,0) + new Itr +"RTN","TMGNDF3D",431,0) + new NumModified set NumModified=0 +"RTN","TMGNDF3D",432,0) + new abort set abort=0 +"RTN","TMGNDF3D",433,0) + +"RTN","TMGNDF3D",434,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3D",435,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3D",436,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF3D",437,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3D",438,0) + . if +$piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDF3D",439,0) + . new IEN50 +"RTN","TMGNDF3D",440,0) + . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",1) +"RTN","TMGNDF3D",441,0) + . set NumModified=NumModified+$$Fix1AppUse(IEN50) +"RTN","TMGNDF3D",442,0) + . set NumModified=NumModified+$$Fix1PkgDoses(IEN50) +"RTN","TMGNDF3D",443,0) + . set IEN50=$piece($get(^TMG(22706.9,IEN,7)),"^",2) +"RTN","TMGNDF3D",444,0) + . set NumModified=NumModified+$$Fix1AppUse(IEN50) +"RTN","TMGNDF3D",445,0) + . set NumModified=NumModified+$$Fix1PkgDoses(IEN50) +"RTN","TMGNDF3D",446,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3D",447,0) + +"RTN","TMGNDF3D",448,0) + write NumModified," modifications made in DRUG file.",! +"RTN","TMGNDF3D",449,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3D",450,0) + +"RTN","TMGNDF3D",451,0) + quit +"RTN","TMGNDF3D",452,0) + +"RTN","TMGNDF3D",453,0) + +"RTN","TMGNDF3D",454,0) +AskFix1AppUse +"RTN","TMGNDF3D",455,0) + ;"Purpose: for testing purposes, ask user for 1 drug and fix that one +"RTN","TMGNDF3D",456,0) + new DIC,Y +"RTN","TMGNDF3D",457,0) + set DIC(0)="MAEQ" +"RTN","TMGNDF3D",458,0) + set DIC=50 +"RTN","TMGNDF3D",459,0) + do ^DIC write ! +"RTN","TMGNDF3D",460,0) + if +Y>0 do Fix1AppUse(+Y) +"RTN","TMGNDF3D",461,0) + quit +"RTN","TMGNDF3D",462,0) + +"RTN","TMGNDF3D",463,0) + +"RTN","TMGNDF3D",464,0) +Fix1AppUse(IEN50) +"RTN","TMGNDF3D",465,0) + ;"Purpose: to Fix one Drug in 50 so that field 63 contains "O" code +"RTN","TMGNDF3D",466,0) + ;"Result: 1 if modified, 0 if not modified. +"RTN","TMGNDF3D",467,0) + +"RTN","TMGNDF3D",468,0) + new result set result=0 +"RTN","TMGNDF3D",469,0) + if +$get(IEN50)=0 goto F1AD +"RTN","TMGNDF3D",470,0) + new code set code=$piece($get(^PSDRUG(IEN50,2)),"^",3) +"RTN","TMGNDF3D",471,0) + new PSIUX,PSIUDA +"RTN","TMGNDF3D",472,0) + set PSIUDA=+IEN50 +"RTN","TMGNDF3D",473,0) + if code'["O" do +"RTN","TMGNDF3D",474,0) + . set PSIUX="O^OUTPATIENT" +"RTN","TMGNDF3D",475,0) + . do ENPSGIU ;"EN^PSGIU +"RTN","TMGNDF3D",476,0) + . set result=1 +"RTN","TMGNDF3D",477,0) + +"RTN","TMGNDF3D",478,0) + if code'["U" do +"RTN","TMGNDF3D",479,0) + . set PSIUX="U^U" +"RTN","TMGNDF3D",480,0) + . do ENPSGIU ;"EN^PSGIU +"RTN","TMGNDF3D",481,0) + . set result=1 +"RTN","TMGNDF3D",482,0) + +"RTN","TMGNDF3D",483,0) + ;"if code'["U" do +"RTN","TMGNDF3D",484,0) + if code'["I" do +"RTN","TMGNDF3D",485,0) + . set PSIUX="I^INPATIENT" +"RTN","TMGNDF3D",486,0) + . do ENPSGIU ;"EN^PSGIU +"RTN","TMGNDF3D",487,0) + . set result=1 +"RTN","TMGNDF3D",488,0) +F1AD +"RTN","TMGNDF3D",489,0) + quit result +"RTN","TMGNDF3D",490,0) + +"RTN","TMGNDF3D",491,0) + +"RTN","TMGNDF3D",492,0) +ENPSGIU +"RTN","TMGNDF3D",493,0) + ;"Purpose: This code is copied from EN^PSGIU and modified so that it +"RTN","TMGNDF3D",494,0) + ;" doesn't ask for confirmation, and is easier for me to read +"RTN","TMGNDF3D",495,0) + ;" It is the 'appropriate' method for setting field 63 in file 50 +"RTN","TMGNDF3D",496,0) + ;"Input: Expected vars: PSIUDA=IEN in 50 to change +"RTN","TMGNDF3D",497,0) + ;" PSIUX=Code to add. Format: 'Code^Description' +"RTN","TMGNDF3D",498,0) + +"RTN","TMGNDF3D",499,0) + new PSIUA,PSIUQ,PSIUO,PSIUY,PSIUT,% +"RTN","TMGNDF3D",500,0) + +"RTN","TMGNDF3D",501,0) + ;"Q:$S('$D(PSIUDA):1,'$D(PSIUX):1,PSIUX'?1E1"^"1.E:1,1:'$D(^PSDRUG(PSIUDA,0))) set PSIUO=$P($G(^(2)),"^",3) set PSIUT=$P(PSIUX,"^",2),PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT,(%,PSIUQ)=PSIUO'[$E(PSIUX)+1 +"RTN","TMGNDF3D",502,0) + if '$D(PSIUDA)!('$D(PSIUX)) quit +"RTN","TMGNDF3D",503,0) + if (PSIUX'?1E1"^"1.E)!('$D(^PSDRUG(PSIUDA,0))) quit +"RTN","TMGNDF3D",504,0) + set PSIUO=$P($G(^(2)),"^",3) +"RTN","TMGNDF3D",505,0) + set PSIUT=$P(PSIUX,"^",2) +"RTN","TMGNDF3D",506,0) + set PSIUT=$S($E(PSIUT,1,4)="UNIT":"",1:$E("N","AEIOU"[$E(PSIUT)))_" "_PSIUT +"RTN","TMGNDF3D",507,0) + set (%,PSIUQ)=PSIUO'[$E(PSIUX)+1 +"RTN","TMGNDF3D",508,0) + ;"F W !!,"A",PSIUT," ITEM" D YN^DICN Q:% D MQ S %=PSIUQ +"RTN","TMGNDF3D",509,0) + ;"I %<0 set PSIUA="^" G DONE +"RTN","TMGNDF3D",510,0) + set %=1 ;"//kt added default answer to YES +"RTN","TMGNDF3D",511,0) + set PSIUA=$E("YN",%) +"RTN","TMGNDF3D",512,0) + ;"G:%=PSIUQ DONE +"RTN","TMGNDF3D",513,0) + if %=1 do +"RTN","TMGNDF3D",514,0) + . new Code set Code=$P(PSIUX,"^") +"RTN","TMGNDF3D",515,0) + . if PSIUO[Code set Code="" +"RTN","TMGNDF3D",516,0) + . set PSIUY=PSIUO_Code +"RTN","TMGNDF3D",517,0) + . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY +"RTN","TMGNDF3D",518,0) + . if $P(^(0),"^")]"" do +"RTN","TMGNDF3D",519,0) + . . set ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA)="" +"RTN","TMGNDF3D",520,0) + if %=2 do +"RTN","TMGNDF3D",521,0) + . set PSIUY=$P(PSIUO,$P(PSIUX,"^"))_$P(PSIUO,$P(PSIUX,"^"),2) +"RTN","TMGNDF3D",522,0) + . set $P(^PSDRUG(PSIUDA,2),"^",3)=PSIUY +"RTN","TMGNDF3D",523,0) + . if $P(^(0),"^")]"" do +"RTN","TMGNDF3D",524,0) + . . kill ^PSDRUG("AIU"_$P(PSIUX,"^"),$P(^(0),"^"),PSIUDA) +"RTN","TMGNDF3D",525,0) + kill:PSIUO]"" ^PSDRUG("IU",PSIUO,PSIUDA) +"RTN","TMGNDF3D",526,0) + set:PSIUY]"" ^PSDRUG("IU",PSIUY,PSIUDA)="" +"RTN","TMGNDF3D",527,0) + ; +"RTN","TMGNDF3D",528,0) +DONE ; +"RTN","TMGNDF3D",529,0) + kill PSIU,PSIUO,PSIUQ,PSIUT,PSIUY Q +"RTN","TMGNDF3D",530,0) + +"RTN","TMGNDF3D",531,0) + +"RTN","TMGNDF3D",532,0) + +"RTN","TMGNDF3D",533,0) + ;"======================================================================= +"RTN","TMGNDF3D",534,0) + ;"======================================================================= +"RTN","TMGNDF3D",535,0) + +"RTN","TMGNDF3D",536,0) +Fix1PkgDoses(IEN50) +"RTN","TMGNDF3D",537,0) + ;"Purpose: to check all possible doses and ensure proper package codes present +"RTN","TMGNDF3D",538,0) + ;"Result: 1 if modified, 0 if not modified. +"RTN","TMGNDF3D",539,0) + +"RTN","TMGNDF3D",540,0) + new result set result=0 +"RTN","TMGNDF3D",541,0) + if +$get(IEN50)=0 goto FPDDone +"RTN","TMGNDF3D",542,0) + new IEN50d0903 set IEN50d0903=0 +"RTN","TMGNDF3D",543,0) + for set IEN50d0903=$order(^PSDRUG(IEN50,"DOS1",IEN50d0903)) quit:(+IEN50d0903'>0) do +"RTN","TMGNDF3D",544,0) + . new CurValue set CurValue=$piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3) +"RTN","TMGNDF3D",545,0) + . if (CurValue["I")&(CurValue["O") quit +"RTN","TMGNDF3D",546,0) + . if CurValue'["I" set CurValue=CurValue_"I" +"RTN","TMGNDF3D",547,0) + . if CurValue'["O" set CurValue=CurValue_"O" +"RTN","TMGNDF3D",548,0) + . set $piece(^PSDRUG(IEN50,"DOS1",IEN50d0903,0),"^",3)=CurValue +"RTN","TMGNDF3D",549,0) + . set result=1 +"RTN","TMGNDF3D",550,0) +FPDDone +"RTN","TMGNDF3D",551,0) + quit result +"RTN","TMGNDF3D",552,0) + +"RTN","TMGNDF3D",553,0) + +"RTN","TMGNDF3D",554,0) +EditDividable +"RTN","TMGNDF3D",555,0) + ;"Purpose: To edit custom field 22706.8 (TMG DIVIDABLE) in file 50.606 (DOSAGE FORM) +"RTN","TMGNDF3D",556,0) + ;"Input: none. +"RTN","TMGNDF3D",557,0) + ;"Output: file 50.606 may be edited. +"RTN","TMGNDF3D",558,0) + +"RTN","TMGNDF3E") +0^52^B4600 +"RTN","TMGNDF3E",1,0) +TMGNDF3E ;TMG/kst/FDA Import: Inactivate unwanted DRUGs ;03/25/06 +"RTN","TMGNDF3E",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF3E",3,0) + +"RTN","TMGNDF3E",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF3E",5,0) + ;" Inactivate DRUG entries not linked to import. +"RTN","TMGNDF3E",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF3E",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF3E",8,0) + ;"11-21-2006 +"RTN","TMGNDF3E",9,0) + +"RTN","TMGNDF3E",10,0) + ;"======================================================================= +"RTN","TMGNDF3E",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF3E",12,0) + ;"======================================================================= +"RTN","TMGNDF3E",13,0) + ;"Menu +"RTN","TMGNDF3E",14,0) + ;"======================================================================= +"RTN","TMGNDF3E",15,0) + +"RTN","TMGNDF3E",16,0) + ;"======================================================================= +"RTN","TMGNDF3E",17,0) + ;" Private Functions. +"RTN","TMGNDF3E",18,0) + ;"======================================================================= +"RTN","TMGNDF3E",19,0) + +"RTN","TMGNDF3E",20,0) +Menu +"RTN","TMGNDF3E",21,0) + ;"Purpose: Provide menu to entry points of main routines +"RTN","TMGNDF3E",22,0) + +"RTN","TMGNDF3E",23,0) + new Menu,UsrSlct +"RTN","TMGNDF3E",24,0) + set Menu(0)="Pick Option for Inactivate unused DRUG file entries (3E)" +"RTN","TMGNDF3E",25,0) + set Menu(1)="Inactivate DRUG entries not linked to import"_$char(9)_"InactivateUnused" +"RTN","TMGNDF3E",26,0) + set Menu(2)="Kill DRUG entries not linked to import (CAUTION!)"_$char(9)_"KillUnused" +"RTN","TMGNDF3E",27,0) + set Menu(3)="View DRUG entries that ARE linked to import"_$char(9)_"BrowseUsed" +"RTN","TMGNDF3E",28,0) + set Menu(4)="Review DRUG entries for bad imports"_$char(9)_"CheckForBad" +"RTN","TMGNDF3E",29,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF3E",30,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF3E",31,0) + +"RTN","TMGNDF3E",32,0) +MC1 write # +"RTN","TMGNDF3E",33,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF3E",34,0) + if UsrSlct="^" goto MCDone +"RTN","TMGNDF3E",35,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGNDF3E",36,0) + +"RTN","TMGNDF3E",37,0) + if UsrSlct="InactivateUnused" do InactivateUnused goto MC1 +"RTN","TMGNDF3E",38,0) + if UsrSlct="KillUnused" do KillUnused goto MC1 +"RTN","TMGNDF3E",39,0) + if UsrSlct="BrowseUsed" do BrowseUsed goto MC1 +"RTN","TMGNDF3E",40,0) + if UsrSlct="CheckForBad" do ReviewForBad goto MC1 +"RTN","TMGNDF3E",41,0) + if UsrSlct="Prev" goto Menu^TMGNDF3D ;"quit can occur from there... +"RTN","TMGNDF3E",42,0) + if UsrSlct="Next" goto Menu^TMGNDF4A ;"quit can occur from there... +"RTN","TMGNDF3E",43,0) + goto MC1 +"RTN","TMGNDF3E",44,0) + +"RTN","TMGNDF3E",45,0) +MCDone +"RTN","TMGNDF3E",46,0) + quit +"RTN","TMGNDF3E",47,0) + +"RTN","TMGNDF3E",48,0) + ;"======================================================================= +"RTN","TMGNDF3E",49,0) + +"RTN","TMGNDF3E",50,0) +InactivateUnused +"RTN","TMGNDF3E",51,0) + ;"Purpose: To cycle through all DRUG entries and inactivate those +"RTN","TMGNDF3E",52,0) + ;" not linked to a non-skipped entry in 22706.9 (TMG FDA IMPORT COMPILED) +"RTN","TMGNDF3E",53,0) + ;"Input: none +"RTN","TMGNDF3E",54,0) + ;"Results: none. +"RTN","TMGNDF3E",55,0) + +"RTN","TMGNDF3E",56,0) + new count set count=0 +"RTN","TMGNDF3E",57,0) + new OnlyTMG set OnlyTMG=1 +"RTN","TMGNDF3E",58,0) + new % set %=1 +"RTN","TMGNDF3E",59,0) + write !,!,"When scanning through records in the DRUG file,",! +"RTN","TMGNDF3E",60,0) + write "should just entries that this FDA import process",! +"RTN","TMGNDF3E",61,0) + write "has added (for example, on a previous run), or ",! +"RTN","TMGNDF3E",62,0) + write "should ALL entries be considered for inactivation?",! +"RTN","TMGNDF3E",63,0) + write "Inactivate ONLY former FDA imports" do YN^DICN write ! +"RTN","TMGNDF3E",64,0) + if %=-1 goto IUDone +"RTN","TMGNDF3E",65,0) + if %=1 goto IU2 +"RTN","TMGNDF3E",66,0) + set %=1 +"RTN","TMGNDF3E",67,0) + write "Inactivate ALL DRUG entries" do YN^DICN write ! +"RTN","TMGNDF3E",68,0) + if %'=1 goto IUDone +"RTN","TMGNDF3E",69,0) + set OnlyTMG=0 +"RTN","TMGNDF3E",70,0) + +"RTN","TMGNDF3E",71,0) +IU2 new Itr,IEN +"RTN","TMGNDF3E",72,0) + new abort set abort=0 +"RTN","TMGNDF3E",73,0) + set IEN=$$ItrInit^TMGITR(50,.Itr) +"RTN","TMGNDF3E",74,0) + write !,"Scanning DRUG entries to find entries to inactivate...",! +"RTN","TMGNDF3E",75,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3E",76,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF3E",77,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3E",78,0) + . if (OnlyTMG=1),($$TMGAdded(IEN)=0) quit +"RTN","TMGNDF3E",79,0) + . new fdaIEN set fdaIEN=+$$GetfdaIEN^TMGNDFUT(IEN) +"RTN","TMGNDF3E",80,0) + . if (fdaIEN'>0)&(OnlyTMG=1) quit +"RTN","TMGNDF3E",81,0) + . if (fdaIEN>0),($piece($get(^TMG(22706.9,fdaIEN,1)),"^",4)'=1) quit ;" 1=SKIP +"RTN","TMGNDF3E",82,0) + . new InactiveDate set InactiveDate=$$GET1^DIQ(50,IEN_",",100) +"RTN","TMGNDF3E",83,0) + . if InactiveDate'="" quit ;"already inactivated. +"RTN","TMGNDF3E",84,0) + . ;"write "Inactivate-->",$$GET1^DIQ(50,IEN_",",.01),! +"RTN","TMGNDF3E",85,0) + . do AddMsg^TMGNDF3C(IEN,"TMG INACTIV D/T NO FDA") ;"Add a message in the Activity log field +"RTN","TMGNDF3E",86,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3E",87,0) + . set TMGFDA(50,IEN_",",100)="NOW" +"RTN","TMGNDF3E",88,0) + . do FILE^DIE("KE","TMGFDA","TMGMSG") +"RTN","TMGNDF3E",89,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3E",90,0) + . set count=count+1 +"RTN","TMGNDF3E",91,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3E",92,0) + +"RTN","TMGNDF3E",93,0) +IUDone +"RTN","TMGNDF3E",94,0) + write count," entries inactivated.",! +"RTN","TMGNDF3E",95,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3E",96,0) + quit +"RTN","TMGNDF3E",97,0) + +"RTN","TMGNDF3E",98,0) + +"RTN","TMGNDF3E",99,0) +KillUnused +"RTN","TMGNDF3E",100,0) + ;"Purpose: To cycle through all DRUG entries and kill those +"RTN","TMGNDF3E",101,0) + ;" not linked to a non-skipped entry in 22706.9 (TMG FDA IMPORT COMPILED) +"RTN","TMGNDF3E",102,0) + ;"Input: none +"RTN","TMGNDF3E",103,0) + ;"Results: none. +"RTN","TMGNDF3E",104,0) + +"RTN","TMGNDF3E",105,0) + new count set count=0 +"RTN","TMGNDF3E",106,0) + +"RTN","TMGNDF3E",107,0) + write !,! +"RTN","TMGNDF3E",108,0) + write "**********************************************************",! +"RTN","TMGNDF3E",109,0) + write "NOTICE: * IMPORTANT *",! +"RTN","TMGNDF3E",110,0) + write "This process could delete drugs that are referenced",! +"RTN","TMGNDF3E",111,0) + write "by an active medical record. As such that would be",! +"RTN","TMGNDF3E",112,0) + write "an alteration of a record (i.e. illegal).",!,! +"RTN","TMGNDF3E",113,0) + write "This process should only be used during initial",! +"RTN","TMGNDF3E",114,0) + write "installation of the drug files (i.e. during debugging etc.)",!,! +"RTN","TMGNDF3E",115,0) + write "**********************************************************",! +"RTN","TMGNDF3E",116,0) + write "If you want to continue, type: 'I UNDERSTAND'",! +"RTN","TMGNDF3E",117,0) + new temp +"RTN","TMGNDF3E",118,0) + read "> ",temp:($get(DTIME,3600)),! +"RTN","TMGNDF3E",119,0) + if temp'="I UNDERSTAND" goto KUDone +"RTN","TMGNDF3E",120,0) + +"RTN","TMGNDF3E",121,0) + new Itr,IEN +"RTN","TMGNDF3E",122,0) + new abort set abort=0 +"RTN","TMGNDF3E",123,0) + set IEN=$$ItrInit^TMGITR(50,.Itr) +"RTN","TMGNDF3E",124,0) + write !,"Scanning DRUG entries to find unused entries to delete...",! +"RTN","TMGNDF3E",125,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3E",126,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF3E",127,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3E",128,0) + . new fdaIEN set fdaIEN=+$$GetfdaIEN^TMGNDFUT(IEN) +"RTN","TMGNDF3E",129,0) + . if (fdaIEN>0),($piece($get(^TMG(22706.9,fdaIEN,1)),"^",4)'=1) quit ;" 1=SKIP +"RTN","TMGNDF3E",130,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF3E",131,0) + . set TMGFDA(50,IEN_",",.01)="@" ;"delete record +"RTN","TMGNDF3E",132,0) + . do FILE^DIE("KE","TMGFDA","TMGMSG") +"RTN","TMGNDF3E",133,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF3E",134,0) + . set count=count+1 +"RTN","TMGNDF3E",135,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF3E",136,0) + +"RTN","TMGNDF3E",137,0) +KUDone +"RTN","TMGNDF3E",138,0) + write count," unlinked entries deleted.",! +"RTN","TMGNDF3E",139,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF3E",140,0) + quit +"RTN","TMGNDF3E",141,0) + +"RTN","TMGNDF3E",142,0) + +"RTN","TMGNDF3E",143,0) + +"RTN","TMGNDF3E",144,0) +TMGAdded(IEN50) +"RTN","TMGNDF3E",145,0) + ;"Purpose: to determine if the record in 50 is one that this TMG code added. +"RTN","TMGNDF3E",146,0) + ;"Input: IEN50 -- IEN in file 50 +"RTN","TMGNDF3E",147,0) + ;"Results: 1 if TMG added, 0 otherwise. +"RTN","TMGNDF3E",148,0) + +"RTN","TMGNDF3E",149,0) + new result set result=0 +"RTN","TMGNDF3E",150,0) + new idx set idx=0 +"RTN","TMGNDF3E",151,0) + for set idx=$order(^PSDRUG(IEN50,4,idx)) quit:(idx="")!(result=1) do +"RTN","TMGNDF3E",152,0) + . new msg set msg=$piece($get(^PSDRUG(IEN50,4,idx,0)),"^",5) +"RTN","TMGNDF3E",153,0) + . if $extract(msg,1,3)="TMG" set result=1 +"RTN","TMGNDF3E",154,0) + quit result +"RTN","TMGNDF3E",155,0) + +"RTN","TMGNDF3E",156,0) + ;"======================== +"RTN","TMGNDF3E",157,0) +GetUsed(pList,pSource) +"RTN","TMGNDF3E",158,0) + ;"Purpose: to Get a list of DRUG entries that are linked to from an import that is not SKIPPED +"RTN","TMGNDF3E",159,0) + ;"Input: pList -- PASS BY NAME. An OUT PARAMETER. Format: +"RTN","TMGNDF3E",160,0) + ;" @pList@(IEN50)="" +"RTN","TMGNDF3E",161,0) + ;" @pList@(IEN50)="" +"RTN","TMGNDF3E",162,0) + ;" pSource -- OPTIONAL. PASS BY NAME. an OUT PARAMETER. Format: +"RTN","TMGNDF3E",163,0) + ;" @pSource@(IEN50,IEN22706d9)="" +"RTN","TMGNDF3E",164,0) + ;" @pSource@(IEN50,IEN22706d9)="" +"RTN","TMGNDF3E",165,0) + ;"Results: None +"RTN","TMGNDF3E",166,0) + +"RTN","TMGNDF3E",167,0) + new Itr,IEN +"RTN","TMGNDF3E",168,0) + new temp +"RTN","TMGNDF3E",169,0) + set pSource=$get(pSource,"temp") +"RTN","TMGNDF3E",170,0) + new abort set abort=0 +"RTN","TMGNDF3E",171,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF3E",172,0) + write !,"Scanning DRUG entries to Browse/View...",! +"RTN","TMGNDF3E",173,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF3E",174,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF3E",175,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF3E",176,0) + . if $piece($get(^TMG(22706.9,IEN,1)),"^",4)=1 quit ;" 1=SKIP +"RTN","TMGNDF3E",177,0) + . new gIEN,tIEN +"RTN","TMGNDF3E",178,0) + . set tIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) +"RTN","TMGNDF3E",179,0) + . set gIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) +"RTN","TMGNDF3E",180,0) + . if tIEN>0 set @pList@(tIEN)="",@pSource@(tIEN,IEN)="" +"RTN","TMGNDF3E",181,0) + . if gIEN>0 set @pList@(gIEN)="",@pSource@(gIEN,IEN)="" +"RTN","TMGNDF3E",182,0) + +"RTN","TMGNDF3E",183,0) + quit +"RTN","TMGNDF3E",184,0) + +"RTN","TMGNDF3E",185,0) +BrowseUsed +"RTN","TMGNDF3E",186,0) + ;"Purpose: To Browse DRUG entries that are linked to a used import (not skipped) +"RTN","TMGNDF3E",187,0) + +"RTN","TMGNDF3E",188,0) + new List +"RTN","TMGNDF3E",189,0) + new Options,IEN +"RTN","TMGNDF3E",190,0) + +"RTN","TMGNDF3E",191,0) + set Options("FIELDS",1)=".01^GENERIC NAME^41" +"RTN","TMGNDF3E",192,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3E",193,0) + set Options("FIELDS",2)="31^NDC^16" +"RTN","TMGNDF3E",194,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3E",195,0) + set Options("FIELDS","MAX NUM")=2 +"RTN","TMGNDF3E",196,0) + set Options("FILE")="50^DRUG" +"RTN","TMGNDF3E",197,0) + +"RTN","TMGNDF3E",198,0) + do GetUsed($name(Options("IEN LIST"))) +"RTN","TMGNDF3E",199,0) + +"RTN","TMGNDF3E",200,0) + new temp +"RTN","TMGNDF3E",201,0) + set temp=$$SELED^TMGSELED(.Options) +"RTN","TMGNDF3E",202,0) + +"RTN","TMGNDF3E",203,0) +BUDone quit +"RTN","TMGNDF3E",204,0) + +"RTN","TMGNDF3E",205,0) + +"RTN","TMGNDF3E",206,0) + ;"======================================= +"RTN","TMGNDF3E",207,0) +ReviewForBad +"RTN","TMGNDF3E",208,0) + ;"Purpose: To review DRUG entries for bad imports +"RTN","TMGNDF3E",209,0) + ;"Input: none +"RTN","TMGNDF3E",210,0) + ;"Output: ... +"RTN","TMGNDF3E",211,0) + +"RTN","TMGNDF3E",212,0) + ;"Results: None +"RTN","TMGNDF3E",213,0) + +"RTN","TMGNDF3E",214,0) + new List +"RTN","TMGNDF3E",215,0) + new IEN50List,IEN50,IEN22706d9,SrcList +"RTN","TMGNDF3E",216,0) + new IENTMGList +"RTN","TMGNDF3E",217,0) + new resultList +"RTN","TMGNDF3E",218,0) + +"RTN","TMGNDF3E",219,0) + do GetUsed("IEN50List","SrcList") +"RTN","TMGNDF3E",220,0) + +"RTN","TMGNDF3E",221,0) + do IENSelector^TMGUSRIF("IEN50List","resultList",50,".01",40,"Select any bad names to investigate them. [ESC][ESC] to exit",".01") +"RTN","TMGNDF3E",222,0) + +"RTN","TMGNDF3E",223,0) + new Options +"RTN","TMGNDF3E",224,0) + +"RTN","TMGNDF3E",225,0) + set IEN50="" +"RTN","TMGNDF3E",226,0) + for set IEN50=$order(resultList(IEN50)) quit:(IEN50="") do +"RTN","TMGNDF3E",227,0) + . set IEN22706d9=$order(^TMG(22706.9,"DRUGT",IEN50,"")) +"RTN","TMGNDF3E",228,0) + . if IEN22706d9'="" set Options("IEN LIST",IEN22706d9)="" +"RTN","TMGNDF3E",229,0) + . set IEN22706d9=$order(^TMG(22706.9,"DRUG",IEN50,"")) +"RTN","TMGNDF3E",230,0) + . if IEN22706d9'="" set Options("IEN LIST",IEN22706d9)="" +"RTN","TMGNDF3E",231,0) + +"RTN","TMGNDF3E",232,0) + set Options("FIELDS",1)=".055^TRADE NAME & FORM - 40^35" +"RTN","TMGNDF3E",233,0) + set Options("FIELDS",1,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3E",234,0) + set Options("FIELDS",2)=".075^,@pSource@(tIEN,IEN)=""^35" +"RTN","TMGNDF3E",235,0) + set Options("FIELDS",2,"NO EDIT")=1 ;"i.e. show for browsing, but don't allow edit +"RTN","TMGNDF3E",236,0) + set Options("FIELDS",3)="6^SKIP THIS RECORD^5" +"RTN","TMGNDF3E",237,0) + set Options("FIELDS","MAX NUM")=3 +"RTN","TMGNDF3E",238,0) + set Options("FILE")="22706.9^TMG FDA IMPORT COMPILED" +"RTN","TMGNDF3E",239,0) + +"RTN","TMGNDF3E",240,0) + new temp +"RTN","TMGNDF3E",241,0) + set temp=$$SELED^TMGSELED(.Options) +"RTN","TMGNDF3E",242,0) + +"RTN","TMGNDF3E",243,0) + quit +"RTN","TMGNDF4A") +0^53^B6524 +"RTN","TMGNDF4A",1,0) +TMGNDF4A ;TMG/kst/FDA Import: Create POI's from DRUGs ;03/25/06 +"RTN","TMGNDF4A",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF4A",3,0) + +"RTN","TMGNDF4A",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4A",5,0) + ;" Creation of records in file 50.7 (PHARMACY ORDERABLE ITEM file) +"RTN","TMGNDF4A",6,0) + ;" from all records stored in file 50 (DRUG file) +"RTN","TMGNDF4A",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4A",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4A",9,0) + ;"11-21-2006 +"RTN","TMGNDF4A",10,0) + +"RTN","TMGNDF4A",11,0) + ;"======================================================================= +"RTN","TMGNDF4A",12,0) + ;" API -- Public Functions. +"RTN","TMGNDF4A",13,0) + ;"======================================================================= +"RTN","TMGNDF4A",14,0) + ;"Menu +"RTN","TMGNDF4A",15,0) + +"RTN","TMGNDF4A",16,0) + ;"======================================================================= +"RTN","TMGNDF4A",17,0) + ;" Private Functions. +"RTN","TMGNDF4A",18,0) + ;"======================================================================= +"RTN","TMGNDF4A",19,0) + ;"InactivatePOIs -- inactivate all POI (entries in PHARMACY ORDERABLE ITEMS) +"RTN","TMGNDF4A",20,0) + ;"ActivatePOI(IEN50d7) -- remove the inactivation date that is automatically added +"RTN","TMGNDF4A",21,0) + ;"HandlePOIErr -- error handler for ActivatePOI +"RTN","TMGNDF4A",22,0) + +"RTN","TMGNDF4A",23,0) + ;"SyncAllTMG -- Add all relevent TMG entries into POI +"RTN","TMGNDF4A",24,0) + ;"AddFromTMG(IEN) -- Add/Update ONE entry in POI file +"RTN","TMGNDF4A",25,0) + ;"Do1POI(DrugNAF,IEN50,IEN50d606,IEN51d2) -- add/refresh one POI entry. +"RTN","TMGNDF4A",26,0) + +"RTN","TMGNDF4A",27,0) + ;"============================================================================= +"RTN","TMGNDF4A",28,0) + ;"============================================================================= +"RTN","TMGNDF4A",29,0) + +"RTN","TMGNDF4A",30,0) +Menu +"RTN","TMGNDF4A",31,0) + new Menu,UsrSlct +"RTN","TMGNDF4A",32,0) + set Menu(0)="Pick Option to Sync to PHARMACY ORDERABLE ITEMS (4A)" +"RTN","TMGNDF4A",33,0) + set Menu(1)="Sync Non-Skipped Imports to PHARMACY ORDERABLE ITEMS."_$char(9)_"SyncDRUGs" +"RTN","TMGNDF4A",34,0) + ;"set Menu(2)="Activate all PHARMACY ORDERABLE ITEMS (do after syncing)"_$char(9)_"ActivateAll" +"RTN","TMGNDF4A",35,0) + set Menu(3)="Kill all previous PHARMACY ORDERABLE ITEMS (only if needed!)"_$char(9)_"KillAll" +"RTN","TMGNDF4A",36,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF4A",37,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF4A",38,0) + +"RTN","TMGNDF4A",39,0) +M1 write # +"RTN","TMGNDF4A",40,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4A",41,0) + +"RTN","TMGNDF4A",42,0) + if UsrSlct="SyncDRUGs" do SyncAllTMG goto M1 +"RTN","TMGNDF4A",43,0) + ;"if UsrSlct="ActivateAll" do ActivAll goto M1 +"RTN","TMGNDF4A",44,0) + if UsrSlct="KillAll" do KillPOIs goto M1 +"RTN","TMGNDF4A",45,0) + if UsrSlct="Prev" goto Menu^TMGNDF3E ;"quit can occur from there... +"RTN","TMGNDF4A",46,0) + if UsrSlct="Next" goto Menu^TMGNDF4B ;"quit can occur from there... +"RTN","TMGNDF4A",47,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF4A",48,0) + goto M1 +"RTN","TMGNDF4A",49,0) + +"RTN","TMGNDF4A",50,0) +MenuDone +"RTN","TMGNDF4A",51,0) + quit +"RTN","TMGNDF4A",52,0) + +"RTN","TMGNDF4A",53,0) + +"RTN","TMGNDF4A",54,0) + ;"============================================================================= +"RTN","TMGNDF4A",55,0) + ;"File 50.7 (PHARMACY ORDERABLE ITEM): +"RTN","TMGNDF4A",56,0) + ;" +"RTN","TMGNDF4A",57,0) + ;" **A record in 50.7 should be created first. +"RTN","TMGNDF4A",58,0) + ;" .01 field should be the generic name of the drug. +"RTN","TMGNDF4A",59,0) + ;" When the record is created, an entry in fle 101.43 (ORDERABLE ITEM) will automatically be made. +"RTN","TMGNDF4A",60,0) + ;" Also, a record in in ORDER QUICK VIEW will also be created (but it is incomplete--see below.) +"RTN","TMGNDF4A",61,0) + ;" Note: new drugs may not be added unless PSEDITNM>0. So to setup a drug in fileman, +"RTN","TMGNDF4A",62,0) + ;" set PSEDITNM=1 from the command-line, then DO D^DI to get into Fileman with vars intact. +"RTN","TMGNDF4A",63,0) + ;" In the MED ROUTE field, the input transform does not allow an input of "ORAL". (If left +"RTN","TMGNDF4A",64,0) + ;" blank ORAL will be shown in CPRS) +"RTN","TMGNDF4A",65,0) + ;" This file can hold the synonyms of a drug etc. +"RTN","TMGNDF4A",66,0) + ;" When this record is created, for some reason it is automatically given the current +"RTN","TMGNDF4A",67,0) + ;" date in the INACTIVE DAT +"RTN","TMGNDF4A",68,0) + ;"Purpose: to Ask E field--meaning it is created in an inactive state. One must +"RTN","TMGNDF4A",69,0) + ;" go back and edit the record a second time to remove the entry from this field. +"RTN","TMGNDF4A",70,0) + ;" File 101.43 (ORDERABLE ITEM), field ID holds a text pointer to this file, e.g. +"RTN","TMGNDF4A",71,0) + ;" '10;99PSP' <---- 10 is IEN in file #50.7 +"RTN","TMGNDF4A",72,0) + ;" There is no pointer field from file 50.7 up to file 50. The link is FROM file #50 +"RTN","TMGNDF4A",73,0) + ;" TO #50.7 (via file #50's field 2.1(PHARMACY ORDERABLE ITEM)). HOWEVER, File #50.7's +"RTN","TMGNDF4A",74,0) + ;" "ASP" cross-reference for the field "PHARMACY ORDERABLE ITEM (#2.1) i.e. +"RTN","TMGNDF4A",75,0) + ;" ^PSDRUG("ASP",+ID,*), contains list of linked records in file #50 +"RTN","TMGNDF4A",76,0) + +"RTN","TMGNDF4A",77,0) + ;"================================================================= +"RTN","TMGNDF4A",78,0) + +"RTN","TMGNDF4A",79,0) +SyncAllTMG +"RTN","TMGNDF4A",80,0) + ;"Purpose: Sync/Add all relevent TMG entries into POI +"RTN","TMGNDF4A",81,0) + ;"Input:none +"RTN","TMGNDF4A",82,0) + ;"results: none +"RTN","TMGNDF4A",83,0) + +"RTN","TMGNDF4A",84,0) + new IEN,Itr +"RTN","TMGNDF4A",85,0) + new abort set abort=0 +"RTN","TMGNDF4A",86,0) + new result set result=0 +"RTN","TMGNDF4A",87,0) + new repeatNeeded set repeatNeeded=0 +"RTN","TMGNDF4A",88,0) + +"RTN","TMGNDF4A",89,0) +SATL1 set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF4A",90,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4A",91,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1) +"RTN","TMGNDF4A",92,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4A",93,0) + . new Option +"RTN","TMGNDF4A",94,0) + . set Option("CUR MODE")="TRADE" +"RTN","TMGNDF4A",95,0) + . set result=$$POIFromTMG(IEN,.Option) ;"screen for skip will occur in function +"RTN","TMGNDF4A",96,0) + . if result=-1 set repeatNeeded=1 +"RTN","TMGNDF4A",97,0) + . set Option("CUR MODE")="GENERIC" +"RTN","TMGNDF4A",98,0) + . set result=$$POIFromTMG(IEN,.Option) ;"screen for skip will occur in function +"RTN","TMGNDF4A",99,0) + . if result=-1 set repeatNeeded=1 +"RTN","TMGNDF4A",100,0) + +"RTN","TMGNDF4A",101,0) + new % set %=2 +"RTN","TMGNDF4A",102,0) + if repeatNeeded do +"RTN","TMGNDF4A",103,0) + . write !,"Error found and repeat scan needed.",! +"RTN","TMGNDF4A",104,0) + . write "Repeat scan now" do YN^DICN write ! +"RTN","TMGNDF4A",105,0) + else do +"RTN","TMGNDF4A",106,0) + . write ! +"RTN","TMGNDF4A",107,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4A",108,0) + if %=1 goto SATL1 +"RTN","TMGNDF4A",109,0) + +"RTN","TMGNDF4A",110,0) + quit +"RTN","TMGNDF4A",111,0) + +"RTN","TMGNDF4A",112,0) + +"RTN","TMGNDF4A",113,0) +POIFromTMG(IEN22706d9,Option) +"RTN","TMGNDF4A",114,0) + ;"Purpose: to Add/Update/(or delete) ONE entry in POI (50.7) file +"RTN","TMGNDF4A",115,0) + ;"Input: IEN22706d9 -- IEN in 22706.9 +"RTN","TMGNDF4A",116,0) + ;" Option -- NON-OPTIONAL part. Format: +"RTN","TMGNDF4A",117,0) + ;" Option("CUR MODE")="TRADE" or "GENERIC" +"RTN","TMGNDF4A",118,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF4A",119,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF4A",120,0) + ;" to file POI, OI, OQV etc. +"RTN","TMGNDF4A",121,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF4A",122,0) + ;" Option("IEN50","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4A",123,0) + ;" Option("IEN50","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4A",124,0) + ;" Option("CUR MODE")="TRADE" or "GENERIC" +"RTN","TMGNDF4A",125,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF4A",126,0) + ;" Option("DELETING")=1 <-- deleting chain (not IEN22706d9) +"RTN","TMGNDF4A",127,0) + +"RTN","TMGNDF4A",128,0) + ;"NOTE: This function does DOES screen for skipped entries, and skips +"RTN","TMGNDF4A",129,0) + ;" proccessing. BUT, if Deleting, then it is NOT skipped +"RTN","TMGNDF4A",130,0) + ;"Output: POI records will be added or refreshed (or deleted) +"RTN","TMGNDF4A",131,0) + ;"Result: 1=OK, 0=Error, -1 process repeat requested +"RTN","TMGNDF4A",132,0) + +"RTN","TMGNDF4A",133,0) + new result set result=1 +"RTN","TMGNDF4A",134,0) + new repeatNeeded set repeatNeeded=0 +"RTN","TMGNDF4A",135,0) + new TMGA,TMGMSG +"RTN","TMGNDF4A",136,0) + new IEN50d606,IEN51d2,IEN50d7 +"RTN","TMGNDF4A",137,0) + +"RTN","TMGNDF4A",138,0) + if $get(Option("DELETING"))'=1,$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 goto AFTMGDone ;"1=SKIP +"RTN","TMGNDF4A",139,0) + if +$get(IEN22706d9)=0 goto AFTMGDone +"RTN","TMGNDF4A",140,0) + +"RTN","TMGNDF4A",141,0) + new mode set mode=$get(Option("CUR MODE")) +"RTN","TMGNDF4A",142,0) + if mode="" set result=0 goto AFTMGDone +"RTN","TMGNDF4A",143,0) + new field,node,pce +"RTN","TMGNDF4A",144,0) + if mode="GENERIC" set field=5.71,node=8,pce=4 ;"5.71= POI ptr Generic +"RTN","TMGNDF4A",145,0) + else if mode="TRADE" set field=5.61,node=8,pce=3 ;"5.61 = POI ptr Trade +"RTN","TMGNDF4A",146,0) + +"RTN","TMGNDF4A",147,0) + do LoadOption^TMGNDF4C(IEN22706d9,.Option) +"RTN","TMGNDF4A",148,0) + +"RTN","TMGNDF4A",149,0) + set IEN50d606=$piece($get(^TMG(22706.9,IEN22706d9,0)),"^",7) +"RTN","TMGNDF4A",150,0) + set IEN51d2=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",7) +"RTN","TMGNDF4A",151,0) + new IEN50 set IEN50=+$get(Option("IEN50",mode)) +"RTN","TMGNDF4A",152,0) + if IEN50=0 set result=0 goto AFTM2 +"RTN","TMGNDF4A",153,0) + +"RTN","TMGNDF4A",154,0) + new DrugNAF set DrugNAF=$get(Option("DRUG NAME AND FORM",mode)) +"RTN","TMGNDF4A",155,0) + if (DrugNAF="")!(DrugNAF="") goto AFTM2 ;"skip these... +"RTN","TMGNDF4A",156,0) + +"RTN","TMGNDF4A",157,0) + set IEN50d7=+$get(Option("IEN50.7",mode)) +"RTN","TMGNDF4A",158,0) + +"RTN","TMGNDF4A",159,0) + if $get(Option("DELETING"))=1 do goto AFTMGDone +"RTN","TMGNDF4A",160,0) + . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4A",161,0) + . set Option("IEN50.7",mode)="" +"RTN","TMGNDF4A",162,0) + +"RTN","TMGNDF4A",163,0) + if IEN50d7=0 set IEN50d7=$$FindPOI^TMGNDFUT(DrugNAF) +"RTN","TMGNDF4A",164,0) + if IEN50d7=0 do if IEN50d7=0 set result=0 goto AFTM2 +"RTN","TMGNDF4A",165,0) + . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4A",166,0) + . new PSEDITNM set PSEDITNM=1 ;"a key to allow editing data +"RTN","TMGNDF4A",167,0) + . set TMGFDA(50.7,"+1,",.01)=DrugNAF +"RTN","TMGNDF4A",168,0) + . set TMGFDA(50.7,"+1,",.02)=IEN50d606 +"RTN","TMGNDF4A",169,0) + . set TMGFDA(50.7,"+1,",.06)=IEN51d2 +"RTN","TMGNDF4A",170,0) + . set TMGFDA(50.7,"+1,",.07)="R" +"RTN","TMGNDF4A",171,0) + . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4A",172,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",173,0) + . . set result=0 +"RTN","TMGNDF4A",174,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",175,0) + . else set IEN50d7=+$get(TMGIEN(1)) +"RTN","TMGNDF4A",176,0) + else do +"RTN","TMGNDF4A",177,0) + . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4A",178,0) + . new PSEDITNM set PSEDITNM=1 ;"a key to allow editing data +"RTN","TMGNDF4A",179,0) + . set TMGFDA(50.7,IEN50d7_",",.01)=DrugNAF +"RTN","TMGNDF4A",180,0) + . set TMGFDA(50.7,IEN50d7_",",.02)=IEN50d606 +"RTN","TMGNDF4A",181,0) + . set TMGFDA(50.7,IEN50d7_",",.06)=IEN51d2 +"RTN","TMGNDF4A",182,0) + . set TMGFDA(50.7,IEN50d7_",",.07)="R" +"RTN","TMGNDF4A",183,0) + . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF4A",184,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDF4A",185,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",186,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",187,0) + . . set result=0 +"RTN","TMGNDF4A",188,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",189,0) + . . if $get(TMGMSG("DIERR",1))=601 do ;"601 --> [record doesn't exist] +"RTN","TMGNDF4A",190,0) + . . . write "Dangling pointer found & removed. ** RUN ENTIRE PROCESS AGAIN **",! +"RTN","TMGNDF4A",191,0) + . . . set IEN50d7=0 +"RTN","TMGNDF4A",192,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",193,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",field)="@" +"RTN","TMGNDF4A",194,0) + . . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",195,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",196,0) + . . . kill TMGFDA,TMGMSG +"RTN","TMGNDF4A",197,0) + . . . set TMGFDA(50,IEN50_",",2.1)="@" +"RTN","TMGNDF4A",198,0) + . . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",199,0) + . . . set repeatNeeded=1 +"RTN","TMGNDF4A",200,0) + . . . set result=-1 +"RTN","TMGNDF4A",201,0) + . . . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",202,0) + . . . . if $data(TMGMSG("DIERR","E",120))>0 set result="" quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4A",203,0) + . . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",204,0) + +"RTN","TMGNDF4A",205,0) + set Option("IEN50.7",mode)=IEN50d7 +"RTN","TMGNDF4A",206,0) + +"RTN","TMGNDF4A",207,0) + ;"Ensure pointer to POI stored in TMG IMPORT COMPILED +"RTN","TMGNDF4A",208,0) + if +$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce)'=IEN50d7 do +"RTN","TMGNDF4A",209,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",210,0) + . set TMGFDA(22706.9,IEN22706d9_",",field)=IEN50d7 +"RTN","TMGNDF4A",211,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",212,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",213,0) + . set Option("IEN50.7",mode)=IEN50d7 +"RTN","TMGNDF4A",214,0) + +"RTN","TMGNDF4A",215,0) + ;"Ensure pointer to POI stored in DRUG file, field 2.1 +"RTN","TMGNDF4A",216,0) + if +$piece($get(^PSDRUG(IEN50,2)),"^",1)'=IEN50d7 do +"RTN","TMGNDF4A",217,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",218,0) + . set TMGFDA(50,IEN50_",",2.1)=IEN50d7 +"RTN","TMGNDF4A",219,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",220,0) + . set result=0 +"RTN","TMGNDF4A",221,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",222,0) + . . if $data(TMGMSG("DIERR","E",120))>0 set result="" quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4A",223,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",224,0) + +"RTN","TMGNDF4A",225,0) +AFTM2 +"RTN","TMGNDF4A",226,0) + if $get(Option("FIX CHAIN"))=1 do ;"pass message forward for fix +"RTN","TMGNDF4A",227,0) + . do Activ1TMG^TMGNDF4B(IEN22706d9) +"RTN","TMGNDF4A",228,0) + . new temp set temp=$$OIFromTMG^TMGNDF4C(IEN22706d9,.Option) ;" <-- more chaining from this +"RTN","TMGNDF4A",229,0) + . ;"if $get(Option("DELETING"))=1 do +"RTN","TMGNDF4A",230,0) + . ;". new IEN50 set IEN50=+$get(Option("IEN50",mode)) +"RTN","TMGNDF4A",231,0) + . ;". if IEN50=0 write "?? 1 -- In POIFromTMG^TMGNDF4A.",! quit +"RTN","TMGNDF4A",232,0) + . ;". new IEN50d7 set IEN50d7=+$get(Option("IEN50d7",mode)) +"RTN","TMGNDF4A",233,0) + . ;". if IEN50d7=0 set IEN50d7=+$piece(^PSDRUG(IEN50,2),"^",1) ;"try a second way +"RTN","TMGNDF4A",234,0) + . ;". if IEN50d7=0 write "?? 2 -- In POIFromTMG^TMGNDF4A.",! quit +"RTN","TMGNDF4A",235,0) + . ;". new numRef set numRef=$$ListCt^TMGMISC($name(^PSDRUG("ASP",IEN50d7))) +"RTN","TMGNDF4A",236,0) + . ;". if numRef>1 quit ;"don't kill POI if another drug in 50 points to it +"RTN","TMGNDF4A",237,0) + . ;". new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF4A",238,0) + . ;". new PSEDITNM set PSEDITNM=1 ;"a key to allow editing data +"RTN","TMGNDF4A",239,0) + . ;". set TMGFDA(50.7,IEN50d7_",",.01)="@" ;"delete pointer from file 50 +"RTN","TMGNDF4A",240,0) + . ;". do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",241,0) + . ;". if $$ShowIfError^TMGDBAPI(.TMGMSG) quit +"RTN","TMGNDF4A",242,0) + . ;". ;"Now delete from TMG IMPORT COMPILED +"RTN","TMGNDF4A",243,0) + . ;". new field +"RTN","TMGNDF4A",244,0) + . ;". if mode="GENERIC" set field=5.71 +"RTN","TMGNDF4A",245,0) + . ;". else if mode="TRADE" set field=5.61 +"RTN","TMGNDF4A",246,0) + . ;". else write "Can't delete pointer to 50.7 from 22706.9.",!,"Can't determine if GENERIC or TRADE mode.",! quit +"RTN","TMGNDF4A",247,0) + . ;". set TMGFDA(22706.9,IEN22706d9_",",field)="@" ;"delete pointer from TMG IMPORT COMPILED +"RTN","TMGNDF4A",248,0) + . ;". do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",249,0) + . ;". if $$ShowIfError^TMGDBAPI(.TMGMSG) quit +"RTN","TMGNDF4A",250,0) + +"RTN","TMGNDF4A",251,0) +AFTMGDone +"RTN","TMGNDF4A",252,0) + if repeatNeeded=1 set result=-1 +"RTN","TMGNDF4A",253,0) + quit result +"RTN","TMGNDF4A",254,0) + +"RTN","TMGNDF4A",255,0) + ;" === Do1POI is old -- delete later... +"RTN","TMGNDF4A",256,0) +Do1POI(IEN22706d9,IEN50d606,IEN51d2,Option) +"RTN","TMGNDF4A",257,0) + ;"Purpose: add/refresh one PHARMACY ORDERABLE ITEM (POI) entry. +"RTN","TMGNDF4A",258,0) + ;"Input: IEN22706d9 -- IEN in 22706.9 +"RTN","TMGNDF4A",259,0) + ;" IEN50d606 -- IEN in 50.606 +"RTN","TMGNDF4A",260,0) + ;" IEN51d2 -- IEN in 51.2 +"RTN","TMGNDF4A",261,0) + ;" Option -- NON-OPTIONAL PART. Format: +"RTN","TMGNDF4A",262,0) + ;" Option("CUR MODE")="TRADE" or "GENERIC" +"RTN","TMGNDF4A",263,0) + ;" Option("IEN50.7","TRADE")=IEN50.7 for Trade Name +"RTN","TMGNDF4A",264,0) + ;" Option("IEN50.7","GENERIC")=IEN50.7 for Generic Name +"RTN","TMGNDF4A",265,0) + ;" Option("DRUG NAME AND FORM","TRADE")=Trade Name and Form +"RTN","TMGNDF4A",266,0) + ;" Option("DRUG NAME AND FORM","GENERIC")=Generic Name and Form +"RTN","TMGNDF4A",267,0) + ;" Option("IEN50","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4A",268,0) + ;" Option("IEN50","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4A",269,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF4A",270,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF4A",271,0) + ;" to file POI, OI, OQV etc. +"RTN","TMGNDF4A",272,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF4A",273,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF4A",274,0) + ;" Option("DELETING")=1 <-- deleting chain (not IEN22706d9) +"RTN","TMGNDF4A",275,0) + ;"Result: IEN50d7 if OK, -1 =Error, -2 process repeat requested +"RTN","TMGNDF4A",276,0) + +"RTN","TMGNDF4A",277,0) + new result set result="" ;"default to null +"RTN","TMGNDF4A",278,0) + new TMGA,TMGMSG +"RTN","TMGNDF4A",279,0) + new IEN50d7 set IEN50d7=-1 ;"default to error +"RTN","TMGNDF4A",280,0) + new mode set mode=$get(Option("CUR MODE")) +"RTN","TMGNDF4A",281,0) + if mode="" write "ERROR: in Do1POI^TMGNDF4A. Mode not supplied.",! goto D1PDone +"RTN","TMGNDF4A",282,0) + new DrugNAF set DrugNAF=$get(Option("DRUG NAME AND FORM",mode)) +"RTN","TMGNDF4A",283,0) + if (DrugNAF="")!(DrugNAF="") goto D1PDone ;"skip these... +"RTN","TMGNDF4A",284,0) + new IEN50 set IEN50=+$get(Option("IEN50",mode)) if IEN50=0 set result=-1 goto D1PDone +"RTN","TMGNDF4A",285,0) + new IEN50d7 set IEN50d7=+$get(Option("IEN50.7",mode)) +"RTN","TMGNDF4A",286,0) + new field,node,pce +"RTN","TMGNDF4A",287,0) + if mode="GENERIC" set field=5.71,node=8,pce=4 ;"5.71= POI ptr Generic +"RTN","TMGNDF4A",288,0) + else if mode="TRADE" set field=5.61,node=8,pce=3 ;"5.61 = POI ptr Trade +"RTN","TMGNDF4A",289,0) + +"RTN","TMGNDF4A",290,0) + if IEN50d7=0 set IEN50d7=$$FindPOI^TMGNDFUT(DrugNAF) +"RTN","TMGNDF4A",291,0) + if IEN50d7=0 do +"RTN","TMGNDF4A",292,0) + . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4A",293,0) + . new PSEDITNM set PSEDITNM=1 ;"a key to allow editing data +"RTN","TMGNDF4A",294,0) + . set TMGFDA(50.7,"+1,",.01)=DrugNAF +"RTN","TMGNDF4A",295,0) + . set TMGFDA(50.7,"+1,",.02)=IEN50d606 +"RTN","TMGNDF4A",296,0) + . set TMGFDA(50.7,"+1,",.06)=IEN51d2 +"RTN","TMGNDF4A",297,0) + . set TMGFDA(50.7,"+1,",.07)="R" +"RTN","TMGNDF4A",298,0) + . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4A",299,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",300,0) + . . set result=-1 +"RTN","TMGNDF4A",301,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",302,0) + . else set IEN50d7=+$get(TMGIEN(1)) +"RTN","TMGNDF4A",303,0) + else do +"RTN","TMGNDF4A",304,0) + . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4A",305,0) + . new PSEDITNM set PSEDITNM=1 ;"a key to allow editing data +"RTN","TMGNDF4A",306,0) + . set TMGFDA(50.7,IEN50d7_",",.01)=DrugNAF +"RTN","TMGNDF4A",307,0) + . set TMGFDA(50.7,IEN50d7_",",.02)=IEN50d606 +"RTN","TMGNDF4A",308,0) + . set TMGFDA(50.7,IEN50d7_",",.06)=IEN51d2 +"RTN","TMGNDF4A",309,0) + . set TMGFDA(50.7,IEN50d7_",",.07)="R" +"RTN","TMGNDF4A",310,0) + . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF4A",311,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDF4A",312,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",313,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",314,0) + . . set result=-1 +"RTN","TMGNDF4A",315,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",316,0) + . . if $get(TMGMSG("DIERR",1))=601 do ;"601 --> [record doesn't exist] +"RTN","TMGNDF4A",317,0) + . . . write "Dangling pointer found & removed. ** RUN ENTIRE PROCESS AGAIN **",! +"RTN","TMGNDF4A",318,0) + . . . set IEN50d7=0 +"RTN","TMGNDF4A",319,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",320,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",field)="@" +"RTN","TMGNDF4A",321,0) + . . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",322,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",323,0) + . . . kill TMGFDA,TMGMSG +"RTN","TMGNDF4A",324,0) + . . . set TMGFDA(50,IEN50_",",2.1)="@" +"RTN","TMGNDF4A",325,0) + . . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",326,0) + . . . set result=-1 +"RTN","TMGNDF4A",327,0) + . . . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",328,0) + . . . . if $data(TMGMSG("DIERR","E",120))>0 set result="" quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4A",329,0) + . . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",330,0) + +"RTN","TMGNDF4A",331,0) + if +IEN50d7=0 set result=-1 goto D1PDone +"RTN","TMGNDF4A",332,0) + +"RTN","TMGNDF4A",333,0) + ;"if +$get(Option("IEN50.7",mode))=0 do +"RTN","TMGNDF4A",334,0) + ;". new TMGFDA,TMGMSG +"RTN","TMGNDF4A",335,0) + ;". set TMGFDA(22706.9,IEN22706d9_",",field)=IEN50d7 +"RTN","TMGNDF4A",336,0) + ;". do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",337,0) + ;". do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",338,0) + ;". set Option("IEN50.7",mode)=IEN50d7 +"RTN","TMGNDF4A",339,0) + +"RTN","TMGNDF4A",340,0) + ;"Store pointer to POI in TMG IMPORT COMPILED +"RTN","TMGNDF4A",341,0) + if +$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce)'=IEN50d7 do +"RTN","TMGNDF4A",342,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",343,0) + . set TMGFDA(22706.9,IEN22706d9_",",field)=IEN50d7 +"RTN","TMGNDF4A",344,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",345,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",346,0) + . set Option("IEN50.7",mode)=IEN50d7 +"RTN","TMGNDF4A",347,0) + +"RTN","TMGNDF4A",348,0) + if +$piece($get(^PSDRUG(IEN50,2)),"^",1)'=IEN50d7 do +"RTN","TMGNDF4A",349,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",350,0) + . set TMGFDA(50,IEN50_",",2.1)=IEN50d7 +"RTN","TMGNDF4A",351,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",352,0) + . set result=-1 +"RTN","TMGNDF4A",353,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4A",354,0) + . . if $data(TMGMSG("DIERR","E",120))>0 set result="" quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4A",355,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",356,0) + +"RTN","TMGNDF4A",357,0) +D1PDone +"RTN","TMGNDF4A",358,0) + if result="" set result=IEN50d7 +"RTN","TMGNDF4A",359,0) + quit result +"RTN","TMGNDF4A",360,0) + +"RTN","TMGNDF4A",361,0) + ;"================================================================= +"RTN","TMGNDF4A",362,0) + ;"================================================================= +"RTN","TMGNDF4A",363,0) + +"RTN","TMGNDF4A",364,0) + +"RTN","TMGNDF4A",365,0) +InactivatePOIs +"RTN","TMGNDF4A",366,0) + ;"Purpose: To inactivate all POI (entries in PHARMACY ORDERABLE ITEMS) +"RTN","TMGNDF4A",367,0) + ;" This will prevent left-over entries from a prior run to cause problems +"RTN","TMGNDF4A",368,0) + +"RTN","TMGNDF4A",369,0) + new Itr,IEN +"RTN","TMGNDF4A",370,0) + new abort set abort=0 +"RTN","TMGNDF4A",371,0) + write "Inactivating all prior PHARMACY ORDERABLE ITEMS...",! +"RTN","TMGNDF4A",372,0) + set IEN=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4A",373,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4A",374,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF4A",375,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4A",376,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4A",377,0) + . set TMGFDA(50.7,IEN_",",.04)="NOW" +"RTN","TMGNDF4A",378,0) + . do FILE^DIE("KE","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",379,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4A",380,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4A",381,0) + +"RTN","TMGNDF4A",382,0) + quit +"RTN","TMGNDF4A",383,0) + +"RTN","TMGNDF4A",384,0) + +"RTN","TMGNDF4A",385,0) +ActivAll +"RTN","TMGNDF4A",386,0) + ;"DISABLED... THIS SHOULD BE DONE IN TMENDF4B... +"RTN","TMGNDF4A",387,0) + +"RTN","TMGNDF4A",388,0) + ;"Purpose: to activate all POI's +"RTN","TMGNDF4A",389,0) + +"RTN","TMGNDF4A",390,0) + new Itr,IEN +"RTN","TMGNDF4A",391,0) + new abort set abort=0 +"RTN","TMGNDF4A",392,0) + set IEN=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4A",393,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4A",394,0) + if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF4A",395,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4A",396,0) + . new temp +"RTN","TMGNDF4A",397,0) + . set temp=$$ActivatePOI(IEN) +"RTN","TMGNDF4A",398,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4A",399,0) + +"RTN","TMGNDF4A",400,0) + quit +"RTN","TMGNDF4A",401,0) + +"RTN","TMGNDF4A",402,0) + +"RTN","TMGNDF4A",403,0) + +"RTN","TMGNDF4A",404,0) +ActivatePOI(IEN50d7) +"RTN","TMGNDF4A",405,0) + ;"Purpose: to remove the inactivation date that is automatically +"RTN","TMGNDF4A",406,0) + ;" added with editing of the POI record +"RTN","TMGNDF4A",407,0) + ;"result: 1 = OK, 0=error +"RTN","TMGNDF4A",408,0) + +"RTN","TMGNDF4A",409,0) + new result set result=1 +"RTN","TMGNDF4A",410,0) + +"RTN","TMGNDF4A",411,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF4A",412,0) + set TMGFDA(50.7,IEN50d7_",",.04)="@" ;"delete inactivation date field value +"RTN","TMGNDF4A",413,0) + do +"RTN","TMGNDF4A",414,0) + . new $etrap set $etrap="do HandlePOIErr^TMGNDF4A quit" +"RTN","TMGNDF4A",415,0) + . do FILE^DIE("ES","TMGFDA","TMGMSG") +"RTN","TMGNDF4A",416,0) + if $data(TMGMSG("DIERR"))'=0 do goto APOIDone +"RTN","TMGNDF4A",417,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGNDF4A",418,0) + . set result=0 +"RTN","TMGNDF4A",419,0) + . write "Error occurred in function ActivatePOI",! +"RTN","TMGNDF4A",420,0) + . zwr TMGFDA +"RTN","TMGNDF4A",421,0) +APOIDone +"RTN","TMGNDF4A",422,0) + quit result +"RTN","TMGNDF4A",423,0) + +"RTN","TMGNDF4A",424,0) + +"RTN","TMGNDF4A",425,0) +HandlePOIErr +"RTN","TMGNDF4A",426,0) + ;"Purpose: An error handler for ActivatePOI +"RTN","TMGNDF4A",427,0) + set $ECODE="" +"RTN","TMGNDF4A",428,0) + if result=0 quit +"RTN","TMGNDF4A",429,0) + set result=0 +"RTN","TMGNDF4A",430,0) + write "Error encountered activating Pharmacy Orderable Item: " +"RTN","TMGNDF4A",431,0) + write $piece($get(^PS(50.7,IEN50d7,0)),"^",1)," (#",IEN50d7,")",! +"RTN","TMGNDF4A",432,0) + ;"Note: below won't set needed xrefs etc. +"RTN","TMGNDF4A",433,0) + ;"set $piece(^PS(50.7,IEN50d7,0),"^",4)="" +"RTN","TMGNDF4A",434,0) + ;"write "Fixed with low-level removal of inactivation date.",! +"RTN","TMGNDF4A",435,0) + quit +"RTN","TMGNDF4A",436,0) + +"RTN","TMGNDF4A",437,0) + +"RTN","TMGNDF4A",438,0) + +"RTN","TMGNDF4A",439,0) +KillPOIs +"RTN","TMGNDF4A",440,0) + ;"Purpose: to kill all POI's, do allow fresh start (after errors) +"RTN","TMGNDF4A",441,0) + +"RTN","TMGNDF4A",442,0) + new % set %=2 +"RTN","TMGNDF4A",443,0) + write "Are you sure you want to perminantly KILL all PHARMACY ORDERABLE ITEMS" +"RTN","TMGNDF4A",444,0) + do YN^DICN +"RTN","TMGNDF4A",445,0) + if %'=1 goto KPOIDone +"RTN","TMGNDF4A",446,0) + +"RTN","TMGNDF4A",447,0) + new Itr,IEN50d7 +"RTN","TMGNDF4A",448,0) + new abort set abort=0 +"RTN","TMGNDF4A",449,0) + set IEN50d7=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4A",450,0) + do PrepProgress^TMGITR(.Itr,2,0,"IEN50d7") +"RTN","TMGNDF4A",451,0) + if IEN50d7'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN50d7)'>0)!abort +"RTN","TMGNDF4A",452,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4A",453,0) + . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4A",454,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4A",455,0) + +"RTN","TMGNDF4A",456,0) +KPOIDone +"RTN","TMGNDF4A",457,0) + quit +"RTN","TMGNDF4B") +0^54^B7237 +"RTN","TMGNDF4B",1,0) +TMGNDF4B ;TMG/kst/FDA Import: Activation of POI's ;03/25/06 +"RTN","TMGNDF4B",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF4B",3,0) + +"RTN","TMGNDF4B",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4B",5,0) + ;" Activation of records in PHARMACY ORDERABLE ITEM file +"RTN","TMGNDF4B",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4B",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4B",8,0) + ;"11-21-2006 +"RTN","TMGNDF4B",9,0) + +"RTN","TMGNDF4B",10,0) + ;"======================================================================= +"RTN","TMGNDF4B",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF4B",12,0) + ;"======================================================================= +"RTN","TMGNDF4B",13,0) + ;"Menu +"RTN","TMGNDF4B",14,0) + +"RTN","TMGNDF4B",15,0) + ;"ActivAll -- remove the inactive date for all records in 50.7 +"RTN","TMGNDF4B",16,0) + ;"Activ1TMG(IEN) -- activate records linked from 22706.9 in 50.7 +"RTN","TMGNDF4B",17,0) + ;"Activ1Rx(IEN50) -- activate records linked from 50 in 50.7 +"RTN","TMGNDF4B",18,0) + +"RTN","TMGNDF4B",19,0) + ;"======================================================================= +"RTN","TMGNDF4B",20,0) + ;" Private Functions. +"RTN","TMGNDF4B",21,0) + ;"======================================================================= +"RTN","TMGNDF4B",22,0) + ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter +"RTN","TMGNDF4B",23,0) + ;"XFormOff -- remove restrinction in input transform that prevents deletion. +"RTN","TMGNDF4B",24,0) + ;"XFormOn -- restore the input transform to field .04 in file 50.7 +"RTN","TMGNDF4B",25,0) + ;"SetXForm(code) -- remove the old input transform, and replace with code +"RTN","TMGNDF4B",26,0) + +"RTN","TMGNDF4B",27,0) + +"RTN","TMGNDF4B",28,0) + ;"======================================================================= +"RTN","TMGNDF4B",29,0) + +"RTN","TMGNDF4B",30,0) +Menu +"RTN","TMGNDF4B",31,0) + +"RTN","TMGNDF4B",32,0) + new Menu,UsrSlct +"RTN","TMGNDF4B",33,0) + set Menu(0)="Pick Option to Activate PHARMACY ORDERABLE ITEMS (4B)" +"RTN","TMGNDF4B",34,0) + set Menu(1)="Activate import PHARMACY ORDERABLE ITEMS."_$char(9)_"ActivateImports" +"RTN","TMGNDF4B",35,0) + set Menu(2)="Inactivate POI's NOT from an active FDA import."_$char(9)_"InactivateNonImports" +"RTN","TMGNDF4B",36,0) + set Menu(3)="Check for duplicate entries in POI file"_$char(9)_"Check4Dups" +"RTN","TMGNDF4B",37,0) + set Menu(4)="Check for dangling entries in POI file"_$char(9)_"Check4Dangle" +"RTN","TMGNDF4B",38,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF4B",39,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF4B",40,0) + +"RTN","TMGNDF4B",41,0) +M1 write # +"RTN","TMGNDF4B",42,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4B",43,0) + +"RTN","TMGNDF4B",44,0) + if UsrSlct="ActivateImports" do ActivRecs(1) goto M1 +"RTN","TMGNDF4B",45,0) + if UsrSlct="InactivateNonImports" do InactivateNonImports("NOW") goto M1 +"RTN","TMGNDF4B",46,0) + if UsrSlct="Check4Dups" do Check4Dups goto M1 +"RTN","TMGNDF4B",47,0) + if UsrSlct="Check4Dangle" do Check4Dangle goto M1 +"RTN","TMGNDF4B",48,0) + if UsrSlct="Prev" goto Menu^TMGNDF4A ;"quit can occur from there... +"RTN","TMGNDF4B",49,0) + if UsrSlct="Next" goto Menu^TMGNDF4C ;"quit can occur from there... +"RTN","TMGNDF4B",50,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF4B",51,0) + goto M1 +"RTN","TMGNDF4B",52,0) + +"RTN","TMGNDF4B",53,0) +MenuDone +"RTN","TMGNDF4B",54,0) + quit +"RTN","TMGNDF4B",55,0) + +"RTN","TMGNDF4B",56,0) + ;"============================================================================= +"RTN","TMGNDF4B",57,0) + +"RTN","TMGNDF4B",58,0) +ActivRecs(OnlyImports) +"RTN","TMGNDF4B",59,0) + ;"Purpose: To activate records in 50.7 by removing the inactivation date +"RTN","TMGNDF4B",60,0) + ;"Input: OnlyImports: if 1 then only records linked to a FDA import will be modified. +"RTN","TMGNDF4B",61,0) + ;" if 0 then ALL records will be modified. +"RTN","TMGNDF4B",62,0) + ;"Results: none +"RTN","TMGNDF4B",63,0) + +"RTN","TMGNDF4B",64,0) + new date,%T,X,Y +"RTN","TMGNDF4B",65,0) + set X="1/1/1960" +"RTN","TMGNDF4B",66,0) + do ^%DT +"RTN","TMGNDF4B",67,0) + if Y'>0 goto AvADone +"RTN","TMGNDF4B",68,0) + set date=Y +"RTN","TMGNDF4B",69,0) + +"RTN","TMGNDF4B",70,0) + do ActivateImports(date,OnlyImports) +"RTN","TMGNDF4B",71,0) +AvADone +"RTN","TMGNDF4B",72,0) + quit +"RTN","TMGNDF4B",73,0) + +"RTN","TMGNDF4B",74,0) + +"RTN","TMGNDF4B",75,0) +Activ1TMG(IEN,Option) +"RTN","TMGNDF4B",76,0) + ;"Purpose: To activate records linked from 22706.9 in 50.7 by removing the inactivation date +"RTN","TMGNDF4B",77,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF4B",78,0) + ;"Get 22706.9 --> 50 --> 50.7 +"RTN","TMGNDF4B",79,0) + ;" --> 50 --> 50.7 +"RTN","TMGNDF4B",80,0) + new gIEN50,tIEN50 +"RTN","TMGNDF4B",81,0) + set tIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) +"RTN","TMGNDF4B",82,0) + set gIEN50=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) +"RTN","TMGNDF4B",83,0) + do Activ1Rx(tIEN50) +"RTN","TMGNDF4B",84,0) + do Activ1Rx(gIEN50) +"RTN","TMGNDF4B",85,0) + +"RTN","TMGNDF4B",86,0) + quit +"RTN","TMGNDF4B",87,0) + +"RTN","TMGNDF4B",88,0) + +"RTN","TMGNDF4B",89,0) +Activ1Rx(IEN50) +"RTN","TMGNDF4B",90,0) + ;"Purpose: To activate records linked from 50 in 50.7 by removing the inactivation date +"RTN","TMGNDF4B",91,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF4B",92,0) + ;"Result: none +"RTN","TMGNDF4B",93,0) + +"RTN","TMGNDF4B",94,0) + new date,%T,X,Y +"RTN","TMGNDF4B",95,0) + set X="1/1/1960" +"RTN","TMGNDF4B",96,0) + do ^%DT +"RTN","TMGNDF4B",97,0) + if Y'>0 goto AvADone +"RTN","TMGNDF4B",98,0) + set date=Y +"RTN","TMGNDF4B",99,0) + +"RTN","TMGNDF4B",100,0) + do XFormOff +"RTN","TMGNDF4B",101,0) + +"RTN","TMGNDF4B",102,0) + ;"Get 50 --> 50.7 +"RTN","TMGNDF4B",103,0) + if +$get(IEN50)'>0 goto A1RxDone +"RTN","TMGNDF4B",104,0) + new IEN50d7 +"RTN","TMGNDF4B",105,0) + set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1) +"RTN","TMGNDF4B",106,0) + if IEN50d7=0 quit +"RTN","TMGNDF4B",107,0) + new temp set temp=$$Active1(IEN50d7,date) +"RTN","TMGNDF4B",108,0) + +"RTN","TMGNDF4B",109,0) + do XFormOn +"RTN","TMGNDF4B",110,0) + +"RTN","TMGNDF4B",111,0) +A1RxDone +"RTN","TMGNDF4B",112,0) + quit +"RTN","TMGNDF4B",113,0) + +"RTN","TMGNDF4B",114,0) + +"RTN","TMGNDF4B",115,0) +ActivateImports(DateAfter,OnlyImports) +"RTN","TMGNDF4B",116,0) + ;"Purpose: To remove inactive date for all records in PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4B",117,0) + ;" having an inactive date on/after DateAfter +"RTN","TMGNDF4B",118,0) + ;"Input: DateAfter -- the date to compare the inactive date with. If the +"RTN","TMGNDF4B",119,0) + ;" inactive date is on/after DateAfter, then inactive date +"RTN","TMGNDF4B",120,0) + ;" will be deleted. +"RTN","TMGNDF4B",121,0) + ;" ** Must be in Fileman Date format +"RTN","TMGNDF4B",122,0) + ;" OnlyImports: if 1 then only records linked to a FDA import will be modified. +"RTN","TMGNDF4B",123,0) + ;" if 0 then ALL records will be modified. +"RTN","TMGNDF4B",124,0) + +"RTN","TMGNDF4B",125,0) + do XFormOff +"RTN","TMGNDF4B",126,0) + +"RTN","TMGNDF4B",127,0) + new Itr,IEN,Date,Y,X +"RTN","TMGNDF4B",128,0) + new count set count=0 +"RTN","TMGNDF4B",129,0) + new abort set abort=0 +"RTN","TMGNDF4B",130,0) + +"RTN","TMGNDF4B",131,0) + write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to activate those",! +"RTN","TMGNDF4B",132,0) + write " records linked to an active (non-skipped) FDA import...",! +"RTN","TMGNDF4B",133,0) + set IEN=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4B",134,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4B",135,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0) +"RTN","TMGNDF4B",136,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",137,0) + . if (OnlyImports=1),($$IsImport^TMGNDFUT(IEN)=0) quit +"RTN","TMGNDF4B",138,0) + . new temp set temp=$$Active1(IEN,DateAfter) +"RTN","TMGNDF4B",139,0) + . if temp=2 set count=count+1 +"RTN","TMGNDF4B",140,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",141,0) + +"RTN","TMGNDF4B",142,0) + do XFormOn +"RTN","TMGNDF4B",143,0) + kill TMGXFORM +"RTN","TMGNDF4B",144,0) + +"RTN","TMGNDF4B",145,0) + write count," records modified.",! +"RTN","TMGNDF4B",146,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4B",147,0) + +"RTN","TMGNDF4B",148,0) + quit +"RTN","TMGNDF4B",149,0) + +"RTN","TMGNDF4B",150,0) + +"RTN","TMGNDF4B",151,0) +Active1(IEN,DateAfter) +"RTN","TMGNDF4B",152,0) + ;"Purpose: To remove inactive date for one records in PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4B",153,0) + ;" having an inactive date on/after DateAfter +"RTN","TMGNDF4B",154,0) + ;"Input: IEN -- the IEN from file 50.7 to affect +"RTN","TMGNDF4B",155,0) + ;" DateAfter -- the date to compare the inactive date with. If the +"RTN","TMGNDF4B",156,0) + ;" inactive date is on/after DateAfter, then inactive date +"RTN","TMGNDF4B",157,0) + ;" will be deleted. +"RTN","TMGNDF4B",158,0) + ;" ** Must be in Fileman Date format +"RTN","TMGNDF4B",159,0) + ;"Results: 1=OK, 0 error occurred, 2 if modification made +"RTN","TMGNDF4B",160,0) + ;"NOTE: The XFormOff should be called before this is called, and XFormON called after +"RTN","TMGNDF4B",161,0) + +"RTN","TMGNDF4B",162,0) + +"RTN","TMGNDF4B",163,0) + new Date,Y,X +"RTN","TMGNDF4B",164,0) + new abort set abort=-5 +"RTN","TMGNDF4B",165,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF4B",166,0) + new X1,X2 +"RTN","TMGNDF4B",167,0) + new result set result=1 +"RTN","TMGNDF4B",168,0) + +"RTN","TMGNDF4B",169,0) + set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date +"RTN","TMGNDF4B",170,0) + if X2="" goto A1Done +"RTN","TMGNDF4B",171,0) + ;"set X1=DateAfter +"RTN","TMGNDF4B",172,0) + ;"do ^%DTC +"RTN","TMGNDF4B",173,0) + set TMGFDA(50.7,IEN_",",.04)="" ;"kill inactive date +"RTN","TMGNDF4B",174,0) + new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q" +"RTN","TMGNDF4B",175,0) + do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",176,0) + new PriorErrorFound +"RTN","TMGNDF4B",177,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto A1Done +"RTN","TMGNDF4B",178,0) + set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date +"RTN","TMGNDF4B",179,0) + if X2'="" do goto A1Done +"RTN","TMGNDF4B",180,0) + . write "Deletion of 50.7 inactivation date (",X2,") FAILED in record: ",IEN,! +"RTN","TMGNDF4B",181,0) + . set result=0 +"RTN","TMGNDF4B",182,0) + +"RTN","TMGNDF4B",183,0) + set result=2 +"RTN","TMGNDF4B",184,0) +A1Done +"RTN","TMGNDF4B",185,0) + quit result +"RTN","TMGNDF4B",186,0) + +"RTN","TMGNDF4B",187,0) + +"RTN","TMGNDF4B",188,0) +InactivateNonImports(Date) +"RTN","TMGNDF4B",189,0) + ;"Purpose: To inactive records in PHARMACY ORDERABLE ITEM not linked to a FDA import +"RTN","TMGNDF4B",190,0) + ;"Input: DateAfter -- OPTIONAL. Default is "NOW" +"RTN","TMGNDF4B",191,0) + ;" The date to to use for the inactivation +"RTN","TMGNDF4B",192,0) + ;" ** Must be in EXTERNAL format +"RTN","TMGNDF4B",193,0) + ;"Results: none +"RTN","TMGNDF4B",194,0) + +"RTN","TMGNDF4B",195,0) + do XFormOff +"RTN","TMGNDF4B",196,0) + +"RTN","TMGNDF4B",197,0) + new Itr,IEN,Date,Y,X +"RTN","TMGNDF4B",198,0) + set Date=$get(Date,"NOW") +"RTN","TMGNDF4B",199,0) + new abort set abort=0 +"RTN","TMGNDF4B",200,0) + new count set count=0 +"RTN","TMGNDF4B",201,0) + +"RTN","TMGNDF4B",202,0) + write !,!,"Scanning all PHARMACY ORDERABLE ITEMS to inactivate those NOT",! +"RTN","TMGNDF4B",203,0) + write " linked to an active (i.e. non-skipped) FDA import...",! +"RTN","TMGNDF4B",204,0) + set IEN=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4B",205,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4B",206,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0) +"RTN","TMGNDF4B",207,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",208,0) + . if $$IsImport^TMGNDFUT(IEN)=1 quit +"RTN","TMGNDF4B",209,0) + . new temp set temp=$$InActv1(IEN,Date) +"RTN","TMGNDF4B",210,0) + . if temp=2 set count=count+1 +"RTN","TMGNDF4B",211,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",212,0) + +"RTN","TMGNDF4B",213,0) + do XFormOn +"RTN","TMGNDF4B",214,0) + kill TMGXFORM +"RTN","TMGNDF4B",215,0) + +"RTN","TMGNDF4B",216,0) + ;"Now check that all skipped imports don't point to POI records. +"RTN","TMGNDF4B",217,0) + ;"And that pointers point to valid records. +"RTN","TMGNDF4B",218,0) + new ChangeCt set ChangeCt=0 +"RTN","TMGNDF4B",219,0) + new Itr,IEN22706d9 +"RTN","TMGNDF4B",220,0) + new abort set abort=0 +"RTN","TMGNDF4B",221,0) + write !,"Checking Imports for links to bad POI records",! +"RTN","TMGNDF4B",222,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF4B",223,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF4B",224,0) + if IEN22706d9'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF4B",225,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",226,0) + . new tIEN50d7 set tIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) +"RTN","TMGNDF4B",227,0) + . set count=count+$$Verify1(IEN22706d9,tIEN50d7,"TRADE") +"RTN","TMGNDF4B",228,0) + . new gIEN50d7 set gIEN50d7=$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) +"RTN","TMGNDF4B",229,0) + . set count=count+$$Verify1(IEN22706d9,gIEN50d7,"GENERIC") +"RTN","TMGNDF4B",230,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",231,0) + +"RTN","TMGNDF4B",232,0) + write count," records modified.",! +"RTN","TMGNDF4B",233,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4B",234,0) + +"RTN","TMGNDF4B",235,0) + quit +"RTN","TMGNDF4B",236,0) + +"RTN","TMGNDF4B",237,0) + +"RTN","TMGNDF4B",238,0) +Verify1(IEN22706d9,IEN50d7,mode) +"RTN","TMGNDF4B",239,0) + ;"To Verify one +"RTN","TMGNDF4B",240,0) + ;"Input: IEN22706d9 +"RTN","TMGNDF4B",241,0) + ;" IEN50 -- link to PHARMACY ORDERABLE ITEM file (either for Generic Drug, or Trade Drug) +"RTN","TMGNDF4B",242,0) + ;" mode - "GENERIC" or "TRADE" +"RTN","TMGNDF4B",243,0) + ;"Result: 0 -- no change, 1= change made +"RTN","TMGNDF4B",244,0) + +"RTN","TMGNDF4B",245,0) + new result set result=0 +"RTN","TMGNDF4B",246,0) + new field50d7 set field50d7="" +"RTN","TMGNDF4B",247,0) + new fieldName set fieldName="" +"RTN","TMGNDF4B",248,0) + new node,pce set (node,pce)="" +"RTN","TMGNDF4B",249,0) + if mode="GENERIC" do +"RTN","TMGNDF4B",250,0) + . set field50d7=5.71 +"RTN","TMGNDF4B",251,0) + . set fieldName=.075 +"RTN","TMGNDF4B",252,0) + . set node=7,pce=4 +"RTN","TMGNDF4B",253,0) + else if mode="TRADE" do +"RTN","TMGNDF4B",254,0) + . set field50d7=5.61 +"RTN","TMGNDF4B",255,0) + . set fieldName=.055 +"RTN","TMGNDF4B",256,0) + . set node=7,pce=3 +"RTN","TMGNDF4B",257,0) + if (field50d7="") goto V1Done +"RTN","TMGNDF4B",258,0) + if (IEN50d7="") goto V1Done +"RTN","TMGNDF4B",259,0) + +"RTN","TMGNDF4B",260,0) + new drugName set drugName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1) +"RTN","TMGNDF4B",261,0) + new TMGName set TMGName=$piece($get(^TMG(22706.9,IEN22706d9,node)),"^",pce) +"RTN","TMGNDF4B",262,0) + set TMGName=$translate(TMGName,";",":") +"RTN","TMGNDF4B",263,0) + +"RTN","TMGNDF4B",264,0) + if $data(^PS(50.7,+$get(IEN50d7)))=0 do +"RTN","TMGNDF4B",265,0) + . write "Bad pointer: ",IEN50d7 +"RTN","TMGNDF4B",266,0) + . set IEN50d7=0 +"RTN","TMGNDF4B",267,0) + +"RTN","TMGNDF4B",268,0) + if drugName'=TMGName do +"RTN","TMGNDF4B",269,0) + . write IEN22706d9," (",$extract(mode,1),"): Name mismatch: ",drugName," vs ",TMGName,! +"RTN","TMGNDF4B",270,0) + . if TMGName="" set IEN50d7=0 +"RTN","TMGNDF4B",271,0) + +"RTN","TMGNDF4B",272,0) + if $get(IEN50d7)=0 do goto V1Done +"RTN","TMGNDF4B",273,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",274,0) + . set TMGFDA(22706.9,IEN22706d9_",",field50d7)="@" +"RTN","TMGNDF4B",275,0) + . do UPDATE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",276,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",277,0) + . write " ... fixed.",! +"RTN","TMGNDF4B",278,0) + . set result=1 +"RTN","TMGNDF4B",279,0) +V1Done +"RTN","TMGNDF4B",280,0) + quit result +"RTN","TMGNDF4B",281,0) + +"RTN","TMGNDF4B",282,0) + +"RTN","TMGNDF4B",283,0) +InActv1(IEN,Date) +"RTN","TMGNDF4B",284,0) + ;"Purpose: To set inactive date for one records in PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4B",285,0) + ;" having no inactive date +"RTN","TMGNDF4B",286,0) + ;"Input: IEN -- the IEN from file 50.7 to affect +"RTN","TMGNDF4B",287,0) + ;" Date -- the date to set inactive date to. Should be EXTERNAL FORMAT +"RTN","TMGNDF4B",288,0) + ;"Results: 1=OK, 0 error occurred, 2 if record modified +"RTN","TMGNDF4B",289,0) + ;"NOTE: The XFormOff should be called before this is called, and XFormON called after +"RTN","TMGNDF4B",290,0) + +"RTN","TMGNDF4B",291,0) + new abort set abort=-5 +"RTN","TMGNDF4B",292,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF4B",293,0) + new X1,X2 +"RTN","TMGNDF4B",294,0) + new result set result=1 +"RTN","TMGNDF4B",295,0) + +"RTN","TMGNDF4B",296,0) + set X2=$piece($get(^PS(50.7,IEN,0)),"^",4) ;"0;4 --> inactive date +"RTN","TMGNDF4B",297,0) + if X2'="" goto IA1Done +"RTN","TMGNDF4B",298,0) + set TMGFDA(50.7,IEN_",",.04)=Date ;"new inactive date +"RTN","TMGNDF4B",299,0) + new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q" +"RTN","TMGNDF4B",300,0) + do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",301,0) + new PriorErrorFound +"RTN","TMGNDF4B",302,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) set result=0 goto IA1Done +"RTN","TMGNDF4B",303,0) + set result=2 +"RTN","TMGNDF4B",304,0) +IA1Done +"RTN","TMGNDF4B",305,0) + quit result +"RTN","TMGNDF4B",306,0) + +"RTN","TMGNDF4B",307,0) + +"RTN","TMGNDF4B",308,0) +XFormOff +"RTN","TMGNDF4B",309,0) + ;"Purpose: to remove restrinction in input transform that prevents deletion. +"RTN","TMGNDF4B",310,0) + +"RTN","TMGNDF4B",311,0) + ;"new TMGXFORM ;NOTE: NO new -- will be killed later +"RTN","TMGNDF4B",312,0) + set TMGXFORM=$piece($get(^DD(50.7,.04,0)),"^",5,99) +"RTN","TMGNDF4B",313,0) + merge ^TMG("TMP","XREF",50.7,.04,1)=^DD(50.7,.04,1) +"RTN","TMGNDF4B",314,0) + kill ^DD(50.7,.04,1) ;"kill off the screening xref code +"RTN","TMGNDF4B",315,0) + do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""") +"RTN","TMGNDF4B",316,0) + +"RTN","TMGNDF4B",317,0) + quit +"RTN","TMGNDF4B",318,0) + +"RTN","TMGNDF4B",319,0) + +"RTN","TMGNDF4B",320,0) +XFormOn +"RTN","TMGNDF4B",321,0) + ;"Purpose: to restore the input transform to field .04 in file 50.7 +"RTN","TMGNDF4B",322,0) + +"RTN","TMGNDF4B",323,0) + set TMGXFORM=$get(TMGXFORM,"S %DT=""EX"" D ^%DT S X=Y K:Y<1 X") +"RTN","TMGNDF4B",324,0) + do SetXForm(TMGXFORM) +"RTN","TMGNDF4B",325,0) + kill ^DD(50.7,.04,1) +"RTN","TMGNDF4B",326,0) + merge ^DD(50.7,.04,1)=^TMG("TMP","XREF",50.7,.04,1) ;"restore screening xref code +"RTN","TMGNDF4B",327,0) + quit +"RTN","TMGNDF4B",328,0) + +"RTN","TMGNDF4B",329,0) + +"RTN","TMGNDF4B",330,0) +SetXForm(code) +"RTN","TMGNDF4B",331,0) + ;"Purpose: to remove the old input transform, and replace with code +"RTN","TMGNDF4B",332,0) + +"RTN","TMGNDF4B",333,0) + set $piece(^DD(50.7,.04,0),"^",5,99)="" ;"clear out old stuff +"RTN","TMGNDF4B",334,0) + set $piece(^DD(50.7,.04,0),"^",5)=code +"RTN","TMGNDF4B",335,0) + ;"zwr ^DD(50.7,.04,0) +"RTN","TMGNDF4B",336,0) + quit +"RTN","TMGNDF4B",337,0) + +"RTN","TMGNDF4B",338,0) + +"RTN","TMGNDF4B",339,0) +Check4Dups +"RTN","TMGNDF4B",340,0) + ;"Purpose: to ensure that there are not two entries in the PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4B",341,0) + ;" file with the same name. +"RTN","TMGNDF4B",342,0) + +"RTN","TMGNDF4B",343,0) + new array,dupArray +"RTN","TMGNDF4B",344,0) + +"RTN","TMGNDF4B",345,0) + new Itr,IEN +"RTN","TMGNDF4B",346,0) + new abort set abort=0 +"RTN","TMGNDF4B",347,0) + set IEN=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4B",348,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4B",349,0) + if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF4B",350,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",351,0) + . new name set name=$piece($get(^PS(50.7,IEN,0)),"^",1) +"RTN","TMGNDF4B",352,0) + . new priorIEN set priorIEN=+$order(array(name,"")) +"RTN","TMGNDF4B",353,0) + . if priorIEN'=0 do +"RTN","TMGNDF4B",354,0) + . . write !,name," previously found...",! +"RTN","TMGNDF4B",355,0) + . . set dupArray(name,priorIEN)="" +"RTN","TMGNDF4B",356,0) + . . set dupArray(name,IEN)="" +"RTN","TMGNDF4B",357,0) + . set array(name,IEN)="" +"RTN","TMGNDF4B",358,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",359,0) + +"RTN","TMGNDF4B",360,0) + new count set count=0 +"RTN","TMGNDF4B",361,0) + new fixName set fixName="" +"RTN","TMGNDF4B",362,0) + for set fixName=$order(dupArray(fixName)) quit:(fixName="") do +"RTN","TMGNDF4B",363,0) + . new keepIEN set keepIEN=$order(dupArray(fixName,"")) +"RTN","TMGNDF4B",364,0) + . new IEN50d7 set IEN50d7=keepIEN +"RTN","TMGNDF4B",365,0) + . for set IEN50d7=$order(dupArray(fixName,IEN50d7)) quit:(IEN50d7="") do +"RTN","TMGNDF4B",366,0) + . . new IEN50Array +"RTN","TMGNDF4B",367,0) + . . do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array) +"RTN","TMGNDF4B",368,0) + . . new IEN50 set IEN50="" +"RTN","TMGNDF4B",369,0) + . . for set IEN50=+$order(IEN50Array(IEN50)) quit:(IEN50=0) do +"RTN","TMGNDF4B",370,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",371,0) + . . . set TMGFDA(50,IEN50_",",2.1)=keepIEN ;"redirect to ONE kept record +"RTN","TMGNDF4B",372,0) + . . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",373,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",374,0) + . . kill TMGFDA,TMGMSG +"RTN","TMGNDF4B",375,0) + . . set TMGFDA(50.7,IEN50d7_",",.01)="@" ;"kill duplicate record +"RTN","TMGNDF4B",376,0) + . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",377,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",378,0) + . . set count=count+1 +"RTN","TMGNDF4B",379,0) + +"RTN","TMGNDF4B",380,0) + write !,count," Modifications Made.",! +"RTN","TMGNDF4B",381,0) + +"RTN","TMGNDF4B",382,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4B",383,0) + quit +"RTN","TMGNDF4B",384,0) + +"RTN","TMGNDF4B",385,0) + +"RTN","TMGNDF4B",386,0) +Check4Dangle +"RTN","TMGNDF4B",387,0) + ;"Purpose: to ensure that there are no dangling entries in the PHARMACY +"RTN","TMGNDF4B",388,0) + ;" ORDERABLE ITEM file +"RTN","TMGNDF4B",389,0) + +"RTN","TMGNDF4B",390,0) + new fixArray +"RTN","TMGNDF4B",391,0) + +"RTN","TMGNDF4B",392,0) + new goodCount set goodCount=0 +"RTN","TMGNDF4B",393,0) + new badCount set badCount=0 +"RTN","TMGNDF4B",394,0) + new count set count=0 +"RTN","TMGNDF4B",395,0) + new Itr,IEN50d7 +"RTN","TMGNDF4B",396,0) + new abort set abort=0 +"RTN","TMGNDF4B",397,0) + set IEN50d7=$$ItrInit^TMGITR(50.7,.Itr) +"RTN","TMGNDF4B",398,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN50d7") +"RTN","TMGNDF4B",399,0) + if IEN50d7'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN50d7)'>0)!abort +"RTN","TMGNDF4B",400,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",401,0) + . new dangle set dangle=1 ;"default to dangle +"RTN","TMGNDF4B",402,0) + . +"RTN","TMGNDF4B",403,0) + . new tempC,tempA,IEN50 +"RTN","TMGNDF4B",404,0) + . merge tempA=^PSDRUG("ASP",IEN50d7) +"RTN","TMGNDF4B",405,0) + . do GetpDRUGs^TMGNDFUT(IEN50d7,.tempC,1) +"RTN","TMGNDF4B",406,0) + . +"RTN","TMGNDF4B",407,0) + . set IEN50="" +"RTN","TMGNDF4B",408,0) + . for set IEN50=$order(tempC(IEN50)) quit:(IEN50="") kill tempA(IEN50) +"RTN","TMGNDF4B",409,0) + . set IEN50="" for set IEN50=$order(tempA(IEN50)) quit:(IEN50="") do +"RTN","TMGNDF4B",410,0) + . . if $piece($get(^PSDRUG(IEN50,"I")),"^",1)'="" kill tempA(IEN50) +"RTN","TMGNDF4B",411,0) + . +"RTN","TMGNDF4B",412,0) + . set IEN50="" +"RTN","TMGNDF4B",413,0) + . for set IEN50=$order(tempA(IEN50)) quit:(IEN50="") do +"RTN","TMGNDF4B",414,0) + . . write "50 #",IEN50," (",$$GET1^DIQ(50,IEN50_",",.01),") found that",! +"RTN","TMGNDF4B",415,0) + . . write " --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",! +"RTN","TMGNDF4B",416,0) + . . new IEN22706d9 +"RTN","TMGNDF4B",417,0) + . . set IEN22706d9=$order(^TMG(22706.9,"DRUGT",IEN50,"")) +"RTN","TMGNDF4B",418,0) + . . if IEN22706d9="" do +"RTN","TMGNDF4B",419,0) + . . . write "But there is no entry in 22706.9 pointing to this #50 record.",! +"RTN","TMGNDF4B",420,0) + . . . write " ... deleting.",! +"RTN","TMGNDF4B",421,0) + . . . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4B",422,0) + . . else do +"RTN","TMGNDF4B",423,0) + . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDF4B",424,0) + . . . . write "But the 22706.9 entry pointing to this is SKIPPED",! +"RTN","TMGNDF4B",425,0) + . . . else do +"RTN","TMGNDF4B",426,0) + . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",! +"RTN","TMGNDF4B",427,0) + . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) +"RTN","TMGNDF4B",428,0) + . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",! +"RTN","TMGNDF4B",429,0) + . . set IEN22706d9=$order(^TMG(22706.9,"DRUGG",IEN50,"")) +"RTN","TMGNDF4B",430,0) + . . if IEN22706d9="" do +"RTN","TMGNDF4B",431,0) + . . . write "But there is no entry in 22706.9 pointing to this #50 record.",! +"RTN","TMGNDF4B",432,0) + . . else do +"RTN","TMGNDF4B",433,0) + . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDF4B",434,0) + . . . . write "But the 22706.9 entry pointing to this is SKIPPED",! +"RTN","TMGNDF4B",435,0) + . . . else do +"RTN","TMGNDF4B",436,0) + . . . . write "Here is the 22706.9 pointing to it: #",IEN22706d9," ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",! +"RTN","TMGNDF4B",437,0) + . . . . new POI set POI=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) +"RTN","TMGNDF4B",438,0) + . . . . write "And this record points to POI #",POI," ",$$GET1^DIQ(50.7,POI_",",.01),")",! +"RTN","TMGNDF4B",439,0) + . +"RTN","TMGNDF4B",440,0) + . +"RTN","TMGNDF4B",441,0) + . ;"--------Check trade drug links------------ +"RTN","TMGNDF4B",442,0) + . new tempA +"RTN","TMGNDF4B",443,0) + . merge tempA=^TMG(22706.9,"POIT",IEN50d7) +"RTN","TMGNDF4B",444,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDF4B",445,0) + . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4B",446,0) + . . set dangle=0 ;"at least one link was found, so not dangling. +"RTN","TMGNDF4B",447,0) + . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDF4B",448,0) + . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",! +"RTN","TMGNDF4B",449,0) + . . . set fixArray(IEN50d7)="" +"RTN","TMGNDF4B",450,0) + . . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF4B",451,0) + . . if tIEN50=0 write "??!!??",! quit +"RTN","TMGNDF4B",452,0) + . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(tIEN50,2)),"^",1) +"RTN","TMGNDF4B",453,0) + . . if tempIEN=IEN50d7 quit +"RTN","TMGNDF4B",454,0) + . . write !,"22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",! +"RTN","TMGNDF4B",455,0) + . . write " --> POI #",IEN50d7," (",$$GET1^DIQ(50.7,IEN50d7_",",.01),")",! +"RTN","TMGNDF4B",456,0) + . . write " --> 50 #",tIEN50," (",$$GET1^DIQ(50,tIEN50_",",.01),")",! +"RTN","TMGNDF4B",457,0) + . . write " ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",! +"RTN","TMGNDF4B",458,0) + . . write " Fixing this...",! +"RTN","TMGNDF4B",459,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",460,0) + . . set TMGFDA(50,tIEN50_",",2.1)=IEN50d7 +"RTN","TMGNDF4B",461,0) + . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",462,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",463,0) + . . set count=count+1 +"RTN","TMGNDF4B",464,0) + . ;"--------Now check generic drug links------------ +"RTN","TMGNDF4B",465,0) + . kill tempA +"RTN","TMGNDF4B",466,0) + . merge tempA=^TMG(22706.9,"POIG",IEN50d7) +"RTN","TMGNDF4B",467,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDF4B",468,0) + . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4B",469,0) + . . set dangle=0 ;"at least one link was found, so not dangling. +"RTN","TMGNDF4B",470,0) + . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDF4B",471,0) + . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped 22706.9 record!",! +"RTN","TMGNDF4B",472,0) + . . . set fixArray(IEN50d7)="" +"RTN","TMGNDF4B",473,0) + . . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF4B",474,0) + . . if gIEN50=0 write "??!!??",! quit +"RTN","TMGNDF4B",475,0) + . . new tempIEN set tempIEN=+$piece($get(^PSDRUG(gIEN50,2)),"^",1) +"RTN","TMGNDF4B",476,0) + . . if tempIEN=IEN50d7 quit +"RTN","TMGNDF4B",477,0) + . . write "22706.9 #",IEN22706d9," (T) ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),")",! +"RTN","TMGNDF4B",478,0) + . . write " --> POI #",IEN50d7,$$GET1^DIQ(50.7,IEN50d7_",",.01),")",! +"RTN","TMGNDF4B",479,0) + . . write " --> 50 #",gIEN50," (",$$GET1^DIQ(50,gIEN50_",",.01),")",! +"RTN","TMGNDF4B",480,0) + . . write " ---> POI #",tempIEN," (",$$GET1^DIQ(50.7,tempIEN_",",.01),")",! +"RTN","TMGNDF4B",481,0) + . . write " Fixing this...",! +"RTN","TMGNDF4B",482,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",483,0) + . . set TMGFDA(50,gIEN50_",",2.1)=IEN50d7 +"RTN","TMGNDF4B",484,0) + . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",485,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",486,0) + . . set count=count+1 +"RTN","TMGNDF4B",487,0) + . if dangle=1 set badCount=badCount+1 +"RTN","TMGNDF4B",488,0) + +"RTN","TMGNDF4B",489,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",490,0) + +"RTN","TMGNDF4B",491,0) + ;"remove this line later +"RTN","TMGNDF4B",492,0) + set abort=0 +"RTN","TMGNDF4B",493,0) + +"RTN","TMGNDF4B",494,0) + write "Scanning 22706.9 for pointers to non-existant generic POI records",! +"RTN","TMGNDF4B",495,0) + new IEN50d7 set IEN50d7="" +"RTN","TMGNDF4B",496,0) + set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG")),.Itr) +"RTN","TMGNDF4B",497,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7") +"RTN","TMGNDF4B",498,0) + if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort +"RTN","TMGNDF4B",499,0) + . new Itr2 +"RTN","TMGNDF4B",500,0) + . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIG",IEN50d7)),.Itr2) +"RTN","TMGNDF4B",501,0) + . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort +"RTN","TMGNDF4B",502,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",503,0) + . . if $data(^PS(50.7,IEN50d7))=0 do +"RTN","TMGNDF4B",504,0) + . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",! +"RTN","TMGNDF4B",505,0) + . . . write " .. Deleting",! +"RTN","TMGNDF4B",506,0) + . . . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4B",507,0) + . . . set count=count+1 +"RTN","TMGNDF4B",508,0) + +"RTN","TMGNDF4B",509,0) + write "Scanning 22706.9 for pointers to non-existant trade POI records",! +"RTN","TMGNDF4B",510,0) + kill Itr +"RTN","TMGNDF4B",511,0) + new IEN50d7 set IEN50d7="" +"RTN","TMGNDF4B",512,0) + set IEN50d7=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT")),.Itr) +"RTN","TMGNDF4B",513,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7") +"RTN","TMGNDF4B",514,0) + if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort +"RTN","TMGNDF4B",515,0) + . new Itr2 +"RTN","TMGNDF4B",516,0) + . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"POIT",IEN50d7)),.Itr2) +"RTN","TMGNDF4B",517,0) + . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort +"RTN","TMGNDF4B",518,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",519,0) + . . if $data(^PS(50.7,IEN50d7))=0 do +"RTN","TMGNDF4B",520,0) + . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",! +"RTN","TMGNDF4B",521,0) + . . . write " .. Deleting",! +"RTN","TMGNDF4B",522,0) + . . . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4B",523,0) + . . . set count=count+1 +"RTN","TMGNDF4B",524,0) + +"RTN","TMGNDF4B",525,0) + goto C4D2 ;"xref not missing it after all. This step not needed +"RTN","TMGNDF4B",526,0) + ;"For some reason xref is missing a record, so will do brute force search +"RTN","TMGNDF4B",527,0) + write "Brute force scan of 22706.9...",! +"RTN","TMGNDF4B",528,0) + kill Itr +"RTN","TMGNDF4B",529,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF4B",530,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF4B",531,0) + if IEN22706d9'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF4B",532,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",533,0) + . new tIEN50d7,gIEN50d7 +"RTN","TMGNDF4B",534,0) + . set tIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) +"RTN","TMGNDF4B",535,0) + . set gIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) +"RTN","TMGNDF4B",536,0) + . if (tIEN50d7>0),$data(^PS(50.7,tIEN50d7))=0 do +"RTN","TMGNDF4B",537,0) + . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",! +"RTN","TMGNDF4B",538,0) + . . write " .. Deleting",! +"RTN","TMGNDF4B",539,0) + . . do KillPOI^TMGNDFUT(tIEN50d7) +"RTN","TMGNDF4B",540,0) + . . set count=count+1 +"RTN","TMGNDF4B",541,0) + . . set tIEN50d7=0 +"RTN","TMGNDF4B",542,0) + . if (gIEN50d7>0),$data(^PS(50.7,gIEN50d7))=0 do +"RTN","TMGNDF4B",543,0) + . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",! +"RTN","TMGNDF4B",544,0) + . . write " .. Deleting",! +"RTN","TMGNDF4B",545,0) + . . do KillPOI^TMGNDFUT(gIEN50d7) +"RTN","TMGNDF4B",546,0) + . . set count=count+1 +"RTN","TMGNDF4B",547,0) + . . set gIEN50d7=0 +"RTN","TMGNDF4B",548,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",549,0) + . if tIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.61)="@" +"RTN","TMGNDF4B",550,0) + . if gIEN50d7=0 set TMGFDA(22706.9,IEN22706d9_",",5.71)="@" +"RTN","TMGNDF4B",551,0) + . if $data(TMGFDA) do +"RTN","TMGNDF4B",552,0) + . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",553,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",554,0) + . . set count=count+1 +"RTN","TMGNDF4B",555,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",556,0) +C4D2 +"RTN","TMGNDF4B",557,0) + write "Scanning 22706.9 for pointers to non-existant generic OI records",! +"RTN","TMGNDF4B",558,0) + new IEN101d43 set IEN101d43="" +"RTN","TMGNDF4B",559,0) + set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG")),.Itr) +"RTN","TMGNDF4B",560,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43") +"RTN","TMGNDF4B",561,0) + if IEN101d43'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort +"RTN","TMGNDF4B",562,0) + . new Itr2 +"RTN","TMGNDF4B",563,0) + . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIG",IEN101d43)),.Itr2) +"RTN","TMGNDF4B",564,0) + . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort +"RTN","TMGNDF4B",565,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",566,0) + . . if $data(^ORD(101.43,IEN101d43))=0 do +"RTN","TMGNDF4B",567,0) + . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (G)",! +"RTN","TMGNDF4B",568,0) + . . . write " ... Deleting",! +"RTN","TMGNDF4B",569,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@" +"RTN","TMGNDF4B",570,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",571,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",572,0) + . . . set count=count+1 +"RTN","TMGNDF4B",573,0) + +"RTN","TMGNDF4B",574,0) + write "Scanning 22706.9 for pointers to non-existant trade OI records",! +"RTN","TMGNDF4B",575,0) + new IEN101d43 set IEN101d43="" +"RTN","TMGNDF4B",576,0) + set IEN101d43=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT")),.Itr) +"RTN","TMGNDF4B",577,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN101d43") +"RTN","TMGNDF4B",578,0) + if IEN101d43'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN101d43)="")!abort +"RTN","TMGNDF4B",579,0) + . new Itr2 +"RTN","TMGNDF4B",580,0) + . set IEN22706d9=$$ItrAInit^TMGITR($name(^TMG(22706.9,"OIT",IEN101d43)),.Itr2) +"RTN","TMGNDF4B",581,0) + . if IEN22706d9'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN22706d9)="")!abort +"RTN","TMGNDF4B",582,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",583,0) + . . if $data(^ORD(101.43,IEN101d43))=0 do +"RTN","TMGNDF4B",584,0) + . . . write !,"Dangling pointer in 22706.9 #",IEN22706d9," (T)",! +"RTN","TMGNDF4B",585,0) + . . . write " .. Deleting",! +"RTN","TMGNDF4B",586,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@" +"RTN","TMGNDF4B",587,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",588,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",589,0) + . . . set count=count+1 +"RTN","TMGNDF4B",590,0) + +"RTN","TMGNDF4B",591,0) + write "Scanning 50 for pointers to non-existant POI records",! +"RTN","TMGNDF4B",592,0) + new IEN50d7 set IEN50d7="" +"RTN","TMGNDF4B",593,0) + set IEN50d7=$$ItrAInit^TMGITR($name(^PSDRUG("ASP")),.Itr) +"RTN","TMGNDF4B",594,0) + do PrepProgress^TMGITR(.Itr,20,1,"IEN50d7") +"RTN","TMGNDF4B",595,0) + if IEN50d7'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN50d7)="")!abort +"RTN","TMGNDF4B",596,0) + . new Itr2 +"RTN","TMGNDF4B",597,0) + . set IEN50=$$ItrAInit^TMGITR($name(^PSDRUG("ASP",IEN50d7)),.Itr2) +"RTN","TMGNDF4B",598,0) + . if IEN50'="" for do quit:($$ItrANext^TMGITR(.Itr2,.IEN50)="")!abort +"RTN","TMGNDF4B",599,0) + . . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",600,0) + . . if $data(^PS(50.7,IEN50d7))=0 do +"RTN","TMGNDF4B",601,0) + . . . write !,"Dangling pointer in 50 #",IEN50,! +"RTN","TMGNDF4B",602,0) + . . . write " .. Deleting",! +"RTN","TMGNDF4B",603,0) + . . . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4B",604,0) + . . . set count=count+1 +"RTN","TMGNDF4B",605,0) + +"RTN","TMGNDF4B",606,0) + write "Scanning 101.43 for pointers to non-existant POI records",! +"RTN","TMGNDF4B",607,0) + new ID set ID="" +"RTN","TMGNDF4B",608,0) + set ID=$$ItrAInit^TMGITR($name(^ORD(101.43,"ID")),.Itr) +"RTN","TMGNDF4B",609,0) + do PrepProgress^TMGITR(.Itr,20,1,"ID") +"RTN","TMGNDF4B",610,0) + if ID'="" for do quit:($$ItrANext^TMGITR(.Itr,.ID)="")!abort +"RTN","TMGNDF4B",611,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",612,0) + . set IEN50d7=$piece(ID,";",1) +"RTN","TMGNDF4B",613,0) + . if $data(^PS(50.7,IEN50d7))=0 do +"RTN","TMGNDF4B",614,0) + . . write !,"Dangling pointer in 101.43 #",IEN50,! +"RTN","TMGNDF4B",615,0) + . . write " .. Deleting",! +"RTN","TMGNDF4B",616,0) + . . do KillPOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4B",617,0) + . . set count=count+1 +"RTN","TMGNDF4B",618,0) + +"RTN","TMGNDF4B",619,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4B",620,0) + +"RTN","TMGNDF4B",621,0) + ;"write goodCount," entries are not dangling.",! +"RTN","TMGNDF4B",622,0) + write badCount," entries are dangling",! +"RTN","TMGNDF4B",623,0) + +"RTN","TMGNDF4B",624,0) + set IEN50d7="" +"RTN","TMGNDF4B",625,0) + for set IEN50d7=$order(fixArray(IEN50d7)) quit:(IEN50d7="")!abort do +"RTN","TMGNDF4B",626,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4B",627,0) + . write "Checking POI# ",IEN50d7,! +"RTN","TMGNDF4B",628,0) + . new temp merge temp=^PSDRUG("ASP",IEN50d7) +"RTN","TMGNDF4B",629,0) + . new IEN50 set IEN50="" +"RTN","TMGNDF4B",630,0) + . for set IEN50=$order(temp(IEN50)) quit:(IEN50="") do +"RTN","TMGNDF4B",631,0) + . . new name set name=$$GET1^DIQ(50,IEN50_",",.01) quit:(name="") +"RTN","TMGNDF4B",632,0) + . . write " POI #",IEN50d7," IS pointed to from DRUG file, record #",IEN50," ",name,! +"RTN","TMGNDF4B",633,0) + . . if $$IsImport^TMGNDFUT(IEN50d7) do quit +"RTN","TMGNDF4B",634,0) + . . . write " (This record IS an active import)",! +"RTN","TMGNDF4B",635,0) + . . . new tempA +"RTN","TMGNDF4B",636,0) + . . . merge tempA=^TMG(22706.9,"POIG",IEN50d7) +"RTN","TMGNDF4B",637,0) + . . . merge tempA=^TMG(22706.9,"POIT",IEN50d7) +"RTN","TMGNDF4B",638,0) + . . . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDF4B",639,0) + . . . for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4B",640,0) + . . . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDF4B",641,0) + . . . . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",! +"RTN","TMGNDF4B",642,0) + . . . . new tIEN50,gIEN50 +"RTN","TMGNDF4B",643,0) + . . . . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDF4B",644,0) + . . . . if tIEN50>0 do +"RTN","TMGNDF4B",645,0) + . . . . . write "22706.9 #",IEN22706d9," points to this from trade link",! +"RTN","TMGNDF4B",646,0) + . . . . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDF4B",647,0) + . . . . if gIEN50>0 do +"RTN","TMGNDF4B",648,0) + . . . . . write "22706.9 #",IEN22706d9," points to this from generic link",! +"RTN","TMGNDF4B",649,0) + . . else do +"RTN","TMGNDF4B",650,0) + . . . write " (This record is NOT an active import)",! +"RTN","TMGNDF4B",651,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",652,0) + . . . set TMGFDA(50,IEN50_",",.01)="@" +"RTN","TMGNDF4B",653,0) + . . . do Unlock50^TMGNDFUT +"RTN","TMGNDF4B",654,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",655,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",656,0) + . . . do Lock50^TMGNDFUT +"RTN","TMGNDF4B",657,0) + . . . write "Dangling entry in file 50 REMOVED.",! +"RTN","TMGNDF4B",658,0) + . . . set count=count+1 +"RTN","TMGNDF4B",659,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4B",660,0) + . set TMGFDA(50.7,IEN50d7_",",.01)="@" +"RTN","TMGNDF4B",661,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4B",662,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4B",663,0) + . write "Dangling entries in file 50.7 REMOVED.",! +"RTN","TMGNDF4B",664,0) + . set count=count+1 +"RTN","TMGNDF4B",665,0) + +"RTN","TMGNDF4B",666,0) + +"RTN","TMGNDF4B",667,0) + write !,count," Modifications Made.",! +"RTN","TMGNDF4B",668,0) + if count>0 write "Please run this process AGAIN.",! +"RTN","TMGNDF4B",669,0) + +"RTN","TMGNDF4B",670,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4B",671,0) + quit +"RTN","TMGNDF4C") +0^55^B10766 +"RTN","TMGNDF4C",1,0) +TMGNDF4C ;TMG/kst/FDA Import: Move drugs from 50.7 --> 101.43 ;03/25/06 +"RTN","TMGNDF4C",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF4C",3,0) + +"RTN","TMGNDF4C",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4C",5,0) + ;" Move drugs from 50.7 --> 101.43 +"RTN","TMGNDF4C",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4C",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4C",8,0) + ;"11-21-2006 +"RTN","TMGNDF4C",9,0) + +"RTN","TMGNDF4C",10,0) + ;"Note: The database itself tries to create entries in 101.43 when a drug +"RTN","TMGNDF4C",11,0) + ;" is added to file 50.7. But I am not happy with the job it does. +"RTN","TMGNDF4C",12,0) + ;" There are missing records, and it combines various IR, SR, XR +"RTN","TMGNDF4C",13,0) + ;" into one entry. So I am going to delete the auto-created records +"RTN","TMGNDF4C",14,0) + ;" and create my own. +"RTN","TMGNDF4C",15,0) + +"RTN","TMGNDF4C",16,0) + ;"======================================================================= +"RTN","TMGNDF4C",17,0) + ;" API -- Public Functions. +"RTN","TMGNDF4C",18,0) + ;"======================================================================= +"RTN","TMGNDF4C",19,0) + ;"Menu +"RTN","TMGNDF4C",20,0) + ;"======================================================================= +"RTN","TMGNDF4C",21,0) + ;"AddAllTMG -- Add/Refresh all relevent TMG entries into OI +"RTN","TMGNDF4C",22,0) + ;"OIFromTMG(IEN,Option) -- Add/Update ONE entry in ORDERABLE ITEM (101.43) file +"RTN","TMGNDF4C",23,0) + +"RTN","TMGNDF4C",24,0) + ;"======================================================================= +"RTN","TMGNDF4C",25,0) + ;" Private Functions. +"RTN","TMGNDF4C",26,0) + ;"======================================================================= +"RTN","TMGNDF4C",27,0) + ;"VerifySync -- verify correct links PHARMACY ORDERABLE ITEM --> ORDERABLE ITEM +"RTN","TMGNDF4C",28,0) + ;"OIFromTMG(IEN22706d9,Option) +"RTN","TMGNDF4C",29,0) + ;"EnsureOI(IEN50d7,Name,Synonyms,Option) -- make sure that there is a corresponding entry +"RTN","TMGNDF4C",30,0) + ;" in 101.43. If one doesn't already exist, then it will be added. +"RTN","TMGNDF4C",31,0) + ;"InactivateOI -- cycle through 101.43 and ensure needed records are inactivated. +"RTN","TMGNDF4C",32,0) + ;"NewOI(Name) -- add one record to file 101.43--stub in an empty record for later stuffing +"RTN","TMGNDF4C",33,0) + ;"StuffOI(IEN101d43,Name,Synonyms,IEN50d7) -- fill one record to file 101.43 with data +"RTN","TMGNDF4C",34,0) + +"RTN","TMGNDF4C",35,0) + +"RTN","TMGNDF4C",36,0) + ;"ResetFiles -- For debugging purposes, this will reset two files: 101.44, 101.43 +"RTN","TMGNDF4C",37,0) + +"RTN","TMGNDF4C",38,0) + +"RTN","TMGNDF4C",39,0) + ;"======================================================================= +"RTN","TMGNDF4C",40,0) + +"RTN","TMGNDF4C",41,0) +Menu +"RTN","TMGNDF4C",42,0) + +"RTN","TMGNDF4C",43,0) + new Menu,UsrSlct +"RTN","TMGNDF4C",44,0) + set Menu(0)="Pick Option to Sync ORDERABLE ITEMS (4C)" +"RTN","TMGNDF4C",45,0) + set Menu(1)="Sync imports to ORDERABLE ITEMS."_$char(9)_"Sync2OI" +"RTN","TMGNDF4C",46,0) + ;"set Menu(2)="Inactivate non-FDA-drug-OI's"_$char(9)_"InactivateOI" +"RTN","TMGNDF4C",47,0) + set Menu(2)="Ensure Activation Status of Import OI's"_$char(9)_"SyncActivOI" +"RTN","TMGNDF4C",48,0) + set Menu(3)="Verify Sync of PHARMACY ORDERABLE ITEMS --> OI's"_$char(9)_"VerifySync" +"RTN","TMGNDF4C",49,0) + ;"set Menu(4)="Check for duplicate ORDABLE ITEMS records"_$char(9)_"Check4Dups" +"RTN","TMGNDF4C",50,0) + set Menu(4)="Check for dangling ORDERABLE ITEMS records"_$char(9)_"CheckDangle" +"RTN","TMGNDF4C",51,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF4C",52,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF4C",53,0) + +"RTN","TMGNDF4C",54,0) +M1 write # +"RTN","TMGNDF4C",55,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4C",56,0) + +"RTN","TMGNDF4C",57,0) + if UsrSlct="Sync2OI" do AddAllTMG goto M1 +"RTN","TMGNDF4C",58,0) + ;"if UsrSlct="Sync2OI" do Sync2OI goto M1 +"RTN","TMGNDF4C",59,0) + ;"if UsrSlct="InactivateOI" do InactivateOI goto M1 +"RTN","TMGNDF4C",60,0) + if UsrSlct="SyncActivOI" do SyncActivOI goto M1 +"RTN","TMGNDF4C",61,0) + if UsrSlct="VerifySync" do VerifySync goto M1 +"RTN","TMGNDF4C",62,0) + ;"if UsrSlct="Check4Dups" do Check4Dups goto M1 +"RTN","TMGNDF4C",63,0) + if UsrSlct="CheckDangle" do CheckDangle goto M1 +"RTN","TMGNDF4C",64,0) + +"RTN","TMGNDF4C",65,0) + if UsrSlct="Prev" goto Menu^TMGNDF4B ;"quit can occur from there... +"RTN","TMGNDF4C",66,0) + if UsrSlct="Next" goto Menu^TMGNDF4E ;"quit can occur from there... +"RTN","TMGNDF4C",67,0) + +"RTN","TMGNDF4C",68,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF4C",69,0) + goto M1 +"RTN","TMGNDF4C",70,0) + +"RTN","TMGNDF4C",71,0) +MenuDone +"RTN","TMGNDF4C",72,0) + quit +"RTN","TMGNDF4C",73,0) + +"RTN","TMGNDF4C",74,0) + ;"============================================================================= +"RTN","TMGNDF4C",75,0) + +"RTN","TMGNDF4C",76,0) +AddAllTMG +"RTN","TMGNDF4C",77,0) + ;"Purpose: Add/Refresh all relevent TMG entries into OI +"RTN","TMGNDF4C",78,0) + ;"Input:none +"RTN","TMGNDF4C",79,0) + ;"results: none +"RTN","TMGNDF4C",80,0) + +"RTN","TMGNDF4C",81,0) + new IEN,Itr +"RTN","TMGNDF4C",82,0) + new abort set abort=0 +"RTN","TMGNDF4C",83,0) + new result set result=0 +"RTN","TMGNDF4C",84,0) + write "Scanning all imports to ensure ORDERABLE ITEMS are set up.",! +"RTN","TMGNDF4C",85,0) + set IEN=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF4C",86,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4C",87,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort=1) +"RTN","TMGNDF4C",88,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",89,0) + . new Option +"RTN","TMGNDF4C",90,0) + . set Option("CUR MODE")="TRADE" +"RTN","TMGNDF4C",91,0) + . set result=$$OIFromTMG(IEN,.Option) ;"screen for skip will occur in function +"RTN","TMGNDF4C",92,0) + . set Option("CUR MODE")="GENERIC" +"RTN","TMGNDF4C",93,0) + . set result=$$OIFromTMG(IEN,.Option) ;"screen for skip will occur in function +"RTN","TMGNDF4C",94,0) + quit +"RTN","TMGNDF4C",95,0) + +"RTN","TMGNDF4C",96,0) + +"RTN","TMGNDF4C",97,0) +OIFromTMG(IEN22706d9,Option,Synonyms) +"RTN","TMGNDF4C",98,0) + ;"Purpose: to Add/Update ONE entry in ORDERABLE ITEM (101.43) file +"RTN","TMGNDF4C",99,0) + ;"Input: IEN22706d9 -- IEN in 22706.9 +"RTN","TMGNDF4C",100,0) + ;" Option -- NON-OPTIONAL part. Format: +"RTN","TMGNDF4C",101,0) + ;" Option("CUR MODE")="TRADE" +"RTN","TMGNDF4C",102,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF4C",103,0) + ;" Option("IEN50.7","TRADE")=IEN50d7 +"RTN","TMGNDF4C",104,0) + ;" Option("IEN50.7","GENERIC")=IEN50d7 +"RTN","TMGNDF4C",105,0) + ;" Option("IEN101.43","TRADE")=IEN101.43 for Trade Name. May be 0 +"RTN","TMGNDF4C",106,0) + ;" Option("IEN101.43","GENERIC")=IEN101.43 for Generic Name. May be 0 +"RTN","TMGNDF4C",107,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF4C",108,0) + ;" to file POI, OI, OQV etc. +"RTN","TMGNDF4C",109,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF4C",110,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF4C",111,0) + ;" Option("IEN50","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4C",112,0) + ;" Option("IEN50","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4C",113,0) + ;" Option("DRUG NAME AND FORM","TRADE")=Trade Name and Form +"RTN","TMGNDF4C",114,0) + ;" Option("DRUG NAME AND FORM","GENERIC")=Generic Name and Form +"RTN","TMGNDF4C",115,0) + ;" Option("CUR MODE")="TRADE" or "GENERIC" +"RTN","TMGNDF4C",116,0) + ;" Option("DELETING")=1 <-- deleting chain (not IEN22706d9) +"RTN","TMGNDF4C",117,0) + ;" Synonyms --OPTIONAL. PASS BY REFERENCE. Expected format: +"RTN","TMGNDF4C",118,0) + ;" Synonyms(Name)="" +"RTN","TMGNDF4C",119,0) + ;" Synonyms(Name)="" +"RTN","TMGNDF4C",120,0) + ;"NOTE: This function DOES screen for skipped entries, and skips +"RTN","TMGNDF4C",121,0) + ;" proccessing. BUT, if Deleting, then it is NOT skipped +"RTN","TMGNDF4C",122,0) + ;"Output: OI records will be added or refreshed, or deleted. +"RTN","TMGNDF4C",123,0) + ;"Result: 1=Modified, 0=not modified +"RTN","TMGNDF4C",124,0) + +"RTN","TMGNDF4C",125,0) + new result set result=0 +"RTN","TMGNDF4C",126,0) + if $get(Option("DELETING"))'=1,$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 goto EOIDone ;"1=SKIP +"RTN","TMGNDF4C",127,0) + if +$get(IEN22706d9)=0 goto EOIDone +"RTN","TMGNDF4C",128,0) + new quiet set quiet=+$get(Option("QUIET")) +"RTN","TMGNDF4C",129,0) + do LoadOption(IEN22706d9,.Option) +"RTN","TMGNDF4C",130,0) + +"RTN","TMGNDF4C",131,0) + new mode set mode=$get(Option("CUR MODE")) if mode="" goto EOIDone +"RTN","TMGNDF4C",132,0) + new IEN50d7 set IEN50d7=+$get(Option("IEN50.7",mode)) if IEN50d7=0 goto EOIDone +"RTN","TMGNDF4C",133,0) + new DrugNAF set DrugNAF=$get(Option("DRUG NAME AND FORM",mode)) if DrugNAF="" goto EOIDone +"RTN","TMGNDF4C",134,0) + +"RTN","TMGNDF4C",135,0) + new IEN101d43 set IEN101d43=+$get(Option("IEN101.43",mode)) +"RTN","TMGNDF4C",136,0) + +"RTN","TMGNDF4C",137,0) + if $get(Option("DELETING"))=1 do goto EOIDone +"RTN","TMGNDF4C",138,0) + . do KillOI^TMGNDFUT(IEN101d43) +"RTN","TMGNDF4C",139,0) + . set Option("IEN101.43",mode)="" +"RTN","TMGNDF4C",140,0) + +"RTN","TMGNDF4C",141,0) + if (IEN101d43>0),$data(^ORD(101.43,IEN101d43))=0 do +"RTN","TMGNDF4C",142,0) + . set IEN101d43=0 ;"I found a dangling pointer +"RTN","TMGNDF4C",143,0) + ;"I am taking line below out because there is supposed to be a 1:1 +"RTN","TMGNDF4C",144,0) + ;" connection between POI<-->OI. Below might cause cross link of chains +"RTN","TMGNDF4C",145,0) + ;"if IEN101d43=0 set IEN101d43=$$FindOI^TMGNDFUT(DrugNAF) +"RTN","TMGNDF4C",146,0) + if IEN101d43=0 do +"RTN","TMGNDF4C",147,0) + . set IEN101d43=$$NewOI(DrugNAF) +"RTN","TMGNDF4C",148,0) + . set Option("IEN101.43",mode)=IEN101d43 +"RTN","TMGNDF4C",149,0) + . set result=1 +"RTN","TMGNDF4C",150,0) + if IEN101d43=0 set result=0 goto EOIDone +"RTN","TMGNDF4C",151,0) + +"RTN","TMGNDF4C",152,0) + set result=$$StuffOI(IEN101d43,DrugNAF,.Synonyms,IEN50d7) ;"result 1=modified +"RTN","TMGNDF4C",153,0) + +"RTN","TMGNDF4C",154,0) + ;"Ensure pointer to 101.43 stored in TMG IMPORT COMPILED records +"RTN","TMGNDF4C",155,0) + if mode="TRADE" do +"RTN","TMGNDF4C",156,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDF4C",157,0) + . for set IEN22706d9=$order(^TMG(22706.9,"POIT",IEN50d7,IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4C",158,0) + . . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)=IEN101d43 quit +"RTN","TMGNDF4C",159,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF4C",160,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.611)=IEN101d43 +"RTN","TMGNDF4C",161,0) + . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",162,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",163,0) + if mode="GENERIC" do +"RTN","TMGNDF4C",164,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDF4C",165,0) + . for set IEN22706d9=$order(^TMG(22706.9,"POIG",IEN50d7,IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4C",166,0) + . . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)=IEN101d43 quit +"RTN","TMGNDF4C",167,0) + . . new TMGFDA,TMGMSG +"RTN","TMGNDF4C",168,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.711)=IEN101d43 +"RTN","TMGNDF4C",169,0) + . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",170,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",171,0) + +"RTN","TMGNDF4C",172,0) + ;"Ensure just 1 link 50.7 --> 101.43 (actually pointer is the other way: 101.43-->50.7) +"RTN","TMGNDF4C",173,0) + new all,temp +"RTN","TMGNDF4C",174,0) + set temp=$$GetOI^TMGNDFUT(IEN50d7,.all) +"RTN","TMGNDF4C",175,0) +OI1 if $$ListCt^TMGMISC("all")>0 do +"RTN","TMGNDF4C",176,0) + . new IEN set IEN="" +"RTN","TMGNDF4C",177,0) + . for set IEN=$order(all(IEN)) quit:(IEN="") do +"RTN","TMGNDF4C",178,0) + . . if IEN=IEN101d43 quit +"RTN","TMGNDF4C",179,0) + . . if 'quiet write "?? Mult pointers 101.43 --> 50.7 ??. Deleting 101.43 #",IEN,! +"RTN","TMGNDF4C",180,0) + . . do KillOI^TMGNDFUT(IEN) +"RTN","TMGNDF4C",181,0) + +"RTN","TMGNDF4C",182,0) + if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF4C",183,0) + . ;"pass message forward for fix +"RTN","TMGNDF4C",184,0) + . if result=1 do +"RTN","TMGNDF4C",185,0) + . . new temp set temp=$$Fix1OQV^TMGNDF4E(IEN101d43,.Option) +"RTN","TMGNDF4C",186,0) + . ;"Delete AFTER above so chain is deleted 101.44-->101.43-->50.7-->50 +"RTN","TMGNDF4C",187,0) + . ;"if $get(Option("DELETING"))=1 do +"RTN","TMGNDF4C",188,0) + . ;". do KillOI^TMGNDFUT(IEN101d43) +"RTN","TMGNDF4C",189,0) +EOIDone +"RTN","TMGNDF4C",190,0) + quit result +"RTN","TMGNDF4C",191,0) + +"RTN","TMGNDF4C",192,0) + +"RTN","TMGNDF4C",193,0) +LoadOption(IEN22706d9,Option) +"RTN","TMGNDF4C",194,0) + ;"Purpose: To load up Option array with info +"RTN","TMGNDF4C",195,0) + ;"Input: IEN22706d9 -- IEN in 22706.9 +"RTN","TMGNDF4C",196,0) + ;" Option -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4C",197,0) + ;" Option("IEN50.7","TRADE")=IEN50.7 for Trade Name +"RTN","TMGNDF4C",198,0) + ;" Option("IEN50.7","GENERIC")=IEN50.7 for Generic Name +"RTN","TMGNDF4C",199,0) + ;" Option("DRUG NAME AND FORM","TRADE")=Trade Name and Form +"RTN","TMGNDF4C",200,0) + ;" Option("DRUG NAME AND FORM","GENERIC")=Generic Name and Form +"RTN","TMGNDF4C",201,0) + ;" Option("IEN50","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4C",202,0) + ;" Option("IEN50","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4C",203,0) + ;" Option("IEN101.43","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4C",204,0) + ;" Option("IEN101.43","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4C",205,0) + ;"Note: May sync pointers in various records +"RTN","TMGNDF4C",206,0) + ;"Results: none +"RTN","TMGNDF4C",207,0) + +"RTN","TMGNDF4C",208,0) + new node7 set node7=$get(^TMG(22706.9,IEN22706d9,7)) +"RTN","TMGNDF4C",209,0) + set Option("DRUG NAME AND FORM","TRADE")=$piece(node7,"^",3) +"RTN","TMGNDF4C",210,0) + set Option("DRUG NAME AND FORM","GENERIC")=$piece(node7,"^",4) +"RTN","TMGNDF4C",211,0) + +"RTN","TMGNDF4C",212,0) + new tIEN50 set tIEN50=+$get(Option("IEN50","TRADE")) +"RTN","TMGNDF4C",213,0) + if tIEN50=0 do +"RTN","TMGNDF4C",214,0) + . new tIEN50 set tIEN50=+$piece(node7,"^",1) +"RTN","TMGNDF4C",215,0) + . set Option("IEN50","TRADE")=tIEN50 +"RTN","TMGNDF4C",216,0) + if tIEN50>0 set Option("IEN50","TRADE","NAME")=$piece($get(^PSDRUG(tIEN50,0)),"^",1) +"RTN","TMGNDF4C",217,0) + +"RTN","TMGNDF4C",218,0) + new gIEN50 set gIEN50=+$get(Option("IEN50","GENERIC")) +"RTN","TMGNDF4C",219,0) + if gIEN50=0 do +"RTN","TMGNDF4C",220,0) + . set gIEN50=+$piece(node7,"^",2) +"RTN","TMGNDF4C",221,0) + . set Option("IEN50","GENERIC")=gIEN50 +"RTN","TMGNDF4C",222,0) + if gIEN50>0 set Option("IEN50","GENERIC","NAME")=$piece($get(^PSDRUG(gIEN50,0)),"^",1) +"RTN","TMGNDF4C",223,0) + +"RTN","TMGNDF4C",224,0) + new tIEN50d7 set tIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) +"RTN","TMGNDF4C",225,0) + if tIEN50'=0 do +"RTN","TMGNDF4C",226,0) + . if tIEN50d7=0 do +"RTN","TMGNDF4C",227,0) + . . set tIEN50d7=+$piece($get(^PSDRUG(tIEN50,2)),"^",1) +"RTN","TMGNDF4C",228,0) + . . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4C",229,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.61)=tIEN50d7 +"RTN","TMGNDF4C",230,0) + . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",231,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",232,0) + . else do ;"sync 50 to match TMG COMPILED +"RTN","TMGNDF4C",233,0) + . . if tIEN50d7=+$piece($get(^PSDRUG(tIEN50,2)),"^",1) quit +"RTN","TMGNDF4C",234,0) + . . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4C",235,0) + . . set TMGFDA(50,tIEN50_",",2.1)=tIEN50d7 +"RTN","TMGNDF4C",236,0) + . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",237,0) + . . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4C",238,0) + . . . if $data(TMGMSG("DIERR","E",120))>0 quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4C",239,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",240,0) + set Option("IEN50.7","TRADE")=tIEN50d7 ;"may be 0 at this point +"RTN","TMGNDF4C",241,0) + if tIEN50d7>0 set Option("IEN50.7","TRADE","NAME")=$piece($get(^PS(50.7,tIEN50d7,0)),"^",1) +"RTN","TMGNDF4C",242,0) + +"RTN","TMGNDF4C",243,0) + new gIEN50d7 set gIEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) +"RTN","TMGNDF4C",244,0) + if gIEN50'=0 do +"RTN","TMGNDF4C",245,0) + . if gIEN50d7=0 do +"RTN","TMGNDF4C",246,0) + . . set gIEN50d7=+$piece($get(^PSDRUG(gIEN50,2)),"^",1) +"RTN","TMGNDF4C",247,0) + . . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4C",248,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.71)=gIEN50d7 +"RTN","TMGNDF4C",249,0) + . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",250,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",251,0) + . else do ;"sync 50 to match TMG COMPILED +"RTN","TMGNDF4C",252,0) + . . if gIEN50d7=+$piece($get(^PSDRUG(gIEN50,2)),"^",1) quit +"RTN","TMGNDF4C",253,0) + . . new TMGFDA,TMGIEN,TMGMSG +"RTN","TMGNDF4C",254,0) + . . set TMGFDA(50,gIEN50_",",2.1)=gIEN50d7 +"RTN","TMGNDF4C",255,0) + . . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",256,0) + . . if $data(TMGMSG("DIERR")) do +"RTN","TMGNDF4C",257,0) + . . . if $data(TMGMSG("DIERR","E",120))>0 quit ;"ignore error if #120 (hook) present. +"RTN","TMGNDF4C",258,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",259,0) + set Option("IEN50.7","GENERIC")=gIEN50d7 ;"may be 0 at this point +"RTN","TMGNDF4C",260,0) + if gIEN50d7>0 set Option("IEN50.7","GENERIC","NAME")=$piece($get(^PS(50.7,gIEN50d7,0)),"^",1) +"RTN","TMGNDF4C",261,0) + +"RTN","TMGNDF4C",262,0) + new tradeNameAF set tradeNameAF=$get(Option("DRUG NAME AND FORM","TRADE")) +"RTN","TMGNDF4C",263,0) + if tradeNameAF="" do +"RTN","TMGNDF4C",264,0) + . set tradeNameAF=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",3) +"RTN","TMGNDF4C",265,0) + . set Option("DRUG NAME AND FORM","TRADE")=tradeNameAF +"RTN","TMGNDF4C",266,0) + +"RTN","TMGNDF4C",267,0) + new genericNameAF set genericNameAF=$get(Option("DRUG NAME AND FORM","GENERIC")) +"RTN","TMGNDF4C",268,0) + if genericNameAF="" do +"RTN","TMGNDF4C",269,0) + . set genericNameAF=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",4) +"RTN","TMGNDF4C",270,0) + . set Option("DRUG NAME AND FORM","GENERIC")=genericNameAF +"RTN","TMGNDF4C",271,0) + +"RTN","TMGNDF4C",272,0) + new tIEN101d43 set tIEN101d43=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5) +"RTN","TMGNDF4C",273,0) + if (tIEN101d43=0)&(tIEN50d7'=0) do +"RTN","TMGNDF4C",274,0) + . set tIEN101d43=$$GetOI^TMGNDFUT(tIEN50d7) +"RTN","TMGNDF4C",275,0) + . if tIEN101d43'>0 quit +"RTN","TMGNDF4C",276,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4C",277,0) + . set TMGFDA(22706.9,IEN22706d9_",",5.611)=tIEN101d43 +"RTN","TMGNDF4C",278,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",279,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",280,0) + set Option("IEN101.43","TRADE")=tIEN101d43 ;"could be 0 at this point +"RTN","TMGNDF4C",281,0) + if tIEN101d43>0 set Option("IEN101.43","TRADE","NAME")=$piece($get(^ORD(101.43,tIEN101d43,0)),"^",1) +"RTN","TMGNDF4C",282,0) + +"RTN","TMGNDF4C",283,0) + new gIEN101d43 set gIEN101d43=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6) +"RTN","TMGNDF4C",284,0) + if (gIEN101d43=0)&(gIEN50d7'=0) do +"RTN","TMGNDF4C",285,0) + . set gIEN101d43=$$GetOI^TMGNDFUT(gIEN50d7) +"RTN","TMGNDF4C",286,0) + . if gIEN101d43=0 quit +"RTN","TMGNDF4C",287,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4C",288,0) + . set TMGFDA(22706.9,IEN22706d9_",",5.711)=gIEN101d43 +"RTN","TMGNDF4C",289,0) + . do FILE^DIE("S","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",290,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",291,0) + set Option("IEN101.43","GENERIC")=gIEN101d43 ;"could be 0 at this point +"RTN","TMGNDF4C",292,0) + if gIEN101d43>0 set Option("IEN101.43","GENERIC","NAME")=$piece($get(^ORD(101.43,gIEN101d43,0)),"^",1) +"RTN","TMGNDF4C",293,0) + +"RTN","TMGNDF4C",294,0) + quit +"RTN","TMGNDF4C",295,0) + +"RTN","TMGNDF4C",296,0) + +"RTN","TMGNDF4C",297,0) +NewOI(Name) +"RTN","TMGNDF4C",298,0) + ;"Purpose: to add one record to file 101.43--stub in an empty record for later stuffing +"RTN","TMGNDF4C",299,0) + ;"Input: Name -- the text of the ORDERABLE ITEM (i.e. drug name) to add +"RTN","TMGNDF4C",300,0) + ;"Results: returns new IEN of added record +"RTN","TMGNDF4C",301,0) + +"RTN","TMGNDF4C",302,0) + new newIEN set newIEN=0 +"RTN","TMGNDF4C",303,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF4C",304,0) + set TMGFDA(101.43,"+1,",.01)=Name +"RTN","TMGNDF4C",305,0) + do UPDATE^DIE("K","TMGFDA","TMGIEN","TMGMSG") ;"ADD RECORD +"RTN","TMGNDF4C",306,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG) goto NOIDone +"RTN","TMGNDF4C",307,0) + set newIEN=+$get(TMGIEN(1)) ;"GET BACK ADDED RECORD NUMBER +"RTN","TMGNDF4C",308,0) +NOIDone +"RTN","TMGNDF4C",309,0) + quit newIEN +"RTN","TMGNDF4C",310,0) + +"RTN","TMGNDF4C",311,0) + +"RTN","TMGNDF4C",312,0) +StuffOI(IEN101d43,Name,Synonyms,IEN50d7) +"RTN","TMGNDF4C",313,0) + ;"Purpose: to fill one record to file 101.43 with data +"RTN","TMGNDF4C",314,0) + ;"Input: IEN110d43 -- IEN in 101.43 to stuff +"RTN","TMGNDF4C",315,0) + ;" Name -- the text of the drug name to add +"RTN","TMGNDF4C",316,0) + ;" Synonyms -- PASS BY REFERENCE. Expected format: +"RTN","TMGNDF4C",317,0) + ;" Synonyms(Name)="" +"RTN","TMGNDF4C",318,0) + ;" Synonyms(Name)="" +"RTN","TMGNDF4C",319,0) + ;" IEN50d7 -- IEN in 50.7 -- the record in PHARMACY ORDERABLE ITEM (50.7) to link to +"RTN","TMGNDF4C",320,0) + ;"Results: 1 if modified, 0 if not modified +"RTN","TMGNDF4C",321,0) + +"RTN","TMGNDF4C",322,0) + ;"Here is an example of a drug that was stuff +"RTN","TMGNDF4C",323,0) + ;" .01-NAME : BUPROPION TAB +"RTN","TMGNDF4C",324,0) + ;" 1-SYNONYMS : +"RTN","TMGNDF4C",325,0) + ;" Multiple Entry #1 .01-SYNONYM : BUDEPRION SR EXT REL TABS +"RTN","TMGNDF4C",326,0) + ;" Multiple Entry #2 .01-SYNONYM : BUDEPRION SR TABS +"RTN","TMGNDF4C",327,0) + ;" Multiple Entry #3 .01-SYNONYM : BUPROPION HCL EXT REL TABS +"RTN","TMGNDF4C",328,0) + ;" Multiple Entry #4 .01-SYNONYM : BUPROPION HCL SR TABS +"RTN","TMGNDF4C",329,0) + ;" 1.1-PACKAGE NAME : BUPROPION TAB +"RTN","TMGNDF4C",330,0) + ;" 2-ID : 3267;99PSP <--- 3267 is IEN in 50.7 to link to +"RTN","TMGNDF4C",331,0) + ;" 5-DISPLAY GROUP : PHARMACY +"RTN","TMGNDF4C",332,0) + ;" 9-SET MEMBERSHIP : +"RTN","TMGNDF4C",333,0) + ;" Multiple Entry #1 .01-SET : RX +"RTN","TMGNDF4C",334,0) + ;" 50.1-INPATIENT MED : NO +"RTN","TMGNDF4C",335,0) + ;" 50.2-OUTPATIENT MED : NO +"RTN","TMGNDF4C",336,0) + ;" 50.3-IV BASE : NO +"RTN","TMGNDF4C",337,0) + ;" 50.4-IV ADDITIVE : NO +"RTN","TMGNDF4C",338,0) + ;" 50.5-SUPPLY : NO +"RTN","TMGNDF4C",339,0) + ;" 50.6-NON-FORMULARY : NO +"RTN","TMGNDF4C",340,0) + ;" 50.7-NON-VA MEDS : NO +"RTN","TMGNDF4C",341,0) + +"RTN","TMGNDF4C",342,0) + new result set result=0 +"RTN","TMGNDF4C",343,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF4C",344,0) + new IENS set IENS=IEN101d43_"," +"RTN","TMGNDF4C",345,0) + set TMGFDA(101.43,IEN101d43_",",.01)=Name +"RTN","TMGNDF4C",346,0) + if $piece($get(^ORD(101.43,IEN101d43,.1)),"^",1)'="" do +"RTN","TMGNDF4C",347,0) + . set TMGFDA(101.43,IENS,.1)="@" ;"delete any inactivation date. +"RTN","TMGNDF4C",348,0) + set TMGFDA(101.43,IENS,1.1)=Name +"RTN","TMGNDF4C",349,0) + set TMGFDA(101.43,IENS,2)=IEN50d7_";99PSP" +"RTN","TMGNDF4C",350,0) + set TMGFDA(101.43,IENS,5)="PHARMACY" +"RTN","TMGNDF4C",351,0) + set TMGFDA(101.43,IENS,50.1)="NO" +"RTN","TMGNDF4C",352,0) + set TMGFDA(101.43,IENS,50.2)="YES" +"RTN","TMGNDF4C",353,0) + set TMGFDA(101.43,IENS,50.3)="NO" +"RTN","TMGNDF4C",354,0) + set TMGFDA(101.43,IENS,50.4)="NO" +"RTN","TMGNDF4C",355,0) + set TMGFDA(101.43,IENS,50.5)="NO" +"RTN","TMGNDF4C",356,0) + set TMGFDA(101.43,IENS,50.6)="NO" +"RTN","TMGNDF4C",357,0) + set TMGFDA(101.43,IENS,50.7)="NO" +"RTN","TMGNDF4C",358,0) + +"RTN","TMGNDF4C",359,0) + new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF4C",360,0) + if $data(TMGFDA)=0 goto SOI2 +"RTN","TMGNDF4C",361,0) + +"RTN","TMGNDF4C",362,0) + ;"UPDATE RECORD +"RTN","TMGNDF4C",363,0) + do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",364,0) + new PriorErrorFound,newIEN +"RTN","TMGNDF4C",365,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) goto SOIDone +"RTN","TMGNDF4C",366,0) + set result=1 +"RTN","TMGNDF4C",367,0) + +"RTN","TMGNDF4C",368,0) + ;"ADD SET MEMBERSHIP ENTRIES +"RTN","TMGNDF4C",369,0) + ;"NOTE: It seems that the database adds these automatically +"RTN","TMGNDF4C",370,0) + ;"kill TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF4C",371,0) + ;"set TMGFDA(101.439,"+1,"_newIEN_",",.01)="RX" +"RTN","TMGNDF4C",372,0) + ;"set TMGFDA(101.439,"+2,"_newIEN_",",.01)="O RX" +"RTN","TMGNDF4C",373,0) + ;"do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4C",374,0) + ;"if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) quit +"RTN","TMGNDF4C",375,0) +SOI2 +"RTN","TMGNDF4C",376,0) + new subIEN set subIEN=0 +"RTN","TMGNDF4C",377,0) + for set subIEN=$order(^ORD(101.43,IEN101d43,2,subIEN)) quit:(+subIEN'>0) do +"RTN","TMGNDF4C",378,0) + . new syn set syn=$piece($get(^ORD(101.43,IEN101d43,2,subIEN,0)),"^",1) +"RTN","TMGNDF4C",379,0) + . if $data(Synonyms(syn))'=0 kill Synonyms(syn) quit ;"no need to add, already present +"RTN","TMGNDF4C",380,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4C",381,0) + . set TMGFDA(101.432,subIEN_","_IEN101d43_",",.01)="@" ;"kill unwanted synonyms +"RTN","TMGNDF4C",382,0) + . do FILE^DIE("KE","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",383,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",384,0) + +"RTN","TMGNDF4C",385,0) + ;"ADD ANY MISSING SYONYMS +"RTN","TMGNDF4C",386,0) + new SynName set SynName="" +"RTN","TMGNDF4C",387,0) + for set SynName=$order(Synonyms(SynName)) quit:(SynName="") do +"RTN","TMGNDF4C",388,0) + . kill TMGIEN,TMGFDA,TMGMSG +"RTN","TMGNDF4C",389,0) + . set TMGFDA(101.432,"+1,"_IEN101d43_",",.01)=SynName ;"was newIEN, change --> IEN101d43 +"RTN","TMGNDF4C",390,0) + . do UPDATE^DIE("EKS","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4C",391,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",392,0) + . set result=1 +"RTN","TMGNDF4C",393,0) +SOIDone +"RTN","TMGNDF4C",394,0) + quit result +"RTN","TMGNDF4C",395,0) + +"RTN","TMGNDF4C",396,0) + +"RTN","TMGNDF4C",397,0) +InactivateOI +"RTN","TMGNDF4C",398,0) + ;"Purpose: To cycle through records in 101.43 and ensure needed records are +"RTN","TMGNDF4C",399,0) + ;" inactivated. +"RTN","TMGNDF4C",400,0) + +"RTN","TMGNDF4C",401,0) + write "Scanning entries to ensure inactivation status is synchronized...",! +"RTN","TMGNDF4C",402,0) + new Itr,IEN50d7 +"RTN","TMGNDF4C",403,0) + new count set count=0 +"RTN","TMGNDF4C",404,0) + new abort set abort=0 +"RTN","TMGNDF4C",405,0) + set IEN101d43=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4C",406,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN101d43") +"RTN","TMGNDF4C",407,0) + if IEN101d43'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN101d43)'>0)!abort +"RTN","TMGNDF4C",408,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",409,0) + . new IEN50d7 set IEN50d7=$$GetPOI^TMGNDFUT(IEN101d43) ;"(will fix bad records) +"RTN","TMGNDF4C",410,0) + . if IEN50d7'>0 quit ;"was bad record, non pharmacy item +"RTN","TMGNDF4C",411,0) + . new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1) quit:(date'="") ;"already inactivated +"RTN","TMGNDF4C",412,0) + . if $$IsImport^TMGNDFUT(IEN50d7)=1 quit ;"is active import --> don't inactivate +"RTN","TMGNDF4C",413,0) + . new TMGFDA,TMGMSG,X,Y +"RTN","TMGNDF4C",414,0) + . set X="NOW" do ^%DT ;"results return in Y +"RTN","TMGNDF4C",415,0) + . set TMGFDA(101.43,IEN101d43_",",.1)=Y +"RTN","TMGNDF4C",416,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",417,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",418,0) + . set count=count+1 +"RTN","TMGNDF4C",419,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",420,0) + +"RTN","TMGNDF4C",421,0) + write count," entries modified.",! +"RTN","TMGNDF4C",422,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",423,0) + quit +"RTN","TMGNDF4C",424,0) + +"RTN","TMGNDF4C",425,0) + +"RTN","TMGNDF4C",426,0) +SyncActivOI +"RTN","TMGNDF4C",427,0) + ;"Purpose: To cycle through records in 101.43 and ensure needed records are +"RTN","TMGNDF4C",428,0) + ;" Activated or Inactivation. +"RTN","TMGNDF4C",429,0) + +"RTN","TMGNDF4C",430,0) + write "Scanning entries to ensure activation/inactivation status is synchronized...",! +"RTN","TMGNDF4C",431,0) + new Itr,IEN50d7 +"RTN","TMGNDF4C",432,0) + new count set count=0 +"RTN","TMGNDF4C",433,0) + new abort set abort=0 +"RTN","TMGNDF4C",434,0) + set IEN101d43=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4C",435,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN101d43") +"RTN","TMGNDF4C",436,0) + if IEN101d43'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN101d43)'>0)!abort +"RTN","TMGNDF4C",437,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",438,0) + . new IEN50d7 set IEN50d7=$$GetPOI^TMGNDFUT(IEN101d43) ;"(will fix bad records) +"RTN","TMGNDF4C",439,0) + . if IEN50d7'>0 quit ;"was bad record, non pharmacy item +"RTN","TMGNDF4C",440,0) + . new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1) +"RTN","TMGNDF4C",441,0) + . new pastInactiveDate set pastInactiveDate=0 +"RTN","TMGNDF4C",442,0) + . if date'="" do +"RTN","TMGNDF4C",443,0) + . . new X,Y set X="NOW" do ^%DT ;"results in Y +"RTN","TMGNDF4C",444,0) + . . new X1,X2 +"RTN","TMGNDF4C",445,0) + . . set X1=Y,X2=date +"RTN","TMGNDF4C",446,0) + . . do ^%DTC ;"result is X=X1-X2 (X=NOW-InactiveDate) X>-1 means past inactive date +"RTN","TMGNDF4C",447,0) + . . set pastInactiveDate=(X>-1) +"RTN","TMGNDF4C",448,0) + . if $$IsImport^TMGNDFUT(IEN50d7)=1 do +"RTN","TMGNDF4C",449,0) + . . if date="" quit +"RTN","TMGNDF4C",450,0) + . . if 'pastInactiveDate quit +"RTN","TMGNDF4C",451,0) + . . new TMGFDA,TMGMSG,X,Y +"RTN","TMGNDF4C",452,0) + . . set TMGFDA(101.43,IEN101d43_",",.1)="@" +"RTN","TMGNDF4C",453,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",454,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",455,0) + . . set count=count+1 +"RTN","TMGNDF4C",456,0) + . else do ;"is NOT an active import, so ensure inactivated +"RTN","TMGNDF4C",457,0) + . . if pastInactiveDate quit +"RTN","TMGNDF4C",458,0) + . . new TMGFDA,TMGMSG,X,Y +"RTN","TMGNDF4C",459,0) + . . set X="NOW" do ^%DT ;"results return in Y +"RTN","TMGNDF4C",460,0) + . . set TMGFDA(101.43,IEN101d43_",",.1)=Y +"RTN","TMGNDF4C",461,0) + . . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",462,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",463,0) + . . set count=count+1 +"RTN","TMGNDF4C",464,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",465,0) + +"RTN","TMGNDF4C",466,0) + write count," entries modified.",! +"RTN","TMGNDF4C",467,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",468,0) + quit +"RTN","TMGNDF4C",469,0) + +"RTN","TMGNDF4C",470,0) + +"RTN","TMGNDF4C",471,0) +ResetFiles +"RTN","TMGNDF4C",472,0) + ;"Purpose: For debugging purposes, this will reset two files: +"RTN","TMGNDF4C",473,0) + ;" 101.44, 101.43 +"RTN","TMGNDF4C",474,0) + +"RTN","TMGNDF4C",475,0) + ;"CAUTION: make sure you have saved data in the locations below FIRST... +"RTN","TMGNDF4C",476,0) + ;"ALSO: There are many pointers IN to file 101.43. So if this function is run +"RTN","TMGNDF4C",477,0) + ;" in a production system (containing valid patient data), then corruption +"RTN","TMGNDF4C",478,0) + ;" will be introduced. +"RTN","TMGNDF4C",479,0) + +"RTN","TMGNDF4C",480,0) + kill ^TMG("TMP","TEMP BACKUP","^ORD(101.43, 10-16-06") +"RTN","TMGNDF4C",481,0) + merge ^TMG("TMP","TEMP BACKUP","^ORD(101.43, 10-16-06")=^ORD(101.43) +"RTN","TMGNDF4C",482,0) + kill ^ORD(101.43) +"RTN","TMGNDF4C",483,0) + merge ^ORD(101.43)=^TMG("TMP","^ORD(101.43, 10-16-06") +"RTN","TMGNDF4C",484,0) + +"RTN","TMGNDF4C",485,0) + kill ^TMG("TMP","TEMP BACKUP","^ORD(101.44, 10-16-06") +"RTN","TMGNDF4C",486,0) + merge ^TMG("TMP","TEMP BACKUP","^ORD(101.44, 10-16-06")=^ORD(101.44) +"RTN","TMGNDF4C",487,0) + kill ^ORD(101.44) +"RTN","TMGNDF4C",488,0) + merge ^ORD(101.44)=^TMG("TMP","^ORD(101.44, 10-16-06") +"RTN","TMGNDF4C",489,0) + +"RTN","TMGNDF4C",490,0) + quit +"RTN","TMGNDF4C",491,0) + +"RTN","TMGNDF4C",492,0) + ;"----------------------------------- +"RTN","TMGNDF4C",493,0) +VerifySync +"RTN","TMGNDF4C",494,0) + ;"Purpose: to verify that links PHARMACY ORDERABLE ITEM --> ORDERABLE ITEM +"RTN","TMGNDF4C",495,0) + ;" are correct. Link is based on a text pointer (and I think less likely +"RTN","TMGNDF4C",496,0) + ;" to have been fixed with multiple runs...) +"RTN","TMGNDF4C",497,0) + +"RTN","TMGNDF4C",498,0) + new fixArray +"RTN","TMGNDF4C",499,0) + +"RTN","TMGNDF4C",500,0) + write "Scanning entries to ensure link is correctly synchronized...",! +"RTN","TMGNDF4C",501,0) + new Itr,IEN50d7 +"RTN","TMGNDF4C",502,0) + new abort set abort=0 +"RTN","TMGNDF4C",503,0) + set IEN101d43=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4C",504,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN101d43") +"RTN","TMGNDF4C",505,0) + if IEN101d43'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN101d43)'>0)!abort +"RTN","TMGNDF4C",506,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",507,0) + . new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1) +"RTN","TMGNDF4C",508,0) + . if $$OIInactive^TMGNDFUT(IEN101d43) quit ;"ignore inactivate entries +"RTN","TMGNDF4C",509,0) + . set IEN50d7=$$GetPOI^TMGNDFUT(IEN101d43) ;"(will fix bad records) +"RTN","TMGNDF4C",510,0) + . if IEN50d7'>0 quit ;"was bad record, non pharmacy item +"RTN","TMGNDF4C",511,0) + . new OIName set OIName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1) +"RTN","TMGNDF4C",512,0) + . new POIName set POIName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1) +"RTN","TMGNDF4C",513,0) + . if (OIName'=POIName) do +"RTN","TMGNDF4C",514,0) + . . write !,OIName," (OI #",IEN101d43,") <-- ",POIName," (POI #",IEN50d7,") ??",! +"RTN","TMGNDF4C",515,0) + . . set fixArray(IEN50d7,IEN101d43)="" +"RTN","TMGNDF4C",516,0) + . if (OIName="") do +"RTN","TMGNDF4C",517,0) + . . write !,"NULL NAME. (OI #",IEN101d43,") <-- ",POIName," (POI #",IEN50d7,") ??",! +"RTN","TMGNDF4C",518,0) + . . set fixArray(IEN50d7,IEN101d43)="" +"RTN","TMGNDF4C",519,0) + . if $$IsImport^TMGNDFUT(IEN50d7)=0 do +"RTN","TMGNDF4C",520,0) + . . write " 50.7 #",IEN50d7," ",POIName," is not an active import!",! +"RTN","TMGNDF4C",521,0) + . . set fixArray(IEN50d7,IEN101d43)="@" +"RTN","TMGNDF4C",522,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",523,0) + +"RTN","TMGNDF4C",524,0) + new IEN50d7 set IEN50d7="" +"RTN","TMGNDF4C",525,0) + for set IEN50d7=$order(fixArray(IEN50d7)) quit:(IEN50d7="") do +"RTN","TMGNDF4C",526,0) + . new POIName set POIName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1) +"RTN","TMGNDF4C",527,0) + . new IEN50Array +"RTN","TMGNDF4C",528,0) + . do GetDRUGs^TMGNDFUT(IEN50d7,.IEN50Array,1) +"RTN","TMGNDF4C",529,0) + . new Name50 set Name50="" +"RTN","TMGNDF4C",530,0) + . for set Name50=$order(IEN50Array(Name50)) quit:(Name50="") do +"RTN","TMGNDF4C",531,0) + . . new IEN50 set IEN50="" +"RTN","TMGNDF4C",532,0) + . . for set IEN50=$order(IEN50Array(Name50,IEN50)) quit:(IEN50="") do +"RTN","TMGNDF4C",533,0) + . . . write "File 50, #",IEN50,": ",Name50," ",$piece($get(^PSDRUG(IEN50,0)),"^",1)," -->",! +"RTN","TMGNDF4C",534,0) + . write " POI Name=",POIName," --> ",! +"RTN","TMGNDF4C",535,0) + . new IEN101d43 set IEN101d43="" +"RTN","TMGNDF4C",536,0) + . for set IEN101d43=$order(fixArray(IEN50d7,IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDF4C",537,0) + . . if $get(fixArray(IEN50d7,IEN101d43))="@" do quit +"RTN","TMGNDF4C",538,0) + . . . new TMGFDA,TMGMSG,PSEDITNM +"RTN","TMGNDF4C",539,0) + . . . set PSEDITNM=1 +"RTN","TMGNDF4C",540,0) + . . . set TMGFDA(50.7,IEN50d7_",",.01)="@" +"RTN","TMGNDF4C",541,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",542,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",543,0) + . . . kill TMGFDA,TMGMSG +"RTN","TMGNDF4C",544,0) + . . . set TMGFDA(101.43,IEN101d43_",",.01)="@" +"RTN","TMGNDF4C",545,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4C",546,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4C",547,0) + . . new OIName set OIName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1) +"RTN","TMGNDF4C",548,0) + . . write " OI Name=",OIName,! +"RTN","TMGNDF4C",549,0) + . . new result +"RTN","TMGNDF4C",550,0) + . . set result=$$StuffOI(IEN101d43,POIName,,IEN50d7) ;"result 1=modified +"RTN","TMGNDF4C",551,0) + +"RTN","TMGNDF4C",552,0) + ;"Now verify ID cross reference +"RTN","TMGNDF4C",553,0) + +"RTN","TMGNDF4C",554,0) + +"RTN","TMGNDF4C",555,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",556,0) + quit +"RTN","TMGNDF4C",557,0) + +"RTN","TMGNDF4C",558,0) + +"RTN","TMGNDF4C",559,0) +Check4Dups ;"DON'T USE. There are times when the "TRADE" name will actually be a generic +"RTN","TMGNDF4C",560,0) + ;"name, and then the chains between generic and trade name drugs get crossed. +"RTN","TMGNDF4C",561,0) + ;"An OI can only point to 1 POI, so one could cause a situation whereby +"RTN","TMGNDF4C",562,0) + ;"Trade POI --> OI, but OI --> Generic POI (and Trade POI gets lost) +"RTN","TMGNDF4C",563,0) + +"RTN","TMGNDF4C",564,0) + ;"Purpose: to ensure that there are not two entries in the ORDERABLE ITEM +"RTN","TMGNDF4C",565,0) + ;" file with the same name. +"RTN","TMGNDF4C",566,0) + +"RTN","TMGNDF4C",567,0) + new array,dupArray +"RTN","TMGNDF4C",568,0) + +"RTN","TMGNDF4C",569,0) + new Itr,IEN +"RTN","TMGNDF4C",570,0) + new abort set abort=0 +"RTN","TMGNDF4C",571,0) + new count set count=0 +"RTN","TMGNDF4C",572,0) + set IEN=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4C",573,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4C",574,0) + if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0)!abort +"RTN","TMGNDF4C",575,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",576,0) + . new name set name=$piece($get(^ORD(101.43,IEN,0)),"^",1) +"RTN","TMGNDF4C",577,0) + . new priorIEN set priorIEN=+$order(array(name,"")) +"RTN","TMGNDF4C",578,0) + . if priorIEN'=0 do +"RTN","TMGNDF4C",579,0) + . . write !,name," previously found...",! +"RTN","TMGNDF4C",580,0) + . . set dupArray(name,priorIEN)="" +"RTN","TMGNDF4C",581,0) + . . set dupArray(name,IEN)="" +"RTN","TMGNDF4C",582,0) + . set array(name,IEN)="" +"RTN","TMGNDF4C",583,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",584,0) + if abort=1 goto C4DDone +"RTN","TMGNDF4C",585,0) + +"RTN","TMGNDF4C",586,0) + new Itr,fixName +"RTN","TMGNDF4C",587,0) + set fixName=$$ItrAInit^TMGITR("dupArray",.Itr) +"RTN","TMGNDF4C",588,0) + do PrepProgress^TMGITR(.Itr,1,1,"fixName") +"RTN","TMGNDF4C",589,0) + if fixName'="" for do quit:($$ItrANext^TMGITR(.Itr,.fixName)="")!abort +"RTN","TMGNDF4C",590,0) + . new IEN101d43 set IEN101d43="" +"RTN","TMGNDF4C",591,0) + . new keepIEN set keepIEN="" +"RTN","TMGNDF4C",592,0) + . for set IEN101d43=$order(dupArray(fixName,IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDF4C",593,0) + . . if keepIEN="" set keepIEN=IEN101d43 quit ;"use first record as one to keep. +"RTN","TMGNDF4C",594,0) + . . do RedirOI^TMGNDFUT(IEN101d43,keepIEN) +"RTN","TMGNDF4C",595,0) + . . do KillOI^TMGNDFUT(IEN101d43) +"RTN","TMGNDF4C",596,0) + . . set count=count+1 +"RTN","TMGNDF4C",597,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",598,0) + +"RTN","TMGNDF4C",599,0) +C4DDone +"RTN","TMGNDF4C",600,0) + write !,count," Modifications Made.",! +"RTN","TMGNDF4C",601,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",602,0) + quit +"RTN","TMGNDF4C",603,0) + +"RTN","TMGNDF4C",604,0) + +"RTN","TMGNDF4C",605,0) + +"RTN","TMGNDF4C",606,0) + +"RTN","TMGNDF4C",607,0) +CheckDangle +"RTN","TMGNDF4C",608,0) + ;"Purpose: to verify that ORDERABLE ITEM records are not dangling records +"RTN","TMGNDF4C",609,0) + +"RTN","TMGNDF4C",610,0) + new delArray +"RTN","TMGNDF4C",611,0) + +"RTN","TMGNDF4C",612,0) + write "Scanning entries checking for dangling records...",! +"RTN","TMGNDF4C",613,0) + new Itr,IEN50d7,TMGArray,ID,Info +"RTN","TMGNDF4C",614,0) + new abort set abort=0 +"RTN","TMGNDF4C",615,0) + set IEN101d43=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4C",616,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN101d43") +"RTN","TMGNDF4C",617,0) + if IEN101d43'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN101d43)'>0)!abort +"RTN","TMGNDF4C",618,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4C",619,0) + . new OIArray +"RTN","TMGNDF4C",620,0) + . do GetOIInfo^TMGNDFUT(IEN101d43,.OIArray) +"RTN","TMGNDF4C",621,0) + . if $get(OIArray("IEN 101.43","INACTIVE"))=1 quit ;"ignore inactivated records +"RTN","TMGNDF4C",622,0) + . new pkg set pkg=$get(OIArray("IEN 101.43","PACKAGE")) +"RTN","TMGNDF4C",623,0) + . if (pkg'="")&(pkg'["PSP") quit ;" -- not a pharmacy item, so ignore +"RTN","TMGNDF4C",624,0) + . set IEN50d7=+$get(OIArray("IEN 50.7 from 101.43")) +"RTN","TMGNDF4C",625,0) + . new OIName set OIName=$get(OIArray("IEN 101.43","NAME")) +"RTN","TMGNDF4C",626,0) + . ;"if OIName'="" quit ;"temporary.... +"RTN","TMGNDF4C",627,0) + . new POIName set POIName=$get(OIArray("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDF4C",628,0) + . if IEN50d7=0 do +"RTN","TMGNDF4C",629,0) + . . write !,"Record 101.43 #",IEN101d43," (",OIName,") doesn't point to any PHARMACY ORDERABLE ITEM",! +"RTN","TMGNDF4C",630,0) + . . set delArray(IEN101d43)="" +"RTN","TMGNDF4C",631,0) + . else if $$IsImport^TMGNDFUT(IEN50d7)=0 do +"RTN","TMGNDF4C",632,0) + . . write !,"Record 101.43 #",IEN101d43," (",OIName,") points to PHARMACY ORDERABLE ITEM (50.7)#",IEN50d7,! +"RTN","TMGNDF4C",633,0) + . . write " But 50.7 #",IEN50d7," (",POIName,") is not an active import!",! +"RTN","TMGNDF4C",634,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4C",635,0) + +"RTN","TMGNDF4C",636,0) + new count set count=$$ListCt^TMGMISC("delArray") +"RTN","TMGNDF4C",637,0) + write count," records to be deleted.",! +"RTN","TMGNDF4C",638,0) + +"RTN","TMGNDF4C",639,0) + if count>0 do +"RTN","TMGNDF4C",640,0) + . new % set %=1 +"RTN","TMGNDF4C",641,0) + . write "Delete records now" do YN^DICN write ! +"RTN","TMGNDF4C",642,0) + . if %'=1 quit +"RTN","TMGNDF4C",643,0) + . set IEN101d43="" +"RTN","TMGNDF4C",644,0) + . for set IEN101d43=$order(delArray(IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDF4C",645,0) + . . do KillOI^TMGNDFUT(IEN101d43) +"RTN","TMGNDF4C",646,0) + . write "Done.",! +"RTN","TMGNDF4C",647,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",648,0) + else do PressToCont^TMGUSRIF +"RTN","TMGNDF4C",649,0) + +"RTN","TMGNDF4C",650,0) + quit +"RTN","TMGNDF4C",651,0) + +"RTN","TMGNDF4C",652,0) + +"RTN","TMGNDF4C",653,0) + +"RTN","TMGNDF4D") +0^56^B7415 +"RTN","TMGNDF4D",1,0) +TMGNDF4D ;TMG/kst/FDA Import: Activate POI's ;03/25/06 +"RTN","TMGNDF4D",2,0) + ;;1.0;TMG-LIB;**1**;11/21/06 +"RTN","TMGNDF4D",3,0) + +"RTN","TMGNDF4D",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4D",5,0) + ;" Activation of records in PHARMACY ORDERABLE ITEM file +"RTN","TMGNDF4D",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4D",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4D",8,0) + ;"11-21-2006 +"RTN","TMGNDF4D",9,0) + +"RTN","TMGNDF4D",10,0) + +"RTN","TMGNDF4D",11,0) + ;"NOTE: 3/9/07 --DON'T USE THIS FUNCTION. IT IS HANDLED IN TMGNDF4C. +"RTN","TMGNDF4D",12,0) + +"RTN","TMGNDF4D",13,0) + ;"======================================================================= +"RTN","TMGNDF4D",14,0) + ;" API -- Public Functions. +"RTN","TMGNDF4D",15,0) + ;"======================================================================= +"RTN","TMGNDF4D",16,0) + ;"ActivAll -- to remove the inactive date for all records in 101.43 +"RTN","TMGNDF4D",17,0) + +"RTN","TMGNDF4D",18,0) + ;"======================================================================= +"RTN","TMGNDF4D",19,0) + ;" Private Functions. +"RTN","TMGNDF4D",20,0) + ;"======================================================================= +"RTN","TMGNDF4D",21,0) + ;"ActivDate(DateAfter) -- remove inactive date if inactive date on/after DateAfter +"RTN","TMGNDF4D",22,0) + ;"XFormOff -- remove restrinction in input transform that prevents deletion. +"RTN","TMGNDF4D",23,0) + ;"XFormOn -- restore the input transform to field .04 in file 50.7 +"RTN","TMGNDF4D",24,0) + ;"SetXForm(code) -- remove the old input transform, and replace with code +"RTN","TMGNDF4D",25,0) + +"RTN","TMGNDF4D",26,0) + +"RTN","TMGNDF4D",27,0) + ;"======================================================================= +"RTN","TMGNDF4D",28,0) + +"RTN","TMGNDF4D",29,0) +ActivAll +"RTN","TMGNDF4D",30,0) + ;"Purpose: To active ALL records +"RTN","TMGNDF4D",31,0) + +"RTN","TMGNDF4D",32,0) + new date,%T,X,Y +"RTN","TMGNDF4D",33,0) + set X="1/1/1960" +"RTN","TMGNDF4D",34,0) + do ^%DT +"RTN","TMGNDF4D",35,0) + set date=Y +"RTN","TMGNDF4D",36,0) + if date>-1 do ActivDate(date) +"RTN","TMGNDF4D",37,0) + +"RTN","TMGNDF4D",38,0) + write "Done.",! +"RTN","TMGNDF4D",39,0) + quit +"RTN","TMGNDF4D",40,0) + +"RTN","TMGNDF4D",41,0) + +"RTN","TMGNDF4D",42,0) +ActivDate(DateAfter) +"RTN","TMGNDF4D",43,0) + ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM +"RTN","TMGNDF4D",44,0) + ;" having an inactive date on/after DateAfter +"RTN","TMGNDF4D",45,0) + ;"Input: DateAfter -- the date to compare the inactive date with. If the +"RTN","TMGNDF4D",46,0) + ;" inactive date is on/after DateAfter, then inactive date +"RTN","TMGNDF4D",47,0) + ;" will be deleted. +"RTN","TMGNDF4D",48,0) + ;" ** Must be in Fileman Date format +"RTN","TMGNDF4D",49,0) + +"RTN","TMGNDF4D",50,0) + do XFormOff +"RTN","TMGNDF4D",51,0) + +"RTN","TMGNDF4D",52,0) + new Itr,IEN,Date,Y,X +"RTN","TMGNDF4D",53,0) + new abort set abort=-5 +"RTN","TMGNDF4D",54,0) + set IEN=$$ItrInit^TMGITR(101.43,.Itr) +"RTN","TMGNDF4D",55,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGNDF4D",56,0) + if IEN'="" for do quit:($$ItrNext^TMGITR(.Itr,.IEN)'>0)!(abort>0) +"RTN","TMGNDF4D",57,0) + . set abort=abort+$$Activ1(IEN,DateAfter) +"RTN","TMGNDF4D",58,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4D",59,0) + +"RTN","TMGNDF4D",60,0) + do XFormOn +"RTN","TMGNDF4D",61,0) + kill TMGXFORM +"RTN","TMGNDF4D",62,0) + +"RTN","TMGNDF4D",63,0) + quit +"RTN","TMGNDF4D",64,0) + +"RTN","TMGNDF4D",65,0) + +"RTN","TMGNDF4D",66,0) +Activ1(IEN101d43,DateAfter) +"RTN","TMGNDF4D",67,0) + ;"Purpose: To remove inactive date for all records in ORDERABLE ITEM +"RTN","TMGNDF4D",68,0) + ;" having an inactive date on/after DateAfter +"RTN","TMGNDF4D",69,0) + ;"Input: IEN101d43 -- IEN in 101.43 +"RTN","TMGNDF4D",70,0) + ;" DateAfter -- the date to compare the inactive date with. If the +"RTN","TMGNDF4D",71,0) + ;" inactive date is on/after DateAfter, then inactive date +"RTN","TMGNDF4D",72,0) + ;" will be deleted. +"RTN","TMGNDF4D",73,0) + ;" ** Must be in Fileman Date format +"RTN","TMGNDF4D",74,0) + ;"NOTE: XFormOff should be called before this function, and when +"RTN","TMGNDF4D",75,0) + ;" all mods are done, XFormOn should be called. +"RTN","TMGNDF4D",76,0) + ;"Results: 0 is OK, 1 if error +"RTN","TMGNDF4D",77,0) + +"RTN","TMGNDF4D",78,0) + new Itr,IEN,Date,Y,X +"RTN","TMGNDF4D",79,0) + new result set result=0 +"RTN","TMGNDF4D",80,0) + +"RTN","TMGNDF4D",81,0) + new X2 set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date +"RTN","TMGNDF4D",82,0) + if X2="" goto A1Done +"RTN","TMGNDF4D",83,0) + new X1 set X1=DateAfter +"RTN","TMGNDF4D",84,0) + do ^%DTC +"RTN","TMGNDF4D",85,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF4D",86,0) + set TMGFDA(101.43,IEN_",",.1)="" ;"kill inactive date +"RTN","TMGNDF4D",87,0) + new $etrap set $etrap="W ""??ERROR TRAPPED??"",! Q" +"RTN","TMGNDF4D",88,0) + do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4D",89,0) + new PriorErrorFound +"RTN","TMGNDF4D",90,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) goto A1Done +"RTN","TMGNDF4D",91,0) + set X2=$piece($get(^ORD(101.43,IEN,.1)),"^",1) ;".1;1 --> inactive date +"RTN","TMGNDF4D",92,0) + if X2'="" do +"RTN","TMGNDF4D",93,0) + . write "Deletion of 101.43 inactivation date FAILED. [",X2,"]",! +"RTN","TMGNDF4D",94,0) + . set result=1 +"RTN","TMGNDF4D",95,0) + +"RTN","TMGNDF4D",96,0) +A1Done +"RTN","TMGNDF4D",97,0) + quit result +"RTN","TMGNDF4D",98,0) + +"RTN","TMGNDF4D",99,0) + +"RTN","TMGNDF4D",100,0) + +"RTN","TMGNDF4D",101,0) +DoFromTMG(IEN,Option) +"RTN","TMGNDF4D",102,0) + ;"Purpose: to activate ONE entry in ORDERABLE ITEM (101.43) file, linked from 22706.9 +"RTN","TMGNDF4D",103,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF4D",104,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF4D",105,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF4D",106,0) + ;" to file POI, OI, OQV etc. +"RTN","TMGNDF4D",107,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF4D",108,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF4D",109,0) + +"RTN","TMGNDF4D",110,0) + ;"Output: OI records will be added or refreshed. +"RTN","TMGNDF4D",111,0) + ;"Result: 1=Modified, 0=not modified +"RTN","TMGNDF4D",112,0) + +"RTN","TMGNDF4D",113,0) + new result set result=0 +"RTN","TMGNDF4D",114,0) + if +$get(IEN)=0 goto DFTMGDone +"RTN","TMGNDF4D",115,0) + +"RTN","TMGNDF4D",116,0) + new tradePtr,genericPtr +"RTN","TMGNDF4D",117,0) + +"RTN","TMGNDF4D",118,0) + new date,%T,X,Y +"RTN","TMGNDF4D",119,0) + set X="1/1/1960" +"RTN","TMGNDF4D",120,0) + do ^%DT +"RTN","TMGNDF4D",121,0) + set date=Y +"RTN","TMGNDF4D",122,0) + do XFormOff +"RTN","TMGNDF4D",123,0) + +"RTN","TMGNDF4D",124,0) + ;"Get 22706.9 --> 50 --> 50.7 --> 101.43 +"RTN","TMGNDF4D",125,0) + set tradePtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" a IEN50d7 ptr +"RTN","TMGNDF4D",126,0) + set genericPtr=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" a IEN50d7 ptr +"RTN","TMGNDF4D",127,0) + if tradePtr'=0 do +"RTN","TMGNDF4D",128,0) + . new IEN50d7 set IEN50d7=+$piece($get(^PSDRUG(tradePtr,2)),"^",1) ;"2;1 = fld 2.1 to POI +"RTN","TMGNDF4D",129,0) + . if IEN50d7=0 quit +"RTN","TMGNDF4D",130,0) + . new IEN101d43 set IEN101d43=$$GetOI^TMGNDFUT(IEN50d7) +"RTN","TMGNDF4D",131,0) + . if IEN101d43=0 quit +"RTN","TMGNDF4D",132,0) + . do Activ1(IEN101d43,date) +"RTN","TMGNDF4D",133,0) + . if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF4D",134,0) + . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option) +"RTN","TMGNDF4D",135,0) + +"RTN","TMGNDF4D",136,0) + if genericPtr'=0 do +"RTN","TMGNDF4D",137,0) + . new IEN50d7 set IEN50d7=$piece($get(^PSDRUG(genericPtr,2)),"^",1) ;"2;1 = fld 2.1 to POI +"RTN","TMGNDF4D",138,0) + . if IEN50d7=0 quit +"RTN","TMGNDF4D",139,0) + . new IEN101d43 set IEN101d43=$$GetOI^TMGNDF4C(IEN50d7) +"RTN","TMGNDF4D",140,0) + . if IEN101d43=0 quit +"RTN","TMGNDF4D",141,0) + . do Activ1(IEN101d43,date) +"RTN","TMGNDF4D",142,0) + . if $get(Option("FIX CHAIN"))=1 do +"RTN","TMGNDF4D",143,0) + . . do Fix1OQV^TMGNDF4E(IEN101d43,.Option) +"RTN","TMGNDF4D",144,0) + +"RTN","TMGNDF4D",145,0) + do XFormOn +"RTN","TMGNDF4D",146,0) + +"RTN","TMGNDF4D",147,0) +DFTMGDone +"RTN","TMGNDF4D",148,0) + quit result +"RTN","TMGNDF4D",149,0) + +"RTN","TMGNDF4D",150,0) + +"RTN","TMGNDF4D",151,0) + +"RTN","TMGNDF4D",152,0) +XFormOff +"RTN","TMGNDF4D",153,0) + ;"Purpose: to remove restrinction in input transform that prevents deletion. +"RTN","TMGNDF4D",154,0) + +"RTN","TMGNDF4D",155,0) + ;"new TMGXFORM ;NOTE: NO new -- will be killed later +"RTN","TMGNDF4D",156,0) + set TMGXFORM=$piece($get(^ORD(101.43,.1,0)),"^",5,99) +"RTN","TMGNDF4D",157,0) + merge ^TMG("TMP","XREF",101.43,.1,1)=^DD(101.43,.1,1) +"RTN","TMGNDF4D",158,0) + kill ^DD(101.43,.1,1) ;"kill off the screening xref code +"RTN","TMGNDF4D",159,0) + do SetXForm("W !,X,! S %DT=""E"" D ^%DT S X=Y S:Y<1 X=""""") +"RTN","TMGNDF4D",160,0) + +"RTN","TMGNDF4D",161,0) + quit +"RTN","TMGNDF4D",162,0) + +"RTN","TMGNDF4D",163,0) + +"RTN","TMGNDF4D",164,0) +XFormOn +"RTN","TMGNDF4D",165,0) + ;"Purpose: to restore the input transform to field .04 in file 50.7 +"RTN","TMGNDF4D",166,0) + +"RTN","TMGNDF4D",167,0) + set TMGXFORM=$get(TMGXFORM,"S %DT=""ESTX"" D ^%DT S X=Y K:Y<1 X") +"RTN","TMGNDF4D",168,0) + do SetXForm(TMGXFORM) +"RTN","TMGNDF4D",169,0) + kill ^DD(101.43,.1,1) +"RTN","TMGNDF4D",170,0) + merge ^DD(101.43,.1,1)=^TMG("TMP","XREF",101.43,.1,1) ;"restore screening xref code +"RTN","TMGNDF4D",171,0) + quit +"RTN","TMGNDF4D",172,0) + +"RTN","TMGNDF4D",173,0) + +"RTN","TMGNDF4D",174,0) +SetXForm(code) +"RTN","TMGNDF4D",175,0) + ;"Purpose: to remove the old input transform, and replace with code +"RTN","TMGNDF4D",176,0) + +"RTN","TMGNDF4D",177,0) + set $piece(^DD(101.43,.1,0),"^",5,99)="" ;"clear out old stuff +"RTN","TMGNDF4D",178,0) + set $piece(^DD(101.43,.1,0),"^",5)=code +"RTN","TMGNDF4D",179,0) + ;"zwr ^DD(50.7,.04,0) +"RTN","TMGNDF4D",180,0) + quit +"RTN","TMGNDF4E") +0^57^B6240 +"RTN","TMGNDF4E",1,0) +TMGNDF4E ;TMG/kst/FDA Import -- Copy Orderable --> OQV ;03/25/06 +"RTN","TMGNDF4E",2,0) + ;;1.0;TMG-LIB;**1**;11/21/07 +"RTN","TMGNDF4E",3,0) + +"RTN","TMGNDF4E",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4E",5,0) + ;" Copy of ORDERABLE ITEMS into ORDER QUICK VIEW file +"RTN","TMGNDF4E",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4E",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4E",8,0) + ;"11-21-2006 +"RTN","TMGNDF4E",9,0) + +"RTN","TMGNDF4E",10,0) + ;"======================================================================= +"RTN","TMGNDF4E",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF4E",12,0) + ;"======================================================================= +"RTN","TMGNDF4E",13,0) + ;"Menu +"RTN","TMGNDF4E",14,0) + +"RTN","TMGNDF4E",15,0) + ;"Sync2OQV -- ensure ALL ORDERABLE ITEMS (101.43) items are added to the ORDER QUICK VIEW (101.44) +"RTN","TMGNDF4E",16,0) + ;"Fix1OQV(IEN101d43,Option) -- alter one entry in OQV file to reflect changes in ORDERABLE ITEM file (101.43) +"RTN","TMGNDF4E",17,0) + +"RTN","TMGNDF4E",18,0) + ;"======================================================================= +"RTN","TMGNDF4E",19,0) + ;" Private Functions. +"RTN","TMGNDF4E",20,0) + ;"======================================================================= +"RTN","TMGNDF4E",21,0) + ;"MakeNewQOVS -- save the old QUICK ORDER VIEW set, and create a new one. +"RTN","TMGNDF4E",22,0) + ;"Add(RxSet,pOI) -- add 'name' to ORWDSET O RX record in ORDER QUICK VIEW file +"RTN","TMGNDF4E",23,0) + ;"KillPrior(RxSet) -- kill ALL records in the RxSet in 101.44 +"RTN","TMGNDF4E",24,0) + ;"Check4BadOQV -- Scan through all ORDER QUICK VIEWS cheking fro pointers to bad records +"RTN","TMGNDF4E",25,0) + +"RTN","TMGNDF4E",26,0) + ;"======================================================================= +"RTN","TMGNDF4E",27,0) + +"RTN","TMGNDF4E",28,0) +Menu +"RTN","TMGNDF4E",29,0) + new Menu,UsrSlct +"RTN","TMGNDF4E",30,0) + set Menu(0)="Pick Option to Sync ORDER QUICK VIEW (OQV) (4E)" +"RTN","TMGNDF4E",31,0) + set Menu(1)="Sync imports to ORDER QUICK VIEW."_$char(9)_"Sync2OQV" +"RTN","TMGNDF4E",32,0) + set Menu(2)="Check for BAD entries in ORDER QUICK VIEW file"_$char(9)_"Check4BadOQV" +"RTN","TMGNDF4E",33,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF4E",34,0) + set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF4E",35,0) + +"RTN","TMGNDF4E",36,0) +M1 write # +"RTN","TMGNDF4E",37,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4E",38,0) + +"RTN","TMGNDF4E",39,0) + if UsrSlct="Sync2OQV" do Sync2OQV goto M1 +"RTN","TMGNDF4E",40,0) + if UsrSlct="Check4BadOQV" do Check4BadOQV goto M1 +"RTN","TMGNDF4E",41,0) + if UsrSlct="Prev" goto Menu^TMGNDF4C ;"quit can occur from there... +"RTN","TMGNDF4E",42,0) + if UsrSlct="Next" goto Menu^TMGNDF4F ;"quit can occur from there... +"RTN","TMGNDF4E",43,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF4E",44,0) + goto M1 +"RTN","TMGNDF4E",45,0) + +"RTN","TMGNDF4E",46,0) +MenuDone +"RTN","TMGNDF4E",47,0) + quit +"RTN","TMGNDF4E",48,0) + +"RTN","TMGNDF4E",49,0) + +"RTN","TMGNDF4E",50,0) +Sync2OQV +"RTN","TMGNDF4E",51,0) + ;"Purpose: To cycle through all items in the ORDERABLE ITEMS (101.43) file and +"RTN","TMGNDF4E",52,0) + ;" ensure that they have been added to the ORDER QUICK VIEW (101.44) file +"RTN","TMGNDF4E",53,0) + ;"Result: none. +"RTN","TMGNDF4E",54,0) + +"RTN","TMGNDF4E",55,0) + ;"NOTE: This function will KILL prior entries in ORWD O RX record +"RTN","TMGNDF4E",56,0) + ;" There are no pointers IN to this file, so deleting will not +"RTN","TMGNDF4E",57,0) + ;" leave dangling pointers. +"RTN","TMGNDF4E",58,0) + +"RTN","TMGNDF4E",59,0) + ;"NOTE: this function must ensure that the drugs are put into 101.44 +"RTN","TMGNDF4E",60,0) + ;" in alphabetical order +"RTN","TMGNDF4E",61,0) + ;" ALSO, drugs should be added both with their generic and brand names. +"RTN","TMGNDF4E",62,0) + +"RTN","TMGNDF4E",63,0) + ;"Here is an example of drugs that have been added 'properly' +"RTN","TMGNDF4E",64,0) + ;" 1) ^ORD(101.44,16,20,0) = ^101.442PA^20^20 +"RTN","TMGNDF4E",65,0) + ;" 2) ^ORD(101.44,16,20,1,0) = 49^AMITRIPTYLINE TAB +"RTN","TMGNDF4E",66,0) + ;" 3) ^ORD(101.44,16,20,2,0) = 53^CHLORPROMAZINE TAB +"RTN","TMGNDF4E",67,0) + ;" 4) ^ORD(101.44,16,20,3,0) = 50^DIGOXIN TAB +"RTN","TMGNDF4E",68,0) + ;" 5) ^ORD(101.44,16,20,4,0) = 44^DILTIAZEM TAB +"RTN","TMGNDF4E",69,0) + ;" 6) ^ORD(101.44,16,20,5,0) = 49^ELAVIL +"RTN","TMGNDF4E",70,0) + ;" 7) ^ORD(101.44,16,20,6,0) = 49^ENDEP +"RTN","TMGNDF4E",71,0) + ;" 8) ^ORD(101.44,16,20,7,0) = 47^HCTZ +"RTN","TMGNDF4E",72,0) + ;" 9) ^ORD(101.44,16,20,8,0) = 47^HYDROCHLOROTHIZIDE TAB +"RTN","TMGNDF4E",73,0) + ;" 10) ^ORD(101.44,16,20,9,0) = 50^LANOXIN +"RTN","TMGNDF4E",74,0) + ;" 11) ^ORD(101.44,16,20,10,0) = 54^LEVOTHYROXINE TAB +"RTN","TMGNDF4E",75,0) + ;" 12) ^ORD(101.44,16,20,11,0) = 54^LEVOXYL +"RTN","TMGNDF4E",76,0) + ;" 13) ^ORD(101.44,16,20,12,0) = 46^LISINOPRIL TAB +"RTN","TMGNDF4E",77,0) + ;" 14) ^ORD(101.44,16,20,13,0) = 52^PRAZOSIN CAP,ORAL +"RTN","TMGNDF4E",78,0) + ;" 15) ^ORD(101.44,16,20,14,0) = 46^PRINIVIL +"RTN","TMGNDF4E",79,0) + ;" 16) ^ORD(101.44,16,20,15,0) = 48^SILDENAFIL TAB +"RTN","TMGNDF4E",80,0) + ;" 17) ^ORD(101.44,16,20,16,0) = 54^SYNTHROID +"RTN","TMGNDF4E",81,0) + ;" 18) ^ORD(101.44,16,20,17,0) = 48^VIAGRA +"RTN","TMGNDF4E",82,0) + ;" 19) ^ORD(101.44,16,20,18,0) = 46^ZESTRIL +"RTN","TMGNDF4E",83,0) + ;" 20) ^ORD(101.44,16,20,19,0) = 20 +"RTN","TMGNDF4E",84,0) + ;"21) ^ORD(101.44,16,20,20,0) = 54 +"RTN","TMGNDF4E",85,0) + ;"22) ^ORD(101.44,16,20,"B",20,19) = +"RTN","TMGNDF4E",86,0) + ;"23) ^ORD(101.44,16,20,"B",54,20) = +"RTN","TMGNDF4E",87,0) + ;"24) ^ORD(101.44,16,20,"C","AMITRIPTYLINE TAB ",1) = +"RTN","TMGNDF4E",88,0) + ;"25) ^ORD(101.44,16,20,"C","CHLORPROMAZINE TAB ",2) = +"RTN","TMGNDF4E",89,0) + ;"26) ^ORD(101.44,16,20,"C","DIGOXIN TAB ",3) = +"RTN","TMGNDF4E",90,0) + ;"27) ^ORD(101.44,16,20,"C","DILTIAZEM TAB ",4) = +"RTN","TMGNDF4E",91,0) + ;"28) ^ORD(101.44,16,20,"C","ELAVIL ",5) = +"RTN","TMGNDF4E",92,0) + ;"29) ^ORD(101.44,16,20,"C","ENDEP ",6) = +"RTN","TMGNDF4E",93,0) + ;"30) ^ORD(101.44,16,20,"C","HCTZ ",7) = +"RTN","TMGNDF4E",94,0) + ;"31) ^ORD(101.44,16,20,"C","HYDROCHLOROTHIZIDE TAB ",8) = +"RTN","TMGNDF4E",95,0) + ;"32) ^ORD(101.44,16,20,"C","LANOXIN ",9) = +"RTN","TMGNDF4E",96,0) + ;"33) ^ORD(101.44,16,20,"C","LEVOTHYROXINE TAB ",10) = +"RTN","TMGNDF4E",97,0) + ;"34) ^ORD(101.44,16,20,"C","LEVOXYL ",11) = +"RTN","TMGNDF4E",98,0) + ;"35) ^ORD(101.44,16,20,"C","LISINOPRIL TAB ",12) = +"RTN","TMGNDF4E",99,0) + ;"36) ^ORD(101.44,16,20,"C","PRAZOSIN CAP,ORAL ",13) = +"RTN","TMGNDF4E",100,0) + ;"37) ^ORD(101.44,16,20,"C","PRINIVIL ",14) = +"RTN","TMGNDF4E",101,0) + ;"38) ^ORD(101.44,16,20,"C","SILDENAFIL TAB ",15) = +"RTN","TMGNDF4E",102,0) + ;"39) ^ORD(101.44,16,20,"C","SYNTHROID ",16) = +"RTN","TMGNDF4E",103,0) + +"RTN","TMGNDF4E",104,0) + do MakeNewQOVS ;"Get a fresh order set to work in. +"RTN","TMGNDF4E",105,0) + +"RTN","TMGNDF4E",106,0) + set RxSet=$$GetOQVSet^TMGNDFUT +"RTN","TMGNDF4E",107,0) + if RxSet'>0 do goto AADone +"RTN","TMGNDF4E",108,0) + . write "Can't find record 'ORWDSET O RX' in ORDER QUICK VIEW (101.44) file.",! +"RTN","TMGNDF4E",109,0) + . write "Aborting.",! +"RTN","TMGNDF4E",110,0) + +"RTN","TMGNDF4E",111,0) + ;"Kill all prior display data in ORDER QUICK VIEW file: ORWDSET O RX record +"RTN","TMGNDF4E",112,0) + do KillPrior(RxSet) +"RTN","TMGNDF4E",113,0) + +"RTN","TMGNDF4E",114,0) + new pAddArray set pAddArray=$name(^TMG("TMP","KILL","Add 101.44 Temp")) +"RTN","TMGNDF4E",115,0) + kill @pAddArray +"RTN","TMGNDF4E",116,0) + +"RTN","TMGNDF4E",117,0) + write "Organizing drugs for addition to ORDER QUICK VIEW...",! +"RTN","TMGNDF4E",118,0) + new Itr,IEN22706d9 +"RTN","TMGNDF4E",119,0) + new abort set abort=0 +"RTN","TMGNDF4E",120,0) + set IEN22706d9=$$ItrInit^TMGITR(22706.9,.Itr) +"RTN","TMGNDF4E",121,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN22706d9") +"RTN","TMGNDF4E",122,0) + if IEN22706d9'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN22706d9)'>0)!abort +"RTN","TMGNDF4E",123,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4E",124,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;" 1=skip +"RTN","TMGNDF4E",125,0) + . new tIEN101d43,gIEN101d43 +"RTN","TMGNDF4E",126,0) + . set tIEN101d43=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5) +"RTN","TMGNDF4E",127,0) + . set gIEN101d43=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6) +"RTN","TMGNDF4E",128,0) + . if tIEN101d43>0 do +"RTN","TMGNDF4E",129,0) + . . new name set name=$piece($get(^ORD(101.43,tIEN101d43,0)),"^",1) +"RTN","TMGNDF4E",130,0) + . . if (name="")!(name="") do KillOI^TMGNDFUT(tIEN101d43) quit +"RTN","TMGNDF4E",131,0) + . . set @pAddArray@(name,tIEN101d43)="" +"RTN","TMGNDF4E",132,0) + . . new SynIEN set SynIEN=0 +"RTN","TMGNDF4E",133,0) + . . for set SynIEN=$order(^ORD(101.43,tIEN101d43,2,SynIEN)) quit:(+SynIEN'>0) do +"RTN","TMGNDF4E",134,0) + . . . new SynName set SynName=$get(^ORD(101.43,tIEN101d43,2,SynIEN,0)) +"RTN","TMGNDF4E",135,0) + . . . set SynName=$$Trim^TMGSTUTL(SynName) +"RTN","TMGNDF4E",136,0) + . . . set SynName=SynName_" <"_name_">" +"RTN","TMGNDF4E",137,0) + . . . set @pAddArray@(SynName,tIEN101d43)="" +"RTN","TMGNDF4E",138,0) + . if gIEN101d43>0 do +"RTN","TMGNDF4E",139,0) + . . new name set name=$piece($get(^ORD(101.43,gIEN101d43,0)),"^",1) +"RTN","TMGNDF4E",140,0) + . . if (name="")!(name="") do KillOI^TMGNDFUT(gIEN101d43) quit +"RTN","TMGNDF4E",141,0) + . . set @pAddArray@(name,gIEN101d43)="" +"RTN","TMGNDF4E",142,0) + . . new SynIEN set SynIEN=0 +"RTN","TMGNDF4E",143,0) + . . for set SynIEN=$order(^ORD(101.43,gIEN101d43,2,SynIEN)) quit:(+SynIEN'>0) do +"RTN","TMGNDF4E",144,0) + . . . new SynName set SynName=$get(^ORD(101.43,gIEN101d43,2,SynIEN,0)) +"RTN","TMGNDF4E",145,0) + . . . set SynName=$$Trim^TMGSTUTL(SynName) +"RTN","TMGNDF4E",146,0) + . . . set SynName=SynName_" <"_name_">" +"RTN","TMGNDF4E",147,0) + . . . set @pAddArray@(SynName,gIEN101d43)="" +"RTN","TMGNDF4E",148,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4E",149,0) + if abort=1 goto AADone +"RTN","TMGNDF4E",150,0) + +"RTN","TMGNDF4E",151,0) + ;"Now add all drugs +"RTN","TMGNDF4E",152,0) + write "Adding drugs to ORDER QUICK VIEW...",! +"RTN","TMGNDF4E",153,0) + new Itr,DispName +"RTN","TMGNDF4E",154,0) + set abort=0 +"RTN","TMGNDF4E",155,0) + set DispName=$$ItrAInit^TMGITR(pAddArray,.Itr) +"RTN","TMGNDF4E",156,0) + do PrepProgress^TMGITR(.Itr,20,1,"DispName") +"RTN","TMGNDF4E",157,0) + if DispName'="" for do quit:($$ItrANext^TMGITR(.Itr,.DispName)="")!abort +"RTN","TMGNDF4E",158,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDF4E",159,0) + . new IEN set IEN=$order(@pAddArray@(DispName,"")) +"RTN","TMGNDF4E",160,0) + . set pOQV=$$Add(RxSet,IEN,DispName) +"RTN","TMGNDF4E",161,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDF4E",162,0) + +"RTN","TMGNDF4E",163,0) +AADone +"RTN","TMGNDF4E",164,0) + write "Done.",! +"RTN","TMGNDF4E",165,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4E",166,0) + quit +"RTN","TMGNDF4E",167,0) + +"RTN","TMGNDF4E",168,0) + +"RTN","TMGNDF4E",169,0) +MakeNewQOVS +"RTN","TMGNDF4E",170,0) + ;"Purpose: To save the old QUICK ORDER VIEW set, and create a new one. +"RTN","TMGNDF4E",171,0) + ;"Note: Because the drugs have to be added to the file in alphabetical order, +"RTN","TMGNDF4E",172,0) + ;" it is required to create a NEW order set. I will save the old one +"RTN","TMGNDF4E",173,0) + ;" for future reference. +"RTN","TMGNDF4E",174,0) + +"RTN","TMGNDF4E",175,0) + new DIC,X,Y,%,RxSet +"RTN","TMGNDF4E",176,0) + +"RTN","TMGNDF4E",177,0) + set RxSet=$$GetOQVSet^TMGNDFUT +"RTN","TMGNDF4E",178,0) + if RxSet'>0 do goto MNQSDone +"RTN","TMGNDF4E",179,0) + . write "Can't find record 'ORWDSET O RX' in ORDER QUICK VIEW (101.44) file.",! +"RTN","TMGNDF4E",180,0) + . write "Aborting.",! +"RTN","TMGNDF4E",181,0) + +"RTN","TMGNDF4E",182,0) + new nowS +"RTN","TMGNDF4E",183,0) + do NOW^%DTC +"RTN","TMGNDF4E",184,0) + S Y=X ;"% current fileman date returned in X (no time) +"RTN","TMGNDF4E",185,0) + D DD^%DT ;"convert to external format. +"RTN","TMGNDF4E",186,0) + set nowS=Y +"RTN","TMGNDF4E",187,0) + +"RTN","TMGNDF4E",188,0) + new newName set newName="ORWDSET O RX -- "_nowS +"RTN","TMGNDF4E",189,0) + write "Saving old ORDER QUICK VIEW set as: ",newName,! +"RTN","TMGNDF4E",190,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGNDF4E",191,0) + set TMGFDA(101.44,RxSet_",",.01)=newName +"RTN","TMGNDF4E",192,0) + do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDF4E",193,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4E",194,0) + +"RTN","TMGNDF4E",195,0) + set TMGFDA(101.44,"+1,",.01)="ORWDSET O RX" +"RTN","TMGNDF4E",196,0) + set TMGFDA(101.44,"+1,",6)="NOW" +"RTN","TMGNDF4E",197,0) + do UPDATE^DIE("EK","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4E",198,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4E",199,0) + +"RTN","TMGNDF4E",200,0) +MNQSDone +"RTN","TMGNDF4E",201,0) + quit +"RTN","TMGNDF4E",202,0) + +"RTN","TMGNDF4E",203,0) + +"RTN","TMGNDF4E",204,0) +Add(RxSet,pOI,RxName) +"RTN","TMGNDF4E",205,0) + ;"Purpose: to add 'name' to ORWDSET O RX record in ORDER QUICK VIEW ('OQV')file +"RTN","TMGNDF4E",206,0) + ;"Input: RxSet -- the record number in OQV to add records to. +"RTN","TMGNDF4E",207,0) + ;" pOI -- a pointer to (i.e. the IEN of) record in ORDERABLE ITEM (101.43) file +"RTN","TMGNDF4E",208,0) + ;" RxName -- The name to display in CPRS +"RTN","TMGNDF4E",209,0) + ;"Results: returns the IEN of the new record. +"RTN","TMGNDF4E",210,0) + +"RTN","TMGNDF4E",211,0) + new TMGFDA,TMGMSG,TMGIEN,PriorErrorFound +"RTN","TMGNDF4E",212,0) + new result set result=0 +"RTN","TMGNDF4E",213,0) + +"RTN","TMGNDF4E",214,0) + if pOI=0 do goto AdDone +"RTN","TMGNDF4E",215,0) + . write !,"Skipping addition of ",RxName," because it doesn't",! +"RTN","TMGNDF4E",216,0) + . write "seem linked to a PHARMACY ORDERABLE ITEM.",! +"RTN","TMGNDF4E",217,0) + set TMGFDA(101.442,"+1,"_RxSet_",",.01)=pOI +"RTN","TMGNDF4E",218,0) + set TMGFDA(101.442,"+1,"_RxSet_",",2)=RxName +"RTN","TMGNDF4E",219,0) + +"RTN","TMGNDF4E",220,0) + new $etrap set $etrap="write !,""ERROR TRAPPED."",! quit" +"RTN","TMGNDF4E",221,0) +Ad1 do UPDATE^DIE("S","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGNDF4E",222,0) + if $$ShowIfError^TMGDBAPI(.TMGMSG,.PriorErrorFound) goto AdDone +"RTN","TMGNDF4E",223,0) + set result=+$get(TMGIEN(1)) +"RTN","TMGNDF4E",224,0) + +"RTN","TMGNDF4E",225,0) +AdDone +"RTN","TMGNDF4E",226,0) + quit result +"RTN","TMGNDF4E",227,0) + +"RTN","TMGNDF4E",228,0) + +"RTN","TMGNDF4E",229,0) +KillPrior(RxSet) +"RTN","TMGNDF4E",230,0) + ;"Purpose: To kill ALL records in the RxSet in 101.44 +"RTN","TMGNDF4E",231,0) + ;"Note: I am fairly certain that no other files point to this file +"RTN","TMGNDF4E",232,0) + ;" (there are no pointers IN). So I can just kill. +"RTN","TMGNDF4E",233,0) + ;" CAUTION: this might not be the right thing to do in another system. +"RTN","TMGNDF4E",234,0) + +"RTN","TMGNDF4E",235,0) + new temp merge temp=^ORD(101.44,RxSet,20,0) +"RTN","TMGNDF4E",236,0) + kill ^ORD(101.44,RxSet,20) +"RTN","TMGNDF4E",237,0) + merge ^ORD(101.44,RxSet,20,0)=temp +"RTN","TMGNDF4E",238,0) + set $piece(^ORD(101.44,RxSet,20,0),"^",3)=0 ;"most recently assigned IEN +"RTN","TMGNDF4E",239,0) + set $piece(^ORD(101.44,RxSet,20,0),"^",4)=0 ;"current total number of records +"RTN","TMGNDF4E",240,0) + +"RTN","TMGNDF4E",241,0) + quit +"RTN","TMGNDF4E",242,0) + +"RTN","TMGNDF4E",243,0) + +"RTN","TMGNDF4E",244,0) + ;"============================== +"RTN","TMGNDF4E",245,0) +Fix1OQV(IEN101d43,Option) +"RTN","TMGNDF4E",246,0) + ;"Purpose: to alter one entry in OQV file to reflect changes +"RTN","TMGNDF4E",247,0) + ;" in ORDERABLE ITEM file (101.43) +"RTN","TMGNDF4E",248,0) + ;"Input: IEN101d43 -- IEN in ORDERABLE ITEM file (101.43) +"RTN","TMGNDF4E",249,0) + ;" Option -- OPTIONAL. Format: +"RTN","TMGNDF4E",250,0) + ;" Option("FIX CHAIN")=1 <--- changes will be propigate forward +"RTN","TMGNDF4E",251,0) + ;" to file POI, OI, OQV etc. +"RTN","TMGNDF4E",252,0) + ;" OPTION("FIX CHAIN","IEN22706d9")=Source IEN +"RTN","TMGNDF4E",253,0) + ;" Option("QUIET")=1 <-- supress text output +"RTN","TMGNDF4E",254,0) + ;" Option("IEN50","TRADE")=IEN50 for Trade Name +"RTN","TMGNDF4E",255,0) + ;" Option("IEN50","GENERIC")=IEN50 for Generic Name +"RTN","TMGNDF4E",256,0) + ;" Option("DRUG NAME AND FORM","TRADE")=tradeNameAF +"RTN","TMGNDF4E",257,0) + ;" Option("DRUG NAME AND FORM","GENERIC")=genericNameAF +"RTN","TMGNDF4E",258,0) + ;" Option("IEN50.7","TRADE")=IEN50d7 +"RTN","TMGNDF4E",259,0) + ;" Option("IEN50.7","GENERIC")=IEN50d7 +"RTN","TMGNDF4E",260,0) + ;" Option("IEN101.43","TRADE")=IEN101d43 +"RTN","TMGNDF4E",261,0) + ;" Option("IEN101.43","GENERIC")=IEN101d43 +"RTN","TMGNDF4E",262,0) + ;" Option("DELETING")=1 <-- deleting chain (not IEN22706d9) +"RTN","TMGNDF4E",263,0) + ;"NOTE: The entries in the OQV file have to be set up in ALPHABETICAL order. +"RTN","TMGNDF4E",264,0) + ;" This function will NOT reorder these. If name is completely changed, then +"RTN","TMGNDF4E",265,0) + ;" it will likely appear out of alphabetical order. This may hinder finding it. +"RTN","TMGNDF4E",266,0) + ;" -- Such a problem could be fixed by runnin: Sync2OQV^TMGNDF4E +"RTN","TMGNDF4E",267,0) + ;"Result: 1 if error, 0 if OK. +"RTN","TMGNDF4E",268,0) + +"RTN","TMGNDF4E",269,0) + new result set result=0 +"RTN","TMGNDF4E",270,0) + new RxSet,quiet +"RTN","TMGNDF4E",271,0) + set quiet=$get(Option("QUIET"))=1 +"RTN","TMGNDF4E",272,0) + set RxSet=$$GetOQVSet^TMGNDFUT(quiet) +"RTN","TMGNDF4E",273,0) + if RxSet=0 goto F1OQVDone +"RTN","TMGNDF4E",274,0) + +"RTN","TMGNDF4E",275,0) + new OQVIENS set OQVIENS=$$GetOQVIENS^TMGNDFUT(IEN101d43,RxSet) +"RTN","TMGNDF4E",276,0) + if OQVIENS=0 do goto F1OQVDone +"RTN","TMGNDF4E",277,0) + . if quiet quit +"RTN","TMGNDF4E",278,0) + . write "Can't find link ORDERABLE ITEM--> ORDER QUICK VIEW (OQV).",! +"RTN","TMGNDF4E",279,0) + . write "Try do a batch add of imports into OQV.",! +"RTN","TMGNDF4E",280,0) + . write "Can't insert OQV with out reordering...",! +"RTN","TMGNDF4E",281,0) + +"RTN","TMGNDF4E",282,0) + new drugName set drugName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1) +"RTN","TMGNDF4E",283,0) + if ($get(Option("DELETING"))=1)!(drugName="") set drugName="" +"RTN","TMGNDF4E",284,0) + +"RTN","TMGNDF4E",285,0) + new TMGFDA,TMGMSG +"RTN","TMGNDF4E",286,0) + set TMGFDA(101.442,OQVIENS,2)=drugName +"RTN","TMGNDF4E",287,0) + new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDF4E",288,0) + if $data(TMGFDA) do +"RTN","TMGNDF4E",289,0) + . do FILE^DIE("KS","TMGFDA","TMGMSG") +"RTN","TMGNDF4E",290,0) + . set result=$$ShowIfError^TMGDBAPI(.TMGMSG) ;"show FM errors, even if quiet. +"RTN","TMGNDF4E",291,0) + +"RTN","TMGNDF4E",292,0) +F1OQVDone +"RTN","TMGNDF4E",293,0) + quit result +"RTN","TMGNDF4E",294,0) + +"RTN","TMGNDF4E",295,0) + +"RTN","TMGNDF4E",296,0) +Check4BadOQV +"RTN","TMGNDF4E",297,0) + ;"Purpose: Scan through all ORDER QUICK VIEWS and see if any are pointing +"RTN","TMGNDF4E",298,0) + ;" to bad records +"RTN","TMGNDF4E",299,0) + +"RTN","TMGNDF4E",300,0) + new RxSet set RxSet=$$GetOQVSet^TMGNDFUT +"RTN","TMGNDF4E",301,0) + if RxSet=0 goto C4BOQVDone +"RTN","TMGNDF4E",302,0) + new totalCt set totalCt=0 +"RTN","TMGNDF4E",303,0) + new count set count=0 +"RTN","TMGNDF4E",304,0) + +"RTN","TMGNDF4E",305,0) + new index set index=0 +"RTN","TMGNDF4E",306,0) + for set index=$order(^ORD(101.44,RxSet,20,index)) quit:(+index'>0) do +"RTN","TMGNDF4E",307,0) + . set totalCt=totalCt+1 +"RTN","TMGNDF4E",308,0) + . new s set s=$get(^ORD(101.44,RxSet,20,index,0)) +"RTN","TMGNDF4E",309,0) + . new ptr set ptr=+s +"RTN","TMGNDF4E",310,0) + . if ptr=0 quit +"RTN","TMGNDF4E",311,0) + . new name set name=$piece(s,"^",2) +"RTN","TMGNDF4E",312,0) + . if $piece($get(^ORD(101.43,ptr,0)),"^",1)'="" quit +"RTN","TMGNDF4E",313,0) + . write !,"BAD: ",name,! +"RTN","TMGNDF4E",314,0) + . write "OQV 101.44:#",index,",",RxSet,", --> OI 101.43:#",ptr," which is empty",! +"RTN","TMGNDF4E",315,0) + . do KillOQV^TMGNDFUT(index_","_RxSet_",") +"RTN","TMGNDF4E",316,0) + . write " ... deleted.",! +"RTN","TMGNDF4E",317,0) + . set count=count+1 +"RTN","TMGNDF4E",318,0) + +"RTN","TMGNDF4E",319,0) + write !,totalCt," entries scanned.",! +"RTN","TMGNDF4E",320,0) + write count," bad entries found.",! +"RTN","TMGNDF4E",321,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4E",322,0) + +"RTN","TMGNDF4E",323,0) +C4BOQVDone +"RTN","TMGNDF4E",324,0) + quit +"RTN","TMGNDF4E",325,0) + +"RTN","TMGNDF4F") +0^58^B7817 +"RTN","TMGNDF4F",1,0) +TMGNDF4F ;TMG/kst/FDA Import -- Explore drugs linked to OQV ;03/25/06 +"RTN","TMGNDF4F",2,0) + ;;1.0;TMG-LIB;**1**;01/10/07 +"RTN","TMGNDF4F",3,0) + +"RTN","TMGNDF4F",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4F",5,0) + ;" Exploration of drugs linked to a selected ORDER QUICK VIEW +"RTN","TMGNDF4F",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4F",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4F",8,0) + ;"1-10-2007 +"RTN","TMGNDF4F",9,0) + +"RTN","TMGNDF4F",10,0) + ;"======================================================================= +"RTN","TMGNDF4F",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF4F",12,0) + ;"======================================================================= +"RTN","TMGNDF4F",13,0) + ;"Menu +"RTN","TMGNDF4F",14,0) + ;"MenuOI(IEN101d43) -- Menu to explore ORDERABLE ITEM +"RTN","TMGNDF4F",15,0) + ;"MenuPOI(OIArray) -- Menu to explore PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4F",16,0) + ;"MenuDrug(IEN50) -- Menu to explore DRUG item. +"RTN","TMGNDF4F",17,0) + ;"MenuFDA(FDA) -- Menu to explore TMG FDA IMPORT COMPILED +"RTN","TMGNDF4F",18,0) + +"RTN","TMGNDF4F",19,0) + ;"======================================================================= +"RTN","TMGNDF4F",20,0) + ;" Private Functions. +"RTN","TMGNDF4F",21,0) + ;"======================================================================= +"RTN","TMGNDF4F",22,0) + ;"GetAvail(IEN,Array,sigArray) -- explore the available doses for a given orderable item +"RTN","TMGNDF4F",23,0) + ;"MenuPickRx(IEN50Array,IEN50) -- allow user to pick which linked DRUG entry to explore +"RTN","TMGNDF4F",24,0) + ;"Show1Chain(IENOQV) -- show entire chain, as far back as possible +"RTN","TMGNDF4F",25,0) + ;"ShowAvail(IEN101d43) -- Show available drugs for a given ORDERABLE ITEM (101.43) +"RTN","TMGNDF4F",26,0) + ;"GetAvail(IEN101d43,Array,sigArray) -- explore the available doses for a given ORDERABLE ITEM (101.43) +"RTN","TMGNDF4F",27,0) + ;"$$AskOQV(NameOut) -- ask the user for a ORDER QUICK VIEW drug to view. +"RTN","TMGNDF4F",28,0) + ;"ShowComp(array) -- display all the drugs and sigs for a set of IEN's in 101.43 +"RTN","TMGNDF4F",29,0) + ;"DispOI(IEN101d43) -- display the relevent parts of the 101.43 (ORDERABLE ITEM) +"RTN","TMGNDF4F",30,0) + ;"DispPOI(IEN50d7) -- display the relevent parts of the 50.7 (PHARMACY ORDERABLE ITEM) +"RTN","TMGNDF4F",31,0) + ;"DispOQV(IENS) -- display the relevent parts of the 101.44 (ORDER QUICK VIEW) +"RTN","TMGNDF4F",32,0) + ;"DispRx(IEN50) -- display the relevent parts of the 50 (DRUG) +"RTN","TMGNDF4F",33,0) + ;"DispFDA(IEN) -- display the relevent parts of TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF4F",34,0) + ;"ShowPIa(IEN101d43,RxSet) -- show all links from 101.44 --> 101.43 +"RTN","TMGNDF4F",35,0) + ;"PickOI(IENOQV) -- start from a ORDER QUICK VIEW record, and track backwards +"RTN","TMGNDF4F",36,0) + ;"DispDoses(IEN101d43) -- Display possible dosed for a ORDER QUICK VIEW record +"RTN","TMGNDF4F",37,0) + +"RTN","TMGNDF4F",38,0) + +"RTN","TMGNDF4F",39,0) + +"RTN","TMGNDF4F",40,0) + ;"======================================================================= +"RTN","TMGNDF4F",41,0) +Menu +"RTN","TMGNDF4F",42,0) + ;"Purpose: Menu for exploring 101.44 +"RTN","TMGNDF4F",43,0) + +"RTN","TMGNDF4F",44,0) + new RxSet +"RTN","TMGNDF4F",45,0) + set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto MenuDone +"RTN","TMGNDF4F",46,0) + +"RTN","TMGNDF4F",47,0) + new IENS,IEN101d43,IENOQV,OQVName +"RTN","TMGNDF4F",48,0) + new Menu,UsrSlct,MenuNum +"RTN","TMGNDF4F",49,0) + +"RTN","TMGNDF4F",50,0) +M0 kill Menu +"RTN","TMGNDF4F",51,0) + set Menu(0)="Pick Option to explore ORDER QUICK VIEW (4F)" +"RTN","TMGNDF4F",52,0) + if $get(OQVName)'="" set Menu(0)=Menu(0)_": "_OQVName +"RTN","TMGNDF4F",53,0) + set MenuNum=1 +"RTN","TMGNDF4F",54,0) + if $data(IENOQV)=0 do +"RTN","TMGNDF4F",55,0) + . set Menu(MenuNum)="Pick ORDER QUICK VIEW"_$char(9)_"PickOQV",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",56,0) + else do +"RTN","TMGNDF4F",57,0) + . set Menu(MenuNum)="Pick *NEW* ORDER QUICK VIEW"_$char(9)_"PickOQV",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",58,0) + . set Menu(MenuNum)="Show current ORDER QUICK VIEW"_$char(9)_"ShowOQV",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",59,0) + . set Menu(MenuNum)="Show OQV's linked to ORDERABLE ITEM: "_IENOQV("Linked 101.43","Name")_$char(9)_"ShowLinks",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",60,0) + . set Menu(MenuNum)="Explore linked ORDERABLE ITEM"_$char(9)_"ExploreOI",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",61,0) + . set Menu(MenuNum)="Show Dump of Doses for Current."_$char(9)_"DispOQV",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",62,0) + . set Menu(MenuNum)="Show Chain of Linked Files & Entries."_$char(9)_"ShowChain",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",63,0) + . set Menu(MenuNum)="Fix current ORDER QUICK VIEW"_$char(9)_"FixCurOQV",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",64,0) + set Menu(MenuNum)="Fix Missing ORDER QUICK VIEW."_$char(9)_"FixMissing",MenuNum=MenuNum+1 +"RTN","TMGNDF4F",65,0) + set Menu("M")="Show data map"_$char(9)_"Map" +"RTN","TMGNDF4F",66,0) + set Menu("P")="Prev Stage"_$char(9)_"Prev" +"RTN","TMGNDF4F",67,0) + ;"set Menu("N")="Next Stage"_$char(9)_"Next" +"RTN","TMGNDF4F",68,0) + +"RTN","TMGNDF4F",69,0) + write # +"RTN","TMGNDF4F",70,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",71,0) + +"RTN","TMGNDF4F",72,0) + if UsrSlct="PickOQV" do goto M0 +"RTN","TMGNDF4F",73,0) + . kill OQVIEN +"RTN","TMGNDF4F",74,0) + . do PickOI(.IENOQV) +"RTN","TMGNDF4F",75,0) + . if $data(IENOQV)=0 quit +"RTN","TMGNDF4F",76,0) + . set OQVName=$$GET1^DIQ(101.442,IENOQV("IENS"),2) +"RTN","TMGNDF4F",77,0) + +"RTN","TMGNDF4F",78,0) + if UsrSlct="ShowOI" do DispOI(IENOQV("Linked 101.43")) goto M0 +"RTN","TMGNDF4F",79,0) + if UsrSlct="ShowOQV" do DispOQV(IENOQV("IENS")) goto M0 +"RTN","TMGNDF4F",80,0) + if UsrSlct="ShowLinks" do ShowPIa(IENOQV("Linked 101.43"),IENOQV(0)) goto M0 +"RTN","TMGNDF4F",81,0) + if UsrSlct="ExploreOI" do MenuOI(IENOQV("Linked 101.43")) goto M0 +"RTN","TMGNDF4F",82,0) + if UsrSlct="DispOQV" do DispDoses(IENOQV("Linked 101.43")) goto M0 +"RTN","TMGNDF4F",83,0) + if UsrSlct="ShowChain" do Show1Chain(.IENOQV) goto M0 +"RTN","TMGNDF4F",84,0) + if UsrSlct="FixMissing" do FixOQVMissing^TMGNDF4G goto M0 +"RTN","TMGNDF4F",85,0) + if UsrSlct="FixCurOQV" do FixCurOQV(.IENOQV) goto M0 +"RTN","TMGNDF4F",86,0) + if UsrSlct="Map" do goto M0 +"RTN","TMGNDF4F",87,0) + . write "ORDER QUICK VIEW (101.44) --> ORDERABLE ITEM (101.43)",! +"RTN","TMGNDF4F",88,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",89,0) + if UsrSlct="Prev" goto Menu^TMGNDF4E ;"quit can occur from there... +"RTN","TMGNDF4F",90,0) + ;"if UsrSlct="Next" goto Menu^TMGNDF2H ;"quit can occur from there... +"RTN","TMGNDF4F",91,0) + +"RTN","TMGNDF4F",92,0) + if UsrSlct="^" goto MenuDone +"RTN","TMGNDF4F",93,0) + goto M0 +"RTN","TMGNDF4F",94,0) + +"RTN","TMGNDF4F",95,0) +MenuDone +"RTN","TMGNDF4F",96,0) + quit +"RTN","TMGNDF4F",97,0) + +"RTN","TMGNDF4F",98,0) +MenuOI(IEN101d43) +"RTN","TMGNDF4F",99,0) + ;"Purpose: Menu to explore ORDERABLE ITEM +"RTN","TMGNDF4F",100,0) + +"RTN","TMGNDF4F",101,0) + new OIArray do GetOIInfo^TMGNDFUT(IEN101d43,.OIArray) +"RTN","TMGNDF4F",102,0) + new OIName set OIName=$get(OIArray("IEN 101.43","NAME")) +"RTN","TMGNDF4F",103,0) + if OIName="" goto MBDone +"RTN","TMGNDF4F",104,0) + +"RTN","TMGNDF4F",105,0) + new IEN50d7 set IEN50d7=$get(OIArray("IEN 50.7 from 101.43")) +"RTN","TMGNDF4F",106,0) + new POIName set POIName=$get(OIArray("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDF4F",107,0) + +"RTN","TMGNDF4F",108,0) + new Menu,UsrSlct +"RTN","TMGNDF4F",109,0) + set Menu(0)="Pick Option to explore ORDERABLE ITEM: "_OIName +"RTN","TMGNDF4F",110,0) + set Menu(1)="Show current ORDERABLE ITEM: "_OIName_$char(9)_"ShowOI" +"RTN","TMGNDF4F",111,0) + set Menu(2)="Explore linked PHARMACY ORDERABLE ITEM: "_POIName_$char(9)_"Explore" +"RTN","TMGNDF4F",112,0) + set Menu(3)="Show CPRS function of all avail doses"_$char(9)_"ShowAvail" +"RTN","TMGNDF4F",113,0) + set Menu(5)="Show Dump of Doses for Current."_$char(9)_"DispOI" +"RTN","TMGNDF4F",114,0) + set Menu("M")="Show data map"_$char(9)_"Map" +"RTN","TMGNDF4F",115,0) + +"RTN","TMGNDF4F",116,0) +MB1 write # +"RTN","TMGNDF4F",117,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",118,0) + +"RTN","TMGNDF4F",119,0) + if UsrSlct="ShowOI" do DispOI(IEN101d43) goto MB1 +"RTN","TMGNDF4F",120,0) + if UsrSlct="Explore" do MenuPOI(.OIArray) goto MB1 +"RTN","TMGNDF4F",121,0) + if UsrSlct="ShowAvail" do ShowAvail(IEN101d43) goto MPOI1 +"RTN","TMGNDF4F",122,0) + if UsrSlct="DispOI" do DispDoses(IEN101d43) goto MPOI1 +"RTN","TMGNDF4F",123,0) + +"RTN","TMGNDF4F",124,0) + if UsrSlct="Map" do goto MB1 +"RTN","TMGNDF4F",125,0) + . write "OQV (101.44) --> ORDERABLE ITEM (101.43) --> PHARMACY ORDERABLE ITEM (50.7)",! +"RTN","TMGNDF4F",126,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",127,0) + if UsrSlct="^" goto MBDone +"RTN","TMGNDF4F",128,0) + goto MB1 +"RTN","TMGNDF4F",129,0) + +"RTN","TMGNDF4F",130,0) +MBDone +"RTN","TMGNDF4F",131,0) + quit +"RTN","TMGNDF4F",132,0) + +"RTN","TMGNDF4F",133,0) + +"RTN","TMGNDF4F",134,0) +MenuPOI(Array) +"RTN","TMGNDF4F",135,0) + ;"Purpose: Menu to explore PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4F",136,0) + ;"INPUT: Array -- PASS BY REFERENCE. Format: (as created by GetOIInfo^TMGNDFUT) +"RTN","TMGNDF4F",137,0) + ;" Array("IEN 50.7 from 101.43")=IEN50d7 +"RTN","TMGNDF4F",138,0) + ;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "" if problem +"RTN","TMGNDF4F",139,0) + +"RTN","TMGNDF4F",140,0) + new IEN50d7 set IEN50d7=$get(Array("IEN 50.7 from 101.43")) +"RTN","TMGNDF4F",141,0) + new POIName set POIName=$get(Array("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDF4F",142,0) + if POIName="" set POIName=$$GET1^DIQ(50.7,IEN50d7_",",.01) +"RTN","TMGNDF4F",143,0) + +"RTN","TMGNDF4F",144,0) + new IEN50Array +"RTN","TMGNDF4F",145,0) + do GetDRUGs^TMGNDFUT(IEN50d7,.IEN50Array) +"RTN","TMGNDF4F",146,0) + new Menu,UsrSlct +"RTN","TMGNDF4F",147,0) + set Menu(0)="Pick Option to explore PHARMACY ORDERABLE ITEM: "_POIName +"RTN","TMGNDF4F",148,0) + set Menu(1)="Show current PHARMACY ORDERABLE ITEM: "_POIName_$char(9)_"ShowPOI" +"RTN","TMGNDF4F",149,0) + set Menu(2)="Explore a linked DRUG item"_$char(9)_"Explore" +"RTN","TMGNDF4F",150,0) + set Menu("M")="Show data map"_$char(9)_"Map" +"RTN","TMGNDF4F",151,0) + +"RTN","TMGNDF4F",152,0) +MPOI1 write # +"RTN","TMGNDF4F",153,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",154,0) + +"RTN","TMGNDF4F",155,0) + if UsrSlct="ShowPOI" do DispPOI(IEN50d7) goto MPOI1 +"RTN","TMGNDF4F",156,0) + if UsrSlct="Explore" do goto MB1 +"RTN","TMGNDF4F",157,0) + . new IEN50 +"RTN","TMGNDF4F",158,0) + . do MenuPickRx(.IEN50Array,.IEN50) +"RTN","TMGNDF4F",159,0) + . if $data(IEN50)=0 quit +"RTN","TMGNDF4F",160,0) + . do MenuDrug(.IEN50) +"RTN","TMGNDF4F",161,0) + if UsrSlct="Map" do goto MB1 +"RTN","TMGNDF4F",162,0) + . write "ORDERABLE ITEM (101.43) --> PHARMACY ORDERABLE ITEM (50.7) --> DRUG (50)",! +"RTN","TMGNDF4F",163,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",164,0) + +"RTN","TMGNDF4F",165,0) + if UsrSlct="^" goto MPOIDone +"RTN","TMGNDF4F",166,0) + goto MB1 +"RTN","TMGNDF4F",167,0) + +"RTN","TMGNDF4F",168,0) +MPOIDone +"RTN","TMGNDF4F",169,0) + quit +"RTN","TMGNDF4F",170,0) + +"RTN","TMGNDF4F",171,0) + +"RTN","TMGNDF4F",172,0) +MenuPickRx(IEN50Array,IEN50) +"RTN","TMGNDF4F",173,0) + ;"Purpose: To allow user to pick which linked DRUG entry to explore +"RTN","TMGNDF4F",174,0) + ;"Input: IEN50Array -- PASS BY REFERENCE, Format: +"RTN","TMGNDF4F",175,0) + ;" IEN50Array(IEN50)=Name (.01 field) of record +"RTN","TMGNDF4F",176,0) + ;" IEN50Array(IEN50)=Name (.01 field) of record +"RTN","TMGNDF4F",177,0) + +"RTN","TMGNDF4F",178,0) + ;" IEN50 -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4F",179,0) + ;" IEN50=IEN in 50 +"RTN","TMGNDF4F",180,0) + ;" IEN50("NAME")=Name of 50 -- OPTIONAL +"RTN","TMGNDF4F",181,0) + ;"Results: None +"RTN","TMGNDF4F",182,0) + +"RTN","TMGNDF4F",183,0) + new Menu,UsrSlct +"RTN","TMGNDF4F",184,0) + kill IEN50 +"RTN","TMGNDF4F",185,0) + set Menu(0)="Pick DRUG" +"RTN","TMGNDF4F",186,0) + new count set count=1 +"RTN","TMGNDF4F",187,0) + new name set name="" +"RTN","TMGNDF4F",188,0) + for set name=$order(IEN50Array(name)) quit:(name="") do +"RTN","TMGNDF4F",189,0) + . new IEN set IEN="" +"RTN","TMGNDF4F",190,0) + . for set IEN=$order(IEN50Array(name,IEN)) quit:(IEN="") do +"RTN","TMGNDF4F",191,0) + . . set Menu(count)=$get(name)_" #"_IEN_$char(9)_IEN +"RTN","TMGNDF4F",192,0) + . . set count=count+1 +"RTN","TMGNDF4F",193,0) + +"RTN","TMGNDF4F",194,0) +MPR1 set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",195,0) + +"RTN","TMGNDF4F",196,0) + if +UsrSlct=UsrSlct do goto MPRDone +"RTN","TMGNDF4F",197,0) + . set IEN50=+UsrSlct +"RTN","TMGNDF4F",198,0) + . set IEN50("NAME")=$get(IEN50Array(IEN50)) +"RTN","TMGNDF4F",199,0) + +"RTN","TMGNDF4F",200,0) + if UsrSlct="^" goto MPRDone +"RTN","TMGNDF4F",201,0) + goto MPR1 +"RTN","TMGNDF4F",202,0) + +"RTN","TMGNDF4F",203,0) +MPRDone +"RTN","TMGNDF4F",204,0) + quit +"RTN","TMGNDF4F",205,0) + +"RTN","TMGNDF4F",206,0) + +"RTN","TMGNDF4F",207,0) +MenuDrug(IEN50) +"RTN","TMGNDF4F",208,0) + ;"Purpose: Menu to explore DRUG item. +"RTN","TMGNDF4F",209,0) + ;"INPUT: IEN50 -- PASS BY REFERENCE. Format: +"RTN","TMGNDF4F",210,0) + ;" IEN50=IEN in 50 +"RTN","TMGNDF4F",211,0) + ;" IEN50("NAME")=Name of 50 -- OPTIONAL +"RTN","TMGNDF4F",212,0) + +"RTN","TMGNDF4F",213,0) + set IEN50("NAME")=$get(IEN50("NAME")) +"RTN","TMGNDF4F",214,0) + if IEN50("NAME")="" set IEN50("NAME")=$$GET1^DIQ(50,IEN50_",",.01) +"RTN","TMGNDF4F",215,0) + +"RTN","TMGNDF4F",216,0) + new FDA do GetFDA^TMGNDFUT(IEN50,.FDA) +"RTN","TMGNDF4F",217,0) + +"RTN","TMGNDF4F",218,0) + new Menu,UsrSlct +"RTN","TMGNDF4F",219,0) + set Menu(0)="Pick Option to explore DRUG: "_IEN50("NAME") +"RTN","TMGNDF4F",220,0) + set Menu(1)="Show current DRUG item: "_IEN50("NAME")_$char(9)_"ShowDRUG" +"RTN","TMGNDF4F",221,0) + set Menu(2)="Edit current DRUG item: "_IEN50("NAME")_$char(9)_"EditDRUG" +"RTN","TMGNDF4F",222,0) + set Menu(3)="Browse current DRUG item: "_IEN50("NAME")_$char(9)_"Browse" +"RTN","TMGNDF4F",223,0) + set Menu(4)="Explore linked FDA IMPORT: "_FDA("NAME")_$char(9)_"Explore1" +"RTN","TMGNDF4F",224,0) + set Menu("M")="Show data map"_$char(9)_"Map" +"RTN","TMGNDF4F",225,0) + ;"set Menu(2)="Explore linked PHARMACY ORDERABLE ITEM: "_POI("NAME")_$char(9)_"Explore" +"RTN","TMGNDF4F",226,0) + +"RTN","TMGNDF4F",227,0) +MRx1 write # +"RTN","TMGNDF4F",228,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",229,0) + +"RTN","TMGNDF4F",230,0) + if UsrSlct="ShowDRUG" do DispRx(IEN50) goto MRx1 +"RTN","TMGNDF4F",231,0) + if UsrSlct="EditDRUG" do Edit50^TMGNDFUT(IEN50) goto MRx1 +"RTN","TMGNDF4F",232,0) + if UsrSlct="Explore1" do MenuFDA(.FDA) goto MRx1 +"RTN","TMGNDF4F",233,0) + if UsrSlct="Browse" do Browse^TMGBROWS(50,IEN50,0) goto MRx1 +"RTN","TMGNDF4F",234,0) + if UsrSlct="Map" do goto MRx1 +"RTN","TMGNDF4F",235,0) + . write "POI (50.7) --> DRUG (50) --> VA PRODUCT (50.68)",! +"RTN","TMGNDF4F",236,0) + . write " --> TMG FDA IMPORT COMPILED (22706.9)",! +"RTN","TMGNDF4F",237,0) + . write " --> NATIONAL DRUG FILE ENTRY (50.6)",! +"RTN","TMGNDF4F",238,0) + . write " --> TMG FDA IMPORT COMPILED (22706.9)",! +"RTN","TMGNDF4F",239,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",240,0) + if UsrSlct="^" goto MRxDone +"RTN","TMGNDF4F",241,0) + goto MB1 +"RTN","TMGNDF4F",242,0) + +"RTN","TMGNDF4F",243,0) +MRxDone +"RTN","TMGNDF4F",244,0) + quit +"RTN","TMGNDF4F",245,0) + +"RTN","TMGNDF4F",246,0) + +"RTN","TMGNDF4F",247,0) +MenuFDA(FDA) +"RTN","TMGNDF4F",248,0) + ;"Purpose: Menu to explore TMG FDA IMPORT COMPILED +"RTN","TMGNDF4F",249,0) + ;"INPUT: FDA -- PASS BY REFERENCE. Format: +"RTN","TMGNDF4F",250,0) + ;" FDA=IEN in 22706.9 +"RTN","TMGNDF4F",251,0) + ;" FDA("NAME")=Name of 22706.9 +"RTN","TMGNDF4F",252,0) + +"RTN","TMGNDF4F",253,0) + new Menu,UsrSlct +"RTN","TMGNDF4F",254,0) + set Menu(0)="Pick Option to explore TMG FDA IMPORT COMPILED item." +"RTN","TMGNDF4F",255,0) + set Menu(1)="Show current FDA IMPORT item: "_FDA("NAME")_$char(9)_"ShowFDA" +"RTN","TMGNDF4F",256,0) + set Menu(2)="Browse current FDA IMPORT item: "_FDA("NAME")_$char(9)_"Browse" +"RTN","TMGNDF4F",257,0) + set Menu(3)="Explore a linked DRUG item"_$char(9)_"Explore" +"RTN","TMGNDF4F",258,0) + set Menu("M")="Show data map"_$char(9)_"Map" +"RTN","TMGNDF4F",259,0) + +"RTN","TMGNDF4F",260,0) +MF1 write # +"RTN","TMGNDF4F",261,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",262,0) + +"RTN","TMGNDF4F",263,0) + if UsrSlct="ShowFDA" do DispFDA(FDA) goto MF1 +"RTN","TMGNDF4F",264,0) + if UsrSlct="Browse" do Browse^TMGBROWS(22706.9,FDA,0) goto MF1 +"RTN","TMGNDF4F",265,0) + if UsrSlct="Map" do goto MF1 +"RTN","TMGNDF4F",266,0) + . write "DRUG (50) --> TMG FDA IMPORT COMPILED (22706.9)",! +"RTN","TMGNDF4F",267,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",268,0) + +"RTN","TMGNDF4F",269,0) + if UsrSlct="^" goto MFDone +"RTN","TMGNDF4F",270,0) + goto MB1 +"RTN","TMGNDF4F",271,0) + +"RTN","TMGNDF4F",272,0) +MFDone +"RTN","TMGNDF4F",273,0) + quit +"RTN","TMGNDF4F",274,0) + +"RTN","TMGNDF4F",275,0) +Show1Chain(IENOQV) +"RTN","TMGNDF4F",276,0) + ;"Purpose: To show entire chain, as far back as possible +"RTN","TMGNDF4F",277,0) + ;"Input: IENOQV -- PASS BY REFERENCE +"RTN","TMGNDF4F",278,0) + ;" IENOQV(0)=RxSet, i.e. the IEN in 101.44 containing ORWDSET O RX +"RTN","TMGNDF4F",279,0) + ;" IENOQV=IEN IN 101.442 +"RTN","TMGNDF4F",280,0) + ;" IENOQV("IENS")=IENS +"RTN","TMGNDF4F",281,0) + ;" IENOQV("Name")=Name of ORDER QUICK VIEW +"RTN","TMGNDF4F",282,0) + ;" IENOQV("Linked 101.43")=IEN of linked 101.43 +"RTN","TMGNDF4F",283,0) + ;" IENOQV("Linked 101.43","Name")=name +"RTN","TMGNDF4F",284,0) + +"RTN","TMGNDF4F",285,0) + ;"results: none. +"RTN","TMGNDF4F",286,0) + +"RTN","TMGNDF4F",287,0) + new IEN50Array,IEN101d43,indent,OIArray,POIName +"RTN","TMGNDF4F",288,0) + set indent=2 +"RTN","TMGNDF4F",289,0) + write "ORDER QUICK VIEW(101.44): ",IENOQV("Name")," #",IENOQV("IENS"),! +"RTN","TMGNDF4F",290,0) + set IEN101d43=IENOQV("Linked 101.43") +"RTN","TMGNDF4F",291,0) + write ?indent,"ORDERABLE ITEM(101.43): ",IENOQV("Linked 101.43","Name")," #",IEN101d43,! +"RTN","TMGNDF4F",292,0) + set indent=indent+5 +"RTN","TMGNDF4F",293,0) + do GetOIInfo^TMGNDFUT(IEN101d43,.OIArray) +"RTN","TMGNDF4F",294,0) + set IEN50d7=$get(OIArray("IEN 50.7 from 101.43")) +"RTN","TMGNDF4F",295,0) + set POIName=$get(OIArray("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDF4F",296,0) + write ?indent,"PHARMACY ORDERABLE ITEM(50.7): ",POIName," #",IEN50d7,! +"RTN","TMGNDF4F",297,0) + set indent=indent+5 +"RTN","TMGNDF4F",298,0) + do GetDRUGs^TMGNDFUT(IEN50d7,.IEN50Array) +"RTN","TMGNDF4F",299,0) + new IEN50,Name50 set IEN50="",Name50="" +"RTN","TMGNDF4F",300,0) + for set Name50=$order(IEN50Array(Name50)) quit:(Name50="") do +"RTN","TMGNDF4F",301,0) + . set IEN50=$order(IEN50Array(Name50,"")) +"RTN","TMGNDF4F",302,0) + . write ?indent,"DRUG(50): ",Name50," #",IEN50,! +"RTN","TMGNDF4F",303,0) + . new TMGIEN set TMGIEN="" +"RTN","TMGNDF4F",304,0) + . for set TMGIEN=$order(^TMG(22706.9,"DRUG",IEN50,TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDF4F",305,0) + . . new TMGname set TMGname=$$GET1^DIQ(22706.9,TMGIEN_",",.04) +"RTN","TMGNDF4F",306,0) + . . if TMGname'="" write ?(indent+5),"TMG(22706.9): ",TMGname," #",TMGIEN,! +"RTN","TMGNDF4F",307,0) + . set TMGIEN="" +"RTN","TMGNDF4F",308,0) + . for set TMGIEN=$order(^TMG(22706.9,"DRUGT",IEN50,TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDF4F",309,0) + . . new TMGname set TMGname=$$GET1^DIQ(22706.9,TMGIEN_",",.04) +"RTN","TMGNDF4F",310,0) + . . if TMGname'="" write ?(indent+5),"TMG(212706.9): ",TMGname," #",TMGIEN,! +"RTN","TMGNDF4F",311,0) + +"RTN","TMGNDF4F",312,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",313,0) + +"RTN","TMGNDF4F",314,0) + quit +"RTN","TMGNDF4F",315,0) + +"RTN","TMGNDF4F",316,0) + +"RTN","TMGNDF4F",317,0) +FixCurOQV(IENOQV) +"RTN","TMGNDF4F",318,0) + ;"Purpose: To Fix the current OQV +"RTN","TMGNDF4F",319,0) + ;"Input: IENOQV -- PASS BY REFERENCE +"RTN","TMGNDF4F",320,0) + ;" IENOQV(0)=RxSet, i.e. the IEN in 101.44 containing ORWDSET O RX +"RTN","TMGNDF4F",321,0) + ;" IENOQV=IEN IN 101.442 +"RTN","TMGNDF4F",322,0) + ;" IENOQV("IENS")=IENS +"RTN","TMGNDF4F",323,0) + ;" IENOQV("Name")=Name of ORDER QUICK VIEW +"RTN","TMGNDF4F",324,0) + ;" IENOQV("Linked 101.43")=IEN of linked 101.43 +"RTN","TMGNDF4F",325,0) + ;" IENOQV("Linked 101.43","Name")=name +"RTN","TMGNDF4F",326,0) + +"RTN","TMGNDF4F",327,0) + ;"results: none. +"RTN","TMGNDF4F",328,0) + +"RTN","TMGNDF4F",329,0) + new IEN50d7,IEN50Array,IEN101d43,chainA +"RTN","TMGNDF4F",330,0) + set IEN101d43=IENOQV("Linked 101.43") +"RTN","TMGNDF4F",331,0) + ;"set IEN50d7=$$GetPOI^TMGNDFUT(IEN101d43) <-- not working for some reason +"RTN","TMGNDF4F",332,0) + new OIArray +"RTN","TMGNDF4F",333,0) + do GetOIInfo^TMGNDFUT(IEN101d43,.OIArray) +"RTN","TMGNDF4F",334,0) + set IEN50d7=$get(OIArray("IEN 50.7 from 101.43")) +"RTN","TMGNDF4F",335,0) + new POIName set POIName=$get(OIArray("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDF4F",336,0) + do GetDRUGs^TMGNDFUT(IEN50d7,.IEN50Array) +"RTN","TMGNDF4F",337,0) + new IEN50,Name50 set IEN50="",Name50="" +"RTN","TMGNDF4F",338,0) + for set Name50=$order(IEN50Array(Name50)) quit:(Name50="") do +"RTN","TMGNDF4F",339,0) + . set IEN50=$order(IEN50Array(Name50,"")) +"RTN","TMGNDF4F",340,0) + . new TMGIEN set TMGIEN="" +"RTN","TMGNDF4F",341,0) + . for set TMGIEN=$order(^TMG(22706.9,"DRUG",IEN50,TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDF4F",342,0) + . . new TMGname set TMGname=$$GET1^DIQ(22706.9,TMGIEN_",",.04) +"RTN","TMGNDF4F",343,0) + . . set chainA(TMGname,TMGIEN_"^22706.9")="" +"RTN","TMGNDF4F",344,0) + . set TMGIEN="" +"RTN","TMGNDF4F",345,0) + . for set TMGIEN=$order(^TMG(22706.9,"DRUGT",IEN50,TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDF4F",346,0) + . . new TMGname set TMGname=$$GET1^DIQ(22706.9,TMGIEN_",",.04) +"RTN","TMGNDF4F",347,0) + . . set chainA(TMGname,TMGIEN_"^22706.9")="" +"RTN","TMGNDF4F",348,0) + +"RTN","TMGNDF4F",349,0) + if $data(chainA) do +"RTN","TMGNDF4F",350,0) + . do HandleChain^TMGNDF4G(.chainA) +"RTN","TMGNDF4F",351,0) + else do +"RTN","TMGNDF4F",352,0) + . write "Sorry, unable to locate sources in file 22706.9",! +"RTN","TMGNDF4F",353,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",354,0) + +"RTN","TMGNDF4F",355,0) + quit +"RTN","TMGNDF4F",356,0) + +"RTN","TMGNDF4F",357,0) +ShowAvail(IEN101d43) +"RTN","TMGNDF4F",358,0) + ;"Purpose: to Show available drugs for a given ORDERABLE ITEM (101.43), +"RTN","TMGNDF4F",359,0) + ;" As determined by RPC code used by CPRS +"RTN","TMGNDF4F",360,0) + ;"Input: IEN101d43 -- IEN in 101.43 +"RTN","TMGNDF4F",361,0) + ;"results: none. +"RTN","TMGNDF4F",362,0) + +"RTN","TMGNDF4F",363,0) + new i,DrugIEN +"RTN","TMGNDF4F",364,0) + new IEN,Y,DIC,drugsArray,sigArray +"RTN","TMGNDF4F",365,0) + +"RTN","TMGNDF4F",366,0) + kill drugsArray,sigArray +"RTN","TMGNDF4F",367,0) + do GetAvail(IEN101d43,.drugsArray,.sigArray) +"RTN","TMGNDF4F",368,0) + if $data(drugsArray)=0 do goto SAvDone +"RTN","TMGNDF4F",369,0) + . write "No Drugs to show!",! +"RTN","TMGNDF4F",370,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",371,0) + +"RTN","TMGNDF4F",372,0) + ;"write "Here are entries in DRUG file:",! +"RTN","TMGNDF4F",373,0) + ;"write "-------------------------------",! +"RTN","TMGNDF4F",374,0) + ;"new IEN set IEN="" +"RTN","TMGNDF4F",375,0) + ;"for set IEN=$order(drugsArray(IEN)) quit:(IEN="") do +"RTN","TMGNDF4F",376,0) + ;". write " #",IEN," in File #50: ",drugsArray(IEN),! +"RTN","TMGNDF4F",377,0) + ;"do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",378,0) + +"RTN","TMGNDF4F",379,0) + write "Here are the different sigs:",! +"RTN","TMGNDF4F",380,0) + write "-------------------------------",! +"RTN","TMGNDF4F",381,0) + new netDose set netDose="" +"RTN","TMGNDF4F",382,0) + for set netDose=$order(sigArray(netDose)) quit:(netDose="") do +"RTN","TMGNDF4F",383,0) + . ;"write "Net Dose: ",netDose,! +"RTN","TMGNDF4F",384,0) + . new IEN set IEN="" +"RTN","TMGNDF4F",385,0) + . for set IEN=$order(sigArray(netDose,IEN)) quit:(IEN="") do +"RTN","TMGNDF4F",386,0) + . . new name set name="" +"RTN","TMGNDF4F",387,0) + . . for set name=$order(sigArray(netDose,IEN,name)) quit:(name="") do +"RTN","TMGNDF4F",388,0) + . . . ;"write " #",IEN,": ",name,! +"RTN","TMGNDF4F",389,0) + . . . new sig set sig="" +"RTN","TMGNDF4F",390,0) + . . . for set sig=$order(sigArray(netDose,IEN,name,sig)) quit:(sig="") do +"RTN","TMGNDF4F",391,0) + . . . . new mult set mult=$get(sigArray(netDose,IEN,name,sig)) +"RTN","TMGNDF4F",392,0) + . . . . write " ",sig,?30,"#",IEN,": ",name," --",mult,! +"RTN","TMGNDF4F",393,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",394,0) +SAvDone +"RTN","TMGNDF4F",395,0) + quit +"RTN","TMGNDF4F",396,0) + +"RTN","TMGNDF4F",397,0) + +"RTN","TMGNDF4F",398,0) +GetAvail(IEN101d43,Array,sigArray) +"RTN","TMGNDF4F",399,0) + ;"Purpose: To explore the available doses for a given ORDERABLE ITEM (101.43) +"RTN","TMGNDF4F",400,0) + ;"Input: IEN -- the record number for ORDERABLE ITEM (101.43) +"RTN","TMGNDF4F",401,0) + ;" Array -- pass by REFERENCE, an OUT PARAMETER +"RTN","TMGNDF4F",402,0) + ;" sigArray -- pass by REFERENCE, an OUT PARAMETER +"RTN","TMGNDF4F",403,0) + ;"Output: Array format: +"RTN","TMGNDF4F",404,0) + ;" Array(IEN in 50)=DrugName +"RTN","TMGNDF4F",405,0) + ;" Array(IEN in 50)=DrugName +"RTN","TMGNDF4F",406,0) + ;" sigArray format: +"RTN","TMGNDF4F",407,0) + ;" sigArray(NetDose,IEN in 50,DrugName,sig)=multiplier +"RTN","TMGNDF4F",408,0) + ;"Result: None +"RTN","TMGNDF4F",409,0) + +"RTN","TMGNDF4F",410,0) + new temp,IENs,IENs2 +"RTN","TMGNDF4F",411,0) + do OISLCT^ORWDPS2(.temp,IEN101d43,0,1,"Y","Y") +"RTN","TMGNDF4F",412,0) + new i set i="" +"RTN","TMGNDF4F",413,0) + for set i=$order(temp(i)) quit:(i="")!($get(temp(i))="~Dispense") +"RTN","TMGNDF4F",414,0) + if i'="" for set i=$order(temp(i)) quit:(i="")!($extract($get(temp(i)),1)="~") do +"RTN","TMGNDF4F",415,0) + . new s set s=$piece($get(temp(i)),"^",1) +"RTN","TMGNDF4F",416,0) + . new IEN set IEN=+$extract(s,2,999) +"RTN","TMGNDF4F",417,0) + . set Array(IEN)=$piece($get(temp(i)),"^",4) +"RTN","TMGNDF4F",418,0) + +"RTN","TMGNDF4F",419,0) + set i="" +"RTN","TMGNDF4F",420,0) + for set i=$order(temp(i)) quit:(i="")!($get(temp(i))="~Dosage") +"RTN","TMGNDF4F",421,0) + if i'="" for set i=$order(temp(i)) quit:(i="")!($extract($get(temp(i)),1)="~") do +"RTN","TMGNDF4F",422,0) + . new s set s=$piece($get(temp(i)),"^",4) +"RTN","TMGNDF4F",423,0) + . new IEN set IEN=+$piece(s,"&",6) +"RTN","TMGNDF4F",424,0) + . new netDose set netDose=+$piece(s,"&",5) +"RTN","TMGNDF4F",425,0) + . new drug set drug=$extract($piece($get(temp(i)),"^",1),2,999) +"RTN","TMGNDF4F",426,0) + . new sig set sig=$piece($get(temp(i)),"^",5) +"RTN","TMGNDF4F",427,0) + . new mult set mult=$piece(s,"&",3) +"RTN","TMGNDF4F",428,0) + . set sigArray(netDose,IEN,drug,sig)=mult +"RTN","TMGNDF4F",429,0) + +"RTN","TMGNDF4F",430,0) + quit +"RTN","TMGNDF4F",431,0) + +"RTN","TMGNDF4F",432,0) + +"RTN","TMGNDF4F",433,0) +AskOQV(NameOut) +"RTN","TMGNDF4F",434,0) + ;"Purpose: To ask the user for a ORDER QUICK VIEW drug to view. +"RTN","TMGNDF4F",435,0) + ;" Note: this is actually a query in the subfile #101.442 +"RTN","TMGNDF4F",436,0) + ;"Input: NameOut -- PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGNDF4F",437,0) + ;" returns the name of the ORDER QUICK VIEW selected +"RTN","TMGNDF4F",438,0) + ;"Result: an IENS that can be used to get record, or "" if unsuccessful +"RTN","TMGNDF4F",439,0) + ;" e.g. set Value=$$GET1^DIQ(101.442,IENS,.01) +"RTN","TMGNDF4F",440,0) + +"RTN","TMGNDF4F",441,0) + new DIC,X,Y,RxSet,DA +"RTN","TMGNDF4F",442,0) + new result set result="" +"RTN","TMGNDF4F",443,0) + set NameOut="" +"RTN","TMGNDF4F",444,0) + +"RTN","TMGNDF4F",445,0) + set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto AOQVDone +"RTN","TMGNDF4F",446,0) + +"RTN","TMGNDF4F",447,0) + if $data(^ORD(101.44,RxSet,20,"B"))=0 do +"RTN","TMGNDF4F",448,0) + . ;"Put code here to reindex "B" index (.01 field of field 20) +"RTN","TMGNDF4F",449,0) + +"RTN","TMGNDF4F",450,0) + new RxName,TMGDATA,TMGERR +"RTN","TMGNDF4F",451,0) + read "DRUG NAME (May be partial name): ",RxName:$get(DTIME,3600),! +"RTN","TMGNDF4F",452,0) + +"RTN","TMGNDF4F",453,0) + do FIND^DIC(101.442,","_RxSet_",","","M",RxName,"*","B","","","TMGDATA","TMGERR") +"RTN","TMGNDF4F",454,0) + if +$get(TMGDATA("DILIST",0))>0 do +"RTN","TMGNDF4F",455,0) +AOQV1 . new found,j,IEN,IEN101d43,Menu,Num,Link,UsrSlct +"RTN","TMGNDF4F",456,0) + . set Menu(0)="Pick Drug",Num=1 +"RTN","TMGNDF4F",457,0) + . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do +"RTN","TMGNDF4F",458,0) + . . set IEN=$get(TMGDATA("DILIST",2,j)) +"RTN","TMGNDF4F",459,0) + . . set IEN101d43=$get(TMGDATA("DILIST",1,j)) +"RTN","TMGNDF4F",460,0) + . . if $data(found(IEN101d43))>0 quit +"RTN","TMGNDF4F",461,0) + . . set found(IEN101d43)=1 +"RTN","TMGNDF4F",462,0) + . . set Menu(Num)=$$GET1^DIQ(101.442,IEN_","_RxSet_",",".01")_" --> "_$$GET1^DIQ(101.43,IEN101d43_",",".01")_" #"_IEN101d43 +"RTN","TMGNDF4F",463,0) + . . set Link(Num)=IEN +"RTN","TMGNDF4F",464,0) + . . set Num=Num+1 +"RTN","TMGNDF4F",465,0) + . if Num>2 do +"RTN","TMGNDF4F",466,0) + . . set Menu(Num)="Compare Drugs and Sigs above."_$char(9)_"COMPARE" +"RTN","TMGNDF4F",467,0) + . write # +"RTN","TMGNDF4F",468,0) + . set UsrSlct=$$Menu^TMGUSRIF(.Menu,"^") +"RTN","TMGNDF4F",469,0) + . if UsrSlct="COMPARE" do goto AOQV1 +"RTN","TMGNDF4F",470,0) + . . do ShowComp(.found) +"RTN","TMGNDF4F",471,0) + . set result=$get(Link(UsrSlct),-1) +"RTN","TMGNDF4F",472,0) + . if result>0 set result=result_","_RxSet_"," +"RTN","TMGNDF4F",473,0) + else do goto:(Y'>-1) AOQVDone +"RTN","TMGNDF4F",474,0) + . set DA(1)=RxSet +"RTN","TMGNDF4F",475,0) + . set DIC(0)="MAEQ" +"RTN","TMGNDF4F",476,0) + . set DIC("A")="Please enter drug name again: ^//" +"RTN","TMGNDF4F",477,0) + . set DIC="^ORD(101.44,"_DA(1)_",20," +"RTN","TMGNDF4F",478,0) + . do ^DIC write ! +"RTN","TMGNDF4F",479,0) + . if Y'>-1 quit +"RTN","TMGNDF4F",480,0) + . set result=+Y_","_DA(1)_"," +"RTN","TMGNDF4F",481,0) + +"RTN","TMGNDF4F",482,0) +AOQVDone +"RTN","TMGNDF4F",483,0) + if result'="" set NameOut=$$GET1^DIQ(101.442,result,.01) +"RTN","TMGNDF4F",484,0) + quit result +"RTN","TMGNDF4F",485,0) + +"RTN","TMGNDF4F",486,0) +ShowComp(array) +"RTN","TMGNDF4F",487,0) + ;"Purpose: to display all the drugs and sigs for a set of IEN's in 101.43 +"RTN","TMGNDF4F",488,0) + ;"Input: array: PASS BY REFERENCE. Format: +"RTN","TMGNDF4F",489,0) + ;" array(IEN)="" +"RTN","TMGNDF4F",490,0) + ;" array(IEN)="" +"RTN","TMGNDF4F",491,0) + ;" array(IEN)="" +"RTN","TMGNDF4F",492,0) + ;"Output: Will dump out data for all IEN's in list +"RTN","TMGNDF4F",493,0) + +"RTN","TMGNDF4F",494,0) + new IEN101d43 +"RTN","TMGNDF4F",495,0) + set IEN101d43="" for set IEN101d43=$order(array(IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDF4F",496,0) + . do ShowAvail(IEN101d43) +"RTN","TMGNDF4F",497,0) + quit +"RTN","TMGNDF4F",498,0) + +"RTN","TMGNDF4F",499,0) + +"RTN","TMGNDF4F",500,0) +DispOI(IEN101d43) +"RTN","TMGNDF4F",501,0) + ;"Purpose: To display the relevent parts of the 101.43 (ORDERABLE ITEM) +"RTN","TMGNDF4F",502,0) + ;" to allow debug tracing. +"RTN","TMGNDF4F",503,0) + ;"Input: IEN101d43 -- the IEN in file 101.43 +"RTN","TMGNDF4F",504,0) + ;"Results: none +"RTN","TMGNDF4F",505,0) + +"RTN","TMGNDF4F",506,0) + new Fields +"RTN","TMGNDF4F",507,0) + set Fields(.01)="" ;".01 NAME +"RTN","TMGNDF4F",508,0) + set Fields(.1)="" ;"1 INACTIVATED +"RTN","TMGNDF4F",509,0) + set Fields(1)="" ;"1 SYNONYMS +"RTN","TMGNDF4F",510,0) + set Fields(1.1)="" ;"1.1 PACKAGE NAME +"RTN","TMGNDF4F",511,0) + set Fields(2)="" ;"2 ID +"RTN","TMGNDF4F",512,0) + +"RTN","TMGNDF4F",513,0) + write "File: ORDERABLE ITEM (101.43) " +"RTN","TMGNDF4F",514,0) + do DumpRec2^TMGDEBUG(101.43,IEN101d43,1,.Fields) +"RTN","TMGNDF4F",515,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",516,0) + +"RTN","TMGNDF4F",517,0) + quit +"RTN","TMGNDF4F",518,0) + +"RTN","TMGNDF4F",519,0) + +"RTN","TMGNDF4F",520,0) +DispPOI(IEN50d7) +"RTN","TMGNDF4F",521,0) + ;"Purpose: To display the relevent parts of the 50.7 (PHARMACY ORDERABLE ITEM) +"RTN","TMGNDF4F",522,0) + ;" to allow debug tracing. +"RTN","TMGNDF4F",523,0) + ;"Input: IEN50d7 -- the IEN in file 50d7 +"RTN","TMGNDF4F",524,0) + ;"Results: none +"RTN","TMGNDF4F",525,0) + +"RTN","TMGNDF4F",526,0) + write "File: PHARMACY ORDERABLE ITEM (50.7) " +"RTN","TMGNDF4F",527,0) + do DumpRec2^TMGDEBUG(50.7,IEN50d7,1) +"RTN","TMGNDF4F",528,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",529,0) + +"RTN","TMGNDF4F",530,0) + quit +"RTN","TMGNDF4F",531,0) + +"RTN","TMGNDF4F",532,0) + +"RTN","TMGNDF4F",533,0) +DispOQV(IENS) +"RTN","TMGNDF4F",534,0) + ;"Purpose: To display the relevent parts of the 101.44 (ORDER QUICK VIEW) +"RTN","TMGNDF4F",535,0) + ;" to allow debug tracing. +"RTN","TMGNDF4F",536,0) + ;"Input: IENS -- the IENS to display 101.442, e.g. "1000,23" +"RTN","TMGNDF4F",537,0) + ;"Results: none +"RTN","TMGNDF4F",538,0) + +"RTN","TMGNDF4F",539,0) + write "File: in ORDER QUICK VIEW (101.442) " +"RTN","TMGNDF4F",540,0) + do DumpRec2^TMGDEBUG(101.442,IENS,1,) +"RTN","TMGNDF4F",541,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",542,0) + +"RTN","TMGNDF4F",543,0) + quit +"RTN","TMGNDF4F",544,0) + +"RTN","TMGNDF4F",545,0) +DispRx(IEN50) +"RTN","TMGNDF4F",546,0) + ;"Purpose: To display the relevent parts of the 50 (DRUG) +"RTN","TMGNDF4F",547,0) + ;" to allow debug tracing. +"RTN","TMGNDF4F",548,0) + ;"Input: IEN50 -- the IEN to display in 50 +"RTN","TMGNDF4F",549,0) + ;"Results: none +"RTN","TMGNDF4F",550,0) + +"RTN","TMGNDF4F",551,0) + write "File: in DRUG (50) " +"RTN","TMGNDF4F",552,0) + do DumpRec2^TMGDEBUG(50,IEN50_",",0) +"RTN","TMGNDF4F",553,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",554,0) + +"RTN","TMGNDF4F",555,0) + quit +"RTN","TMGNDF4F",556,0) + +"RTN","TMGNDF4F",557,0) + +"RTN","TMGNDF4F",558,0) +DispFDA(IEN) +"RTN","TMGNDF4F",559,0) + ;"Purpose: To display the relevent parts of TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF4F",560,0) + ;" to allow debug tracing. +"RTN","TMGNDF4F",561,0) + ;"Input: IEN -- the IEN to display in 22706.9 +"RTN","TMGNDF4F",562,0) + ;"Results: none +"RTN","TMGNDF4F",563,0) + +"RTN","TMGNDF4F",564,0) + write "File: in TMG FDA IMPORT COMPILED (22706.9) " +"RTN","TMGNDF4F",565,0) + do DumpRec2^TMGDEBUG(22706.9,IEN_",",0) +"RTN","TMGNDF4F",566,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",567,0) + +"RTN","TMGNDF4F",568,0) + quit +"RTN","TMGNDF4F",569,0) + +"RTN","TMGNDF4F",570,0) + +"RTN","TMGNDF4F",571,0) +ShowPIa(IEN101d43,RxSet) +"RTN","TMGNDF4F",572,0) + ;"Purpose: To show all links from 101.44 --> 101.43 +"RTN","TMGNDF4F",573,0) + ;"Input: IEN101d43 -- the IEN from 101d43 +"RTN","TMGNDF4F",574,0) + ;" RxSet -the IEN in 101.44 containing ORWDSET O RX +"RTN","TMGNDF4F",575,0) + ;"Results: none +"RTN","TMGNDF4F",576,0) + +"RTN","TMGNDF4F",577,0) + new OQVIndex +"RTN","TMGNDF4F",578,0) + do Index101d44^TMGNDFUT(RxSet,"OQVIndex") +"RTN","TMGNDF4F",579,0) + +"RTN","TMGNDF4F",580,0) + new IENOQV set IENOQV="" +"RTN","TMGNDF4F",581,0) + new someShown set someShown=0 +"RTN","TMGNDF4F",582,0) + new pauseCount set pauseCount=0 +"RTN","TMGNDF4F",583,0) + write "Here are all the entries in ORDER QUICK VIEW that point to",! +"RTN","TMGNDF4F",584,0) + write "ORDERABLE ITEM: ",$$GET1^DIQ(101.43,IEN101d43_",",.01),! +"RTN","TMGNDF4F",585,0) + write " <--- (IEN in ORDER QUICK VIEW) NAME",! +"RTN","TMGNDF4F",586,0) + for set IENOQV=$order(OQVIndex(IEN101d43,IENOQV)) quit:(IENOQV'>0) do +"RTN","TMGNDF4F",587,0) + . write " <--- (#",IENOQV,") " +"RTN","TMGNDF4F",588,0) + . write $$GET1^DIQ(101.442,IENOQV_","_RxSet_",",2),! +"RTN","TMGNDF4F",589,0) + . set someShown=1 +"RTN","TMGNDF4F",590,0) + . set pauseCount=pauseCount+1 +"RTN","TMGNDF4F",591,0) + . if pauseCount<10 quit +"RTN","TMGNDF4F",592,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",593,0) + . set pauseCount=0 +"RTN","TMGNDF4F",594,0) + if someShown=0 write " (None)",! +"RTN","TMGNDF4F",595,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",596,0) + +"RTN","TMGNDF4F",597,0) + quit +"RTN","TMGNDF4F",598,0) + +"RTN","TMGNDF4F",599,0) + +"RTN","TMGNDF4F",600,0) +PickOI(IENOQV) +"RTN","TMGNDF4F",601,0) + ;"Purpose: To start from a ORDER QUICK VIEW record, and track backwards +"RTN","TMGNDF4F",602,0) + ;"Input: IENOQV -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4F",603,0) + ;" IENOQV(0)=RxSet, i.e. the IEN in 101.44 containing ORWDSET O RX +"RTN","TMGNDF4F",604,0) + ;" IENOQV=IEN IN 101.442 +"RTN","TMGNDF4F",605,0) + ;" IENOQV("IENS")=IENS +"RTN","TMGNDF4F",606,0) + ;" IENOQV("Name")=Name of ORDER QUICK VIEW +"RTN","TMGNDF4F",607,0) + ;" IENOQV("Linked 101.43")=IEN of linked 101.43 +"RTN","TMGNDF4F",608,0) + ;" IENOQV("Linked 101.43","Name")=name +"RTN","TMGNDF4F",609,0) + ;"Result: none. +"RTN","TMGNDF4F",610,0) + +"RTN","TMGNDF4F",611,0) + new IENS,IEN101d43,OQVName +"RTN","TMGNDF4F",612,0) + set IENS=$$AskOQV(.OQVName) if IENS="" goto POIDone +"RTN","TMGNDF4F",613,0) + ;"write "ORDER QUICK VIEW (",IENS,") --> ORDERABLE ITEM ",! +"RTN","TMGNDF4F",614,0) + set IEN101d43=$$GET1^DIQ(101.442,IENS,.01,"I") +"RTN","TMGNDF4F",615,0) + set IENOQV=$piece(IENS,",",1) +"RTN","TMGNDF4F",616,0) + set IENOQV(0)=$piece(IENS,",",2) +"RTN","TMGNDF4F",617,0) + set IENOQV("IENS")=IENS +"RTN","TMGNDF4F",618,0) + set IENOQV("Name")=OQVName +"RTN","TMGNDF4F",619,0) + set IENOQV("Linked 101.43")=IEN101d43 +"RTN","TMGNDF4F",620,0) + set IENOQV("Linked 101.43","Name")=$$GET1^DIQ(101.43,IEN101d43_",",.01) +"RTN","TMGNDF4F",621,0) + +"RTN","TMGNDF4F",622,0) +POIDone +"RTN","TMGNDF4F",623,0) + quit +"RTN","TMGNDF4F",624,0) + +"RTN","TMGNDF4F",625,0) +DispDoses(IEN101d43) +"RTN","TMGNDF4F",626,0) + ;"Purpose: To Display possible dosed for a ORDER QUICK VIEW record +"RTN","TMGNDF4F",627,0) + ;"Input: IEN101d43 -- IEN in 101.43 +"RTN","TMGNDF4F",628,0) + ;"Output: displays possible doses +"RTN","TMGNDF4F",629,0) + ;"Result: none. +"RTN","TMGNDF4F",630,0) + +"RTN","TMGNDF4F",631,0) + new array +"RTN","TMGNDF4F",632,0) + do OISLCT^ORWDPS2(.array,IEN101d43,"O",0,"Y","N") +"RTN","TMGNDF4F",633,0) + do ArrayDump^TMGDEBUG("array") +"RTN","TMGNDF4F",634,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4F",635,0) + +"RTN","TMGNDF4F",636,0) + quit +"RTN","TMGNDF4F",637,0) + +"RTN","TMGNDF4F",638,0) + +"RTN","TMGNDF4G") +0^59^B6258 +"RTN","TMGNDF4G",1,0) +TMGNDF4G ;TMG/kst/FDA Import -- Fix OQV Problems;10/15/07 +"RTN","TMGNDF4G",2,0) + ;;1.0;TMG-LIB;**1**;10/15/07 +"RTN","TMGNDF4G",3,0) + +"RTN","TMGNDF4G",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDF4G",5,0) + ;" Fixing problems with ORDER QUICK VIEW +"RTN","TMGNDF4G",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDF4G",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDF4G",8,0) + ;"10-15-2007 +"RTN","TMGNDF4G",9,0) + +"RTN","TMGNDF4G",10,0) + ;"======================================================================= +"RTN","TMGNDF4G",11,0) + ;" API -- Public Functions. +"RTN","TMGNDF4G",12,0) + ;"======================================================================= +"RTN","TMGNDF4G",13,0) + ;"(No menu -- called from ^TMGNDF4F) +"RTN","TMGNDF4G",14,0) + ;"AskFix1TMG -- ask user for entry in 22706.9 and allow editing. +"RTN","TMGNDF4G",15,0) + ;"======================================================================= +"RTN","TMGNDF4G",16,0) + +"RTN","TMGNDF4G",17,0) + ;"======================================================================= +"RTN","TMGNDF4G",18,0) + ;" Private Functions. +"RTN","TMGNDF4G",19,0) + ;"======================================================================= +"RTN","TMGNDF4G",20,0) + ;"FixOQVMissing -- fix a missing ORDER QUICK VIEW. +"RTN","TMGNDF4G",21,0) + ;"FindOQV(Prefix,RxName,RxSet,SrchRec) -- Search ORDER QUICk VIEW for RxName, and return if found +"RTN","TMGNDF4G",22,0) + ;"FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) -- Scan 22706.9 for RxName, and return if found +"RTN","TMGNDF4G",23,0) + ;"DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) -- Scam file for RxName, and return if found +"RTN","TMGNDF4G",24,0) + ;"HandleChain(array) -- Show chain and alow user editing etc. from input entry towards final part of chain (Order Quick View) +"RTN","TMGNDF4G",25,0) + ;"HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) -- show the user a drug chain and allow manipulation of it +"RTN","TMGNDF4G",26,0) + ;"Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) -- A brief subroutine to format 22706.9 input +"RTN","TMGNDF4G",27,0) + ;"Fmt101d43(IEN,RxSet) -- add an entry from file 101.43 to output string +"RTN","TMGNDF4G",28,0) + ;"Fmt50d7(IEN,RxSet) -- add an entry from file 50.7 to output string +"RTN","TMGNDF4G",29,0) + ;"Fmt50(IEN,RxSet) -- add an entry from file 50 to output string +"RTN","TMGNDF4G",30,0) + ;"Fmt22706d9(IEN,RxSet,s) -- add an entry from file 22706.9 to output string +"RTN","TMGNDF4G",31,0) + ;"EditTMG(IEN) -- to edit the TMG entry in 22706.9 +"RTN","TMGNDF4G",32,0) + ;"FullEDTMG(IEN) -- allow editing of any field in TMG 22706.9 +"RTN","TMGNDF4G",33,0) + +"RTN","TMGNDF4G",34,0) + ;"======================================================================= +"RTN","TMGNDF4G",35,0) + +"RTN","TMGNDF4G",36,0) +FixOQVMissing +"RTN","TMGNDF4G",37,0) + ;"Purpose: to fix a missing ORDER QUICK VIEW. I.e. add entry and +"RTN","TMGNDF4G",38,0) + ;" and interviening entries needed. +"RTN","TMGNDF4G",39,0) + ;"Input: none. +"RTN","TMGNDF4G",40,0) + +"RTN","TMGNDF4G",41,0) + new RxSet +"RTN","TMGNDF4G",42,0) + set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto FOQVDone +"RTN","TMGNDF4G",43,0) + +"RTN","TMGNDF4G",44,0) + new RxName,SrchRec +"RTN","TMGNDF4G",45,0) + read "Enter DRUG NAME to FIND/ADD (may be partial name): ",RxName:$get(DTIME,3600),! +"RTN","TMGNDF4G",46,0) + if (RxName="")!(RxName="^") goto FOQVDone +"RTN","TMGNDF4G",47,0) + +"RTN","TMGNDF4G",48,0) + ;"do FindOQV("A. (101.44): ",RxName,RxSet,.SrchRec) ;"ORDER QUICK VIEW +"RTN","TMGNDF4G",49,0) + ;"do DoFind("B. (101.43): ",RxName,101.43,.01,.SrchRec,"B") ;"ORDERABLE ITEM +"RTN","TMGNDF4G",50,0) + ;"do DoFind("C. (50.7): ",RxName,50.7,.01,.SrchRec,"B") ;"PHARMACY ORDERABLE ITEM +"RTN","TMGNDF4G",51,0) + ;"do DoFind("D. (50): ",RxName,50,.01,.SrchRec,"B") ;"DRUG file +"RTN","TMGNDF4G",52,0) + ;"do DoFind("E. (22706.9): ",RxName,22706.9,.04,.SrchRec,"LN^C") ;"TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF4G",53,0) + ;"do DoFind("",RxName,22706.9,.04,.SrchRec,"B^C^D^E^LN") ;"TMG FDA IMPORT COMPILED (22706.9) +"RTN","TMGNDF4G",54,0) + +"RTN","TMGNDF4G",55,0) + new % set %=1 +"RTN","TMGNDF4G",56,0) + write "Ignore drugs marked to be SKIPPED" +"RTN","TMGNDF4G",57,0) + do YN^DICN write ! +"RTN","TMGNDF4G",58,0) + if %=-1 goto FOQVDone +"RTN","TMGNDF4G",59,0) + do FindTMG("",RxName,RxSet,.SrchRec,(%=1)) +"RTN","TMGNDF4G",60,0) + +"RTN","TMGNDF4G",61,0) + write !,"Next, select one or more drugs that are ",! +"RTN","TMGNDF4G",62,0) + write "examples of a drug that is missing.",! +"RTN","TMGNDF4G",63,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",64,0) + +"RTN","TMGNDF4G",65,0) + new Results +"RTN","TMGNDF4G",66,0) + do Slctor2^TMGUSRIF("SrchRec","Results","Pick Example(s) of Missing Drugs. [ESC][ESC] when done.") +"RTN","TMGNDF4G",67,0) + +"RTN","TMGNDF4G",68,0) + set %=1 +"RTN","TMGNDF4G",69,0) + write "Automatically Refreshing Selected Before Editing" +"RTN","TMGNDF4G",70,0) + do YN^DICN write ! +"RTN","TMGNDF4G",71,0) + if %=-1 goto FOQVDone +"RTN","TMGNDF4G",72,0) + if %=1 do RefreshChain(.Results) +"RTN","TMGNDF4G",73,0) + +"RTN","TMGNDF4G",74,0) + do HandleChain(.Results) ;"Show forward array +"RTN","TMGNDF4G",75,0) + +"RTN","TMGNDF4G",76,0) + write "Done.",! +"RTN","TMGNDF4G",77,0) + do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",78,0) + +"RTN","TMGNDF4G",79,0) +FOQVDone +"RTN","TMGNDF4G",80,0) + quit +"RTN","TMGNDF4G",81,0) + +"RTN","TMGNDF4G",82,0) + +"RTN","TMGNDF4G",83,0) +AskFix1TMG +"RTN","TMGNDF4G",84,0) + ;"Purpose: ask user for entry in 22706.9 and allow editing. +"RTN","TMGNDF4G",85,0) + +"RTN","TMGNDF4G",86,0) + new DIC,X,Y,IEN22706d9 +"RTN","TMGNDF4G",87,0) + +"RTN","TMGNDF4G",88,0) + set DIC=22706.9,DIC(0)="MAEQ" +"RTN","TMGNDF4G",89,0) + do ^DIC +"RTN","TMGNDF4G",90,0) + if +Y>0 do +"RTN","TMGNDF4G",91,0) + . new array +"RTN","TMGNDF4G",92,0) + . set array($piece(Y,"^",2),+Y_"^22706.9")="" +"RTN","TMGNDF4G",93,0) + . do HandleChain(.array) +"RTN","TMGNDF4G",94,0) + +"RTN","TMGNDF4G",95,0) + quit +"RTN","TMGNDF4G",96,0) + +"RTN","TMGNDF4G",97,0) + +"RTN","TMGNDF4G",98,0) +FindOQV(Prefix,RxName,RxSet,SrchRec) +"RTN","TMGNDF4G",99,0) + ;"Purpose: look through ORDER QUICk VIEW for RxName, and return if found +"RTN","TMGNDF4G",100,0) + ;"Input: Prefix -- a string to prefix name with in index. +"RTN","TMGNDF4G",101,0) + ;" RxName -- the string of the Rx name to look for (may be a partial name) +"RTN","TMGNDF4G",102,0) + ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44 +"RTN","TMGNDF4G",103,0) + ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4G",104,0) + ;" SrchRec(NameFound)=IEN^File# +"RTN","TMGNDF4G",105,0) + ;" SrchRec(NameFound)=IEN^File# +"RTN","TMGNDF4G",106,0) + ;"Output: SrchRec is filled. +"RTN","TMGNDF4G",107,0) + ;"Result: none +"RTN","TMGNDF4G",108,0) + +"RTN","TMGNDF4G",109,0) + new TMGDATA,TMGERR +"RTN","TMGNDF4G",110,0) + do FIND^DIC(101.442,","_RxSet_",","","M",RxName,"*","B","","","TMGDATA","TMGERR") +"RTN","TMGNDF4G",111,0) + +"RTN","TMGNDF4G",112,0) + if +$get(TMGDATA("DILIST",0))>0 do +"RTN","TMGNDF4G",113,0) + . new j,IEN,Name +"RTN","TMGNDF4G",114,0) + . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do +"RTN","TMGNDF4G",115,0) + . . set IEN=$get(TMGDATA("DILIST",2,j)) +"RTN","TMGNDF4G",116,0) + . . set name=Prefix_$$GET1^DIQ(101.442,IEN_","_RxSet_",",".01") +"RTN","TMGNDF4G",117,0) + . . set SrchRec(name,IEN_","_RxSet_",^101.442")="" +"RTN","TMGNDF4G",118,0) + +"RTN","TMGNDF4G",119,0) + quit +"RTN","TMGNDF4G",120,0) + +"RTN","TMGNDF4G",121,0) + +"RTN","TMGNDF4G",122,0) +FindTMG(Prefix,RxName,RxSet,SrchRec,IgnoreSkipped) +"RTN","TMGNDF4G",123,0) + ;"Purpose: look through 22706.9 for RxName, and return if found +"RTN","TMGNDF4G",124,0) + ;"Input: Prefix -- a string to prefix name with in index. +"RTN","TMGNDF4G",125,0) + ;" RxName -- the string of the Rx name to look for (may be a partial name) +"RTN","TMGNDF4G",126,0) + ;" RxSet -- IEN of 'ORWDSET O RX' in 101.44 +"RTN","TMGNDF4G",127,0) + ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4G",128,0) + ;" SrchRec(NameFound,IEN^File#)="" +"RTN","TMGNDF4G",129,0) + ;" SrchRec(NameFound,IEN^File#)="" +"RTN","TMGNDF4G",130,0) + ;" IgnoreSkipped -- if 1 then only show drugs not marked to be SKIPPED +"RTN","TMGNDF4G",131,0) + ;"Output: SrchRec is filled. +"RTN","TMGNDF4G",132,0) + ;"Result: none +"RTN","TMGNDF4G",133,0) + +"RTN","TMGNDF4G",134,0) + new TMGDATA,TMGERR +"RTN","TMGNDF4G",135,0) + ;"do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^E^LN","","","TMGDATA","TMGERR") +"RTN","TMGNDF4G",136,0) + do FIND^DIC(22706.9,"","","M",RxName,"*","B^C^D^LN","","","TMGDATA","TMGERR") +"RTN","TMGNDF4G",137,0) + +"RTN","TMGNDF4G",138,0) + if +$get(TMGDATA("DILIST",0))>0 do +"RTN","TMGNDF4G",139,0) + . new j,IEN,IENS,name,name1,name2,name3,TMGARRAY +"RTN","TMGNDF4G",140,0) + . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do +"RTN","TMGNDF4G",141,0) + . . set IEN=$get(TMGDATA("DILIST",2,j)),IENS=IEN_"," +"RTN","TMGNDF4G",142,0) + . . do GETS^DIQ(22706.9,IENS,".05;.07;6;.04",,"TMGARRAY","TMGMSG") +"RTN","TMGNDF4G",143,0) + . . if IgnoreSkipped,($get(TMGARRAY(22706.9,IENS,"6"))="SKIP") quit +"RTN","TMGNDF4G",144,0) + . . set name1=$get(TMGARRAY(22706.9,IENS,".05")) +"RTN","TMGNDF4G",145,0) + . . set name2=$get(TMGARRAY(22706.9,IENS,".07")) +"RTN","TMGNDF4G",146,0) + . . set name3=$get(TMGARRAY(22706.9,IENS,".04")) +"RTN","TMGNDF4G",147,0) + . . set name=name1_" | "_name2_" | "_name3 +"RTN","TMGNDF4G",148,0) + . . set name=$extract(name,1,75) +"RTN","TMGNDF4G",149,0) + . . set SrchRec(name,IENS_"^"_"22706.9")="" +"RTN","TMGNDF4G",150,0) + +"RTN","TMGNDF4G",151,0) + quit +"RTN","TMGNDF4G",152,0) + +"RTN","TMGNDF4G",153,0) + +"RTN","TMGNDF4G",154,0) +DoFind(Prefix,RxName,FileNum,Field,SrchRec,index) +"RTN","TMGNDF4G",155,0) + ;"Purpose: look through file for RxName, and return if found +"RTN","TMGNDF4G",156,0) + ;"Input: Prefix -- a string to prefix name with in index. +"RTN","TMGNDF4G",157,0) + ;" RxName -- the string of the Rx name to look for (may be a partial name) +"RTN","TMGNDF4G",158,0) + ;" FileNum -- The file number to look in. +"RTN","TMGNDF4G",159,0) + ;" Field -- OPTIONAL. Field to return value in. Default=.01 +"RTN","TMGNDF4G",160,0) + ;" SrchRec -- PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGNDF4G",161,0) + ;" SrchRec(NameFound)=IEN^File# +"RTN","TMGNDF4G",162,0) + ;" SrchRec(NameFound)=IEN^File# +"RTN","TMGNDF4G",163,0) + ;" --NOTE: if Name has already been found, it will NOT be overwritten here. +"RTN","TMGNDF4G",164,0) + ;" index -- OPTIONAL. Index to search. Default="B" +"RTN","TMGNDF4G",165,0) + ;"Output: SrchRec is filled. +"RTN","TMGNDF4G",166,0) + ;"Result: none +"RTN","TMGNDF4G",167,0) + +"RTN","TMGNDF4G",168,0) + set Field=$get(Field,".01") +"RTN","TMGNDF4G",169,0) + set index=$get(index,"B") +"RTN","TMGNDF4G",170,0) + +"RTN","TMGNDF4G",171,0) + new TMGDATA,TMGERR +"RTN","TMGNDF4G",172,0) + do FIND^DIC(FileNum,"","","M",RxName,"*",index,"","","TMGDATA","TMGERR") +"RTN","TMGNDF4G",173,0) + +"RTN","TMGNDF4G",174,0) + if +$get(TMGDATA("DILIST",0))>0 do +"RTN","TMGNDF4G",175,0) + . new j,IEN,Name +"RTN","TMGNDF4G",176,0) + . set j=0 for set j=+$order(TMGDATA("DILIST",2,j)) quit:(j=0) do +"RTN","TMGNDF4G",177,0) + . . set IEN=$get(TMGDATA("DILIST",2,j)) +"RTN","TMGNDF4G",178,0) + . . set name=Prefix_$$GET1^DIQ(FileNum,IEN,Field) +"RTN","TMGNDF4G",179,0) + . . set SrchRec(name,IEN_"^"_FileNum)="" +"RTN","TMGNDF4G",180,0) + +"RTN","TMGNDF4G",181,0) + quit +"RTN","TMGNDF4G",182,0) + +"RTN","TMGNDF4G",183,0) + +"RTN","TMGNDF4G",184,0) +RefreshChain(array) +"RTN","TMGNDF4G",185,0) + ;"Purpose: Refresh entries in 22706.9 +"RTN","TMGNDF4G",186,0) + ;"Input: -- array: PASS BY REFERENCE. Format: +"RTN","TMGNDF4G",187,0) + ;" array(DrugName,IEN^File#)="" +"RTN","TMGNDF4G",188,0) + ;" array(DrugName,IEN^File#)="" +"RTN","TMGNDF4G",189,0) + ;" Note: it is expected that File# will be: +"RTN","TMGNDF4G",190,0) + ;" 101.44, 101.43, 50.7, 50, or 22706.9 +"RTN","TMGNDF4G",191,0) + +"RTN","TMGNDF4G",192,0) + new name,IENArray +"RTN","TMGNDF4G",193,0) + set name="" +"RTN","TMGNDF4G",194,0) + for set name=$order(array(name)) quit:(name="") do +"RTN","TMGNDF4G",195,0) + . new fInfo set fInfo="" +"RTN","TMGNDF4G",196,0) + . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do +"RTN","TMGNDF4G",197,0) + . . new IEN,FileNum +"RTN","TMGNDF4G",198,0) + . . set FileNum=$piece(fInfo,"^",2) +"RTN","TMGNDF4G",199,0) + . . if FileNum'=22706.9 quit +"RTN","TMGNDF4G",200,0) + . . set IEN=$piece(fInfo,"^",1) +"RTN","TMGNDF4G",201,0) + . . set IENArray(+IEN)="" +"RTN","TMGNDF4G",202,0) + +"RTN","TMGNDF4G",203,0) + new Option set Option("FIX CHAIN")=1 +"RTN","TMGNDF4G",204,0) + set Option("QUIET")=1 +"RTN","TMGNDF4G",205,0) + do RefreshBatch^TMGNDF3C(.IENArray,.Option) +"RTN","TMGNDF4G",206,0) + +"RTN","TMGNDF4G",207,0) + quit +"RTN","TMGNDF4G",208,0) + +"RTN","TMGNDF4G",209,0) + +"RTN","TMGNDF4G",210,0) +HandleChain(array) ;"Show forward array +"RTN","TMGNDF4G",211,0) + ;"Purpose: Show chain from input entry towards final part of chain (Order Quick View) +"RTN","TMGNDF4G",212,0) + ;"Input: -- array: PASS BY REFERENCE. Format: +"RTN","TMGNDF4G",213,0) + ;" array(DrugName,IEN^File#)="" +"RTN","TMGNDF4G",214,0) + ;" array(DrugName,IEN^File#)="" +"RTN","TMGNDF4G",215,0) + ;" Note: it is expected that File# will be: +"RTN","TMGNDF4G",216,0) + ;" 101.44, 101.43, 50.7, 50, or 22706.9 +"RTN","TMGNDF4G",217,0) + +"RTN","TMGNDF4G",218,0) + new output,RxSet,OutArray +"RTN","TMGNDF4G",219,0) + +"RTN","TMGNDF4G",220,0) + set RxSet=$$GetOQVSet^TMGNDFUT() if RxSet'>0 goto HCnDone +"RTN","TMGNDF4G",221,0) + new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9 +"RTN","TMGNDF4G",222,0) + new array1,array2,num +"RTN","TMGNDF4G",223,0) + new abort,rescan +"RTN","TMGNDF4G",224,0) + new name +"RTN","TMGNDF4G",225,0) +HC1 +"RTN","TMGNDF4G",226,0) + kill output,array2,array1 +"RTN","TMGNDF4G",227,0) + set name="" +"RTN","TMGNDF4G",228,0) + for set name=$order(array(name)) quit:(name="") do +"RTN","TMGNDF4G",229,0) + . new fInfo set fInfo="" +"RTN","TMGNDF4G",230,0) + . for set fInfo=$order(array(name,fInfo)) quit:(fInfo="") do +"RTN","TMGNDF4G",231,0) + . . new IEN,FileNum +"RTN","TMGNDF4G",232,0) + . . set IEN=$piece(fInfo,"^",1) +"RTN","TMGNDF4G",233,0) + . . set FileNum=$piece(fInfo,"^",2) +"RTN","TMGNDF4G",234,0) + . . if FileNum=101.44 set output=IEN +"RTN","TMGNDF4G",235,0) + . . else if FileNum=101.43 set output=$$Fmt101d43(IEN,RxSet) +"RTN","TMGNDF4G",236,0) + . . else if FileNum=50.7 set output=$$Fmt50d7(IEN,RxSet) +"RTN","TMGNDF4G",237,0) + . . else if FileNum=50 set output=$$Fmt50(IEN,RxSet) +"RTN","TMGNDF4G",238,0) + . . else if FileNum=22706.9 do +"RTN","TMGNDF4G",239,0) + . . . do Hndl22706d9(IEN,RxSet,.OutArray,.array1,"T") +"RTN","TMGNDF4G",240,0) + . . . set output=$$Fmt22706d9(IEN,RxSet,"G") +"RTN","TMGNDF4G",241,0) + . . set IEN10144=+$piece(output,"^",1) +"RTN","TMGNDF4G",242,0) + . . set IEN10143=+$piece(output,"^",2) +"RTN","TMGNDF4G",243,0) + . . set IEN50d7=+$piece(output,"^",3) +"RTN","TMGNDF4G",244,0) + . . set IEN50=+$piece(output,"^",4) +"RTN","TMGNDF4G",245,0) + . . set IEN22706d9=+$piece(output,"^",5) +"RTN","TMGNDF4G",246,0) + . . if IEN22706d9=0 quit +"RTN","TMGNDF4G",247,0) + . . set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)="G" +"RTN","TMGNDF4G",248,0) + . . set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_"G")="" +"RTN","TMGNDF4G",249,0) + +"RTN","TMGNDF4G",250,0) + ;"Now rearrange into a numbered array +"RTN","TMGNDF4G",251,0) + set num=0,IEN22706d9="" +"RTN","TMGNDF4G",252,0) + for set IEN22706d9=$order(array1(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDF4G",253,0) + . new s set s="" +"RTN","TMGNDF4G",254,0) + . for set s=$order(array1(IEN22706d9,s)) quit:(s="") do +"RTN","TMGNDF4G",255,0) + . . set num=num+1 +"RTN","TMGNDF4G",256,0) + . . set array2(num)=s +"RTN","TMGNDF4G",257,0) + +"RTN","TMGNDF4G",258,0) + ;"Now display array -- this setup will allow user to back up in list +"RTN","TMGNDF4G",259,0) + set abort=0,rescan=0,num=0 +"RTN","TMGNDF4G",260,0) + for set num=$order(array2(num)) quit:(num="")!(abort=1)!(rescan=1) do +"RTN","TMGNDF4G",261,0) + . new s set s=$get(array2(num)) +"RTN","TMGNDF4G",262,0) + . new result +"RTN","TMGNDF4G",263,0) + . set result=$$HandleOne($piece(s,"^",1),$piece(s,"^",2),$piece(s,"^",3),$piece(s,"^",4),$piece(s,"^",5),$piece(s,"^",6)) +"RTN","TMGNDF4G",264,0) + . if result="^" set abort=1 quit +"RTN","TMGNDF4G",265,0) + . else if result=-3 kill array2(num) quit +"RTN","TMGNDF4G",266,0) + . else if result=-4 set rescan=1 quit +"RTN","TMGNDF4G",267,0) + . else if result=-1 do quit +"RTN","TMGNDF4G",268,0) + . . set num=$order(array2(num),-1) +"RTN","TMGNDF4G",269,0) + . . if num>0 set num=$order(array2(num),-1) +"RTN","TMGNDF4G",270,0) + +"RTN","TMGNDF4G",271,0) + if rescan=1 goto HC1 +"RTN","TMGNDF4G",272,0) + +"RTN","TMGNDF4G",273,0) +HCnDone +"RTN","TMGNDF4G",274,0) + quit +"RTN","TMGNDF4G",275,0) + +"RTN","TMGNDF4G",276,0) + +"RTN","TMGNDF4G",277,0) +HandleOne(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9,GorT) +"RTN","TMGNDF4G",278,0) + ;"Purpose: to show the user a drug chain and allow manipulation of it +"RTN","TMGNDF4G",279,0) + ;"Input: IEN's +"RTN","TMGNDF4G",280,0) + ;" GorT -- G or T +"RTN","TMGNDF4G",281,0) + ;"NOTE: makes use of RxSet (a variable globally scoped here) +"RTN","TMGNDF4G",282,0) + ;"Results: 1: go to next, +"RTN","TMGNDF4G",283,0) + ;" -1: go back one, +"RTN","TMGNDF4G",284,0) + ;" ^: abort, +"RTN","TMGNDF4G",285,0) + ;" -3: delete this record +"RTN","TMGNDF4G",286,0) + ;" -4: Rescan and re-setup array +"RTN","TMGNDF4G",287,0) + +"RTN","TMGNDF4G",288,0) + new input +"RTN","TMGNDF4G",289,0) + new result set result=1 +"RTN","TMGNDF4G",290,0) +H1L1 +"RTN","TMGNDF4G",291,0) + write # +"RTN","TMGNDF4G",292,0) + write "-- TMG FDA IMPORT COMPILED (22706.9) file, Record# ",IEN22706d9," [",GorT,"] -----------",! +"RTN","TMGNDF4G",293,0) + new tabCol set tabCol=50 +"RTN","TMGNDF4G",294,0) + ;"write $extract($$GET1^DIQ(22706.9,IEN22706d9_",",.04),1,48),?50," [.04;22706.9:#",IEN22706d9,"]",! +"RTN","TMGNDF4G",295,0) + write "1. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.04),?tabCol," [.04; Long]",! +"RTN","TMGNDF4G",296,0) + write "2. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.05),?tabCol," [.05; Trade (inclds Frm)]",! +"RTN","TMGNDF4G",297,0) + write "3. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.055),?tabCol," [.055; Trade&Frm]",! +"RTN","TMGNDF4G",298,0) + write "4. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.056),?tabCol," [.056; Trade,Frm,Dose,Unit]",! +"RTN","TMGNDF4G",299,0) + write "5. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.07),?tabCol," [.07; Generic]",! +"RTN","TMGNDF4G",300,0) + write "6. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.075),?tabCol," [.075; Genrc&Frm]",! +"RTN","TMGNDF4G",301,0) + write "7. ",$$GET1^DIQ(22706.9,IEN22706d9_",",.076),?tabCol," [.076; Generc,Frm,Dose,Unit]",! +"RTN","TMGNDF4G",302,0) + write "8. +-> [",GorT,"] ",$$GET1^DIQ(50,IEN50_",",.01),?tabCol," [50:#",IEN50,"]",! +"RTN","TMGNDF4G",303,0) + new vapIEN set vapIEN=+$piece($get(^PSDRUG(IEN50,"ND")),"^",3) +"RTN","TMGNDF4G",304,0) + if vapIEN>0 write "9. +~~~> 50.68: ",$$GET1^DIQ(50.68,vapIEN_",",.01),! +"RTN","TMGNDF4G",305,0) + write "10. +->",$$GET1^DIQ(50.7,IEN50d7_",",.01),?tabCol," [50.7:#",IEN50d7,"]",! +"RTN","TMGNDF4G",306,0) + write "11. +->",$$GET1^DIQ(101.43,IEN10143_",",.01),?tabCol," [101.43:#",IEN10143,"]",! +"RTN","TMGNDF4G",307,0) + write "12. +->",$$GET1^DIQ(101.442,IEN10144_","_RxSet_",",.01),?tabCol," [101.44:#",IEN10144,"]",! +"RTN","TMGNDF4G",308,0) + write ! +"RTN","TMGNDF4G",309,0) + write "'-'=Backward; '+'=Forward; '^'=quit;",! +"RTN","TMGNDF4G",310,0) + write "F=show FDA source; T=show Compiled record dump",! +"RTN","TMGNDF4G",311,0) + write "S=mark import to be SKIPPED'",! +"RTN","TMGNDF4G",312,0) + write "FE=Full edit of Compiled",! +"RTN","TMGNDF4G",313,0) + write "1..7=Edit Compiled, 8=Edit DRUG (50) record",! +"RTN","TMGNDF4G",314,0) + write "RC=Recompile; N=Alt Names setup; RDL=Refresh DRUG link",! +"RTN","TMGNDF4G",315,0) + read "Enter option: +// ",input,! +"RTN","TMGNDF4G",316,0) + if input="" set input="+" +"RTN","TMGNDF4G",317,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGNDF4G",318,0) + if input="^" set result="^" goto HODone +"RTN","TMGNDF4G",319,0) + if input="-" set result=-1 goto HODone +"RTN","TMGNDF4G",320,0) + if input="+" set result=1 goto HODone +"RTN","TMGNDF4G",321,0) + if input="FE" do +"RTN","TMGNDF4G",322,0) + . do FullEDTMG(IEN22706d9) +"RTN","TMGNDF4G",323,0) + . set input="RDL" +"RTN","TMGNDF4G",324,0) + if (+input>0)&(+input<8) do +"RTN","TMGNDF4G",325,0) + . do EditTMG(IEN22706d9) +"RTN","TMGNDF4G",326,0) + . set input="RDL" +"RTN","TMGNDF4G",327,0) + if input="8" do +"RTN","TMGNDF4G",328,0) + . do Edit50^TMGNDFUT(IEN50) +"RTN","TMGNDF4G",329,0) + . set input="RDL" +"RTN","TMGNDF4G",330,0) + if input="9" do +"RTN","TMGNDF4G",331,0) + . do EditVAP(IEN22706d9) +"RTN","TMGNDF4G",332,0) + . set input="RDL" +"RTN","TMGNDF4G",333,0) + if input="F" do goto H1L1 +"RTN","TMGNDF4G",334,0) + . do Show1Source^TMGNDF1A(IEN22706d9) +"RTN","TMGNDF4G",335,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",336,0) + if input="T" do goto H1L1 +"RTN","TMGNDF4G",337,0) + . do DumpRec2^TMGDEBUG(22706.9,IEN22706d9,0) +"RTN","TMGNDF4G",338,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",339,0) + if input="S" do goto HODone +"RTN","TMGNDF4G",340,0) + . new Option +"RTN","TMGNDF4G",341,0) + . set Option("FIX CHAIN")=1 +"RTN","TMGNDF4G",342,0) + . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9 +"RTN","TMGNDF4G",343,0) + . set Option("DELETING")=1 +"RTN","TMGNDF4G",344,0) + . set Option("QUIET")=1 +"RTN","TMGNDF4G",345,0) + . do Refresh1^TMGNDF3C(IEN22706d9,.Option) +"RTN","TMGNDF4G",346,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDF4G",347,0) + . set TMGFDA(22706.9,IEN22706d9,6)=1 +"RTN","TMGNDF4G",348,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDF4G",349,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDF4G",350,0) + . ;"set $piece(^TMG(22706.9,IEN22706d9,1),"^",4)=1 ;"set SKIP=true +"RTN","TMGNDF4G",351,0) + . set result=-3 +"RTN","TMGNDF4G",352,0) + if input="RC" do goto H1L1 +"RTN","TMGNDF4G",353,0) + . new Option set Option("FIX CHAIN")=1 +"RTN","TMGNDF4G",354,0) + . do ReCompOne^TMGNDF1A(IEN22706d9,.Option) +"RTN","TMGNDF4G",355,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",356,0) + if input="N" do goto H1L1 +"RTN","TMGNDF4G",357,0) + . new Option set Option("FIX CHAIN")=1 +"RTN","TMGNDF4G",358,0) + . do Make1Alt^TMGNDF2G(IEN22706d9,.Option) +"RTN","TMGNDF4G",359,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",360,0) + if input="RDL" do goto HODone +"RTN","TMGNDF4G",361,0) + . new Option set Option("FIX CHAIN")=1 +"RTN","TMGNDF4G",362,0) + . set Option("FIX CHAIN","IEN22706d9")=IEN22706d9 +"RTN","TMGNDF4G",363,0) + . do Refresh1^TMGNDF3C(IEN22706d9,.Option) +"RTN","TMGNDF4G",364,0) + . set result=-4 +"RTN","TMGNDF4G",365,0) + . write "Will now rescan and setup array to detect possible changes.",! +"RTN","TMGNDF4G",366,0) + . do PressToCont^TMGUSRIF +"RTN","TMGNDF4G",367,0) + +"RTN","TMGNDF4G",368,0) +HODone +"RTN","TMGNDF4G",369,0) + quit result +"RTN","TMGNDF4G",370,0) + +"RTN","TMGNDF4G",371,0) +Hndl22706d9(IEN,RxSet,OutArray,array1,GorT) +"RTN","TMGNDF4G",372,0) + ;"Purpose: A brief subroutine to format 22706.9 input +"RTN","TMGNDF4G",373,0) + +"RTN","TMGNDF4G",374,0) + new output +"RTN","TMGNDF4G",375,0) + new IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9 +"RTN","TMGNDF4G",376,0) + set output=$$Fmt22706d9(IEN,RxSet,GorT) +"RTN","TMGNDF4G",377,0) + set IEN10144=+$piece(output,"^",1) +"RTN","TMGNDF4G",378,0) + set IEN10143=+$piece(output,"^",2) +"RTN","TMGNDF4G",379,0) + set IEN50d7=+$piece(output,"^",3) +"RTN","TMGNDF4G",380,0) + set IEN50=+$piece(output,"^",4) +"RTN","TMGNDF4G",381,0) + set IEN22706d9=+$piece(output,"^",5) +"RTN","TMGNDF4G",382,0) + if IEN22706d9=0 quit +"RTN","TMGNDF4G",383,0) + set OutArray(IEN10144,IEN10143,IEN50d7,IEN50,IEN22706d9)=GorT +"RTN","TMGNDF4G",384,0) + set array1(IEN22706d9,IEN10144_"^"_IEN10143_"^"_IEN50d7_"^"_IEN50_"^"_IEN22706d9_"^"_GorT)="" +"RTN","TMGNDF4G",385,0) + quit +"RTN","TMGNDF4G",386,0) + +"RTN","TMGNDF4G",387,0) + +"RTN","TMGNDF4G",388,0) + +"RTN","TMGNDF4G",389,0) +Fmt101d43(IEN,RxSet) +"RTN","TMGNDF4G",390,0) + ;"Purpose: to add an entry from file 101.43 to output string +"RTN","TMGNDF4G",391,0) + ;"Input: IEN -- an IEN from file 101.43 +"RTN","TMGNDF4G",392,0) + ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record +"RTN","TMGNDF4G",393,0) + ;"Result: IEN101.44^IEN101.43 +"RTN","TMGNDF4G",394,0) + +"RTN","TMGNDF4G",395,0) + new parentIEN +"RTN","TMGNDF4G",396,0) + set IEN=+$get(IEN) +"RTN","TMGNDF4G",397,0) + if IEN>0 do +"RTN","TMGNDF4G",398,0) + . set parentIEN=+$order(^ORD(101.44,RxSet,20,"B",IEN,"")) +"RTN","TMGNDF4G",399,0) + else set parentIEN=0 +"RTN","TMGNDF4G",400,0) + +"RTN","TMGNDF4G",401,0) + quit parentIEN_"^"_IEN +"RTN","TMGNDF4G",402,0) + +"RTN","TMGNDF4G",403,0) + +"RTN","TMGNDF4G",404,0) +Fmt50d7(IEN,RxSet) +"RTN","TMGNDF4G",405,0) + ;"Purpose: to add an entry from file 50.7 to output string +"RTN","TMGNDF4G",406,0) + ;"Input: IEN -- an IEN from file 50.7 +"RTN","TMGNDF4G",407,0) + ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record +"RTN","TMGNDF4G",408,0) + ;"Result: IEN101.44^IEN101.43^IEN50.7 +"RTN","TMGNDF4G",409,0) + +"RTN","TMGNDF4G",410,0) + new parentIEN +"RTN","TMGNDF4G",411,0) + set IEN=+$get(IEN) +"RTN","TMGNDF4G",412,0) + if IEN>0 do +"RTN","TMGNDF4G",413,0) + . set parentIEN=$order(^ORD(101.43,"ID",IEN_";99PSP","")) +"RTN","TMGNDF4G",414,0) + else set parentIEN=0 +"RTN","TMGNDF4G",415,0) + +"RTN","TMGNDF4G",416,0) + quit $$Fmt101d43(parentIEN,RxSet)_"^"_IEN +"RTN","TMGNDF4G",417,0) + +"RTN","TMGNDF4G",418,0) + +"RTN","TMGNDF4G",419,0) +Fmt50(IEN,RxSet) +"RTN","TMGNDF4G",420,0) + ;"Purpose: to add an entry from file 50 to output string +"RTN","TMGNDF4G",421,0) + ;"Input: IEN -- an IEN from file 50 +"RTN","TMGNDF4G",422,0) + ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record +"RTN","TMGNDF4G",423,0) + ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50 +"RTN","TMGNDF4G",424,0) + +"RTN","TMGNDF4G",425,0) + new parentIEN +"RTN","TMGNDF4G",426,0) + set IEN=+$get(IEN) +"RTN","TMGNDF4G",427,0) + if IEN>0 do +"RTN","TMGNDF4G",428,0) + . set parentIEN=+$piece($get(^PSDRUG(IEN,2)),"^",1) +"RTN","TMGNDF4G",429,0) + else set parentIEN=0 +"RTN","TMGNDF4G",430,0) + +"RTN","TMGNDF4G",431,0) + quit $$Fmt50d7(parentIEN,RxSet)_"^"_IEN +"RTN","TMGNDF4G",432,0) + +"RTN","TMGNDF4G",433,0) + +"RTN","TMGNDF4G",434,0) +Fmt22706d9(IEN,RxSet,s) +"RTN","TMGNDF4G",435,0) + ;"Purpose: to add an entry from file 22706.9 to output string +"RTN","TMGNDF4G",436,0) + ;"Input: IEN -- an IEN from file 22706.9 +"RTN","TMGNDF4G",437,0) + ;" RxSet -- the IEN in 101.44 of the ORWDSET O RX record +"RTN","TMGNDF4G",438,0) + ;" s -- "G" or "T" for Generic or Trade +"RTN","TMGNDF4G",439,0) + ;"Result: IEN101.44^IEN101.43^IEN50.7^IEN50^IEN22706.9 +"RTN","TMGNDF4G",440,0) + +"RTN","TMGNDF4G",441,0) + new parentIEN set parentIEN=0 +"RTN","TMGNDF4G",442,0) + new parentS +"RTN","TMGNDF4G",443,0) + set IEN=+$get(IEN) +"RTN","TMGNDF4G",444,0) + if IEN>0 do +"RTN","TMGNDF4G",445,0) + . if $get(s)="T" do +"RTN","TMGNDF4G",446,0) + . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",1) ;" 7;1 DRUG TRADENAME LINK +"RTN","TMGNDF4G",447,0) + . else do +"RTN","TMGNDF4G",448,0) + . . set parentIEN=+$piece($get(^TMG(22706.9,IEN,7)),"^",2) ;" 7;2 DRUG GENERIC LINK +"RTN","TMGNDF4G",449,0) + +"RTN","TMGNDF4G",450,0) + if parentIEN>0 do +"RTN","TMGNDF4G",451,0) + . set parentS=$$Fmt50(parentIEN,RxSet) +"RTN","TMGNDF4G",452,0) + else do +"RTN","TMGNDF4G",453,0) + . set parentS="???" +"RTN","TMGNDF4G",454,0) + +"RTN","TMGNDF4G",455,0) + quit parentS_"^"_IEN +"RTN","TMGNDF4G",456,0) + +"RTN","TMGNDF4G",457,0) + +"RTN","TMGNDF4G",458,0) + ;"============================================================ +"RTN","TMGNDF4G",459,0) + +"RTN","TMGNDF4G",460,0) +EditTMG(IEN) +"RTN","TMGNDF4G",461,0) + ;"Purpose: to edit the TMG +"RTN","TMGNDF4G",462,0) + +"RTN","TMGNDF4G",463,0) + ;"do Edit1^TMGNDF1D(IEN) +"RTN","TMGNDF4G",464,0) + +"RTN","TMGNDF4G",465,0) + new Options,IENlist +"RTN","TMGNDF4G",466,0) + set IENlist(IEN)="" +"RTN","TMGNDF4G",467,0) + set Options("FILE")=22706.9 +"RTN","TMGNDF4G",468,0) + set Options("FIELDS",1)=.04 +"RTN","TMGNDF4G",469,0) + set Options("FIELDS",2)=.05 +"RTN","TMGNDF4G",470,0) + set Options("FIELDS",3)=.055 +"RTN","TMGNDF4G",471,0) + set Options("FIELDS",4)=.056 +"RTN","TMGNDF4G",472,0) + set Options("FIELDS",5)=.07 +"RTN","TMGNDF4G",473,0) + set Options("FIELDS",6)=.075 +"RTN","TMGNDF4G",474,0) + set Options("FIELDS",7)=.076 +"RTN","TMGNDF4G",475,0) + set Options("FIELDS",8)=6 +"RTN","TMGNDF4G",476,0) + set Options("FIELDS","MAX NUM")=8 +"RTN","TMGNDF4G",477,0) + +"RTN","TMGNDF4G",478,0) + new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options) +"RTN","TMGNDF4G",479,0) + +"RTN","TMGNDF4G",480,0) + quit +"RTN","TMGNDF4G",481,0) + +"RTN","TMGNDF4G",482,0) + +"RTN","TMGNDF4G",483,0) +FullEDTMG(IEN) +"RTN","TMGNDF4G",484,0) + ;"Purpose: allow editing of any field in TMG +"RTN","TMGNDF4G",485,0) + +"RTN","TMGNDF4G",486,0) + new Options +"RTN","TMGNDF4G",487,0) + set Options("FILE")=22706.9 +"RTN","TMGNDF4G",488,0) + if $$GetFields^TMGSELED(.Options)=0 goto FETDone +"RTN","TMGNDF4G",489,0) + +"RTN","TMGNDF4G",490,0) + new list set list(IEN)="" +"RTN","TMGNDF4G",491,0) + new temp set temp=$$EditRecs^TMGSELED("list",.Options) +"RTN","TMGNDF4G",492,0) + +"RTN","TMGNDF4G",493,0) +FETDone quit +"RTN","TMGNDF4G",494,0) + +"RTN","TMGNDF4G",495,0) + +"RTN","TMGNDF4G",496,0) + +"RTN","TMGNDF4G",497,0) +EditVAP(IEN) +"RTN","TMGNDF4G",498,0) + ;"Purpose: to edit the TMG +"RTN","TMGNDF4G",499,0) + ;"Input: IEN -- IEN in 22706.9 +"RTN","TMGNDF4G",500,0) + +"RTN","TMGNDF4G",501,0) + new Options,IENlist +"RTN","TMGNDF4G",502,0) + set IENlist(IEN)="" +"RTN","TMGNDF4G",503,0) + set Options("FILE")=22706.9 +"RTN","TMGNDF4G",504,0) + set Options("FIELDS",1)=.04 +"RTN","TMGNDF4G",505,0) + set Options("FIELDS",1,"NO EDIT")=1 +"RTN","TMGNDF4G",506,0) + set Options("FIELDS",2)=.055 +"RTN","TMGNDF4G",507,0) + set Options("FIELDS",2,"NO EDIT")=1 +"RTN","TMGNDF4G",508,0) + set Options("FIELDS",3)=.075 +"RTN","TMGNDF4G",509,0) + set Options("FIELDS",3,"NO EDIT")=1 +"RTN","TMGNDF4G",510,0) + set Options("FIELDS",4)=.076 +"RTN","TMGNDF4G",511,0) + set Options("FIELDS",4,"NO EDIT")=1 +"RTN","TMGNDF4G",512,0) + set Options("FIELDS",5)=5.5 +"RTN","TMGNDF4G",513,0) + set Options("FIELDS","MAX NUM")=5 +"RTN","TMGNDF4G",514,0) + +"RTN","TMGNDF4G",515,0) + new temp set temp=$$EditRecs^TMGSELED("IENlist",.Options) +"RTN","TMGNDF4G",516,0) + +"RTN","TMGNDF4G",517,0) + quit +"RTN","TMGNDF4G",518,0) + +"RTN","TMGNDF4G",519,0) + +"RTN","TMGNDFK1") +0^60^B4836 +"RTN","TMGNDFK1",1,0) +TMGNDFK1 ;TMG/kst/FDA Import code -- KIDS Fns ;03/25/06 +"RTN","TMGNDFK1",2,0) + ;;1.0;TMG-LIB;**1**;03/24/07 +"RTN","TMGNDFK1",3,0) + +"RTN","TMGNDFK1",4,0) + ;"FDA - NATIONAL DRUG FILES IMPORT +"RTN","TMGNDFK1",5,0) + ;"Code to handle KIDS builds +"RTN","TMGNDFK1",6,0) + +"RTN","TMGNDFK1",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDFK1",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDFK1",9,0) + ;"3/24/07 +"RTN","TMGNDFK1",10,0) + +"RTN","TMGNDFK1",11,0) + ;"======================================================================= +"RTN","TMGNDFK1",12,0) + ;" API -- Public Functions. +"RTN","TMGNDFK1",13,0) + ;"======================================================================= +"RTN","TMGNDFK1",14,0) + +"RTN","TMGNDFK1",15,0) + ;"======================================================================= +"RTN","TMGNDFK1",16,0) + ;" Private Functions. +"RTN","TMGNDFK1",17,0) + ;"======================================================================= +"RTN","TMGNDFK1",18,0) + ;"======================================================================= +"RTN","TMGNDFK1",19,0) + +"RTN","TMGNDFK1",20,0) +CKENV +"RTN","TMGNDFK1",21,0) + ;"Purpose: Code to check the environment in the target system +"RTN","TMGNDFK1",22,0) + +"RTN","TMGNDFK1",23,0) + quit +"RTN","TMGNDFK1",24,0) + +"RTN","TMGNDFK1",25,0) + +"RTN","TMGNDFK1",26,0) +PRETRANS +"RTN","TMGNDFK1",27,0) + ;"Purpose: Code that will be executed before creating the KIDS +"RTN","TMGNDFK1",28,0) + +"RTN","TMGNDFK1",29,0) + quit +"RTN","TMGNDFK1",30,0) + +"RTN","TMGNDFK1",31,0) + +"RTN","TMGNDFK1",32,0) +PREINST +"RTN","TMGNDFK1",33,0) + ;"Purpose: Code that will be executed on the remote system before the import. +"RTN","TMGNDFK1",34,0) + +"RTN","TMGNDFK1",35,0) + quit +"RTN","TMGNDFK1",36,0) + +"RTN","TMGNDFK1",37,0) +POSTINST +"RTN","TMGNDFK1",38,0) + ;"Purpose: Code that will be executed on the remote system after the import. +"RTN","TMGNDFK1",39,0) + +"RTN","TMGNDFK1",40,0) + quit +"RTN","TMGNDFUT") +0^61^B10639 +"RTN","TMGNDFUT",1,0) +TMGNDFUT ;TMG/kst/FDA Import -- Fix OQV Problems;11/20/07 +"RTN","TMGNDFUT",2,0) + ;;1.0;TMG-LIB;**1**;11/20/07 +"RTN","TMGNDFUT",3,0) + +"RTN","TMGNDFUT",4,0) + ;" FDA - NATIONAL DRUG FILES COMPILING FUNCTIONS +"RTN","TMGNDFUT",5,0) + ;" Utility functions +"RTN","TMGNDFUT",6,0) + +"RTN","TMGNDFUT",7,0) + ;"Kevin Toppenberg MD +"RTN","TMGNDFUT",8,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGNDFUT",9,0) + ;"10-15-2007 +"RTN","TMGNDFUT",10,0) + +"RTN","TMGNDFUT",11,0) + ;"======================================================================= +"RTN","TMGNDFUT",12,0) + ;" API -- Public Functions. +"RTN","TMGNDFUT",13,0) + ;"======================================================================= +"RTN","TMGNDFUT",14,0) + +"RTN","TMGNDFUT",15,0) + ;"Edit50(IEN50) -- launch a screenman form that is designed to edit file 50 records +"RTN","TMGNDFUT",16,0) + ;"Index101d44(RxSet,pIndex) -- index pointers from 101.44 --> 101.43 +"RTN","TMGNDFUT",17,0) + ;"GetOI(IEN50d7,Array) -- return linked IEN in the ORDERABLE ITEM file (101.43) from IEN50d7 +"RTN","TMGNDFUT",18,0) + ;"GetPOI(IEN101d43,POI) -- return linked IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7) +"RTN","TMGNDFUT",19,0) + ;"$$GetOQVIENS(IEN101d43,RxSet,Array) -- get IEN ORDER QUICK VIEW (101.44) for pointer to 101.43 +"RTN","TMGNDFUT",20,0) + ;"GetOIInfo(IEN101d43,Array) -- Get info about ORDERABLE ITEM (101.43) record +"RTN","TMGNDFUT",21,0) + ;"ChkFixOI(Array) -- check and fix pointers into and out of OI record +"RTN","TMGNDFUT",22,0) + ;"GetDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in PHARMACY ORDERABLE ITEM, return linked #50 IEN +"RTN","TMGNDFUT",23,0) + ;"GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly) -- For a given IEN in POI, return linked IEN to DRUG file (50) +"RTN","TMGNDFUT",24,0) + ;"GetfdaIEN(IEN50) -- return the IEN in 22706.9 that points to IEN50 +"RTN","TMGNDFUT",25,0) + ;"GetFDA(IEN50,FDA) -- For a given IEN in DRUG file, return linked IEN in TMG FDA IMPORT COMPILED file (22706.9) +"RTN","TMGNDFUT",26,0) + ;"Unlock50: Unlock fields needed to add data to 50 +"RTN","TMGNDFUT",27,0) + ;"Lock50: Return locks removed from Unlock50 in file 50 +"RTN","TMGNDFUT",28,0) + ;"GetpTMG(IEN50d7,TMGArray,ActiveOnly) IENs in 22706.9 pointing to POI (50.7) record +"RTN","TMGNDFUT",29,0) + ;"Getp1TMG(IEN101d43,TMGArray,ActiveOnly) -- IENS in 22706.9 pointing to OI (101.43) record +"RTN","TMGNDFUT",30,0) + ;"GetpPOI(IEN50d7,Array,ActiveOnly) -- return all IENs pointing to POI from 22706.9, 50, or 101.43 +"RTN","TMGNDFUT",31,0) + ;"GetpOI(IEN101d43,Array,ActiveOnly) --return all IENs pointing to OI from 22706.9, 50.7 101.44 +"RTN","TMGNDFUT",32,0) + ;"KillPOI(IEN50d7) -- remove a POI, along with ptrs from 50, 22706.9, 101.43 +"RTN","TMGNDFUT",33,0) + ;"KillOI(IEN101d43) -- remove an OI, along with ptrs to it from files 50.7, 22706.9, 101.44 +"RTN","TMGNDFUT",34,0) + ;"RedirOI(oldIEN,newIEN) -- redirect pointers in ORDERABLE ITEM file from oldIEN to newIEN +"RTN","TMGNDFUT",35,0) + ;"FindPOI(DrugNAF) -- return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name +"RTN","TMGNDFUT",36,0) + ;"FindOI(DrugNAF) -- return IEN in ORDERABLE ITEM (101.43) matching drug name +"RTN","TMGNDFUT",37,0) + ;"GetOQVSet(quiet) -- get the active RxSet in OQV file +"RTN","TMGNDFUT",38,0) + ;"Kill50(IEN50,IEN22706d9,mode,quiet) --delete entry in file 50, and links to it from 22706.9 +"RTN","TMGNDFUT",39,0) + ;"$$OIInactive(IEN101d43) -- Return if record has a past-due inactive date +"RTN","TMGNDFUT",40,0) + ;"$$IsImport(IEN50d7) -- determine if the POI record is one linked to a FDA import +"RTN","TMGNDFUT",41,0) + ;"KillOQV(IENS) -- kill/inactivate entry in ORDER QUICK VIEW (101.44) +"RTN","TMGNDFUT",42,0) + +"RTN","TMGNDFUT",43,0) + ;"======================================================================= +"RTN","TMGNDFUT",44,0) + ;" Private Functions. +"RTN","TMGNDFUT",45,0) + ;"======================================================================= +"RTN","TMGNDFUT",46,0) + +"RTN","TMGNDFUT",47,0) + ;"======================================================================= +"RTN","TMGNDFUT",48,0) + +"RTN","TMGNDFUT",49,0) + +"RTN","TMGNDFUT",50,0) +Edit50(IEN50) +"RTN","TMGNDFUT",51,0) + ;"Purpose: to launch a screenman form that is designed to edit file 50 records +"RTN","TMGNDFUT",52,0) + +"RTN","TMGNDFUT",53,0) + +"RTN","TMGNDFUT",54,0) + new PSSZ set PSSZ=1 ;"allows editing of .01 field of file 50 +"RTN","TMGNDFUT",55,0) + if +IEN50>0 do LaunchScreenman^TMGMISC(50,103,IEN50,1) ;"launch screenman form +"RTN","TMGNDFUT",56,0) + quit +"RTN","TMGNDFUT",57,0) + +"RTN","TMGNDFUT",58,0) + +"RTN","TMGNDFUT",59,0) + +"RTN","TMGNDFUT",60,0) +Index101d44(RxSet,pIndex) +"RTN","TMGNDFUT",61,0) + ;"Purpose: index pointers from 101.44 --> 101.43 +"RTN","TMGNDFUT",62,0) + ;"Input: RxSet -the IEN in 101.44 containing ORWDSET O RX +"RTN","TMGNDFUT",63,0) + ;" pIndex: PASS BY NAME. An OUT PARAMETER. Format: +"RTN","TMGNDFUT",64,0) + ;" @pIndex@(IEN101.43,IEN101.44)="" +"RTN","TMGNDFUT",65,0) + +"RTN","TMGNDFUT",66,0) + new Itr,subIEN +"RTN","TMGNDFUT",67,0) + new abort set abort=0 +"RTN","TMGNDFUT",68,0) + write "Gathering list of links between ORDER QUICK VIEW --> ORDERABLE ITEM...",! +"RTN","TMGNDFUT",69,0) + set subIEN=$$ItrAInit^TMGITR("^ORD(101.44,"_RxSet_",20)",.Itr) +"RTN","TMGNDFUT",70,0) + do PrepProgress^TMGITR(.Itr,20,1,"subIEN") +"RTN","TMGNDFUT",71,0) + if subIEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.subIEN)="")!abort +"RTN","TMGNDFUT",72,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGNDFUT",73,0) + . new IEN101d43 +"RTN","TMGNDFUT",74,0) + . set IEN101d43=+$piece($get(^ORD(101.44,RxSet,20,subIEN,0)),"^",1) +"RTN","TMGNDFUT",75,0) + . if IEN101d43=0 quit +"RTN","TMGNDFUT",76,0) + . set @pIndex@(IEN101d43,subIEN)=1 +"RTN","TMGNDFUT",77,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGNDFUT",78,0) + +"RTN","TMGNDFUT",79,0) + quit +"RTN","TMGNDFUT",80,0) + +"RTN","TMGNDFUT",81,0) + +"RTN","TMGNDFUT",82,0) + +"RTN","TMGNDFUT",83,0) +GetOI(IEN50d7,Array) +"RTN","TMGNDFUT",84,0) + ;"Purpose: for a given PHARAMCY ORDERABLE ITEM (50.7), return matching IEN +"RTN","TMGNDFUT",85,0) + ;" in the ORDERABLE ITEM file (101.43) +"RTN","TMGNDFUT",86,0) + ;"Input: IEN50d7 -- the IEN in 50.7 +"RTN","TMGNDFUT",87,0) + ;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER. +"RTN","TMGNDFUT",88,0) + ;" Will be filled with ALL pointers to 50d7. Format: +"RTN","TMGNDFUT",89,0) + ;" Array(IEN)="" +"RTN","TMGNDFUT",90,0) + ;"Results: the IEN in 101.43, or 0 if not found +"RTN","TMGNDFUT",91,0) + ;"Note: If, for some reason, more than one record in 101.43 points to +"RTN","TMGNDFUT",92,0) + ;" the specified IEN50d7, then only the first one in the list will be +"RTN","TMGNDFUT",93,0) + ;" returned, but Array will return all +"RTN","TMGNDFUT",94,0) + +"RTN","TMGNDFUT",95,0) + new result set result=0 +"RTN","TMGNDFUT",96,0) + new tempS set tempS=IEN50d7_";99PSP" +"RTN","TMGNDFUT",97,0) + +"RTN","TMGNDFUT",98,0) + new IEN101d43 set IEN101d43="" +"RTN","TMGNDFUT",99,0) + for set IEN101d43=$order(^ORD(101.43,"ID",tempS,IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDFUT",100,0) + . if +IEN101d43=0 quit +"RTN","TMGNDFUT",101,0) + . if result=0 set result=IEN101d43 +"RTN","TMGNDFUT",102,0) + . set Array(IEN101d43)="" +"RTN","TMGNDFUT",103,0) + +"RTN","TMGNDFUT",104,0) + quit result +"RTN","TMGNDFUT",105,0) + +"RTN","TMGNDFUT",106,0) + +"RTN","TMGNDFUT",107,0) +GetPOI(IEN101d43) ;" !! Note: this is a different function from GetpOI !! +"RTN","TMGNDFUT",108,0) + ;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching +"RTN","TMGNDFUT",109,0) + ;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7) +"RTN","TMGNDFUT",110,0) + ;"Input: IEN101d43 -- IEN in 101.43 +"RTN","TMGNDFUT",111,0) + ;"Output: bad pointers may be fixed. +"RTN","TMGNDFUT",112,0) + ;"Result: returns IEN in 50.7, or -1 if NON-PHARMACY entry found, or 0 if problem +"RTN","TMGNDFUT",113,0) + +"RTN","TMGNDFUT",114,0) + new Array,result +"RTN","TMGNDFUT",115,0) + +"RTN","TMGNDFUT",116,0) + do GetOIInfo(IEN101d43,.Array) +"RTN","TMGNDFUT",117,0) + +"RTN","TMGNDFUT",118,0) + new tPOI,gPOI +"RTN","TMGNDFUT",119,0) + set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE")) +"RTN","TMGNDFUT",120,0) + set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC")) +"RTN","TMGNDFUT",121,0) + if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do +"RTN","TMGNDFUT",122,0) + . do ChkFixOI(.Array) +"RTN","TMGNDFUT",123,0) + +"RTN","TMGNDFUT",124,0) + set result=$get(Array("IEN 50.7 from 22706.9","GENERIC")) +"RTN","TMGNDFUT",125,0) + if result="" set result=$get(Array("IEN 50.7 from 22706.9","TRADE")) +"RTN","TMGNDFUT",126,0) + if result="" set result=$get(Array("IEN 50.7 from 101.43")) +"RTN","TMGNDFUT",127,0) + +"RTN","TMGNDFUT",128,0) + quit +result +"RTN","TMGNDFUT",129,0) + +"RTN","TMGNDFUT",130,0) + +"RTN","TMGNDFUT",131,0) +GetOIInfo(IEN101d43,Array) +"RTN","TMGNDFUT",132,0) + ;"Purpose: for a given entry in ORDERABLE ITEM (101.43) file, return matching +"RTN","TMGNDFUT",133,0) + ;" IEN in PHARMACY ORDERABLE ITEM (POI) file (50.7) +"RTN","TMGNDFUT",134,0) + ;"Input: IEN101d43 -- IEN in 101.43 +"RTN","TMGNDFUT",135,0) + ;" Array -- OPTIONAL. PASS BY REFERENCE. An OUT PARAMETER. Output format: +"RTN","TMGNDFUT",136,0) + ;" Array("IEN 101.43")=IEN +"RTN","TMGNDFUT",137,0) + ;" Array("IEN 101.43","NAME")=Name +"RTN","TMGNDFUT",138,0) + ;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated) +"RTN","TMGNDFUT",139,0) + ;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy) +"RTN","TMGNDFUT",140,0) + ;" Array("IEN 101.44",IENS)="" +"RTN","TMGNDFUT",141,0) + ;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7 +"RTN","TMGNDFUT",142,0) + ;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7 +"RTN","TMGNDFUT",143,0) + ;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7 +"RTN","TMGNDFUT",144,0) + ;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7 +"RTN","TMGNDFUT",145,0) + ;" Array("IEN 50.7 from 101.43")=IEN50d7 +"RTN","TMGNDFUT",146,0) + ;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "" if problem +"RTN","TMGNDFUT",147,0) + ;" Array("IEN 22706.9","GENERIC",IEN22706d9)="" +"RTN","TMGNDFUT",148,0) + ;" Array("IEN 22706.9","TRADE",IEN22706d9)="" +"RTN","TMGNDFUT",149,0) + ;"Output: See Array above. +"RTN","TMGNDFUT",150,0) + ;"Result: none +"RTN","TMGNDFUT",151,0) + +"RTN","TMGNDFUT",152,0) + new POIName set POIName="" +"RTN","TMGNDFUT",153,0) + new IEN22706d9 +"RTN","TMGNDFUT",154,0) + +"RTN","TMGNDFUT",155,0) + set Array("IEN 101.43")=IEN101d43 +"RTN","TMGNDFUT",156,0) + set Array("IEN 101.43","NAME")=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1) +"RTN","TMGNDFUT",157,0) + set Array("IEN 101.43","INACTIVE")=$$OIInactive(IEN101d43) +"RTN","TMGNDFUT",158,0) + +"RTN","TMGNDFUT",159,0) + set IEN22706d9="" +"RTN","TMGNDFUT",160,0) + for set IEN22706d9=+$order(^TMG(22706.9,"OIG",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do +"RTN","TMGNDFUT",161,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDFUT",162,0) + . new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;" 8;4 =POI GENERIC LINK +"RTN","TMGNDFUT",163,0) + . set Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=tempPtr +"RTN","TMGNDFUT",164,0) + . set Array("IEN 22706.9","GENERIC",IEN22706d9)="" +"RTN","TMGNDFUT",165,0) + . set Array("IEN 50.7 from 22706.9","GENERIC")=tempPtr +"RTN","TMGNDFUT",166,0) + +"RTN","TMGNDFUT",167,0) + set IEN22706d9="" +"RTN","TMGNDFUT",168,0) + for set IEN22706d9=+$order(^TMG(22706.9,"OIT",IEN101d43,IEN22706d9)) quit:(+IEN22706d9'>0) do +"RTN","TMGNDFUT",169,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 quit ;"1=SKIP +"RTN","TMGNDFUT",170,0) + . new tempPtr set tempPtr=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;" 8;3 = POI TRADENAME LINK +"RTN","TMGNDFUT",171,0) + . set Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=tempPtr +"RTN","TMGNDFUT",172,0) + . set Array("IEN 22706.9","TRADE",IEN22706d9)="" +"RTN","TMGNDFUT",173,0) + . set Array("IEN 50.7 from 22706.9","TRADE")=tempPtr +"RTN","TMGNDFUT",174,0) + +"RTN","TMGNDFUT",175,0) + ;"Get direct pointer to 50.7 +"RTN","TMGNDFUT",176,0) + new ID set ID=$piece($get(^ORD(101.43,IEN101d43,0)),"^",2) +"RTN","TMGNDFUT",177,0) + new pkg set pkg=$piece(ID,";",2) +"RTN","TMGNDFUT",178,0) + set Array("IEN 101.43","PACKAGE")=pkg +"RTN","TMGNDFUT",179,0) + +"RTN","TMGNDFUT",180,0) + new IEN50d7 +"RTN","TMGNDFUT",181,0) + if pkg="99PSP" do +"RTN","TMGNDFUT",182,0) + . set IEN50d7=+$piece(ID,";",1) +"RTN","TMGNDFUT",183,0) + . set POIName=$piece($get(^PS(50.7,IEN50d7,0)),"^",1) +"RTN","TMGNDFUT",184,0) + else do goto GPOIDone ;"not a pharmacy item. +"RTN","TMGNDFUT",185,0) + . set IEN50d7=0 +"RTN","TMGNDFUT",186,0) + . set POIName="" +"RTN","TMGNDFUT",187,0) + set Array("IEN 50.7 from 101.43")=IEN50d7 +"RTN","TMGNDFUT",188,0) + set Array("IEN 50.7 from 101.43","NAME")=POIName +"RTN","TMGNDFUT",189,0) + +"RTN","TMGNDFUT",190,0) + new IENS set IENS=$$GetOQVIENS(IEN101d43) +"RTN","TMGNDFUT",191,0) + set Array("IEN 101.44",IENS)="" +"RTN","TMGNDFUT",192,0) + +"RTN","TMGNDFUT",193,0) +GPOIDone +"RTN","TMGNDFUT",194,0) + quit +"RTN","TMGNDFUT",195,0) + +"RTN","TMGNDFUT",196,0) + +"RTN","TMGNDFUT",197,0) +ChkFixOI(Array) ;"NOTE: This function is not finished/debugged +"RTN","TMGNDFUT",198,0) + ;"Purpose: to check and fix pointers into and out of OI record +"RTN","TMGNDFUT",199,0) + ;"Input -- Array -- PASS BY REFERENCE. An Array as created by GetOIInfo +"RTN","TMGNDFUT",200,0) + ;" Array("IEN 101.43")=IEN +"RTN","TMGNDFUT",201,0) + ;" Array("IEN 101.43","NAME")=Name +"RTN","TMGNDFUT",202,0) + ;" Array("IEN 101.43","INACTIVE")=0 (or 1 if is inactivated) +"RTN","TMGNDFUT",203,0) + ;" Array("IEN 101.43","PACKAGE") = package ('99PSP' for pharmacy) +"RTN","TMGNDFUT",204,0) + ;" Array("IEN 101.44",IENS)="" +"RTN","TMGNDFUT",205,0) + ;" Array("IEN 50.7 from 22706.9","GENERIC")=IEN50d7 +"RTN","TMGNDFUT",206,0) + ;" Array("IEN 50.7 from 22706.9","TRADE")=IEN50d7 +"RTN","TMGNDFUT",207,0) + ;" Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)=IEN50d7 +"RTN","TMGNDFUT",208,0) + ;" Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)=IEN50d7 +"RTN","TMGNDFUT",209,0) + ;" Array("IEN 50.7 from 101.43")=IEN50d7 +"RTN","TMGNDFUT",210,0) + ;" Array("IEN 50.7 from 101.43","NAME")=Name of 50.7, or "" if problem +"RTN","TMGNDFUT",211,0) + ;" Array("IEN 22706.9","GENERIC",IEN22706d9)="" +"RTN","TMGNDFUT",212,0) + ;" Array("IEN 22706.9","TRADE",IEN22706d9)="" +"RTN","TMGNDFUT",213,0) + ;"Result: none +"RTN","TMGNDFUT",214,0) + +"RTN","TMGNDFUT",215,0) + if $get(Array("IEN 101.43","INACTIVE"))=1 goto COIFDone +"RTN","TMGNDFUT",216,0) + +"RTN","TMGNDFUT",217,0) + new IEN101d43 set IEN101d43=+$get(Array("IEN 101.43")) +"RTN","TMGNDFUT",218,0) + new IEN50d7a set IEN50d7a=+$get(Array("IEN 50.7 from 101.43")) +"RTN","TMGNDFUT",219,0) + if IEN50d7a=0 do KillOI(IENE101d43) goto COIFDone +"RTN","TMGNDFUT",220,0) + +"RTN","TMGNDFUT",221,0) + new POIName set POIName=$get(Array("IEN 50.7 from 101.43","NAME")) +"RTN","TMGNDFUT",222,0) + new OIName set OIName=$get(Array("IEN 101.43","NAME")) +"RTN","TMGNDFUT",223,0) + +"RTN","TMGNDFUT",224,0) + new tPOI,gPOI +"RTN","TMGNDFUT",225,0) + set tPOI=+$get(Array("IEN 50.7 from 22706.9","TRADE")) +"RTN","TMGNDFUT",226,0) + set gPOI=+$get(Array("IEN 50.7 from 22706.9","GENERIC")) +"RTN","TMGNDFUT",227,0) + ;"For a given OI, see if there are two different POI's pointing to it via 22706.9 +"RTN","TMGNDFUT",228,0) + ;"There should be just TRADE ptrs or GENERIC ptrs, but not both. +"RTN","TMGNDFUT",229,0) + if (tPOI'=0)&(gPOI'=0)&(tPOI'=gPOI) do goto COIFDone ;"we have crossed chains. +"RTN","TMGNDFUT",230,0) + . ;"We need to make a new POI. But which chain gets new one? +"RTN","TMGNDFUT",231,0) + . new gPOIName,tPOIName,OIName +"RTN","TMGNDFUT",232,0) + . set gPOIName=$piece($get(^PS(50.7,gPOI,0)),"^",1) +"RTN","TMGNDFUT",233,0) + . set tPOIName=$piece($get(^PS(50.7,tPOI,0)),"^",1) +"RTN","TMGNDFUT",234,0) + . set OIName=$piece($get(^ORD(101.43,IEN101d43,0)),"^",1) +"RTN","TMGNDFUT",235,0) + . if gPOIName'=OIName do ;"make a new OI for generic chain +"RTN","TMGNDFUT",236,0) + . . new newOI set newOI=$$NewOI^TMGNDF4C(gPOIName) +"RTN","TMGNDFUT",237,0) + . . if newOI=0 quit ;"error +"RTN","TMGNDFUT",238,0) + . . new result set result=$$StuffOI^TMGNDF4C(newOI,gPOIName,,gPOI) +"RTN","TMGNDFUT",239,0) + . . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",240,0) + . . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","GENERIC",IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",241,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",242,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",5.711)=newOI +"RTN","TMGNDFUT",243,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",244,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",245,0) + . if tPOIName'=OIName do ;"make a new OI for trade chain +"RTN","TMGNDFUT",246,0) + . . new newOI set newOI=$$NewOI^TMGNDF4C(tPOIName) +"RTN","TMGNDFUT",247,0) + . . if newOI=0 quit ;"error +"RTN","TMGNDFUT",248,0) + . . new result set result=$$StuffOI^TMGNDF4C(newOI,tPOIName,,tPOI) +"RTN","TMGNDFUT",249,0) + . . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",250,0) + . . for set IEN22706d9=$order(Array("IEN 50.7 from 22706.9","TRADE",IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",251,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",252,0) + . . . set TMGFDA(22706.9,IEN22706d9_",",5.611)=newOI +"RTN","TMGNDFUT",253,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",254,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",255,0) + +"RTN","TMGNDFUT",256,0) + if ($data(Array("IEN 50.7 from 22706.9","GENERIC"))=0)&($data(Array("IEN 50.7 from 22706.9","TRADE"))=0) do +"RTN","TMGNDFUT",257,0) + . write "A linked record in 22706.9 NOT found pointing to 101.43 #",IEN101d43," (",OIName,")",! +"RTN","TMGNDFUT",258,0) + else do +"RTN","TMGNDFUT",259,0) + . new TMGIEN set TMGIEN="" +"RTN","TMGNDFUT",260,0) + . for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDFUT",261,0) + . . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","GENERIC",TMGIEN)) +"RTN","TMGNDFUT",262,0) + . . write "Linked record in 22706.9 #",TMGIEN," (GENERIC pointer) points to 50.7 #",IEN50d7,! +"RTN","TMGNDFUT",263,0) + . set TMGIEN="" +"RTN","TMGNDFUT",264,0) + . for set TMGIEN=$order(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN)) quit:(TMGIEN="") do +"RTN","TMGNDFUT",265,0) + . . new IEN50d7 set IEN50d7=+$get(Array("IEN 50.7 from 22706.9","TRADE",TMGIEN)) +"RTN","TMGNDFUT",266,0) + . . write "Linked record in 22706.9 #",TMGIEN," (TRADE pointer) points to 50.7 #",IEN50d7,! +"RTN","TMGNDFUT",267,0) + +"RTN","TMGNDFUT",268,0) + write " 101.43 #",IEN101d43," (",OIName,")",! +"RTN","TMGNDFUT",269,0) + write " points directly to 50.7 #",IEN50d7a," (",POIName,")",! +"RTN","TMGNDFUT",270,0) + if (IEN50d7a'=0),$$IsImport^TMGNDF4B(IEN50d7a) do +"RTN","TMGNDFUT",271,0) + . write " and that IS an active import record.",! +"RTN","TMGNDFUT",272,0) + . new IEN50Array +"RTN","TMGNDFUT",273,0) + . do GetDRUGs^TMGNDF4F(IEN50d7a,.IEN50Array,1) +"RTN","TMGNDFUT",274,0) + . write " Pointed to by these active records:",! +"RTN","TMGNDFUT",275,0) + . new name set name="" +"RTN","TMGNDFUT",276,0) + . for set name=$order(IEN50Array(name)) quit:(name="") do +"RTN","TMGNDFUT",277,0) + . . new IEN50 set IEN50="" +"RTN","TMGNDFUT",278,0) + . . for set IEN50=$order(IEN50Array(name,IEN50)) quit:(IEN50="") do +"RTN","TMGNDFUT",279,0) + . . . write " #",IEN50," ",name,! +"RTN","TMGNDFUT",280,0) + else do +"RTN","TMGNDFUT",281,0) + . write " and that IS NOT active import record.",! +"RTN","TMGNDFUT",282,0) + . do KillOI(IEN101d43) +"RTN","TMGNDFUT",283,0) + . write " .. Record in 101.43 deleted.",! +"RTN","TMGNDFUT",284,0) + +"RTN","TMGNDFUT",285,0) +COIFDone +"RTN","TMGNDFUT",286,0) + quit +"RTN","TMGNDFUT",287,0) + +"RTN","TMGNDFUT",288,0) + +"RTN","TMGNDFUT",289,0) + +"RTN","TMGNDFUT",290,0) +GetDRUGs(IEN50d7,IEN50Array,ActiveOnly) +"RTN","TMGNDFUT",291,0) + ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to +"RTN","TMGNDFUT",292,0) + ;" DRUG file (50) +"RTN","TMGNDFUT",293,0) + ;"Input: IEN50d7 -- IEN in file 50.7 +"RTN","TMGNDFUT",294,0) + ;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",295,0) + ;" IEN50Array(Name,IEN50)="" Name is from .01 field +"RTN","TMGNDFUT",296,0) + ;" IEN50Array(Name,IEN50)="" Name is from .01 field +"RTN","TMGNDFUT",297,0) + ;" ActiveOnly -- OPTIONAL, Default=1 +"RTN","TMGNDFUT",298,0) + ;"result: none. +"RTN","TMGNDFUT",299,0) + +"RTN","TMGNDFUT",300,0) + if +$get(IEN50d7)=0 goto GDsDone +"RTN","TMGNDFUT",301,0) + new tempA +"RTN","TMGNDFUT",302,0) + merge tempA=^TMG(22706.9,"POIG",IEN50d7) +"RTN","TMGNDFUT",303,0) + merge tempA=^TMG(22706.9,"POIT",IEN50d7) +"RTN","TMGNDFUT",304,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",305,0) + for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",306,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDFUT",307,0) + . . write "?? PHARMACY ORDERABLE ITEM #",IEN50d7," points to skipped record!",! +"RTN","TMGNDFUT",308,0) + . new tIEN50,gIEN50 +"RTN","TMGNDFUT",309,0) + . set tIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDFUT",310,0) + . if tIEN50>0 do +"RTN","TMGNDFUT",311,0) + . . new name set name=$piece($get(^PSDRUG(tIEN50,0)),"^",1) +"RTN","TMGNDFUT",312,0) + . . set IEN50Array(name,tIEN50)="" +"RTN","TMGNDFUT",313,0) + . set gIEN50=$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDFUT",314,0) + . if gIEN50>0 do +"RTN","TMGNDFUT",315,0) + . . new name set name=$piece($get(^PSDRUG(gIEN50,0)),"^",1) +"RTN","TMGNDFUT",316,0) + . . set IEN50Array(name,gIEN50)="" +"RTN","TMGNDFUT",317,0) + +"RTN","TMGNDFUT",318,0) + ;"set ActiveOnly=1 +"RTN","TMGNDFUT",319,0) + ;"kill IEN50Array +"RTN","TMGNDFUT",320,0) + ;"new temp merge temp=^PSDRUG("ASP",IEN50d7) +"RTN","TMGNDFUT",321,0) + ;"new IEN set IEN="" +"RTN","TMGNDFUT",322,0) + ;"for set IEN=$order(temp(IEN)) quit:(IEN="") do +"RTN","TMGNDFUT",323,0) + ;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="") +"RTN","TMGNDFUT",324,0) + ;". if ActiveOnly,(Active=0) quit +"RTN","TMGNDFUT",325,0) + ;". new name set name=$$GET1^DIQ(50,IEN_",",.01) quit:(name="") +"RTN","TMGNDFUT",326,0) + ;". ;"set name="(#"_IEN_") "_name +"RTN","TMGNDFUT",327,0) + ;". new route set route=$$GET1^DIQ(50,IEN_",",62.02) +"RTN","TMGNDFUT",328,0) + ;". if route'="" set name=name_" "_route +"RTN","TMGNDFUT",329,0) + ;". set IEN50Array(name,IEN)="" +"RTN","TMGNDFUT",330,0) +GDsDone +"RTN","TMGNDFUT",331,0) + quit +"RTN","TMGNDFUT",332,0) + +"RTN","TMGNDFUT",333,0) + +"RTN","TMGNDFUT",334,0) +GetpDRUGs(IEN50d7,IEN50Array,ActiveOnly) +"RTN","TMGNDFUT",335,0) + ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return linked IEN to +"RTN","TMGNDFUT",336,0) + ;" DRUG file (50) +"RTN","TMGNDFUT",337,0) + ;"Input: IEN50d7 -- IEN in file 50.7 +"RTN","TMGNDFUT",338,0) + ;" IEN50Array -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",339,0) + ;" IEN50Array(IEN50)="" +"RTN","TMGNDFUT",340,0) + ;" IEN50Array(IEN50)="" +"RTN","TMGNDFUT",341,0) + ;" ActiveOnly -- OPTIONAL, Default=1 +"RTN","TMGNDFUT",342,0) + ;"result: none. +"RTN","TMGNDFUT",343,0) + +"RTN","TMGNDFUT",344,0) + set ActiveOnly=$get(ActiveOnly,1) +"RTN","TMGNDFUT",345,0) + new tempA +"RTN","TMGNDFUT",346,0) + merge tempA=^TMG(22706.9,"POIG",IEN50d7) +"RTN","TMGNDFUT",347,0) + merge tempA=^TMG(22706.9,"POIT",IEN50d7) +"RTN","TMGNDFUT",348,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",349,0) + for set IEN22706d9=$order(tempA(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",350,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)=1 do quit; 1= SKIP +"RTN","TMGNDFUT",351,0) + . . if ActiveOnly=1 quit +"RTN","TMGNDFUT",352,0) + . . write " Pointer to PHARMACY ORDERABLE ITEM #",IEN50d7," found in skipped 22706.9 #",IEN22706d9," record!",! +"RTN","TMGNDFUT",353,0) + . new tIEN50,gIEN50 +"RTN","TMGNDFUT",354,0) + . set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDFUT",355,0) + . if tIEN50>0 set IEN50Array(tIEN50)="" +"RTN","TMGNDFUT",356,0) + . set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDFUT",357,0) + . if gIEN50>0 set IEN50Array(gIEN50)="" +"RTN","TMGNDFUT",358,0) + +"RTN","TMGNDFUT",359,0) + ;"set ActiveOnly=1 +"RTN","TMGNDFUT",360,0) + ;"kill IEN50Array +"RTN","TMGNDFUT",361,0) + ;"new temp merge temp=^PSDRUG("ASP",IEN50d7) +"RTN","TMGNDFUT",362,0) + ;"new IEN set IEN="" +"RTN","TMGNDFUT",363,0) + ;"for set IEN=$order(temp(IEN)) quit:(IEN="") do +"RTN","TMGNDFUT",364,0) + ;". new Active set Active=($piece($get(^PSDRUG(IEN,"I")),"^",1)="") +"RTN","TMGNDFUT",365,0) + ;". if ActiveOnly,(Active=0) quit +"RTN","TMGNDFUT",366,0) + ;". set IEN50Array(IEN)="" +"RTN","TMGNDFUT",367,0) + +"RTN","TMGNDFUT",368,0) + quit +"RTN","TMGNDFUT",369,0) + +"RTN","TMGNDFUT",370,0) + +"RTN","TMGNDFUT",371,0) +GetfdaIEN(IEN50) +"RTN","TMGNDFUT",372,0) + ;"Purpose: to return the pointer to the record in 22706.9 that points to IEN50 +"RTN","TMGNDFUT",373,0) + ;"Input: IEN50 -- IEN in 50 +"RTN","TMGNDFUT",374,0) + ;"Results: returns a pointer, or 0 if not found +"RTN","TMGNDFUT",375,0) + +"RTN","TMGNDFUT",376,0) + new result +"RTN","TMGNDFUT",377,0) + set result=+$order(^TMG(22706.9,"DRUG",IEN50,"")) +"RTN","TMGNDFUT",378,0) + if result=0 set result=+$order(^TMG(22706.9,"DRUGT",IEN50,"")) +"RTN","TMGNDFUT",379,0) + quit result +"RTN","TMGNDFUT",380,0) + +"RTN","TMGNDFUT",381,0) + +"RTN","TMGNDFUT",382,0) +GetFDA(IEN50,FDA) +"RTN","TMGNDFUT",383,0) + ;"Purpose: For a given IEN in DRUG file, return linked IEN in +"RTN","TMGNDFUT",384,0) + ;" TMG FDA IMPORT COMPILED file (22706.9) +"RTN","TMGNDFUT",385,0) + ;"Input: IEN50 -- IEN in file 50 (DRUG) +"RTN","TMGNDFUT",386,0) + ;" FDA -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",387,0) + ;" FDA=IEN in 22706.9 +"RTN","TMGNDFUT",388,0) + ;" FDA("NAME")=Name +"RTN","TMGNDFUT",389,0) + ;"result: none. +"RTN","TMGNDFUT",390,0) + +"RTN","TMGNDFUT",391,0) + set FDA=$$GetfdaIEN(IEN50) +"RTN","TMGNDFUT",392,0) + if FDA'=0 set FDA("NAME")=$$GET1^DIQ(22706.9,FDA_",",.04) +"RTN","TMGNDFUT",393,0) + quit +"RTN","TMGNDFUT",394,0) + +"RTN","TMGNDFUT",395,0) + +"RTN","TMGNDFUT",396,0) +GetDRUGIEN(IEN50d7) ;" -- DEPRECIATED. Use GetDRUGs^TMGNDFUT or GetpDRUGs^TMGNDFUT +"RTN","TMGNDFUT",397,0) + ;"Purpose: get linked record in DRUG file (50) for given record in 50.7 +"RTN","TMGNDFUT",398,0) + ;"Input:IEN50d7 -- IEN in 50.7 +"RTN","TMGNDFUT",399,0) + ;"Results: IEN in 50, or 0 if not found +"RTN","TMGNDFUT",400,0) + ;"NOTE: there may well be MULTIPLE records in 50 pointing to record in 50.7 +"RTN","TMGNDFUT",401,0) + ;" This function will only return the FIRST. +"RTN","TMGNDFUT",402,0) + ;" GetDRUGs^TMGNDF4F(IEN50d7,IEN50Array,ActiveOnly) -- will return ALL entries. +"RTN","TMGNDFUT",403,0) + +"RTN","TMGNDFUT",404,0) + new result +"RTN","TMGNDFUT",405,0) + set result=$order(^PSDRUG("ASP",IEN50d7,"")) +"RTN","TMGNDFUT",406,0) + quit result +"RTN","TMGNDFUT",407,0) + +"RTN","TMGNDFUT",408,0) + +"RTN","TMGNDFUT",409,0) +GetpTMG(IEN50d7,TMGArray,ActiveOnly) +"RTN","TMGNDFUT",410,0) + ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs +"RTN","TMGNDFUT",411,0) + ;" in 22706.9 pointing to this +"RTN","TMGNDFUT",412,0) + ;"Input: IEN50d7 -- IEN in file 50.7 +"RTN","TMGNDFUT",413,0) + ;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",414,0) + ;" TMGArray(IEN22706d9)="" +"RTN","TMGNDFUT",415,0) + ;" TMGArray(IEN22706d9)="" +"RTN","TMGNDFUT",416,0) + ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered +"RTN","TMGNDFUT",417,0) + ;"result: none. +"RTN","TMGNDFUT",418,0) + +"RTN","TMGNDFUT",419,0) + merge TMGArray=^TMG(22706.9,"POIG",IEN50d7) +"RTN","TMGNDFUT",420,0) + merge TMGArray=^TMG(22706.9,"POIT",IEN50d7) +"RTN","TMGNDFUT",421,0) + +"RTN","TMGNDFUT",422,0) + if $get(ActiveOnly)=1 do +"RTN","TMGNDFUT",423,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",424,0) + . for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",425,0) + . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip +"RTN","TMGNDFUT",426,0) + . . kill TMGArray(IEN22706d9) +"RTN","TMGNDFUT",427,0) + +"RTN","TMGNDFUT",428,0) + quit +"RTN","TMGNDFUT",429,0) + +"RTN","TMGNDFUT",430,0) + +"RTN","TMGNDFUT",431,0) +Getp1TMG(IEN101d43,TMGArray,ActiveOnly) +"RTN","TMGNDFUT",432,0) + ;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs +"RTN","TMGNDFUT",433,0) + ;" in 22706.9 pointing to this +"RTN","TMGNDFUT",434,0) + ;"Input: IEN101d43 -- IEN in file 101.43 +"RTN","TMGNDFUT",435,0) + ;" IENTMGArray -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",436,0) + ;" TMGArray(IEN22706d9)="" +"RTN","TMGNDFUT",437,0) + ;" TMGArray(IEN22706d9)="" +"RTN","TMGNDFUT",438,0) + ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered +"RTN","TMGNDFUT",439,0) + ;"result: none. +"RTN","TMGNDFUT",440,0) + +"RTN","TMGNDFUT",441,0) + merge TMGArray=^TMG(22706.9,"OIG",IEN101d43) +"RTN","TMGNDFUT",442,0) + merge TMGArray=^TMG(22706.9,"OIT",IEN101d43) +"RTN","TMGNDFUT",443,0) + +"RTN","TMGNDFUT",444,0) + if $get(ActiveOnly)=1 do +"RTN","TMGNDFUT",445,0) + . new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",446,0) + . for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",447,0) + . . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 quit ;"1=skip +"RTN","TMGNDFUT",448,0) + . . kill TMGArray(IEN22706d9) +"RTN","TMGNDFUT",449,0) + +"RTN","TMGNDFUT",450,0) + quit +"RTN","TMGNDFUT",451,0) + +"RTN","TMGNDFUT",452,0) +Unlock50 +"RTN","TMGNDFUT",453,0) + ;"Purpose: Unlock fields needed to add data to 50 +"RTN","TMGNDFUT",454,0) + +"RTN","TMGNDFUT",455,0) + kill ^DD(50,20,8.5) +"RTN","TMGNDFUT",456,0) + kill ^DD(50,20,9) +"RTN","TMGNDFUT",457,0) + +"RTN","TMGNDFUT",458,0) + kill ^DD(50,21,8.5) +"RTN","TMGNDFUT",459,0) + kill ^DD(50,21,9) +"RTN","TMGNDFUT",460,0) + +"RTN","TMGNDFUT",461,0) + kill ^DD(50,22,8.5) +"RTN","TMGNDFUT",462,0) + kill ^DD(50,22,9) +"RTN","TMGNDFUT",463,0) + +"RTN","TMGNDFUT",464,0) + kill ^DD(50,25,8.5) +"RTN","TMGNDFUT",465,0) + kill ^DD(50,25,9) +"RTN","TMGNDFUT",466,0) + +"RTN","TMGNDFUT",467,0) + kill ^DD(50,29,8.5) +"RTN","TMGNDFUT",468,0) + kill ^DD(50,29,9) +"RTN","TMGNDFUT",469,0) + +"RTN","TMGNDFUT",470,0) + kill ^DD(50,902,8.5) +"RTN","TMGNDFUT",471,0) + kill ^DD(50,902,9) +"RTN","TMGNDFUT",472,0) + +"RTN","TMGNDFUT",473,0) + new node,nodeA,nodeB,node2 +"RTN","TMGNDFUT",474,0) + set node=$get(^DD(50,901,0)) +"RTN","TMGNDFUT",475,0) + set nodeA=$piece(node,"^",1,4) +"RTN","TMGNDFUT",476,0) + set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N) X" +"RTN","TMGNDFUT",477,0) + set node2=nodeA_"^"_nodeB +"RTN","TMGNDFUT",478,0) + set ^DD(50,901,0)=node2 +"RTN","TMGNDFUT",479,0) + +"RTN","TMGNDFUT",480,0) + quit +"RTN","TMGNDFUT",481,0) + +"RTN","TMGNDFUT",482,0) +Lock50 +"RTN","TMGNDFUT",483,0) + ;"Purpose: Return locks removed from Unlock50 in file 50 +"RTN","TMGNDFUT",484,0) + +"RTN","TMGNDFUT",485,0) + set ^DD(50,20,8.5)="^" +"RTN","TMGNDFUT",486,0) + set ^DD(50,20,9)="^" +"RTN","TMGNDFUT",487,0) + +"RTN","TMGNDFUT",488,0) + set ^DD(50,21,8.5)="^" +"RTN","TMGNDFUT",489,0) + set ^DD(50,21,9)="^" +"RTN","TMGNDFUT",490,0) + +"RTN","TMGNDFUT",491,0) + set ^DD(50,22,8.5)="^" +"RTN","TMGNDFUT",492,0) + set ^DD(50,22,9)="^" +"RTN","TMGNDFUT",493,0) + +"RTN","TMGNDFUT",494,0) + set ^DD(50,25,8.5)="^" +"RTN","TMGNDFUT",495,0) + set ^DD(50,25,9)="^" +"RTN","TMGNDFUT",496,0) + +"RTN","TMGNDFUT",497,0) + set ^DD(50,29,8.5)="^" +"RTN","TMGNDFUT",498,0) + set ^DD(50,29,9)="^" +"RTN","TMGNDFUT",499,0) + +"RTN","TMGNDFUT",500,0) + set ^DD(50,902,8.5)="^" +"RTN","TMGNDFUT",501,0) + set ^DD(50,902,9)="^" +"RTN","TMGNDFUT",502,0) + +"RTN","TMGNDFUT",503,0) + new node,nodeA,nodeB +"RTN","TMGNDFUT",504,0) + set node=$get(^DD(50,901,0)) +"RTN","TMGNDFUT",505,0) + set nodeA=$piece(node,"^",1,4) +"RTN","TMGNDFUT",506,0) + set nodeB="K:+X'=X!(X>99999999)!(X<0)!(X?.E1"".""5N.N)!('$P($G(^PSDRUG(DA,""DOS"")),""^"",2)) X" +"RTN","TMGNDFUT",507,0) + set node2=nodeA_"^"_nodeB +"RTN","TMGNDFUT",508,0) + set ^DD(50,901,0)=node2 +"RTN","TMGNDFUT",509,0) + +"RTN","TMGNDFUT",510,0) + quit +"RTN","TMGNDFUT",511,0) + +"RTN","TMGNDFUT",512,0) + +"RTN","TMGNDFUT",513,0) +GetpPOI(IEN50d7,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpOI or GetPOI!! +"RTN","TMGNDFUT",514,0) + ;"Purpose: For a given IEN in PHARMACY ORDERABLE ITEM, return all IENs +"RTN","TMGNDFUT",515,0) + ;" pointing to this, from 22706.9, 50, or 101.43 +"RTN","TMGNDFUT",516,0) + ;"Input: IEN50d7 -- IEN in file 50.7 +"RTN","TMGNDFUT",517,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",518,0) + ;" Array(File,IENS,field)="" +"RTN","TMGNDFUT",519,0) + ;" Array(File,IENS,field)="" +"RTN","TMGNDFUT",520,0) + ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered +"RTN","TMGNDFUT",521,0) + ;" *** NOT FULLY IMPLEMENTED YET *** +"RTN","TMGNDFUT",522,0) + ;"result: none. +"RTN","TMGNDFUT",523,0) + +"RTN","TMGNDFUT",524,0) + new TMGFDA,TMGMSG +"RTN","TMGNDFUT",525,0) + set ActiveOnly=$get(ActiveOnly,0) +"RTN","TMGNDFUT",526,0) + +"RTN","TMGNDFUT",527,0) + ;"Get links in 50 to POI record (from 22706.9 Xref) +"RTN","TMGNDFUT",528,0) + new IEN50Array +"RTN","TMGNDFUT",529,0) + do GetpDRUGs(IEN50d7,.IEN50Array,0) +"RTN","TMGNDFUT",530,0) + new IEN50 set IEN50="" +"RTN","TMGNDFUT",531,0) + for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="") do +"RTN","TMGNDFUT",532,0) + . set Array(50,IEN50_",",2.1)="" +"RTN","TMGNDFUT",533,0) + +"RTN","TMGNDFUT",534,0) + ;"Get links in 50 to POI record (from 50 ASP Xref) +"RTN","TMGNDFUT",535,0) + new temp merge temp=^PSDRUG("ASP",IEN50d7) +"RTN","TMGNDFUT",536,0) + set IEN50="" +"RTN","TMGNDFUT",537,0) + for set IEN50=$order(temp(IEN50)) quit:(IEN50="") do +"RTN","TMGNDFUT",538,0) + . new Active set Active=($piece($get(^PSDRUG(IEN50,"I")),"^",1)="") +"RTN","TMGNDFUT",539,0) + . if (ActiveOnly=1)&(Active=0) quit +"RTN","TMGNDFUT",540,0) + . set Array(50,IEN50_",",2.1)="" +"RTN","TMGNDFUT",541,0) + +"RTN","TMGNDFUT",542,0) + ;"Get pointers in 22706.9 to POI record +"RTN","TMGNDFUT",543,0) + new TMGArray +"RTN","TMGNDFUT",544,0) + do GetpTMG(IEN50d7,.TMGArray,ActiveOnly) +"RTN","TMGNDFUT",545,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",546,0) + for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",547,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)=IEN50d7 do +"RTN","TMGNDFUT",548,0) + . . set Array(22706.9,IEN22706d9_",",5.61)="" +"RTN","TMGNDFUT",549,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)=IEN50d7 do +"RTN","TMGNDFUT",550,0) + . . set Array(22706.9,IEN22706d9_",",5.71)="" +"RTN","TMGNDFUT",551,0) + +"RTN","TMGNDFUT",552,0) + ;"Get text pointers in 101.43 to POI record +"RTN","TMGNDFUT",553,0) + new ID set ID=IEN50d7_";99PSP" +"RTN","TMGNDFUT",554,0) + new IEN101d43 set IEN101d43="" +"RTN","TMGNDFUT",555,0) + for set IEN101d43=$order(^ORD(101.43,"ID",ID,IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDFUT",556,0) + . set Array(101.43,IEN101d43_",",2)="@" +"RTN","TMGNDFUT",557,0) + +"RTN","TMGNDFUT",558,0) + quit +"RTN","TMGNDFUT",559,0) + +"RTN","TMGNDFUT",560,0) + +"RTN","TMGNDFUT",561,0) +GetpOI(IEN101d43,Array,ActiveOnly) ;"!! NOTE: this is DIFFERENT from GetpPOI!! +"RTN","TMGNDFUT",562,0) + ;"Purpose: For a given IEN in ORDERABLE ITEM, return all IENs +"RTN","TMGNDFUT",563,0) + ;" pointing to this, from 22706.9, 50.7 101.44 +"RTN","TMGNDFUT",564,0) + ;"Input: IEN101d43 -- IEN in file 101.43 +"RTN","TMGNDFUT",565,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Format: +"RTN","TMGNDFUT",566,0) + ;" Array(File,IENS,field)="" +"RTN","TMGNDFUT",567,0) + ;" Array(File,IENS,field)="" +"RTN","TMGNDFUT",568,0) + ;" Array(File,IENS,"N/A")="" for 50.7 'pointers' +"RTN","TMGNDFUT",569,0) + ;" ActiveOnly -- OPTIONAL, Default=1 Only non-skipped records considered +"RTN","TMGNDFUT",570,0) + ;" *** NOT FULLY IMPLEMENTED YET *** +"RTN","TMGNDFUT",571,0) + ;"result: none. +"RTN","TMGNDFUT",572,0) + ;"Note: there is no direct pointer 50.7 --> 101.43 +"RTN","TMGNDFUT",573,0) + ;" Will use 101.43 <-- 22706.9 --> 50.7 to get 50.7 --> 101.43 +"RTN","TMGNDFUT",574,0) + +"RTN","TMGNDFUT",575,0) + new TMGFDA,TMGMSG +"RTN","TMGNDFUT",576,0) + set ActiveOnly=$get(ActiveOnly,0) +"RTN","TMGNDFUT",577,0) + +"RTN","TMGNDFUT",578,0) + ;"Get Pointers 101.44 --> 101.43 +"RTN","TMGNDFUT",579,0) + new all +"RTN","TMGNDFUT",580,0) + if $$GetOQVIENS(IEN101d43,.all)>0 do +"RTN","TMGNDFUT",581,0) + . new IENS set IENS="" +"RTN","TMGNDFUT",582,0) + . for set IENS=$order(all(IENS)) quit:(IENS="") do +"RTN","TMGNDFUT",583,0) + . . set Array(101.442,IENS,.01)="" +"RTN","TMGNDFUT",584,0) + +"RTN","TMGNDFUT",585,0) + ;"Get pointers in 22706.9 to 101.43/OI record +"RTN","TMGNDFUT",586,0) + ;" use to create pseudo pointers 50.7 --> 101.43 +"RTN","TMGNDFUT",587,0) + new TMGArray +"RTN","TMGNDFUT",588,0) + do Getp1TMG(IEN101d43,.TMGArray,ActiveOnly) +"RTN","TMGNDFUT",589,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",590,0) + for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",591,0) + . set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3) ;"TRADE POI +"RTN","TMGNDFUT",592,0) + . if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")="" +"RTN","TMGNDFUT",593,0) + . set IEN50d7=+$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4) ;"GENERIC POI +"RTN","TMGNDFUT",594,0) + . if IEN50d7>0 set Array(50.7,IEN50d7_",","N/A")="" +"RTN","TMGNDFUT",595,0) + +"RTN","TMGNDFUT",596,0) + ;"Get Pointers in 22706.9 --> 101.43 +"RTN","TMGNDFUT",597,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",598,0) + for set IEN22706d9=$order(TMGArray(IEN22706d9)) quit:(IEN22706d9="") do +"RTN","TMGNDFUT",599,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)=IEN101d43 do +"RTN","TMGNDFUT",600,0) + . . set Array(22706.9,IEN22706d9_",",5.611)="" +"RTN","TMGNDFUT",601,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)=IEN101d43 do +"RTN","TMGNDFUT",602,0) + . . set Array(22706.9,IEN22706d9_",",5.711)="" +"RTN","TMGNDFUT",603,0) + +"RTN","TMGNDFUT",604,0) + quit +"RTN","TMGNDFUT",605,0) + +"RTN","TMGNDFUT",606,0) + +"RTN","TMGNDFUT",607,0) +RedirOI(oldIEN,newIEN) +"RTN","TMGNDFUT",608,0) + ;"Purpose: to redirect pointers to ORDERABLE ITEM file from oldIEN to newIEN +"RTN","TMGNDFUT",609,0) + ;"Input: oldIEN -- IEN in ORDABLE ITEM (101.44) to switch FROM +"RTN","TMGNDFUT",610,0) + ;" newIEN -- IEN in ORDABLE ITEM (101.44) to switch TO +"RTN","TMGNDFUT",611,0) + ;"results: none. +"RTN","TMGNDFUT",612,0) + +"RTN","TMGNDFUT",613,0) + new Array +"RTN","TMGNDFUT",614,0) + do GetpOI(oldIEN,.Array) +"RTN","TMGNDFUT",615,0) + ;"redirect pointers to this record held in other files (50.7, 22706.9, or 101.442) +"RTN","TMGNDFUT",616,0) + new file set file="" +"RTN","TMGNDFUT",617,0) + for set file=$order(Array(file)) quit:(file="") do +"RTN","TMGNDFUT",618,0) + . new IENS set IENS="" +"RTN","TMGNDFUT",619,0) + . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do +"RTN","TMGNDFUT",620,0) + . . new field set field="" +"RTN","TMGNDFUT",621,0) + . . for set field=$order(Array(file,IENS,field)) quit:(field="") do +"RTN","TMGNDFUT",622,0) + . . . if +field'=field quit ;"avoid "N/A" +"RTN","TMGNDFUT",623,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",624,0) + . . . set TMGFDA(file,IENS,field)=newIEN +"RTN","TMGNDFUT",625,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",626,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",627,0) + +"RTN","TMGNDFUT",628,0) + quit +"RTN","TMGNDFUT",629,0) + +"RTN","TMGNDFUT",630,0) + +"RTN","TMGNDFUT",631,0) +FindPOI(DrugNAF) +"RTN","TMGNDFUT",632,0) + ;"Purpose: to return IEN in PHARMACY ORDERABLE ITEM (50.7) matching drug name +"RTN","TMGNDFUT",633,0) + ;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB) +"RTN","TMGNDFUT",634,0) + ;"results: IEN in 50.7, or 0 if not found +"RTN","TMGNDFUT",635,0) + ;"Note: this will only return the FIRST such match. +"RTN","TMGNDFUT",636,0) + ;" Also, this is an EXACT match only. +"RTN","TMGNDFUT",637,0) + +"RTN","TMGNDFUT",638,0) + new result +"RTN","TMGNDFUT",639,0) + set result=+$order(^PS(50.7,"B",DrugNAF,"")) +"RTN","TMGNDFUT",640,0) + quit result +"RTN","TMGNDFUT",641,0) + +"RTN","TMGNDFUT",642,0) + +"RTN","TMGNDFUT",643,0) +FindOI(DrugNAF) +"RTN","TMGNDFUT",644,0) + ;"Purpose: to return IEN in ORDERABLE ITEM (101.43) matching drug name +"RTN","TMGNDFUT",645,0) + ;"Input: DrugNAF -- Drug name and form (e.g. LISINOPRIL TAB) +"RTN","TMGNDFUT",646,0) + ;"results: IEN in 101.43, or 0 if not found +"RTN","TMGNDFUT",647,0) + ;"Note: this will only return the FIRST such match. +"RTN","TMGNDFUT",648,0) + ;" Also, this is an EXACT match only. +"RTN","TMGNDFUT",649,0) + +"RTN","TMGNDFUT",650,0) + new result +"RTN","TMGNDFUT",651,0) + set result=+$order(^ORD(101.43,"B",DrugNAF,"")) +"RTN","TMGNDFUT",652,0) + quit result +"RTN","TMGNDFUT",653,0) + +"RTN","TMGNDFUT",654,0) + +"RTN","TMGNDFUT",655,0) +Kill50(IEN50,IEN22706d9,mode,quiet) +"RTN","TMGNDFUT",656,0) + ;"Purpose: to delete entry in file 50, and also links to it from 22706.9 +"RTN","TMGNDFUT",657,0) + ;"Input: IEN50 -- IEN in file 50 +"RTN","TMGNDFUT",658,0) + ;" IEN22706d9 -- IEn in 22706.9 +"RTN","TMGNDFUT",659,0) + ;" mode -- OPTIONAL-- "TRADE" or "GENERIC" +"RTN","TMGNDFUT",660,0) + ;" quiet -- OPTIONAL -- 1 = no message +"RTN","TMGNDFUT",661,0) + ;"Results: none +"RTN","TMGNDFUT",662,0) + ;"NOTE: Since file 50 is the head of a chain of drugs, it does not make +"RTN","TMGNDFUT",663,0) + ;" sense for 22706.9 to have a 0 pointer to 50, but still have pointers +"RTN","TMGNDFUT",664,0) + ;" to other entries in the chain (parts of which might be used by other +"RTN","TMGNDFUT",665,0) + ;" drugs). So I will also delete pointers to 50.7 and 101.43 +"RTN","TMGNDFUT",666,0) + ;" This could leave dangling records. I guess I will have to deal +"RTN","TMGNDFUT",667,0) + ;" with this elsewhere. +"RTN","TMGNDFUT",668,0) + ;" -- I WILL be deleting records in 50.7 (if not pointed to by other drugs) +"RTN","TMGNDFUT",669,0) + +"RTN","TMGNDFUT",670,0) + set IEN50=+$get(IEN50) +"RTN","TMGNDFUT",671,0) + if IEN50=0 goto K50Done +"RTN","TMGNDFUT",672,0) + +"RTN","TMGNDFUT",673,0) + set mode=$get(mode) +"RTN","TMGNDFUT",674,0) + set quiet=$get(quiet) +"RTN","TMGNDFUT",675,0) + +"RTN","TMGNDFUT",676,0) + ;"Get pointer to next link in chain, before deleting this link +"RTN","TMGNDFUT",677,0) + new IEN50d7 ;"50.7 = PHARMACY ORDERABLE ITEM. +"RTN","TMGNDFUT",678,0) + set IEN50d7=+$piece($get(^PSDRUG(IEN50,2)),"^",1) +"RTN","TMGNDFUT",679,0) + +"RTN","TMGNDFUT",680,0) + new TMGFDA,TMGMSG +"RTN","TMGNDFUT",681,0) + if (IEN50>0)&($data(^PSDRUG(IEN50))>0) do +"RTN","TMGNDFUT",682,0) + . set TMGFDA(50,IEN50_",",.01)="@" +"RTN","TMGNDFUT",683,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",684,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",685,0) + . if 'quiet write !,"DRUG entry (#",IEN50,") deleted: ",$get(DrugInfo("NAME",mode)) +"RTN","TMGNDFUT",686,0) + +"RTN","TMGNDFUT",687,0) + if mode="" do +"RTN","TMGNDFUT",688,0) + . new tIEN50 set tIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1) +"RTN","TMGNDFUT",689,0) + . new gIEN50 set gIEN50=+$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2) +"RTN","TMGNDFUT",690,0) + . if tIEN50=IEN50 set mode="TRADE" quit +"RTN","TMGNDFUT",691,0) + . if gIEN50=IEN50 set mode="GENERIC" quit +"RTN","TMGNDFUT",692,0) + +"RTN","TMGNDFUT",693,0) + if mode="TRADE" do +"RTN","TMGNDFUT",694,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",1)>0 do +"RTN","TMGNDFUT",695,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.6)="@" +"RTN","TMGNDFUT",696,0) + . . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",697,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",3)>0 do +"RTN","TMGNDFUT",698,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.61)="@" +"RTN","TMGNDFUT",699,0) + . . if 'quiet write " Link to trade POI from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",700,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",5)>0 do +"RTN","TMGNDFUT",701,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.611)="@" +"RTN","TMGNDFUT",702,0) + . . if 'quiet write " Link to trade OI from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",703,0) + . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDFUT",704,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDFUT",705,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",706,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",707,0) + +"RTN","TMGNDFUT",708,0) + if mode="GENERIC" do +"RTN","TMGNDFUT",709,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,7)),"^",2)>0 do +"RTN","TMGNDFUT",710,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.7)="@" +"RTN","TMGNDFUT",711,0) + . . if 'quiet write " Link to trade drug from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",712,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",4)>0 do +"RTN","TMGNDFUT",713,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.71)="@" +"RTN","TMGNDFUT",714,0) + . . if 'quiet write " Link to generic POI from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",715,0) + . if +$piece($get(^TMG(22706.9,IEN22706d9,8)),"^",6)>0 do +"RTN","TMGNDFUT",716,0) + . . set TMGFDA(22706.9,IEN22706d9_",",5.711)="@" +"RTN","TMGNDFUT",717,0) + . . if 'quiet write " Link to generic OI from import #",IEN22706d9," removed.",! +"RTN","TMGNDFUT",718,0) + . new temp set temp=$$TrimFDA^TMGDBAPI(.TMGFDA) +"RTN","TMGNDFUT",719,0) + . if $data(TMGFDA)=0 quit +"RTN","TMGNDFUT",720,0) + . do FILE^DIE("K","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",721,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",722,0) + +"RTN","TMGNDFUT",723,0) + ;"See if any other DRUGs(50) are pointing to POI (50.7). If not kill POI +"RTN","TMGNDFUT",724,0) + if $order(^PSDRUG("ASP",IEN50d7,""))="" do +"RTN","TMGNDFUT",725,0) + . do KillPOI(IEN50d7) ;"will link forward to kill the rest of the chain +"RTN","TMGNDFUT",726,0) + +"RTN","TMGNDFUT",727,0) +K50Done quit +"RTN","TMGNDFUT",728,0) + +"RTN","TMGNDFUT",729,0) + +"RTN","TMGNDFUT",730,0) +KillPOI(IEN50d7) +"RTN","TMGNDFUT",731,0) + ;"Purpose: to remove a PHARMACY ORDERABLE ITEM (50.7), along with pointers +"RTN","TMGNDFUT",732,0) + ;" to it from files 50, 22706.9, 101.43 +"RTN","TMGNDFUT",733,0) + ;"NOTE: This function will also call subsequent functions to +"RTN","TMGNDFUT",734,0) + ;" kill records chained records in 101.43,101.44 +"RTN","TMGNDFUT",735,0) + ;"Results: none +"RTN","TMGNDFUT",736,0) + +"RTN","TMGNDFUT",737,0) + set IEN50d7=+$get(IEN50d7) +"RTN","TMGNDFUT",738,0) + if IEN50d7=0 goto KPOIdone +"RTN","TMGNDFUT",739,0) + ;"Get array of pointers to OI's from this POI record +"RTN","TMGNDFUT",740,0) + new OIArray,temp +"RTN","TMGNDFUT",741,0) + set temp=$$GetOI(IEN50d7,.OIArray) +"RTN","TMGNDFUT",742,0) + +"RTN","TMGNDFUT",743,0) + new Array +"RTN","TMGNDFUT",744,0) + do GetpPOI(IEN50d7,.Array,0) +"RTN","TMGNDFUT",745,0) + +"RTN","TMGNDFUT",746,0) + new PSSZ set PSSZ=1 ;"Key for editing 50 (?) +"RTN","TMGNDFUT",747,0) + do Unlock50 ;"if I relock here, may lock another function out. Will leave unlocked +"RTN","TMGNDFUT",748,0) + +"RTN","TMGNDFUT",749,0) + ;"Delete pointers to this record held in other files (50, 22706.9, or 101.43) +"RTN","TMGNDFUT",750,0) + new file set file="" +"RTN","TMGNDFUT",751,0) + for set file=$order(Array(file)) quit:(file="") do +"RTN","TMGNDFUT",752,0) + . if file=101.43 quit ;"ignore these, to be handled below +"RTN","TMGNDFUT",753,0) + . new IENS set IENS="" +"RTN","TMGNDFUT",754,0) + . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do +"RTN","TMGNDFUT",755,0) + . . new field set field="" +"RTN","TMGNDFUT",756,0) + . . for set field=$order(Array(file,IENS,field)) quit:(field="") do +"RTN","TMGNDFUT",757,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",758,0) + . . . set TMGFDA(file,IENS,field)="@" +"RTN","TMGNDFUT",759,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",760,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",761,0) + +"RTN","TMGNDFUT",762,0) + ;"Delete the record itself. +"RTN","TMGNDFUT",763,0) + if $data(^PS(50.7,IEN50d7))'=0 do +"RTN","TMGNDFUT",764,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",765,0) + . set TMGFDA(50.7,IEN50d7_",",.01)="@" +"RTN","TMGNDFUT",766,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",767,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",768,0) + +"RTN","TMGNDFUT",769,0) + ;"Kill chained records in OI +"RTN","TMGNDFUT",770,0) + new IEN101d43 set IEN101d43="" +"RTN","TMGNDFUT",771,0) + for set IEN101d43=$order(OIArray(IEN101d43)) quit:(IEN101d43="") do +"RTN","TMGNDFUT",772,0) + . do KillOI(IEN101d43) ;"Will chain forward to delete further records in chain. +"RTN","TMGNDFUT",773,0) + +"RTN","TMGNDFUT",774,0) +KPOIdone +"RTN","TMGNDFUT",775,0) + quit +"RTN","TMGNDFUT",776,0) + +"RTN","TMGNDFUT",777,0) + +"RTN","TMGNDFUT",778,0) +KillOI(IEN101d43) +"RTN","TMGNDFUT",779,0) + ;"Purpose: to remove an ORDERABLE ITEM, along with pointers to it +"RTN","TMGNDFUT",780,0) + ;" from files 50.7, 22706.9, 101.44 +"RTN","TMGNDFUT",781,0) + ;"Results: none +"RTN","TMGNDFUT",782,0) + +"RTN","TMGNDFUT",783,0) + set IEN101d43=+$get(IEN101d43) +"RTN","TMGNDFUT",784,0) + if IEN101d43=0 goto KOIDone +"RTN","TMGNDFUT",785,0) + +"RTN","TMGNDFUT",786,0) + new Array +"RTN","TMGNDFUT",787,0) + do GetpOI(IEN101d43,.Array,0) +"RTN","TMGNDFUT",788,0) + +"RTN","TMGNDFUT",789,0) + ;"Delete pointers to this record held in other files (50.7, 22706.9, or 101.442) +"RTN","TMGNDFUT",790,0) + new file set file="" +"RTN","TMGNDFUT",791,0) + for set file=$order(Array(file)) quit:(file="") do +"RTN","TMGNDFUT",792,0) + . if file=101.442 quit ;" ignore these... will handle below +"RTN","TMGNDFUT",793,0) + . new IENS set IENS="" +"RTN","TMGNDFUT",794,0) + . for set IENS=$order(Array(file,IENS)) quit:(IENS="") do +"RTN","TMGNDFUT",795,0) + . . new field set field="" +"RTN","TMGNDFUT",796,0) + . . for set field=$order(Array(file,IENS,field)) quit:(field="") do +"RTN","TMGNDFUT",797,0) + . . . if +field'=field quit ;"avoid "N/A" +"RTN","TMGNDFUT",798,0) + . . . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",799,0) + . . . set TMGFDA(file,IENS,field)="@" +"RTN","TMGNDFUT",800,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",801,0) + . . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",802,0) + +"RTN","TMGNDFUT",803,0) + ;"Delete record in 101.43 +"RTN","TMGNDFUT",804,0) + if $data(^ORD(101.43,IEN101d43))'=0 do +"RTN","TMGNDFUT",805,0) + . new TMGFDA,TMGMSG +"RTN","TMGNDFUT",806,0) + . set TMGFDA(101.43,IEN101d43_",",.01)="@" +"RTN","TMGNDFUT",807,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",808,0) + . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",809,0) + +"RTN","TMGNDFUT",810,0) + ;"Delete chained records in 101.44 +"RTN","TMGNDFUT",811,0) + new OQVIENS set OQVIENS="" +"RTN","TMGNDFUT",812,0) + for set OQVIENS=$order(Array(101.442,OQVIENS)) quit:(OQVIENS="") do +"RTN","TMGNDFUT",813,0) + . do KillOQV(OQVIENS) +"RTN","TMGNDFUT",814,0) + +"RTN","TMGNDFUT",815,0) +KOIDone quit +"RTN","TMGNDFUT",816,0) + +"RTN","TMGNDFUT",817,0) + +"RTN","TMGNDFUT",818,0) +KillOQV(IENS) +"RTN","TMGNDFUT",819,0) + ;"Purpose: to kill/inactivate entry in ORDER QUICK VIEW (101.44) +"RTN","TMGNDFUT",820,0) + ;"Input: IENS -- the IENS entry locating record to 'kill' +"RTN","TMGNDFUT",821,0) + ;"Results: none +"RTN","TMGNDFUT",822,0) + ;"Note: for now, I am not going to actually delete the record, just +"RTN","TMGNDFUT",823,0) + ;" mark it as deleted +"RTN","TMGNDFUT",824,0) + +"RTN","TMGNDFUT",825,0) + new TMGFDA,TMGMSG +"RTN","TMGNDFUT",826,0) + set TMGFDA(101.442,IENS,.01)=0 +"RTN","TMGNDFUT",827,0) + set TMGFDA(101.442,IENS,2)="" +"RTN","TMGNDFUT",828,0) + do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGNDFUT",829,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGNDFUT",830,0) + +"RTN","TMGNDFUT",831,0) + quit +"RTN","TMGNDFUT",832,0) + +"RTN","TMGNDFUT",833,0) + +"RTN","TMGNDFUT",834,0) +GetOQVIENS(IEN101d43,RxSet,Array) +"RTN","TMGNDFUT",835,0) + ;"Purpose: Scan in ORDER QUICK VIEW (101.44) for pointer to 101.43 +"RTN","TMGNDFUT",836,0) + ;"Input: IEN101d43 -- IEN in ORDERABLE ITEM (101.43) file +"RTN","TMGNDFUT",837,0) + ;" RxSet -- OPTIONAL -- the IEN of the ORWDSET O RX record in 101.44 +"RTN","TMGNDFUT",838,0) + ;" Array -- OPTIONAL. PASS BY REFERNCE. An OUT PARAMETER. +"RTN","TMGNDFUT",839,0) + ;" Will be filled with ALL pointers to 101.43. Format: +"RTN","TMGNDFUT",840,0) + ;" Array(IENS)="" +"RTN","TMGNDFUT",841,0) + ;"Result: IENS pointing to Entry in OQV (e.g. '104,57,'), or 0 if not found +"RTN","TMGNDFUT",842,0) + +"RTN","TMGNDFUT",843,0) + ;"If there happened to be 2 pointers to 101.43, this would only return +"RTN","TMGNDFUT",844,0) + ;" the FIRST one, but Array will return all pointers. +"RTN","TMGNDFUT",845,0) + +"RTN","TMGNDFUT",846,0) + ;"On my initial run index was empty. May need to programatically launch reindex in the future +"RTN","TMGNDFUT",847,0) + +"RTN","TMGNDFUT",848,0) + new result set result=0 +"RTN","TMGNDFUT",849,0) + if +$get(RxSet)=0 set RxSet=$$GetOQVSet +"RTN","TMGNDFUT",850,0) + if RxSet=0 goto GPrDone +"RTN","TMGNDFUT",851,0) + +"RTN","TMGNDFUT",852,0) + new IENS set IENS="" +"RTN","TMGNDFUT",853,0) + new OQVIEN set OQVIEN="" +"RTN","TMGNDFUT",854,0) + for set OQVIEN=$order(^ORD(101.44,RxSet,20,"B",IEN101d43,OQVIEN)) quit:(OQVIEN="") do +"RTN","TMGNDFUT",855,0) + . if +OQVIEN=0 quit +"RTN","TMGNDFUT",856,0) + . new tempIENS set tempIENS=OQVIEN_","_RxSet_"," +"RTN","TMGNDFUT",857,0) + . if result=0 set result=tempIENS +"RTN","TMGNDFUT",858,0) + . set Array(tempIENS)="" +"RTN","TMGNDFUT",859,0) + +"RTN","TMGNDFUT",860,0) +GPrDone quit result +"RTN","TMGNDFUT",861,0) + +"RTN","TMGNDFUT",862,0) + +"RTN","TMGNDFUT",863,0) + +"RTN","TMGNDFUT",864,0) +GetOQVSet(quiet) +"RTN","TMGNDFUT",865,0) + ;"Purpose: get the active RxSet in ORDER QUICK VIEW (101.44) +"RTN","TMGNDFUT",866,0) + ;"Input: quiet -- OPTIONAL. If 1, then no error message +"RTN","TMGNDFUT",867,0) + ;"results: returns RxSet, or 0 if problem. +"RTN","TMGNDFUT",868,0) + +"RTN","TMGNDFUT",869,0) + set quiet=+$get(quiet) +"RTN","TMGNDFUT",870,0) + new DIC,X,Y +"RTN","TMGNDFUT",871,0) + set DIC=101.44 +"RTN","TMGNDFUT",872,0) + set X="ORWDSET O RX" +"RTN","TMGNDFUT",873,0) + do ^DIC +"RTN","TMGNDFUT",874,0) + if +Y'>0 do +"RTN","TMGNDFUT",875,0) + . if quiet quit +"RTN","TMGNDFUT",876,0) + . write "Can't find record 'ORWDSET O RX' in ORDER QUICK VIEW (101.44) file.",! +"RTN","TMGNDFUT",877,0) + +"RTN","TMGNDFUT",878,0) + quit +Y +"RTN","TMGNDFUT",879,0) + +"RTN","TMGNDFUT",880,0) + +"RTN","TMGNDFUT",881,0) +OIInactive(IEN101d43) +"RTN","TMGNDFUT",882,0) + ;"Purpose -- Return if record has a past-due inactive date +"RTN","TMGNDFUT",883,0) + ;"Input: IEN101d43 -- IEn in 101.43 +"RTN","TMGNDFUT",884,0) + ;"Results: 0 -- not inactive, 1 is inactive +"RTN","TMGNDFUT",885,0) + +"RTN","TMGNDFUT",886,0) + new date set date=$piece($get(^ORD(101.43,IEN101d43,.1)),"^",1) +"RTN","TMGNDFUT",887,0) + new pastInactiveDate set pastInactiveDate=0 +"RTN","TMGNDFUT",888,0) + if date'="" do +"RTN","TMGNDFUT",889,0) + . new X,Y set X="NOW" do ^%DT ;"results in Y +"RTN","TMGNDFUT",890,0) + . new X1,X2 +"RTN","TMGNDFUT",891,0) + . set X1=Y,X2=date +"RTN","TMGNDFUT",892,0) + . do ^%DTC ;"result is X=X1-X2 (X=NOW-InactiveDate) X>-1 means past inactive date +"RTN","TMGNDFUT",893,0) + . set pastInactiveDate=(X>-1) +"RTN","TMGNDFUT",894,0) + +"RTN","TMGNDFUT",895,0) + quit pastInactiveDate +"RTN","TMGNDFUT",896,0) + +"RTN","TMGNDFUT",897,0) + +"RTN","TMGNDFUT",898,0) +IsImport(IEN50d7) +"RTN","TMGNDFUT",899,0) + ;"Purpose: To determine if the POI record is one linked to a FDA import +"RTN","TMGNDFUT",900,0) + ;"Input: IEN50d7 -- IEN in 50.7 +"RTN","TMGNDFUT",901,0) + ;"Results: 1 if linked to a DRUG entry that is linked to an NON-SKIPPED +"RTN","TMGNDFUT",902,0) + ;" record in 22706.9 +"RTN","TMGNDFUT",903,0) + ;" 0 otherwise +"RTN","TMGNDFUT",904,0) + ;"Addendum: This function will be changed slightly, to such that it returns +"RTN","TMGNDFUT",905,0) + ;" 1 if linked to an entry in 22706.9 that is NON-SKIPPED +"RTN","TMGNDFUT",906,0) + +"RTN","TMGNDFUT",907,0) + new result set result=0 +"RTN","TMGNDFUT",908,0) + new IEN22706d9 set IEN22706d9="" +"RTN","TMGNDFUT",909,0) + for set IEN22706d9=$order(^TMG(22706.9,"POIT",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do +"RTN","TMGNDFUT",910,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1 +"RTN","TMGNDFUT",911,0) + +"RTN","TMGNDFUT",912,0) + if result=1 goto IIDone +"RTN","TMGNDFUT",913,0) + +"RTN","TMGNDFUT",914,0) + for set IEN22706d9=$order(^TMG(22706.9,"POIG",IEN50d7,IEN22706d9)) quit:(IEN22706d9="")!(result=1) do +"RTN","TMGNDFUT",915,0) + . if $piece($get(^TMG(22706.9,IEN22706d9,1)),"^",4)'=1 set result=1 +"RTN","TMGNDFUT",916,0) + +"RTN","TMGNDFUT",917,0) + goto IIDone +"RTN","TMGNDFUT",918,0) + +"RTN","TMGNDFUT",919,0) + ;"==== old code, delete later +"RTN","TMGNDFUT",920,0) + new result set result=0 +"RTN","TMGNDFUT",921,0) + new IEN50Array +"RTN","TMGNDFUT",922,0) + do GetpDRUGs^TMGNDFUT(IEN50d7,.IEN50Array,1) +"RTN","TMGNDFUT",923,0) + new IEN50 set IEN50="" +"RTN","TMGNDFUT",924,0) + for set IEN50=$order(IEN50Array(IEN50)) quit:(IEN50="")!(result=1) do +"RTN","TMGNDFUT",925,0) + . new fdaIEN set fdaIEN=$$GetfdaIEN^TMGNDFUT(IEN50) if fdaIEN'>0 quit +"RTN","TMGNDFUT",926,0) + . if $piece($get(^TMG(22706.9,fdaIEN,1)),"^",4)'=1 set result=1 +"RTN","TMGNDFUT",927,0) +IIDone +"RTN","TMGNDFUT",928,0) + quit result +"RTN","TMGNDFUT",929,0) + +"RTN","TMGNDFUT",930,0) + +"RTN","TMGPRNTR") +0^66^B9035 +"RTN","TMGPRNTR",1,0) +TMGPRNTR ;TMG/kst/Printer API Fns ;03/25/06 +"RTN","TMGPRNTR",2,0) + ;;1.0;TMG-LIB;**1**;04/25/04 +"RTN","TMGPRNTR",3,0) + +"RTN","TMGPRNTR",4,0) + ;"TMG PRINTER API FUNCTIONS +"RTN","TMGPRNTR",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGPRNTR",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGPRNTR",7,0) + +"RTN","TMGPRNTR",8,0) + ;"======================================================================= +"RTN","TMGPRNTR",9,0) + ;" API -- Public Functions. +"RTN","TMGPRNTR",10,0) + ;"======================================================================= +"RTN","TMGPRNTR",11,0) + +"RTN","TMGPRNTR",12,0) + ;"MatchPrt(Printers) +"RTN","TMGPRNTR",13,0) + +"RTN","TMGPRNTR",14,0) + ;"======================================================================= +"RTN","TMGPRNTR",15,0) + ;" Functions Used During Printing Process +"RTN","TMGPRNTR",16,0) + ;"======================================================================= +"RTN","TMGPRNTR",17,0) + ;"SETJOB(Filename) +"RTN","TMGPRNTR",18,0) + ;"FINISH(Printer) +"RTN","TMGPRNTR",19,0) + +"RTN","TMGPRNTR",20,0) + +"RTN","TMGPRNTR",21,0) + ;"Dependancies +"RTN","TMGPRNTR",22,0) + ;" TMGXDLG.m +"RTN","TMGPRNTR",23,0) + ;"======================================================================= +"RTN","TMGPRNTR",24,0) + ;"Private Functions +"RTN","TMGPRNTR",25,0) + ;"======================================================================= +"RTN","TMGPRNTR",26,0) + ;"GetPrinters^TMGPRNTR(Printers) +"RTN","TMGPRNTR",27,0) + ;"GetPrtDefs(PrtDefs) +"RTN","TMGPRNTR",28,0) + ;"PickPrtDef(LinuxPrt,PrtDefs,Output) +"RTN","TMGPRNTR",29,0) + +"RTN","TMGPRNTR",30,0) + +"RTN","TMGPRNTR",31,0) + +"RTN","TMGPRNTR",32,0) +GetPrinters(Printers) +"RTN","TMGPRNTR",33,0) + ;"Purpose: To interact with Redhat 9 Linux printer system and get a list +"RTN","TMGPRNTR",34,0) + ;" of defined printers +"RTN","TMGPRNTR",35,0) + ;"Input: (Printers is an OUT variable. MUST PASS BY REFERENCE +"RTN","TMGPRNTR",36,0) + ;"Output: Printers variable will be filled like this: +"RTN","TMGPRNTR",37,0) + ;" Printers(0,"COUNT")=2 +"RTN","TMGPRNTR",38,0) + ;" Printers(1)="Deskjet1" +"RTN","TMGPRNTR",39,0) + ;" Printers(2)="Laser1" +"RTN","TMGPRNTR",40,0) + ;"result: 1=OkToCont 0=Abort +"RTN","TMGPRNTR",41,0) + +"RTN","TMGPRNTR",42,0) + ;"Notes: Here is a simple way to get the available printers from the CUPS system +"RTN","TMGPRNTR",43,0) + ;"#lpstat -p >/tmp/DefinedPrinters.txt +"RTN","TMGPRNTR",44,0) + ;"#cat DefinedPrinters.txt +"RTN","TMGPRNTR",45,0) + ;"printer Laser is idle. enabled since Jan 01 00:00 +"RTN","TMGPRNTR",46,0) + ;"--notice that in this case "Laser" is the name of the printer. There is only 1 printer. +"RTN","TMGPRNTR",47,0) + ;"This printer could be used like this: +"RTN","TMGPRNTR",48,0) + ;"lp -d Laser MyFile.txt +"RTN","TMGPRNTR",49,0) + +"RTN","TMGPRNTR",50,0) + +"RTN","TMGPRNTR",51,0) + new Cmd,HookCmd +"RTN","TMGPRNTR",52,0) + new FileHandle +"RTN","TMGPRNTR",53,0) + new CmdResult +"RTN","TMGPRNTR",54,0) + new lpReport +"RTN","TMGPRNTR",55,0) + new index,PrtIndex +"RTN","TMGPRNTR",56,0) + new PrinterCount set PrinterCount=0 +"RTN","TMGPRNTR",57,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGPRNTR",58,0) + new cAbort set cAbort=0 +"RTN","TMGPRNTR",59,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPRNTR",60,0) + +"RTN","TMGPRNTR",61,0) + new result set result=cOKToCont +"RTN","TMGPRNTR",62,0) + +"RTN","TMGPRNTR",63,0) + if TMGDEBUG>0 do Entry^TMGDEBUG(.DBIndent,"GetPrinters") +"RTN","TMGPRNTR",64,0) + +"RTN","TMGPRNTR",65,0) + new CommFPath set CommFPath="/tmp/" +"RTN","TMGPRNTR",66,0) + new CommFName set CommFName="M_Printer_comm_"_$J_".tmp" +"RTN","TMGPRNTR",67,0) + new CommFile set CommFile=CommFPath_CommFName +"RTN","TMGPRNTR",68,0) + +"RTN","TMGPRNTR",69,0) + set HookCmd="lpstat -p>"_CommFile +"RTN","TMGPRNTR",70,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGPRNTR",71,0) + zsystem HookCmd +"RTN","TMGPRNTR",72,0) + +"RTN","TMGPRNTR",73,0) + set CmdResult=$ZSYSTEM&255 ;"get result of execution. (low byte only) +"RTN","TMGPRNTR",74,0) + ;"write "CmdResult=",CmdResult,! ;"1=error +"RTN","TMGPRNTR",75,0) + if CmdResult=0 set result=cOKToCont else set result=cAbort goto GPDone +"RTN","TMGPRNTR",76,0) + +"RTN","TMGPRNTR",77,0) + ;"Read output info Results +"RTN","TMGPRNTR",78,0) + set FileHandle=$$FTG^%ZISH(CommFPath,CommFName,$name(lpReport("LIST")),3) +"RTN","TMGPRNTR",79,0) + ;"zwr lpReport(*) +"RTN","TMGPRNTR",80,0) + +"RTN","TMGPRNTR",81,0) + ;"Now kill the communication file... no longer needed. +"RTN","TMGPRNTR",82,0) + new FileSpec +"RTN","TMGPRNTR",83,0) + set FileSpec(CommFile)="" +"RTN","TMGPRNTR",84,0) + set result=$$DEL^%ZISH(CommFPath,$name(FileSpec)) +"RTN","TMGPRNTR",85,0) + +"RTN","TMGPRNTR",86,0) + set index="" +"RTN","TMGPRNTR",87,0) + for do quit:(index="") +"RTN","TMGPRNTR",88,0) + . new s +"RTN","TMGPRNTR",89,0) + . set s=$get(lpReport("LIST",index)) +"RTN","TMGPRNTR",90,0) + . if s="" quit +"RTN","TMGPRNTR",91,0) + . new Prt set Prt=$piece(s," ",2) +"RTN","TMGPRNTR",92,0) + . if Prt'="" do +"RTN","TMGPRNTR",93,0) + . . set PrinterCount=PrinterCount+1 +"RTN","TMGPRNTR",94,0) + . . set Printers(PrinterCount)=Prt +"RTN","TMGPRNTR",95,0) + . set index=$order(lpReport("LIST",index)) +"RTN","TMGPRNTR",96,0) + +"RTN","TMGPRNTR",97,0) + ;"if $data(Printers) zwr Printers(*) +"RTN","TMGPRNTR",98,0) + ;"w "done" +"RTN","TMGPRNTR",99,0) + +"RTN","TMGPRNTR",100,0) +GPDone +"RTN","TMGPRNTR",101,0) + set Printers(0,"COUNT")=PrinterCount +"RTN","TMGPRNTR",102,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrinters") +"RTN","TMGPRNTR",103,0) + +"RTN","TMGPRNTR",104,0) + quit result +"RTN","TMGPRNTR",105,0) + +"RTN","TMGPRNTR",106,0) + +"RTN","TMGPRNTR",107,0) +GetPrtDefs(PrtDefs) +"RTN","TMGPRNTR",108,0) + ;"Purpose: To get a list of printer definitions (i.e. TERMINAL TYPES) +"RTN","TMGPRNTR",109,0) + ;"Input: PrtDefs -- SHOULD BE PASSED BY REFERENCE to receive results. +"RTN","TMGPRNTR",110,0) + ;"Output: (PrtDefs is changed) +"RTN","TMGPRNTR",111,0) + ;" PrtDefs(0,"COUNT")=12 +"RTN","TMGPRNTR",112,0) + ;" PrtDefs(1,"NAME")="P-ANADEX" +"RTN","TMGPRNTR",113,0) + ;" PrtDefs(1,"DESCRIPTION")="ANADEX PRINTER 10P" +"RTN","TMGPRNTR",114,0) + ;" PrtDefs(2,"NAME")="P-CENT" +"RTN","TMGPRNTR",115,0) + ;" PrtDefs(2,"DESCRIPTION")="Centronix printer" +"RTN","TMGPRNTR",116,0) + ;" ... etc. +"RTN","TMGPRNTR",117,0) + ;"Result: 1=OKToCont 0=Abort +"RTN","TMGPRNTR",118,0) + +"RTN","TMGPRNTR",119,0) + ;"TERMINAL TYPE if file 3.2 +"RTN","TMGPRNTR",120,0) + +"RTN","TMGPRNTR",121,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGPRNTR",122,0) + new cAbort set cAbort=0 +"RTN","TMGPRNTR",123,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPRNTR",124,0) + +"RTN","TMGPRNTR",125,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetPrtDefs") +"RTN","TMGPRNTR",126,0) + +"RTN","TMGPRNTR",127,0) + new Matches,Msg +"RTN","TMGPRNTR",128,0) + if $data(PriorErrorFound)=0 new PriorErrorFound +"RTN","TMGPRNTR",129,0) + if $data(DBIndent)=0 new DBIndent set DBIndent=0 +"RTN","TMGPRNTR",130,0) + new NumMatches,index +"RTN","TMGPRNTR",131,0) + new PrtCount set PrtCount=0 +"RTN","TMGPRNTR",132,0) + new result set result=cOKToCont +"RTN","TMGPRNTR",133,0) + new MatchValue set MatchValue="P-" +"RTN","TMGPRNTR",134,0) + +"RTN","TMGPRNTR",135,0) + ;"====================================================== +"RTN","TMGPRNTR",136,0) + ;"Call FIND^DIC +"RTN","TMGPRNTR",137,0) + ;"====================================================== +"RTN","TMGPRNTR",138,0) + ;"Params: +"RTN","TMGPRNTR",139,0) + ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS +"RTN","TMGPRNTR",140,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGPRNTR",141,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent," MatchValue=",MatchValue) +"RTN","TMGPRNTR",142,0) + do FIND^DIC("3.2","","@;.01","",MatchValue,"*",,"",,"Matches","Msg") +"RTN","TMGPRNTR",143,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC") +"RTN","TMGPRNTR",144,0) + ;"====================================================== +"RTN","TMGPRNTR",145,0) + ;"====================================================== +"RTN","TMGPRNTR",146,0) + +"RTN","TMGPRNTR",147,0) + if $data(Msg("DIERR"))'=0 do goto GPDDone +"RTN","TMGPRNTR",148,0) + . do ShowDIERR^TMGDEBUG(.Msg,.PriorErrorFound) +"RTN","TMGPRNTR",149,0) + . set result=cAbort +"RTN","TMGPRNTR",150,0) + +"RTN","TMGPRNTR",151,0) + if $data(Matches) do +"RTN","TMGPRNTR",152,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries") +"RTN","TMGPRNTR",153,0) + . if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches") +"RTN","TMGPRNTR",154,0) + +"RTN","TMGPRNTR",155,0) + if $data(Matches("DILIST"))=0 goto GPDDone +"RTN","TMGPRNTR",156,0) + +"RTN","TMGPRNTR",157,0) + set NumMatches=$piece(Matches("DILIST",0),"^",1) +"RTN","TMGPRNTR",158,0) + kill PrtDefs +"RTN","TMGPRNTR",159,0) + set PrtDefs(0,"COUNT")=NumMatches +"RTN","TMGPRNTR",160,0) + if NumMatches=0 goto GPDDone ;"keep RecNumIEN default of 0 +"RTN","TMGPRNTR",161,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries") +"RTN","TMGPRNTR",162,0) + if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches") +"RTN","TMGPRNTR",163,0) + +"RTN","TMGPRNTR",164,0) + for index=1:1:NumMatches do +"RTN","TMGPRNTR",165,0) + . kill OneMatch +"RTN","TMGPRNTR",166,0) + . new Name,Descr +"RTN","TMGPRNTR",167,0) + . set Name=$get(Matches("DILIST","ID",index,.01)) +"RTN","TMGPRNTR",168,0) + . set Descr=$get(^%ZIS(2,index,9)) +"RTN","TMGPRNTR",169,0) + . set PrtDefs(index,"NAME")=Name +"RTN","TMGPRNTR",170,0) + . set PrtDefs(index,"DESCRIPTION")=Descr +"RTN","TMGPRNTR",171,0) + +"RTN","TMGPRNTR",172,0) +GPDDone +"RTN","TMGPRNTR",173,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrtDefs") +"RTN","TMGPRNTR",174,0) + quit result +"RTN","TMGPRNTR",175,0) + +"RTN","TMGPRNTR",176,0) + +"RTN","TMGPRNTR",177,0) +PickPrtDef(LinuxPrt,PrtDefs,Output) +"RTN","TMGPRNTR",178,0) + ;"Purpose: To show all the printer types (TERMINAL TYPES), and have user pick one +"RTN","TMGPRNTR",179,0) + ;"Input: LinuxPrt -- name of Linux printer, as retrieved from GetPrinters() +"RTN","TMGPRNTR",180,0) + ;" PrtDefs -- Array of printer defs, as returned from GetPrtDefs(PrtDefs) +"RTN","TMGPRNTR",181,0) + ;" Array will not be changed, even if passed by reference. +"RTN","TMGPRNTR",182,0) + ;" Output -- MUST BE PASSED BY REFERENCE. Will be formated like this: +"RTN","TMGPRNTR",183,0) + ;" Output(0,"COUNT")=1 +"RTN","TMGPRNTR",184,0) + ;" Output(1,"LINUX")="Laser1" <----- Prior results +"RTN","TMGPRNTR",185,0) + ;" Output(1,"TYPE")="P-ANADEX" +"RTN","TMGPRNTR",186,0) + ;"Output: Output -- MUST BE PASSED BY REFERENCE. Output will be formated like this: +"RTN","TMGPRNTR",187,0) + ;" Output(0,"COUNT")=2 +"RTN","TMGPRNTR",188,0) + ;" Output(1,"LINUX")="Laser1" <----- Prior results +"RTN","TMGPRNTR",189,0) + ;" Output(1,"TYPE")="P-ANADEX" +"RTN","TMGPRNTR",190,0) + ;" Output(2,"LINUX")="Printer2" <----- Added results +"RTN","TMGPRNTR",191,0) + ;" Output(2,"TYPE")="P-CENT" +"RTN","TMGPRNTR",192,0) + ;"Result: 1=OKToCont 0=Abort, OR Cancel pressed. +"RTN","TMGPRNTR",193,0) + +"RTN","TMGPRNTR",194,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGPRNTR",195,0) + new cAbort set cAbort=0 +"RTN","TMGPRNTR",196,0) + new result set result=cAbort +"RTN","TMGPRNTR",197,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPRNTR",198,0) + new tPrtDefs +"RTN","TMGPRNTR",199,0) + new DefCount,OutCount +"RTN","TMGPRNTR",200,0) + new index +"RTN","TMGPRNTR",201,0) + new UserPick +"RTN","TMGPRNTR",202,0) + +"RTN","TMGPRNTR",203,0) + set DefCount=$get(PrtDefs(0,"COUNT"),0) +"RTN","TMGPRNTR",204,0) + if DefCount=0 do goto PPDefDone +"RTN","TMGPRNTR",205,0) + . write "No printer defs! Quitting!",! +"RTN","TMGPRNTR",206,0) + set OutCount=$get(Output(0,"COUNT"),0) +"RTN","TMGPRNTR",207,0) + Set Output(0,"COUNT")=OutCount ;"Ensure this is set before any need to abort +"RTN","TMGPRNTR",208,0) + +"RTN","TMGPRNTR",209,0) + for index=1:1:DefCount do +"RTN","TMGPRNTR",210,0) + . new s,Name,Descr +"RTN","TMGPRNTR",211,0) + . set s=index_"; " +"RTN","TMGPRNTR",212,0) + . set Name=$get(PrtDefs(index,"NAME")) +"RTN","TMGPRNTR",213,0) + . ;"write "converted: ",Name," to " +"RTN","TMGPRNTR",214,0) + . set Name=$extract(Name,3,128) +"RTN","TMGPRNTR",215,0) + . ;"write Name,! +"RTN","TMGPRNTR",216,0) + . set Descr=$get(PrtDefs(index,"DESCRIPTION")) +"RTN","TMGPRNTR",217,0) + . set s=s_Name +"RTN","TMGPRNTR",218,0) + . if Descr'="" set s=s_Name_" -- "_Descr +"RTN","TMGPRNTR",219,0) + . set tPrtDefs(index)=s +"RTN","TMGPRNTR",220,0) + +"RTN","TMGPRNTR",221,0) + new s set s="---- Pick VistA driver for printer '"_LinuxPrt_"' ----\n\n" +"RTN","TMGPRNTR",222,0) + set s=s_"(Note: If you can not find an corresponding driver for your\n" +"RTN","TMGPRNTR",223,0) + set s=s_"printer, then see your installer regarding adding an\n" +"RTN","TMGPRNTR",224,0) + set s=s_"appropriate entry to the TERMINAL TYPE file, then retry.)" +"RTN","TMGPRNTR",225,0) + set UserPick=$$Combo^TMGXDLG(s,80,15,.tPrtDefs) +"RTN","TMGPRNTR",226,0) + if UserPick="" goto PPDefDone +"RTN","TMGPRNTR",227,0) + set index=+$piece(UserPick,";",1) +"RTN","TMGPRNTR",228,0) + if index=0 goto PPDefDone +"RTN","TMGPRNTR",229,0) + set OutCount=OutCount+1 +"RTN","TMGPRNTR",230,0) + +"RTN","TMGPRNTR",231,0) + set Output(OutCount,"LINUX")=LinuxPrt +"RTN","TMGPRNTR",232,0) + set Output(OutCount,"TYPE")=PrtDefs(index,"NAME") +"RTN","TMGPRNTR",233,0) + Set Output(0,"COUNT")=OutCount +"RTN","TMGPRNTR",234,0) + +"RTN","TMGPRNTR",235,0) + set result=cOKToCont +"RTN","TMGPRNTR",236,0) +PPDefDone +"RTN","TMGPRNTR",237,0) + quit result +"RTN","TMGPRNTR",238,0) + +"RTN","TMGPRNTR",239,0) + +"RTN","TMGPRNTR",240,0) + +"RTN","TMGPRNTR",241,0) +MatchPrt(Output) +"RTN","TMGPRNTR",242,0) + ;"Purpose: To create match between Linux printers, and definitions +"RTN","TMGPRNTR",243,0) + ;"Input: Output -- and out parameter. MUST BE PASSED BY REFERENCE +"RTN","TMGPRNTR",244,0) + ;"Output: (Output is changed) as follows +"RTN","TMGPRNTR",245,0) + ;" Output(0,"COUNT")=2 +"RTN","TMGPRNTR",246,0) + ;" Output(1,"LINUX")="Deskjet1" <-- suitable name for linux: lp -p PRINTER +"RTN","TMGPRNTR",247,0) + ;" Output(1,"TYPE")="P-ANADEX" +"RTN","TMGPRNTR",248,0) + ;" Output(2,"LINUX")="Laser1" <-- suitable name for linux: lp -p PRINTER +"RTN","TMGPRNTR",249,0) + ;" Output(2,"TYPE")="P-CENT" +"RTN","TMGPRNTR",250,0) + +"RTN","TMGPRNTR",251,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGPRNTR",252,0) + new cAbort set cAbort=0 +"RTN","TMGPRNTR",253,0) + if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPRNTR",254,0) + if $data(DispMode)#10=0 new DispMode set DispMode=1 ;"1=GUI, 3=Roll-n-Scroll +"RTN","TMGPRNTR",255,0) + new result set result=cOKToCont +"RTN","TMGPRNTR",256,0) + new PrtDefs,Printers +"RTN","TMGPRNTR",257,0) + new PrtCount set PrtCount=0 +"RTN","TMGPRNTR",258,0) + kill Output ;"clear any prior entries. +"RTN","TMGPRNTR",259,0) + +"RTN","TMGPRNTR",260,0) + if DispMode'=1 do goto SUPDone +"RTN","TMGPRNTR",261,0) + . write "Currently unable to set up printers in 'Roll-and-Scroll' mode. Quitting.",! +"RTN","TMGPRNTR",262,0) + +"RTN","TMGPRNTR",263,0) + set result=$$GetPrinters(.Printers) +"RTN","TMGPRNTR",264,0) + if result=cAbort do goto SUPDone +"RTN","TMGPRNTR",265,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printers.") +"RTN","TMGPRNTR",266,0) + +"RTN","TMGPRNTR",267,0) + set result=$$GetPrtDefs(.PrtDefs) +"RTN","TMGPRNTR",268,0) + if result=cAbort do goto SUPDone +"RTN","TMGPRNTR",269,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printer definitions.") +"RTN","TMGPRNTR",270,0) + +"RTN","TMGPRNTR",271,0) + new tPrts +"RTN","TMGPRNTR",272,0) + new Selected set Selected="" +"RTN","TMGPRNTR",273,0) + merge tPrts=Printers +"RTN","TMGPRNTR",274,0) + kill tPrts(0) +"RTN","TMGPRNTR",275,0) + ;"set tPrts(2)="TestPrinter" ;"temp!!!!! +"RTN","TMGPRNTR",276,0) + ;"set tPrts(3)="TestPrinter2" ;"temp!!!!! +"RTN","TMGPRNTR",277,0) + for do quit:Selected="" +"RTN","TMGPRNTR",278,0) + . ;"write "loop1, selected=",Selected,! +"RTN","TMGPRNTR",279,0) + . set Selected=$$Combo^TMGXDLG("Select Printer to Setup",,,.tPrts) +"RTN","TMGPRNTR",280,0) + . if Selected="" quit +"RTN","TMGPRNTR",281,0) + . ;"write "OK, now to set up printer: ",Selected,! +"RTN","TMGPRNTR",282,0) + . new tResult set tResult=$$PickPrtDef(Selected,.PrtDefs,.Output) +"RTN","TMGPRNTR",283,0) + . ;"Note: I am not doing anything if user cancels pick of printer type. +"RTN","TMGPRNTR",284,0) + . ;"Now remove that printer from list of printers to install. +"RTN","TMGPRNTR",285,0) + . new index set index=$order(tPrts("")) +"RTN","TMGPRNTR",286,0) + . new NextIndex set NextIndex="" +"RTN","TMGPRNTR",287,0) + . for do quit:(index="") +"RTN","TMGPRNTR",288,0) + . . ;"write "loop2, index=",index,! +"RTN","TMGPRNTR",289,0) + . . set NextIndex=1 +"RTN","TMGPRNTR",290,0) + . . if index="" quit +"RTN","TMGPRNTR",291,0) + . . if $get(tPrts(index))=Selected do quit +"RTN","TMGPRNTR",292,0) + . . . set NextIndex=$order(tPrts(index)) +"RTN","TMGPRNTR",293,0) + . . . kill tPrts(index) +"RTN","TMGPRNTR",294,0) + . . . set index="" +"RTN","TMGPRNTR",295,0) + . . set index=$order(tPrts(index)) +"RTN","TMGPRNTR",296,0) + . if $data(tPrts)=0 do quit +"RTN","TMGPRNTR",297,0) + . . set Selected="" ;"force quit +"RTN","TMGPRNTR",298,0) + . ;"Now move all entries below this one UP +"RTN","TMGPRNTR",299,0) + . set index=NextIndex +"RTN","TMGPRNTR",300,0) + . for do quit:index="" +"RTN","TMGPRNTR",301,0) + . . ;"write "loop3, index=",index,! +"RTN","TMGPRNTR",302,0) + . . if index="" quit +"RTN","TMGPRNTR",303,0) + . . set tPrts(index-1)=tPrts(index) +"RTN","TMGPRNTR",304,0) + . . new PriorIndex set PriorIndex=index +"RTN","TMGPRNTR",305,0) + . . set index=$order(tPrts(index)) +"RTN","TMGPRNTR",306,0) + . . kill tPrts(PriorIndex) +"RTN","TMGPRNTR",307,0) + . . if $data(tPrts)=0 do +"RTN","TMGPRNTR",308,0) + . . . set Selected="" +"RTN","TMGPRNTR",309,0) + . . . set index="" +"RTN","TMGPRNTR",310,0) + +"RTN","TMGPRNTR",311,0) +SUPDone +"RTN","TMGPRNTR",312,0) + quit result +"RTN","TMGPRNTR",313,0) + +"RTN","TMGPRNTR",314,0) + +"RTN","TMGPRNTR",315,0) +SetupPrt +"RTN","TMGPRNTR",316,0) + ;"To query linux printer system, and create VistA entries for these. +"RTN","TMGPRNTR",317,0) + +"RTN","TMGPRNTR",318,0) + +"RTN","TMGPRNTR",319,0) + new cFile set cFile="FILE" +"RTN","TMGPRNTR",320,0) + new cEntries set cEntries="Entries" +"RTN","TMGPRNTR",321,0) + +"RTN","TMGPRNTR",322,0) + ; new Data +"RTN","TMGPRNTR",323,0) + ; set Data(0,cFile)="3.5" +"RTN","TMGPRNTR",324,0) + ; set Data(0,cEntries)=1 +"RTN","TMGPRNTR",325,0) + ; set Data +"RTN","TMGPRNTR",326,0) + ; +"RTN","TMGPRNTR",327,0) + ; 1 0;1 .01 NAME [RFX] +"RTN","TMGPRNTR",328,0) + ; 2 1;1 .02 LOCATION OF TERMINAL [RF] +"RTN","TMGPRNTR",329,0) + ; MN;0 .03 MNEMONIC <-Mult [3.501] +"RTN","TMGPRNTR",330,0) + ; 3 -0;1 .01 -MNEMONIC [MFX] +"RTN","TMGPRNTR",331,0) + ; 4 1;4 .04 LOCAL SYNONYM [F] +"RTN","TMGPRNTR",332,0) + ; 5 0;2 1 $I [RFX] +"RTN","TMGPRNTR",333,0) + ; 6 0;9 1.9 VOLUME SET(CPU) [FX] +"RTN","TMGPRNTR",334,0) + ; 7 0;11 1.95 SIGN-ON/SYSTEM DEVICE [SX] +"RTN","TMGPRNTR",335,0) + ; 8 TYPE;1 2 TYPE [RS] +"RTN","TMGPRNTR",336,0) + ; 9 SUBTYPE;1 3 SUBTYPE <-Pntr [RP3.2] +"RTN","TMGPRNTR",337,0) + ; 10 0;3 4 ASK DEVICE [S] +"RTN","TMGPRNTR",338,0) + ; 11 0;4 5 ASK PARAMETERS [S] +"RTN","TMGPRNTR",339,0) + ; 12 1;5 5.1 ASK HOST FILE [S] +"RTN","TMGPRNTR",340,0) + ; 13 1;6 5.2 ASK HFS I/O OPERATION [S] +"RTN","TMGPRNTR",341,0) + ; 14 0;12 5.5 QUEUING [S] +"RTN","TMGPRNTR",342,0) + ; 15 90;1 6 OUT-OF-SERVICE DATE [D] +"RTN","TMGPRNTR",343,0) + ; 17 90;3 8 KEY OPERATOR [F] +"RTN","TMGPRNTR",344,0) + ;18 91;1 9 MARGIN WIDTH [NJ3,0] +"RTN","TMGPRNTR",345,0) + ; 19 91;3 11 PAGE LENGTH [NJ5,0] +"RTN","TMGPRNTR",346,0) + ; 20 1;11 11.2 SUPPRESS FORM FEED AT CLOSE [S] +"RTN","TMGPRNTR",347,0) + ; 27 POX;E1,245 19.7 PRE-OPEN EXECUTE [K] +"RTN","TMGPRNTR",348,0) + ; 28 PCX;E1,245 19.8 POST-CLOSE EXECUTE [K] +"RTN","TMGPRNTR",349,0) + ; +"RTN","TMGPRNTR",350,0) + ; +"RTN","TMGPRNTR",351,0) + ;NAME: TEST-LINUX-PRINTER $I: +"RTN","TMGPRNTR",352,0) + ; ASK DEVICE: NO ASK PARAMETERS: NO +"RTN","TMGPRNTR",353,0) + ; SIGN-ON/SYSTEM DEVICE: NO LOCATION OF TERMINAL: Laughlin_Office +"RTN","TMGPRNTR",354,0) + ; ASK HOST FILE: NO ASK HFS I/O OPERATION: NO +"RTN","TMGPRNTR",355,0) + ; NEAREST PHONE: 787-7000 PAGE LENGTH: 80 +"RTN","TMGPRNTR",356,0) + ; FORM CURRENTLY MOUNTED: Plain paper +"RTN","TMGPRNTR",357,0) + ; POST-CLOSE EXECUTE: DO FINISH^TMGPRNTR("laughlin_laser") +"RTN","TMGPRNTR",358,0) + ; PRE-OPEN EXECUTE: DO SETJOB^TMGPRNTR(.IO) ;Note: Change IO (output file) +"RTN","TMGPRNTR",359,0) + ; SUBTYPE: P-OTH80 TYPE: TERMINAL +"RTN","TMGPRNTR",360,0) + ; ASK DEVICE TYPE AT SIGN-ON: YES, ASK +"RTN","TMGPRNTR",361,0) + +"RTN","TMGPRNTR",362,0) + quit +"RTN","TMGPRNTR",363,0) + +"RTN","TMGPRNTR",364,0) + +"RTN","TMGPRNTR",365,0) + ;"======================================================================= +"RTN","TMGPRNTR",366,0) + ;"======================================================================= +"RTN","TMGPRNTR",367,0) + +"RTN","TMGPRNTR",368,0) + +"RTN","TMGPRNTR",369,0) +GETJOBNM() +"RTN","TMGPRNTR",370,0) + ;"Purpose: To create a unique printer job name. This will be used during a printing process +"RTN","TMGPRNTR",371,0) + ;" that writes the printer file to the host file system, then passes file to Linux +"RTN","TMGPRNTR",372,0) + ;" printing system. +"RTN","TMGPRNTR",373,0) + ;"Output: Returns name of file to put output into +"RTN","TMGPRNTR",374,0) + +"RTN","TMGPRNTR",375,0) + ;"UNIQUE will generate a filename based on time and job number +"RTN","TMGPRNTR",376,0) + ;" i.e. 'Print-Job-628233034.tmp +"RTN","TMGPRNTR",377,0) + +"RTN","TMGPRNTR",378,0) + ;"write !,"here in GETJOBNM^TMGPRNTR",! +"RTN","TMGPRNTR",379,0) + new cJobs set cJobs="PRINT JOBS" +"RTN","TMGPRNTR",380,0) + new Filename set Filename=$$UNIQUE^%ZISUTL("/tmp/Print-Job.tmp") +"RTN","TMGPRNTR",381,0) + +"RTN","TMGPRNTR",382,0) + ;"Now store Filename for later transfer to Linux lpr +"RTN","TMGPRNTR",383,0) + new index set index=$order(^TMP("TMG",cJobs,$J,"")) +"RTN","TMGPRNTR",384,0) + if index="" set index=1 +"RTN","TMGPRNTR",385,0) + set ^TMP("TMG",cJobs,$J,index)=Filename +"RTN","TMGPRNTR",386,0) + +"RTN","TMGPRNTR",387,0) + ;"write !,"Print job name will be:",Filename,! +"RTN","TMGPRNTR",388,0) + quit Filename ;"result returned by altering Filename +"RTN","TMGPRNTR",389,0) + +"RTN","TMGPRNTR",390,0) + +"RTN","TMGPRNTR",391,0) + +"RTN","TMGPRNTR",392,0) +FINISH(Printer) +"RTN","TMGPRNTR",393,0) + ;"Purpose: to complete the printing process by sending the now-created file +"RTN","TMGPRNTR",394,0) + ;" to Linux CUPS (the printing system). +"RTN","TMGPRNTR",395,0) + ;"Note: The lpr system itself will delete this print file when done (option -r) +"RTN","TMGPRNTR",396,0) + ;"Input: Printer OPTIONAL -- the name of the linux printer to send the job to. +"RTN","TMGPRNTR",397,0) + +"RTN","TMGPRNTR",398,0) + new cJobs set cJobs="PRINT JOBS" +"RTN","TMGPRNTR",399,0) + new index set index=$order(^TMP("TMG",cJobs,$J,"")) +"RTN","TMGPRNTR",400,0) + new Filename set Filename=$get(^TMP("TMG",cJobs,$J,index)) +"RTN","TMGPRNTR",401,0) + +"RTN","TMGPRNTR",402,0) + close IO +"RTN","TMGPRNTR",403,0) + kill IO(1,IO) +"RTN","TMGPRNTR",404,0) + +"RTN","TMGPRNTR",405,0) + kill ^TMP("TMG",cJobs,$J,index) +"RTN","TMGPRNTR",406,0) + +"RTN","TMGPRNTR",407,0) + if Filename'="" do +"RTN","TMGPRNTR",408,0) + . new CmdStr +"RTN","TMGPRNTR",409,0) + . set CmdStr="lpr " +"RTN","TMGPRNTR",410,0) + . if $get(Printer)'="" set CmdStr=CmdStr_"-P "_Printer_" " +"RTN","TMGPRNTR",411,0) + . set CmdStr=CmdStr_"-r " ;"option -r --> lpr deletes file after printing done. +"RTN","TMGPRNTR",412,0) + . set CmdStr=CmdStr_Filename_" &" +"RTN","TMGPRNTR",413,0) + . zsystem CmdStr +"RTN","TMGPRNTR",414,0) + +"RTN","TMGPRNTR",415,0) + quit +"RTN","TMGPRNTR",416,0) + +"RTN","TMGPRNTR",417,0) + +"RTN","TMGPRNTR",418,0) + +"RTN","TMGPRNTR",419,0) + +"RTN","TMGPRNTR",420,0) + +"RTN","TMGPRPN") +0^67^B76219 +"RTN","TMGPRPN",1,0) +TMGPRPN ;TMG/kst/Print Notes Fns. ;03/25/06 +"RTN","TMGPRPN",2,0) + ;;1.0;TMG-LIB;**1**;04/25/04 +"RTN","TMGPRPN",3,0) + +"RTN","TMGPRPN",4,0) + ;"TMG PRINT NOTES FUNCTIONS +"RTN","TMGPRPN",5,0) + +"RTN","TMGPRPN",6,0) + ;"======================================================================= +"RTN","TMGPRPN",7,0) + ;" API -- Public Functions. +"RTN","TMGPRPN",8,0) + ;"======================================================================= +"RTN","TMGPRPN",9,0) + ;"CONTPRNT -- print notes for chosed patient, contigiously or divided +"RTN","TMGPRPN",10,0) + ;"CONTPRN2(PtIEN) -- print notes for specified patient +"RTN","TMGPRPN",11,0) + ;"PRPNQUIET(OPTIONS) -- print notes based on input options +"RTN","TMGPRPN",12,0) + +"RTN","TMGPRPN",13,0) + ;"======================================================================= +"RTN","TMGPRPN",14,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGPRPN",15,0) + ;"======================================================================= +"RTN","TMGPRPN",16,0) + +"RTN","TMGPRPN",17,0) + +"RTN","TMGPRPN",18,0) + ;"======================================================================= +"RTN","TMGPRPN",19,0) + ;"======================================================================= +"RTN","TMGPRPN",20,0) + +"RTN","TMGPRPN",21,0) +CONTPRNT +"RTN","TMGPRPN",22,0) + ;"Purpose: To ask for patient name, and date range, and output device +"RTN","TMGPRPN",23,0) + ;" and then print notes contigously (i.e. not a separate page +"RTN","TMGPRPN",24,0) + ;" for each note), or on separate pages +"RTN","TMGPRPN",25,0) + ;"Input: none -- will ask user for values +"RTN","TMGPRPN",26,0) + ;"Output: none -- will print to chosen device based on user preference +"RTN","TMGPRPN",27,0) + +"RTN","TMGPRPN",28,0) + new Options +"RTN","TMGPRPN",29,0) + +"RTN","TMGPRPN",30,0) + write !,"-- PRINT NOTES FOR A PATIENT, CONTIGIOUSLY -- ",!! +"RTN","TMGPRPN",31,0) + +"RTN","TMGPRPN",32,0) + set DIC=2 ;"PATIENT file +"RTN","TMGPRPN",33,0) + set DIC(0)="MAQE" +"RTN","TMGPRPN",34,0) + set DIC("A")="Enter name of Patient to print note for (^ to abort): " +"RTN","TMGPRPN",35,0) + do ^DIC +"RTN","TMGPRPN",36,0) + +"RTN","TMGPRPN",37,0) + do CONTPRN2(+Y) +"RTN","TMGPRPN",38,0) +RADone +"RTN","TMGPRPN",39,0) + quit +"RTN","TMGPRPN",40,0) + +"RTN","TMGPRPN",41,0) + +"RTN","TMGPRPN",42,0) +CONTPRN2(PtIEN) +"RTN","TMGPRPN",43,0) + ;"Purpose: For specified patient, ask for date range, output device, +"RTN","TMGPRPN",44,0) + ;" and if to print notes contigously (i.e. not a separate page +"RTN","TMGPRPN",45,0) + ;" for each note) or on separate pages, and if to list avail notes. +"RTN","TMGPRPN",46,0) + ;"Input: PtIEN -- record number in file #2 +"RTN","TMGPRPN",47,0) + ;"Output: none -- will print to chosen device based on user preference +"RTN","TMGPRPN",48,0) + +"RTN","TMGPRPN",49,0) + new Options +"RTN","TMGPRPN",50,0) + +"RTN","TMGPRPN",51,0) + write ! +"RTN","TMGPRPN",52,0) + +"RTN","TMGPRPN",53,0) + set Options("PATIENT")=$get(PtIEN,-1) +"RTN","TMGPRPN",54,0) + if Options("PATIENT")'>0 do goto CP2Done +"RTN","TMGPRPN",55,0) + . write !,"No patient selected. Aborting.",! +"RTN","TMGPRPN",56,0) + +"RTN","TMGPRPN",57,0) + new YN,index +"RTN","TMGPRPN",58,0) + read !,"Show list of available notes? (^ to abort): YES// ",YN:$get(DTIME,3600) +"RTN","TMGPRPN",59,0) + if YN="" set YN="Y" +"RTN","TMGPRPN",60,0) + if YN="^" write "Aborting.",! goto CP2Done +"RTN","TMGPRPN",61,0) + if ($$UP^XLFSTR(YN)["Y") do +"RTN","TMGPRPN",62,0) + . write !,"Available notes",! +"RTN","TMGPRPN",63,0) + . write "---------------",! +"RTN","TMGPRPN",64,0) + . set index=$order(^TIU(8925,"C",PtIEN,""),1) +"RTN","TMGPRPN",65,0) + . for do quit:(index="") +"RTN","TMGPRPN",66,0) + . . if index="" quit ;"note index is DocIEN +"RTN","TMGPRPN",67,0) + . . new S,Date,DateS,DocTIEN,TypeName,X,Y +"RTN","TMGPRPN",68,0) + . . set Date=$piece($get(^TIU(8925,index,13)),"^",1) +"RTN","TMGPRPN",69,0) + . . set Y="D" set DateS=$$FMTE^XLFDT(Date) +"RTN","TMGPRPN",70,0) + . . set DocTIEN=$piece($get(^TIU(8925,index,0)),"^",1) +"RTN","TMGPRPN",71,0) + . . set TypeName=$piece($get(^TIU(8925.1,DocTIEN,0)),"^",1) +"RTN","TMGPRPN",72,0) + . . if TypeName="" set TypeName="(Unknown document type): "_DocTIEN +"RTN","TMGPRPN",73,0) + . . write DateS," -- ",TypeName,! +"RTN","TMGPRPN",74,0) + . . set index=$order(^TIU(8925,"C",PtIEN,index),1) +"RTN","TMGPRPN",75,0) + +"RTN","TMGPRPN",76,0) + new %DT +"RTN","TMGPRPN",77,0) + set %DT="AEP" +"RTN","TMGPRPN",78,0) + set %DT("A")="Enter starting date (^ to abort): " +"RTN","TMGPRPN",79,0) + do ^%DT +"RTN","TMGPRPN",80,0) + if Y=-1 do goto CP2Done +"RTN","TMGPRPN",81,0) + . write "Invalid date. Aborting.",! +"RTN","TMGPRPN",82,0) + set Options("START")=Y +"RTN","TMGPRPN",83,0) + +"RTN","TMGPRPN",84,0) + set %DT("A")="Enter ending date (^ to abort): " +"RTN","TMGPRPN",85,0) + do ^%DT +"RTN","TMGPRPN",86,0) + if Y=-1 do goto CP2Done +"RTN","TMGPRPN",87,0) + . write "Invalid date. Aborting report.",! +"RTN","TMGPRPN",88,0) + set Options("END")=Y +"RTN","TMGPRPN",89,0) + +"RTN","TMGPRPN",90,0) + new ContMode +"RTN","TMGPRPN",91,0) + read !,"Print each note on a separate page? NO// ",ContMode:$get(DTIME,3600),! +"RTN","TMGPRPN",92,0) + if ContMode="" set ContMode="N" +"RTN","TMGPRPN",93,0) + set Options("CONTMODE")=($$UP^XLFSTR(ContMode)["N") +"RTN","TMGPRPN",94,0) + if ContMode="^" write "Aborting.",! goto CP2Done +"RTN","TMGPRPN",95,0) + +"RTN","TMGPRPN",96,0) + set %ZIS("A")="Enter output printer or device (^ to abort): " +"RTN","TMGPRPN",97,0) + do ^%ZIS +"RTN","TMGPRPN",98,0) + if POP do goto CP2Done +"RTN","TMGPRPN",99,0) + . write !,"Error selecting output printer or device. Aborting report.",! +"RTN","TMGPRPN",100,0) + +"RTN","TMGPRPN",101,0) + use IO +"RTN","TMGPRPN",102,0) + do PRPNQUIET(.Options) +"RTN","TMGPRPN",103,0) + use IO(0) +"RTN","TMGPRPN",104,0) + +"RTN","TMGPRPN",105,0) + do ^%ZISC +"RTN","TMGPRPN",106,0) + +"RTN","TMGPRPN",107,0) + write !,"Done. Good bye!",!! +"RTN","TMGPRPN",108,0) +CP2Done +"RTN","TMGPRPN",109,0) + quit +"RTN","TMGPRPN",110,0) + +"RTN","TMGPRPN",111,0) + +"RTN","TMGPRPN",112,0) +PRPNQUIET(OPTIONS) +"RTN","TMGPRPN",113,0) + ;"Purpose: To create a report on transcription productivity based on +"RTN","TMGPRPN",114,0) + ;" options specified in OPTIONS. +"RTN","TMGPRPN",115,0) + ;"Input: The following elements in OPTIONS should be defined +"RTN","TMGPRPN",116,0) + ;" 0PTIONS("PATIENT") ;"the IEN of the user (IEN from file 200) +"RTN","TMGPRPN",117,0) + ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format +"RTN","TMGPRPN",118,0) + ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format +"RTN","TMGPRPN",119,0) + ;" OPTIONS("CONTMODE") ;"if 1, then notes printed contigiously +"RTN","TMGPRPN",120,0) + ;"Note: This will create a report by writing to the current device +"RTN","TMGPRPN",121,0) + ;" If the user wants output to go to a DEVICE, then they should call +"RTN","TMGPRPN",122,0) + ;" ^%ZIS prior to calling this function, then use IO, +"RTN","TMGPRPN",123,0) + ;" then when done, use IO(0) and call ^%ZISC to close +"RTN","TMGPRPN",124,0) + +"RTN","TMGPRPN",125,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PRPNQUIET^TMGPRPN") +"RTN","TMGPRPN",126,0) + +"RTN","TMGPRPN",127,0) + new PtIEN +"RTN","TMGPRPN",128,0) + new index set index="" +"RTN","TMGPRPN",129,0) + +"RTN","TMGPRPN",130,0) + set PtIEN=+$get(OPTIONS("PATIENT")) +"RTN","TMGPRPN",131,0) + if PtIEN=0 do goto PQDone +"RTN","TMGPRPN",132,0) + . write "No patient record number supplied. Aborting.",! +"RTN","TMGPRPN",133,0) + set StartDT=+$get(OPTIONS("START")) +"RTN","TMGPRPN",134,0) + if (StartDT=0) do +"RTN","TMGPRPN",135,0) + . write "No start date specified. Aborting.",! +"RTN","TMGPRPN",136,0) + set EndDT=+$get(OPTIONS("END")) +"RTN","TMGPRPN",137,0) + if (EndDT=0) do +"RTN","TMGPRPN",138,0) + . write "No end date specified. Aborting.",! +"RTN","TMGPRPN",139,0) + +"RTN","TMGPRPN",140,0) + kill ^TMP("TIUPR",$J) +"RTN","TMGPRPN",141,0) + set index=$order(^TIU(8925,"C",PtIEN,"")) +"RTN","TMGPRPN",142,0) + for do quit:(index="") +"RTN","TMGPRPN",143,0) + . if index="" quit ;"note index is DocIEN +"RTN","TMGPRPN",144,0) + . new S,SSN,DATE +"RTN","TMGPRPN",145,0) + . set SSN=$Piece(^DPT(PtIEN,0),"^",9) +"RTN","TMGPRPN",146,0) + . Set DATE=$piece($get(^TIU(8925,index,13)),"^",1) +"RTN","TMGPRPN",147,0) + . if (DATE'EndDT) do +"RTN","TMGPRPN",148,0) + . . Set ^TMP("TIUPR",$Job,SSN_";"_PtIEN,DATE,index)="VistA EMR" +"RTN","TMGPRPN",149,0) + . set index=$order(^TIU(8925,"C",PtIEN,index)) +"RTN","TMGPRPN",150,0) + +"RTN","TMGPRPN",151,0) + do PRINT^TIUPRPN1(1,1) ;0=> Chart Copy, 1=>Contigious +"RTN","TMGPRPN",152,0) + +"RTN","TMGPRPN",153,0) +PQDone +"RTN","TMGPRPN",154,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PRPNQUIET^TMGPRPN") +"RTN","TMGPRPN",155,0) + quit +"RTN","TMGPRPN",156,0) + +"RTN","TMGPRPN",157,0) + +"RTN","TMGPSSDE") +0^68^B217084810 +"RTN","TMGPSSDE",1,0) +TMGPSSDE ;TMG/kst/Custom version of PSSDEE ;03/25/06 +"RTN","TMGPSSDE",2,0) + ;;1.0;TMG-LIB;**1**;04/25/04 +"RTN","TMGPSSDE",3,0) + +"RTN","TMGPSSDE",4,0) +PSSDEE ;BIR/WRT-MASTER DRUG ENTER/EDIT ROUTINE ;01/21/00 +"RTN","TMGPSSDE",5,0) + ;;1.0;PHARMACY DATA MANAGEMENT;**3,5,15,16,20,22,28,32,34,33,38,57,47,68,61**;9/30/97 +"RTN","TMGPSSDE",6,0) + +"RTN","TMGPSSDE",7,0) + ;"***************************************************************** +"RTN","TMGPSSDE",8,0) + ;"* Custom version of code by Kevin Toppenberg, MD +"RTN","TMGPSSDE",9,0) + ;"* to allow customization of the code. +"RTN","TMGPSSDE",10,0) + ;"* +"RTN","TMGPSSDE",11,0) + ;"***************************************************************** +"RTN","TMGPSSDE",12,0) + +"RTN","TMGPSSDE",13,0) + ;"Reference to REACT1^PSNOUT supported by DBIA #2080 +"RTN","TMGPSSDE",14,0) + ;"Reference to $$UP^XLFSTR(X) supported by DBIA #10104 +"RTN","TMGPSSDE",15,0) + ;"Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531 +"RTN","TMGPSSDE",16,0) + ; +"RTN","TMGPSSDE",17,0) +BEGIN set PSSFLAG=0 +"RTN","TMGPSSDE",18,0) + do ^PSSDEE2 ;"kill vars +"RTN","TMGPSSDE",19,0) + set PSSZ=1 +"RTN","TMGPSSDE",20,0) + F PSSXX=1:1 do quit:PSSFLAG +"RTN","TMGPSSDE",21,0) + . kill DA +"RTN","TMGPSSDE",22,0) + . do ASK ;" ask users all questions +"RTN","TMGPSSDE",23,0) +DONE do ^PSSDEE2 ;" kill vars +"RTN","TMGPSSDE",24,0) + kill PSSFLAG +"RTN","TMGPSSDE",25,0) + quit +"RTN","TMGPSSDE",26,0) + ; +"RTN","TMGPSSDE",27,0) + ;"================================================================= +"RTN","TMGPSSDE",28,0) +ASK W ! +"RTN","TMGPSSDE",29,0) + set DIC="^PSDRUG(" +"RTN","TMGPSSDE",30,0) + set DIC(0)="QEALMNTV" ;"query/echo/ask/learn=OK/multIndex/IntNumOK/T->searchAllIndexes/verify +"RTN","TMGPSSDE",31,0) + set DLAYGO=50 ;"force allowing adding record to file 50 +"RTN","TMGPSSDE",32,0) + set DIC("T")="" ;"present every match to the lookup value +"RTN","TMGPSSDE",33,0) + do ^DIC +"RTN","TMGPSSDE",34,0) + kill DIC +"RTN","TMGPSSDE",35,0) + if Y<0 set PSSFLAG=1 quit +"RTN","TMGPSSDE",36,0) + ; +"RTN","TMGPSSDE",37,0) + set (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0 +"RTN","TMGPSSDE",38,0) + kill ^TMP($J,"ADD") +"RTN","TMGPSSDE",39,0) + kill ^TMP($J,"SOL") +"RTN","TMGPSSDE",40,0) + ; +"RTN","TMGPSSDE",41,0) + set DA=+Y +"RTN","TMGPSSDE",42,0) + set DISPDRG=DA +"RTN","TMGPSSDE",43,0) + L +^PSDRUG(DISPDRG):0 +"RTN","TMGPSSDE",44,0) + if '$T W !,$C(7),"Another person is editing this one." quit +"RTN","TMGPSSDE",45,0) + set PSSHUIDG=1 +"RTN","TMGPSSDE",46,0) + set PSSNEW=$P(Y,"^",3) +"RTN","TMGPSSDE",47,0) + do USE +"RTN","TMGPSSDE",48,0) + do NOPE +"RTN","TMGPSSDE",49,0) + do COMMON +"RTN","TMGPSSDE",50,0) + do DEA +"RTN","TMGPSSDE",51,0) + do MF +"RTN","TMGPSSDE",52,0) + kill PSSHUIDG +"RTN","TMGPSSDE",53,0) + do DRG^PSSHUIDG(DISPDRG,PSSNEW) +"RTN","TMGPSSDE",54,0) + L -^PSDRUG(DISPDRG) +"RTN","TMGPSSDE",55,0) + kill FLG3,PSSNEW +"RTN","TMGPSSDE",56,0) + quit +"RTN","TMGPSSDE",57,0) + ; +"RTN","TMGPSSDE",58,0) + ;"================================================================= +"RTN","TMGPSSDE",59,0) +COMMON set DIE="^PSDRUG(" +"RTN","TMGPSSDE",60,0) + set DR="[PSSCOMMON]" +"RTN","TMGPSSDE",61,0) + do ^DIE +"RTN","TMGPSSDE",62,0) + quit:$data(Y)!($data(DTOUT)) +"RTN","TMGPSSDE",63,0) + W:'$data(Y) !,"PRICE PER DISPENSE UNIT: " +"RTN","TMGPSSDE",64,0) + S:'$data(^PSDRUG(DA,660)) $P(^PSDRUG(DA,660),"^",6)="" +"RTN","TMGPSSDE",65,0) + W:'$data(Y) $P(^PSDRUG(DA,660),"^",6) +"RTN","TMGPSSDE",66,0) + do DEA +"RTN","TMGPSSDE",67,0) + do CK +"RTN","TMGPSSDE",68,0) + do ASKND +"RTN","TMGPSSDE",69,0) + do OIKILL^PSSDEE1 +"RTN","TMGPSSDE",70,0) + do COMMON1 +"RTN","TMGPSSDE",71,0) + quit +"RTN","TMGPSSDE",72,0) + ; +"RTN","TMGPSSDE",73,0) +COMMON1 W !,"Just a reminder...you are editing ",$P(^PSDRUG(DISPDRG,0),"^"),"." +"RTN","TMGPSSDE",74,0) + set (PSSVVDA,DA)=DISPDRG +"RTN","TMGPSSDE",75,0) + do DOSN^PSSDOS +"RTN","TMGPSSDE",76,0) + set DA=PSSVVDA +"RTN","TMGPSSDE",77,0) + kill PSSVVDA +"RTN","TMGPSSDE",78,0) + do USE +"RTN","TMGPSSDE",79,0) + do APP +"RTN","TMGPSSDE",80,0) + do ORDITM^PSSDEE1 +"RTN","TMGPSSDE",81,0) + quit +"RTN","TMGPSSDE",82,0) + ; +"RTN","TMGPSSDE",83,0) +CK do DSPY^PSSDEE1 +"RTN","TMGPSSDE",84,0) + set FLGNDF=0 +"RTN","TMGPSSDE",85,0) + quit +"RTN","TMGPSSDE",86,0) + ; +"RTN","TMGPSSDE",87,0) +ASKND set %=-1 +"RTN","TMGPSSDE",88,0) + if $data(^XUSEC("PSNMGR",DUZ)) do +"RTN","TMGPSSDE",89,0) + . do MESSAGE^PSSDEE1 +"RTN","TMGPSSDE",90,0) + . W !!,"Do you wish to match/rematch to NATIONAL DRUG file" +"RTN","TMGPSSDE",91,0) + . set %=1 +"RTN","TMGPSSDE",92,0) + . S:FLGMTH=1 %=2 +"RTN","TMGPSSDE",93,0) + . do YN^DICN +"RTN","TMGPSSDE",94,0) + if %=0 W !,"If you answer ""yes"", you will attempt to match to NDF." G ASKND +"RTN","TMGPSSDE",95,0) + if %=2 kill X,Y quit +"RTN","TMGPSSDE",96,0) + if %<0 kill X,Y quit +"RTN","TMGPSSDE",97,0) + if %=1 do +"RTN","TMGPSSDE",98,0) + . do RSET^PSSDEE1 +"RTN","TMGPSSDE",99,0) + . do EN1^PSSUTIL(DISPDRG,1) +"RTN","TMGPSSDE",100,0) + . set X="PSNOUT" +"RTN","TMGPSSDE",101,0) + . X ^%ZOSF("TEST") +"RTN","TMGPSSDE",102,0) + . if do +"RTN","TMGPSSDE",103,0) + . . do REACT1^PSNOUT +"RTN","TMGPSSDE",104,0) + . . set DA=DISPDRG +"RTN","TMGPSSDE",105,0) + . . if $data(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)]"" do ONE +"RTN","TMGPSSDE",106,0) + quit +"RTN","TMGPSSDE",107,0) + ; +"RTN","TMGPSSDE",108,0) +ONE set PSNP=$G(^PSDRUG(DA,"I")) +"RTN","TMGPSSDE",109,0) + if PSNP,PSNP
1 if $data(^PSDRUG(DISPDRG,2)) DO +"RTN","TMGPSSDE",401,0) + . set PSSOR=$P(^PSDRUG(DISPDRG,2),"^",1) +"RTN","TMGPSSDE",402,0) + . if PSSOR]"" DO +"RTN","TMGPSSDE",403,0) + . . DO EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDE",404,0) + . . DO EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDE",405,0) + quit +"RTN","TMGPSSDE",406,0) + ; +"RTN","TMGPSSDE",407,0) +MFA if $P($G(^PS(59.7,1,80)),"^",2)>1 do +"RTN","TMGPSSDE",408,0) + . set PSSOR=$P(^PS(52.6,ENTRY,0),"^",11) +"RTN","TMGPSSDE",409,0) + . set PSSDD=$P(^PS(52.6,ENTRY,0),"^",2) +"RTN","TMGPSSDE",410,0) + . if PSSOR]"" do +"RTN","TMGPSSDE",411,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDE",412,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDE",413,0) + . . do MFDD +"RTN","TMGPSSDE",414,0) + quit +"RTN","TMGPSSDE",415,0) + ; +"RTN","TMGPSSDE",416,0) +MFS if $P($G(^PS(59.7,1,80)),"^",2)>1 do +"RTN","TMGPSSDE",417,0) + . set PSSOR=$P(^PS(52.7,ENTRY,0),"^",11) +"RTN","TMGPSSDE",418,0) + . set PSSDD=$P(^PS(52.7,ENTRY,0),"^",2) +"RTN","TMGPSSDE",419,0) + . if PSSOR]"" do +"RTN","TMGPSSDE",420,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDE",421,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDE",422,0) + . . do MFDD +"RTN","TMGPSSDE",423,0) + quit +"RTN","TMGPSSDE",424,0) + ; +"RTN","TMGPSSDE",425,0) +MFDD if $data(^PSDRUG(PSSDD,2)) do +"RTN","TMGPSSDE",426,0) + . set PSSOR=$P(^PSDRUG(PSSDD,2),"^",1) +"RTN","TMGPSSDE",427,0) + . if PSSOR]"" do +"RTN","TMGPSSDE",428,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDE",429,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDE",430,0) + quit +"RTN","TMGPSSDE",431,0) + ; +"RTN","TMGPSSDE",432,0) +OPEI if $data(^PSDRUG(DISPDRG,"ND")),$P(^PSDRUG(DISPDRG,"ND"),"^",10)]"" do +"RTN","TMGPSSDE",433,0) + . set DIE="^PSDRUG(" +"RTN","TMGPSSDE",434,0) + . set DR="28" +"RTN","TMGPSSDE",435,0) + . set DA=DISPDRG +"RTN","TMGPSSDE",436,0) + . do ^DIE +"RTN","TMGPSSDE",437,0) + quit +"RTN","TMGPSSDE",438,0) + ; +"RTN","TMGPSSDE",439,0) +DEA ; +"RTN","TMGPSSDE",440,0) + if $P($G(^PSDRUG(DISPDRG,3)),"^")=1,($P(^PSDRUG(DISPDRG,0),"^",3)[1!($P(^(0),"^",3)[2)) do DSH +"RTN","TMGPSSDE",441,0) + quit +"RTN","TMGPSSDE",442,0) + ; +"RTN","TMGPSSDE",443,0) +DSH W !!,"****************************************************************************" +"RTN","TMGPSSDE",444,0) + W !,"This entry contains a ""1"" or a ""2"" in the ""DEA, SPECIAL HDLG""",! +"RTN","TMGPSSDE",445,0) + w "field, therefore this item has been UNMARKED for CMOP transmission." +"RTN","TMGPSSDE",446,0) + W !,"****************************************************************************",! +"RTN","TMGPSSDE",447,0) + S $P(^PSDRUG(DISPDRG,3),"^")=0 +"RTN","TMGPSSDE",448,0) + kill ^PSDRUG("AQ",DISPDRG) +"RTN","TMGPSSDE",449,0) + set DA=DISPDRG +"RTN","TMGPSSDE",450,0) + N % +"RTN","TMGPSSDE",451,0) + do ^PSSREF +"RTN","TMGPSSDE",452,0) + quit +"RTN","TMGPSSDEE") +0^69^B217084810 +"RTN","TMGPSSDEE",1,0) +TMGPSSDE ;TMG/kst/Custom version of PSSDEE ;03/25/06 +"RTN","TMGPSSDEE",2,0) + ;;1.0;TMG-LIB;**1**;04/25/04 +"RTN","TMGPSSDEE",3,0) + +"RTN","TMGPSSDEE",4,0) +PSSDEE ;BIR/WRT-MASTER DRUG ENTER/EDIT ROUTINE ;01/21/00 +"RTN","TMGPSSDEE",5,0) + ;;1.0;PHARMACY DATA MANAGEMENT;**3,5,15,16,20,22,28,32,34,33,38,57,47,68,61**;9/30/97 +"RTN","TMGPSSDEE",6,0) + +"RTN","TMGPSSDEE",7,0) + ;"***************************************************************** +"RTN","TMGPSSDEE",8,0) + ;"* Custom version of code by Kevin Toppenberg, MD +"RTN","TMGPSSDEE",9,0) + ;"* to allow customization of the code. +"RTN","TMGPSSDEE",10,0) + ;"* +"RTN","TMGPSSDEE",11,0) + ;"***************************************************************** +"RTN","TMGPSSDEE",12,0) + +"RTN","TMGPSSDEE",13,0) + ;"Reference to REACT1^PSNOUT supported by DBIA #2080 +"RTN","TMGPSSDEE",14,0) + ;"Reference to $$UP^XLFSTR(X) supported by DBIA #10104 +"RTN","TMGPSSDEE",15,0) + ;"Reference to $$PSJDF^PSNAPIS(P1,P3) supported by DBIA #2531 +"RTN","TMGPSSDEE",16,0) + ; +"RTN","TMGPSSDEE",17,0) +BEGIN set PSSFLAG=0 +"RTN","TMGPSSDEE",18,0) + do ^PSSDEE2 ;"kill vars +"RTN","TMGPSSDEE",19,0) + set PSSZ=1 +"RTN","TMGPSSDEE",20,0) + F PSSXX=1:1 do quit:PSSFLAG +"RTN","TMGPSSDEE",21,0) + . kill DA +"RTN","TMGPSSDEE",22,0) + . do ASK ;" ask users all questions +"RTN","TMGPSSDEE",23,0) +DONE do ^PSSDEE2 ;" kill vars +"RTN","TMGPSSDEE",24,0) + kill PSSFLAG +"RTN","TMGPSSDEE",25,0) + quit +"RTN","TMGPSSDEE",26,0) + ; +"RTN","TMGPSSDEE",27,0) + ;"================================================================= +"RTN","TMGPSSDEE",28,0) +ASK W ! +"RTN","TMGPSSDEE",29,0) + set DIC="^PSDRUG(" +"RTN","TMGPSSDEE",30,0) + set DIC(0)="QEALMNTV" ;"query/echo/ask/learn=OK/multIndex/IntNumOK/T->searchAllIndexes/verify +"RTN","TMGPSSDEE",31,0) + set DLAYGO=50 ;"force allowing adding record to file 50 +"RTN","TMGPSSDEE",32,0) + set DIC("T")="" ;"present every match to the lookup value +"RTN","TMGPSSDEE",33,0) + do ^DIC +"RTN","TMGPSSDEE",34,0) + kill DIC +"RTN","TMGPSSDEE",35,0) + if Y<0 set PSSFLAG=1 quit +"RTN","TMGPSSDEE",36,0) + ; +"RTN","TMGPSSDEE",37,0) + set (FLG1,FLG2,FLG3,FLG4,FLG5,FLG6,FLG7,FLAG,FLGKY,FLGOI)=0 +"RTN","TMGPSSDEE",38,0) + kill ^TMP($J,"ADD") +"RTN","TMGPSSDEE",39,0) + kill ^TMP($J,"SOL") +"RTN","TMGPSSDEE",40,0) + ; +"RTN","TMGPSSDEE",41,0) + set DA=+Y +"RTN","TMGPSSDEE",42,0) + set DISPDRG=DA +"RTN","TMGPSSDEE",43,0) + L +^PSDRUG(DISPDRG):0 +"RTN","TMGPSSDEE",44,0) + if '$T W !,$C(7),"Another person is editing this one." quit +"RTN","TMGPSSDEE",45,0) + set PSSHUIDG=1 +"RTN","TMGPSSDEE",46,0) + set PSSNEW=$P(Y,"^",3) +"RTN","TMGPSSDEE",47,0) + do USE +"RTN","TMGPSSDEE",48,0) + do NOPE +"RTN","TMGPSSDEE",49,0) + do COMMON +"RTN","TMGPSSDEE",50,0) + do DEA +"RTN","TMGPSSDEE",51,0) + do MF +"RTN","TMGPSSDEE",52,0) + kill PSSHUIDG +"RTN","TMGPSSDEE",53,0) + do DRG^PSSHUIDG(DISPDRG,PSSNEW) +"RTN","TMGPSSDEE",54,0) + L -^PSDRUG(DISPDRG) +"RTN","TMGPSSDEE",55,0) + kill FLG3,PSSNEW +"RTN","TMGPSSDEE",56,0) + quit +"RTN","TMGPSSDEE",57,0) + ; +"RTN","TMGPSSDEE",58,0) + ;"================================================================= +"RTN","TMGPSSDEE",59,0) +COMMON set DIE="^PSDRUG(" +"RTN","TMGPSSDEE",60,0) + set DR="[PSSCOMMON]" +"RTN","TMGPSSDEE",61,0) + do ^DIE +"RTN","TMGPSSDEE",62,0) + quit:$data(Y)!($data(DTOUT)) +"RTN","TMGPSSDEE",63,0) + W:'$data(Y) !,"PRICE PER DISPENSE UNIT: " +"RTN","TMGPSSDEE",64,0) + S:'$data(^PSDRUG(DA,660)) $P(^PSDRUG(DA,660),"^",6)="" +"RTN","TMGPSSDEE",65,0) + W:'$data(Y) $P(^PSDRUG(DA,660),"^",6) +"RTN","TMGPSSDEE",66,0) + do DEA +"RTN","TMGPSSDEE",67,0) + do CK +"RTN","TMGPSSDEE",68,0) + do ASKND +"RTN","TMGPSSDEE",69,0) + do OIKILL^PSSDEE1 +"RTN","TMGPSSDEE",70,0) + do COMMON1 +"RTN","TMGPSSDEE",71,0) + quit +"RTN","TMGPSSDEE",72,0) + ; +"RTN","TMGPSSDEE",73,0) +COMMON1 W !,"Just a reminder...you are editing ",$P(^PSDRUG(DISPDRG,0),"^"),"." +"RTN","TMGPSSDEE",74,0) + set (PSSVVDA,DA)=DISPDRG +"RTN","TMGPSSDEE",75,0) + do DOSN^PSSDOS +"RTN","TMGPSSDEE",76,0) + set DA=PSSVVDA +"RTN","TMGPSSDEE",77,0) + kill PSSVVDA +"RTN","TMGPSSDEE",78,0) + do USE +"RTN","TMGPSSDEE",79,0) + do APP +"RTN","TMGPSSDEE",80,0) + do ORDITM^PSSDEE1 +"RTN","TMGPSSDEE",81,0) + quit +"RTN","TMGPSSDEE",82,0) + ; +"RTN","TMGPSSDEE",83,0) +CK do DSPY^PSSDEE1 +"RTN","TMGPSSDEE",84,0) + set FLGNDF=0 +"RTN","TMGPSSDEE",85,0) + quit +"RTN","TMGPSSDEE",86,0) + ; +"RTN","TMGPSSDEE",87,0) +ASKND set %=-1 +"RTN","TMGPSSDEE",88,0) + if $data(^XUSEC("PSNMGR",DUZ)) do +"RTN","TMGPSSDEE",89,0) + . do MESSAGE^PSSDEE1 +"RTN","TMGPSSDEE",90,0) + . W !!,"Do you wish to match/rematch to NATIONAL DRUG file" +"RTN","TMGPSSDEE",91,0) + . set %=1 +"RTN","TMGPSSDEE",92,0) + . S:FLGMTH=1 %=2 +"RTN","TMGPSSDEE",93,0) + . do YN^DICN +"RTN","TMGPSSDEE",94,0) + if %=0 W !,"If you answer ""yes"", you will attempt to match to NDF." G ASKND +"RTN","TMGPSSDEE",95,0) + if %=2 kill X,Y quit +"RTN","TMGPSSDEE",96,0) + if %<0 kill X,Y quit +"RTN","TMGPSSDEE",97,0) + if %=1 do +"RTN","TMGPSSDEE",98,0) + . do RSET^PSSDEE1 +"RTN","TMGPSSDEE",99,0) + . do EN1^PSSUTIL(DISPDRG,1) +"RTN","TMGPSSDEE",100,0) + . set X="PSNOUT" +"RTN","TMGPSSDEE",101,0) + . X ^%ZOSF("TEST") +"RTN","TMGPSSDEE",102,0) + . if do +"RTN","TMGPSSDEE",103,0) + . . do REACT1^PSNOUT +"RTN","TMGPSSDEE",104,0) + . . set DA=DISPDRG +"RTN","TMGPSSDEE",105,0) + . . if $data(^PSDRUG(DA,"ND")),$P(^PSDRUG(DA,"ND"),"^",2)]"" do ONE +"RTN","TMGPSSDEE",106,0) + quit +"RTN","TMGPSSDEE",107,0) + ; +"RTN","TMGPSSDEE",108,0) +ONE set PSNP=$G(^PSDRUG(DA,"I")) +"RTN","TMGPSSDEE",109,0) + if PSNP,PSNP
1 if $data(^PSDRUG(DISPDRG,2)) DO +"RTN","TMGPSSDEE",401,0) + . set PSSOR=$P(^PSDRUG(DISPDRG,2),"^",1) +"RTN","TMGPSSDEE",402,0) + . if PSSOR]"" DO +"RTN","TMGPSSDEE",403,0) + . . DO EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDEE",404,0) + . . DO EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDEE",405,0) + quit +"RTN","TMGPSSDEE",406,0) + ; +"RTN","TMGPSSDEE",407,0) +MFA if $P($G(^PS(59.7,1,80)),"^",2)>1 do +"RTN","TMGPSSDEE",408,0) + . set PSSOR=$P(^PS(52.6,ENTRY,0),"^",11) +"RTN","TMGPSSDEE",409,0) + . set PSSDD=$P(^PS(52.6,ENTRY,0),"^",2) +"RTN","TMGPSSDEE",410,0) + . if PSSOR]"" do +"RTN","TMGPSSDEE",411,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDEE",412,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDEE",413,0) + . . do MFDD +"RTN","TMGPSSDEE",414,0) + quit +"RTN","TMGPSSDEE",415,0) + ; +"RTN","TMGPSSDEE",416,0) +MFS if $P($G(^PS(59.7,1,80)),"^",2)>1 do +"RTN","TMGPSSDEE",417,0) + . set PSSOR=$P(^PS(52.7,ENTRY,0),"^",11) +"RTN","TMGPSSDEE",418,0) + . set PSSDD=$P(^PS(52.7,ENTRY,0),"^",2) +"RTN","TMGPSSDEE",419,0) + . if PSSOR]"" do +"RTN","TMGPSSDEE",420,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDEE",421,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDEE",422,0) + . . do MFDD +"RTN","TMGPSSDEE",423,0) + quit +"RTN","TMGPSSDEE",424,0) + ; +"RTN","TMGPSSDEE",425,0) +MFDD if $data(^PSDRUG(PSSDD,2)) do +"RTN","TMGPSSDEE",426,0) + . set PSSOR=$P(^PSDRUG(PSSDD,2),"^",1) +"RTN","TMGPSSDEE",427,0) + . if PSSOR]"" do +"RTN","TMGPSSDEE",428,0) + . . do EN^PSSPOIDT(PSSOR) +"RTN","TMGPSSDEE",429,0) + . . do EN2^PSSHL1(PSSOR,"MUP") +"RTN","TMGPSSDEE",430,0) + quit +"RTN","TMGPSSDEE",431,0) + ; +"RTN","TMGPSSDEE",432,0) +OPEI if $data(^PSDRUG(DISPDRG,"ND")),$P(^PSDRUG(DISPDRG,"ND"),"^",10)]"" do +"RTN","TMGPSSDEE",433,0) + . set DIE="^PSDRUG(" +"RTN","TMGPSSDEE",434,0) + . set DR="28" +"RTN","TMGPSSDEE",435,0) + . set DA=DISPDRG +"RTN","TMGPSSDEE",436,0) + . do ^DIE +"RTN","TMGPSSDEE",437,0) + quit +"RTN","TMGPSSDEE",438,0) + ; +"RTN","TMGPSSDEE",439,0) +DEA ; +"RTN","TMGPSSDEE",440,0) + if $P($G(^PSDRUG(DISPDRG,3)),"^")=1,($P(^PSDRUG(DISPDRG,0),"^",3)[1!($P(^(0),"^",3)[2)) do DSH +"RTN","TMGPSSDEE",441,0) + quit +"RTN","TMGPSSDEE",442,0) + ; +"RTN","TMGPSSDEE",443,0) +DSH W !!,"****************************************************************************" +"RTN","TMGPSSDEE",444,0) + W !,"This entry contains a ""1"" or a ""2"" in the ""DEA, SPECIAL HDLG""",! +"RTN","TMGPSSDEE",445,0) + w "field, therefore this item has been UNMARKED for CMOP transmission." +"RTN","TMGPSSDEE",446,0) + W !,"****************************************************************************",! +"RTN","TMGPSSDEE",447,0) + S $P(^PSDRUG(DISPDRG,3),"^")=0 +"RTN","TMGPSSDEE",448,0) + kill ^PSDRUG("AQ",DISPDRG) +"RTN","TMGPSSDEE",449,0) + set DA=DISPDRG +"RTN","TMGPSSDEE",450,0) + N % +"RTN","TMGPSSDEE",451,0) + do ^PSSREF +"RTN","TMGPSSDEE",452,0) + quit +"RTN","TMGPUTN0") +0^70^B125965713 +"RTN","TMGPUTN0",1,0) +TMGPUTN0 ;TMG/kst/TIU Document Upload look-up function ;03/25/06 +"RTN","TMGPUTN0",2,0) + ;;1.0;TMG-LIB;**1**;04/25/04 +"RTN","TMGPUTN0",3,0) + +"RTN","TMGPUTN0",4,0) + ;"TIU Document Upload look-up function +"RTN","TMGPUTN0",5,0) + +"RTN","TMGPUTN0",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGPUTN0",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGPUTN0",8,0) + ;"4-25-2004 +"RTN","TMGPUTN0",9,0) + +"RTN","TMGPUTN0",10,0) + +"RTN","TMGPUTN0",11,0) +LOOKUP(DocTitle,Autosign) ; +"RTN","TMGPUTN0",12,0) + ;"----------------------------------------------------------------------------------- +"RTN","TMGPUTN0",13,0) + ;"Upload look-up function +"RTN","TMGPUTN0",14,0) + ;"by Kevin Toppenberg +"RTN","TMGPUTN0",15,0) + ;"4-25-2004 +"RTN","TMGPUTN0",16,0) + ;" +"RTN","TMGPUTN0",17,0) + ;"PURPOSE: +"RTN","TMGPUTN0",18,0) + ;"This code is used as look-up code by the TIU document upload routines. +"RTN","TMGPUTN0",19,0) + ;"It has a very specific purpose. It was written for uploading documents +"RTN","TMGPUTN0",20,0) + ;" from a Medic EMR system. Notes had been dumped out of that system, and +"RTN","TMGPUTN0",21,0) + ;" were to be ported into VistA +"RTN","TMGPUTN0",22,0) + ;"Each note has a header with patient name, dob, ssnum, chart#, provider +"RTN","TMGPUTN0",23,0) + ;"Addendum -- this code will also work with less extensive patient data. +"RTN","TMGPUTN0",24,0) + ;" +"RTN","TMGPUTN0",25,0) + ;"INPUT +"RTN","TMGPUTN0",26,0) + ;" The variable (with global scope) listed below are expected as input. +"RTN","TMGPUTN0",27,0) + ;" Not all will be required every time, however. +"RTN","TMGPUTN0",28,0) + ;" DocTitle -- this is the type of document type. i.e. 'OFFICE VISIT' +"RTN","TMGPUTN0",29,0) + ;" This will be used so that this code can service multiple +"RTN","TMGPUTN0",30,0) + ;" types, i.e. NOTE, PRESCRIPTION CALL IN, etc. +"RTN","TMGPUTN0",31,0) + ;" Autosign -- [OPTIONAL] if value=1 then document will be created as SIGNED +"RTN","TMGPUTN0",32,0) + ;"Results: Document number that uploaded code should be put into is returned in variable Y +"RTN","TMGPUTN0",33,0) + ;" +"RTN","TMGPUTN0",34,0) + ;" +"RTN","TMGPUTN0",35,0) + ;"*How it works*: +"RTN","TMGPUTN0",36,0) + ;"A remote computer connects to the server running VistA. This remote computer must be +"RTN","TMGPUTN0",37,0) + ;" able to upload a file using kermit. The only way I know to do this is to be on a PC +"RTN","TMGPUTN0",38,0) + ;" using a terminal emulator program that has kermit upload ability. +"RTN","TMGPUTN0",39,0) + ;"From this remote session, get into the TIU menu system and navigate to the option to +"RTN","TMGPUTN0",40,0) + ;" upload a document. Note, one's upload parameters must be set up for this to work. +"RTN","TMGPUTN0",41,0) + ;"The remote user will see a #N3, and use this que to acutally upload the file. +"RTN","TMGPUTN0",42,0) + ;"After the file is uploaded, it is then processed. Each document specifies what 'type' it is +"RTN","TMGPUTN0",43,0) + ;" for example 'OFFICE VISIT' +"RTN","TMGPUTN0",44,0) + ;"The server then loads up the parameters for OFFICE VISIT and processes each item in the header. +"RTN","TMGPUTN0",45,0) + ;"Here is an example progress note that this file can process +"RTN","TMGPUTN0",46,0) + ;"-------------------------------------- +"RTN","TMGPUTN0",47,0) + ;"[NewDict]: OFFICE VISIT +"RTN","TMGPUTN0",48,0) + ;"Name: JONES,BASKETBALL +"RTN","TMGPUTN0",49,0) + ;"Alias: JONES,BOB +"RTN","TMGPUTN0",50,0) + ;"DOB: 4/13/71 +"RTN","TMGPUTN0",51,0) + ;"Sex: MALE +"RTN","TMGPUTN0",52,0) + ;"SSNumber: 555 11 9999 +"RTN","TMGPUTN0",53,0) + ;"ChartNumber: 10034 +"RTN","TMGPUTN0",54,0) + ;"Date: 7/22/2002 +"RTN","TMGPUTN0",55,0) + ;"Location: Peds_Office +"RTN","TMGPUTN0",56,0) + ;"Provider: KEVIN TOPPENBERG MD +"RTN","TMGPUTN0",57,0) + ;"[TEXT] +"RTN","TMGPUTN0",58,0) + ;" +"RTN","TMGPUTN0",59,0) + ;" CHIEF COMPLAINT: Follow up blood clot. +"RTN","TMGPUTN0",60,0) + ;" +"RTN","TMGPUTN0",61,0) + ;" HPI: +"RTN","TMGPUTN0",62,0) + ;" 1. BJ was in the emergency room 3 days ago. He was being +"RTN","TMGPUTN0",63,0) + ;" evaluated for left lower extremity pain. He said that they did +"RTN","TMGPUTN0",64,0) + ;" radiographic studies and told him that he had a blood clot in +"RTN","TMGPUTN0",65,0) + ;" .... (snip) +"RTN","TMGPUTN0",66,0) + ;" +"RTN","TMGPUTN0",67,0) + ;"[END] +"RTN","TMGPUTN0",68,0) + ;"-------------------------------------- +"RTN","TMGPUTN0",69,0) + ;"[NewDic] tells the system that a document header is starting +"RTN","TMGPUTN0",70,0) + ;"'Name' is a CAPTION, and the value for this caption is 'JONES,BASKETBALL' +"RTN","TMGPUTN0",71,0) + ;"The upload system will put this value into a variable. In this case, I specified +"RTN","TMGPUTN0",72,0) + ;" that the variable name TMGNAME to be used. +"RTN","TMGPUTN0",73,0) + ;" +"RTN","TMGPUTN0",74,0) + ;"Here are each caption and its cooresponding Variable: +"RTN","TMGPUTN0",75,0) + ;"Name <--> TMGNAME +"RTN","TMGPUTN0",76,0) + ;"DOB <--> TMGDOB +"RTN","TMGPUTN0",77,0) + ;"Sex <--> TMGSEX +"RTN","TMGPUTN0",78,0) + ;"SSNumber <--> TMGSSNUM +"RTN","TMGPUTN0",79,0) + ;"ChartNumber <--> TMGPTNUM +"RTN","TMGPUTN0",80,0) + ;"Date <--> TIUVDT +"RTN","TMGPUTN0",81,0) + ;"Provider <--> PERSON +"RTN","TMGPUTN0",82,0) + ;"Alias <--> TMGALIAS +"RTN","TMGPUTN0",83,0) + ;"Location: <--> TIULOC +"RTN","TMGPUTN0",84,0) + ;" +"RTN","TMGPUTN0",85,0) + ;"Document Title is passed to function as 'DocTitle' +"RTN","TMGPUTN0",86,0) + ;" +"RTN","TMGPUTN0",87,0) + ;"After the note has been processed and all the above variables have been set, the server +"RTN","TMGPUTN0",88,0) + ;"calls a 'look-up' function. This function is supposed to return the document number where the +"RTN","TMGPUTN0",89,0) + ;"text is supposed to be put (the number should be put in Y) +"RTN","TMGPUTN0",90,0) + ;" +"RTN","TMGPUTN0",91,0) + ;"This look-up function has an extra twist. I am using it to register patients on the fly +"RTN","TMGPUTN0",92,0) + ;" if needed. I am doing this because I had about 30,000 patients in my database to transfer, +"RTN","TMGPUTN0",93,0) + ;" and I had difficulty getting a separate file with just demographics etc. So, if a patient +"RTN","TMGPUTN0",94,0) + ;" is not already in the database, they are registered here. +"RTN","TMGPUTN0",95,0) + ;" +"RTN","TMGPUTN0",96,0) + ;"Extra note: +"RTN","TMGPUTN0",97,0) + ;"When this function is called, the TIU upload process has already set up some variables. +"RTN","TMGPUTN0",98,0) + ;"DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that the uploaded text was temporarily store in. +"RTN","TMGPUTN0",99,0) + ;" In other words, here DA = the serial index number of the document to be uploaded +"RTN","TMGPUTN0",100,0) + ;" i.e. 1 for the first, 2 for the second etc. +"RTN","TMGPUTN0",101,0) + ;"TIUI = the line index of the beginning of the report to be processed (i.e. the line +"RTN","TMGPUTN0",102,0) + ;" that starts with [TEXT] +"RTN","TMGPUTN0",103,0) + ;"DUZ = Current user number. +"RTN","TMGPUTN0",104,0) + ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params +"RTN","TMGPUTN0",105,0) + ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. +"RTN","TMGPUTN0",106,0) + +"RTN","TMGPUTN0",107,0) + write "+-------------------------------------+",! +"RTN","TMGPUTN0",108,0) + write "| Starting upload code... |",! +"RTN","TMGPUTN0",109,0) + write "+-------------------------------------+",! +"RTN","TMGPUTN0",110,0) + +"RTN","TMGPUTN0",111,0) + set BuffNum=$get(DA) ;"Store which upload buffer we are working on. +"RTN","TMGPUTN0",112,0) + set BuffIdx=$get(TIUI) ;"Store line number (in upload buffer) we are starting with. +"RTN","TMGPUTN0",113,0) + +"RTN","TMGPUTN0",114,0) + ;"new cName set cName="NAME" +"RTN","TMGPUTN0",115,0) + ;"new cDOB set cDOB="DOB" +"RTN","TMGPUTN0",116,0) + ;"new cSex set cSex="SEX" +"RTN","TMGPUTN0",117,0) + ;"new cSSNum set cSSNum="SSNUM" +"RTN","TMGPUTN0",118,0) + ;"new cPtNum set cPtNum="PATIENTNUM" +"RTN","TMGPUTN0",119,0) + ;"new cAlias set cAlias="ALIAS" +"RTN","TMGPUTN0",120,0) + ;"new cMissing set cMissing="MISSING" +"RTN","TMGPUTN0",121,0) + ;"new cExtra set cExtra="EXTRA" +"RTN","TMGPUTN0",122,0) + ;"new cRecNum set cRecNum="RECNUM" +"RTN","TMGPUTN0",123,0) + ;"new cProvider set cProvider="PROVIDER" +"RTN","TMGPUTN0",124,0) + ;"new cProvIEN set cProvIEN="PROVIDER IEN" +"RTN","TMGPUTN0",125,0) + ;"new cLocation set cLocation="LOCATION" +"RTN","TMGPUTN0",126,0) + ;"new cTranscript set cTranscript="TRANSCRIPTIONIST" +"RTN","TMGPUTN0",127,0) + ;"new cBadDate set cBadDate="??/??/??" +"RTN","TMGPUTN0",128,0) + ;"new cPatIEN set cPatIEN="DFN" ;"DFN = Patient IEN +"RTN","TMGPUTN0",129,0) + ;"new cAutosign set cAutosign="AUTO SIGN" +"RTN","TMGPUTN0",130,0) + ;"new cDocIEN set cDocIEN="DOC IEN" +"RTN","TMGPUTN0",131,0) + ;"new cCharTrans set cCharTrans="CHARACTER COUNT - TRANSCRIPTIONIST'S" +"RTN","TMGPUTN0",132,0) + ;"new cCharTotal set cCharTotal="CHAR COUNT - TOTAL" +"RTN","TMGPUTN0",133,0) + ;"new cLineCount set cLineCount="LINE COUNT" +"RTN","TMGPUTN0",134,0) + new cMaxNoteWidth set cMaxNoteWidth=60 +"RTN","TMGPUTN0",135,0) + +"RTN","TMGPUTN0",136,0) + ;"Field (f) constants +"RTN","TMGPUTN0",137,0) + new fPatient set fPatient=.02 ;"field .02 = PATIENT +"RTN","TMGPUTN0",138,0) + new fVisit set fVisit=.03 ;"field .03 = VISIT +"RTN","TMGPUTN0",139,0) + new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE +"RTN","TMGPUTN0",140,0) + new fStatus set fStatus=.05 ;"field .05 = STATUS +"RTN","TMGPUTN0",141,0) + new fParent set fParent=.06 ;"field .06 = PARENT +"RTN","TMGPUTN0",142,0) + new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) +"RTN","TMGPUTN0",143,0) + new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) +"RTN","TMGPUTN0",144,0) + new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME +"RTN","TMGPUTN0",145,0) + new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR +"RTN","TMGPUTN0",146,0) + new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer +"RTN","TMGPUTN0",147,0) + new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION +"RTN","TMGPUTN0",148,0) + new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner +"RTN","TMGPUTN0",149,0) + new fAttending set fAttending=1209 ;"field 1209 = ATTENDING +"RTN","TMGPUTN0",150,0) + new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION +"RTN","TMGPUTN0",151,0) + new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE +"RTN","TMGPUTN0",152,0) + new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200) +"RTN","TMGPUTN0",153,0) + new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' +"RTN","TMGPUTN0",154,0) + new fService set fService=1404 ;"field 1404 = SERVICE +"RTN","TMGPUTN0",155,0) + new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by +"RTN","TMGPUTN0",156,0) + new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. +"RTN","TMGPUTN0",157,0) + new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST +"RTN","TMGPUTN0",158,0) + new fLineCount set fLineCout=.1 ;"field .1 = LINE COUNT +"RTN","TMGPUTN0",159,0) + +"RTN","TMGPUTN0",160,0) + ;" Piece (p) constants +"RTN","TMGPUTN0",161,0) + new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02) +"RTN","TMGPUTN0",162,0) + new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03) +"RTN","TMGPUTN0",163,0) + new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07) +"RTN","TMGPUTN0",164,0) + new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08) +"RTN","TMGPUTN0",165,0) + new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204) +"RTN","TMGPUTN0",166,0) + new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = HOSPITAL LOCATION (field 1205) +"RTN","TMGPUTN0",167,0) + new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210) +"RTN","TMGPUTN0",168,0) + new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209) +"RTN","TMGPUTN0",169,0) + new pService set pService=4 ;"Node 14,piece 4 = SERVICE (field 1404) +"RTN","TMGPUTN0",170,0) + +"RTN","TMGPUTN0",171,0) + ;"if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPUTN0",172,0) + new TMGDEBUG +"RTN","TMGPUTN0",173,0) + ;"set TMGDEBUG=+$piece($get(^TMG(22711,1,0)),"^",2) ;2=to Scrn; 3=to file +"RTN","TMGPUTN0",174,0) + set TMGDEBUG=0 ;"2=to Scrn; 3=to file +"RTN","TMGPUTN0",175,0) + +"RTN","TMGPUTN0",176,0) + ;"if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGPUTN0",177,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGPUTN0",178,0) + +"RTN","TMGPUTN0",179,0) + new DBIndent,PriorErrorFound +"RTN","TMGPUTN0",180,0) + new Patient +"RTN","TMGPUTN0",181,0) + new DocIEN set DocIEN=-1 +"RTN","TMGPUTN0",182,0) + new Document +"RTN","TMGPUTN0",183,0) + new NewDoc set NewDoc=0 +"RTN","TMGPUTN0",184,0) + new result set result=1 ;"cOKToCont +"RTN","TMGPUTN0",185,0) + +"RTN","TMGPUTN0",186,0) + ;"do OpenLogFile^TMGDEBUG("/tmp/","M_Debug_TIUPUTx.tmp") +"RTN","TMGPUTN0",187,0) + if $get(TMGDEBUG)>0 do OpenDefLogFile^TMGDEBUG +"RTN","TMGPUTN0",188,0) + +"RTN","TMGPUTN0",189,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent," ^TMGPUTN0 (as close to start as possible)") +"RTN","TMGPUTN0",190,0) + +"RTN","TMGPUTN0",191,0) + do PtArrayCreate(.Patient) ;"Load upload info into Patient array +"RTN","TMGPUTN0",192,0) + set result=$$DocArrayCreate(.Document) ;"Load upload document info into Document array +"RTN","TMGPUTN0",193,0) + if result=cAbort goto LUDone +"RTN","TMGPUTN0",194,0) + set Document("DFN")=$$GetDFN^TMGGDFN(.Patient) ;"Store DFN of patient. +"RTN","TMGPUTN0",195,0) + if Document("DFN")'>0 set result=cAbort goto LUDone ;"Abort. +"RTN","TMGPUTN0",196,0) + set Document("AUTO SIGN")=$get(Autosign,1) ;"default to YES auto-signing +"RTN","TMGPUTN0",197,0) + ;"06-19-05 Changed to disable autosigning. If document is +"RTN","TMGPUTN0",198,0) + ;" autosigned here, then no prompt for printing elsewhere. +"RTN","TMGPUTN0",199,0) + ;"9-1-05 Resuming autosigning. Currently the outside transcriptionists are already +"RTN","TMGPUTN0",200,0) + ;" printing the notes before giving them to us for upload. +"RTN","TMGPUTN0",201,0) + ;" Changed default to be YES autosign +"RTN","TMGPUTN0",202,0) + ;"set Document("AUTO SIGN")=0 ;"override setting passed in... +"RTN","TMGPUTN0",203,0) + +"RTN","TMGPUTN0",204,0) + set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=$$BuffCharCount() ;"Count character prior to any wrapping/merging etc. +"RTN","TMGPUTN0",205,0) + set result=$$PrepUploadBuf() ;"Do any word-wrapping etc needed in upload buffer +"RTN","TMGPUTN0",206,0) + if result=cAbort goto LUDone +"RTN","TMGPUTN0",207,0) + set DocIEN=$$PrepDoc(.Document,.NewDoc) ;"Prepair a document to put upload into. Credits transcription +"RTN","TMGPUTN0",208,0) + +"RTN","TMGPUTN0",209,0) + set Y=DocIEN +"RTN","TMGPUTN0",210,0) + merge TMGDOC=Document ;"Create a global -- will kill after followup code +"RTN","TMGPUTN0",211,0) +LUDone +"RTN","TMGPUTN0",212,0) + ;"put result into Y. TIU filing system looks for results in Yi +"RTN","TMGPUTN0",213,0) + if result=cAbort set Y=-1 +"RTN","TMGPUTN0",214,0) + +"RTN","TMGPUTN0",215,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",216,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"On exit, Y=",Y) +"RTN","TMGPUTN0",217,0) + . do DebugExit^TMGDEBUG(.DBIndent," ^TMGPUTN0") +"RTN","TMGPUTN0",218,0) + +"RTN","TMGPUTN0",219,0) + quit +"RTN","TMGPUTN0",220,0) + +"RTN","TMGPUTN0",221,0) + +"RTN","TMGPUTN0",222,0) + +"RTN","TMGPUTN0",223,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",224,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",225,0) + ;" S U B R O U T I N E S +"RTN","TMGPUTN0",226,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",227,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",228,0) + ;"PtArrayCreate(Array) +"RTN","TMGPUTN0",229,0) + ;"DocArrayCreate(Document) +"RTN","TMGPUTN0",230,0) + ;"PrepDoc(Document,NewDoc); +"RTN","TMGPUTN0",231,0) + ;"GetDocTIEN(Title) +"RTN","TMGPUTN0",232,0) + ;"GetLocIEN(Location) +"RTN","TMGPUTN0",233,0) + ;"GetService(IEN) +"RTN","TMGPUTN0",234,0) + ;"GetProvIEN(Provider) +"RTN","TMGPUTN0",235,0) + ;"GetRecord(Document,NewDoc,AskOK,Editable) +"RTN","TMGPUTN0",236,0) + ;"DocExists(Document) +"RTN","TMGPUTN0",237,0) + ;"BuffCharCount() +"RTN","TMGPUTN0",238,0) + ;"PrepUploadBuf() +"RTN","TMGPUTN0",239,0) + +"RTN","TMGPUTN0",240,0) + ;"NeedsReformat(MaxWidth) +"RTN","TMGPUTN0",241,0) + ;"CutNote(Array) +"RTN","TMGPUTN0",242,0) + ;"PasteNote(Array,NextNoteI) +"RTN","TMGPUTN0",243,0) + ;"CompToBuff(ExistingIEN,UplTIEN,UplDate) +"RTN","TMGPUTN0",244,0) + ;"CreateRec(Document) ; +"RTN","TMGPUTN0",245,0) + ;"StuffRec(Document,PARENT) +"RTN","TMGPUTN0",246,0) + ;"MakeVisit(Document) +"RTN","TMGPUTN0",247,0) + ;"FOLLOWUP(DocIEN) ;Post-filing code for PROGRESS NOTES +"RTN","TMGPUTN0",248,0) + +"RTN","TMGPUTN0",249,0) + +"RTN","TMGPUTN0",250,0) +PtArrayCreate(Array) +"RTN","TMGPUTN0",251,0) + ;"SCOPE: Private +"RTN","TMGPUTN0",252,0) + ;"Purpose: To put global scope vars (i.e. TMGNAME,TMGSSNUM etc) into +"RTN","TMGPUTN0",253,0) + ;" an array for easier portability +"RTN","TMGPUTN0",254,0) + ;"Input: Array, must be passed by reference +"RTN","TMGPUTN0",255,0) + ;" The global-scope variables setup by the upload system, and are used here: +"RTN","TMGPUTN0",256,0) + ;" TMGPTNUM,TMGSSNUM,TMGSSNUM,TMGNAME,TMGDOB,TMGSEX +"RTN","TMGPUTN0",257,0) + ;"Output: Array is loaded with info, like this: +"RTN","TMGPUTN0",258,0) + ;" set Array("SSNUM")="123-45-6789" +"RTN","TMGPUTN0",259,0) + ;" set Array("NAME")="DOE,JOHN" +"RTN","TMGPUTN0",260,0) + ;" set Array("DOB")=TMGDOB +"RTN","TMGPUTN0",261,0) + ;" set Array("PATIENTNUM")="12345677" +"RTN","TMGPUTN0",262,0) + ;" set Array("SEX")="M" +"RTN","TMGPUTN0",263,0) + ;" set Array("ALIAS")="DOE,JOHNNY" +"RTN","TMGPUTN0",264,0) + ;"Results: none +"RTN","TMGPUTN0",265,0) + +"RTN","TMGPUTN0",266,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PtArrayCreate") +"RTN","TMGPUTN0",267,0) + +"RTN","TMGPUTN0",268,0) + if $data(TMGPTNUM)#10'=0 do +"RTN","TMGPUTN0",269,0) + . set TMGPTNUM=$translate(TMGPTNUM,"PWCI*","") ;"Clean off alpha characters -- not needed. +"RTN","TMGPUTN0",270,0) + . ;"set TMGPTNUM=$$Trim^TMGSTUTL(TMGPTNUM) +"RTN","TMGPUTN0",271,0) + . set TMGPTNUM=$$FORMAT^DPTNAME(.TMGPTNUM,3,30) ;"Use same input transform as for .01 field of PATIENT file +"RTN","TMGPUTN0",272,0) + . set Array("PATIENTNUM")=TMGPTNUM +"RTN","TMGPUTN0",273,0) + +"RTN","TMGPUTN0",274,0) + if $data(TMGSSNUM)#10'=0 do +"RTN","TMGPUTN0",275,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TMGSSNUM=",TMGSSNUM) +"RTN","TMGPUTN0",276,0) + . set TMGSSNUM=$translate(TMGSSNUM," /-","") ;"Clean delimiters +"RTN","TMGPUTN0",277,0) + . if +TMGSSNUM=0 set TMGSSNUM="" ;was ... "P" +"RTN","TMGPUTN0",278,0) + . if (TMGSSNUM="P")!(+TMGSSNUM>0) set Array("SSNUM")=TMGSSNUM +"RTN","TMGPUTN0",279,0) + else do +"RTN","TMGPUTN0",280,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No TMGSSNUM found") +"RTN","TMGPUTN0",281,0) + +"RTN","TMGPUTN0",282,0) + set Array("NAME")=$$FormatName^TMGMISC(.TMGNAME) +"RTN","TMGPUTN0",283,0) + +"RTN","TMGPUTN0",284,0) + if $data(TMGALIAS)#10'=0 do +"RTN","TMGPUTN0",285,0) + . set TMGALIAS=$translate(TMGALIAS,"*","") +"RTN","TMGPUTN0",286,0) + . set TMGALIAS=$$FORMAT^DPTNAME(TMGALIAS,3,30) ;"convert to 'internal' format (strip .'s etc) +"RTN","TMGPUTN0",287,0) + . set Array("ALIAS")=TMGALIAS +"RTN","TMGPUTN0",288,0) + +"RTN","TMGPUTN0",289,0) + if $data(TMGSEX)#10'=0 do +"RTN","TMGPUTN0",290,0) + . set TMGSEX=$$UP^XLFSTR($get(TMGSEX)) +"RTN","TMGPUTN0",291,0) + . if TMGSEX="M" set TMGSEX="MALE" +"RTN","TMGPUTN0",292,0) + . else if TMGSEX="F" set TMGSEX="FEMALE" +"RTN","TMGPUTN0",293,0) + . set Array("SEX")=TMGSEX +"RTN","TMGPUTN0",294,0) + +"RTN","TMGPUTN0",295,0) + if $data(TMGDOB)#10'=0 do +"RTN","TMGPUTN0",296,0) + . if +TMGDOB>0 set Array("DOB")=TMGDOB +"RTN","TMGPUTN0",297,0) + . else quit +"RTN","TMGPUTN0",298,0) + . new CurDate,CurYr +"RTN","TMGPUTN0",299,0) + . do DT^DILF("E","T",.CurDate) +"RTN","TMGPUTN0",300,0) + . set CurDate=$get(CurDate(0)) +"RTN","TMGPUTN0",301,0) + . if CurDate="" quit +"RTN","TMGPUTN0",302,0) + . set CurYr=$piece(CurDate,", ",2) +"RTN","TMGPUTN0",303,0) + . new DOBYr +"RTN","TMGPUTN0",304,0) + . set DOBYr=$piece(TMGDOB,"/",3) +"RTN","TMGPUTN0",305,0) + . if DOBYr>CurYr do ;"we have a Y2K problem +"RTN","TMGPUTN0",306,0) + . . set DOBYr=DOBYr-100 +"RTN","TMGPUTN0",307,0) + . . if DOBYr'>0 quit +"RTN","TMGPUTN0",308,0) + . . set TMGDOB=$piece(TMGDOB,"/",1,2)_"/"_DOBYr +"RTN","TMGPUTN0",309,0) + . . set Array("DOB")=TMGDOB +"RTN","TMGPUTN0",310,0) + +"RTN","TMGPUTN0",311,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Array") +"RTN","TMGPUTN0",312,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PtArrayCreate") +"RTN","TMGPUTN0",313,0) + quit +"RTN","TMGPUTN0",314,0) + +"RTN","TMGPUTN0",315,0) + +"RTN","TMGPUTN0",316,0) + +"RTN","TMGPUTN0",317,0) +DocArrayCreate(Document) +"RTN","TMGPUTN0",318,0) + ;"SCOPE: Private +"RTN","TMGPUTN0",319,0) + ;"Purpose: To put TIUVDT etc. etc into an array for easier portibility +"RTN","TMGPUTN0",320,0) + ;"Input: Document -- OUT parameter, must be passed by reference +"RTN","TMGPUTN0",321,0) + ;" The global-scope variables setup by the upload system are used: +"RTN","TMGPUTN0",322,0) + ;" TIUVDT,PERSON,TIULOC, (and also DocTitle) +"RTN","TMGPUTN0",323,0) + ;"Output: Document is loaded with info. +"RTN","TMGPUTN0",324,0) + ;"Results: 1=OKToCont, or cAbort +"RTN","TMGPUTN0",325,0) + +"RTN","TMGPUTN0",326,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DocArrayCreate") +"RTN","TMGPUTN0",327,0) + +"RTN","TMGPUTN0",328,0) + new result set result=1 ;"cOKToCont +"RTN","TMGPUTN0",329,0) + +"RTN","TMGPUTN0",330,0) + set Document("PROVIDER")=$get(PERSON) +"RTN","TMGPUTN0",331,0) + if Document("PROVIDER")="" do goto DACDone +"RTN","TMGPUTN0",332,0) + . set result=cAbort +"RTN","TMGPUTN0",333,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error!! Missing required provider name.") +"RTN","TMGPUTN0",334,0) + set Document("PROVIDER IEN")=$$GetProvIEN(Document("PROVIDER")) +"RTN","TMGPUTN0",335,0) + set Document("LOCATION")=$get(TIULOC,"Main_Office") +"RTN","TMGPUTN0",336,0) + set Document("DATE")=$get(TIUVDT) +"RTN","TMGPUTN0",337,0) + set Document("TITLE")=$get(DocTitle,"NOTE") +"RTN","TMGPUTN0",338,0) + +"RTN","TMGPUTN0",339,0) + ;"Decide which transcriptionist is. This will be used for crediting productivity. +"RTN","TMGPUTN0",340,0) + ;"If transcriptionist not specified, current user (DUZ) is assumed. +"RTN","TMGPUTN0",341,0) + if $data(TMGTRANS)#10=0 set TMGTRANS=$piece($get(^VA(200,DUZ,0)),"^",1) +"RTN","TMGPUTN0",342,0) + set Document("TRANSCRIPTIONIST")=$$FormatName^TMGMISC(TMGTRANS) +"RTN","TMGPUTN0",343,0) + +"RTN","TMGPUTN0",344,0) + if (Document("DATE")="")!(Document("DATE")="00/00/00") do goto DACDone +"RTN","TMGPUTN0",345,0) + . set result=cAbort +"RTN","TMGPUTN0",346,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Error!! Bad or missing document date.") +"RTN","TMGPUTN0",347,0) + +"RTN","TMGPUTN0",348,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Document") +"RTN","TMGPUTN0",349,0) + +"RTN","TMGPUTN0",350,0) +DACDone +"RTN","TMGPUTN0",351,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DocArrayCreate") +"RTN","TMGPUTN0",352,0) + quit result +"RTN","TMGPUTN0",353,0) + +"RTN","TMGPUTN0",354,0) + +"RTN","TMGPUTN0",355,0) + +"RTN","TMGPUTN0",356,0) +PrepDoc(Document,NewDoc); +"RTN","TMGPUTN0",357,0) + ;"Scope: PRIVATE. +"RTN","TMGPUTN0",358,0) + ;" Addendum 7/25/07. Will be called by RPC call BLANKTIU^TMGRPC1 +"RTN","TMGPUTN0",359,0) + ;" to return a blank document +"RTN","TMGPUTN0",360,0) + ;"Purpose: Prepair a document to put upload into. +"RTN","TMGPUTN0",361,0) + ;"Input: Document -- an array as follows: +"RTN","TMGPUTN0",362,0) + ;" Document("DFN")=DFN, the record number of the patient. +"RTN","TMGPUTN0",363,0) + ;" Document("PROVIDER IEN")= the IEN of the provider +"RTN","TMGPUTN0",364,0) + ;" Document("LOCATION")= the location of the visit +"RTN","TMGPUTN0",365,0) + ;" Document("DATE")= the date of the visit. +"RTN","TMGPUTN0",366,0) + ;" Document("TITLE")= the title of the note +"RTN","TMGPUTN0",367,0) + ;" Document(cVisitStr) an OUT PARAMETER +"RTN","TMGPUTN0",368,0) + ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist +"RTN","TMGPUTN0",369,0) + ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist +"RTN","TMGPUTN0",370,0) + ;" NewDoc: OPTIONAL flag, passed back with +"RTN","TMGPUTN0",371,0) + ;" NewDoc = 1 if returned docmt is new +"RTN","TMGPUTN0",372,0) + ;" NewDoc = 0 if returned docmt already existed, timeout, etc +"RTN","TMGPUTN0",373,0) + ;"Results: returns record number (IEN) ready to accept upload (or -1 if failure) +"RTN","TMGPUTN0",374,0) + ;" Also Document("DOC IEN") will have this same IEN +"RTN","TMGPUTN0",375,0) + ;" NOTE: if result is -1 then errors are passed back in +"RTN","TMGPUTN0",376,0) + ;" Document("ERROR") node +"RTN","TMGPUTN0",377,0) + ;" Document("ERROR",n)="ERROR.. Stuffing new document." +"RTN","TMGPUTN0",378,0) + ;" Document("ERROR","NUM")=n +"RTN","TMGPUTN0",379,0) + ;" Document("ERROR","FM INFO")=merge with DIERR array +"RTN","TMGPUTN0",380,0) + +"RTN","TMGPUTN0",381,0) + ;" PIEN = patient internal entry number +"RTN","TMGPUTN0",382,0) + ;" Global-Scope variables expected: +"RTN","TMGPUTN0",383,0) + ;" PERSON, TMGSSNUM etc. defined above +"RTN","TMGPUTN0",384,0) + ;" TIUVDT expected +"RTN","TMGPUTN0",385,0) + ;" TIULOC is also expected (i.e. 'LAUGHLIN_OFFICE') +"RTN","TMGPUTN0",386,0) + ;" +"RTN","TMGPUTN0",387,0) + ;"Output: will return document number, or -1 if failure. +"RTN","TMGPUTN0",388,0) + ;"NOTES: This originated from ^TIUPUTPN +"RTN","TMGPUTN0",389,0) + ;" +"RTN","TMGPUTN0",390,0) + ;" Look-up code used by router/filer +"RTN","TMGPUTN0",391,0) + ;" Required variables: TMGSSNUM, TIUVDT +"RTN","TMGPUTN0",392,0) + ;" i.e., TMGSSNUM (Pt SS-Number) and TIUVDT (visit date) must be set prior to call. +"RTN","TMGPUTN0",393,0) + ;" +"RTN","TMGPUTN0",394,0) + +"RTN","TMGPUTN0",395,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PrepDoc") +"RTN","TMGPUTN0",396,0) + +"RTN","TMGPUTN0",397,0) + new cIntDate set cIntDate="DATE"_"-Internal" +"RTN","TMGPUTN0",398,0) + new cStartDate set cStartDate="EDT" +"RTN","TMGPUTN0",399,0) + new cEndDate set cEndDate="LDT" +"RTN","TMGPUTN0",400,0) + new cService set cService="SVC" +"RTN","TMGPUTN0",401,0) + new cDocType set cDocType="TYPE" +"RTN","TMGPUTN0",402,0) + new cDocTIEN set cDocTIEN="TYPE IEN" +"RTN","TMGPUTN0",403,0) + new cHspLocIEN set cHspLocIEN="LOC" +"RTN","TMGPUTN0",404,0) + new cVstLocIEN set cVstLocIEN="VLOC" +"RTN","TMGPUTN0",405,0) + new cVisitStr set cVisitStr="VSTR" +"RTN","TMGPUTN0",406,0) + new cVisitIEN set cVisitIEN="VISIT" +"RTN","TMGPUTN0",407,0) + new cStopCode set cStopCode="STOP" +"RTN","TMGPUTN0",408,0) + +"RTN","TMGPUTN0",409,0) + new TMG +"RTN","TMGPUTN0",410,0) + new DFN +"RTN","TMGPUTN0",411,0) + new TIUDAD,TIUEDIT +"RTN","TMGPUTN0",412,0) + new TIULDT,TIUXCRP,DocTIEN +"RTN","TMGPUTN0",413,0) + new LocIEN +"RTN","TMGPUTN0",414,0) + new result set result=-1 +"RTN","TMGPUTN0",415,0) + set NewDoc=0 +"RTN","TMGPUTN0",416,0) + +"RTN","TMGPUTN0",417,0) + set Document(cStartDate)=$$IDATE^TIULC(Document("DATE")) ;"Convert date into internal format +"RTN","TMGPUTN0",418,0) + set Document(cEndDate)=Document(cStartDate) ;"For office notes, begin and end dates will be the same. +"RTN","TMGPUTN0",419,0) + +"RTN","TMGPUTN0",420,0) + ;"Setup DocTIEN -- to be used below as [MAS Movement event type] +"RTN","TMGPUTN0",421,0) + ;"Convert Document title into IEN, i.e. OFFICE VISIT --> 128 +"RTN","TMGPUTN0",422,0) + set DocTIEN=$$GetDocTIEN(Document("TITLE")) +"RTN","TMGPUTN0",423,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"DocTIEN=",DocTIEN) +"RTN","TMGPUTN0",424,0) + if +DocTIEN'>0 do goto PrepDocX +"RTN","TMGPUTN0",425,0) + . set Document("ERROR",1)="ERROR: Unable to determine note type from title: "_Document("TITLE") +"RTN","TMGPUTN0",426,0) + . set Document("ERROR","NUM")=1 +"RTN","TMGPUTN0",427,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,Document("ERROR",1)) +"RTN","TMGPUTN0",428,0) + +"RTN","TMGPUTN0",429,0) + ;"Purpose: setup Document(cDocType) -- used below as: Title info variable of form: +"RTN","TMGPUTN0",430,0) + ;" Setup string in form of: 1^title IEN^title Name +"RTN","TMGPUTN0",431,0) + ;" e.g.: 1^128^OFFICE VISIT^OFFICE VISIT +"RTN","TMGPUTN0",432,0) + set Document(cDocTIEN)=DocTIEN +"RTN","TMGPUTN0",433,0) + set Document(cDocType)=1_"^"_DocTIEN_"^"_$$PNAME^TIULC1(DocTIEN) +"RTN","TMGPUTN0",434,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is Document('TYPE'): ",Document(cDocType)) +"RTN","TMGPUTN0",435,0) + +"RTN","TMGPUTN0",436,0) + ;"do MAIN^TIUVSIT(.TIU,.DFN,TMGSSNUM,Document(cStartDate),Document(cEndDate),"LAST",0,Document("LOCATION")) +"RTN","TMGPUTN0",437,0) + +"RTN","TMGPUTN0",438,0) + ;" setup LocIEN from HOSPITAL LOCATION file (#44) +"RTN","TMGPUTN0",439,0) + ;" This contains entries like 'Laughlin_Office' +"RTN","TMGPUTN0",440,0) + set LocIEN=+$$GetLocIEN(Document("LOCATION")) +"RTN","TMGPUTN0",441,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Now LocIEN=",LocIEN) +"RTN","TMGPUTN0",442,0) + if '$data(^SC(LocIEN,0)) do goto PrepDocX ;"^SC(*) is file 44, Hospital Location +"RTN","TMGPUTN0",443,0) + . set Document("ERROR",1)="ERROR: Unable to process location: "_Document("LOCATION") +"RTN","TMGPUTN0",444,0) + . set Document("ERROR","NUM")=1 +"RTN","TMGPUTN0",445,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,Document("ERROR",1)) +"RTN","TMGPUTN0",446,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"^SC(",LocIEN,") = ",$get(^SC(LocIEN))) +"RTN","TMGPUTN0",447,0) + +"RTN","TMGPUTN0",448,0) + set Document(cService)=$$GetService(Document("PROVIDER IEN")) ;"i.e. FAMILY PRACTICE +"RTN","TMGPUTN0",449,0) + set Document(cVisitStr)="x;x;"_DocTIEN ;"LOC;VDT;VTYP +"RTN","TMGPUTN0",450,0) + set Document(cVisitIEN)=0 ;"Visit File IFN +"RTN","TMGPUTN0",451,0) + set Document(cHspLocIEN)=LocIEN +"RTN","TMGPUTN0",452,0) + set Document(cVstLocIEN)=LocIEN +"RTN","TMGPUTN0",453,0) + set Document(cStopCode)=0 ;"0=FALSE, don't worry about stop codes. +"RTN","TMGPUTN0",454,0) + +"RTN","TMGPUTN0",455,0) + set result=$$GetRecord(.Document,.NewDoc,0) +"RTN","TMGPUTN0",456,0) + if result'>0 do goto PrepDocX +"RTN","TMGPUTN0",457,0) + . new n set n=+$get(Document("ERROR","NUM"))+1 +"RTN","TMGPUTN0",458,0) + . set Document("ERROR",n)="ERROR.. after creating new document." +"RTN","TMGPUTN0",459,0) + . set Document("ERROR","NUM")=n +"RTN","TMGPUTN0",460,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,Document("ERROR",n)) +"RTN","TMGPUTN0",461,0) + +"RTN","TMGPUTN0",462,0) + ;"At this point, any merging has been done (once implemented) +"RTN","TMGPUTN0",463,0) + ;"So a character count of now will be a total/combined character count +"RTN","TMGPUTN0",464,0) + set Document("CHAR COUNT - TOTAL")=$$BuffCharCount ;"Count character after any wrapping/merging etc. +"RTN","TMGPUTN0",465,0) + ;"Now, we need the standard CHARARACTERS/LINE value stored in field .03 of TIU PARAMETERS (in ^TIU(8925.99)) +"RTN","TMGPUTN0",466,0) + ;"For my setup, I have only have one record for in this file, so I'll use IEN=1. +"RTN","TMGPUTN0",467,0) + new CharsPerLine set CharsPerLine=$piece($get(^TIU(8925.99,1,0)),"^",3) +"RTN","TMGPUTN0",468,0) + if CharsPerLine'=0 do +"RTN","TMGPUTN0",469,0) + . new IntLC,LC,Delta +"RTN","TMGPUTN0",470,0) + . set LC=Document("CHAR COUNT - TOTAL")\CharsPerLine +"RTN","TMGPUTN0",471,0) + . set IntLC=Document("CHAR COUNT - TOTAL")\CharsPerLine ;" \ is integer divide +"RTN","TMGPUTN0",472,0) + . set Delta=(LC-IntLC)*10 +"RTN","TMGPUTN0",473,0) + . if Delta>4 set IntLC=IntLC+1 ;"Round to closest integer value. +"RTN","TMGPUTN0",474,0) + . set Document("LINE COUNT")=IntLC +"RTN","TMGPUTN0",475,0) + +"RTN","TMGPUTN0",476,0) + set result=$$StuffRec(.Document,0) +"RTN","TMGPUTN0",477,0) + if +$get(result)'>0 do goto PrepDocX +"RTN","TMGPUTN0",478,0) + . new n set n=+$get(Document("ERROR","NUM"))+1 +"RTN","TMGPUTN0",479,0) + . set Document("ERROR",n)="ERROR.. Stuffing new document." +"RTN","TMGPUTN0",480,0) + . set Document("ERROR","NUM")=n +"RTN","TMGPUTN0",481,0) + . ;"Note: StuffRec will also load Document("ERROR","FM INFO") with FM errors +"RTN","TMGPUTN0",482,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,Document("ERROR",n)) +"RTN","TMGPUTN0",483,0) +N +"RTN","TMGPUTN0",484,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Blank document successfully created. Doc#=",result) +"RTN","TMGPUTN0",485,0) + +"RTN","TMGPUTN0",486,0) +PrepDocXN +"RTN","TMGPUTN0",487,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",488,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"Returning result=",$get(result)) +"RTN","TMGPUTN0",489,0) + . do DebugExit^TMGDEBUG(.DBIndent,"PrepDoc") +"RTN","TMGPUTN0",490,0) + quit result ;"result is document # +"RTN","TMGPUTN0",491,0) + +"RTN","TMGPUTN0",492,0) + +"RTN","TMGPUTN0",493,0) +MakeVisit(Document) +"RTN","TMGPUTN0",494,0) + ;"Purpose -- to create a new entery in the VISIT file, based on info in Document. +"RTN","TMGPUTN0",495,0) + ;"Input -- Document -- array with following info: +"RTN","TMGPUTN0",496,0) + ;" Document("DFN")=DFN, the record number of the patient. +"RTN","TMGPUTN0",497,0) + ;" Document("PROVIDER")= the provider of care for the note +"RTN","TMGPUTN0",498,0) + ;" Document("PROVIDER IEN")= the IEN of the provider +"RTN","TMGPUTN0",499,0) + ;" Document("LOCATION")= the location of the visit +"RTN","TMGPUTN0",500,0) + ;" Document("DATE")= the date of the visit. +"RTN","TMGPUTN0",501,0) + ;"Result -- returns IEN of visit entry +"RTN","TMGPUTN0",502,0) + +"RTN","TMGPUTN0",503,0) + ;"Note -- this function is not now being used... +"RTN","TMGPUTN0",504,0) + +"RTN","TMGPUTN0",505,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"MakeVisit") +"RTN","TMGPUTN0",506,0) + +"RTN","TMGPUTN0",507,0) + new TMGFDA +"RTN","TMGPUTN0",508,0) + +"RTN","TMGPUTN0",509,0) + ;set TMGFDA(9000010,"?+1,",.01)= ;".01=VISIT/ADMIT DATE&TIME +"RTN","TMGPUTN0",510,0) + ;set TMGFDA(9000010,"?+1,",.02)= ;".02=DATE VISIT CREATED +"RTN","TMGPUTN0",511,0) + ;set TMGFDA(9000010,"?+1,",.03)="O" ;".02=VISIT TYPE -- O=Other +"RTN","TMGPUTN0",512,0) + ;set TMGFDA(9000010,"?+1,",.05)= ;".05=PATIENT NAME +"RTN","TMGPUTN0",513,0) + ;set TMGFDA(9000010,"?+1,",15001)="10C1-TEST" ;"15001=VISIT ID +"RTN","TMGPUTN0",514,0) + ;LOCATION NAME --> Medical Group of Greeneville +"RTN","TMGPUTN0",515,0) + ;SERVICE CATEGORY: A --> AMBULATORY +"RTN","TMGPUTN0",516,0) + ;DSS ID: PRIMARY CARE/MEDICINE +"RTN","TMGPUTN0",517,0) + ;HOSPITAL LOCATION: Laughlin_Office +"RTN","TMGPUTN0",518,0) + ;Created by user: DUZ +"RTN","TMGPUTN0",519,0) + +"RTN","TMGPUTN0",520,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"MakeVisit") +"RTN","TMGPUTN0",521,0) + quit +"RTN","TMGPUTN0",522,0) + +"RTN","TMGPUTN0",523,0) + +"RTN","TMGPUTN0",524,0) +GetDocTIEN(Title) +"RTN","TMGPUTN0",525,0) + ;"Purpose: To return IEN for document *type defination* / Identify document title +"RTN","TMGPUTN0",526,0) + ;"Input Title -- the Text Title to look up +"RTN","TMGPUTN0",527,0) + ;"Results: Returns the document definition IFN (i.e. Y) +"RTN","TMGPUTN0",528,0) + +"RTN","TMGPUTN0",529,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDocTIEN") +"RTN","TMGPUTN0",530,0) + +"RTN","TMGPUTN0",531,0) + new DIC,Y,X +"RTN","TMGPUTN0",532,0) + new TIUFPRIV set TIUFPRIV=1 +"RTN","TMGPUTN0",533,0) + +"RTN","TMGPUTN0",534,0) + set DIC=8925.1 +"RTN","TMGPUTN0",535,0) + set DIC(0)="M" +"RTN","TMGPUTN0",536,0) + set DIC("S")="IF $PIECE(^TIU(8925.1,+Y,0),""^"",4)=""DOC""" +"RTN","TMGPUTN0",537,0) + set X=Title +"RTN","TMGPUTN0",538,0) + do ^DIC +"RTN","TMGPUTN0",539,0) + kill DIC("S") +"RTN","TMGPUTN0",540,0) + if $find(Y,"^")>0 set Y=$piece(Y,"^",1) +"RTN","TMGPUTN0",541,0) + +"RTN","TMGPUTN0",542,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"IEN for document type: ",Title," = ",Y) +"RTN","TMGPUTN0",543,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDocTIEN") +"RTN","TMGPUTN0",544,0) + quit Y +"RTN","TMGPUTN0",545,0) + +"RTN","TMGPUTN0",546,0) + +"RTN","TMGPUTN0",547,0) +GetLocIEN(Location) +"RTN","TMGPUTN0",548,0) + ;"Scope: PRIVATE +"RTN","TMGPUTN0",549,0) + ;"Purpose: To return IEN for location +"RTN","TMGPUTN0",550,0) + ;"Input: Location -- the Location to look up. +"RTN","TMGPUTN0",551,0) + ;"Results: returns LocationIEN (i.e. Y) +"RTN","TMGPUTN0",552,0) + +"RTN","TMGPUTN0",553,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetLocIEN") +"RTN","TMGPUTN0",554,0) + new DIC,X,Y +"RTN","TMGPUTN0",555,0) + set DIC=44 ;"file 44 is HOSPITAL LOCATION +"RTN","TMGPUTN0",556,0) + set DIC(0)="M" +"RTN","TMGPUTN0",557,0) + set X=Location +"RTN","TMGPUTN0",558,0) + do ^DIC ;" do a , value is returned in Y +"RTN","TMGPUTN0",559,0) + if $find(Y,"^")>0 set Y=$piece(Y,"^",1) +"RTN","TMGPUTN0",560,0) + +"RTN","TMGPUTN0",561,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Location IEN for ",Location," = ",Y) +"RTN","TMGPUTN0",562,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetLocIEN") +"RTN","TMGPUTN0",563,0) + quit Y +"RTN","TMGPUTN0",564,0) + +"RTN","TMGPUTN0",565,0) + +"RTN","TMGPUTN0",566,0) +GetService(IEN) +"RTN","TMGPUTN0",567,0) + ;"Scope: PRIVATE +"RTN","TMGPUTN0",568,0) + ;"Purpose: Get the Service for the Provider +"RTN","TMGPUTN0",569,0) + ;"Input: IEN -- the IEN of the Provider to look up. +"RTN","TMGPUTN0",570,0) + ;"Results: returns the Name of the Service for provider, or "" if not found +"RTN","TMGPUTN0",571,0) + +"RTN","TMGPUTN0",572,0) + new result set result="" +"RTN","TMGPUTN0",573,0) + new node,SvIEN +"RTN","TMGPUTN0",574,0) + +"RTN","TMGPUTN0",575,0) + if IEN=-1 goto GtSvDone +"RTN","TMGPUTN0",576,0) + set node=$get(^VA(200,IEN,5)) ;"^VA(200, is NEW PERSON file +"RTN","TMGPUTN0",577,0) + set SvIEN=+$piece(node,"^",1) +"RTN","TMGPUTN0",578,0) + if SvIEN=0 goto GtSvDone +"RTN","TMGPUTN0",579,0) + set node=$get(^DIC(49,SvIEN,0)) ;"^DIC(49, is the SERVICE/SECTION file +"RTN","TMGPUTN0",580,0) + set result=$piece(node,"^",1) +"RTN","TMGPUTN0",581,0) + +"RTN","TMGPUTN0",582,0) +GtSvDone +"RTN","TMGPUTN0",583,0) + quit result +"RTN","TMGPUTN0",584,0) + +"RTN","TMGPUTN0",585,0) + +"RTN","TMGPUTN0",586,0) +GetProvIEN(Provider) +"RTN","TMGPUTN0",587,0) + ;"Scope: PRIVATE +"RTN","TMGPUTN0",588,0) + ;"Purpose: To return IEN for Provider +"RTN","TMGPUTN0",589,0) + ;"Input: Provider -- the Provider to look up. +"RTN","TMGPUTN0",590,0) + ;"Results: returns Provider's IEN (i.e. Y), or -1 if not found +"RTN","TMGPUTN0",591,0) + +"RTN","TMGPUTN0",592,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetProvIEN") +"RTN","TMGPUTN0",593,0) + new DIC,X,Y +"RTN","TMGPUTN0",594,0) + set DIC=200 ;"file 200 is NEW PERSON +"RTN","TMGPUTN0",595,0) + set DIC(0)="M" +"RTN","TMGPUTN0",596,0) + set X=Provider +"RTN","TMGPUTN0",597,0) + do ^DIC ;" do a , value is returned in Y +"RTN","TMGPUTN0",598,0) + if $find(Y,"^")>0 set Y=$piece(Y,"^",1) +"RTN","TMGPUTN0",599,0) + +"RTN","TMGPUTN0",600,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetProvIEN") +"RTN","TMGPUTN0",601,0) + quit Y +"RTN","TMGPUTN0",602,0) + +"RTN","TMGPUTN0",603,0) + +"RTN","TMGPUTN0",604,0) +GetRecord(Document,NewDoc,AskOK,Editable) +"RTN","TMGPUTN0",605,0) + ;"Scope: PRIVATE +"RTN","TMGPUTN0",606,0) + ;"PURPOSE: +"RTN","TMGPUTN0",607,0) + ;" To get a record--either via creating a new one, or returning an existing one +"RTN","TMGPUTN0",608,0) + ;" Note: If an existing one is returned, it will be emptied first... +"RTN","TMGPUTN0",609,0) + ;" +"RTN","TMGPUTN0",610,0) + ;" Note: If I want to merge part of what the doctor creates with what the +"RTN","TMGPUTN0",611,0) + ;" transcriptionist uploads, here what I should do +"RTN","TMGPUTN0",612,0) + ;" 1. Look for an existing document with same date as document being uploaded. +"RTN","TMGPUTN0",613,0) + ;" 2. If found, look in existing document for merge symbols (i.e. {{1}} } +"RTN","TMGPUTN0",614,0) + ;" 3. If found, then take code from existing document and current part +"RTN","TMGPUTN0",615,0) + ;" of upload buffer, and create a merged document. +"RTN","TMGPUTN0",616,0) + ;" 4. Put this merged document back into the upload buffer. +"RTN","TMGPUTN0",617,0) + ;" 5. Empty the existing document, and return its IEN from this function +"RTN","TMGPUTN0",618,0) + ;" +"RTN","TMGPUTN0",619,0) + ;"INPUT: Document -- array with Document("DFN"), Document(cDocType) are REQUIRED. +"RTN","TMGPUTN0",620,0) + ;" [Document] --> Visit info array -- SHOULD PASS BE REFERENCE. +"RTN","TMGPUTN0",621,0) + ;" Document("DFN") = patient DFN +"RTN","TMGPUTN0",622,0) + ;" Document(cVisitStr) = LOC;VDT;VTYP e.g. 'x;x;OFFICE VISIT' +"RTN","TMGPUTN0",623,0) + ;" Document(cVisitIEN) = VISIT file IFN e.g. 0, used for field .03 in file 8925. Pointer to file #9000010 +"RTN","TMGPUTN0",624,0) + ;" Document(cHspLocIEN) i.e. Hospital location IEN. Used for field 1205 in 8925. Pointer to file #44 +"RTN","TMGPUTN0",625,0) + ;" Document(cVstLocIEN) i.e. visit location IEN. Used for field 1211 in 8925. Pointer to file #44 +"RTN","TMGPUTN0",626,0) + ;" Document(cStopCode) = mark to defer workload e.g. 0/FALSE=don't worry about stop codes. +"RTN","TMGPUTN0",627,0) + ;" USED FOR: Mark record for deferred crediting of stop code (fld #.11) +"RTN","TMGPUTN0",628,0) + ;" This boolean field (.11) indicates whether the stop code associated with a new +"RTN","TMGPUTN0",629,0) + ;" visit should be credited when the note is completed. +"RTN","TMGPUTN0",630,0) + ;" Note: if Document('STOP')="", then not processed. +"RTN","TMGPUTN0",631,0) + ;" Document(cDocType)=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT +"RTN","TMGPUTN0",632,0) + ;" Document(cDocTIEN)=DocTIEN (a.k.a. title DA) e.g. 128 +"RTN","TMGPUTN0",633,0) + ;" Document(cService) e.g.FAMILY PRACTICE +"RTN","TMGPUTN0",634,0) + ;" Document(cStartDate) i.e. event begin time +"RTN","TMGPUTN0",635,0) + ;" Document(cEndDate) i.e. event end time +"RTN","TMGPUTN0",636,0) + ;" [NewDoc] --> flag, passed back with +"RTN","TMGPUTN0",637,0) + ;" NewDoc = 1 if returned docmt is new +"RTN","TMGPUTN0",638,0) + ;" NewDoc = 0 if returned docmt already existed, timeout, etc +"RTN","TMGPUTN0",639,0) + ;" [AskOK] --> Ask user flag, where +"RTN","TMGPUTN0",640,0) + ;" AskOK = 1: ask re edit/addend existing docmt +"RTN","TMGPUTN0",641,0) + ;" (Interactive List Manager options, TRY docmt def) +"RTN","TMGPUTN0",642,0) + ;" AskOK = 0: don't ask (Upload & GUI options) +"RTN","TMGPUTN0",643,0) + ;" [Editable]-->flag, passed back with Editable = 1 if returned +"RTN","TMGPUTN0",644,0) + ;" PREEXISTING docmt can be edited by Provider. If +"RTN","TMGPUTN0",645,0) + ;" preexisting docmt returned and 'Editable, then +"RTN","TMGPUTN0",646,0) + ;" docmt cannot be edited by Provider. +"RTN","TMGPUTN0",647,0) + ;" +"RTN","TMGPUTN0",648,0) + ;"Results: Returns DocIEN -- IEN of document to use, or -1 if error etc. +"RTN","TMGPUTN0",649,0) + ;" Also, Document("DOC IEN") is set to DocIEN +"RTN","TMGPUTN0",650,0) + ;" Errors will be returned in Document("ERROR") +"RTN","TMGPUTN0",651,0) + ;" +"RTN","TMGPUTN0",652,0) + ;"Note: Code originally from GETRECNM^TIUEDI3 -- KT 5/25/04 +"RTN","TMGPUTN0",653,0) + +"RTN","TMGPUTN0",654,0) + +"RTN","TMGPUTN0",655,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetRecord") +"RTN","TMGPUTN0",656,0) + +"RTN","TMGPUTN0",657,0) + new MultOK set MultOK=1 +"RTN","TMGPUTN0",658,0) + new DocIEN set DocIEN=-1 +"RTN","TMGPUTN0",659,0) + set NewDoc=0 +"RTN","TMGPUTN0",660,0) + +"RTN","TMGPUTN0",661,0) + if +$get(BuffNum)'=0 set DocIEN=$$DocExists(.Document) ;"avoid error with RPC calls +"RTN","TMGPUTN0",662,0) + else set DocIEN=0 +"RTN","TMGPUTN0",663,0) + set Document("DOC IEN")=DocIEN +"RTN","TMGPUTN0",664,0) + if DocIEN>0 do goto GRDone ;"DocIEN>0 means that the TEXT of the report is an exact match +"RTN","TMGPUTN0",665,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Found a prior matching document that will be overwriten") +"RTN","TMGPUTN0",666,0) + . kill ^TIU(8925,DocIEN,"TEXT") ;"Kill the TEXT prior report, so we can overwrite it +"RTN","TMGPUTN0",667,0) + else do +"RTN","TMGPUTN0",668,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"No prior matching document found. No overwrite planned.") +"RTN","TMGPUTN0",669,0) + . set DocIEN=$$CreateRec(.Document) +"RTN","TMGPUTN0",670,0) + . set NewDoc=1 +"RTN","TMGPUTN0",671,0) + +"RTN","TMGPUTN0",672,0) +GRDone ; +"RTN","TMGPUTN0",673,0) + if NewDoc,DocIEN'>0 set NewDoc=0 +"RTN","TMGPUTN0",674,0) + set Document("DOC IEN")=DocIEN +"RTN","TMGPUTN0",675,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Return DocIEN (record#)=",DocIEN) +"RTN","TMGPUTN0",676,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"GetRecord") +"RTN","TMGPUTN0",677,0) + quit DocIEN ;"DocIEN is document number +"RTN","TMGPUTN0",678,0) + +"RTN","TMGPUTN0",679,0) + +"RTN","TMGPUTN0",680,0) +DocExists(Document) +"RTN","TMGPUTN0",681,0) + ;"PURPOSE: To return document IEN, if it already EXISTS for the +"RTN","TMGPUTN0",682,0) + ;" given patient, title, and visit. +"RTN","TMGPUTN0",683,0) + ;"INPUT: Document -- see documentation of format in $$GetRecord +"RTN","TMGPUTN0",684,0) + ;"Results: returns a value for document (i.e. DocIEN), or -1 if no prior doc is found. +"RTN","TMGPUTN0",685,0) + ;" +"RTN","TMGPUTN0",686,0) + ;"Note: The following documents are ignored: +"RTN","TMGPUTN0",687,0) + ;" - docmts of status deleted or retracted +"RTN","TMGPUTN0",688,0) + ;" - all docmts if run across a docmt w/ requesting pkg +"RTN","TMGPUTN0",689,0) + ;" - If REQEDIT, then also ignore docmts PERSON cannot edit. +"RTN","TMGPUTN0",690,0) + ;"Note: If there are more than one, get the smallest DA. +"RTN","TMGPUTN0",691,0) + +"RTN","TMGPUTN0",692,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"DocExists") +"RTN","TMGPUTN0",693,0) + +"RTN","TMGPUTN0",694,0) + new DocIEN set DocIEN=-1 +"RTN","TMGPUTN0",695,0) + new index +"RTN","TMGPUTN0",696,0) + +"RTN","TMGPUTN0",697,0) + ;"After uploading old progress notes, I should restore code that sees if I SHOULD be editing. +"RTN","TMGPUTN0",698,0) + +"RTN","TMGPUTN0",699,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here is Upload Buffer") +"RTN","TMGPUTN0",700,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("^TIU(8925.2,BuffNum)") +"RTN","TMGPUTN0",701,0) + +"RTN","TMGPUTN0",702,0) + if $data(^TIU(8925,"C",Document("DFN")))=0 goto DEDone +"RTN","TMGPUTN0",703,0) + ;"Scan through all documents for patient (DFN) +"RTN","TMGPUTN0",704,0) + set index=$order(^TIU(8925,"C",Document("DFN"),"")) +"RTN","TMGPUTN0",705,0) + if index="" goto DEDone +"RTN","TMGPUTN0",706,0) + for do quit:(index="") +"RTN","TMGPUTN0",707,0) + . new DocCompValue +"RTN","TMGPUTN0",708,0) + . ;"new KeyIn ;temp --removed 7/30/07 to avoid RPC error +"RTN","TMGPUTN0",709,0) + . ;"read *KeyIn:0 +"RTN","TMGPUTN0",710,0) + . ;"if KeyIn=" " set index="" quit +"RTN","TMGPUTN0",711,0) + . set DocCompValue=$$CompToBuff(index,Document(cDocTIEN),Document(cStartDate)) +"RTN","TMGPUTN0",712,0) + . if DocCompValue=2 do quit ;"i.e. documents are an exact match +"RTN","TMGPUTN0",713,0) + . . ;"For below, the document is the same as the upload buffer. +"RTN","TMGPUTN0",714,0) + . . ;"We have found our answer. +"RTN","TMGPUTN0",715,0) + . . ;" +"RTN","TMGPUTN0",716,0) + . . ;"Below is code I can use to check to see if I SHOULD be editing. +"RTN","TMGPUTN0",717,0) + . . ;"------------------------------------------------------ +"RTN","TMGPUTN0",718,0) + . . ;"new CANEDIT,CANDel +"RTN","TMGPUTN0",719,0) + . . ;"set CANEDIT=+$$CANDO^TIULP(index,"EDIT RECORD",Document("PROVIDER IEN")) +"RTN","TMGPUTN0",720,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent," Editable?=",CANEDIT +"RTN","TMGPUTN0",721,0) + . . ;"set CANDel=+$$CANDO^TIULP(index,"DELETE RECORD",Document("PROVIDER IEN")) +"RTN","TMGPUTN0",722,0) + . . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent," Deletable?=",CANDel) +"RTN","TMGPUTN0",723,0) + . . ;"if +CANEDIT>0 set DocIEN=index +"RTN","TMGPUTN0",724,0) + . . set DocIEN=index set index="" quit +"RTN","TMGPUTN0",725,0) + . set index=$order(^TIU(8925,"C",Document("DFN"),index)) +"RTN","TMGPUTN0",726,0) + +"RTN","TMGPUTN0",727,0) +DEDone +"RTN","TMGPUTN0",728,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"resulting DocIEN=",DocIEN) +"RTN","TMGPUTN0",729,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"DocExists") +"RTN","TMGPUTN0",730,0) + quit DocIEN +"RTN","TMGPUTN0",731,0) + +"RTN","TMGPUTN0",732,0) + +"RTN","TMGPUTN0",733,0) +BuffCharCount() +"RTN","TMGPUTN0",734,0) + ;"Purpose: To count the number of characters in the current upload buffer, for the +"RTN","TMGPUTN0",735,0) + ;" current document. The upload buffer puts all the documents being uploaded +"RTN","TMGPUTN0",736,0) + ;" into one big WP array. This function will count down until the text +"RTN","TMGPUTN0",737,0) + ;" signal is found to start the next documnent (e.g. '[NewDict]') +"RTN","TMGPUTN0",738,0) + ;"Input: none. However, several global-scope variables are used. +"RTN","TMGPUTN0",739,0) + ;" By tracing through the upload code I know that +"RTN","TMGPUTN0",740,0) + ;" the following variables are set: +"RTN","TMGPUTN0",741,0) + ;" (I saved DA as BuffNum, and TIUI as BuffIdx) +"RTN","TMGPUTN0",742,0) + ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params +"RTN","TMGPUTN0",743,0) + ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. +"RTN","TMGPUTN0",744,0) + ;" BuffIdx = the line index of the beginning of the report to be processed (i.e. the line +"RTN","TMGPUTN0",745,0) + ;" that starts with [TEXT] +"RTN","TMGPUTN0",746,0) + ;" BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0) +"RTN","TMGPUTN0",747,0) + ;" In other words, here BuffNum = the serial index number of the document to +"RTN","TMGPUTN0",748,0) + ;" be uploaded i.e. 1 for the first, 2 for the second etc. +"RTN","TMGPUTN0",749,0) + ;"Notes +"RTN","TMGPUTN0",750,0) + ;" 8925.2 is file: TIU UPLOAD BUFFER +"RTN","TMGPUTN0",751,0) + ;" To detect the beginning of the next document, use +"RTN","TMGPUTN0",752,0) + ;" if MyLine[TIUHSIG then abort +"RTN","TMGPUTN0",753,0) + ;" I trim of leading and trailing white-space before counting. +"RTN","TMGPUTN0",754,0) + ;" But, otherwise spaces will be counted +"RTN","TMGPUTN0",755,0) + ;" +"RTN","TMGPUTN0",756,0) + ;"Results: Returns character count, or 0 if none found. +"RTN","TMGPUTN0",757,0) + +"RTN","TMGPUTN0",758,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"BuffCharCount") +"RTN","TMGPUTN0",759,0) + +"RTN","TMGPUTN0",760,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Scan ^TIU(8925.2,",BuffNum,",TEXT) starting at index: ",BuffIdx) +"RTN","TMGPUTN0",761,0) + +"RTN","TMGPUTN0",762,0) + new index +"RTN","TMGPUTN0",763,0) + new result set result=0 +"RTN","TMGPUTN0",764,0) + if $get(TIUHSIG)="" do goto BuffCDone +"RTN","TMGPUTN0",765,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"TIUHSIG=''! No further search possible") +"RTN","TMGPUTN0",766,0) + +"RTN","TMGPUTN0",767,0) + set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) +"RTN","TMGPUTN0",768,0) + for do quit:(index="") +"RTN","TMGPUTN0",769,0) + . if index="" quit +"RTN","TMGPUTN0",770,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"index=",index) +"RTN","TMGPUTN0",771,0) + . new s set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) +"RTN","TMGPUTN0",772,0) + . if s="" set index="" quit +"RTN","TMGPUTN0",773,0) + . if s[TIUHSIG set index="" quit +"RTN","TMGPUTN0",774,0) + . set s=$$Trim^TMGSTUTL(.s) +"RTN","TMGPUTN0",775,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"s=",s) +"RTN","TMGPUTN0",776,0) + . set result=result+$length(s) +"RTN","TMGPUTN0",777,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result (char count)=",result) +"RTN","TMGPUTN0",778,0) + . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) +"RTN","TMGPUTN0",779,0) + +"RTN","TMGPUTN0",780,0) +BuffCDone +"RTN","TMGPUTN0",781,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result (char count)=",result) +"RTN","TMGPUTN0",782,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"BuffCharCount") +"RTN","TMGPUTN0",783,0) + quit result +"RTN","TMGPUTN0",784,0) + +"RTN","TMGPUTN0",785,0) + +"RTN","TMGPUTN0",786,0) + +"RTN","TMGPUTN0",787,0) +PrepUploadBuf() +"RTN","TMGPUTN0",788,0) + ;"Purpose: Ensure upload buffer is ready for processing +"RTN","TMGPUTN0",789,0) + ;"Background: Transcriptionist will upload a large document containing +"RTN","TMGPUTN0",790,0) + ;" multiple notes for different patients etc. This entire large +"RTN","TMGPUTN0",791,0) + ;" document is stored in the TIU UPLOAD BUFFER file (8925.2) +"RTN","TMGPUTN0",792,0) + ;" When this filer code is called, the TIU upload process has already +"RTN","TMGPUTN0",793,0) + ;" set up some variables. +"RTN","TMGPUTN0",794,0) + ;" DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that +"RTN","TMGPUTN0",795,0) + ;" the uploaded text was temporarily store in. +"RTN","TMGPUTN0",796,0) + ;" (I save DA as BuffNum) +"RTN","TMGPUTN0",797,0) + ;" TIUI = the line index of the beginning of the report to +"RTN","TMGPUTN0",798,0) + ;" be processed (i.e. the line that starts with [TEXT]) +"RTN","TMGPUTN0",799,0) + ;" (I save TIUI as BuffIdx) +"RTN","TMGPUTN0",800,0) + ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params +"RTN","TMGPUTN0",801,0) + ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. +"RTN","TMGPUTN0",802,0) + ;" +"RTN","TMGPUTN0",803,0) + ;" I found that transcriptionists were using word-processors that automatically +"RTN","TMGPUTN0",804,0) + ;" wrapped the text to a next line. Thus paragraphs were being uploaded as +"RTN","TMGPUTN0",805,0) + ;" one very long line. Rather than try to reeducate them to consistantly hit +"RTN","TMGPUTN0",806,0) + ;" enter at the end of every line, I chose to automatically wrap the text to +"RTN","TMGPUTN0",807,0) + ;" a set width. +"RTN","TMGPUTN0",808,0) + ;" +"RTN","TMGPUTN0",809,0) + ;" A global-scope var: cMaxNoteWidth is expected to be defined/ +"RTN","TMGPUTN0",810,0) + ;" +"RTN","TMGPUTN0",811,0) + ;" So, to prepair the upload buffer, I use these steps: +"RTN","TMGPUTN0",812,0) + ;" 1. Scan the part of the upload buffer pertaining to the +"RTN","TMGPUTN0",813,0) + ;" current note being processed +"RTN","TMGPUTN0",814,0) + ;" - This starts with line BuffIdx, and ends with... +"RTN","TMGPUTN0",815,0) + ;" - the line containing TIUHSIG (or end of buffer) +"RTN","TMGPUTN0",816,0) + ;" See if any line is longer than cMaxNoteWidth characters. +"RTN","TMGPUTN0",817,0) + ;" If so, mark for wrapping. +"RTN","TMGPUTN0",818,0) + ;" 2. If wrapping needed, extract note to a temporary array +"RTN","TMGPUTN0",819,0) + ;" 3. Perform reformatting/wrapping on temp array. +"RTN","TMGPUTN0",820,0) + ;" 4. Put temp array back into Upload buffer +"RTN","TMGPUTN0",821,0) + ;" +"RTN","TMGPUTN0",822,0) + ;"Input: None, but global-scope vars used (see above) +"RTN","TMGPUTN0",823,0) + ;"Output: Upload buffer may be changed +"RTN","TMGPUTN0",824,0) + ;"Result: 1=OKToCont or cAbort +"RTN","TMGPUTN0",825,0) + +"RTN","TMGPUTN0",826,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PrepUploadBuf") +"RTN","TMGPUTN0",827,0) + +"RTN","TMGPUTN0",828,0) + new result set result=1 ;"cOKToCont +"RTN","TMGPUTN0",829,0) + +"RTN","TMGPUTN0",830,0) + if $$NeedsReformat(cMaxNoteWidth) do +"RTN","TMGPUTN0",831,0) + . new CurNote +"RTN","TMGPUTN0",832,0) + . new NextNoteI +"RTN","TMGPUTN0",833,0) + . new DoSpecialIndent set DoSpecialIndent=1 ;"I.e. use hanging indents.) +"RTN","TMGPUTN0",834,0) + . set NextNoteI=$$CutNote(.CurNote) +"RTN","TMGPUTN0",835,0) + . do WordWrapArray^TMGSTUTL(.CurNote,cMaxNoteWidth,DoSpecialIndent) +"RTN","TMGPUTN0",836,0) + . set result=$$PasteNote(.CurNote,NextNoteI) +"RTN","TMGPUTN0",837,0) + ;" SEEMS TO BE STRAY CHARS ELH --> 0c +"RTN","TMGPUTN0",838,0) +PULBFDone +"RTN","TMGPUTN0",839,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PrepUploadBuf") +"RTN","TMGPUTN0",840,0) + quit result +"RTN","TMGPUTN0",841,0) + +"RTN","TMGPUTN0",842,0) + +"RTN","TMGPUTN0",843,0) +NeedsReformat(MaxWidth) +"RTN","TMGPUTN0",844,0) + ;"Purpose: To scan the single note being processed, to see if +"RTN","TMGPUTN0",845,0) + ;" it is too wide (i.e. any line of length > MaxWidth +"RTN","TMGPUTN0",846,0) + ;" I had to do this because transcriptionists were using +"RTN","TMGPUTN0",847,0) + ;" a wordprocessor that wrapped lines. Then when uploaded +"RTN","TMGPUTN0",848,0) + ;" each paragraph became one long line. +"RTN","TMGPUTN0",849,0) + ;" Also, will fix extended ASCII characters +"RTN","TMGPUTN0",850,0) + ;"Input: MaxWidth The max length of any line (i.e. 80 for 80 chars) +"RTN","TMGPUTN0",851,0) + ;" Also depends on global-scope vars +"RTN","TMGPUTN0",852,0) + ;"Result: 1= A line was found that is > MaxWidth +"RTN","TMGPUTN0",853,0) + ;" 0= no long lines found +"RTN","TMGPUTN0",854,0) + +"RTN","TMGPUTN0",855,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"NeedsReformat") +"RTN","TMGPUTN0",856,0) + +"RTN","TMGPUTN0",857,0) + new index +"RTN","TMGPUTN0",858,0) + new result set result=0 +"RTN","TMGPUTN0",859,0) + if $get(TIUHSIG)="" goto NRFMDone +"RTN","TMGPUTN0",860,0) + if $get(MaxWidth)'>0 goto NRFMDone +"RTN","TMGPUTN0",861,0) + +"RTN","TMGPUTN0",862,0) + set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) +"RTN","TMGPUTN0",863,0) + if index'="" for do quit:(index="") +"RTN","TMGPUTN0",864,0) + . new s +"RTN","TMGPUTN0",865,0) + . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) +"RTN","TMGPUTN0",866,0) + . if s="" set index="" quit +"RTN","TMGPUTN0",867,0) + . ;"9/19/06 Added to remove extended ASCII characters +"RTN","TMGPUTN0",868,0) + . ;"set s=$translate(s,$c(146)_$c(246)_$c(150)_$c(147)_$c(148),"'--""""") +"RTN","TMGPUTN0",869,0) + . if s[TIUHSIG set index="" quit +"RTN","TMGPUTN0",870,0) + . if $length(s)>MaxWidth do quit +"RTN","TMGPUTN0",871,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Line length found > ",MaxWidth) +"RTN","TMGPUTN0",872,0) + . . set result=1 +"RTN","TMGPUTN0",873,0) + . . set index="" +"RTN","TMGPUTN0",874,0) + . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) +"RTN","TMGPUTN0",875,0) + else do +"RTN","TMGPUTN0",876,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Upload unexpectedly empty!") +"RTN","TMGPUTN0",877,0) + +"RTN","TMGPUTN0",878,0) +NRFMDone +"RTN","TMGPUTN0",879,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result=",result) +"RTN","TMGPUTN0",880,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"NeedsReformat") +"RTN","TMGPUTN0",881,0) + quit result +"RTN","TMGPUTN0",882,0) + +"RTN","TMGPUTN0",883,0) + +"RTN","TMGPUTN0",884,0) +CutNote(Array) +"RTN","TMGPUTN0",885,0) + ;"Purpose: To extract the current note out of the entire upload buffer +"RTN","TMGPUTN0",886,0) + ;"Input: Array -- MUST BE PASSED BY REFERENCE. This is an OUT parameter +"RTN","TMGPUTN0",887,0) + ;" Array will be loaded with the note, with the first line being +"RTN","TMGPUTN0",888,0) + ;" put into Array(1) +"RTN","TMGPUTN0",889,0) + ;" Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere. +"RTN","TMGPUTN0",890,0) + ;"Note: This function empties the lines in TIU UPLOAD BUFFER as it cuts out note. +"RTN","TMGPUTN0",891,0) + ;"Result: Returns: +"RTN","TMGPUTN0",892,0) + ;" #: index of line containing start of next note. +"RTN","TMGPUTN0",893,0) + ;" -1: Error +"RTN","TMGPUTN0",894,0) + ;" 0: Note is the last one in the upload buffer, so no next note found +"RTN","TMGPUTN0",895,0) + +"RTN","TMGPUTN0",896,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CutNote") +"RTN","TMGPUTN0",897,0) + +"RTN","TMGPUTN0",898,0) + new index +"RTN","TMGPUTN0",899,0) + new LastI set LastI=0 +"RTN","TMGPUTN0",900,0) + new result set result=-1 +"RTN","TMGPUTN0",901,0) + kill Array +"RTN","TMGPUTN0",902,0) + if $get(TIUHSIG)="" goto ExNDone +"RTN","TMGPUTN0",903,0) + new ArrayI set ArrayI=0 +"RTN","TMGPUTN0",904,0) + new s +"RTN","TMGPUTN0",905,0) + new Done set Done=0 +"RTN","TMGPUTN0",906,0) + +"RTN","TMGPUTN0",907,0) + set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) +"RTN","TMGPUTN0",908,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Ready for loop. index=",index) +"RTN","TMGPUTN0",909,0) + +"RTN","TMGPUTN0",910,0) + if index'="" for do quit:(index="")!(Done=1) +"RTN","TMGPUTN0",911,0) + . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) +"RTN","TMGPUTN0",912,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"s='",s,"'") +"RTN","TMGPUTN0",913,0) + . if s[TIUHSIG set Done=1 quit +"RTN","TMGPUTN0",914,0) + . set ArrayI=ArrayI+1 +"RTN","TMGPUTN0",915,0) + . set Array(ArrayI)=s +"RTN","TMGPUTN0",916,0) + . kill ^TIU(8925.2,BuffNum,"TEXT",index) +"RTN","TMGPUTN0",917,0) + . set LastI=index +"RTN","TMGPUTN0",918,0) + . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) +"RTN","TMGPUTN0",919,0) + else do +"RTN","TMGPUTN0",920,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Can't find text in buffer!") +"RTN","TMGPUTN0",921,0) + +"RTN","TMGPUTN0",922,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Array") +"RTN","TMGPUTN0",923,0) + set result=+index +"RTN","TMGPUTN0",924,0) + if result=0 set result=LastI +"RTN","TMGPUTN0",925,0) +ExNDone +"RTN","TMGPUTN0",926,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"result='",result,"'") +"RTN","TMGPUTN0",927,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CutNote") +"RTN","TMGPUTN0",928,0) + quit result +"RTN","TMGPUTN0",929,0) + +"RTN","TMGPUTN0",930,0) + +"RTN","TMGPUTN0",931,0) + +"RTN","TMGPUTN0",932,0) +PasteNote(Array,NextNoteI) +"RTN","TMGPUTN0",933,0) + ;"Purpose: To put Array back into the upload buffer, at the correct location, +"RTN","TMGPUTN0",934,0) + ;"Input: Array -- Best if PASSED BY REFERENCE. +"RTN","TMGPUTN0",935,0) + ;" Array is expected to be loaded with the note, with the first line Array(1) +"RTN","TMGPUTN0",936,0) + ;" NextNoteI: This is the index, in upload buffer, of the start of the next note. +"RTN","TMGPUTN0",937,0) + ;"Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere. +"RTN","TMGPUTN0",938,0) + ;"Result: 1=OKToCont if all OK, or cAbort if error +"RTN","TMGPUTN0",939,0) + +"RTN","TMGPUTN0",940,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PasteNote") +"RTN","TMGPUTN0",941,0) + +"RTN","TMGPUTN0",942,0) + new EntireBuf +"RTN","TMGPUTN0",943,0) + new IndexInc set IndexInc=0.01 ;"WP^DIE does not require integer indexes. +"RTN","TMGPUTN0",944,0) + new ArrayI,PasteI +"RTN","TMGPUTN0",945,0) + new s +"RTN","TMGPUTN0",946,0) + new Done set Done=0 +"RTN","TMGPUTN0",947,0) + new result set result=cAbort +"RTN","TMGPUTN0",948,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"NextNoteI='",$get(NextNoteI),"'") +"RTN","TMGPUTN0",949,0) + +"RTN","TMGPUTN0",950,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Ready for merge.") +"RTN","TMGPUTN0",951,0) + +"RTN","TMGPUTN0",952,0) + merge EntireBuf=^TIU(8925.2,BuffNum,"TEXT") +"RTN","TMGPUTN0",953,0) + kill EntireBuf(0) ;"remove ^^^^^^ +"RTN","TMGPUTN0",954,0) + +"RTN","TMGPUTN0",955,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("EntireBuf") +"RTN","TMGPUTN0",956,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Array") +"RTN","TMGPUTN0",957,0) + +"RTN","TMGPUTN0",958,0) + set ArrayI=$order(Array("")) +"RTN","TMGPUTN0",959,0) + set PasteI=BuffIdx+1 +"RTN","TMGPUTN0",960,0) + for do quit:((Done=1)!(ArrayI="")) +"RTN","TMGPUTN0",961,0) + . if $data(Array(ArrayI))#10=0 set Done=1 quit +"RTN","TMGPUTN0",962,0) + . set s=Array(ArrayI) +"RTN","TMGPUTN0",963,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"s=",s) +"RTN","TMGPUTN0",964,0) + . set EntireBuff(PasteI,0)=s +"RTN","TMGPUTN0",965,0) + . set PasteI=PasteI+IndexInc +"RTN","TMGPUTN0",966,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"PasteI=",PasteI) +"RTN","TMGPUTN0",967,0) + . if PasteI>NextNoteI do quit +"RTN","TMGPUTN0",968,0) + . . do ShowError^TMGDEBUG(PriorErrorFound,"Insufficient room to put note back into upload buffer.") +"RTN","TMGPUTN0",969,0) + . . set Done=1 +"RTN","TMGPUTN0",970,0) + . set ArrayI=$order(Array(ArrayI)) +"RTN","TMGPUTN0",971,0) + . ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ArrayI=",ArrayI) +"RTN","TMGPUTN0",972,0) + +"RTN","TMGPUTN0",973,0) + ;"if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("EntireBuff") +"RTN","TMGPUTN0",974,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Ready to call WriteWP") +"RTN","TMGPUTN0",975,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"BuffNum=",$get(BuffNum)) +"RTN","TMGPUTN0",976,0) + +"RTN","TMGPUTN0",977,0) + Set result=$$WriteWP^TMGDBAPI(8925.2,BuffNum,1,.EntireBuff) +"RTN","TMGPUTN0",978,0) + +"RTN","TMGPUTN0",979,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PasteNote") +"RTN","TMGPUTN0",980,0) + quit result +"RTN","TMGPUTN0",981,0) + +"RTN","TMGPUTN0",982,0) + +"RTN","TMGPUTN0",983,0) +CompToBuff(ExistingIEN,UplTIEN,UplDate) +"RTN","TMGPUTN0",984,0) + ;"PURPOSE: To compare the document being uploaded (i.e. in the file 8925.2, TIU upload buffer) +"RTN","TMGPUTN0",985,0) + ;" to documents already existing in database +"RTN","TMGPUTN0",986,0) + ;"Input: ExistingIEN -- the document IEN of a pre-existing document in the database. +"RTN","TMGPUTN0",987,0) + ;" i.e. ^TIU(8925,ExistingIEN,*) +"RTN","TMGPUTN0",988,0) + ;" UplTIEN=The type number of document being uploaded +"RTN","TMGPUTN0",989,0) + ;" UplDate -- the date of the document being uploaded. +"RTN","TMGPUTN0",990,0) + ;" NOTE: See also global-scope variables below that are REQUIRED +"RTN","TMGPUTN0",991,0) + ;" +"RTN","TMGPUTN0",992,0) + ;"Output: returns 0 if TEXT or Date different +"RTN","TMGPUTN0",993,0) + ;" 1 if TEXT only is the same (Title is different) +"RTN","TMGPUTN0",994,0) + ;" 2 if TEXT & Title are same +"RTN","TMGPUTN0",995,0) + ;" +"RTN","TMGPUTN0",996,0) + ;"------------------------------------------------------------------------------------ +"RTN","TMGPUTN0",997,0) + ;"Programming Note: By tracing through the upload code I know that +"RTN","TMGPUTN0",998,0) + ;" the following variables are set: +"RTN","TMGPUTN0",999,0) + ;" (I saved DA as BuffNum, and TIUI as BuffIdx) +"RTN","TMGPUTN0",1000,0) + ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params +"RTN","TMGPUTN0",1001,0) + ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. +"RTN","TMGPUTN0",1002,0) + ;"BuffIdx = the line index of the beginning of the report to be processed (i.e. the line +"RTN","TMGPUTN0",1003,0) + ;" that starts with [TEXT] +"RTN","TMGPUTN0",1004,0) + ;"BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0) +"RTN","TMGPUTN0",1005,0) + ;" In other words, here BuffNum = the serial index number of the document to be uploaded +"RTN","TMGPUTN0",1006,0) + ;" i.e. 1 for the first, 2 for the second etc. +"RTN","TMGPUTN0",1007,0) + ;" Note 8925.2 is file: TIU UPLOAD BUFFER +"RTN","TMGPUTN0",1008,0) + ;"Note +"RTN","TMGPUTN0",1009,0) + ;" To detect the beginning of the next document, use +"RTN","TMGPUTN0",1010,0) + ;" if MyLine[TIUHSIG then abort +"RTN","TMGPUTN0",1011,0) + +"RTN","TMGPUTN0",1012,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CompToBuff") +"RTN","TMGPUTN0",1013,0) + +"RTN","TMGPUTN0",1014,0) + new MaxUplLine +"RTN","TMGPUTN0",1015,0) + new DocLine,UplLine +"RTN","TMGPUTN0",1016,0) + new DocData,UplData +"RTN","TMGPUTN0",1017,0) + new result set result=0 +"RTN","TMGPUTN0",1018,0) + new MaxDocLine,CompLine +"RTN","TMGPUTN0",1019,0) + new DocType,DocName +"RTN","TMGPUTN0",1020,0) + new Break set Break=0 +"RTN","TMGPUTN0",1021,0) + new DocDate +"RTN","TMGPUTN0",1022,0) + +"RTN","TMGPUTN0",1023,0) + ;"First, see if dates are the same. If not, bail out. +"RTN","TMGPUTN0",1024,0) + set DocDate=$piece(^TIU(8925,ExistingIEN,0),"^",7) +"RTN","TMGPUTN0",1025,0) + if DocDate'=UplDate goto CompExit ;"Quit with result=0 +"RTN","TMGPUTN0",1026,0) + +"RTN","TMGPUTN0",1027,0) + set MaxUplLine=$piece($get(^TIU(8925.2,BuffNum,"TEXT",0)),"^",3) +"RTN","TMGPUTN0",1028,0) + if MaxUplLine="" goto CompExit +"RTN","TMGPUTN0",1029,0) + set MaxDocLine=$piece($get(^TIU(8925,ExistingIEN,"TEXT",0)),"^",3) +"RTN","TMGPUTN0",1030,0) + if MaxDocLine="" goto CompExit +"RTN","TMGPUTN0",1031,0) + +"RTN","TMGPUTN0",1032,0) + set UplLine=BuffIdx +"RTN","TMGPUTN0",1033,0) + set DocLine=0 +"RTN","TMGPUTN0",1034,0) + +"RTN","TMGPUTN0",1035,0) + ;"Compare the two documents line by line. +"RTN","TMGPUTN0",1036,0) + for i=1:1:(MaxUplLine-UplLine) do if Break goto CompExit +"RTN","TMGPUTN0",1037,0) + . set UplData=$get(^TIU(8925.2,BuffNum,"TEXT",UplLine+i,0)) +"RTN","TMGPUTN0",1038,0) + . set DocData=$get(^TIU(8925,ExistingIEN,"TEXT",DocLine+i,0),"x") +"RTN","TMGPUTN0",1039,0) + . if UplData[TIUHSIG set i=MaxUplLine quit +"RTN","TMGPUTN0",1040,0) + . if UplData'=DocData set Break=1 quit +"RTN","TMGPUTN0",1041,0) + . quit +"RTN","TMGPUTN0",1042,0) + +"RTN","TMGPUTN0",1043,0) + ;"If we have gotten this far, then the text is an identical match. +"RTN","TMGPUTN0",1044,0) + set result=1 +"RTN","TMGPUTN0",1045,0) + +"RTN","TMGPUTN0",1046,0) + ;"Now check to see if the dictation type is the same. +"RTN","TMGPUTN0",1047,0) + set DocType=$piece($get(^TIU(8925,ExistingIEN,0)),"^",1) +"RTN","TMGPUTN0",1048,0) + if DocType=UplTIEN set result=2 +"RTN","TMGPUTN0",1049,0) + +"RTN","TMGPUTN0",1050,0) +CompExit +"RTN","TMGPUTN0",1051,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"CompToBuff") +"RTN","TMGPUTN0",1052,0) + quit result +"RTN","TMGPUTN0",1053,0) + +"RTN","TMGPUTN0",1054,0) + +"RTN","TMGPUTN0",1055,0) + ;------------------------------------------------------------------------ +"RTN","TMGPUTN0",1056,0) +CreateRec(Document) ; +"RTN","TMGPUTN0",1057,0) + ;"Purpose: Create document record - Returns DA +"RTN","TMGPUTN0",1058,0) + ;"Input: Document -- an array with document info. See GetRecord for documentation +"RTN","TMGPUTN0",1059,0) + ;"Ouput: DocIEN (internal entry number) of entry created, or -1 if failure +"RTN","TMGPUTN0",1060,0) + ;" Errors (if any) returned in Document("ERROR") +"RTN","TMGPUTN0",1061,0) + ;" +"RTN","TMGPUTN0",1062,0) + ;"Note: This was originally taken from TIUEDI3 +"RTN","TMGPUTN0",1063,0) + +"RTN","TMGPUTN0",1064,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"CreateRec") +"RTN","TMGPUTN0",1065,0) + +"RTN","TMGPUTN0",1066,0) + ;"new cOKToCont set cOKToCont=1 +"RTN","TMGPUTN0",1067,0) + new cAbort set cAbort=0 +"RTN","TMGPUTN0",1068,0) + new result set result=1; "cOKToCont +"RTN","TMGPUTN0",1069,0) + +"RTN","TMGPUTN0",1070,0) + new DIC,DLAYGO,X,Y,DIE,DR +"RTN","TMGPUTN0",1071,0) + +"RTN","TMGPUTN0",1072,0) + new DocIEN set DocIEN=-1 +"RTN","TMGPUTN0",1073,0) + new TMGFDA,RecNum,TMGMsg,Flags +"RTN","TMGPUTN0",1074,0) + set TMGFDA(8925,"+1,",.01)="`"_Document(cDocTIEN) +"RTN","TMGPUTN0",1075,0) + set Flags="E" +"RTN","TMGPUTN0",1076,0) + +"RTN","TMGPUTN0",1077,0) + ;"====================================================== +"RTN","TMGPUTN0",1078,0) + ;"Call UPDATE^DIE -- add new entries in files or subfiles. +"RTN","TMGPUTN0",1079,0) + ;"====================================================== +"RTN","TMGPUTN0",1080,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",1081,0) + . do DebugEntry^TMGDEBUG(.DBIndent,"TMGPOUTN0::UPDATE^DIE") +"RTN","TMGPUTN0",1082,0) + . if $data(TMGFDA)'=0 do ArrayDump^TMGDEBUG("TMGFDA") +"RTN","TMGPUTN0",1083,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"Flags=",Flags) +"RTN","TMGPUTN0",1084,0) + do +"RTN","TMGPUTN0",1085,0) + . new $etrap set $etrap="do ErrTrp^TMGDBAPI" +"RTN","TMGPUTN0",1086,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Remember, UPDATE^DIE adds new entries in files or subfiles.") +"RTN","TMGPUTN0",1087,0) + . set ^TMP("TMG",$J,"ErrorTrap")=result +"RTN","TMGPUTN0",1088,0) + . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE" +"RTN","TMGPUTN0",1089,0) + . do UPDATE^DIE(Flags,"TMGFDA","RecNum","TMGMsg") +"RTN","TMGPUTN0",1090,0) + . set result=^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGPUTN0",1091,0) + . kill ^TMP("TMG",$J,"ErrorTrap") +"RTN","TMGPUTN0",1092,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"TMGPOUTN0::UPDATE^DIE") +"RTN","TMGPUTN0",1093,0) + ;"====================================================== +"RTN","TMGPUTN0",1094,0) + ;"====================================================== +"RTN","TMGPUTN0",1095,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",1096,0) + . do ArrayDump^TMGDEBUG("RecNum") +"RTN","TMGPUTN0",1097,0) + . do ArrayDump^TMGDEBUG("TMGMsg") +"RTN","TMGPUTN0",1098,0) + +"RTN","TMGPUTN0",1099,0) + if result'=1 goto CRDone ;"1=cOKToCont +"RTN","TMGPUTN0",1100,0) + if $data(TMGMsg("DIERR")) do goto CRDone +"RTN","TMGPUTN0",1101,0) + . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGPUTN0",1102,0) + . set DocIEN=-1 +"RTN","TMGPUTN0",1103,0) + . merge Document("ERROR","DIERR")=TMGMsg +"RTN","TMGPUTN0",1104,0) + do +"RTN","TMGPUTN0",1105,0) + . new index set index=$order(RecNum("")) +"RTN","TMGPUTN0",1106,0) + . if index'="" set DocIEN=+$get(RecNum(index)) +"RTN","TMGPUTN0",1107,0) + if DocIEN=0 set DocIEN=-1 +"RTN","TMGPUTN0",1108,0) + +"RTN","TMGPUTN0",1109,0) +CRDone +"RTN","TMGPUTN0",1110,0) + ;"Now check for failure. DocIEN will equal record number, or -1 if failure +"RTN","TMGPUTN0",1111,0) + if DocIEN'>0 do goto CRDone +"RTN","TMGPUTN0",1112,0) + . new n set n=+$get(Document("ERROR","NUM"))+1 +"RTN","TMGPUTN0",1113,0) + . set Document("ERROR",n)=$piece(Document(cDocType),"^",3)_" record could not be created." +"RTN","TMGPUTN0",1114,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,Document("ERROR",n)) +"RTN","TMGPUTN0",1115,0) + set Document("DOC IEN")=DocIEN +"RTN","TMGPUTN0",1116,0) + +"RTN","TMGPUTN0",1117,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",1118,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"Leaving Create record. Our record number is ",DocIEN) +"RTN","TMGPUTN0",1119,0) + . do DebugExit^TMGDEBUG(.DBIndent,"CreateRec") +"RTN","TMGPUTN0",1120,0) + quit DocIEN +"RTN","TMGPUTN0",1121,0) + +"RTN","TMGPUTN0",1122,0) + +"RTN","TMGPUTN0",1123,0) + +"RTN","TMGPUTN0",1124,0) + ;------------------------------------------------------------------------ +"RTN","TMGPUTN0",1125,0) +StuffRec(Document,PARENT) +"RTN","TMGPUTN0",1126,0) + ;"Purpose: Stuff fixed field data +"RTN","TMGPUTN0",1127,0) + ;"INPUT: +"RTN","TMGPUTN0",1128,0) + ;" Document = An array containing information to put into document. +"RTN","TMGPUTN0",1129,0) + ;" The array should contain the following: +"RTN","TMGPUTN0",1130,0) + ;" Document("DOC IEN") -- the document IEN +"RTN","TMGPUTN0",1131,0) + ;" Document("PROVIDER IEN") -- the IEN of the provider +"RTN","TMGPUTN0",1132,0) + ;" Document("DFN") -- the patient IEN +"RTN","TMGPUTN0",1133,0) + ;" Document(cVisitIEN) -- a link to a visit entry +"RTN","TMGPUTN0",1134,0) + ;" Document(cStartDate) -- episode begin date/time +"RTN","TMGPUTN0",1135,0) + ;" Document(cEndDate) -- episode end date/time +"RTN","TMGPUTN0",1136,0) + ;" Document(cHspLocIEN) -- hospital location (Document(cVstLocIEN) used NULL) +"RTN","TMGPUTN0",1137,0) + ;" Document(cVstLocIEN) -- visit location. +"RTN","TMGPUTN0",1138,0) + ;" Document(cService) -- service (i.e. FAMILY PRACTICE) +"RTN","TMGPUTN0",1139,0) + ;" Document(cVisitStr) +"RTN","TMGPUTN0",1140,0) + ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist +"RTN","TMGPUTN0",1141,0) + ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist +"RTN","TMGPUTN0",1142,0) + ;" Document("LINE COUNT") -- Total line count +"RTN","TMGPUTN0",1143,0) + ;" PARENT: If we are working with an addendum to a document, then +"RTN","TMGPUTN0",1144,0) + ;" parent is the internal entry number of the original parent document +"RTN","TMGPUTN0",1145,0) + ;" Note:DocID can be null if not needed. +"RTN","TMGPUTN0",1146,0) + ;" Note: I don't ever pass a parent, currently +"RTN","TMGPUTN0",1147,0) + ;" +"RTN","TMGPUTN0",1148,0) + ;"NOTE: The following global-scope variables are also referenced +"RTN","TMGPUTN0",1149,0) + ;" TIUDDT +"RTN","TMGPUTN0",1150,0) + ;"Results: Passes back document IEN, or -1 if error. +"RTN","TMGPUTN0",1151,0) + ;" NOTE: if result is -1 then errors are passed back in +"RTN","TMGPUTN0",1152,0) + ;" Document("ERROR") node +"RTN","TMGPUTN0",1153,0) + ;" Document("ERROR",n)="ERROR.. Stuffing new document." +"RTN","TMGPUTN0",1154,0) + ;" Document("ERROR","NUM")=n +"RTN","TMGPUTN0",1155,0) + ;" Document("ERROR","FM INFO")=merge with DIERR array +"RTN","TMGPUTN0",1156,0) + +"RTN","TMGPUTN0",1157,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"StuffRec") +"RTN","TMGPUTN0",1158,0) + +"RTN","TMGPUTN0",1159,0) + new TMGFDA,TMGMsg +"RTN","TMGPUTN0",1160,0) + new RefDate +"RTN","TMGPUTN0",1161,0) + new result set result=1 ;"cOKToCont +"RTN","TMGPUTN0",1162,0) + new DocIEN set DocIEN=$get(Document("DOC IEN"),-1) +"RTN","TMGPUTN0",1163,0) + if DocIEN=-1 goto SfRecDone +"RTN","TMGPUTN0",1164,0) + new ParentDocType +"RTN","TMGPUTN0",1165,0) + +"RTN","TMGPUTN0",1166,0) + ;"Field (f) constants +"RTN","TMGPUTN0",1167,0) + new fPatient set fPatient=.02 ;"field .02 = PATIENT +"RTN","TMGPUTN0",1168,0) + new fVisit set fVisit=.03 ;"field .03 = VISIT +"RTN","TMGPUTN0",1169,0) + new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE +"RTN","TMGPUTN0",1170,0) + new fStatus set fStatus=.05 ;"field .05 = STATUS +"RTN","TMGPUTN0",1171,0) + new fParent set fParent=.06 ;"field .06 = PARENT +"RTN","TMGPUTN0",1172,0) + new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) +"RTN","TMGPUTN0",1173,0) + new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) +"RTN","TMGPUTN0",1174,0) + new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME +"RTN","TMGPUTN0",1175,0) + new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR +"RTN","TMGPUTN0",1176,0) + new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer +"RTN","TMGPUTN0",1177,0) + new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION +"RTN","TMGPUTN0",1178,0) + new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner +"RTN","TMGPUTN0",1179,0) + new fAttending set fAttending=1209 ;"field 1209 = ATTENDING +"RTN","TMGPUTN0",1180,0) + new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION +"RTN","TMGPUTN0",1181,0) + new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE +"RTN","TMGPUTN0",1182,0) + new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200) +"RTN","TMGPUTN0",1183,0) + new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' +"RTN","TMGPUTN0",1184,0) + new fService set fService=1404 ;"field 1404 = SERVICE +"RTN","TMGPUTN0",1185,0) + new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by +"RTN","TMGPUTN0",1186,0) + new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. +"RTN","TMGPUTN0",1187,0) + new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST +"RTN","TMGPUTN0",1188,0) + new fLineCount set fLineCout=.1 ;"field .1 = LINE COUNT +"RTN","TMGPUTN0",1189,0) + +"RTN","TMGPUTN0",1190,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",1191,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"Here the the Document array received") +"RTN","TMGPUTN0",1192,0) + . do ArrayDump^TMGDEBUG("Document") +"RTN","TMGPUTN0",1193,0) + +"RTN","TMGPUTN0",1194,0) + ;"8925=TIU DOCUMENT, the file we will edit +"RTN","TMGPUTN0",1195,0) + do Set8925Value(Document("DFN"),fPatient,1) +"RTN","TMGPUTN0",1196,0) + do Set8925Value(Document(cVisitIEN),fVisit,1) +"RTN","TMGPUTN0",1197,0) + do Set8925Value(Document("PROVIDER IEN"),fAuthor,1) +"RTN","TMGPUTN0",1198,0) + do Set8925Value(Document("PROVIDER IEN"),fExpSigner,1) +"RTN","TMGPUTN0",1199,0) + do Set8925Value(Document("PROVIDER IEN"),fAttending,1) +"RTN","TMGPUTN0",1200,0) + do Set8925Value(Document(cHspLocIEN),fHospLoc,1) +"RTN","TMGPUTN0",1201,0) + do Set8925Value(Document(cVstLocIEN),fVisitLoc,1) +"RTN","TMGPUTN0",1202,0) + do Set8925Value(Document("TRANSCRIPTIONIST"),fEnteredBy,0) ;"VA transcriptionist field +"RTN","TMGPUTN0",1203,0) + do Set8925Value(Document("CHARACTER COUNT - TRANSCRIPTIONIST'S"),fCharTrans,0) +"RTN","TMGPUTN0",1204,0) + +"RTN","TMGPUTN0",1205,0) + if $data(Document("LINE COUNT")) do +"RTN","TMGPUTN0",1206,0) + . do Set8925Value(Document("LINE COUNT"),fLineCount,0) +"RTN","TMGPUTN0",1207,0) + +"RTN","TMGPUTN0",1208,0) + set ParentDocType=$$DOCCLASS^TIULC1(+$piece(DocIEN,"^",2)) +"RTN","TMGPUTN0",1209,0) + if +ParentDocType>0 do Set8925Value(ParentDocType,fParentDoc,1) +"RTN","TMGPUTN0",1210,0) + +"RTN","TMGPUTN0",1211,0) + if $get(Document("AUTO SIGN"))=1 do +"RTN","TMGPUTN0",1212,0) + . do Set8925Value("COMPLETED",fStatus,0) +"RTN","TMGPUTN0",1213,0) + . do Set8925Value(Document("PROVIDER IEN"),fSignedBy,1) +"RTN","TMGPUTN0",1214,0) + else do +"RTN","TMGPUTN0",1215,0) + . do Set8925Value("UNSIGNED",fStatus,0) +"RTN","TMGPUTN0",1216,0) + +"RTN","TMGPUTN0",1217,0) + if +$get(PARENT)'>0 do +"RTN","TMGPUTN0",1218,0) + . do Set8925Value(Document("DFN"),fPatient,1) +"RTN","TMGPUTN0",1219,0) + . do Set8925Value(Document(cVisitIEN),fVisit,1) +"RTN","TMGPUTN0",1220,0) + . do Set8925Value(Document(cStartDate),fStartDate,0) +"RTN","TMGPUTN0",1221,0) + . do Set8925Value(Document(cEndDate),fEndDate,0) +"RTN","TMGPUTN0",1222,0) + . do Set8925Value(Document(cService),fService,0) +"RTN","TMGPUTN0",1223,0) + if +$get(PARENT)>0 do +"RTN","TMGPUTN0",1224,0) + . new NodeZero set NodeZero=$get(^TIU(8925,+PARENT,0)) +"RTN","TMGPUTN0",1225,0) + . new Node12 set Node12=$get(^TIU(8925,+PARENT,12)) +"RTN","TMGPUTN0",1226,0) + . new Node14 set Node14=$get(^TIU(8925,+PARENT,14)) +"RTN","TMGPUTN0",1227,0) + . ;" +"RTN","TMGPUTN0",1228,0) + . do Set8925Value(PARENT,fParent,1) +"RTN","TMGPUTN0",1229,0) + . do Set8925Value($piece(NodeZero,"^",pPatient),fPatient,1) +"RTN","TMGPUTN0",1230,0) + . do Set8925Value($piece(NodeZero,"^",pVisit),fVisit,1) +"RTN","TMGPUTN0",1231,0) + . do Set8925Value($piece(NodeZero,"^",pStrtDate),fStartDate,0) +"RTN","TMGPUTN0",1232,0) + . do Set8925Value($piece(NodeZero,"^",pEndDate),fEndDate,0) +"RTN","TMGPUTN0",1233,0) + . do Set8925Value($piece(Node12,"^",pHospLoc),fHospLoc,1) +"RTN","TMGPUTN0",1234,0) + . do Set8925Value($piece(Node14,"^",pService),fService,0) +"RTN","TMGPUTN0",1235,0) + +"RTN","TMGPUTN0",1236,0) + do Set8925Value($$NOW^TIULC,fEntryDate,0) +"RTN","TMGPUTN0",1237,0) + do Set8925Value(Document(cHspLocIEN),fHospLoc,1) +"RTN","TMGPUTN0",1238,0) + do Set8925Value(Document(cVstLocIEN),fVisitLoc,1) +"RTN","TMGPUTN0",1239,0) + do Set8925Value(Document(cStartDate),fRefDate,0) +"RTN","TMGPUTN0",1240,0) + do Set8925Value("U",fCapMethod,0) ;" U-->'upload' +"RTN","TMGPUTN0",1241,0) + ;"do Set8925Value(3,fStatus,0) +"RTN","TMGPUTN0",1242,0) + +"RTN","TMGPUTN0",1243,0) + new ErrArray +"RTN","TMGPUTN0",1244,0) + set result=$$dbWrite^TMGDBAPI(.TMGFDA,1,,,.ErrArray) +"RTN","TMGPUTN0",1245,0) + +"RTN","TMGPUTN0",1246,0) + ;" -- [Mark record for deferred crediting of stop code (fld #.11)]: -- +"RTN","TMGPUTN0",1247,0) + if +$get(Document("STOP")) do +"RTN","TMGPUTN0",1248,0) + . do DEFER^TIUVSIT(DocIEN,+$get(Document("STOP"))) +"RTN","TMGPUTN0",1249,0) + +"RTN","TMGPUTN0",1250,0) +SfRecDone +"RTN","TMGPUTN0",1251,0) + if result'=1 do +"RTN","TMGPUTN0",1252,0) + . set DocIEN=-1 ;"1=cOKToCont +"RTN","TMGPUTN0",1253,0) + . merge Document("ERROR","FM INFO")=ErrArray +"RTN","TMGPUTN0",1254,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"On exiting, result=",result," DocIEN=",DocIEN) +"RTN","TMGPUTN0",1255,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"StuffRec") +"RTN","TMGPUTN0",1256,0) + quit DocIEN +"RTN","TMGPUTN0",1257,0) + +"RTN","TMGPUTN0",1258,0) + +"RTN","TMGPUTN0",1259,0) +Set8925Value(Value,Field,IsIEN) +"RTN","TMGPUTN0",1260,0) + ;"Purpose: To provide a clean means of loading values into fields, into TMGFDA(8925,DOCIEN) +"RTN","TMGPUTN0",1261,0) + ;"Input: Value -- the value to load +"RTN","TMGPUTN0",1262,0) + ;" Field -- the field +"RTN","TMGPUTN0",1263,0) + ;" IsIEN = 1 if value is an IEN +"RTN","TMGPUTN0",1264,0) + ;"Note: DEPENDS ON GLOBAL-SCOPE VARIABLES: +"RTN","TMGPUTN0",1265,0) + ;" TMGFDA,DocIEN,Document +"RTN","TMGPUTN0",1266,0) + +"RTN","TMGPUTN0",1267,0) + new tempDB set tempDB=$get(TMGDEBUG) +"RTN","TMGPUTN0",1268,0) + set TMGDEBUG=0 ;"This is a temporary shutting OFF of debug system (original value restored below) +"RTN","TMGPUTN0",1269,0) + +"RTN","TMGPUTN0",1270,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"Set8925Value") +"RTN","TMGPUTN0",1271,0) + +"RTN","TMGPUTN0",1272,0) + if ($get(Value)'="")&($data(Field)>0) do +"RTN","TMGPUTN0",1273,0) + . if $get(IsIEN)>0 set Value="`"_+Value +"RTN","TMGPUTN0",1274,0) + . if Value'="`0" do +"RTN","TMGPUTN0",1275,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Setting field ",Field," to ",Value) +"RTN","TMGPUTN0",1276,0) + . . set TMGFDA(8925,DocIEN_",",Field)=Value +"RTN","TMGPUTN0",1277,0) + . else do +"RTN","TMGPUTN0",1278,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Field ",Field," was `0, so skipping.") +"RTN","TMGPUTN0",1279,0) + else do +"RTN","TMGPUTN0",1280,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Skipping: Value='",$get(Value),"' Field='",$get(Field),"'") +"RTN","TMGPUTN0",1281,0) + +"RTN","TMGPUTN0",1282,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"Set8925Value") +"RTN","TMGPUTN0",1283,0) + +"RTN","TMGPUTN0",1284,0) + set TMGDEBUG=tempDB +"RTN","TMGPUTN0",1285,0) + quit +"RTN","TMGPUTN0",1286,0) + +"RTN","TMGPUTN0",1287,0) + +"RTN","TMGPUTN0",1288,0) + +"RTN","TMGPUTN0",1289,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",1290,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",1291,0) + ;" F O L L O W - U P C O D E +"RTN","TMGPUTN0",1292,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",1293,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",1294,0) + +"RTN","TMGPUTN0",1295,0) +FOLLOWUP(DocIEN) ;" Post-filing code for PROGRESS NOTES +"RTN","TMGPUTN0",1296,0) + ;"PURPOSE: +"RTN","TMGPUTN0",1297,0) + ;" This function is called by the TIU upload document facilities. +"RTN","TMGPUTN0",1298,0) + ;" it is called after the text has been put into the document +"RTN","TMGPUTN0",1299,0) + ;" +"RTN","TMGPUTN0",1300,0) + ;"INPUT: +"RTN","TMGPUTN0",1301,0) + ;" DocIEN -- is passed a value held in TIUREC("#"), i.e. +"RTN","TMGPUTN0",1302,0) + ;" do FOLLOWUP^TIUPUTN1(TIUREC("#")). +"RTN","TMGPUTN0",1303,0) + +"RTN","TMGPUTN0",1304,0) + write ! +"RTN","TMGPUTN0",1305,0) + write "+-------------------------------------+",! +"RTN","TMGPUTN0",1306,0) + write "| Starting Follow-up code... |",! +"RTN","TMGPUTN0",1307,0) + write "+-------------------------------------+",! +"RTN","TMGPUTN0",1308,0) + +"RTN","TMGPUTN0",1309,0) + new TMGDEBUG +"RTN","TMGPUTN0",1310,0) + set TMGDEBUG=+$piece($get(^TMG(22711,1,0)),"^",2) ;"2=to Scrn; 3=to file +"RTN","TMGPUTN0",1311,0) + ;"if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 +"RTN","TMGPUTN0",1312,0) + +"RTN","TMGPUTN0",1313,0) + ;"9-1-05 -- turn off debug info +"RTN","TMGPUTN0",1314,0) + set TMGDEBUG=0 ;"2=to Scrn; 3=to file +"RTN","TMGPUTN0",1315,0) + +"RTN","TMGPUTN0",1316,0) + if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 +"RTN","TMGPUTN0",1317,0) + if $data(cAbort)#10=0 new cAbort set cAbort=0 +"RTN","TMGPUTN0",1318,0) + +"RTN","TMGPUTN0",1319,0) + new DBIndent,PriorErrorFound +"RTN","TMGPUTN0",1320,0) + new result set result=1 ;" 1=cOKToCont +"RTN","TMGPUTN0",1321,0) + +"RTN","TMGPUTN0",1322,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"FOLLOWUP^TMGPUTN0 (as close to start as possible)") +"RTN","TMGPUTN0",1323,0) + +"RTN","TMGPUTN0",1324,0) + new Document merge Document=TMGDOC +"RTN","TMGPUTN0",1325,0) + if $get(TMGDEBUG)>0 do +"RTN","TMGPUTN0",1326,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"Here the the Document array received") +"RTN","TMGPUTN0",1327,0) + . do ArrayDump^TMGDEBUG("Document") +"RTN","TMGPUTN0",1328,0) + . do DebugMsg^TMGDEBUG(.DBIndent,"The value of DocIEN (i.e. document#) that is passed is: ",DocIEN) +"RTN","TMGPUTN0",1329,0) + +"RTN","TMGPUTN0",1330,0) + new cStartDate set cStartDate="EDT" +"RTN","TMGPUTN0",1331,0) + new cEndDate set cEndDate="LDT" +"RTN","TMGPUTN0",1332,0) + new cService set cService="SVC" +"RTN","TMGPUTN0",1333,0) + new cDocType set cDocType="TYPE" +"RTN","TMGPUTN0",1334,0) + new cDocTIEN set cDocTIEN="TYPE IEN" +"RTN","TMGPUTN0",1335,0) + ;"new cDocIEN set cDocIEN="DOC IEN" +"RTN","TMGPUTN0",1336,0) + ;"new cPatIEN set cPatIEN="DFN" ;"DFN = Patient IEN +"RTN","TMGPUTN0",1337,0) + new cHspLocIEN set cHspLocIEN="LOC" +"RTN","TMGPUTN0",1338,0) + new cVstLocIEN set cVstLocIEN="VLOC" +"RTN","TMGPUTN0",1339,0) + new cVisitStr set cVisitStr="VSTR" +"RTN","TMGPUTN0",1340,0) + new cVisitIEN set cVisitIEN="VISIT" +"RTN","TMGPUTN0",1341,0) + new cStopCode set cStopCode="STOP" +"RTN","TMGPUTN0",1342,0) + +"RTN","TMGPUTN0",1343,0) + ;" 'p constants +"RTN","TMGPUTN0",1344,0) + new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02) +"RTN","TMGPUTN0",1345,0) + new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03) +"RTN","TMGPUTN0",1346,0) + new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07) +"RTN","TMGPUTN0",1347,0) + new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08) +"RTN","TMGPUTN0",1348,0) + +"RTN","TMGPUTN0",1349,0) + new pAuthor set pAuthor=2 ;"Node 12,piece 2 = AUTHOR/DICTATOR (field 1202) +"RTN","TMGPUTN0",1350,0) + new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204) +"RTN","TMGPUTN0",1351,0) + new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = field 1205 = HOSPITAL LOCATION +"RTN","TMGPUTN0",1352,0) + new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209) +"RTN","TMGPUTN0",1353,0) + new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210) +"RTN","TMGPUTN0",1354,0) + new pVstLoc set pVstLoc=11 ;"Node 12,piece 11 = field 1211 = VISIT LOCATION +"RTN","TMGPUTN0",1355,0) + +"RTN","TMGPUTN0",1356,0) + ;"Field (f) constants +"RTN","TMGPUTN0",1357,0) + new fPatient set fPatient=.02 ;"field .02 = PATIENT +"RTN","TMGPUTN0",1358,0) + new fVisit set fVisit=.03 ;"field .03 = VISIT +"RTN","TMGPUTN0",1359,0) + new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE +"RTN","TMGPUTN0",1360,0) + new fStatus set fStatus=.05 ;"field .05 = STATUS +"RTN","TMGPUTN0",1361,0) + new fParent set fParent=.06 ;"field .06 = PARENT +"RTN","TMGPUTN0",1362,0) + new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) +"RTN","TMGPUTN0",1363,0) + new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) +"RTN","TMGPUTN0",1364,0) + new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME +"RTN","TMGPUTN0",1365,0) + new fAuthor set fAuthor=1202 ;"field 1202 = AUTHOR/DICTATOR +"RTN","TMGPUTN0",1366,0) + new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer +"RTN","TMGPUTN0",1367,0) + new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION +"RTN","TMGPUTN0",1368,0) + new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner +"RTN","TMGPUTN0",1369,0) + new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION +"RTN","TMGPUTN0",1370,0) + new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE +"RTN","TMGPUTN0",1371,0) + new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' +"RTN","TMGPUTN0",1372,0) + new fService set fService=1404 ;"field 1404 = SERVICE +"RTN","TMGPUTN0",1373,0) + new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. +"RTN","TMGPUTN0",1374,0) + new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by +"RTN","TMGPUTN0",1375,0) + +"RTN","TMGPUTN0",1376,0) + new TMGFDA,TMGMsg +"RTN","TMGPUTN0",1377,0) + new DFN +"RTN","TMGPUTN0",1378,0) + new Attending,ExpSigner,ExpCosign,Author +"RTN","TMGPUTN0",1379,0) + new BailOut set BailOut=0 +"RTN","TMGPUTN0",1380,0) + new Node12 set Node12=$get(^TIU(8925,DocIEN,12)) +"RTN","TMGPUTN0",1381,0) + new NodeZero set NodeZero=$get(^TIU(8925,DocIEN,0)) +"RTN","TMGPUTN0",1382,0) + if $data(Document)=0 new Document +"RTN","TMGPUTN0",1383,0) + +"RTN","TMGPUTN0",1384,0) + set Author=+$piece(Node12,"^",pAuthor) +"RTN","TMGPUTN0",1385,0) + set Attending=+$piece(Node12,"^",pAttending) +"RTN","TMGPUTN0",1386,0) + set ExpCosign=+$piece(Node12,"^",pExpCosign) +"RTN","TMGPUTN0",1387,0) + set ExpSigner=+$piece(Node12,"^",pExpSigner) +"RTN","TMGPUTN0",1388,0) + +"RTN","TMGPUTN0",1389,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Author=",Author) +"RTN","TMGPUTN0",1390,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Attending=",Attending) +"RTN","TMGPUTN0",1391,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ExpCosign=",ExpCosign) +"RTN","TMGPUTN0",1392,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ExpSigner=",ExpSigner) +"RTN","TMGPUTN0",1393,0) + +"RTN","TMGPUTN0",1394,0) + do +"RTN","TMGPUTN0",1395,0) + . new Signer set Signer=$$WHOSIGNS^TIULC1(DocIEN) +"RTN","TMGPUTN0",1396,0) + . do Set8925Value($$WHOSIGNS^TIULC1(DocIEN),fExpSigner,1) +"RTN","TMGPUTN0",1397,0) + +"RTN","TMGPUTN0",1398,0) + if (Attending>0)&(ExpCosign=0) do +"RTN","TMGPUTN0",1399,0) + . do Set8925Value($$WHOCOSIG^TIULC1(DocIEN),fExpCosign,1) +"RTN","TMGPUTN0",1400,0) + +"RTN","TMGPUTN0",1401,0) + if (ExpCosign>0)&(ExpSigner'=ExpCosign) do +"RTN","TMGPUTN0",1402,0) + . do Set8925Value(1,fNeedCosign,0) +"RTN","TMGPUTN0",1403,0) + +"RTN","TMGPUTN0",1404,0) + set result=$$dbWrite^TMGDBAPI(.TMGFDA,1) +"RTN","TMGPUTN0",1405,0) + if result=-1 goto FUDone +"RTN","TMGPUTN0",1406,0) + +"RTN","TMGPUTN0",1407,0) + do RELEASE^TIUT(DocIEN,1) ;"Call function to 'Release Document from transcription' +"RTN","TMGPUTN0",1408,0) + do AUDIT^TIUEDI1(DocIEN,0,$$CHKSUM^TIULC("^TIU(8925,"_+DocIEN_",""TEXT"")")) ;"Update audit trail +"RTN","TMGPUTN0",1409,0) + +"RTN","TMGPUTN0",1410,0) + if '$data(Document) do if (BailOut=1) goto FUDone +"RTN","TMGPUTN0",1411,0) + . new VstLocIEN,HspLocIEN,StartDate,EndDate +"RTN","TMGPUTN0",1412,0) + . if $data(NodeZero)#10=0 do quit +"RTN","TMGPUTN0",1413,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"MISSING DATA. QUITING...") +"RTN","TMGPUTN0",1414,0) + . . set BailOut=1 +"RTN","TMGPUTN0",1415,0) + . set DFN=+$piece(NodeZero,"^",pPatient) +"RTN","TMGPUTN0",1416,0) + . set StartDate=+$piece(NodeZero,"^",pStrtDate) +"RTN","TMGPUTN0",1417,0) + . set EndDate=$$FMADD^XLFDT(StartDate,1) +"RTN","TMGPUTN0",1418,0) + . set Document(cHspLocIEN)=+$piece(Node12,"^",pHospLoc) +"RTN","TMGPUTN0",1419,0) + . set Document(cVstLocIEN)=+$piece(Node12,"^",pVstLoc) +"RTN","TMGPUTN0",1420,0) + . set VstLocIEN=Document(cVstLocIEN) +"RTN","TMGPUTN0",1421,0) + . if VstLocIEN'>0 set VstLocIEN=Document(cHspLocIEN) +"RTN","TMGPUTN0",1422,0) + . if (DFN>0)&(StartDate>0)&(EndDate>0)&(VstLocIEN>0) do +"RTN","TMGPUTN0",1423,0) + . . ;"This is an interactive visit .... +"RTN","TMGPUTN0",1424,0) + . . do MAIN^TIUVSIT(.Document,DFN,"",StartDate,EndDate,"LAST",0,VstLocIEN) +"RTN","TMGPUTN0",1425,0) + +"RTN","TMGPUTN0",1426,0) + if $data(Document)=0 goto FUDone +"RTN","TMGPUTN0",1427,0) + if $data(Document(cVisitStr))#10=0 goto FUDone +"RTN","TMGPUTN0",1428,0) + if $data(DFN)=0 set DFN=$get(Document("DFN")) if DFN="" goto FUDone +"RTN","TMGPUTN0",1429,0) + +"RTN","TMGPUTN0",1430,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"ENQ^TIUPXAP1") +"RTN","TMGPUTN0",1431,0) + ;"Note: reviewing the code for ENQ^TIUPXAP1, it appears the following is expected: +"RTN","TMGPUTN0",1432,0) + ;" .TIU array +"RTN","TMGPUTN0",1433,0) + ;" DFN -- the patient IEN +"RTN","TMGPUTN0",1434,0) + ;" DA -- the IEN of the document to work on. +"RTN","TMGPUTN0",1435,0) + ;" TIUDA -- the doc IEN that was passed to this function. +"RTN","TMGPUTN0",1436,0) + ;" Note, I'm not sure how DA and TIUDA are used differently. +"RTN","TMGPUTN0",1437,0) + ;" In fact, if $data(TIUDA)=0, then function uses DA. +"RTN","TMGPUTN0",1438,0) + ;" Unless I kill TIUDA (which might cause other problems), I don't +"RTN","TMGPUTN0",1439,0) + ;" know if TIUDA will hold an abherent value. So I'll set to DA +"RTN","TMGPUTN0",1440,0) + do +"RTN","TMGPUTN0",1441,0) + . new TIUDA set TIUDA=DocIEN +"RTN","TMGPUTN0",1442,0) + . new DA set DA=DocIEN +"RTN","TMGPUTN0",1443,0) + . new TIU merge TIU=Document +"RTN","TMGPUTN0",1444,0) + . do ENQ^TIUPXAP1 ;" Get/file VISIT +"RTN","TMGPUTN0",1445,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"ENQ^TIUPXAP1") +"RTN","TMGPUTN0",1446,0) + +"RTN","TMGPUTN0",1447,0) +FUDone ; +"RTN","TMGPUTN0",1448,0) + kill TMGDOC +"RTN","TMGPUTN0",1449,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"FOLLOWUP") +"RTN","TMGPUTN0",1450,0) + +"RTN","TMGPUTN0",1451,0) + quit +"RTN","TMGPUTN0",1452,0) + +"RTN","TMGPUTN0",1453,0) + +"RTN","TMGPUTN0",1454,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",1455,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",1456,0) + ;" R E - F I L I N G C O D E +"RTN","TMGPUTN0",1457,0) + ;"==============================================================================================- +"RTN","TMGPUTN0",1458,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGPUTN0",1459,0) + +"RTN","TMGPUTN0",1460,0) +REFILE +"RTN","TMGPUTN0",1461,0) + ;"Purpose: Somtimes the upload process fails because of an error in the +"RTN","TMGPUTN0",1462,0) + ;" upload filing code. Rather than require a re-upload of the file, +"RTN","TMGPUTN0",1463,0) + ;" this function will trigger a retry of filing the TIU UPLOAD BUFFER +"RTN","TMGPUTN0",1464,0) + ;" (file 8925.2) +"RTN","TMGPUTN0",1465,0) + ;"This function is called by menu option TMG REFILE UPLOAD +"RTN","TMGPUTN0",1466,0) + +"RTN","TMGPUTN0",1467,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"REFILE^TMGPUTN0") +"RTN","TMGPUTN0",1468,0) + +"RTN","TMGPUTN0",1469,0) + new TIUDA set TIUDA="" +"RTN","TMGPUTN0",1470,0) + new job +"RTN","TMGPUTN0",1471,0) + new DoRetry set DoRetry="" +"RTN","TMGPUTN0",1472,0) + new Abort set Abort=0 +"RTN","TMGPUTN0",1473,0) + new Found set Found=0 +"RTN","TMGPUTN0",1474,0) + +"RTN","TMGPUTN0",1475,0) + write !,! +"RTN","TMGPUTN0",1476,0) + write "------------------------------------------------",! +"RTN","TMGPUTN0",1477,0) + write " Refiler for failed uploads (i.e. a second try.)",! +"RTN","TMGPUTN0",1478,0) + write "------------------------------------------------",!,! +"RTN","TMGPUTN0",1479,0) + +"RTN","TMGPUTN0",1480,0) + write "Here are all the failed uploads:",!,! +"RTN","TMGPUTN0",1481,0) + set job=$order(^TIU(8925.2,"B","")) +"RTN","TMGPUTN0",1482,0) + for do quit:(job="") +"RTN","TMGPUTN0",1483,0) + . new Buff,NextBuff +"RTN","TMGPUTN0",1484,0) + . if job="" quit +"RTN","TMGPUTN0",1485,0) + . set Buff=$order(^TIU(8925.2,"B",job,"")) +"RTN","TMGPUTN0",1486,0) + . for do quit:(Buff="") +"RTN","TMGPUTN0",1487,0) + . . if Buff="" quit +"RTN","TMGPUTN0",1488,0) + . . write "Buffer #"_Buff_" (created by process #"_job_")",! +"RTN","TMGPUTN0",1489,0) + . . set Found=1 +"RTN","TMGPUTN0",1490,0) + . . set Buff=$order(^TIU(8925.2,"B",job,Buff)) +"RTN","TMGPUTN0",1491,0) + . set job=$order(^TIU(8925.2,"B",job)) +"RTN","TMGPUTN0",1492,0) + +"RTN","TMGPUTN0",1493,0) + if Found=0 write "(There are no failed uploads to process... Great!)",! +"RTN","TMGPUTN0",1494,0) + else write "------------------------------------------------",! +"RTN","TMGPUTN0",1495,0) + +"RTN","TMGPUTN0",1496,0) + set job=$order(^TIU(8925.2,"B","")) +"RTN","TMGPUTN0",1497,0) + for do quit:(job="")!(Abort=1) +"RTN","TMGPUTN0",1498,0) + . new Buff,NextBuff +"RTN","TMGPUTN0",1499,0) + . if job="" quit +"RTN","TMGPUTN0",1500,0) + . set Buff=$order(^TIU(8925.2,"B",job,"")) +"RTN","TMGPUTN0",1501,0) + . for do quit:(Buff="")!(Abort=1) +"RTN","TMGPUTN0",1502,0) + . . if Buff="" quit +"RTN","TMGPUTN0",1503,0) + . . if DoRetry'="all" do +"RTN","TMGPUTN0",1504,0) + . . . write !,"Refile upload buffer #"_Buff_" (created by process #"_job_")? (y/n/all/^) " +"RTN","TMGPUTN0",1505,0) + . . . read DoRetry:$get(DTIME,300),! +"RTN","TMGPUTN0",1506,0) + . . else do +"RTN","TMGPUTN0",1507,0) + . . . new GetKey +"RTN","TMGPUTN0",1508,0) + . . . read *GetKey:0 +"RTN","TMGPUTN0",1509,0) + . . . if $get(GetKey)=27 set DoRetry="n" +"RTN","TMGPUTN0",1510,0) + . . . else write !,!,"Processing upload buffer #",Buff,! +"RTN","TMGPUTN0",1511,0) + . . if DoRetry="^" set Abort=1 quit +"RTN","TMGPUTN0",1512,0) + . . if (DoRetry["y")!(DoRetry["Y")!(DoRetry="all") do +"RTN","TMGPUTN0",1513,0) + . . . set TIUDA=Buff +"RTN","TMGPUTN0",1514,0) + . . . ;"These is an edited form of MAIN^TIUUPLD +"RTN","TMGPUTN0",1515,0) + . . . N EOM,TIUERR,TIUHDR,TIULN,TIUSRC,X +"RTN","TMGPUTN0",1516,0) + . . . I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE +"RTN","TMGPUTN0",1517,0) + . . . S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11) +"RTN","TMGPUTN0",1518,0) + . . . I EOM']"",($P(TIUPRM0,U,17)'="k") do quit +"RTN","TMGPUTN0",1519,0) + . . . . W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! +"RTN","TMGPUTN0",1520,0) + . . . S:TIUSRC']"" TIUSRC="R" +"RTN","TMGPUTN0",1521,0) + . . . S TIUHDR=$P(TIUPRM0,U,10) +"RTN","TMGPUTN0",1522,0) + . . . I TIUHDR']"" do quit +"RTN","TMGPUTN0",1523,0) + . . . . W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! +"RTN","TMGPUTN0",1524,0) + . . . new temp set temp=$order(^TIU(8925.2,TIUDA,"TEXT",0)) +"RTN","TMGPUTN0",1525,0) + . . . write "First line of TEXT=",temp,! +"RTN","TMGPUTN0",1526,0) + . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0 do +"RTN","TMGPUTN0",1527,0) + . . . . write "Calling FILE^TIUUPLD("_TIUDA_")",! +"RTN","TMGPUTN0",1528,0) + . . . . D FILE^TIUUPLD(TIUDA) +"RTN","TMGPUTN0",1529,0) + . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0 D BUFPURGE^TIUPUTC(TIUDA) +"RTN","TMGPUTN0",1530,0) + . . set Buff=$order(^TIU(8925.2,"B",job,Buff)) +"RTN","TMGPUTN0",1531,0) + . set job=$order(^TIU(8925.2,"B",job)) +"RTN","TMGPUTN0",1532,0) + +"RTN","TMGPUTN0",1533,0) + write !,"------------------------------------------------",! +"RTN","TMGPUTN0",1534,0) + write " All done with Refiler",! +"RTN","TMGPUTN0",1535,0) + write "------------------------------------------------",!,! +"RTN","TMGPUTN0",1536,0) + +"RTN","TMGPUTN0",1537,0) +RFDone +"RTN","TMGPUTN0",1538,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"REFILE^TMGPUTN0") +"RTN","TMGPUTN0",1539,0) + Q +"RTN","TMGPUTN0",1540,0) + +"RTN","TMGPUTN0",1541,0) + +"RTN","TMGPUTN0",1542,0) + +"RTN","TMGPUTN0",1543,0) + +"RTN","TMGQIO") +0^71^B78392 +"RTN","TMGQIO",1,0) + TMGQIO ;TMG/kst/Quiet IO routines ;03/25/06 +"RTN","TMGQIO",2,0) + ;;1.0;TMG-LIB;**1**;11/01/04 +"RTN","TMGQIO",3,0) + +"RTN","TMGQIO",4,0) + ;"'QUIET IO To provide routines for quite (non-interactive) IO that programs can call. +"RTN","TMGQIO",5,0) + ;"============================================================================= +"RTN","TMGQIO",6,0) + ;"Kevin Toppenberg, MD 11-04 +"RTN","TMGQIO",7,0) + ;" +"RTN","TMGQIO",8,0) + ;"'QUIET IO" +"RTN","TMGQIO",9,0) + ;" +"RTN","TMGQIO",10,0) + ;"Purpose: +"RTN","TMGQIO",11,0) + ;" To provide routines for quite (non-interactive) IO that programs can call. +"RTN","TMGQIO",12,0) + ;" i.e. replacement routines for READ and WRITE +"RTN","TMGQIO",13,0) + ;" +"RTN","TMGQIO",14,0) + ;"Functions: +"RTN","TMGQIO",15,0) + ;" OUTP(SILENT,A,B,C,D,E,F,G,H,I,J) +"RTN","TMGQIO",16,0) + ;" WOUT(S) +"RTN","TMGQIO",17,0) + ;" SILENTW(S) -- puts output into INFO("TEXT") +"RTN","TMGQIO",18,0) + ;" INP(VAR,SILENT,TIMEOUT,SILNTVAL,A,B,C,D,E,F,G,H,I,J) +"RTN","TMGQIO",19,0) + ;" +"RTN","TMGQIO",20,0) + ;"Dependancies: +"RTN","TMGQIO",21,0) + ;" if TMGDEBUG defined, then requires TMGDEBUG.m +"RTN","TMGQIO",22,0) + ;"============================================================================= +"RTN","TMGQIO",23,0) + +"RTN","TMGQIO",24,0) +OUTP(SILENT,A,B,C,D,E,F,G,H,I,J) +"RTN","TMGQIO",25,0) + ;"Purpose: To provide an output channel for this program module. Will allow +"RTN","TMGQIO",26,0) + ;" converting to a "SILENT-OUTPUT" mode. +"RTN","TMGQIO",27,0) + ; +"RTN","TMGQIO",28,0) + ;"IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"OUTP^TMGQIO") +"RTN","TMGQIO",29,0) + IF $GET(SILENT,0)=1 DO GOTO OPQUIT +"RTN","TMGQIO",30,0) + . IF '$$SILENTW(.A) QUIT +"RTN","TMGQIO",31,0) + . IF '$$SILENTW(.B) QUIT +"RTN","TMGQIO",32,0) + . IF '$$SILENTW(.C) QUIT +"RTN","TMGQIO",33,0) + . IF '$$SILENTW(.D) QUIT +"RTN","TMGQIO",34,0) + . IF '$$SILENTW(.E) QUIT +"RTN","TMGQIO",35,0) + . IF '$$SILENTW(.F) QUIT +"RTN","TMGQIO",36,0) + . IF '$$SILENTW(.G) QUIT +"RTN","TMGQIO",37,0) + . IF '$$SILENTW(.H) QUIT +"RTN","TMGQIO",38,0) + . IF '$$SILENTW(.I) QUIT +"RTN","TMGQIO",39,0) + . IF '$$SILENTW(.J) QUIT +"RTN","TMGQIO",40,0) + ELSE DO GOTO OPQUIT +"RTN","TMGQIO",41,0) + . IF '$$WOUT(.A) QUIT +"RTN","TMGQIO",42,0) + . IF '$$WOUT(.B) QUIT +"RTN","TMGQIO",43,0) + . IF '$$WOUT(.C) QUIT +"RTN","TMGQIO",44,0) + . IF '$$WOUT(.D) QUIT +"RTN","TMGQIO",45,0) + . IF '$$WOUT(.E) QUIT +"RTN","TMGQIO",46,0) + . IF '$$WOUT(.F) QUIT +"RTN","TMGQIO",47,0) + . IF '$$WOUT(.G) QUIT +"RTN","TMGQIO",48,0) + . IF '$$WOUT(.H) QUIT +"RTN","TMGQIO",49,0) + . IF '$$WOUT(.I) QUIT +"RTN","TMGQIO",50,0) + . IF '$$WOUT(.J) QUIT +"RTN","TMGQIO",51,0) + ; +"RTN","TMGQIO",52,0) +OPQUIT +"RTN","TMGQIO",53,0) + ;"IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"OUTP^TMGQIO") +"RTN","TMGQIO",54,0) + QUIT +"RTN","TMGQIO",55,0) + ; +"RTN","TMGQIO",56,0) + ; +"RTN","TMGQIO",57,0) +WOUT(S) +"RTN","TMGQIO",58,0) + ;"Purpose: To write out S, or newline if "!" passed +"RTN","TMGQIO",59,0) + ;"Result: 1 if text output, 0 if it wasn't +"RTN","TMGQIO",60,0) + ; +"RTN","TMGQIO",61,0) + ;"IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"WOUT^TMGQIO") +"RTN","TMGQIO",62,0) + ;"IF $GET(TMGDEBUG)>0 DO DebugMsg^TMGDEBUG(.DBIndent,"S='",$GET(S),"'") +"RTN","TMGQIO",63,0) + NEW RESULT SET RESULT=0 +"RTN","TMGQIO",64,0) + IF $DATA(S)'=0 DO +"RTN","TMGQIO",65,0) + . SET RESULT=1 +"RTN","TMGQIO",66,0) + . IF S="!" WRITE ! QUIT +"RTN","TMGQIO",67,0) + . IF ($EXTRACT(S,1)="?")&(+$EXTRACT(S,2,256)>0) DO +"RTN","TMGQIO",68,0) + . . NEW INDENT,I +"RTN","TMGQIO",69,0) + . . SET INDENT=+$EXTRACT(S,2,256) +"RTN","TMGQIO",70,0) + . . FOR I=1:1:INDENT WRITE " " +"RTN","TMGQIO",71,0) + . ELSE WRITE S +"RTN","TMGQIO",72,0) + ;"IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"WOUT^TMGQIO") +"RTN","TMGQIO",73,0) + QUIT RESULT +"RTN","TMGQIO",74,0) + ; +"RTN","TMGQIO",75,0) + ; +"RTN","TMGQIO",76,0) +SILENTW(S) +"RTN","TMGQIO",77,0) + ;"Purpose: To take text and put in INFO Array +"RTN","TMGQIO",78,0) + ;"Result: 1 if text output, 0 if it wasn't +"RTN","TMGQIO",79,0) + ; +"RTN","TMGQIO",80,0) + IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"SILENTW^TMGQIO") +"RTN","TMGQIO",81,0) + NEW RESULT SET RESULT=0 +"RTN","TMGQIO",82,0) + IF $DATA(S)=0 GOTO SWQ +"RTN","TMGQIO",83,0) + NEW LINE +"RTN","TMGQIO",84,0) + SET LINE=$get(INFO("TEXT","LINES"),1) +"RTN","TMGQIO",85,0) + DO DebugMsg^TMGDEBUG(.DBIndent,"s=",S) +"RTN","TMGQIO",86,0) + IF S="!" DO +"RTN","TMGQIO",87,0) + . IF $DATA(INFO("TEXT",LINE))=0 SET INFO("TEXT",LINE)=" " +"RTN","TMGQIO",88,0) + . SET INFO("TEXT","LINES")=LINE+1 +"RTN","TMGQIO",89,0) + ELSE DO +"RTN","TMGQIO",90,0) + . IF $EXTRACT(S,1)="?" set S="" ;"Ignore ?x's +"RTN","TMGQIO",91,0) + . SET INFO("TEXT",LINE)=$get(INFO("TEXT",LINE)," ")_S +"RTN","TMGQIO",92,0) + SET RESULT=1 +"RTN","TMGQIO",93,0) +SWQ +"RTN","TMGQIO",94,0) + IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"SILENTW^TMGQIO") +"RTN","TMGQIO",95,0) + QUIT RESULT +"RTN","TMGQIO",96,0) + ; +"RTN","TMGQIO",97,0) + ; +"RTN","TMGQIO",98,0) +INP(VAR,SILENT,TIMEOUT,SILNTVAL,A,B,C,D,E,F,G,H,I,J) +"RTN","TMGQIO",99,0) + ;"Purpose: To provide an input that may or may not be silent +"RTN","TMGQIO",100,0) + ;"Input VAR: variable to input. SHOULD PASS BY REFERENCE +"RTN","TMGQIO",101,0) + ;" SILENT: 1=silent (will get value from SILNTVAL), 0=interactive +"RTN","TMGQIO",102,0) + ;" TIMEOUT: value to timeout user input (optional, will default to 120) +"RTN","TMGQIO",103,0) + ;" SILNTVAL: the value to use to assign VAR if SILENT=1 +"RTN","TMGQIO",104,0) + ;" A..J: optional prompts for input if not in silent mode +"RTN","TMGQIO",105,0) + IF $GET(TMGDEBUG)>0 DO DebugEntry^TMGDEBUG(.DBIndent,"INP^TMGQIO") +"RTN","TMGQIO",106,0) + +"RTN","TMGQIO",107,0) + SET SILENT=$get(SILENT,0) +"RTN","TMGQIO",108,0) + IF SILENT=1 DO +"RTN","TMGQIO",109,0) + . SET VAR=$get(SILNTVAL) +"RTN","TMGQIO",110,0) + . IF $GET(TMGDEBUG)>0 DO DebugMsg^TMGDEBUG(.DBIndent,"Silent input used=",VAR) +"RTN","TMGQIO",111,0) + . DO OUTP(SILNTOUT,VAR,"!") ;//to show log the value used. +"RTN","TMGQIO",112,0) + ELSE DO +"RTN","TMGQIO",113,0) + . DO OUTP(SILNTOUT,.A,.B,.C,.D,.E,.F,.G,.H,.I,.J) +"RTN","TMGQIO",114,0) + . SET TIMEOUT=$get(TIMEOUT,120) +"RTN","TMGQIO",115,0) + . READ VAR:TIMEOUT +"RTN","TMGQIO",116,0) + . DO OUTP(SILNTOUT,"!") +"RTN","TMGQIO",117,0) + ; +"RTN","TMGQIO",118,0) + IF $GET(TMGDEBUG)>0 DO DebugExit^TMGDEBUG(.DBIndent,"INP^TMGQIO") +"RTN","TMGQIO",119,0) + QUIT +"RTN","TMGQIO",120,0) + ; +"RTN","TMGQIO",121,0) + ; +"RTN","TMGRPC1") +0^72^B6434 +"RTN","TMGRPC1",1,0) +TMGRPC1 ;TMG/kst-RPC Functions ;03/25/06 +"RTN","TMGRPC1",2,0) + ;;1.0;TMG-LIB;**1**;06/04/08 +"RTN","TMGRPC1",3,0) + +"RTN","TMGRPC1",4,0) + ;"TMG RPC FUNCTIONS +"RTN","TMGRPC1",5,0) + +"RTN","TMGRPC1",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGRPC1",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGRPC1",8,0) + ;"3/24/07 +"RTN","TMGRPC1",9,0) + +"RTN","TMGRPC1",10,0) + ;"======================================================================= +"RTN","TMGRPC1",11,0) + ;" RPC -- Public Functions. +"RTN","TMGRPC1",12,0) + ;"======================================================================= +"RTN","TMGRPC1",13,0) + ;"DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) +"RTN","TMGRPC1",14,0) + ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) +"RTN","TMGRPC1",15,0) + ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file +"RTN","TMGRPC1",16,0) + ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File +"RTN","TMGRPC1",17,0) + ;"GETLONG(GREF,IMAGEIEN) +"RTN","TMGRPC1",18,0) + ;"GETDFN(RESULT,RECNUM,RECFIELD,LNAME,FNAME,MNAME,DOB,SEX,SSNUM) +"RTN","TMGRPC1",19,0) + ;"BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) +"RTN","TMGRPC1",20,0) + ;"AUTOSIGN(RESULT,DOCIEN) +"RTN","TMGRPC1",21,0) + ;"FNINFO(RESULT,DFN) -- GET PATIENT DEMOGRAPHICS +"RTN","TMGRPC1",22,0) + ;"PTADD(RESULT,INFO) -- ADD PATIENT +"RTN","TMGRPC1",23,0) + ;"STPTINFO(RESULT,DFN,INFO) -- SET PATIENT DEMOGRAPHICS +"RTN","TMGRPC1",24,0) + ;"GETURLS(RESULT) -- TMG CPRS GET URL LIST +"RTN","TMGRPC1",25,0) + +"RTN","TMGRPC1",26,0) + ;"======================================================================= +"RTN","TMGRPC1",27,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGRPC1",28,0) + ;"======================================================================= +"RTN","TMGRPC1",29,0) + ;"ENCODE(GRef,incSubscr,encodeFn) +"RTN","TMGRPC1",30,0) + ;"DECODE(GRef,incSubscr,decodeFn) +"RTN","TMGRPC1",31,0) + ;"$$HEXCODER(INPUT) ;"encode the input string. Currently using simple hex encoding/ +"RTN","TMGRPC1",32,0) + ;"$$B64CODER(INPUT) ;"encode the input string via UUENCODE (actually Base64) +"RTN","TMGRPC1",33,0) + ;"$$B64DECODER(INPUT) ;"encode the input string via UUDECODE (actually Base64) +"RTN","TMGRPC1",34,0) + +"RTN","TMGRPC1",35,0) + ;"======================================================================= +"RTN","TMGRPC1",36,0) + ;"======================================================================= +"RTN","TMGRPC1",37,0) + ;"Dependencies: +"RTN","TMGRPC1",38,0) + ;"TMGBINF +"RTN","TMGRPC1",39,0) + ;"TMGSTUTL +"RTN","TMGRPC1",40,0) + ;"RGUTUU +"RTN","TMGRPC1",41,0) + ;"======================================================================= +"RTN","TMGRPC1",42,0) + ;"======================================================================= +"RTN","TMGRPC1",43,0) + +"RTN","TMGRPC1",44,0) +DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) +"RTN","TMGRPC1",45,0) + ;"SCOPE: Public +"RTN","TMGRPC1",46,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",47,0) + ;" will ask for a given file, and it will be passed back in the form +"RTN","TMGRPC1",48,0) + ;" of an array (in BASE64 ascii encoding) +"RTN","TMGRPC1",49,0) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",50,0) + ;" FPATH -- the file path up to, but not including, the filename +"RTN","TMGRPC1",51,0) + ;" Use '/' to NOT specify any subdirectory +"RTN","TMGRPC1",52,0) + ;" FNAME -- the name of the file to pass back +"RTN","TMGRPC1",53,0) + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from +"RTN","TMGRPC1",54,0) + ;" default value is 1 +"RTN","TMGRPC1",55,0) + ;" Note: For security reasons, all path requests will be considered relative to a root path. +"RTN","TMGRPC1",56,0) + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"RTN","TMGRPC1",57,0) + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg +"RTN","TMGRPC1",58,0) + ;" This root path is found in custom field 22701 in file 2005.2 +"RTN","TMGRPC1",59,0) + ;"Output: results are passed out in @GREF +"RTN","TMGRPC1",60,0) + ;" @GREF@(0)=success; 1=success, 0=failure +"RTN","TMGRPC1",61,0) + ;" @GREF@(1..xxx) = actual data +"RTN","TMGRPC1",62,0) + +"RTN","TMGRPC1",63,0) + set FPATH=$get(FPATH) +"RTN","TMGRPC1",64,0) + set FNAME=$get(FNAME) +"RTN","TMGRPC1",65,0) + set LOCIEN=$GET(LOCIEN,1) +"RTN","TMGRPC1",66,0) + +"RTN","TMGRPC1",67,0) + new PathRoot +"RTN","TMGRPC1",68,0) + set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) ;"NOTE: CUSTOM FIELD +"RTN","TMGRPC1",69,0) + +"RTN","TMGRPC1",70,0) + new NodeDiv +"RTN","TMGRPC1",71,0) + set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" NOTE: CUSTOM FIELD +"RTN","TMGRPC1",72,0) + +"RTN","TMGRPC1",73,0) + new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) +"RTN","TMGRPC1",74,0) + new StartPath set StartPath=$extract(FPATH,1) +"RTN","TMGRPC1",75,0) + +"RTN","TMGRPC1",76,0) + if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do +"RTN","TMGRPC1",77,0) + . set FPATH=$extract(FPATH,2,1024) +"RTN","TMGRPC1",78,0) + else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do +"RTN","TMGRPC1",79,0) + . set PathRoot=PathRoot_NodeDiv +"RTN","TMGRPC1",80,0) + +"RTN","TMGRPC1",81,0) + set FPATH=PathRoot_FPATH +"RTN","TMGRPC1",82,0) + +"RTN","TMGRPC1",83,0) + set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")" +"RTN","TMGRPC1",84,0) + +"RTN","TMGRPC1",85,0) + kill @GREF +"RTN","TMGRPC1",86,0) + set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3) +"RTN","TMGRPC1",87,0) + +"RTN","TMGRPC1",88,0) + do ENCODE($name(@GREF@(1)),3) +"RTN","TMGRPC1",89,0) + +"RTN","TMGRPC1",90,0) + quit +"RTN","TMGRPC1",91,0) + +"RTN","TMGRPC1",92,0) + +"RTN","TMGRPC1",93,0) +UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) +"RTN","TMGRPC1",94,0) + ;"SCOPE: Public +"RTN","TMGRPC1",95,0) + ;"RPC That calls this: TMG UPLOAD FILE +"RTN","TMGRPC1",96,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",97,0) + ;" will provide a file for upload (in BASE64 ascii encoding) +"RTN","TMGRPC1",98,0) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",99,0) + ;" FPATH -- the file path up to, but not including, the filename +"RTN","TMGRPC1",100,0) + ;" Use '/' to NOT specify any subdirectory +"RTN","TMGRPC1",101,0) + ;" FNAME -- the name of the file to pass back +"RTN","TMGRPC1",102,0) + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to +"RTN","TMGRPC1",103,0) + ;" default value is 1 +"RTN","TMGRPC1",104,0) + ;" Note: For security reasons, all path requests will be considered relative to a root path. +"RTN","TMGRPC1",105,0) + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"RTN","TMGRPC1",106,0) + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg +"RTN","TMGRPC1",107,0) + ;" This root path is found in custom field 22701 in file 2005.2 +"RTN","TMGRPC1",108,0) + ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding +"RTN","TMGRPC1",109,0) + ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage +"RTN","TMGRPC1",110,0) + +"RTN","TMGRPC1",111,0) + new result +"RTN","TMGRPC1",112,0) + new resultMsg set resultMsg="1^Successful Upload" +"RTN","TMGRPC1",113,0) + +"RTN","TMGRPC1",114,0) + set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH) +"RTN","TMGRPC1",115,0) + set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME) +"RTN","TMGRPC1",116,0) + set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN) +"RTN","TMGRPC1",117,0) + +"RTN","TMGRPC1",118,0) + if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone +"RTN","TMGRPC1",119,0) + set FPATH=$get(FPATH) +"RTN","TMGRPC1",120,0) + if FPATH="" set resultMsg="0^No file path received" goto UpDone +"RTN","TMGRPC1",121,0) + set FNAME=$get(FNAME) +"RTN","TMGRPC1",122,0) + if FNAME="" set resultMsg="0^No file name received" goto UpDone +"RTN","TMGRPC1",123,0) + set LOCIEN=$GET(LOCIEN,1); +"RTN","TMGRPC1",124,0) + new GREF +"RTN","TMGRPC1",125,0) + +"RTN","TMGRPC1",126,0) + new PathRoot +"RTN","TMGRPC1",127,0) + set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) +"RTN","TMGRPC1",128,0) + +"RTN","TMGRPC1",129,0) + new NodeDiv +"RTN","TMGRPC1",130,0) + set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" +"RTN","TMGRPC1",131,0) + +"RTN","TMGRPC1",132,0) + new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) +"RTN","TMGRPC1",133,0) + new StartPath set StartPath=$extract(FPATH,1) +"RTN","TMGRPC1",134,0) + if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do +"RTN","TMGRPC1",135,0) + . set FPATH=$extract(FPATH,2,1024) +"RTN","TMGRPC1",136,0) + else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do +"RTN","TMGRPC1",137,0) + . set PathRoot=PathRoot_NodeDiv +"RTN","TMGRPC1",138,0) + +"RTN","TMGRPC1",139,0) + set FPATH=PathRoot_FPATH +"RTN","TMGRPC1",140,0) + +"RTN","TMGRPC1",141,0) + merge ^TMP("UPLOAD^TMGRPC1",$J,"ENCODED")=ARRAY ;"//TEMP +"RTN","TMGRPC1",142,0) + do DECODE("ARRAY(0)",1) +"RTN","TMGRPC1",143,0) + merge ^TMP("UPLOAD^TMGRPC1",$J,"DECODED")=ARRAY ;"//TEMP +"RTN","TMGRPC1",144,0) + +"RTN","TMGRPC1",145,0) + if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do +"RTN","TMGRPC1",146,0) + . set resultMsg="0^Error while saving file" +"RTN","TMGRPC1",147,0) + +"RTN","TMGRPC1",148,0) +UpDone +"RTN","TMGRPC1",149,0) + set RESULT=resultMsg +"RTN","TMGRPC1",150,0) + quit +"RTN","TMGRPC1",151,0) + +"RTN","TMGRPC1",152,0) + +"RTN","TMGRPC1",153,0) +DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file +"RTN","TMGRPC1",154,0) + ;"SCOPE: Public +"RTN","TMGRPC1",155,0) + ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX +"RTN","TMGRPC1",156,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",157,0) + ;" will request for the file to be placed into in a 'dropbox' file +"RTN","TMGRPC1",158,0) + ;" location that both the client and server can access. File may be +"RTN","TMGRPC1",159,0) + ;" moved from there to its final destination by the client. +"RTN","TMGRPC1",160,0) + ;" This method alloows file-hiding ability on the server side. +"RTN","TMGRPC1",161,0) + ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",162,0) + ;" FPATH -- the file path up to, but not including, the filename. This +"RTN","TMGRPC1",163,0) + ;" is the path that the file is stored at (relative to a root path, +"RTN","TMGRPC1",164,0) + ;" see comments below). It is NOT the path of the dropbox. +"RTN","TMGRPC1",165,0) + ;" Use '/' to NOT specify any subdirectory +"RTN","TMGRPC1",166,0) + ;" FNAME -- the name of the file to be uploaded. Note: This is also the +"RTN","TMGRPC1",167,0) + ;" name of the file to be put into the dropbox. It is the +"RTN","TMGRPC1",168,0) + ;" responsibility of the client to ensure that there is not already +"RTN","TMGRPC1",169,0) + ;" a similarly named file in the dropbox before requesting a file +"RTN","TMGRPC1",170,0) + ;" be put there. It is the responsibility of the client to delete +"RTN","TMGRPC1",171,0) + ;" the file from the drop box. +"RTN","TMGRPC1",172,0) + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from +"RTN","TMGRPC1",173,0) + ;" default value is 1 +"RTN","TMGRPC1",174,0) + ;" Note: For security reasons, all path requests will be considered relative to a root path. +"RTN","TMGRPC1",175,0) + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"RTN","TMGRPC1",176,0) + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg +"RTN","TMGRPC1",177,0) + ;" This root path is found in custom field 22701 in file 2005.2 +"RTN","TMGRPC1",178,0) + ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"RTN","TMGRPC1",179,0) + ;"NOTE RE DROPBOX: +"RTN","TMGRPC1",180,0) + ;" This system is designed for a system where by the server and the client have a +"RTN","TMGRPC1",181,0) + ;" shared filesystem, but the directory paths will be different. For example: +"RTN","TMGRPC1",182,0) + ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ +"RTN","TMGRPC1",183,0) + ;" Windows Client has access to dropbox at: V:\Dropbox\ +"RTN","TMGRPC1",184,0) + +"RTN","TMGRPC1",185,0) + ;"Output: results are 1^Success, or 0^Error Message +"RTN","TMGRPC1",186,0) + +"RTN","TMGRPC1",187,0) + new resultMsg set resultMsg="1^Successful Download" +"RTN","TMGRPC1",188,0) + +"RTN","TMGRPC1",189,0) + set FPATH=$get(FPATH) +"RTN","TMGRPC1",190,0) + if FPATH="" set resultMsg="0^No file path received" goto DnDBxDone +"RTN","TMGRPC1",191,0) + set FNAME=$get(FNAME) +"RTN","TMGRPC1",192,0) + if FNAME="" set resultMsg="0^No file name received" goto DnDBxDone +"RTN","TMGRPC1",193,0) + set LOCIEN=$GET(LOCIEN,1); +"RTN","TMGRPC1",194,0) + new GREF +"RTN","TMGRPC1",195,0) + +"RTN","TMGRPC1",196,0) + new PathRoot +"RTN","TMGRPC1",197,0) + set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) +"RTN","TMGRPC1",198,0) + +"RTN","TMGRPC1",199,0) + new NodeDiv +"RTN","TMGRPC1",200,0) + set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" +"RTN","TMGRPC1",201,0) + +"RTN","TMGRPC1",202,0) + new DropBox +"RTN","TMGRPC1",203,0) + set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) +"RTN","TMGRPC1",204,0) + if DropBox="" do goto UpDBxDone +"RTN","TMGRPC1",205,0) + . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" +"RTN","TMGRPC1",206,0) + ;"Ensure DropBox ends in a node divider +"RTN","TMGRPC1",207,0) + if $extract(DropBox,$length(DropBox))'=NodeDiv do +"RTN","TMGRPC1",208,0) + . set DropBox=DropBox_NodeDiv +"RTN","TMGRPC1",209,0) + +"RTN","TMGRPC1",210,0) + ;"Ensure PathRoot ends in a node divider +"RTN","TMGRPC1",211,0) + if $extract(PathRoot,$length(PathRoot))'=NodeDiv do +"RTN","TMGRPC1",212,0) + . set PathRoot=PathRoot_NodeDiv +"RTN","TMGRPC1",213,0) + +"RTN","TMGRPC1",214,0) + ;"Ensure Fpath does NOT start in a node divider +"RTN","TMGRPC1",215,0) + if $extract(FPATH,1)=NodeDiv do +"RTN","TMGRPC1",216,0) + . set FPATH=$extract(FPATH,2,1024) +"RTN","TMGRPC1",217,0) + +"RTN","TMGRPC1",218,0) + set FPATH=PathRoot_FPATH +"RTN","TMGRPC1",219,0) + +"RTN","TMGRPC1",220,0) + new SrcNamePath set SrcNamePath=FPATH_FNAME +"RTN","TMGRPC1",221,0) + ;"new DestNamePath set DestNamePath=DropBox_FNAME +"RTN","TMGRPC1",222,0) + +"RTN","TMGRPC1",223,0) + new moveResult +"RTN","TMGRPC1",224,0) + set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox) +"RTN","TMGRPC1",225,0) + if moveResult>0 do +"RTN","TMGRPC1",226,0) + . set resultMsg="0^Move failed, returning OS error code: "_moveResult +"RTN","TMGRPC1",227,0) + +"RTN","TMGRPC1",228,0) +DnDBxDone +"RTN","TMGRPC1",229,0) + set RESULT=resultMsg +"RTN","TMGRPC1",230,0) + quit +"RTN","TMGRPC1",231,0) + +"RTN","TMGRPC1",232,0) + +"RTN","TMGRPC1",233,0) +UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File +"RTN","TMGRPC1",234,0) + ;"SCOPE: Public +"RTN","TMGRPC1",235,0) + ;"RPC That calls this: TMG UPLOAD FILE DROPBOX +"RTN","TMGRPC1",236,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",237,0) + ;" will put the file in a 'dropbox' file location that both the client +"RTN","TMGRPC1",238,0) + ;" and server can access. File will be moved from there to its final +"RTN","TMGRPC1",239,0) + ;" destination. This will provide file-hiding ability on the server side. +"RTN","TMGRPC1",240,0) + ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",241,0) + ;" FPATH -- the file path up to, but not including, the filename. This +"RTN","TMGRPC1",242,0) + ;" is the path to store the file at. (relative to a root path, +"RTN","TMGRPC1",243,0) + ;" see comments below). It is NOT the path of the dropbox. +"RTN","TMGRPC1",244,0) + ;" Use '/' to NOT specify any subdirectory +"RTN","TMGRPC1",245,0) + ;" FNAME -- the name of the file to be uploaded. Note: This is also the +"RTN","TMGRPC1",246,0) + ;" name of the file to be pulled from the dropbox. It is the +"RTN","TMGRPC1",247,0) + ;" responsibility of the client to ensure that there is not already +"RTN","TMGRPC1",248,0) + ;" a similarly named file in the dropbox before depositing a file there. +"RTN","TMGRPC1",249,0) + ;" The server will remove the file from the dropbox, unless there is +"RTN","TMGRPC1",250,0) + ;" an error with the host OS (which will be returned as an error message) +"RTN","TMGRPC1",251,0) + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to +"RTN","TMGRPC1",252,0) + ;" default value is 1 +"RTN","TMGRPC1",253,0) + ;" Note: For security reasons, all path requests will be considered relative to a root path. +"RTN","TMGRPC1",254,0) + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: +"RTN","TMGRPC1",255,0) + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg +"RTN","TMGRPC1",256,0) + ;" This root path is found in custom field 22700 in file 2005.2 +"RTN","TMGRPC1",257,0) + ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 +"RTN","TMGRPC1",258,0) + ;"NOTE RE DROPBOX: +"RTN","TMGRPC1",259,0) + ;" This system is designed for a system where by the server and the client have a +"RTN","TMGRPC1",260,0) + ;" shared filesystem, but the directory paths will be different. For example: +"RTN","TMGRPC1",261,0) + ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ +"RTN","TMGRPC1",262,0) + ;" Windows Client has access to dropbox at: V:\Dropbox\ +"RTN","TMGRPC1",263,0) + +"RTN","TMGRPC1",264,0) + ;"Output: results are passed out in RESULT: +"RTN","TMGRPC1",265,0) + ;" 1^SuccessMessage or 0^FailureMessage +"RTN","TMGRPC1",266,0) + +"RTN","TMGRPC1",267,0) + new result +"RTN","TMGRPC1",268,0) + new resultMsg set resultMsg="1^Successful Upload" +"RTN","TMGRPC1",269,0) + +"RTN","TMGRPC1",270,0) + set FPATH=$get(FPATH) +"RTN","TMGRPC1",271,0) + if FPATH="" set resultMsg="0^No file path received" goto UpDBxDone +"RTN","TMGRPC1",272,0) + set FNAME=$get(FNAME) +"RTN","TMGRPC1",273,0) + if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone +"RTN","TMGRPC1",274,0) + set LOCIEN=$GET(LOCIEN,1); +"RTN","TMGRPC1",275,0) + new GREF +"RTN","TMGRPC1",276,0) + +"RTN","TMGRPC1",277,0) + new PathRoot +"RTN","TMGRPC1",278,0) + set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) +"RTN","TMGRPC1",279,0) + +"RTN","TMGRPC1",280,0) + new NodeDiv +"RTN","TMGRPC1",281,0) + set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) ;"default is "/" +"RTN","TMGRPC1",282,0) + +"RTN","TMGRPC1",283,0) + new DropBox +"RTN","TMGRPC1",284,0) + set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) +"RTN","TMGRPC1",285,0) + if DropBox="" do goto UpDBxDone +"RTN","TMGRPC1",286,0) + . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" +"RTN","TMGRPC1",287,0) + ;"Ensure DropBox ends in a node divider +"RTN","TMGRPC1",288,0) + if $extract(DropBox,$length(DropBox))'=NodeDiv do +"RTN","TMGRPC1",289,0) + . set DropBox=DropBox_NodeDiv +"RTN","TMGRPC1",290,0) + +"RTN","TMGRPC1",291,0) + ;"Ensure PathRoot ends in a node divider +"RTN","TMGRPC1",292,0) + if $extract(PathRoot,$length(PathRoot))'=NodeDiv do +"RTN","TMGRPC1",293,0) + . set PathRoot=PathRoot_NodeDiv +"RTN","TMGRPC1",294,0) + +"RTN","TMGRPC1",295,0) + ;"Ensure Fpath does NOT start in a node divider +"RTN","TMGRPC1",296,0) + if $extract(FPATH,1)=NodeDiv do +"RTN","TMGRPC1",297,0) + . set FPATH=$extract(FPATH,2,1024) +"RTN","TMGRPC1",298,0) + +"RTN","TMGRPC1",299,0) + set FPATH=PathRoot_FPATH +"RTN","TMGRPC1",300,0) + +"RTN","TMGRPC1",301,0) + new SrcNamePath,DestNamePath +"RTN","TMGRPC1",302,0) + set SrcNamePath=DropBox_FNAME +"RTN","TMGRPC1",303,0) + set DestNamePath=FPATH_FNAME +"RTN","TMGRPC1",304,0) + +"RTN","TMGRPC1",305,0) + new moveResult +"RTN","TMGRPC1",306,0) + set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath) +"RTN","TMGRPC1",307,0) + if moveResult>0 do +"RTN","TMGRPC1",308,0) + . set resultMsg="0^Move failed, returning OS error code: "_moveResult +"RTN","TMGRPC1",309,0) + +"RTN","TMGRPC1",310,0) +UpDBxDone +"RTN","TMGRPC1",311,0) + set RESULT=resultMsg +"RTN","TMGRPC1",312,0) + quit +"RTN","TMGRPC1",313,0) + +"RTN","TMGRPC1",314,0) + +"RTN","TMGRPC1",315,0) +ENCODE(GRef,incSubscr,encodeFn) +"RTN","TMGRPC1",316,0) + ;"Purpose: ENCODE a BINARY GLOBAL. +"RTN","TMGRPC1",317,0) + ;"Input: +"RTN","TMGRPC1",318,0) + ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved +"RTN","TMGRPC1",319,0) + ;" (closed root) format. +"RTN","TMGRPC1",320,0) + ;" Note: +"RTN","TMGRPC1",321,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGRPC1",322,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGRPC1",323,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGRPC1",324,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGRPC1",325,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGRPC1",326,0) + ;" is always zero. +"RTN","TMGRPC1",327,0) + ;" REQUIRED +"RTN","TMGRPC1",328,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global +"RTN","TMGRPC1",329,0) + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and +"RTN","TMGRPC1",330,0) + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third +"RTN","TMGRPC1",331,0) + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global +"RTN","TMGRPC1",332,0) + ;" reference, such as ^TMP(115,1,x,0). +"RTN","TMGRPC1",333,0) + ;" REQUIRED +"RTN","TMGRPC1",334,0) + ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data. +"RTN","TMGRPC1",335,0) + ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should +"RTN","TMGRPC1",336,0) + ;" take one input variable (the line of raw binary data), and return a converted +"RTN","TMGRPC1",337,0) + ;" line. e.g. +"RTN","TMGRPC1",338,0) + ;" CODER(INPUT) +"RTN","TMGRPC1",339,0) + ;" ... ;"convert INPUT to RESULT +"RTN","TMGRPC1",340,0) + ;" QUIT RESULT +"RTN","TMGRPC1",341,0) + ;" default value is B64CODER^TMGRPC1 +"RTN","TMGRPC1",342,0) + ;" +"RTN","TMGRPC1",343,0) + ;"Output: @GRef is converted to encoded data +"RTN","TMGRPC1",344,0) + ;"Result: None +"RTN","TMGRPC1",345,0) + +"RTN","TMGRPC1",346,0) + if $get(GRef)="" goto EncodeDone +"RTN","TMGRPC1",347,0) + if $get(incSubscr)="" goto EncodeDone +"RTN","TMGRPC1",348,0) + +"RTN","TMGRPC1",349,0) + set encodeFn=$get(encodeFn,"B64CODER") +"RTN","TMGRPC1",350,0) + +"RTN","TMGRPC1",351,0) + new encoder +"RTN","TMGRPC1",352,0) + set encoder="set temp=$$"_encodeFn_"(.temp)" +"RTN","TMGRPC1",353,0) + +"RTN","TMGRPC1",354,0) + for do quit:(GRef="") +"RTN","TMGRPC1",355,0) + . new temp +"RTN","TMGRPC1",356,0) + . set temp=$get(@GRef) +"RTN","TMGRPC1",357,0) + . if temp="" set GRef="" quit +"RTN","TMGRPC1",358,0) + . xecute encoder ;"i.e. set temp=$$encoderFn(.temp) +"RTN","TMGRPC1",359,0) + . set @GRef=temp +"RTN","TMGRPC1",360,0) + . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) +"RTN","TMGRPC1",361,0) + +"RTN","TMGRPC1",362,0) +EncodeDone +"RTN","TMGRPC1",363,0) + quit +"RTN","TMGRPC1",364,0) + +"RTN","TMGRPC1",365,0) + +"RTN","TMGRPC1",366,0) +HEXCODER(INPUT) +"RTN","TMGRPC1",367,0) + ;"Purpose: to encode the input string. Currently using simple hex encoding/ +"RTN","TMGRPC1",368,0) + quit $$STRB2H^TMGSTUTL(.INPUT,0,1) +"RTN","TMGRPC1",369,0) + +"RTN","TMGRPC1",370,0) + +"RTN","TMGRPC1",371,0) +B64CODER(INPUT) +"RTN","TMGRPC1",372,0) + ;"Purpose: to encode the input string via UUENCODE (actually Base64) +"RTN","TMGRPC1",373,0) + quit $$ENCODE^RGUTUU(.INPUT) +"RTN","TMGRPC1",374,0) + +"RTN","TMGRPC1",375,0) +B64DECODER(INPUT) +"RTN","TMGRPC1",376,0) + ;"Purpose: to encode the input string via UUENCODE (actually Base64) +"RTN","TMGRPC1",377,0) + quit $$DECODE^RGUTUU(.INPUT) +"RTN","TMGRPC1",378,0) + +"RTN","TMGRPC1",379,0) + +"RTN","TMGRPC1",380,0) +DECODE(GRef,incSubscr,decodeFn) +"RTN","TMGRPC1",381,0) + ;"Purpose: ENCODE a BINARY GLOBAL. +"RTN","TMGRPC1",382,0) + ;"Input: +"RTN","TMGRPC1",383,0) + ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved +"RTN","TMGRPC1",384,0) + ;" (closed root) format. +"RTN","TMGRPC1",385,0) + ;" Note: +"RTN","TMGRPC1",386,0) + ;" At least one subscript must be numeric. This will be the incrementing +"RTN","TMGRPC1",387,0) + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment +"RTN","TMGRPC1",388,0) + ;" to store each new global node). This subscript need not be the final +"RTN","TMGRPC1",389,0) + ;" subscript. For example, to load into a WORD PROCESSING field, the +"RTN","TMGRPC1",390,0) + ;" incrementing node is the second-to-last subscript; the final subscript +"RTN","TMGRPC1",391,0) + ;" is always zero. +"RTN","TMGRPC1",392,0) + ;" REQUIRED +"RTN","TMGRPC1",393,0) + ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global +"RTN","TMGRPC1",394,0) + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and +"RTN","TMGRPC1",395,0) + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third +"RTN","TMGRPC1",396,0) + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global +"RTN","TMGRPC1",397,0) + ;" reference, such as ^TMP(115,1,x,0). +"RTN","TMGRPC1",398,0) + ;" REQUIRED +"RTN","TMGRPC1",399,0) + ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data. +"RTN","TMGRPC1",400,0) + ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take +"RTN","TMGRPC1",401,0) + ;" one input variable (the line of encoded data), and return a decoded line. e.g. +"RTN","TMGRPC1",402,0) + ;" DECODER(INPUT) +"RTN","TMGRPC1",403,0) + ;" ... ;"convert INPUT to RESULT +"RTN","TMGRPC1",404,0) + ;" QUIT RESULT +"RTN","TMGRPC1",405,0) + ;" default value is B64DECODER^TMGRPC1 +"RTN","TMGRPC1",406,0) + ;" +"RTN","TMGRPC1",407,0) + ;"Output: @GRef is converted to decoded data +"RTN","TMGRPC1",408,0) + ;"Result: None +"RTN","TMGRPC1",409,0) + +"RTN","TMGRPC1",410,0) + if $get(GRef)="" goto DecodeDone +"RTN","TMGRPC1",411,0) + if $get(incSubscr)="" goto DecodeDone +"RTN","TMGRPC1",412,0) + set decodeFn=$get(decodeFn,"B64DECODER") +"RTN","TMGRPC1",413,0) + +"RTN","TMGRPC1",414,0) + new decoder +"RTN","TMGRPC1",415,0) + set decoder="set temp=$$"_decodeFn_"(.temp)" +"RTN","TMGRPC1",416,0) + +"RTN","TMGRPC1",417,0) + for do quit:(GRef="") +"RTN","TMGRPC1",418,0) + . new temp +"RTN","TMGRPC1",419,0) + . set temp=$get(@GRef) +"RTN","TMGRPC1",420,0) + . if temp="" set GRef="" quit +"RTN","TMGRPC1",421,0) + . xecute decoder ;"i.e. set temp=$$decoderFn(.temp) +"RTN","TMGRPC1",422,0) + . set @GRef=temp +"RTN","TMGRPC1",423,0) + . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) +"RTN","TMGRPC1",424,0) + +"RTN","TMGRPC1",425,0) +DecodeDone +"RTN","TMGRPC1",426,0) + quit +"RTN","TMGRPC1",427,0) + +"RTN","TMGRPC1",428,0) + +"RTN","TMGRPC1",429,0) +GETLONG(GREF,IMAGEIEN) +"RTN","TMGRPC1",430,0) + ;"SCOPE: Public +"RTN","TMGRPC1",431,0) + ;"Purpose: To provide an entry point for a RPC call from a client. +"RTN","TMGRPC1",432,0) + ;" Will return results of field 11 (LONG DESCRIPTION) from file IMAGE(2005) +"RTN","TMGRPC1",433,0) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",434,0) + ;" IMAGEIEN-- The IEN (record number) from file 2005 (IMAGE) +"RTN","TMGRPC1",435,0) + ;"Output: results are passed out in @GREF +"RTN","TMGRPC1",436,0) + ;" @GREF@(0) = WP header line: format is: ^^MaxLine^MaxLine^TimeStamp(FM Date/Time Format) +"RTN","TMGRPC1",437,0) + ;" @GREF@(1) = WP line 1 +"RTN","TMGRPC1",438,0) + ;" @GREF@(2) = WP line 2 +"RTN","TMGRPC1",439,0) + ;" @GREF@(3) = WP line 3 +"RTN","TMGRPC1",440,0) + ;" @GREF@(4) = WP line 4 ... etc. +"RTN","TMGRPC1",441,0) + +"RTN","TMGRPC1",442,0) + set GREF="^TMP(""GETLONG^TMGRPC1"","_$J_")" +"RTN","TMGRPC1",443,0) + +"RTN","TMGRPC1",444,0) + kill @GREF +"RTN","TMGRPC1",445,0) + +"RTN","TMGRPC1",446,0) + new i,s,MaxLines,header +"RTN","TMGRPC1",447,0) + set header="" +"RTN","TMGRPC1",448,0) + if +$get(IMAGEIEN)>0 do +"RTN","TMGRPC1",449,0) + . set header=$get(^MAG(2005,IMAGEIEN,3,0)) ;"NOTE: Field 11 held in node 3;0 +"RTN","TMGRPC1",450,0) + set @GREF@(0)=header +"RTN","TMGRPC1",451,0) + set MaxLines=+$piece(header,"^",3) +"RTN","TMGRPC1",452,0) + for i=1:1:MaxLines do +"RTN","TMGRPC1",453,0) + . set @GREF@(i)=$get(^MAG(2005,IMAGEIEN,3,i,0)) +"RTN","TMGRPC1",454,0) + +"RTN","TMGRPC1",455,0) + quit +"RTN","TMGRPC1",456,0) + +"RTN","TMGRPC1",457,0) + +"RTN","TMGRPC1",458,0) + +"RTN","TMGRPC1",459,0) +GETDFN(RESULT,RECNUM,PMS,FNAME,LNAME,MNAME,DOB,SEX,SSNUM,AUTOADD) +"RTN","TMGRPC1",460,0) + ;"Purpose: This is a RPC entry point for looking up a patient. +"RTN","TMGRPC1",461,0) + ;"Input: +"RTN","TMGRPC1",462,0) + ;" RESULT -- an OUT PARAMETER +"RTN","TMGRPC1",463,0) + ;" RECNUM -- Record number from a PMS +"RTN","TMGRPC1",464,0) + ;" PMS -- Which PMS RECNUM refers to (1=Medic,2=Sequel,3=Paradigm) +"RTN","TMGRPC1",465,0) + ;" FNAME -- First Name +"RTN","TMGRPC1",466,0) + ;" LNAME -- Last name +"RTN","TMGRPC1",467,0) + ;" MNAME -- Middle Name or initial +"RTN","TMGRPC1",468,0) + ;" DOB -- Date of birth in EXTERNAL format +"RTN","TMGRPC1",469,0) + ;" SEX -- Patient sex: M or F +"RTN","TMGRPC1",470,0) + ;" SSNUM -- Social security number (digits only) +"RTN","TMGRPC1",471,0) + ;" AUTOADD -- Automatically register patient if needed (if value=1) +"RTN","TMGRPC1",472,0) + ;"Output: Patient may be added to database if AUTOADD=1 +"RTN","TMGRPC1",473,0) + ;"Results: Returns DFN (i.e. IEN in PATIENT file) or -1 if not found or error +"RTN","TMGRPC1",474,0) + +"RTN","TMGRPC1",475,0) + new Patient,TMGFREG +"RTN","TMGRPC1",476,0) + set RESULT=-1 ;"default to not found +"RTN","TMGRPC1",477,0) + +"RTN","TMGRPC1",478,0) + if $get(LNAME)'="" do +"RTN","TMGRPC1",479,0) + . set Patient("NAME")=$get(LNAME) +"RTN","TMGRPC1",480,0) + . if $get(FNAME)'="" set Patient("NAME")=Patient("NAME")_","_FNAME +"RTN","TMGRPC1",481,0) + . if $get(MNAME)'="" set Patient("NAME")=Patient("NAME")_" "_MNAME +"RTN","TMGRPC1",482,0) + set Patient("DOB")=$get(DOB) +"RTN","TMGRPC1",483,0) + set Patient("SEX")=$get(SEX) +"RTN","TMGRPC1",484,0) + set Patient("SSNUM")=$get(SSNUM) +"RTN","TMGRPC1",485,0) +test if $get(AUTOADD)=1 set TMGFREG=1 +"RTN","TMGRPC1",486,0) + +"RTN","TMGRPC1",487,0) + if $get(PMS)=1 set Patient("PATIENTNUM")=$get(RECNUM) ;" <-- Medic account number +"RTN","TMGRPC1",488,0) + if $get(PMS)=2 set Patient("SEQUELNUM")=$get(RECNUM) ;" <-- Sequel or other account number +"RTN","TMGRPC1",489,0) + if $get(PMS)=3 set Patient("PARADIGMNUM")=$get(RECNUM) ;" <-- Paradigm or other account number +"RTN","TMGRPC1",490,0) + +"RTN","TMGRPC1",491,0) + ;"temp +"RTN","TMGRPC1",492,0) + ;"merge ^TMG("TMP","GETDFN","KILLLATER")=Patient +"RTN","TMGRPC1",493,0) + ;"set ^TMG("TMP","GETDFN","KILLLATER","FNAME")=FNAME +"RTN","TMGRPC1",494,0) + ;"set ^TMG("TMP","GETDFN","KILLLATER","LNAME")=LNAME +"RTN","TMGRPC1",495,0) + ;"set ^TMG("TMP","GETDFN","KILLLATER","MNAME")=MNAME +"RTN","TMGRPC1",496,0) + +"RTN","TMGRPC1",497,0) + set RESULT=$$GetDFN^TMGGDFN(.Patient) +"RTN","TMGRPC1",498,0) + +"RTN","TMGRPC1",499,0) + quit +"RTN","TMGRPC1",500,0) + +"RTN","TMGRPC1",501,0) + +"RTN","TMGRPC1",502,0) +BLANKTIU(RESULT,DFN,PERSON,LOC,DOS,TITLE) +"RTN","TMGRPC1",503,0) + ;"Purpose: To create a new, blank TIU note and return it's IEN +"RTN","TMGRPC1",504,0) + ;"Input: DFN -- IEN in PATIENT file of patient +"RTN","TMGRPC1",505,0) + ;" PERSON -- Provider NAME +"RTN","TMGRPC1",506,0) + ;" LOC -- Location for new document +"RTN","TMGRPC1",507,0) + ;" DOS -- Date of Service +"RTN","TMGRPC1",508,0) + ;" TITLE -- Title of new document +"RTN","TMGRPC1",509,0) + ;"Results: IEN in file 8925 is returned in RESULT, +"RTN","TMGRPC1",510,0) + ;" or -1^ErrMsg1;ErrMsg2... if failure +"RTN","TMGRPC1",511,0) + ;"Note: This functionality probably duplicates that of RPC call: +"RTN","TMGRPC1",512,0) + ;" TIU CREATE NOTE -- found after writing this... +"RTN","TMGRPC1",513,0) + +"RTN","TMGRPC1",514,0) + new Document,Flag +"RTN","TMGRPC1",515,0) + +"RTN","TMGRPC1",516,0) + set Document("DFN")=DFN +"RTN","TMGRPC1",517,0) + set Document("PROVIDER IEN")=$$GetProvIEN^TMGPUTN0(PERSON) +"RTN","TMGRPC1",518,0) + set Document("LOCATION")=$get(LOC) +"RTN","TMGRPC1",519,0) + set Document("DATE")=$get(DOS) +"RTN","TMGRPC1",520,0) + set Document("TITLE")=$get(TITLE) +"RTN","TMGRPC1",521,0) + set Document("TRANSCRIPTIONIST")="" +"RTN","TMGRPC1",522,0) + set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=0 +"RTN","TMGRPC1",523,0) + +"RTN","TMGRPC1",524,0) + set RESULT=$$PrepDoc^TMGPUTN0(.Document) +"RTN","TMGRPC1",525,0) + if +RESULT>0 do ;"change capture method from Upload (default) to RPC +"RTN","TMGRPC1",526,0) + . new TMGFDA,TMGMSG +"RTN","TMGRPC1",527,0) + . set TMGFDA(8925,RESULT_",",1303)="R" ;"1303 = capture method. "R" = RPC +"RTN","TMGRPC1",528,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;"ignore any errors. +"RTN","TMGRPC1",529,0) + else do +"RTN","TMGRPC1",530,0) + . new i,ErrMsg set ErrMsg="" +"RTN","TMGRPC1",531,0) + . for i=1:1:+$get(Document("ERROR","NUM")) do +"RTN","TMGRPC1",532,0) + . . set ErrMsg=ErrMsg_$get(Document("ERROR",i))_" ||" +"RTN","TMGRPC1",533,0) + . if $data(Document("ERROR","FM INFO"))>0 do +"RTN","TMGRPC1",534,0) + . . new ref set ref="Document(""ERROR"",""FM INFO"")" +"RTN","TMGRPC1",535,0) + . . set ErrMsg=ErrMsg_"FILEMAN SAYS:" +"RTN","TMGRPC1",536,0) + . . for set ref=$query(@ref) quit:(ref="")!(ref'["FM INFO") do +"RTN","TMGRPC1",537,0) + . . . if ErrMsg'="" set ErrMsg=ErrMsg_" ||" +"RTN","TMGRPC1",538,0) + . . . set ErrMsg=ErrMsg_$piece(ref,"DIERR",2)_"="_$get(@ref) +"RTN","TMGRPC1",539,0) + . if ErrMsg="" set ErrMsg="Unknown error" +"RTN","TMGRPC1",540,0) + . set ErrMsg=$translate(ErrMsg,"^","@") +"RTN","TMGRPC1",541,0) + . set $piece(RESULT,"^",2)=ErrMsg +"RTN","TMGRPC1",542,0) + +"RTN","TMGRPC1",543,0) + ;"temp +"RTN","TMGRPC1",544,0) + merge ^TMG("TMP","BLANKTIU","RESULT")=RESULT +"RTN","TMGRPC1",545,0) + merge ^TMG("TMP","BLANKTIU","Document")=Document +"RTN","TMGRPC1",546,0) + +"RTN","TMGRPC1",547,0) + +"RTN","TMGRPC1",548,0) + quit +"RTN","TMGRPC1",549,0) + +"RTN","TMGRPC1",550,0) + +"RTN","TMGRPC1",551,0) +AUTOSIGN(RESULT,DOCIEN) +"RTN","TMGRPC1",552,0) + ;"Purpose: To automatically sign TIU note (8925). +"RTN","TMGRPC1",553,0) + ;"Input: DOCIEN -- the IEN in 8925 of the file to be automatically signed. +"RTN","TMGRPC1",554,0) + ;"Note: This function will not succeed unless field 1303 holds "R" +"RTN","TMGRPC1",555,0) + ;" and an Author found for note +"RTN","TMGRPC1",556,0) + ;"Results: Results passed back in RESULT(0) ARRAY +"RTN","TMGRPC1",557,0) + ;" -1 = failure. 1= success +"RTN","TMGRPC1",558,0) + ;" Any error message is passed back in RESULT("DIERR") +"RTN","TMGRPC1",559,0) + ;"Note: This differs from RPC CALL: TIU SIGN RECORD in that a signiture +"RTN","TMGRPC1",560,0) + ;" code is NOT required +"RTN","TMGRPC1",561,0) + +"RTN","TMGRPC1",562,0) + new TMGFDA,TMGMSG +"RTN","TMGRPC1",563,0) + new AuthorIEN,AuthorName +"RTN","TMGRPC1",564,0) + new CaptureMethod +"RTN","TMGRPC1",565,0) + +"RTN","TMGRPC1",566,0) + set DOCIEN=+$get(DOCIEN) +"RTN","TMGRPC1",567,0) + set RESULT=-1 ;"default to failure +"RTN","TMGRPC1",568,0) + +"RTN","TMGRPC1",569,0) + set CaptureMethod=$piece($get(^TIU(8925,DOCIEN,13)),"^",3) +"RTN","TMGRPC1",570,0) + if CaptureMethod'="R" do goto ASDone +"RTN","TMGRPC1",571,0) + . set RESULT("DIERR")="Unable to auto-sign. Upload-Method was not 'R'." +"RTN","TMGRPC1",572,0) + set AuthorIEN=$piece($get(^TIU(8925,DOCIEN,12)),"^",2) +"RTN","TMGRPC1",573,0) + if AuthorIEN'>0 do goto ASDone +"RTN","TMGRPC1",574,0) + . set RESULT("DIERR")="Unable to find author of document." +"RTN","TMGRPC1",575,0) + set AuthorName=$piece($get(^VA(200,AuthorIEN,0)),"^",1) +"RTN","TMGRPC1",576,0) + +"RTN","TMGRPC1",577,0) + set TMGFDA(8925,DOCIEN_",",.05)="COMPLETED" ;"field .05 = STATUS +"RTN","TMGRPC1",578,0) + set TMGFDA(8925,DOCIEN_",",1501)="NOW" ;"field 1501 = Signed date +"RTN","TMGRPC1",579,0) + set TMGFDA(8925,DOCIEN_",",1502)="`"_AuthorIEN ;"field 1502 = signed by +"RTN","TMGRPC1",580,0) + set TMGFDA(8925,DOCIEN_",",1503)=AuthorName ;"field 1503 = Signature block name +"RTN","TMGRPC1",581,0) + set TMGFDA(8925,DOCIEN_",",1504)="[Scanned image auto-signed]" ;"field 1504 = Signature block title +"RTN","TMGRPC1",582,0) + set TMGFDA(8925,DOCIEN_",",1505)="C" ;C=Chart ;"field 1505 = Signature mode +"RTN","TMGRPC1",583,0) + do FILE^DIE("E","TMGFDA","TMGMSG") +"RTN","TMGRPC1",584,0) + if $data(TMGMSG("DIERR")) do goto ASDone +"RTN","TMGRPC1",585,0) + . merge RESULT("DIERR")=TMGMSG("DIERR") +"RTN","TMGRPC1",586,0) + +"RTN","TMGRPC1",587,0) + set RESULT(0)=1 ;"set success if we got this far. +"RTN","TMGRPC1",588,0) +ASDone +"RTN","TMGRPC1",589,0) + quit +"RTN","TMGRPC1",590,0) + +"RTN","TMGRPC1",591,0) + +"RTN","TMGRPC1",592,0) +DFNINFO(RESULT,DFN) +"RTN","TMGRPC1",593,0) + ;"Purpose: To return array with demographcs details about patient +"RTN","TMGRPC1",594,0) + ;"Input: RESULT (this is the output array) +"RTN","TMGRPC1",595,0) + ;" DFN : The record number in file #2 of the patient to inquire about. +"RTN","TMGRPC1",596,0) + ;"Results: Results passed back in RESULT array. Format as follows: +"RTN","TMGRPC1",597,0) + ;" The results are in format: KeyName=Value, +"RTN","TMGRPC1",598,0) + ;" There is no set order these will appear. +"RTN","TMGRPC1",599,0) + ;" Here are the KeyName names that will be provided. +"RTN","TMGRPC1",600,0) + ;" If the record has no value, then value will be empty +"RTN","TMGRPC1",601,0) + ;" IEN=record# +"RTN","TMGRPC1",602,0) + ;" COMBINED_NAME= +"RTN","TMGRPC1",603,0) + ;" LNAME= +"RTN","TMGRPC1",604,0) + ;" FNAME= +"RTN","TMGRPC1",605,0) + ;" MNAME= +"RTN","TMGRPC1",606,0) + ;" PREFIX= +"RTN","TMGRPC1",607,0) + ;" SUFFIX= +"RTN","TMGRPC1",608,0) + ;" DEGREE +"RTN","TMGRPC1",609,0) + ;" DOB= +"RTN","TMGRPC1",610,0) + ;" SEX= +"RTN","TMGRPC1",611,0) + ;" SS_NUM= +"RTN","TMGRPC1",612,0) + ;" ADDRESS_LINE_1= +"RTN","TMGRPC1",613,0) + ;" ADDRESS_LINE_2= +"RTN","TMGRPC1",614,0) + ;" ADDRESS_LINE_3= +"RTN","TMGRPC1",615,0) + ;" CITY= +"RTN","TMGRPC1",616,0) + ;" STATE= +"RTN","TMGRPC1",617,0) + ;" ZIP4= +"RTN","TMGRPC1",618,0) + ;" BAD_ADDRESS= +"RTN","TMGRPC1",619,0) + ;" TEMP_ADDRESS_LINE_1= +"RTN","TMGRPC1",620,0) + ;" TEMP_ADDRESS_LINE_2= +"RTN","TMGRPC1",621,0) + ;" TEMP_ADDRESS_LINE_3= +"RTN","TMGRPC1",622,0) + ;" TEMP_CITY= +"RTN","TMGRPC1",623,0) + ;" TEMP_STATE= +"RTN","TMGRPC1",624,0) + ;" TEMP_ZIP4= +"RTN","TMGRPC1",625,0) + ;" TEMP_STARTING_DATE= +"RTN","TMGRPC1",626,0) + ;" TEMP_ENDING_DATE= +"RTN","TMGRPC1",627,0) + ;" TEMP_ADDRESS_ACTIVE= +"RTN","TMGRPC1",628,0) + ;" CONF_ADDRESS_LINE_1= +"RTN","TMGRPC1",629,0) + ;" CONF_ADDRESS_LINE_2= +"RTN","TMGRPC1",630,0) + ;" CONF_ADDRESS_LINE_3= +"RTN","TMGRPC1",631,0) + ;" CONF_CITY= +"RTN","TMGRPC1",632,0) + ;" CONF_STATE= +"RTN","TMGRPC1",633,0) + ;" CONF_ZIP4= +"RTN","TMGRPC1",634,0) + ;" CONF_STARTING_DATE= +"RTN","TMGRPC1",635,0) + ;" CONF_ENDING_DATE= +"RTN","TMGRPC1",636,0) + ;" CONF_ADDRESS_ACTIVE= +"RTN","TMGRPC1",637,0) + ;" PHONE_RESIDENCE= +"RTN","TMGRPC1",638,0) + ;" PHONE_WORK= +"RTN","TMGRPC1",639,0) + ;" PHONE_CELL= +"RTN","TMGRPC1",640,0) + ;" PHONE_TEMP= +"RTN","TMGRPC1",641,0) + +"RTN","TMGRPC1",642,0) + ;"Note, for the following, there may be multiple entries. # is record number +"RTN","TMGRPC1",643,0) + ;" ALIAS # NAME +"RTN","TMGRPC1",644,0) + ;" ALIAS # SSN +"RTN","TMGRPC1",645,0) + +"RTN","TMGRPC1",646,0) + new TMGFDA,TMGMSG,IENS +"RTN","TMGRPC1",647,0) + set IENS="" +"RTN","TMGRPC1",648,0) + new ptrParts set ptrParts=0 +"RTN","TMGRPC1",649,0) + set DFN=+$get(DFN) +"RTN","TMGRPC1",650,0) + if DFN>0 do +"RTN","TMGRPC1",651,0) + . set ptrParts=+$piece($get(^DPT(DFN,"NAME")),"^",1) ;"ptr to file #20, NAME COMPONENTS +"RTN","TMGRPC1",652,0) + . set IENS=DFN_"," +"RTN","TMGRPC1",653,0) + . do GETS^DIQ(2,IENS,"**","N","TMGFDA","TMGMSG") +"RTN","TMGRPC1",654,0) + +"RTN","TMGRPC1",655,0) + new line set line=0 +"RTN","TMGRPC1",656,0) + set RESULT(line)="IEN="_DFN set line=line+1 +"RTN","TMGRPC1",657,0) + set RESULT(line)="COMBINED_NAME="_$get(TMGFDA(2,IENS,.01)) set line=line+1 +"RTN","TMGRPC1",658,0) + new s set s="" +"RTN","TMGRPC1",659,0) + if ptrParts>0 set s=$get(^VA(20,ptrParts,1)) +"RTN","TMGRPC1",660,0) + set RESULT(line)="LNAME="_$piece(s,"^",1) set line=line+1 +"RTN","TMGRPC1",661,0) + set RESULT(line)="FNAME="_$piece(s,"^",2) set line=line+1 +"RTN","TMGRPC1",662,0) + set RESULT(line)="MNAME="_$piece(s,"^",3) set line=line+1 +"RTN","TMGRPC1",663,0) + set RESULT(line)="PREFIX="_$piece(s,"^",4) set line=line+1 +"RTN","TMGRPC1",664,0) + set RESULT(line)="SUFFIX="_$piece(s,"^",5) set line=line+1 +"RTN","TMGRPC1",665,0) + set RESULT(line)="DEGREE="_$piece(s,"^",5) set line=line+1 +"RTN","TMGRPC1",666,0) + set RESULT(line)="DOB="_$get(TMGFDA(2,IENS,.03)) set line=line+1 +"RTN","TMGRPC1",667,0) + set RESULT(line)="SEX="_$get(TMGFDA(2,IENS,.02)) set line=line+1 +"RTN","TMGRPC1",668,0) + set RESULT(line)="SS_NUM="_$get(TMGFDA(2,IENS,.09)) set line=line+1 +"RTN","TMGRPC1",669,0) + set RESULT(line)="ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.111)) set line=line+1 +"RTN","TMGRPC1",670,0) + set RESULT(line)="ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.112)) set line=line+1 +"RTN","TMGRPC1",671,0) + set RESULT(line)="ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.113)) set line=line+1 +"RTN","TMGRPC1",672,0) + set RESULT(line)="CITY="_$get(TMGFDA(2,IENS,.114)) set line=line+1 +"RTN","TMGRPC1",673,0) + set RESULT(line)="STATE="_$get(TMGFDA(2,IENS,.115)) set line=line+1 +"RTN","TMGRPC1",674,0) + if $get(TMGFDA(2,IENS,.1112))'="" do +"RTN","TMGRPC1",675,0) + . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1112)) set line=line+1 +"RTN","TMGRPC1",676,0) + else if $get(TMGFDA(2,IENS,.1116))'="" do +"RTN","TMGRPC1",677,0) + . set RESULT(line)="ZIP4="_$get(TMGFDA(2,IENS,.1116)) set line=line+1 +"RTN","TMGRPC1",678,0) + set RESULT(line)="BAD_ADDRESS="_$get(TMGFDA(2,IENS,.121)) set line=line+1 +"RTN","TMGRPC1",679,0) + set RESULT(line)="TEMP_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1211)) set line=line+1 +"RTN","TMGRPC1",680,0) + set RESULT(line)="TEMP_ADDRESS_LINE_2="_$get(TMGFDA(2,IENS,.1212)) set line=line+1 +"RTN","TMGRPC1",681,0) + set RESULT(line)="TEMP_ADDRESS_LINE_3="_$get(TMGFDA(2,IENS,.1213)) set line=line+1 +"RTN","TMGRPC1",682,0) + set RESULT(line)="TEMP_CITY="_$get(TMGFDA(2,IENS,.1214)) set line=line+1 +"RTN","TMGRPC1",683,0) + set RESULT(line)="TEMP_STATE="_$get(TMGFDA(2,IENS,.1215)) set line=line+1 +"RTN","TMGRPC1",684,0) + set RESULT(line)="TEMP_ZIP4="_$get(TMGFDA(2,IENS,.1216)) set line=line+1 +"RTN","TMGRPC1",685,0) + set RESULT(line)="TEMP_STARTING_DATE="_$get(TMGFDA(2,IENS,.1217)) set line=line+1 +"RTN","TMGRPC1",686,0) + set RESULT(line)="TEMP_ENDING_DATE="_$get(TMGFDA(2,IENS,.1218)) set line=line+1 +"RTN","TMGRPC1",687,0) + set RESULT(line)="TEMP_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.12105)) set line=line+1 +"RTN","TMGRPC1",688,0) + set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1411)) set line=line+1 +"RTN","TMGRPC1",689,0) + set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1412)) set line=line+1 +"RTN","TMGRPC1",690,0) + set RESULT(line)="CONF_ADDRESS_LINE_1="_$get(TMGFDA(2,IENS,.1413)) set line=line+1 +"RTN","TMGRPC1",691,0) + set RESULT(line)="CONF_CITY="_$get(TMGFDA(2,IENS,.1414)) set line=line+1 +"RTN","TMGRPC1",692,0) + set RESULT(line)="CONF_STATE="_$get(TMGFDA(2,IENS,.1415)) set line=line+1 +"RTN","TMGRPC1",693,0) + set RESULT(line)="CONF_ZIP4="_$get(TMGFDA(2,IENS,.1416)) set line=line+1 +"RTN","TMGRPC1",694,0) + set RESULT(line)="CONF_STARTING_DATE="_$get(TMGFDA(2,IENS,.1417)) set line=line+1 +"RTN","TMGRPC1",695,0) + set RESULT(line)="CONF_ENDING_DATE="_$get(TMGFDA(2,IENS,.1418)) set line=line+1 +"RTN","TMGRPC1",696,0) + set RESULT(line)="CONF_ADDRESS_ACTIVE="_$get(TMGFDA(2,IENS,.14105)) set line=line+1 +"RTN","TMGRPC1",697,0) + set RESULT(line)="PHONE_RESIDENCE="_$get(TMGFDA(2,IENS,.131)) set line=line+1 +"RTN","TMGRPC1",698,0) + set RESULT(line)="PHONE_WORK="_$get(TMGFDA(2,IENS,.132)) set line=line+1 +"RTN","TMGRPC1",699,0) + set RESULT(line)="PHONE_CELL="_$get(TMGFDA(2,IENS,.133)) set line=line+1 +"RTN","TMGRPC1",700,0) + set RESULT(line)="PHONE_TEMP="_$get(TMGFDA(2,IENS,.1219)) set line=line+1 +"RTN","TMGRPC1",701,0) + +"RTN","TMGRPC1",702,0) + ;"the GETS doesn't return ALIAS entries, so will do manually: +"RTN","TMGRPC1",703,0) + new Itr,IEN +"RTN","TMGRPC1",704,0) + set IEN=$$ItrInit^TMGITR(2.01,.Itr,DFN_",") +"RTN","TMGRPC1",705,0) + if IEN'="" for do quit:(+$$ItrNext^TMGITR(.Itr,.IEN)'>0) +"RTN","TMGRPC1",706,0) + . new s set s=$get(^DPT(DFN,.01,IEN,0)) +"RTN","TMGRPC1",707,0) + . if s="" quit +"RTN","TMGRPC1",708,0) + . set RESULT(line)="ALIAS "_IEN_" NAME="_$piece(s,"^",1) set line=line+1 +"RTN","TMGRPC1",709,0) + . set RESULT(line)="ALIAS "_IEN_" SSN="_$piece(s,"^",2) set line=line+1 +"RTN","TMGRPC1",710,0) + . ;"maybe later do something with NAME COMPONENTS in Alias. +"RTN","TMGRPC1",711,0) + +"RTN","TMGRPC1",712,0) + quit +"RTN","TMGRPC1",713,0) + +"RTN","TMGRPC1",714,0) + +"RTN","TMGRPC1",715,0) +STPTINFO(RESULT,DFN,INFO) ;" SET PATIENT INFO +"RTN","TMGRPC1",716,0) + ;"Purpose: To set demographcs details about patient +"RTN","TMGRPC1",717,0) + ;"Input: RESULT (this is the output array) +"RTN","TMGRPC1",718,0) + ;" DFN : The record number in file #2 of the patient to inquire about. +"RTN","TMGRPC1",719,0) + ;" INFO: Format as follows: +"RTN","TMGRPC1",720,0) + ;" The results are in format: INFO("KeyName")=Value, +"RTN","TMGRPC1",721,0) + ;" There is no set order these will appear. +"RTN","TMGRPC1",722,0) + ;" Here are the KeyName names that will be provided. +"RTN","TMGRPC1",723,0) + ;" If the record has no value, then value will be empty +"RTN","TMGRPC1",724,0) + ;" If a record should be deleted, its value will be @ +"RTN","TMGRPC1",725,0) + ;" INFO("COMBINED_NAME")= +"RTN","TMGRPC1",726,0) + ;" INFO("PREFIX")= +"RTN","TMGRPC1",727,0) + ;" INFO("SUFFIX")= +"RTN","TMGRPC1",728,0) + ;" INFO("DEGREE")= +"RTN","TMGRPC1",729,0) + ;" INFO("DOB")= +"RTN","TMGRPC1",730,0) + ;" INFO("SEX")= +"RTN","TMGRPC1",731,0) + ;" INFO("SS_NUM")= +"RTN","TMGRPC1",732,0) + ;" INFO("ADDRESS_LINE_1")= +"RTN","TMGRPC1",733,0) + ;" INFO("ADDRESS_LINE_2")= +"RTN","TMGRPC1",734,0) + ;" INFO("ADDRESS_LINE_3")= +"RTN","TMGRPC1",735,0) + ;" INFO("CITY")= +"RTN","TMGRPC1",736,0) + ;" INFO("STATE")= +"RTN","TMGRPC1",737,0) + ;" INFO("ZIP4")= +"RTN","TMGRPC1",738,0) + ;" INFO("BAD_ADDRESS")= +"RTN","TMGRPC1",739,0) + ;" INFO("TEMP_ADDRESS_LINE_1")= +"RTN","TMGRPC1",740,0) + ;" INFO("TEMP_ADDRESS_LINE_2")= +"RTN","TMGRPC1",741,0) + ;" INFO("TEMP_ADDRESS_LINE_3")= +"RTN","TMGRPC1",742,0) + ;" INFO("TEMP_CITY")= +"RTN","TMGRPC1",743,0) + ;" INFO("TEMP_STATE")= +"RTN","TMGRPC1",744,0) + ;" INFO("TEMP_ZIP4")= +"RTN","TMGRPC1",745,0) + ;" INFO("TEMP_STARTING_DATE")= +"RTN","TMGRPC1",746,0) + ;" INFO("TEMP_ENDING_DATE")= +"RTN","TMGRPC1",747,0) + ;" INFO("TEMP_ADDRESS_ACTIVE")= +"RTN","TMGRPC1",748,0) + ;" INFO("CONF_ADDRESS_LINE_1")= +"RTN","TMGRPC1",749,0) + ;" INFO("CONF_ADDRESS_LINE_2")= +"RTN","TMGRPC1",750,0) + ;" INFO("CONF_ADDRESS_LINE_3")= +"RTN","TMGRPC1",751,0) + ;" INFO("CONF_CITY")= +"RTN","TMGRPC1",752,0) + ;" INFO("CONF_STATE")= +"RTN","TMGRPC1",753,0) + ;" INFO("CONF_ZIP4")= +"RTN","TMGRPC1",754,0) + ;" INFO("CONF_STARTING_DATE")= +"RTN","TMGRPC1",755,0) + ;" INFO("CONF_ENDING_DATE")= +"RTN","TMGRPC1",756,0) + ;" INFO("CONF_ADDRESS_ACTIVE")= +"RTN","TMGRPC1",757,0) + ;" INFO("PHONE_RESIDENCE")= +"RTN","TMGRPC1",758,0) + ;" INFO("PHONE_WORK")= +"RTN","TMGRPC1",759,0) + ;" INFO("PHONE_CELL")= +"RTN","TMGRPC1",760,0) + ;" INFO("PHONE_TEMP")= +"RTN","TMGRPC1",761,0) + ;"Note, for the following, there may be multiple entries. # is record number +"RTN","TMGRPC1",762,0) + ;" If a record should be added, it will be marked +1, +2 etc. +"RTN","TMGRPC1",763,0) + ;" INFO("ALIAS # NAME")= +"RTN","TMGRPC1",764,0) + ;" INFO("ALIAS # SSN")= +"RTN","TMGRPC1",765,0) + ;" +"RTN","TMGRPC1",766,0) + ;"Results: Results passed back in RESULT string: +"RTN","TMGRPC1",767,0) + ;" 1 = success +"RTN","TMGRPC1",768,0) + ;" -1^Message = failure +"RTN","TMGRPC1",769,0) + +"RTN","TMGRPC1",770,0) + set RESULT=1 ;"default to success +"RTN","TMGRPC1",771,0) + +"RTN","TMGRPC1",772,0) + ;"kill ^TMG("TMP","RPC") +"RTN","TMGRPC1",773,0) + ;"merge ^TMG("TMP","RPC")=INFO ;"temp... remove later +"RTN","TMGRPC1",774,0) + +"RTN","TMGRPC1",775,0) + new TMGFDA,TMGMSG,IENS +"RTN","TMGRPC1",776,0) + set IENS=DFN_"," +"RTN","TMGRPC1",777,0) + new key set key="" +"RTN","TMGRPC1",778,0) + for set key=$order(INFO(key)) quit:(key="") do +"RTN","TMGRPC1",779,0) + . if key="COMBINED_NAME" set TMGFDA(2,IENS,.01)=INFO("COMBINED_NAME") +"RTN","TMGRPC1",780,0) + . else if key="DOB" set TMGFDA(2,IENS,.03)=INFO("DOB") +"RTN","TMGRPC1",781,0) + . else if key="SEX" set TMGFDA(2,IENS,.02)=INFO("SEX") +"RTN","TMGRPC1",782,0) + . else if key="SS_NUM" set TMGFDA(2,IENS,.09)=INFO("SS_NUM") +"RTN","TMGRPC1",783,0) + . else if key="ADDRESS_LINE_1" set TMGFDA(2,IENS,.111)=INFO("ADDRESS_LINE_1") +"RTN","TMGRPC1",784,0) + . else if key="ADDRESS_LINE_2" set TMGFDA(2,IENS,.112)=INFO("ADDRESS_LINE_2") +"RTN","TMGRPC1",785,0) + . else if key="ADDRESS_LINE_3" set TMGFDA(2,IENS,.113)=INFO("ADDRESS_LINE_3") +"RTN","TMGRPC1",786,0) + . else if key="CITY" set TMGFDA(2,IENS,.114)=INFO("CITY") +"RTN","TMGRPC1",787,0) + . else if key="STATE" set TMGFDA(2,IENS,.115)=INFO("STATE") +"RTN","TMGRPC1",788,0) + . else if key="ZIP4" set TMGFDA(2,IENS,.1122)=INFO("ZIP4") +"RTN","TMGRPC1",789,0) + . else if key="BAD_ADDRESS" set TMGFDA(2,IENS,.121)=INFO("BAD_ADDRESS") +"RTN","TMGRPC1",790,0) + . else if key="TEMP_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1211)=INFO("TEMP_ADDRESS_LINE_1") +"RTN","TMGRPC1",791,0) + . else if key="TEMP_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1212)=INFO("TEMP_ADDRESS_LINE_2") +"RTN","TMGRPC1",792,0) + . else if key="TEMP_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1213)=INFO("TEMP_ADDRESS_LINE_3") +"RTN","TMGRPC1",793,0) + . else if key="TEMP_CITY" set TMGFDA(2,IENS,.1214)=INFO("TEMP_CITY") +"RTN","TMGRPC1",794,0) + . else if key="TEMP_STATE" set TMGFDA(2,IENS,.1215)=INFO("TEMP_STATE") +"RTN","TMGRPC1",795,0) + . else if key="TEMP_ZIP4" set TMGFDA(2,IENS,.1216)=INFO("TEMP_ZIP4") +"RTN","TMGRPC1",796,0) + . else if key="TEMP_STARTING_DATE" set TMGFDA(2,IENS,.1217)=INFO("TEMP_STARTING_DATE") +"RTN","TMGRPC1",797,0) + . else if key="TEMP_ENDING_DATE" set TMGFDA(2,IENS,.1218)=INFO("TEMP_ENDING_DATE") +"RTN","TMGRPC1",798,0) + . else if key="TEMP_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.12105)=INFO("TEMP_ADDRESS_ACTIVE") +"RTN","TMGRPC1",799,0) + . else if key="CONF_ADDRESS_LINE_1" set TMGFDA(2,IENS,.1411)=INFO("CONF_ADDRESS_LINE_1") +"RTN","TMGRPC1",800,0) + . else if key="CONF_ADDRESS_LINE_2" set TMGFDA(2,IENS,.1412)=INFO("CONF_ADDRESS_LINE_2") +"RTN","TMGRPC1",801,0) + . else if key="CONF_ADDRESS_LINE_3" set TMGFDA(2,IENS,.1413)=INFO("CONF_ADDRESS_LINE_3") +"RTN","TMGRPC1",802,0) + . else if key="CONF_CITY" set TMGFDA(2,IENS,.1414)=INFO("CONF_CITY") +"RTN","TMGRPC1",803,0) + . else if key="CONF_STATE" set TMGFDA(2,IENS,.1415)=INFO("CONF_STATE") +"RTN","TMGRPC1",804,0) + . else if key="CONF_ZIP4" set TMGFDA(2,IENS,.1416)=INFO("CONF_ZIP4") +"RTN","TMGRPC1",805,0) + . else if key="CONF_STARTING_DATE" set TMGFDA(2,IENS,.1417)=INFO("CONF_STARTING_DATE") +"RTN","TMGRPC1",806,0) + . else if key="CONF_ENDING_DATE" set TMGFDA(2,IENS,.1418)=INFO("CONF_ENDING_DATE") +"RTN","TMGRPC1",807,0) + . else if key="CONF_ADDRESS_ACTIVE" set TMGFDA(2,IENS,.14105)=INFO("CONF_ADDRESS_ACTIVE") +"RTN","TMGRPC1",808,0) + . else if key="PHONE_RESIDENCE" set TMGFDA(2,IENS,.131)=INFO("PHONE_RESIDENCE") +"RTN","TMGRPC1",809,0) + . else if key="PHONE_WORK" set TMGFDA(2,IENS,.132)=INFO("PHONE_WORK") +"RTN","TMGRPC1",810,0) + . else if key="PHONE_CELL" set TMGFDA(2,IENS,.133)=INFO("PHONE_CELL") +"RTN","TMGRPC1",811,0) + . else if key="PHONE_TEMP" set TMGFDA(2,IENS,.1219)=INFO("PHONE_TEMP") +"RTN","TMGRPC1",812,0) + +"RTN","TMGRPC1",813,0) + if $data(TMGFDA) do +"RTN","TMGRPC1",814,0) + . do FILE^DIE("EKST","TMGFDA","TMGMSG") +"RTN","TMGRPC1",815,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGRPC1",816,0) + . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) +"RTN","TMGRPC1",817,0) + . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") +"RTN","TMGRPC1",818,0) + . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA +"RTN","TMGRPC1",819,0) + +"RTN","TMGRPC1",820,0) + ;"now file Alias info separately +"RTN","TMGRPC1",821,0) + if RESULT=1 do +"RTN","TMGRPC1",822,0) + . new tempArray,index,key2 +"RTN","TMGRPC1",823,0) + . new key set key="" +"RTN","TMGRPC1",824,0) + . for set key=$order(INFO(key)) quit:(key="") do +"RTN","TMGRPC1",825,0) + . . if key["ALIAS" do +"RTN","TMGRPC1",826,0) + . . . set index=$piece(key," ",2) quit:(index="") +"RTN","TMGRPC1",827,0) + . . . set key2=$piece(key," ",3) +"RTN","TMGRPC1",828,0) + . . . set tempArray(index,key2)=INFO(key) +"RTN","TMGRPC1",829,0) + . set index=0 for set index=$order(tempArray(index)) quit:(index="")!(RESULT'=1) do +"RTN","TMGRPC1",830,0) + . . new TMGFDA,TMGMSG,TMGIEN,newRec +"RTN","TMGRPC1",831,0) + . . set newRec=0 +"RTN","TMGRPC1",832,0) + . . set key="" for set key=$order(tempArray(index,key)) quit:(key="")!(RESULT'=1) do +"RTN","TMGRPC1",833,0) + . . . if key="NAME" set TMGFDA(2.01,index_","_DFN_",",.01)=$get(tempArray(index,"NAME")) +"RTN","TMGRPC1",834,0) + . . . if key="SSN" set TMGFDA(2.01,index_","_DFN_",",1)=$get(tempArray(index,"SSN")) +"RTN","TMGRPC1",835,0) + . . . if index["+" set newRec=1 +"RTN","TMGRPC1",836,0) + . . if $data(TMGFDA) do +"RTN","TMGRPC1",837,0) + . . . if newRec=0 do FILE^DIE("EKST","TMGFDA","TMGMSG") +"RTN","TMGRPC1",838,0) + . . . else do UPDATE^DIE("ES","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGRPC1",839,0) + . . if $data(TMGMSG("DIERR")) do +"RTN","TMGRPC1",840,0) + . . . set RESULT="-1^Filing Error Occured: "_$get(TMGMSG("DIERR",1,"TEXT",1)) +"RTN","TMGRPC1",841,0) + . . . ;"merge ^TMG("TMP","RPC","DIERR")=TMGMSG("DIERR") +"RTN","TMGRPC1",842,0) + . . . ;"merge ^TMG("TMP","RPC","FDA")=TMGFDA +"RTN","TMGRPC1",843,0) + +"RTN","TMGRPC1",844,0) + quit +"RTN","TMGRPC1",845,0) + +"RTN","TMGRPC1",846,0) +PTADD(RESULT,INFO) ;" ADD PATIENT +"RTN","TMGRPC1",847,0) + ;"Purpose: To add a patient +"RTN","TMGRPC1",848,0) + ;"Input: RESULT (this is the output array) +"RTN","TMGRPC1",849,0) + ;" +"RTN","TMGRPC1",850,0) + ;" INFO: Format as follows: +"RTN","TMGRPC1",851,0) + ;" The results are in format: INFO("KeyName")=Value, +"RTN","TMGRPC1",852,0) + ;" There is no set order these will appear. +"RTN","TMGRPC1",853,0) + ;" Here are the KeyName names that will be provided. +"RTN","TMGRPC1",854,0) + ;" If the record has no value, then value will be empty +"RTN","TMGRPC1",855,0) + ;" If a record should be deleted, its value will be @ +"RTN","TMGRPC1",856,0) + ;" INFO("COMBINED_NAME")= +"RTN","TMGRPC1",857,0) + ;" INFO("DOB")= +"RTN","TMGRPC1",858,0) + ;" INFO("SEX")= +"RTN","TMGRPC1",859,0) + ;" INFO("SS_NUM")= +"RTN","TMGRPC1",860,0) + ;" INFO("Veteran")= +"RTN","TMGRPC1",861,0) + ;" INFO("PtType")= +"RTN","TMGRPC1",862,0) + ;"Results: Results passed back in RESULT string: +"RTN","TMGRPC1",863,0) + ;" DFN = success +"RTN","TMGRPC1",864,0) + ;" -1^Message = failure +"RTN","TMGRPC1",865,0) + ;" 0^DFN = already exists +"RTN","TMGRPC1",866,0) + +"RTN","TMGRPC1",867,0) + set RESULT=1 ;"default to success +"RTN","TMGRPC1",868,0) + +"RTN","TMGRPC1",869,0) + kill ^TMG("TMP","RPC") +"RTN","TMGRPC1",870,0) + merge ^TMG("TMP","RPC")=INFO ;"temp... remove later +"RTN","TMGRPC1",871,0) + +"RTN","TMGRPC1",872,0) + new TMGFDA,TMGMSG,IENS,PATIENT,DFN,TMGFREG +"RTN","TMGRPC1",873,0) + ;" set IENS=DFN_"," +"RTN","TMGRPC1",874,0) + new key set key="" +"RTN","TMGRPC1",875,0) + for set key=$order(INFO(key)) quit:(key="") do +"RTN","TMGRPC1",876,0) + . if key="COMBINED_NAME" set PATIENT("NAME")=INFO("COMBINED_NAME") +"RTN","TMGRPC1",877,0) + . else if key="DOB" set PATIENT("DOB")=INFO("DOB") +"RTN","TMGRPC1",878,0) + . else if key="SEX" set PATIENT("SEX")=INFO("SEX") +"RTN","TMGRPC1",879,0) + . else if key="SS_NUM" set PATIENT("SSNUM")=INFO("SS_NUM") +"RTN","TMGRPC1",880,0) + . else if key="Veteran" set PATIENT("VETERAN")=INFO("Veteran") +"RTN","TMGRPC1",881,0) + . else if key="PtType" set PATIENT("PT_TYPE")=INFO("PtType") +"RTN","TMGRPC1",882,0) + set DFN=$$GetDFN^TMGGDFN(.PATIENT) +"RTN","TMGRPC1",883,0) + if DFN=-1 do +"RTN","TMGRPC1",884,0) + . new Entry,result,ErrMsg +"RTN","TMGRPC1",885,0) + . do Pat2Entry^TMGGDFN(.PATIENT,.Entry) +"RTN","TMGRPC1",886,0) + . set DFN=$$AddNewPt^TMGGDFN(.Entry,.ErrMsg) +"RTN","TMGRPC1",887,0) + . ;"set DFN=$$GetDFN^TMGGDFN(.PATIENT) +"RTN","TMGRPC1",888,0) + . if DFN'>0 do +"RTN","TMGRPC1",889,0) + . . set RESULT="-1^ERROR ADDING" ;"should use ErrMsg from above. Fix later +"RTN","TMGRPC1",890,0) + . . set RESULT=RESULT_". "_$$GetErrStr^TMGDEBUG(.ErrMsg) +"RTN","TMGRPC1",891,0) + . else do +"RTN","TMGRPC1",892,0) + .. set RESULT=DFN +"RTN","TMGRPC1",893,0) + else do +"RTN","TMGRPC1",894,0) + . set RESULT="0^"_DFN +"RTN","TMGRPC1",895,0) + +"RTN","TMGRPC1",896,0) + quit +"RTN","TMGRPC1",897,0) + +"RTN","TMGRPC1",898,0) + +"RTN","TMGRPC1",899,0) +GETBARCD(GREF,MESSAGE,OPTION) +"RTN","TMGRPC1",900,0) + ;"SCOPE: Public +"RTN","TMGRPC1",901,0) + ;"RPC that calls this: TMG BARCODE ENCODE +"RTN","TMGRPC1",902,0) + ;"Purpose: To provide an entry point for a RPC call from a client. +"RTN","TMGRPC1",903,0) + ;" A 2D DataMatrix Bar Code will be create and passed to client. +"RTN","TMGRPC1",904,0) + ;" It will not be stored on server +"RTN","TMGRPC1",905,0) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) +"RTN","TMGRPC1",906,0) + ;" MESSAGE-- The text to use to create the barcode +"RTN","TMGRPC1",907,0) + ;" OPTION -- Array that may hold optional settings, as follows: +"RTN","TMGRPC1",908,0) + ;" OPTION("IMAGE TYPE")="jpg" <-- if not specified, then default is "png" +"RTN","TMGRPC1",909,0) + ;"Output: results are passed out in @GREF +"RTN","TMGRPC1",910,0) + ;" @GREF@(0)=success; 1=success, 0=failure +"RTN","TMGRPC1",911,0) + ;" @GREF@(1..xxx) = actual data +"RTN","TMGRPC1",912,0) + +"RTN","TMGRPC1",913,0) + ;"NOTE: dmtxread must be installed on linux host. +"RTN","TMGRPC1",914,0) + ;" I found source code here: +"RTN","TMGRPC1",915,0) + ;" http://sourceforge.net/projects/libdmtx/ +"RTN","TMGRPC1",916,0) + ;" After installing (./configure --> make --> make install), I +"RTN","TMGRPC1",917,0) + ;" copied dmtxread and dmtxwrite, which were found in the +"RTN","TMGRPC1",918,0) + ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs +"RTN","TMGRPC1",919,0) + ;" folders, into a folder on the system path. I chose /usr/bin/ +"RTN","TMGRPC1",920,0) + ;" Also, to achieve compile of above, I had to install required libs. +"RTN","TMGRPC1",921,0) + ;" See notes included with dmtx source code. +"RTN","TMGRPC1",922,0) + +"RTN","TMGRPC1",923,0) + new FileSpec +"RTN","TMGRPC1",924,0) + new file +"RTN","TMGRPC1",925,0) + new FName,FPath +"RTN","TMGRPC1",926,0) + +"RTN","TMGRPC1",927,0) + set GREF="^TMP(""GETBARCD^TMGRPC1"","_$J_")" +"RTN","TMGRPC1",928,0) + kill @GREF +"RTN","TMGRPC1",929,0) + set @GREF@(0)="" ;"default to failure +"RTN","TMGRPC1",930,0) + set MESSAGE=$get(MESSAGE) +"RTN","TMGRPC1",931,0) + if MESSAGE="" goto GBCDone +"RTN","TMGRPC1",932,0) + +"RTN","TMGRPC1",933,0) + ;"Create the barcode and get file name and path +"RTN","TMGRPC1",934,0) + set file=$$MAKEBC^TMGBARC(MESSAGE,.OPTION) +"RTN","TMGRPC1",935,0) + do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") +"RTN","TMGRPC1",936,0) + +"RTN","TMGRPC1",937,0) + ;"Load binary image into global array +"RTN","TMGRPC1",938,0) + set @GREF@(0)=$$BFTG^TMGBINF(.FPath,.FName,$name(@GREF@(1)),3) +"RTN","TMGRPC1",939,0) + +"RTN","TMGRPC1",940,0) + ;"convert binary data to ascii encoded data +"RTN","TMGRPC1",941,0) + do ENCODE($name(@GREF@(1)),3) +"RTN","TMGRPC1",942,0) + +"RTN","TMGRPC1",943,0) + ;"delete temp image file +"RTN","TMGRPC1",944,0) + do SplitFNamePath^TMGIOUTL(file,.FPath,.FName,"/") +"RTN","TMGRPC1",945,0) + set FileSpec(FName)="" +"RTN","TMGRPC1",946,0) + new temp set temp=$$DEL^%ZISH(FPath,"FileSpec") +"RTN","TMGRPC1",947,0) + +"RTN","TMGRPC1",948,0) +GBCDone +"RTN","TMGRPC1",949,0) + quit +"RTN","TMGRPC1",950,0) + +"RTN","TMGRPC1",951,0) + +"RTN","TMGRPC1",952,0) +DECODEBC(RESULT,ARRAY,IMGTYPE) +"RTN","TMGRPC1",953,0) + ;"SCOPE: Public +"RTN","TMGRPC1",954,0) + ;"RPC that calls this: TMG BARCODE DECODE +"RTN","TMGRPC1",955,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",956,0) + ;" will upload an image file (.png format only) of a barcode (Datamatrix +"RTN","TMGRPC1",957,0) + ;" format) for decoding. Decoded message is passed back. +"RTN","TMGRPC1",958,0) + ;"Input: RESULT -- an OUT PARAMETER. See output below. +"RTN","TMGRPC1",959,0) + ;" ARRAY -- the array that will hold the image file, in BASE64 ascii encoding +"RTN","TMGRPC1",960,0) + ;" IMGTYPE -- Image type, e.g. "jpg" (Note: don't include any '.') +"RTN","TMGRPC1",961,0) + ;"Output: results are passed out in RESULT: 1^Decoded Message or 0^FailureMessage +"RTN","TMGRPC1",962,0) + +"RTN","TMGRPC1",963,0) + ;"NOTE: dmtxread must be installed on linux host. +"RTN","TMGRPC1",964,0) + ;" I found source code here: +"RTN","TMGRPC1",965,0) + ;" http://sourceforge.net/projects/libdmtx/ +"RTN","TMGRPC1",966,0) + ;" After installing (./configure --> make --> make install), I +"RTN","TMGRPC1",967,0) + ;" copied dmtxread and dmtxwrite, which were found in the +"RTN","TMGRPC1",968,0) + ;" (installdir)/util/dmtxread/.libs and (installdir)/util/dmtxwrite/.libs +"RTN","TMGRPC1",969,0) + ;" folders, into a folder on the system path. I chose /usr/bin/ +"RTN","TMGRPC1",970,0) + ;" Also, to achieve compile of above, I had to install required libs. +"RTN","TMGRPC1",971,0) + ;" See notes included with dmtx source code. +"RTN","TMGRPC1",972,0) + ;"NOTE: if image types other than .png will be uploaded, then the linux host +"RTN","TMGRPC1",973,0) + ;" must have ImageMagick utility 'convert' installed for conversion +"RTN","TMGRPC1",974,0) + ;" between image types. +"RTN","TMGRPC1",975,0) + +"RTN","TMGRPC1",976,0) + kill ^TMG("TMP","BARCODE") +"RTN","TMGRPC1",977,0) + ;"set ^TMG("TMP","BARCODE","LOG")=1 ;"temp +"RTN","TMGRPC1",978,0) + +"RTN","TMGRPC1",979,0) + ;"new Stack do GetStackInfo^TMGIDE2(.Stack) +"RTN","TMGRPC1",980,0) + ;"merge ^TMG("TMP","BARCODE","STACK")=Stack +"RTN","TMGRPC1",981,0) + +"RTN","TMGRPC1",982,0) + new resultMsg +"RTN","TMGRPC1",983,0) + if $data(ARRAY)=0 set resultMsg="0^No image data received to decode" goto DBCDone +"RTN","TMGRPC1",984,0) + +"RTN","TMGRPC1",985,0) + new imageType set imageType=$$LOW^XLFSTR($get(IMGTYPE)) +"RTN","TMGRPC1",986,0) + if imageType="" set resultMsg="0^Image type not specified" goto DBCDone +"RTN","TMGRPC1",987,0) + +"RTN","TMGRPC1",988,0) + new imageFName set imageFName="/tmp/barcode."_imageType +"RTN","TMGRPC1",989,0) + set imageFName=$$UNIQUE^%ZISUTL(imageFName) +"RTN","TMGRPC1",990,0) + new FName,FPath,FileSpec +"RTN","TMGRPC1",991,0) + do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") +"RTN","TMGRPC1",992,0) + set FileSpec(FName)="" +"RTN","TMGRPC1",993,0) + +"RTN","TMGRPC1",994,0) + ;"temp... +"RTN","TMGRPC1",995,0) + ;"merge ^TMG("TMP","BARCODE","DATA")=ARRAY +"RTN","TMGRPC1",996,0) + ;"merge ^TMG("TMP","BARCODE","IMGTYPE")=IMGTYPE +"RTN","TMGRPC1",997,0) + +"RTN","TMGRPC1",998,0) + ;"set ^TMG("TMP","BARCODE","LOG")=2 ;"temp +"RTN","TMGRPC1",999,0) + ;"Remove BASE64 ascii encoding +"RTN","TMGRPC1",1000,0) + do DECODE("ARRAY(0)",1) +"RTN","TMGRPC1",1001,0) + +"RTN","TMGRPC1",1002,0) + ;"set ^TMG("TMP","BARCODE","LOG")=3 ;"temp +"RTN","TMGRPC1",1003,0) + ;"set ^TMG("TMP","BARCODE","LOG","Orig file: "_FPath_FName)="" +"RTN","TMGRPC1",1004,0) + +"RTN","TMGRPC1",1005,0) + ;"Save to host file system +"RTN","TMGRPC1",1006,0) + if $$GTBF^TMGBINF("ARRAY(0)",1,FPath,FName)=0 do goto DBCDone +"RTN","TMGRPC1",1007,0) + . set resultMsg="0^Error while saving file to HFS" +"RTN","TMGRPC1",1008,0) + +"RTN","TMGRPC1",1009,0) + ;"set ^TMG("TMP","BARCODE","LOG")=4 ;"temp +"RTN","TMGRPC1",1010,0) + +"RTN","TMGRPC1",1011,0) + ;"convert image file to .png format, if needed +"RTN","TMGRPC1",1012,0) + if imageType'="png" do +"RTN","TMGRPC1",1013,0) + . set imageFName=$$Convert^TMGKERNL(imageFName,"png") +"RTN","TMGRPC1",1014,0) + . if imageFName="" do quit +"RTN","TMGRPC1",1015,0) + . . set resultMsg="0^Error while converting image from ."_imageType_" to .png format." +"RTN","TMGRPC1",1016,0) + . do SplitFNamePath^TMGIOUTL(imageFName,.FPath,.FName,"/") +"RTN","TMGRPC1",1017,0) + . set FileSpec(FName)="" +"RTN","TMGRPC1",1018,0) + if imageFName="" goto DBCDone +"RTN","TMGRPC1",1019,0) + +"RTN","TMGRPC1",1020,0) + ;"set ^TMG("TMP","BARCODE","LOG")=5 ;"temp +"RTN","TMGRPC1",1021,0) + +"RTN","TMGRPC1",1022,0) + ;"Decode the barcode.png image +"RTN","TMGRPC1",1023,0) + new result set result=$$READBC^TMGBARC(imageFName) +"RTN","TMGRPC1",1024,0) + if result'="" set resultMsg="1^"_result +"RTN","TMGRPC1",1025,0) + else set resultMsg="0^Unable to Decode Image" +"RTN","TMGRPC1",1026,0) + +"RTN","TMGRPC1",1027,0) + ;"delete temp image file +"RTN","TMGRPC1",1028,0) + ;"temp REMOVE COMMENTS LATER TO DELETE FILE. !!!!! +"RTN","TMGRPC1",1029,0) + ;"set result=$$DEL^%ZISH(FPath,"FileSpec") +"RTN","TMGRPC1",1030,0) + +"RTN","TMGRPC1",1031,0) +DBCDone +"RTN","TMGRPC1",1032,0) + ;"set ^TMG("TMP","BARCODE","LOG")=6 ;"temp +"RTN","TMGRPC1",1033,0) + +"RTN","TMGRPC1",1034,0) + set RESULT=resultMsg +"RTN","TMGRPC1",1035,0) + quit +"RTN","TMGRPC1",1036,0) + +"RTN","TMGRPC1",1037,0) + ;"-------------------- +"RTN","TMGRPC1",1038,0) +GETURLS(RESULT) +"RTN","TMGRPC1",1039,0) + ;"SCOPE: Public +"RTN","TMGRPC1",1040,0) + ;"RPC that calls this: TMG CPRS GET URL LIST +"RTN","TMGRPC1",1041,0) + ;"Purpose: To provide an entry point for a RPC call from a client. The client +"RTN","TMGRPC1",1042,0) + ;" will request URLs to display in custom tabs inside CPRS, in an +"RTN","TMGRPC1",1043,0) + ;" imbedded web browser +"RTN","TMGRPC1",1044,0) + ;"Input: RESULT -- an OUT PARAMETER. See output below. +"RTN","TMGRPC1",1045,0) + ;"Output: results are passed out in RESULT: +"RTN","TMGRPC1",1046,0) + ;" RESULT(0)="1^Success" or "0^SomeFailureMessage" +"RTN","TMGRPC1",1047,0) + ;" RESULT(1)="Name1^URL#1" ; shows URL#1 in tab #1, named 'Name1' +"RTN","TMGRPC1",1048,0) + ;" RESULT(2)="Name2^URL#2" ; etc. +"RTN","TMGRPC1",1049,0) + ;" RESULT(3)="Name3^URL#3" +"RTN","TMGRPC1",1050,0) + ;" +"RTN","TMGRPC1",1051,0) + ;" E.g. RESULT(1)="cnn^www.cnn.com" +"RTN","TMGRPC1",1052,0) + ;" RESULT(2)="INFO^192.168.0.1/home.html" +"RTN","TMGRPC1",1053,0) + ;" +"RTN","TMGRPC1",1054,0) + ;" The number of allowed tabs is determined by code in CPRS +"RTN","TMGRPC1",1055,0) + ;" Reference to tab numbers > specified in CPRS will be ignored by CPRS +"RTN","TMGRPC1",1056,0) + ;" If a web tab is NOT specified, then the page previously +"RTN","TMGRPC1",1057,0) + ;" displayed will be left in place. It will not be cleared. +"RTN","TMGRPC1",1058,0) + ;" To clear a given page, a url of "about:blank" will cause a +"RTN","TMGRPC1",1059,0) + ;" blank page to be displayed. e.g. +"RTN","TMGRPC1",1060,0) + ;" RESULT(3)="^about:blank" +"RTN","TMGRPC1",1061,0) + ;" To HIDE a tab on CPRS use this: +"RTN","TMGRPC1",1062,0) + ;" RESULT(3)="" ;triggers tab #3 to be hidden +"RTN","TMGRPC1",1063,0) + +"RTN","TMGRPC1",1064,0) + ;"Notice to others: Below is where code should be added to return +"RTN","TMGRPC1",1065,0) + ;" proper URL's to CPRS. This will be called whenever a new patient +"RTN","TMGRPC1",1066,0) + ;" is opened, or a Refresh Information is requested. +"RTN","TMGRPC1",1067,0) + ;" FYI, 'DFN' should be defined as a globally-scoped variable that can be used +"RTN","TMGRPC1",1068,0) + ;" to pass back URLS specific for a given patient. +"RTN","TMGRPC1",1069,0) + +"RTN","TMGRPC1",1070,0) + set RESULT(0)="1^Success" +"RTN","TMGRPC1",1071,0) + set RESULT(1)="Yahoo^www.yahoo.com" +"RTN","TMGRPC1",1072,0) + set RESULT(2)="(x)^about:blank" +"RTN","TMGRPC1",1073,0) + set RESULT(3)="^" +"RTN","TMGRPC1",1074,0) + +"RTN","TMGRPC1",1075,0) + ;"kill RESULT +"RTN","TMGRPC1",1076,0) + ;"merge RESULT=^TMG("TMP","URLS") ;"TEMP!!! +"RTN","TMGRPC1",1077,0) + +"RTN","TMGRPC1",1078,0) + quit +"RTN","TMGSELED") +0^73^B10024 +"RTN","TMGSELED",1,0) +TMGSELED ;TMG/kst/Group record selected editer ;03/25/06 +"RTN","TMGSELED",2,0) + ;;1.0;TMG-LIB;**1**;01/25/07 +"RTN","TMGSELED",3,0) + +"RTN","TMGSELED",4,0) + ;"TMG -- Group record selected editer +"RTN","TMGSELED",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGSELED",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSELED",7,0) + ;"1-25-2007 +"RTN","TMGSELED",8,0) + +"RTN","TMGSELED",9,0) + ;"======================================================================= +"RTN","TMGSELED",10,0) + ;" API -- Public Functions. +"RTN","TMGSELED",11,0) + ;"======================================================================= +"RTN","TMGSELED",12,0) + ;"ASKSELED -- A record group selecter/editor, with asking user for options +"RTN","TMGSELED",13,0) + ;"ASK1ED -- A record editor +"RTN","TMGSELED",14,0) + ;"$$SELED(Options) -- entry point for group selecting and editing of records +"RTN","TMGSELED",15,0) + ;" Options -- PASS BY REFERENCE. Format: +"RTN","TMGSELED",16,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",17,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",18,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",19,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",20,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",21,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",22,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",23,0) + ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- Optional. Makes preselected +"RTN","TMGSELED",24,0) + ;" Note: alternative Format +"RTN","TMGSELED",25,0) + ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width +"RTN","TMGSELED",26,0) + ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and +"RTN","TMGSELED",27,0) + ;" FldNum2 is in file2. This value is a pointer to file3, and +"RTN","TMGSELED",28,0) + ;" FldNum3 is a value in file3 +"RTN","TMGSELED",29,0) + ;" +"RTN","TMGSELED",30,0) + ;"$$EditRecs(pList,Options,LookupFn) -- get new values for fields in records +"RTN","TMGSELED",31,0) + ;"$$GetFields(Options) -- Interact with user to choose fields, and their display widths +"RTN","TMGSELED",32,0) + +"RTN","TMGSELED",33,0) + ;"======================================================================= +"RTN","TMGSELED",34,0) + ;" Private Functions. +"RTN","TMGSELED",35,0) + ;"======================================================================= +"RTN","TMGSELED",36,0) + ;"GetIENs(Options) -- Interact with user to choose IENs to be edited +"RTN","TMGSELED",37,0) + +"RTN","TMGSELED",38,0) + ;"GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags) -- get List of IENs in File matching ScreenCode +"RTN","TMGSELED",39,0) + ;"GetFldValue(File,FieldNum,Value,pResults) --get List of IENs in File with missing Field +"RTN","TMGSELED",40,0) + ;"FixValue(pList,FileNum,FieldNum) -- Ask user for a valid value & apply to all entries in pList +"RTN","TMGSELED",41,0) + +"RTN","TMGSELED",42,0) + +"RTN","TMGSELED",43,0) + +"RTN","TMGSELED",44,0) +ASKSELED +"RTN","TMGSELED",45,0) + ;"Scope: PUBLIC +"RTN","TMGSELED",46,0) + ;"Purpose: A record group selecter/editor +"RTN","TMGSELED",47,0) + ;"Input: None +"RTN","TMGSELED",48,0) + ;"Output: Data in database may be edited. +"RTN","TMGSELED",49,0) + ;"Results: none +"RTN","TMGSELED",50,0) + +"RTN","TMGSELED",51,0) + write !,"Group Select-and-Edit Routine",! +"RTN","TMGSELED",52,0) + write "-------------------------------",! +"RTN","TMGSELED",53,0) + write "Here are the steps we will go through . . .",! +"RTN","TMGSELED",54,0) + write "Step #1. Pick FILE to browse",! +"RTN","TMGSELED",55,0) + write "Step #2. Pick FIELDS to show when browsing",! +"RTN","TMGSELED",56,0) + write "Step #3. Pick Records to browse from",! +"RTN","TMGSELED",57,0) + write "Step #4. Select sepecific Records to edit",! +"RTN","TMGSELED",58,0) + write "Step #5. Edit values in selected records",! +"RTN","TMGSELED",59,0) + write "Loop back to Step #4",! +"RTN","TMGSELED",60,0) + +"RTN","TMGSELED",61,0) + new DIC,X,Y +"RTN","TMGSELED",62,0) + new FileNum,IEN +"RTN","TMGSELED",63,0) + new UseDefault set UseDefault=1 +"RTN","TMGSELED",64,0) + +"RTN","TMGSELED",65,0) + ;"Pick file to edit from +"RTN","TMGSELED",66,0) +ASK1 set DIC=1 +"RTN","TMGSELED",67,0) + set DIC(0)="AEQM" +"RTN","TMGSELED",68,0) + if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called +"RTN","TMGSELED",69,0) + . do ^DICRW ;" ^DICRW has default value of user's last response +"RTN","TMGSELED",70,0) + else do ^DIC ;"^DIC doesn't use a default value... +"RTN","TMGSELED",71,0) + write ! +"RTN","TMGSELED",72,0) + if +Y'>0 write ! goto ASKDone +"RTN","TMGSELED",73,0) + +"RTN","TMGSELED",74,0) + new Options +"RTN","TMGSELED",75,0) + set Options("FILE")=Y +"RTN","TMGSELED",76,0) + if $$GetFields(.Options)=0 goto ASKDone +"RTN","TMGSELED",77,0) + if $$GetWidths(.Options)=0 goto ASKDone +"RTN","TMGSELED",78,0) + +"RTN","TMGSELED",79,0) +ASK2 if $$GetIENs(.Options)=0 goto ASKDone +"RTN","TMGSELED",80,0) + +"RTN","TMGSELED",81,0) + if $$SELED(.Options)=2 goto ASK2 +"RTN","TMGSELED",82,0) + +"RTN","TMGSELED",83,0) +ASKDone +"RTN","TMGSELED",84,0) + quit +"RTN","TMGSELED",85,0) + +"RTN","TMGSELED",86,0) + +"RTN","TMGSELED",87,0) +ASK1ED +"RTN","TMGSELED",88,0) + ;"Scope: PUBLIC +"RTN","TMGSELED",89,0) + ;"Purpose: A record editor +"RTN","TMGSELED",90,0) + ;"Input: None +"RTN","TMGSELED",91,0) + ;"Output: Data in database may be edited. +"RTN","TMGSELED",92,0) + ;"Results: none +"RTN","TMGSELED",93,0) + +"RTN","TMGSELED",94,0) + new DIC,X,Y +"RTN","TMGSELED",95,0) + new FileNum,IEN +"RTN","TMGSELED",96,0) + new UseDefault set UseDefault=0 +"RTN","TMGSELED",97,0) + +"RTN","TMGSELED",98,0) + ;"Pick file to edit from +"RTN","TMGSELED",99,0) +AK1 kill DIC +"RTN","TMGSELED",100,0) + set DIC=1 +"RTN","TMGSELED",101,0) + set DIC(0)="AEQM" +"RTN","TMGSELED",102,0) + set DIC("A")="Enter Name of File Containing Record to Edit: ^// " +"RTN","TMGSELED",103,0) + if UseDefault do ;"leave the redundant do loop, it protects $T, so second do ^DIC isn't called +"RTN","TMGSELED",104,0) + . do ^DICRW ;" ^DICRW has default value of user's last response +"RTN","TMGSELED",105,0) + else do ^DIC ;"^DIC doesn't use a default value... +"RTN","TMGSELED",106,0) + write ! +"RTN","TMGSELED",107,0) + if +Y'>0 write ! goto AKDone +"RTN","TMGSELED",108,0) + +"RTN","TMGSELED",109,0) + new Options +"RTN","TMGSELED",110,0) + set Options("FILE")=Y +"RTN","TMGSELED",111,0) + if $$GetFields(.Options)=0 goto AKDone +"RTN","TMGSELED",112,0) + +"RTN","TMGSELED",113,0) +AK2 kill DIC +"RTN","TMGSELED",114,0) + set DIC("A")="Enter Record in "_$piece(Y,"^",2)_" to Edit: ^// " +"RTN","TMGSELED",115,0) + set DIC=+Y +"RTN","TMGSELED",116,0) + set DIC(0)="AEQM" +"RTN","TMGSELED",117,0) + do ^DIC +"RTN","TMGSELED",118,0) + if Y=-1 goto AK1 +"RTN","TMGSELED",119,0) + new list set list(+Y)="" +"RTN","TMGSELED",120,0) + if $$EditRecs("list",.Options)=1 goto AK2 +"RTN","TMGSELED",121,0) + +"RTN","TMGSELED",122,0) +AKDone +"RTN","TMGSELED",123,0) + quit +"RTN","TMGSELED",124,0) + +"RTN","TMGSELED",125,0) + +"RTN","TMGSELED",126,0) +GetFields(Options) +"RTN","TMGSELED",127,0) + ;"Purpose: Interact with user to choose fields, and their display widths +"RTN","TMGSELED",128,0) + ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) +"RTN","TMGSELED",129,0) + ;" Note: prior entries are NOT KILLED +"RTN","TMGSELED",130,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",131,0) + ;" Options("FILE")=Filenumber <---- FileName will be filled in. +"RTN","TMGSELED",132,0) + ;"Output: Options is filled as follows: +"RTN","TMGSELED",133,0) + ;" Options("FILE")=Filenumber^FileName <-- left in from input +"RTN","TMGSELED",134,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",135,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",136,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",137,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",138,0) + ;"Results: 1=OK To continue, 0=abort +"RTN","TMGSELED",139,0) + +"RTN","TMGSELED",140,0) + new result set result=1 +"RTN","TMGSELED",141,0) + new DIC,X,Y +"RTN","TMGSELED",142,0) + new SeqNum set SeqNum=1 +"RTN","TMGSELED",143,0) + new Field +"RTN","TMGSELED",144,0) + +"RTN","TMGSELED",145,0) + new FName set FName=$piece($get(Options("FILE")),"^",2) +"RTN","TMGSELED",146,0) + new FileNum set FileNum=+$get(Options("FILE")) +"RTN","TMGSELED",147,0) + if FileNum=0 set result=0 goto GFDone +"RTN","TMGSELED",148,0) + if FName="" do +"RTN","TMGSELED",149,0) + . set FName=$$GetFName^TMGDBAPI(FileNum) +"RTN","TMGSELED",150,0) + . set $piece(Options("FILE"),"^",2)=FName +"RTN","TMGSELED",151,0) + set DIC="^DD("_FileNum_"," +"RTN","TMGSELED",152,0) + set DIC(0)="MEQ" +"RTN","TMGSELED",153,0) +GFLoop +"RTN","TMGSELED",154,0) + write "Enter " +"RTN","TMGSELED",155,0) + if SeqNum=1 write "first " +"RTN","TMGSELED",156,0) + else write "next " +"RTN","TMGSELED",157,0) + write "field to display/edit (^ to abort): " +"RTN","TMGSELED",158,0) + read Field:$get(DTIME,3600) +"RTN","TMGSELED",159,0) + if Field="^" set result=0 goto GFDone +"RTN","TMGSELED",160,0) + if Field="" goto GFDone +"RTN","TMGSELED",161,0) + if Field[":" do +"RTN","TMGSELED",162,0) + . new i,CurFile,abort +"RTN","TMGSELED",163,0) + . new NewField set NewField="" +"RTN","TMGSELED",164,0) + . new NewFldNames set NewFldNames="" +"RTN","TMGSELED",165,0) + . set CurFile=FileNum,abort=0 +"RTN","TMGSELED",166,0) + . for i=1:1:$length(Field,":") do quit:(abort=1) +"RTN","TMGSELED",167,0) + . . new fld,DIC,X,Y +"RTN","TMGSELED",168,0) + . . set fld=$piece(Field,":",i) +"RTN","TMGSELED",169,0) + . . set DIC="^DD("_CurFile_"," +"RTN","TMGSELED",170,0) + . . set DIC(0)="MEQ" +"RTN","TMGSELED",171,0) + . . set X=fld +"RTN","TMGSELED",172,0) + . . do ^DIC +"RTN","TMGSELED",173,0) + . . if Y=-1 set abort=1 quit +"RTN","TMGSELED",174,0) + . . if NewField'="" set NewField=NewField_":" +"RTN","TMGSELED",175,0) + . . if NewFldNames'="" set NewFldNames=NewFldNames_":" +"RTN","TMGSELED",176,0) + . . set NewField=NewField_+Y +"RTN","TMGSELED",177,0) + . . set NewFldNames=NewFldNames_$piece(Y,"^",2) +"RTN","TMGSELED",178,0) + . . new FldInfo set FldInfo=$piece($get(^DD(CurFile,+Y,0)),"^",2) +"RTN","TMGSELED",179,0) + . . if FldInfo["P" do +"RTN","TMGSELED",180,0) + . . . set CurFile=+$piece(FldInfo,"P",2) +"RTN","TMGSELED",181,0) + . . . write "->" +"RTN","TMGSELED",182,0) + . set Field=NewField_"^"_NewFldNames +"RTN","TMGSELED",183,0) + . if Field="^" set Field="" +"RTN","TMGSELED",184,0) + . write ! +"RTN","TMGSELED",185,0) + else do +"RTN","TMGSELED",186,0) + . set X=Field +"RTN","TMGSELED",187,0) + . do ^DIC write ! +"RTN","TMGSELED",188,0) + . if +Y>0 set Field=Y +"RTN","TMGSELED",189,0) + . ;"NOTE: I need to ask for subfield if PTR to another file. +"RTN","TMGSELED",190,0) + . else do +"RTN","TMGSELED",191,0) + . . ;"if Field'["?" write "??",! +"RTN","TMGSELED",192,0) + . . set Field="" +"RTN","TMGSELED",193,0) + if Field="" goto GFLoop +"RTN","TMGSELED",194,0) + set Options("FIELDS",SeqNum)=Field +"RTN","TMGSELED",195,0) + set Options("FIELDS","MAX NUM")=SeqNum +"RTN","TMGSELED",196,0) + new % set %=2 +"RTN","TMGSELED",197,0) + write " DISPLAY only (i.e. don't allow edit)" do YN^DICN write ! +"RTN","TMGSELED",198,0) + if %=1 set Options("FIELDS",SeqNum,"NO EDIT")=1 +"RTN","TMGSELED",199,0) + if %=-1 goto GFDone +"RTN","TMGSELED",200,0) + set SeqNum=SeqNum+1 +"RTN","TMGSELED",201,0) + goto GFLoop +"RTN","TMGSELED",202,0) + +"RTN","TMGSELED",203,0) +GFDone +"RTN","TMGSELED",204,0) + write ! +"RTN","TMGSELED",205,0) + quit result +"RTN","TMGSELED",206,0) + +"RTN","TMGSELED",207,0) + +"RTN","TMGSELED",208,0) +GetWidths(Options) +"RTN","TMGSELED",209,0) + ;"Purpose: Interact with user to choose adjust widths of displayed fields +"RTN","TMGSELED",210,0) + ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) +"RTN","TMGSELED",211,0) + ;" Note: prior entries are NOT KILLED +"RTN","TMGSELED",212,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",213,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",214,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName +"RTN","TMGSELED",215,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName +"RTN","TMGSELED",216,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName +"RTN","TMGSELED",217,0) + ;"Output: Options is filled as follows: +"RTN","TMGSELED",218,0) + ;" Options("FILE")=Filenumber^FileName <-- left in from input +"RTN","TMGSELED",219,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",220,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",221,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",222,0) + ;"Results: 1=OK To continue, 0=abort +"RTN","TMGSELED",223,0) + +"RTN","TMGSELED",224,0) + ;"Note: Later I could rewrite this function to allow a more graphical +"RTN","TMGSELED",225,0) + ;" resizing of the fields, by displaying the line with one field +"RTN","TMGSELED",226,0) + ;" in reverse colors, indicating that it has been selected. Then +"RTN","TMGSELED",227,0) + ;" left-right would adjust size, and TAB would rotate to next field. +"RTN","TMGSELED",228,0) + +"RTN","TMGSELED",229,0) + new result set result=1 +"RTN","TMGSELED",230,0) + new LMargin set LMargin=6 +"RTN","TMGSELED",231,0) + new TMGMINW set TMGMINW=3 +"RTN","TMGSELED",232,0) + new FldCount set FldCount=$get(Options("FIELDS","MAX NUM"),0) +"RTN","TMGSELED",233,0) + if FldCount=0 set result=0 goto GWDone +"RTN","TMGSELED",234,0) + new ScrnWidth set ScrnWidth=$get(IOM,80)-LMargin-1 ;"leave room for selector numbers +"RTN","TMGSELED",235,0) + new tempW set tempW=ScrnWidth\FldCount +"RTN","TMGSELED",236,0) + +"RTN","TMGSELED",237,0) + ;"Set default values +"RTN","TMGSELED",238,0) + new i for i=1:1:FldCount set $piece(Options("FIELDS",i),"^",3)=tempW +"RTN","TMGSELED",239,0) + +"RTN","TMGSELED",240,0) + write !,$$GetDispStr(.Options),! +"RTN","TMGSELED",241,0) + +"RTN","TMGSELED",242,0) + new %,i,Num,TMGW,Delta,MinW,TMGMAXW +"RTN","TMGSELED",243,0) + new SufferCol,SufferW +"RTN","TMGSELED",244,0) + new Menu,UsrSlct,MenuCount,MenuDflt +"RTN","TMGSELED",245,0) + set MenuCount=1 +"RTN","TMGSELED",246,0) + set MenuDflt=1 +"RTN","TMGSELED",247,0) + new DIR,FldName +"RTN","TMGSELED",248,0) + +"RTN","TMGSELED",249,0) + set Menu(0)="Pick Option" +"RTN","TMGSELED",250,0) + for i=1:1:FldCount do +"RTN","TMGSELED",251,0) + . set Menu(MenuCount)="Adjust ["_$piece(Options("FIELDS",i),"^",2)_"]"_$char(9)_i +"RTN","TMGSELED",252,0) + . set MenuCount=MenuCount+1 +"RTN","TMGSELED",253,0) + set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^" +"RTN","TMGSELED",254,0) + +"RTN","TMGSELED",255,0) +GWLoop +"RTN","TMGSELED",256,0) + set %=2 ;"default to 'NO' the first time into loop. +"RTN","TMGSELED",257,0) + write "Adjust column widths" +"RTN","TMGSELED",258,0) + do YN^DICN write ! +"RTN","TMGSELED",259,0) + if %=2 goto GWDone +"RTN","TMGSELED",260,0) + +"RTN","TMGSELED",261,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,MenuDflt,.MenuDflt) +"RTN","TMGSELED",262,0) + if (UsrSlct="^")!(UsrSlct="") goto GWDone +"RTN","TMGSELED",263,0) + +"RTN","TMGSELED",264,0) + set Num=+UsrSlct +"RTN","TMGSELED",265,0) + set TMGW=$piece($get(Options("FIELDS",Num)),"^",3) +"RTN","TMGSELED",266,0) + set FldName=$piece($get(Options("FIELDS",Num)),"^",2) +"RTN","TMGSELED",267,0) + +"RTN","TMGSELED",268,0) + ;"Determine which column will have compensatory changes as Column is changed +"RTN","TMGSELED",269,0) + set SufferCol=FldCount +"RTN","TMGSELED",270,0) + if Num1 set SufferCol=Num-1 +"RTN","TMGSELED",272,0) + set SufferW=$piece($get(Options("FIELDS",SufferCol)),"^",3) +"RTN","TMGSELED",273,0) + +"RTN","TMGSELED",274,0) + set TMGMAXW=ScrnWidth-((FldCount-1)*TMGMINW) ;"min colum width is 3 +"RTN","TMGSELED",275,0) + if TMGMAXWTMGMAXW) X" +"RTN","TMGSELED",277,0) + set DIR("A")="Enter amount to adjust "_FldName_" width by" +"RTN","TMGSELED",278,0) + set DIR("B")="" +"RTN","TMGSELED",279,0) + +"RTN","TMGSELED",280,0) + write $$GetDispStr(.Options) +"RTN","TMGSELED",281,0) + do ^DIR write ! +"RTN","TMGSELED",282,0) + if (Y="")!(Y["^") goto GWDone +"RTN","TMGSELED",283,0) + +"RTN","TMGSELED",284,0) + set delta=+Y +"RTN","TMGSELED",285,0) + if delta'=0 do +"RTN","TMGSELED",286,0) + . do AdjCol(.Options,Num,delta) +"RTN","TMGSELED",287,0) + . do AdjCol(.Options,SufferCol,-delta) +"RTN","TMGSELED",288,0) + +"RTN","TMGSELED",289,0) + ;"write # +"RTN","TMGSELED",290,0) + write $$GetDispStr(.Options),! +"RTN","TMGSELED",291,0) + +"RTN","TMGSELED",292,0) + goto GWLoop +"RTN","TMGSELED",293,0) +GWDone +"RTN","TMGSELED",294,0) + quit result +"RTN","TMGSELED",295,0) + +"RTN","TMGSELED",296,0) +AdjCol(Options,Num,Delta) +"RTN","TMGSELED",297,0) + ;"Purpose: To adust one column width +"RTN","TMGSELED",298,0) + ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) +"RTN","TMGSELED",299,0) + ;" Note: prior entries are NOT KILLED +"RTN","TMGSELED",300,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName +"RTN","TMGSELED",301,0) + ;"Output:Width for one column is changed. No check for total width made +"RTN","TMGSELED",302,0) + ;"Results: none +"RTN","TMGSELED",303,0) + +"RTN","TMGSELED",304,0) + new W +"RTN","TMGSELED",305,0) + set W=$piece($get(Options("FIELDS",Num)),"^",3) +"RTN","TMGSELED",306,0) + set W=W+Delta +"RTN","TMGSELED",307,0) + set $piece(Options("FIELDS",Num),"^",3)=W +"RTN","TMGSELED",308,0) + quit +"RTN","TMGSELED",309,0) + +"RTN","TMGSELED",310,0) + +"RTN","TMGSELED",311,0) +GetDispStr(Options) +"RTN","TMGSELED",312,0) + ;"Purpose: get a display representation of widths +"RTN","TMGSELED",313,0) + ;"Input: Options -- PASS BY REFERENCE +"RTN","TMGSELED",314,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",315,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",316,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",317,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",318,0) + ;"Results: returns a display string +"RTN","TMGSELED",319,0) + +"RTN","TMGSELED",320,0) + new outS set $piece(outS," ",LMargin)="" +"RTN","TMGSELED",321,0) + ;"Display current widths +"RTN","TMGSELED",322,0) + for i=1:1:FldCount do +"RTN","TMGSELED",323,0) + . new W set W=$piece(Options("FIELDS",i),"^",3) +"RTN","TMGSELED",324,0) + . new name set name=$piece($get(Options("FIELDS",i)),"^",2) +"RTN","TMGSELED",325,0) + . set name=$extract(name,1,W-2) +"RTN","TMGSELED",326,0) + . set name=$$LJ^XLFSTR(name,W-2,".") if name="" set name="!" +"RTN","TMGSELED",327,0) + . set outS=outS_"["_name_"]" +"RTN","TMGSELED",328,0) + +"RTN","TMGSELED",329,0) + quit outS +"RTN","TMGSELED",330,0) + +"RTN","TMGSELED",331,0) + +"RTN","TMGSELED",332,0) +GetIENs(Options) +"RTN","TMGSELED",333,0) + ;"Purpose: Interact with user to choose IENs to be edited +"RTN","TMGSELED",334,0) + ;" User will be able to pick IENs from a SORT TEMPLATE, or +"RTN","TMGSELED",335,0) + ;" a custom search. +"RTN","TMGSELED",336,0) + ;"Input: Options -- PASS BY REFERENCE, (used for input and as OUT PARAMETER) +"RTN","TMGSELED",337,0) + ;" Note: prior entries are NOT KILLED +"RTN","TMGSELED",338,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",339,0) + ;"Output: Options is filled as follows: +"RTN","TMGSELED",340,0) + ;" Options("FILE")=Filenumber^FileName <-- left from input +"RTN","TMGSELED",341,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",342,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",343,0) + ;"Results: 1=OK To continue, 0=abort +"RTN","TMGSELED",344,0) + +"RTN","TMGSELED",345,0) + new Menu,UsrSlct +"RTN","TMGSELED",346,0) + new FileNum set FileNum=$piece($get(Options("FILE")),"^",1) +"RTN","TMGSELED",347,0) + new FileName set FileName=$piece($get(Options("FILE")),"^",2) +"RTN","TMGSELED",348,0) + new result set result=1 +"RTN","TMGSELED",349,0) + +"RTN","TMGSELED",350,0) + set Menu(0)="Pick Records from "_FileName_" to Browse" +"RTN","TMGSELED",351,0) + set Menu(1)="Choose a TEMPLATE from a former FILEMAN SEARCH"_$char(9)_"TEMPLATE" +"RTN","TMGSELED",352,0) + set Menu(2)="Browse ALL records"_$char(9)_"ALL" +"RTN","TMGSELED",353,0) + set Menu(3)="Browse records with a given Field VALUE"_$char(9)_"SCREEN" +"RTN","TMGSELED",354,0) + set Menu(4)="Enter ^ to abort"_$char(9)_"^" +"RTN","TMGSELED",355,0) + ;"write # +"RTN","TMGSELED",356,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu,1) +"RTN","TMGSELED",357,0) + if UsrSlct="^" set result=0 goto GIDone +"RTN","TMGSELED",358,0) + if UsrSlct=0 set UsrSlct="" +"RTN","TMGSELED",359,0) + +"RTN","TMGSELED",360,0) + new abort set abort=0 +"RTN","TMGSELED",361,0) + if UsrSlct="TEMPLATE" do +"RTN","TMGSELED",362,0) + . new DIC,Y +"RTN","TMGSELED",363,0) + . set DIC=.401 +"RTN","TMGSELED",364,0) + . set DIC(0)="MAEQ" +"RTN","TMGSELED",365,0) +TPLOOP . write "Select a TEMPLATE Containing Records for Browsing.",! +"RTN","TMGSELED",366,0) + . set DIC("A")="Enter Template (^ to abort): " +"RTN","TMGSELED",367,0) + . do ^DIC write ! +"RTN","TMGSELED",368,0) + . if +Y'>0 set abort=1 quit +"RTN","TMGSELED",369,0) + . new node set node=$get(^DIBT(+Y,0)) +"RTN","TMGSELED",370,0) + . if $piece(node,"^",4)'=FileNum do goto TPLOOP +"RTN","TMGSELED",371,0) + . . set Y=0 ;"signal to try again +"RTN","TMGSELED",372,0) + . . new PriorErrorFound +"RTN","TMGSELED",373,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: That template doesn't contain records from "_FileName_". Please select another.") +"RTN","TMGSELED",374,0) + . . do PressToCont^TMGUSRIF +"RTN","TMGSELED",375,0) + . if (+Y>0)&($data(^DIBT(+Y,1))>1) do +"RTN","TMGSELED",376,0) + . . merge Options("IEN LIST")=^DIBT(+Y,1) +"RTN","TMGSELED",377,0) + +"RTN","TMGSELED",378,0) + else if UsrSlct="ALL" do +"RTN","TMGSELED",379,0) + . do GetFldValue(FileNum,.01,"ALL",$name(Options("IEN LIST"))) +"RTN","TMGSELED",380,0) + +"RTN","TMGSELED",381,0) + else if UsrSlct="SCREEN" do +"RTN","TMGSELED",382,0) + . new DIC,X,Y,DIR,FldNum,Value +"RTN","TMGSELED",383,0) + . set DIC="^DD("_FileNum_"," +"RTN","TMGSELED",384,0) + . set DIC(0)="MAEQ" +"RTN","TMGSELED",385,0) + . set DIC("A")="Enter FIELD to use for SCREEN: " +"RTN","TMGSELED",386,0) + . do ^DIC write ! +"RTN","TMGSELED",387,0) + . if Y=-1 quit +"RTN","TMGSELED",388,0) + . set FldNum=+Y +"RTN","TMGSELED",389,0) + . set DIR(0)=FileNum_","_FldNum +"RTN","TMGSELED",390,0) + . set DIR("?",1)="Enter value to search for. Records will be included" +"RTN","TMGSELED",391,0) + . set DIR("?",2)="if the field chosed contains the value entered here." +"RTN","TMGSELED",392,0) + . set DIR("?",3)="A @ may be entered to represent a NULL value for a field." +"RTN","TMGSELED",393,0) + . set DIR("?",4)="For more complex searches, use Fileman search function," +"RTN","TMGSELED",394,0) + . set DIR("?",5)="store results in a template, and then chose that template" +"RTN","TMGSELED",395,0) + . set DIR("?",6)="as the input source instead of choosing a screening value." +"RTN","TMGSELED",396,0) + . do ^DIR write ! +"RTN","TMGSELED",397,0) + . if X="@" set Y="@" +"RTN","TMGSELED",398,0) + . if Y="" quit +"RTN","TMGSELED",399,0) + . set Value=$piece(Y,"^",1) +"RTN","TMGSELED",400,0) + . do GetFldValue(FileNum,FldNum,Value,$name(Options("IEN LIST"))) +"RTN","TMGSELED",401,0) + +"RTN","TMGSELED",402,0) + if abort=1 set result=0 +"RTN","TMGSELED",403,0) +GIDone +"RTN","TMGSELED",404,0) + quit result +"RTN","TMGSELED",405,0) + +"RTN","TMGSELED",406,0) + +"RTN","TMGSELED",407,0) +GetFldVScreen(File,FieldNum,ScrnCode,pResults,Flags) +"RTN","TMGSELED",408,0) + ;"Purpose: get List of IENs in File with matching Field +"RTN","TMGSELED",409,0) + ;"Input: File -- the File to scan +"RTN","TMGSELED",410,0) + ;" FieldNum -- the Field number to get from file +"RTN","TMGSELED",411,0) + ;" ScrnCode -- Screening code to be executed.... +"RTN","TMGSELED",412,0) + ;" Format: '$$MyFn^MyModule()', or +"RTN","TMGSELED",413,0) + ;" '(some test)' such that the following is valid code: +"RTN","TMGSELED",414,0) + ;" set @("flagToSkip="_ScrnCode) +"RTN","TMGSELED",415,0) + ;" ---> If flagToSkip=1, then record is NOT selected +"RTN","TMGSELED",416,0) + ;" The following variables will be available for use: +"RTN","TMGSELED",417,0) + ;" File -- the File name or number +"RTN","TMGSELED",418,0) + ;" FieldNum -- the field number +"RTN","TMGSELED",419,0) + ;" IEN -- the IEN of the current record. +"RTN","TMGSELED",420,0) + ;" RecValue -- the current value of the field +"RTN","TMGSELED",421,0) + ;" pResults -- PASS BY NAME, an OUT PARAMETER. +"RTN","TMGSELED",422,0) + ;" Flags -- OPTIONAL. Possible Flags +"RTN","TMGSELED",423,0) + ;" "E" search for external forms (default is internal forms) +"RTN","TMGSELED",424,0) + ;"Output: @pResults is filled as following. Note: prior results are not killed +"RTN","TMGSELED",425,0) + ;" @pResults@(IEN)="" +"RTN","TMGSELED",426,0) + ;" @pResults@(IEN)="" +"RTN","TMGSELED",427,0) + ;"Results: none +"RTN","TMGSELED",428,0) + +"RTN","TMGSELED",429,0) + new Itr,IEN,RecValue,FMFlag +"RTN","TMGSELED",430,0) + new abort set abort=0 +"RTN","TMGSELED",431,0) + set FMFlag="I" if $get(Flags)["E" set FMFlag="" +"RTN","TMGSELED",432,0) + +"RTN","TMGSELED",433,0) + set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag) +"RTN","TMGSELED",434,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGSELED",435,0) + for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0))!abort +"RTN","TMGSELED",436,0) + . if $$UserAborted^TMGUSRIF set abort=1 quit +"RTN","TMGSELED",437,0) + . new flagToSkip set @("flagToSkip="_ScrnCode) +"RTN","TMGSELED",438,0) + . if flagToSkip quit +"RTN","TMGSELED",439,0) + . set @pResults@(IEN)="" +"RTN","TMGSELED",440,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGSELED",441,0) + +"RTN","TMGSELED",442,0) + quit +"RTN","TMGSELED",443,0) + +"RTN","TMGSELED",444,0) + +"RTN","TMGSELED",445,0) +GetFldValue(File,FieldNum,Value,pResults,Flags) +"RTN","TMGSELED",446,0) + ;"Purpose: get List of IENs in File with matching Field +"RTN","TMGSELED",447,0) + ;"Input: File -- the File to scan +"RTN","TMGSELED",448,0) + ;" FieldNum -- the Field number to get from file +"RTN","TMGSELED",449,0) + ;" Value -- the value to compare against. Poss Values +"RTN","TMGSELED",450,0) + ;" VALUE: if field=VALUE, then record selected +"RTN","TMGSELED",451,0) + ;" "@": if field=null (empty), then record selected +"RTN","TMGSELED",452,0) + ;" "ALL": all records are selected +"RTN","TMGSELED",453,0) + ;" pResults -- PASS BY NAME, an OUT PARAMETER. +"RTN","TMGSELED",454,0) + ;" Flags -- OPTIONAL. Possible Flags +"RTN","TMGSELED",455,0) + ;" "E" search for external forms (default is internal forms) +"RTN","TMGSELED",456,0) + ;"Output: @pResults is filled as following. Note: prior results are not killed +"RTN","TMGSELED",457,0) + ;" @pResults@(IEN)="" +"RTN","TMGSELED",458,0) + ;" @pResults@(IEN)="" +"RTN","TMGSELED",459,0) + ;"Results: none +"RTN","TMGSELED",460,0) + +"RTN","TMGSELED",461,0) + +"RTN","TMGSELED",462,0) + new Itr,IEN,RecValue,FMFlag +"RTN","TMGSELED",463,0) + if $get(Value)="ALL" goto GFV3 +"RTN","TMGSELED",464,0) + +"RTN","TMGSELED",465,0) +GFV1 set FMFlag="I" if $get(Flags)["E" set FMFlag="" +"RTN","TMGSELED",466,0) + set RecValue=$$ItrFInit^TMGITR(File,.Itr,.IEN,FieldNum,,FMFlag) +"RTN","TMGSELED",467,0) + do PrepProgress^TMGITR(.Itr,20,0,"IEN") +"RTN","TMGSELED",468,0) + for do quit:(($$ItrFNext^TMGITR(.Itr,.IEN,.RecValue)="@@@@@@@@")!(+IEN=0)) +"RTN","TMGSELED",469,0) + . if (RecValue=Value)!((Value="@")&(RecValue="")) do +"RTN","TMGSELED",470,0) + . . set @pResults@(IEN)="" +"RTN","TMGSELED",471,0) + write ! +"RTN","TMGSELED",472,0) + goto GFVDone +"RTN","TMGSELED",473,0) + +"RTN","TMGSELED",474,0) +GFV3 write "Gathering ALL records...",! +"RTN","TMGSELED",475,0) + set IEN=$$ItrInit^TMGITR(File,.Itr,.IEN) +"RTN","TMGSELED",476,0) + do PrepProgress^TMGITR(.Itr,100,0,"IEN") +"RTN","TMGSELED",477,0) + for do quit:($$ItrNext^TMGITR(.Itr,.IEN)="") +"RTN","TMGSELED",478,0) + . if +IEN'=IEN quit +"RTN","TMGSELED",479,0) + . set @pResults@(IEN)="" +"RTN","TMGSELED",480,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGSELED",481,0) +GFVDone +"RTN","TMGSELED",482,0) + quit +"RTN","TMGSELED",483,0) + +"RTN","TMGSELED",484,0) + +"RTN","TMGSELED",485,0) +SELED(Options) +"RTN","TMGSELED",486,0) + ;"Scope: PUBLIC +"RTN","TMGSELED",487,0) + ;"Purpose: the entry point for group selecting and editing of recrods +"RTN","TMGSELED",488,0) + ;" Note: this can be used as an API entry point +"RTN","TMGSELED",489,0) + ;"Input: Options -- PASS BY REFERENCE +"RTN","TMGSELED",490,0) + ;" Format: +"RTN","TMGSELED",491,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",492,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",493,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",494,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",495,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width +"RTN","TMGSELED",496,0) + ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL +"RTN","TMGSELED",497,0) + ;" A function for looking up new values. +"RTN","TMGSELED",498,0) + ;" Must be in format like this: +"RTN","TMGSELED",499,0) + ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)" +"RTN","TMGSELED",500,0) + ;" i.e. must be a function name. Function may take passed +"RTN","TMGSELED",501,0) + ;" parameters 'File' and 'FldNum' +"RTN","TMGSELED",502,0) + ;" Default value="$$ValueLookup(File,FldNum)" +"RTN","TMGSELED",503,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",504,0) + ;" Options("IEN LIST",IEN in FILE)="" +"RTN","TMGSELED",505,0) + ;" Options("IEN LIST",IEN in FILE,"SEL")="" ;"<-- optional. Makes preselected +"RTN","TMGSELED",506,0) + ;" Note: alternative Format +"RTN","TMGSELED",507,0) + ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width +"RTN","TMGSELED",508,0) + ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and +"RTN","TMGSELED",509,0) + ;" FldNum2 is in file2. This value is a pointer to file3, and +"RTN","TMGSELED",510,0) + ;" FldNum3 is a value in file3 +"RTN","TMGSELED",511,0) + ;"Output: Data in database may be edited. +"RTN","TMGSELED",512,0) + ;"Results: 1=Normal exit, 2=Needs rescan and recall +"RTN","TMGSELED",513,0) + +"RTN","TMGSELED",514,0) + new result set result=1 +"RTN","TMGSELED",515,0) + new SelList,pList,pIENList +"RTN","TMGSELED",516,0) + set pList=$name(SelList) +"RTN","TMGSELED",517,0) + set pIENList=$name(Options("IEN LIST")) +"RTN","TMGSELED",518,0) + +"RTN","TMGSELED",519,0) + new Fields,Widths +"RTN","TMGSELED",520,0) + set Fields="",Widths="" +"RTN","TMGSELED",521,0) + +"RTN","TMGSELED",522,0) + new File set File=+$get(Options("FILE")) +"RTN","TMGSELED",523,0) + if File="" goto SEDone +"RTN","TMGSELED",524,0) + +"RTN","TMGSELED",525,0) + new i for i=1:1:$get(Options("FIELDS","MAX NUM")) do +"RTN","TMGSELED",526,0) + . set Fields=Fields_$piece($get(Options("FIELDS",i)),"^",1)_";" +"RTN","TMGSELED",527,0) + . set Widths=Widths_$piece($get(Options("FIELDS",i)),"^",3)_";" +"RTN","TMGSELED",528,0) + +"RTN","TMGSELED",529,0) + new tempResult +"RTN","TMGSELED",530,0) + new pSaveArray ;"will store ref of stored display array --> faster +"RTN","TMGSELED",531,0) +SLoop kill @pList +"RTN","TMGSELED",532,0) + +"RTN","TMGSELED",533,0) + ;"Later change this to allow custom order of sort fields. +"RTN","TMGSELED",534,0) + do IENSelector^TMGUSRIF(pIENList,pList,File,Fields,Widths,"Pick Records to Edit. [ESC],[ESC] when done",Fields,.pSaveArray) +"RTN","TMGSELED",535,0) + new count set count=$$ListCt^TMGMISC(pList) +"RTN","TMGSELED",536,0) + write count," items selected.",! +"RTN","TMGSELED",537,0) + +"RTN","TMGSELED",538,0) + if count>0 set tempResult=$$EditRecs(pList,.Options) +"RTN","TMGSELED",539,0) + +"RTN","TMGSELED",540,0) + write !,"Fix more" +"RTN","TMGSELED",541,0) + new % set %=1 +"RTN","TMGSELED",542,0) + if count=0 set %=2 +"RTN","TMGSELED",543,0) + do YN^DICN write ! +"RTN","TMGSELED",544,0) + if %'=1 goto SEDone +"RTN","TMGSELED",545,0) + if $data(@pList)=0 goto SLoop +"RTN","TMGSELED",546,0) + +"RTN","TMGSELED",547,0) + new needsRepack set needsRepack=0 +"RTN","TMGSELED",548,0) + write "Removing fixed items from list. Here are the old entries...",! +"RTN","TMGSELED",549,0) + if $get(pSaveArray)="" do +"RTN","TMGSELED",550,0) + . do ListNot^TMGMISC(pIENList,pList) ;"<-- probably a bug in this function +"RTN","TMGSELED",551,0) + else do +"RTN","TMGSELED",552,0) + . new Itr,IEN,DispLineNum +"RTN","TMGSELED",553,0) + . ;"zwr @pList +"RTN","TMGSELED",554,0) + . set IEN=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGSELED",555,0) + . if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="") +"RTN","TMGSELED",556,0) + . . set DispLineNum=+$get(@pList@(IEN)) +"RTN","TMGSELED",557,0) + . . if DispLineNum=0 quit +"RTN","TMGSELED",558,0) + . . new tempS +"RTN","TMGSELED",559,0) + . . set tempS=$get(@pSaveArray@(DispLineNum)) +"RTN","TMGSELED",560,0) + . . set tempS=$piece(tempS,$char(9),2) +"RTN","TMGSELED",561,0) + . . write " --",tempS,! +"RTN","TMGSELED",562,0) + . . kill @pSaveArray@(DispLineNum) +"RTN","TMGSELED",563,0) + . . set needsRepack=1 +"RTN","TMGSELED",564,0) + . write ! +"RTN","TMGSELED",565,0) + write ! +"RTN","TMGSELED",566,0) + ;"IMPORTANT NOTE: It seems that that after deleting items in pSaveArray, the ordering +"RTN","TMGSELED",567,0) + ;" gets out of sync, such that the display number is NOT the same as the index +"RTN","TMGSELED",568,0) + ;" and the wrong references can be used!!! Must renumber somehow... +"RTN","TMGSELED",569,0) + +"RTN","TMGSELED",570,0) + set %=2 +"RTN","TMGSELED",571,0) + write "Rescan file (slow)" +"RTN","TMGSELED",572,0) + do YN^DICN write ! +"RTN","TMGSELED",573,0) + if %=1 set result=2 goto SEDone +"RTN","TMGSELED",574,0) + if %=-1 goto SEDone +"RTN","TMGSELED",575,0) + +"RTN","TMGSELED",576,0) + write "Packing display list..." +"RTN","TMGSELED",577,0) + do ListPack^TMGMISC(pSaveArray) +"RTN","TMGSELED",578,0) + write ! +"RTN","TMGSELED",579,0) + +"RTN","TMGSELED",580,0) + goto SLoop +"RTN","TMGSELED",581,0) +SEDone +"RTN","TMGSELED",582,0) + quit result +"RTN","TMGSELED",583,0) + +"RTN","TMGSELED",584,0) +EditRecs(pList,Options,LookupFn) +"RTN","TMGSELED",585,0) + ;"Purpose: To get new values for display fields in records +"RTN","TMGSELED",586,0) + ;"Input: pList -- PASS BY NAME. A list of IENs to process +"RTN","TMGSELED",587,0) + ;" @pList@(IEN)=IgnoredValue +"RTN","TMGSELED",588,0) + ;" @pList@(IEN)=IgnoredValue +"RTN","TMGSELED",589,0) + ;" @pList@(IEN)=IgnoredValue +"RTN","TMGSELED",590,0) + ;" Options -- PASS BY REFERENCE. Format: +"RTN","TMGSELED",591,0) + ;" Options("FILE")=Filenumber^FileName +"RTN","TMGSELED",592,0) + ;" Options("FIELDS","MAX NUM")=MaxDisplaySequenceNumber +"RTN","TMGSELED",593,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored +"RTN","TMGSELED",594,0) + ;" Options("FIELDS",DisplaySequence)=FldNum^FldName^Width <-- Width is ignored +"RTN","TMGSELED",595,0) + ;" Options("FIELDS",DisplaySequence)=FldNum <-- FldName OPTIONAL +"RTN","TMGSELED",596,0) + ;" Options("FIELDS",DisplaySequence,"LOOKUP FN") -- OPTIONAL +"RTN","TMGSELED",597,0) + ;" A function for looking up new values. +"RTN","TMGSELED",598,0) + ;" Must be in format like this: +"RTN","TMGSELED",599,0) + ;" Options("FIELDS",DisplaySequence,"LOOKUP FN")="$$MyFn^MyModule(File,FldNum)" +"RTN","TMGSELED",600,0) + ;" i.e. must be a function name. Function may take passed +"RTN","TMGSELED",601,0) + ;" parameters 'File' and 'FldNum' +"RTN","TMGSELED",602,0) + ;" Default value="$$ValueLookup(File,FldNum)" +"RTN","TMGSELED",603,0) + ;" Options("FIELDS",DisplaySequence,"NO EDIT")=1 <-- indicates this field NOT to be edited. +"RTN","TMGSELED",604,0) + ;" Note: alternative Format +"RTN","TMGSELED",605,0) + ;" Options("FIELDS",DisplaySequence)=FldNum:FldNum2:FldNum3^Width +"RTN","TMGSELED",606,0) + ;" FldNum:FldNum2:FldNum3 means FldNum is ptr to file2, and +"RTN","TMGSELED",607,0) + ;" FldNum2 is in file2. This value is a pointer to file3, and +"RTN","TMGSELED",608,0) + ;" FldNum3 is a value in file3 +"RTN","TMGSELED",609,0) + ;" +"RTN","TMGSELED",610,0) + ;"Results: 1=OK to continue, 0 if error +"RTN","TMGSELED",611,0) + +"RTN","TMGSELED",612,0) + new result set result=0 ;"default to error +"RTN","TMGSELED",613,0) + new Menu,UsrSlct,MenuCount,FldCount,File +"RTN","TMGSELED",614,0) + new TMGFDA,TMGMSG +"RTN","TMGSELED",615,0) + set FldCount=+$get(Options("FIELDS","MAX NUM")) if FldCount=0 goto GNVDone +"RTN","TMGSELED",616,0) + set File=+$get(Options("FILE")) if File=0 goto GNVDone +"RTN","TMGSELED",617,0) + new LookupFn +"RTN","TMGSELED",618,0) + new DIR,FldNum,NewValue +"RTN","TMGSELED",619,0) + +"RTN","TMGSELED",620,0) +GNVL1 kill Menu +"RTN","TMGSELED",621,0) + set Menu(0)="Pick Field to EDIT" +"RTN","TMGSELED",622,0) + set MenuCount=1 +"RTN","TMGSELED",623,0) + for i=1:1:FldCount do +"RTN","TMGSELED",624,0) + . new CommonValue,FieldNum,FieldName +"RTN","TMGSELED",625,0) + . if $get(Options("FIELDS",i,"NO EDIT"))=1 quit ;"don't edit this field +"RTN","TMGSELED",626,0) + . set FieldNum=$piece($get(Options("FIELDS",i)),"^",1) +"RTN","TMGSELED",627,0) + . set FieldName=$piece($get(Options("FIELDS",i)),"^",2) +"RTN","TMGSELED",628,0) + . if FieldName="" set FieldName=$$GetFldName^TMGDBAPI(File,FieldNum) +"RTN","TMGSELED",629,0) + . set CommonValue=$$GetCommonValue(File,FieldNum,pList) +"RTN","TMGSELED",630,0) + . set Menu(MenuCount)=FieldName_": ["_CommonValue_"]"_$char(9)_i +"RTN","TMGSELED",631,0) + . set MenuCount=MenuCount+1 +"RTN","TMGSELED",632,0) + ;"set Menu(MenuCount)="Enter ^ to abort"_$char(9)_"^" +"RTN","TMGSELED",633,0) + +"RTN","TMGSELED",634,0) +GNVL2 +"RTN","TMGSELED",635,0) + set UsrSlct=$$Menu^TMGUSRIF(.Menu) +"RTN","TMGSELED",636,0) + ;"if FldCount>1 do +"RTN","TMGSELED",637,0) + ;". set UsrSlct=$$Menu^TMGUSRIF(.Menu) +"RTN","TMGSELED",638,0) + ;"else set UsrSlct=1 ;"If only 1 option, then auto-select +"RTN","TMGSELED",639,0) + if (UsrSlct="^")!(UsrSlct="") goto GWDone +"RTN","TMGSELED",640,0) + +"RTN","TMGSELED",641,0) + set LookupFn=$get(Options("FIELDS",UsrSlct,"LOOKUP FN"),"$$ValueLookup(File,FldNum)") +"RTN","TMGSELED",642,0) + +"RTN","TMGSELED",643,0) + kill DIR,NewValue +"RTN","TMGSELED",644,0) + set FldNum=+$piece($get(Options("FIELDS",UsrSlct)),"^",1) +"RTN","TMGSELED",645,0) + if FldNum=0 goto GNVDone +"RTN","TMGSELED",646,0) + +"RTN","TMGSELED",647,0) + set @("Y="_LookupFn) +"RTN","TMGSELED",648,0) + ;"write !,"Enter new value for field below." +"RTN","TMGSELED",649,0) + ;"set DIR(0)=File_","_FldNum +"RTN","TMGSELED",650,0) + ;"do ^DIR write ! +"RTN","TMGSELED",651,0) + +"RTN","TMGSELED",652,0) + if Y="" goto GNVL2 +"RTN","TMGSELED",653,0) + if Y="^" goto GNVDone +"RTN","TMGSELED",654,0) + set NewValue=$piece(Y,"^",1) +"RTN","TMGSELED",655,0) + if NewValue=+NewValue do +"RTN","TMGSELED",656,0) + . new array +"RTN","TMGSELED",657,0) + . do GetFieldInfo^TMGDBAPI(File,FldNum,"array") +"RTN","TMGSELED",658,0) + . if $get(array("SPECIFIER"))["S" quit ;"check if field is a SET, if so, don't add ` mark +"RTN","TMGSELED",659,0) + . set NewValue="`"_NewValue ;"indicate that number is a pointer +"RTN","TMGSELED",660,0) + +"RTN","TMGSELED",661,0) + new Itr,IEN,Value,results +"RTN","TMGSELED",662,0) + set result=1 +"RTN","TMGSELED",663,0) + set IEN=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGSELED",664,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="") +"RTN","TMGSELED",665,0) + . kill TMGFDA,TMGMSG +"RTN","TMGSELED",666,0) + . set TMGFDA(File,IEN_",",FldNum)=NewValue +"RTN","TMGSELED",667,0) + . do FILE^DIE("EK","TMGFDA","TMGMSG") +"RTN","TMGSELED",668,0) + . if $data(TMGMSG("DIERR")) do +"RTN","TMGSELED",669,0) + . . set result=0 +"RTN","TMGSELED",670,0) + . . new PriorErrorFound +"RTN","TMGSELED",671,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSELED",672,0) + +"RTN","TMGSELED",673,0) + goto GNVL1 +"RTN","TMGSELED",674,0) + +"RTN","TMGSELED",675,0) +GNVDone +"RTN","TMGSELED",676,0) + quit result +"RTN","TMGSELED",677,0) + +"RTN","TMGSELED",678,0) + +"RTN","TMGSELED",679,0) +ValueLookup(File,FldNum) +"RTN","TMGSELED",680,0) + ;"Purpose: To interact with user and obtain a value for field in file +"RTN","TMGSELED",681,0) + ;"Input: File: A valid file number +"RTN","TMGSELED",682,0) + ;" FldNum: A valid field number in File +"RTN","TMGSELED",683,0) + ;"Result: Returns value of user input. +"RTN","TMGSELED",684,0) + +"RTN","TMGSELED",685,0) + new DIR +"RTN","TMGSELED",686,0) + write !,"Enter new value for field below." +"RTN","TMGSELED",687,0) + set DIR(0)=File_","_FldNum +"RTN","TMGSELED",688,0) + do ^DIR write ! +"RTN","TMGSELED",689,0) + quit Y +"RTN","TMGSELED",690,0) + +"RTN","TMGSELED",691,0) + +"RTN","TMGSELED",692,0) +GetCommonValue(File,Field,pList,Flags) +"RTN","TMGSELED",693,0) + ;"Purpose: Return a value held by all records in pList, or "" if mixed values +"RTN","TMGSELED",694,0) + ;"Input: File -- file number +"RTN","TMGSELED",695,0) + ;" Field -- field number or 'num:num2:num3" etc +"RTN","TMGSELED",696,0) + ;" Flags -- value to pass to GET1^DIQ during lookup +"RTN","TMGSELED",697,0) + ;"Output: returns a common value, or "" if not common value +"RTN","TMGSELED",698,0) + +"RTN","TMGSELED",699,0) + new Itr,IEN,Value,abort,result +"RTN","TMGSELED",700,0) + set abort=0,result="" +"RTN","TMGSELED",701,0) + +"RTN","TMGSELED",702,0) + new Itr,IEN,Value,abort +"RTN","TMGSELED",703,0) + set abort=0 +"RTN","TMGSELED",704,0) + set IEN=$$ItrAInit^TMGITR(pList,.Itr) +"RTN","TMGSELED",705,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!(abort=1) +"RTN","TMGSELED",706,0) + . set Value=$$GET1^DIQ(File,IEN_",",Field) +"RTN","TMGSELED",707,0) + . if result="" set result=Value +"RTN","TMGSELED",708,0) + . if Value'=result set result="",abort=1 +"RTN","TMGSELED",709,0) + +"RTN","TMGSELED",710,0) + quit result +"RTN","TMGSELED",711,0) + +"RTN","TMGSELED",712,0) + +"RTN","TMGSELED",713,0) + +"RTN","TMGSEQL1") +0^74^B44760 +"RTN","TMGSEQL1",1,0) +TMGSEQL1 ;TMG/kst/Interface with SequelSystems PMS ;03/25/06 +"RTN","TMGSEQL1",2,0) + ;;1.0;TMG-LIB;**1**;01/09/06 +"RTN","TMGSEQL1",3,0) + +"RTN","TMGSEQL1",4,0) + ;"TMG SEQUEL IMPORT FUNCTIONS +"RTN","TMGSEQL1",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGSEQL1",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSEQL1",7,0) + ;"1-9-2006 +"RTN","TMGSEQL1",8,0) + +"RTN","TMGSEQL1",9,0) + +"RTN","TMGSEQL1",10,0) + ;"======================================================================= +"RTN","TMGSEQL1",11,0) + ;" API -- Public Functions. +"RTN","TMGSEQL1",12,0) + ;"======================================================================= +"RTN","TMGSEQL1",13,0) + ;"ASKIMPORT +"RTN","TMGSEQL1",14,0) + ;"RUNNOW provide an entry point for running import NOW. This will delete prior alerts +"RTN","TMGSEQL1",15,0) + ;"AUTOIN ;"entry point for scheduled task +"RTN","TMGSEQL1",16,0) + ;"QUIETIN +"RTN","TMGSEQL1",17,0) + +"RTN","TMGSEQL1",18,0) + ;"$$IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID) +"RTN","TMGSEQL1",19,0) + ;"$$IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChgLog,PrgCallback,UserID) +"RTN","TMGSEQL1",20,0) + +"RTN","TMGSEQL1",21,0) + ;"======================================================================= +"RTN","TMGSEQL1",22,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGSEQL1",23,0) + ;"======================================================================= +"RTN","TMGSEQL1",24,0) + ;"$$ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ) +"RTN","TMGSEQL1",25,0) + ;"$$ParseLine(OneLine,Array,SSNArray) +"RTN","TMGSEQL1",26,0) + ;"UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog) +"RTN","TMGSEQL1",27,0) + ;"$$InactivePt(PMSAcctNum,SSNArray) +"RTN","TMGSEQL1",28,0) + ;"$$InvalidProvider(SequelProvider) +"RTN","TMGSEQL1",29,0) + ;"$$InvalPtName(FName,LName) +"RTN","TMGSEQL1",30,0) + +"RTN","TMGSEQL1",31,0) + +"RTN","TMGSEQL1",32,0) + ;"======================================================================= +"RTN","TMGSEQL1",33,0) + ;"DEPENDENCIES +"RTN","TMGSEQL1",34,0) + ;"TMGIOUTL +"RTN","TMGSEQL1",35,0) + ;"TMGMISC +"RTN","TMGSEQL1",36,0) + ;"======================================================================= +"RTN","TMGSEQL1",37,0) + ;"======================================================================= +"RTN","TMGSEQL1",38,0) + +"RTN","TMGSEQL1",39,0) + +"RTN","TMGSEQL1",40,0) + +"RTN","TMGSEQL1",41,0) + ;"======================================================================= +"RTN","TMGSEQL1",42,0) + ;" Below are three custom files that are used by the TMGSEQL* code +"RTN","TMGSEQL1",43,0) + ;"======================================================================= +"RTN","TMGSEQL1",44,0) + +"RTN","TMGSEQL1",45,0) + +"RTN","TMGSEQL1",46,0) + ;"File: 22706 TMG DEMOGRAPHICS IMPORT ERRORS Branch: 1 +"RTN","TMGSEQL1",47,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1",48,0) + ;"=============================================================================== +"RTN","TMGSEQL1",49,0) + ;" 1 0;1 .01 ACCOUNT NUMBER [RNJ9,0] +"RTN","TMGSEQL1",50,0) + ;" 2 4;1 .02 CREATION DATE [D] +"RTN","TMGSEQL1",51,0) + ;" 3 4;2 .03 PATIENT NAME [F] +"RTN","TMGSEQL1",52,0) + ;" 4 0;2 1 MESSAGE [F] +"RTN","TMGSEQL1",53,0) + ;" 2;0 2 IMPORT DATA <-WP [22706.02] +"RTN","TMGSEQL1",54,0) + ;" 5 -0;1 .01 -IMPORT DATA [W] +"RTN","TMGSEQL1",55,0) + ;" 3;0 3 DIERR MESSAGE <-WP [22706.03] +"RTN","TMGSEQL1",56,0) + ;" 6 -0;1 .01 -DIERR MESSAGE [W] +"RTN","TMGSEQL1",57,0) + ;" 7 4;3 4 ALERT IEN [NJ9,0] +"RTN","TMGSEQL1",58,0) + ;" <> <> <> +"RTN","TMGSEQL1",59,0) + ;" A.) FILE NAME:------------- TMG DEMOGRAPHICS IMPORT ERRORS +"RTN","TMGSEQL1",60,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1",61,0) + ;" B.) FILE NUMBER:----------- 22706 DD______ @ +"RTN","TMGSEQL1",62,0) + ;" Read____ @ +"RTN","TMGSEQL1",63,0) + ;" C.) NUM OF FLDS:----------- 9 Write___ @ +"RTN","TMGSEQL1",64,0) + ;" Delete__ @ +"RTN","TMGSEQL1",65,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22706, Laygo___ @ +"RTN","TMGSEQL1",66,0) + ;" +"RTN","TMGSEQL1",67,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 76 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1",68,0) + ;"================================================================================ +"RTN","TMGSEQL1",69,0) + +"RTN","TMGSEQL1",70,0) + +"RTN","TMGSEQL1",71,0) + +"RTN","TMGSEQL1",72,0) + ;"File: 22707 TMG NAME SEX Branch: 1 +"RTN","TMGSEQL1",73,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1",74,0) + ;"=============================================================================== +"RTN","TMGSEQL1",75,0) + ;" 1 0;1 .01 FIRST NAME [RF] +"RTN","TMGSEQL1",76,0) + ;" 2 0;2 1 SEX [S] +"RTN","TMGSEQL1",77,0) + ;"<> <> <> +"RTN","TMGSEQL1",78,0) + ;" A.) FILE NAME:------------- TMG NAME SEX +"RTN","TMGSEQL1",79,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1",80,0) + ;" B.) FILE NUMBER:----------- 22707 DD______ @ +"RTN","TMGSEQL1",81,0) + ;" Read____ @ +"RTN","TMGSEQL1",82,0) + ;" C.) NUM OF FLDS:----------- 2 Write___ @ +"RTN","TMGSEQL1",83,0) + ;" Delete__ @ +"RTN","TMGSEQL1",84,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22707, Laygo___ @ +"RTN","TMGSEQL1",85,0) + ;" +"RTN","TMGSEQL1",86,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 698 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1",87,0) + ;"================================================================================ +"RTN","TMGSEQL1",88,0) + +"RTN","TMGSEQL1",89,0) + +"RTN","TMGSEQL1",90,0) + +"RTN","TMGSEQL1",91,0) + ;"File: 22711 TMG UPLOAD SETTINGS Branch: 1 +"RTN","TMGSEQL1",92,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1",93,0) + ;"=============================================================================== +"RTN","TMGSEQL1",94,0) + ;" 1 0;1 .01 NAME [RFX] +"RTN","TMGSEQL1",95,0) + ;" 2 0;2 1 DEBUG SHOW [NJ1,0X] +"RTN","TMGSEQL1",96,0) + ;" 3 1;1 1.1 DEBUG OUTPUT FILE [F] +"RTN","TMGSEQL1",97,0) + ;" 4 2;1 1.15 DEBUG OUTPUT PATH [F] +"RTN","TMGSEQL1",98,0) + ;" 5 1;2 1.2 DEBUG CUMULATIVE [NJ1,0] +"RTN","TMGSEQL1",99,0) + ;" 6 3;1 2 IMPORT DATAFILE NAME [F] +"RTN","TMGSEQL1",100,0) + ;" 7 5;1 2.1 IMPORT DATAFILE 2 NAME [F] +"RTN","TMGSEQL1",101,0) + ;" 8 4;1 2.5 IMPORT DATAFILE PATH [F] +"RTN","TMGSEQL1",102,0) + ;" 9 6;1 3 ALERT RECIPIENT <-Pntr [P200'] +"RTN","TMGSEQL1",103,0) + ;" 10 6;2 4 LAST IMPORT DATE [D] +"RTN","TMGSEQL1",104,0) + ;" 11 6;3 5 DELETE DATAFILE AFTER IMPORT? [S] +"RTN","TMGSEQL1",105,0) + ;" 12 6;4 6 PICK GENDER FROM NAME? [S] +"RTN","TMGSEQL1",106,0) + ;" 13 6;5 7 IMPORT FREQUENCY (IN HOURS) [NJ4,0] +"RTN","TMGSEQL1",107,0) + ;" <> <> <> +"RTN","TMGSEQL1",108,0) + ;" A.) FILE NAME:------------- TMG UPLOAD SETTINGS +"RTN","TMGSEQL1",109,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1",110,0) + ;" B.) FILE NUMBER:----------- 22711 DD______ @ +"RTN","TMGSEQL1",111,0) + ;" Read____ @ +"RTN","TMGSEQL1",112,0) + ;" C.) NUM OF FLDS:----------- 12 Write___ @ +"RTN","TMGSEQL1",113,0) + ;" Delete__ @ +"RTN","TMGSEQL1",114,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22711, Laygo___ @ +"RTN","TMGSEQL1",115,0) + ;" +"RTN","TMGSEQL1",116,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 1 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1",117,0) + ;"================================================================================ +"RTN","TMGSEQL1",118,0) + +"RTN","TMGSEQL1",119,0) + +"RTN","TMGSEQL1",120,0) + +"RTN","TMGSEQL1",121,0) + +"RTN","TMGSEQL1",122,0) +ASKIMPORT +"RTN","TMGSEQL1",123,0) + ;"Purpose: To ask user for filename and then import data. +"RTN","TMGSEQL1",124,0) + ;"Input: None +"RTN","TMGSEQL1",125,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1",126,0) + ;"Result: None +"RTN","TMGSEQL1",127,0) + +"RTN","TMGSEQL1",128,0) + new DiscardName +"RTN","TMGSEQL1",129,0) + new DefPath set DefPath="/tmp/" +"RTN","TMGSEQL1",130,0) + new DefFName set DefFName="demographics.csv" +"RTN","TMGSEQL1",131,0) + new DefF2Name set DefF2Name="demographics2.csv" +"RTN","TMGSEQL1",132,0) + new FPath,FName,F2Name +"RTN","TMGSEQL1",133,0) + new ErrArray,ChLog +"RTN","TMGSEQL1",134,0) + new result +"RTN","TMGSEQL1",135,0) + +"RTN","TMGSEQL1",136,0) + new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)" +"RTN","TMGSEQL1",137,0) + set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1" +"RTN","TMGSEQL1",138,0) + +"RTN","TMGSEQL1",139,0) + set DiscardName=$$GetFName^TMGIOUTL("Please enter file to import.",.DefPath,.DefFName,,.FPath,.FName) +"RTN","TMGSEQL1",140,0) + if DiscardName="" goto AIDone +"RTN","TMGSEQL1",141,0) + +"RTN","TMGSEQL1",142,0) + set DiscardName=$$GetFName^TMGIOUTL("Please enter 2nd file to import.",.DefPath,.DefF2Name,,.FPath,.F2Name) +"RTN","TMGSEQL1",143,0) + if DiscardName="" goto AIDone +"RTN","TMGSEQL1",144,0) + +"RTN","TMGSEQL1",145,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,.ErrArray,.ChLog,PrgsFn) +"RTN","TMGSEQL1",146,0) + +"RTN","TMGSEQL1",147,0) +AIDone +"RTN","TMGSEQL1",148,0) + quit +"RTN","TMGSEQL1",149,0) + +"RTN","TMGSEQL1",150,0) + +"RTN","TMGSEQL1",151,0) +RUNNOW +"RTN","TMGSEQL1",152,0) + ;"Purpose: To provide an entry point for running import NOW. This will delete prior alerts +"RTN","TMGSEQL1",153,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1",154,0) + ;"Output: None. Progress shown to console. The database should be updated +"RTN","TMGSEQL1",155,0) + ;"Results: none +"RTN","TMGSEQL1",156,0) + +"RTN","TMGSEQL1",157,0) + write !!,"Import Sequel Demographics Now...",! +"RTN","TMGSEQL1",158,0) + +"RTN","TMGSEQL1",159,0) + new FName,F2Name,FPath +"RTN","TMGSEQL1",160,0) + new result +"RTN","TMGSEQL1",161,0) + new ErrArray,ChLog +"RTN","TMGSEQL1",162,0) + new DelFiles +"RTN","TMGSEQL1",163,0) + new UserID +"RTN","TMGSEQL1",164,0) + +"RTN","TMGSEQL1",165,0) + set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME") +"RTN","TMGSEQL1",166,0) + set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME") +"RTN","TMGSEQL1",167,0) + set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH") +"RTN","TMGSEQL1",168,0) + set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I") +"RTN","TMGSEQL1",169,0) + set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1",170,0) + +"RTN","TMGSEQL1",171,0) + new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)" +"RTN","TMGSEQL1",172,0) + set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1" +"RTN","TMGSEQL1",173,0) + +"RTN","TMGSEQL1",174,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,,,PrgsFn,,DelFiles,UserID) +"RTN","TMGSEQL1",175,0) + +"RTN","TMGSEQL1",176,0) + quit +"RTN","TMGSEQL1",177,0) + +"RTN","TMGSEQL1",178,0) + +"RTN","TMGSEQL1",179,0) +AUTOIN +"RTN","TMGSEQL1",180,0) + ;"Purpose: To provide an entry point for a scheduled task. This will delete prior alerts +"RTN","TMGSEQL1",181,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1",182,0) + ;"Output: None. There should be no console output. The database should be updated +"RTN","TMGSEQL1",183,0) + ;"Results: none +"RTN","TMGSEQL1",184,0) + +"RTN","TMGSEQL1",185,0) + new InitTime set InitTime=$H +"RTN","TMGSEQL1",186,0) + +"RTN","TMGSEQL1",187,0) + new UserID set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1",188,0) + +"RTN","TMGSEQL1",189,0) + do ;"clear out 'next run task number' +"RTN","TMGSEQL1",190,0) + . new TMGFDA,TMGMSG +"RTN","TMGSEQL1",191,0) + . set TMGFDA(22711,"1,",8)="@" ;"#4 = TASK FOR NEXT RUN +"RTN","TMGSEQL1",192,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1",193,0) + +"RTN","TMGSEQL1",194,0) + new temp set temp=$$QuietClear^TMGSEQL3(UserID) ;"clear prior alerts & errors +"RTN","TMGSEQL1",195,0) + do QUIETIN ;" do import +"RTN","TMGSEQL1",196,0) + +"RTN","TMGSEQL1",197,0) + ;"Here I schedule the next task to run again. +"RTN","TMGSEQL1",198,0) + new HrInterval set HrInterval=$$GET1^DIQ(22711,"1,","IMPORT FREQUENCY (IN HOURS)","I") +"RTN","TMGSEQL1",199,0) + if +HrInterval>0 do +"RTN","TMGSEQL1",200,0) + . new time set time=$$HADD^XLFDT(InitTime,0,HrInterval,0) +"RTN","TMGSEQL1",201,0) + . new task set task=$$Schedule^TMGSEQL3(time,"AUTOIN^TMGSEQL1","Import of demographic data from Sequel billing system.") +"RTN","TMGSEQL1",202,0) + . ;"store 'next run task number' +"RTN","TMGSEQL1",203,0) + . set TMGFDA(22711,"1,",8)="`"_task ;"#4 = TASK FOR NEXT RUN +"RTN","TMGSEQL1",204,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1",205,0) + +"RTN","TMGSEQL1",206,0) + quit +"RTN","TMGSEQL1",207,0) + +"RTN","TMGSEQL1",208,0) + +"RTN","TMGSEQL1",209,0) +QUIETIN +"RTN","TMGSEQL1",210,0) + ;"Purpose: To import data based on settings, with no user interaction (in or out) +"RTN","TMGSEQL1",211,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1",212,0) + ;"Output: None. There should be no console output. The database should be updated +"RTN","TMGSEQL1",213,0) + ;"Results: none +"RTN","TMGSEQL1",214,0) + +"RTN","TMGSEQL1",215,0) + new FName,F2Name,FPath +"RTN","TMGSEQL1",216,0) + new result +"RTN","TMGSEQL1",217,0) + new ErrArray,ChLog +"RTN","TMGSEQL1",218,0) + new DelFiles +"RTN","TMGSEQL1",219,0) + new UserID +"RTN","TMGSEQL1",220,0) + +"RTN","TMGSEQL1",221,0) + set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME") +"RTN","TMGSEQL1",222,0) + set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME") +"RTN","TMGSEQL1",223,0) + set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH") +"RTN","TMGSEQL1",224,0) + set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I") +"RTN","TMGSEQL1",225,0) + set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1",226,0) + +"RTN","TMGSEQL1",227,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,,,,,DelFiles,UserID) +"RTN","TMGSEQL1",228,0) + +"RTN","TMGSEQL1",229,0) + quit +"RTN","TMGSEQL1",230,0) + +"RTN","TMGSEQL1",231,0) + +"RTN","TMGSEQL1",232,0) +IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID) +"RTN","TMGSEQL1",233,0) + ;"Purpose: To import data from file specified. +"RTN","TMGSEQL1",234,0) + ;"Input: FilePath: Path of file to input. +"RTN","TMGSEQL1",235,0) + ;" FileName: The Name of file of file to input. +"RTN","TMGSEQL1",236,0) + ;" Note: This is written to import a specific file +"RTN","TMGSEQL1",237,0) + ;" created by SequelMed Systems, filled with +"RTN","TMGSEQL1",238,0) + ;" patient demographics, in CVS format +"RTN","TMGSEQL1",239,0) + ;" Note: This file will be DELETED if DelFiles=1 +"RTN","TMGSEQL1",240,0) + ;" F2Name : the name of the second demographics file in input +"RTN","TMGSEQL1",241,0) + ;" The reason for 2 files is because Sequel doesn't report the SSN in the +"RTN","TMGSEQL1",242,0) + ;" primary demographics report. So a second report must be used, and these +"RTN","TMGSEQL1",243,0) + ;" two files are merged to provide complete patient demographics. +"RTN","TMGSEQL1",244,0) + ;" Note: This file will be DELETED if DelFiles=1 +"RTN","TMGSEQL1",245,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1",246,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1",247,0) + ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string +"RTN","TMGSEQL1",248,0) + ;" will be xecuted periodically, to allow display of a progress bar etc. +"RTN","TMGSEQL1",249,0) + ;" Note: the following variables with global scope will be declared and +"RTN","TMGSEQL1",250,0) + ;" available for use: TMGCUR (current count), TMGMAX (max count), +"RTN","TMGSEQL1",251,0) + ;" TMGSTART (the start time +"RTN","TMGSEQL1",252,0) + ;" External function can signal a request an abort by setting TMGABORT=1 +"RTN","TMGSEQL1",253,0) + ;" F2Path: OPTIONAL -- path of 2nd demographics file. Default=FilePath +"RTN","TMGSEQL1",254,0) + ;" DelFiles: OPTIONAL -- if 1, then source files (FileName and F2Name) are deleted after import +"RTN","TMGSEQL1",255,0) + ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ) +"RTN","TMGSEQL1",256,0) + ;"Note: I have learned that SequelMed billing system exports ALL patients in the primary +"RTN","TMGSEQL1",257,0) + ;" export file, including one that have been marked inactive do to invalid data etc. +"RTN","TMGSEQL1",258,0) + ;" Thus, while the second file (F2Name) has limited info, it contains the list of +"RTN","TMGSEQL1",259,0) + ;" ACTIVE patients. So if a name is not included in the 2nd file, then its info will +"RTN","TMGSEQL1",260,0) + ;" be ignored in the 1st file. +"RTN","TMGSEQL1",261,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1",262,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1",263,0) + +"RTN","TMGSEQL1",264,0) + new GRef,GRef1 +"RTN","TMGSEQL1",265,0) + new G2Ref,G2Ref1 +"RTN","TMGSEQL1",266,0) + new result +"RTN","TMGSEQL1",267,0) + +"RTN","TMGSEQL1",268,0) + set F2Path=$get(F2Path,FilePath) +"RTN","TMGSEQL1",269,0) + +"RTN","TMGSEQL1",270,0) + set GRef=$name(^TMP("TMG","SEQUELIMPORT","DATA",1,$J)) ;"I use this to process array +"RTN","TMGSEQL1",271,0) + set GRef1=$name(@GRef@(1)) ;"I use this to load file +"RTN","TMGSEQL1",272,0) + kill @GRef +"RTN","TMGSEQL1",273,0) + set result=$$FTG^%ZISH(FilePath,FileName,GRef1,6) ;"load file into a global +"RTN","TMGSEQL1",274,0) + if result=0 goto IFDONE +"RTN","TMGSEQL1",275,0) + +"RTN","TMGSEQL1",276,0) + set G2Ref=$name(^TMP("TMG","SEQUELIMPORT","DATA",2,$J)) ;"I use this to process array +"RTN","TMGSEQL1",277,0) + set G2Ref1=$name(@G2Ref@(1)) ;"I use this to load file +"RTN","TMGSEQL1",278,0) + kill @G2Ref +"RTN","TMGSEQL1",279,0) + set result=$$FTG^%ZISH(F2Path,F2Name,G2Ref1,6) ;"load file into a global +"RTN","TMGSEQL1",280,0) + if result=0 goto IFDONE +"RTN","TMGSEQL1",281,0) + +"RTN","TMGSEQL1",282,0) + set UserID=$get(UserID,+$get(DUZ)) +"RTN","TMGSEQL1",283,0) + +"RTN","TMGSEQL1",284,0) + set result=$$IMPORTGLOBAL(GRef,G2Ref,.ErrArray,.ChLog,.PrgCallback,UserID) +"RTN","TMGSEQL1",285,0) + +"RTN","TMGSEQL1",286,0) + ;"Note: @GRef, @G2Ref killed at end of $$IMPORTGLOBAL() +"RTN","TMGSEQL1",287,0) + +"RTN","TMGSEQL1",288,0) + do ;"record the current time as the time of last import +"RTN","TMGSEQL1",289,0) + . do NOW^%DTC +"RTN","TMGSEQL1",290,0) + . new TMGFDA,TMGMSG +"RTN","TMGSEQL1",291,0) + . set TMGFDA(22711,"1,",4)=% ;"#4 = LAST IMPORT DATE +"RTN","TMGSEQL1",292,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1",293,0) + +"RTN","TMGSEQL1",294,0) + if $get(DelFiles)=1 do +"RTN","TMGSEQL1",295,0) + . ;"Notice: After I implemented this, I realized that I have a permissions problem +"RTN","TMGSEQL1",296,0) + . ;" at my site... the uploaded files belong to the uploaded user, and deletion by +"RTN","TMGSEQL1",297,0) + . ;" this user is being blocked. I'll leave in for now... +"RTN","TMGSEQL1",298,0) + . new temp +"RTN","TMGSEQL1",299,0) + . set temp=$$DelFile^TMGIOUTL(FilePath_FileName) +"RTN","TMGSEQL1",300,0) + . set temp=$$DelFile^TMGIOUTL(F2Path_F2Name) +"RTN","TMGSEQL1",301,0) + +"RTN","TMGSEQL1",302,0) +IFDONE +"RTN","TMGSEQL1",303,0) + quit result +"RTN","TMGSEQL1",304,0) + +"RTN","TMGSEQL1",305,0) +IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChLog,PrgCallback,UserID) +"RTN","TMGSEQL1",306,0) + ;"Purpose: To import data from global specified. +"RTN","TMGSEQL1",307,0) + ;"Input: GRef -- the NAME of array holding the data to import (1st file) +"RTN","TMGSEQL1",308,0) + ;" Format: @GRef@(1)=OneLine +"RTN","TMGSEQL1",309,0) + ;" @GRef@(2)=OneLine .. etc. +"RTN","TMGSEQL1",310,0) + ;" Note: This is written to import a specific file +"RTN","TMGSEQL1",311,0) + ;" created by SequelMed Systems, filled with +"RTN","TMGSEQL1",312,0) + ;" patient demographics, in CVS format +"RTN","TMGSEQL1",313,0) + ;" Note: Array will be KILLED at the end of this function. +"RTN","TMGSEQL1",314,0) + ;" G2Ref -- the NAME of array holding the data to import (2nd file) +"RTN","TMGSEQL1",315,0) + ;" Note: Array will be KILLED at the end of this function. +"RTN","TMGSEQL1",316,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1",317,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1",318,0) + ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string +"RTN","TMGSEQL1",319,0) + ;" will be xecuted periodically, to allow display of a progress bar etc. +"RTN","TMGSEQL1",320,0) + ;" Note: the following variables with global scope will be declared and +"RTN","TMGSEQL1",321,0) + ;" available for use: TMGCUR (current count), TMGMAX (max count), +"RTN","TMGSEQL1",322,0) + ;" TMGSTART (the start time +"RTN","TMGSEQL1",323,0) + ;" External function can signal a request an abort by setting TMGABORT=1 +"RTN","TMGSEQL1",324,0) + ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ) +"RTN","TMGSEQL1",325,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1",326,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1",327,0) + +"RTN","TMGSEQL1",328,0) + new TMGInvalid ;"Will be used as a globally-scoped variable in the module +"RTN","TMGSEQL1",329,0) + new result set result=1 +"RTN","TMGSEQL1",330,0) + new delay set delay=0 +"RTN","TMGSEQL1",331,0) + new TMGCUR,TMGMAX,TMGSTART,TMGABORT ;"avail for PrgCallback function +"RTN","TMGSEQL1",332,0) + set TMGABORT=0 +"RTN","TMGSEQL1",333,0) + set TMGMAX=+$order(@GRef@(""),-1) +"RTN","TMGSEQL1",334,0) + set TMGSTART=$H ;"store starting time. +"RTN","TMGSEQL1",335,0) + set UserID=$get(UserID,+$get(DUZ)) +"RTN","TMGSEQL1",336,0) + +"RTN","TMGSEQL1",337,0) + new SSNArray +"RTN","TMGSEQL1",338,0) + do XtractSSNum(G2Ref,.SSNArray) +"RTN","TMGSEQL1",339,0) + +"RTN","TMGSEQL1",340,0) + set TMGCUR=$order(@GRef@("")) +"RTN","TMGSEQL1",341,0) + if TMGCUR'="" for do quit:(TMGCUR="")!(TMGABORT=1) +"RTN","TMGSEQL1",342,0) + . new OneLine +"RTN","TMGSEQL1",343,0) + . set OneLine=$get(@GRef@(TMGCUR)) +"RTN","TMGSEQL1",344,0) + . set result=$$ProcessPt(OneLine,.ErrArray,.ChgLog,.SSNArray,UserID) +"RTN","TMGSEQL1",345,0) + . set delay=delay+1 +"RTN","TMGSEQL1",346,0) + . if (delay>30),$get(PrgCallback)'="" do ;"update progress bar every 30 cycles +"RTN","TMGSEQL1",347,0) + . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGSEQL1",348,0) + . . xecute PrgCallback ;"call the specified progress code. +"RTN","TMGSEQL1",349,0) + . . set delay=0 +"RTN","TMGSEQL1",350,0) + . set TMGCUR=$order(@GRef@(TMGCUR)) +"RTN","TMGSEQL1",351,0) + +"RTN","TMGSEQL1",352,0) + kill @GRef +"RTN","TMGSEQL1",353,0) + kill @G2Ref +"RTN","TMGSEQL1",354,0) + quit result +"RTN","TMGSEQL1",355,0) + +"RTN","TMGSEQL1",356,0) + +"RTN","TMGSEQL1",357,0) + +"RTN","TMGSEQL1",358,0) +ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ,InputFn) +"RTN","TMGSEQL1",359,0) + ;"Purpose: To process one line from patient demographics file. +"RTN","TMGSEQL1",360,0) + ;"Input: OneLine-- One line from CVS demographics file. +"RTN","TMGSEQL1",361,0) + ;" Format is as follows, *** all on one line (comma delimited) +"RTN","TMGSEQL1",362,0) + ;" 01- patient_seq_num, +"RTN","TMGSEQL1",363,0) + ;" 02- facility_short_name, +"RTN","TMGSEQL1",364,0) + ;" 03- pat_last_name, +"RTN","TMGSEQL1",365,0) + ;" 04- pat_first_name, +"RTN","TMGSEQL1",366,0) + ;" 05- pat_account_num, +"RTN","TMGSEQL1",367,0) + ;" 06- pat_address, +"RTN","TMGSEQL1",368,0) + ;" 07- state, +"RTN","TMGSEQL1",369,0) + ;" 08- resp_last_name, +"RTN","TMGSEQL1",370,0) + ;" 09- resp_first_name, +"RTN","TMGSEQL1",371,0) + ;" 10- facility_seq_num, +"RTN","TMGSEQL1",372,0) + ;" 11- register_date, +"RTN","TMGSEQL1",373,0) + ;" 12- location_name, +"RTN","TMGSEQL1",374,0) + ;" 13- city, +"RTN","TMGSEQL1",375,0) + ;" 14- provider_short_name, +"RTN","TMGSEQL1",376,0) + ;" 15- zipcode, +"RTN","TMGSEQL1",377,0) + ;" 16- class_name, +"RTN","TMGSEQL1",378,0) + ;" 17- pat_dob, +"RTN","TMGSEQL1",379,0) + ;" 18- ref_prov_short_name, +"RTN","TMGSEQL1",380,0) + ;" 19- pat_tel_num, +"RTN","TMGSEQL1",381,0) + ;" 20- last_visit_days, +"RTN","TMGSEQL1",382,0) + ;" 21- name, +"RTN","TMGSEQL1",383,0) + ;" 22- description +"RTN","TMGSEQL1",384,0) + ;" ADDENDUM: +"RTN","TMGSEQL1",385,0) + ;" sometimes SEX will be appended to line. Format: +"RTN","TMGSEQL1",386,0) + ;" previous data^MALE or previous data^FEMALE +"RTN","TMGSEQL1",387,0) + ;" sometimes SSN will be appended to line. Format: +"RTN","TMGSEQL1",388,0) + ;" previous data^(sex)^SSNUM +"RTN","TMGSEQL1",389,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1",390,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1",391,0) + ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers, +"RTN","TMGSEQL1",392,0) + ;" as created by XtractSSNum() +"RTN","TMGSEQL1",393,0) + ;" DUZ: The user who will recieve alerts of errors +"RTN","TMGSEQL1",394,0) + ;" InputFn: OPTIONAL-- the name of a function to turn parse on csv line +"RTN","TMGSEQL1",395,0) + ;" default value is "ParseLine" +"RTN","TMGSEQL1",396,0) + ;" e.g. "MyFn" or "MyFn^MyRoutine". Must take same params as ParseLine +"RTN","TMGSEQL1",397,0) + ;" This will allow this code to be used on a variety of .csv files, with +"RTN","TMGSEQL1",398,0) + ;" different data-formats--each one with its own parser funtion. +"RTN","TMGSEQL1",399,0) + ;"Output: Data is put into database, if it is not there already. +"RTN","TMGSEQL1",400,0) + ;"Result: 1=OK To continue; 0=abort or bad data +"RTN","TMGSEQL1",401,0) + +"RTN","TMGSEQL1",402,0) + new XFn +"RTN","TMGSEQL1",403,0) + new PtInfo,OneErrArray +"RTN","TMGSEQL1",404,0) + new result set result=1 +"RTN","TMGSEQL1",405,0) + new AutoRegister set AutoRegister=1 +"RTN","TMGSEQL1",406,0) + set InputFn=$get(InputFn,"ParseLine") +"RTN","TMGSEQL1",407,0) + +"RTN","TMGSEQL1",408,0) + set XFn="set result=$$"_InputFn_"(.OneLine,.PtInfo,.SSNArray)" +"RTN","TMGSEQL1",409,0) + xecute XFn ;"old -- set result=$$ParseLine(.OneLine,.PtInfo,.SSNArray) +"RTN","TMGSEQL1",410,0) + if result'>0 goto PPtDone +"RTN","TMGSEQL1",411,0) + if $get(PtInfo("FACILITY"))="SAMPLE" goto PPtDone +"RTN","TMGSEQL1",412,0) + +"RTN","TMGSEQL1",413,0) + if $$UpdateDB(.PtInfo,AutoRegister,.OneErrArray,.ChgLog)=0 do +"RTN","TMGSEQL1",414,0) + . new count set count=+$get(ErrArray)+1 +"RTN","TMGSEQL1",415,0) + . set ErrArray=count +"RTN","TMGSEQL1",416,0) + . set ErrArray(count)=OneLine +"RTN","TMGSEQL1",417,0) + . merge ErrArray(count,"INFO")=OneErrArray +"RTN","TMGSEQL1",418,0) + . ;"------ +"RTN","TMGSEQL1",419,0) + . do AlertError^TMGSEQL2(OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL1",420,0) + +"RTN","TMGSEQL1",421,0) +PPtDone +"RTN","TMGSEQL1",422,0) + quit result +"RTN","TMGSEQL1",423,0) + +"RTN","TMGSEQL1",424,0) + +"RTN","TMGSEQL1",425,0) +ParseLine(OneLine,Array,SSNArray) +"RTN","TMGSEQL1",426,0) + ;"Purpose: To process one line from patient demographics file. +"RTN","TMGSEQL1",427,0) + ;" Also gets data into an acceptible format. +"RTN","TMGSEQL1",428,0) + ;"Input: OneLine -- One line from CVS demographics file. (Format as per ProcessPt) +"RTN","TMGSEQL1",429,0) + ;" NOTE: if PASSED BY REFERENCE, then line may be altered such that SSN is +"RTN","TMGSEQL1",430,0) + ;" added as a 3rd piece, using ^ as a delimiter. (2nd piece used elsewhere +"RTN","TMGSEQL1",431,0) + ;" to store sex. +"RTN","TMGSEQL1",432,0) + ;" When processing line, if SSNArray doesn't provide a SSN for patient, then +"RTN","TMGSEQL1",433,0) + ;" this 3rd piece can provide the SSN +"RTN","TMGSEQL1",434,0) + ;" Array -- PASS BY REFERENCE. And OUT parameter. Any prior data killed. +"RTN","TMGSEQL1",435,0) + ;" Note: uses TMGInvalid (globally scoped var defined in this module) +"RTN","TMGSEQL1",436,0) + ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers, +"RTN","TMGSEQL1",437,0) + ;" as created by XtractSSNum() +"RTN","TMGSEQL1",438,0) + ;"Output: Array is filled with Format as follows (note not all data used): +"RTN","TMGSEQL1",439,0) + ;" Array("FACILITY"), to hold 02- facility_short_name +"RTN","TMGSEQL1",440,0) + ;" Array("LAST NAME"), to hold 03- pat_last_name, +"RTN","TMGSEQL1",441,0) + ;" Array("FIRST NAME"), to hold 04- pat_first_name, +"RTN","TMGSEQL1",442,0) + ;" Array("PMS ACCOUNT NUM"), to hold 05- pat_account_num, +"RTN","TMGSEQL1",443,0) + ;" Array("ADDRESS1"), to hold 06- pat_address, +"RTN","TMGSEQL1",444,0) + ;" Array("ADDRESS2"), to hold 06- pat_address, +"RTN","TMGSEQL1",445,0) + ;" Array("ADDRESS3"), to hold 06- pat_address, +"RTN","TMGSEQL1",446,0) + ;" Array("STATE"), to hold 07- state, +"RTN","TMGSEQL1",447,0) + ;" Array("RESP LAST NAME"), to hold 08- resp_last_name, +"RTN","TMGSEQL1",448,0) + ;" Array("RESP FIRST NAME"), to hold 09- resp_first_name, +"RTN","TMGSEQL1",449,0) + ;" Array("CITY"), to hold 13- city, +"RTN","TMGSEQL1",450,0) + ;" Array("PROVIDER"), to hold 14- provider_short_name, +"RTN","TMGSEQL1",451,0) + ;" Array("ZIP CODE"), to hold 15- zipcode, +"RTN","TMGSEQL1",452,0) + ;" Array("DOB"), to hold 17- pat_dob, +"RTN","TMGSEQL1",453,0) + ;" Array("PHONE NUM"), to hold 19- pat_tel_num, +"RTN","TMGSEQL1",454,0) + ;" Array("SEX"), to hold Patient sex, if provided. +"RTN","TMGSEQL1",455,0) + ;" Array("SSNUM")=Social security number +"RTN","TMGSEQL1",456,0) + ;" Array("FULL NAME")=FIRSTNAME LASTNAME (DOB) +"RTN","TMGSEQL1",457,0) + ;" Array("FULL NAME2")=LASTNAME,FIRSTNAME (DOB) +"RTN","TMGSEQL1",458,0) + ;" Array("FULL NAME3")=LASTNAME,FIRSTNAME +"RTN","TMGSEQL1",459,0) + ;"Result: 1=OK To continue; 0=abort or bad data; -1 skip, but don't store as error +"RTN","TMGSEQL1",460,0) + +"RTN","TMGSEQL1",461,0) + new temp +"RTN","TMGSEQL1",462,0) + new result set result=1 +"RTN","TMGSEQL1",463,0) + +"RTN","TMGSEQL1",464,0) + set OneLine=$translate($get(OneLine),"""","'") ;" convert " to ' to avoid fileman error +"RTN","TMGSEQL1",465,0) + +"RTN","TMGSEQL1",466,0) + kill Array +"RTN","TMGSEQL1",467,0) + set Array("FACILITY")=$piece(OneLine,",",2) +"RTN","TMGSEQL1",468,0) + set Array("LAST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",3)) +"RTN","TMGSEQL1",469,0) + set Array("FIRST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",4)) +"RTN","TMGSEQL1",470,0) + set Array("PMS ACCOUNT NUM")=$piece(OneLine,",",5) +"RTN","TMGSEQL1",471,0) + set Array("ADDRESS1")=$piece(OneLine,",",6) +"RTN","TMGSEQL1",472,0) + set Array("STATE")=$piece(OneLine,",",7) +"RTN","TMGSEQL1",473,0) + set Array("RESP LAST NAME")=$piece(OneLine,",",8) +"RTN","TMGSEQL1",474,0) + set Array("RESP FIRST NAME")=$piece(OneLine,",",9) +"RTN","TMGSEQL1",475,0) + set Array("CITY")=$$Trim^TMGSTUTL($piece(OneLine,",",13),"""") +"RTN","TMGSEQL1",476,0) + set Array("PROVIDER")=$piece(OneLine,",",14) +"RTN","TMGSEQL1",477,0) + set Array("ZIP CODE")=$piece(OneLine,",",15) +"RTN","TMGSEQL1",478,0) + new DOB set DOB=$piece(OneLine,",",17) +"RTN","TMGSEQL1",479,0) + set DOB=$$Trim^TMGSTUTL(DOB) +"RTN","TMGSEQL1",480,0) + set DOB=$piece(DOB," ",1) ;" '03/09/05 00:00' --> '03/09/05' +"RTN","TMGSEQL1",481,0) + set Array("DOB")=DOB +"RTN","TMGSEQL1",482,0) + set Array("PHONE NUM")=$piece(OneLine,",",19) +"RTN","TMGSEQL1",483,0) + set Array("SEX")=$piece(OneLine,"^",2) +"RTN","TMGSEQL1",484,0) + +"RTN","TMGSEQL1",485,0) + set Array("FULL NAME")=Array("FIRST NAME")_" "_Array("LAST NAME")_" ("_Array("DOB")_")" +"RTN","TMGSEQL1",486,0) + set Array("FULL NAME2")=Array("LAST NAME")_","_Array("FIRST NAME")_" ("_Array("DOB")_")" +"RTN","TMGSEQL1",487,0) + set Array("FULL NAME3")=Array("LAST NAME")_","_Array("FIRST NAME") +"RTN","TMGSEQL1",488,0) + +"RTN","TMGSEQL1",489,0) + ;"do a lookup on abreviattion for ALL states, convert to external format +"RTN","TMGSEQL1",490,0) + new DIC,X,Y +"RTN","TMGSEQL1",491,0) + set DIC=5 ;"STATE file +"RTN","TMGSEQL1",492,0) + set DIC(0)="M" +"RTN","TMGSEQL1",493,0) + set X=Array("STATE") +"RTN","TMGSEQL1",494,0) + do ^DIC +"RTN","TMGSEQL1",495,0) + set Array("STATE")=$piece(Y,"^",2) +"RTN","TMGSEQL1",496,0) + +"RTN","TMGSEQL1",497,0) + ;"convert Sequel format to VistA format +"RTN","TMGSEQL1",498,0) + if Array("PROVIDER")'="" do +"RTN","TMGSEQL1",499,0) + . set Array("PROVIDER")=$$ConvProvider(Array("PROVIDER")) +"RTN","TMGSEQL1",500,0) + if Array("PROVIDER")="SKIP" set result=0 goto PLDone +"RTN","TMGSEQL1",501,0) + +"RTN","TMGSEQL1",502,0) + ;" VistA address allows for: +"RTN","TMGSEQL1",503,0) + ;" .111 -- address line 1 +"RTN","TMGSEQL1",504,0) + ;" .112 -- address line 2 +"RTN","TMGSEQL1",505,0) + ;" .113 -- address line 3 +"RTN","TMGSEQL1",506,0) + ;" BUT, each line must be 3-35 characters +"RTN","TMGSEQL1",507,0) + ;" Sequel puts this all on one line. +"RTN","TMGSEQL1",508,0) + ;" SO, I need to divide the Sequel line if not 3-35 +"RTN","TMGSEQL1",509,0) + new value set value=Array("ADDRESS1") +"RTN","TMGSEQL1",510,0) + if $length(value)'<35 do +"RTN","TMGSEQL1",511,0) + . new s1,s2 +"RTN","TMGSEQL1",512,0) + . do NiceSplit^TMGSTUTL(value,35,.s1,.s2,3) +"RTN","TMGSEQL1",513,0) + . set Array("ADDRESS1")=s1 +"RTN","TMGSEQL1",514,0) + . if $length(s2)'<35 do +"RTN","TMGSEQL1",515,0) + . . do NiceSplit^TMGSTUTL(s1,35,.s1,.s2,3) +"RTN","TMGSEQL1",516,0) + . . set Array("ADDRESS2")=s1 ;"<-- is this correct? +"RTN","TMGSEQL1",517,0) + . . if s2'="" set Array("ADDRESS3")=$extract(s2,1,35) +"RTN","TMGSEQL1",518,0) + . else set Array("ADDRESS2")=s2 +"RTN","TMGSEQL1",519,0) + +"RTN","TMGSEQL1",520,0) + ;"Ensure proper length of city. +"RTN","TMGSEQL1",521,0) + set Array("CITY")=$extract(Array("CITY"),1,15) +"RTN","TMGSEQL1",522,0) + if $length(Array("CITY"))=1 set Array("CITY")=Array("CITY")_" " +"RTN","TMGSEQL1",523,0) + +"RTN","TMGSEQL1",524,0) + ;"Ensure proper length of phone +"RTN","TMGSEQL1",525,0) + if $length(Array("PHONE NUM"))<7 kill Array("PHONE NUM") +"RTN","TMGSEQL1",526,0) + +"RTN","TMGSEQL1",527,0) + new AcctNum set AcctNum=$get(Array("PMS ACCOUNT NUM")) +"RTN","TMGSEQL1",528,0) + new SSNum set SSNum=$get(SSNArray(AcctNum)) +"RTN","TMGSEQL1",529,0) + if SSNum=999999999 set SSNum=0 +"RTN","TMGSEQL1",530,0) + if +SSNum=0 do ;"see if 3rd ^ piece holds SSNum data +"RTN","TMGSEQL1",531,0) + . set SSNum=$piece(OneLine,"^",3) ;"note this won't overwrite valid data from SSNArray() +"RTN","TMGSEQL1",532,0) + if SSNum>0 do +"RTN","TMGSEQL1",533,0) + . set Array("SSNUM")=SSNum +"RTN","TMGSEQL1",534,0) + . set $piece(OneLine,"^",3)=SSNum +"RTN","TMGSEQL1",535,0) + +"RTN","TMGSEQL1",536,0) + if result'=0 do +"RTN","TMGSEQL1",537,0) + . if $$InvalPtName(Array("FIRST NAME"),Array("LAST NAME"))=1 set result=-1 quit +"RTN","TMGSEQL1",538,0) + . if $$InactivePt(Array("PMS ACCOUNT NUM"),.SSNArray)=1 do +"RTN","TMGSEQL1",539,0) +xx . . set result=-1 +"RTN","TMGSEQL1",540,0) + . . ;"write !,"Skipping: ",Array("FULL NAME3"),! ;"temp +"RTN","TMGSEQL1",541,0) + +"RTN","TMGSEQL1",542,0) +PLDone +"RTN","TMGSEQL1",543,0) + quit result +"RTN","TMGSEQL1",544,0) + +"RTN","TMGSEQL1",545,0) + +"RTN","TMGSEQL1",546,0) +ConvProvider(SequelProvider) +"RTN","TMGSEQL1",547,0) + ;"Purpose: To convert Sequel provider shortname to VistA file 200 name. +"RTN","TMGSEQL1",548,0) + ;"Input: SequelProvider +"RTN","TMGSEQL1",549,0) + ;"Result: VistA provider name (string), or "" if not found, or "SKIP" if not to be used +"RTN","TMGSEQL1",550,0) + +"RTN","TMGSEQL1",551,0) + new result set result="" +"RTN","TMGSEQL1",552,0) + +"RTN","TMGSEQL1",553,0) + if $$InvalidProvider(SequelProvider) set result="SKIP" goto ConPrDone +"RTN","TMGSEQL1",554,0) + if SequelProvider="SAMPLE" set result="SKIP" goto ConPrDone +"RTN","TMGSEQL1",555,0) + +"RTN","TMGSEQL1",556,0) + +"RTN","TMGSEQL1",557,0) + new TMGARRAY,TMGMSG +"RTN","TMGSEQL1",558,0) + do FIND^DIC(200,,".01",,SequelProvider,"*","TMG",,,"TMGARRAY","TMGMSG") +"RTN","TMGSEQL1",559,0) + if +TMGARRAY("DILIST",0)>0 do +"RTN","TMGSEQL1",560,0) + . set result=TMGARRAY("DILIST",1,1) +"RTN","TMGSEQL1",561,0) + else do +"RTN","TMGSEQL1",562,0) + . new DIC +"RTN","TMGSEQL1",563,0) + . set DIC=200 +"RTN","TMGSEQL1",564,0) + . ;"try converting name and doing quiet lookup (KTOPPEN->TOPPEN,K) +"RTN","TMGSEQL1",565,0) + . set X=$extract(SequelProvider,2,99)_","_$extract(SequelProvider,1) +"RTN","TMGSEQL1",566,0) + . do ^DIC +"RTN","TMGSEQL1",567,0) + . if (+Y=-1)&(1=0) do ;"<--- FEATURE TURNED OFF. If not found, don't ask (no longer needed) +"RTN","TMGSEQL1",568,0) + . . if $data(TMGInvalid(SequelProvider))'=0 quit +"RTN","TMGSEQL1",569,0) + . . write !,"Please help match the Sequel 'shortname' to a VistA provider name.",! +"RTN","TMGSEQL1",570,0) + . . write "This should have to be done only once.",! +"RTN","TMGSEQL1",571,0) + . . write "Enter ^ if the provider name is not valid.",! +"RTN","TMGSEQL1",572,0) + . . write "Please enter VistA provider name for: '",SequelProvider,"'",! +"RTN","TMGSEQL1",573,0) + . . set DIC(0)="AEQM" +"RTN","TMGSEQL1",574,0) + . . do ^DIC +"RTN","TMGSEQL1",575,0) + . . write ! +"RTN","TMGSEQL1",576,0) + . if +Y>-1 do +"RTN","TMGSEQL1",577,0) + . . new DFN set DFN=+Y +"RTN","TMGSEQL1",578,0) + . . new TMGFDA set TMGFDA(200,DFN_",",22702)=SequelProvider +"RTN","TMGSEQL1",579,0) + . . kill TMGMSG +"RTN","TMGSEQL1",580,0) + . . do FILE^DIE(,"TMGFDA","TMGMSG") ;"ignore errors +"RTN","TMGSEQL1",581,0) + . . set result=$piece(Y,"^",2) +"RTN","TMGSEQL1",582,0) + . else do +"RTN","TMGSEQL1",583,0) + . . set TMGInvalid(SequelProvider)="" +"RTN","TMGSEQL1",584,0) +ConPrDone +"RTN","TMGSEQL1",585,0) + quit result +"RTN","TMGSEQL1",586,0) + +"RTN","TMGSEQL1",587,0) + +"RTN","TMGSEQL1",588,0) +InvalPtName(FName,LName) +"RTN","TMGSEQL1",589,0) + ;"Purpose: To determine if the Patient name is invalid (i.e. CAP TOPPENBERG, or INSURANCE INSURANCE etc.) +"RTN","TMGSEQL1",590,0) + ;"Input: FName,LName -- the first and last names +"RTN","TMGSEQL1",591,0) + ;"Result: 1 if name is invalid, 0 if OK name +"RTN","TMGSEQL1",592,0) + +"RTN","TMGSEQL1",593,0) + new result set result=0 +"RTN","TMGSEQL1",594,0) + +"RTN","TMGSEQL1",595,0) + if FName="CAP" do ;"screen out 'CAP TOPPENBERG' etc ?? entries ?? +"RTN","TMGSEQL1",596,0) + . new DIC set DIC=200 +"RTN","TMGSEQL1",597,0) + . set DIC(0)="M" +"RTN","TMGSEQL1",598,0) + . set X=LName +"RTN","TMGSEQL1",599,0) + . do ^DIC +"RTN","TMGSEQL1",600,0) + . if +Y>0 set result=1 +"RTN","TMGSEQL1",601,0) + +"RTN","TMGSEQL1",602,0) + if (FName="INSURANCE")&(LName="INSURANCE") set result=1 +"RTN","TMGSEQL1",603,0) + +"RTN","TMGSEQL1",604,0) + quit result +"RTN","TMGSEQL1",605,0) + +"RTN","TMGSEQL1",606,0) + +"RTN","TMGSEQL1",607,0) +InactivePt(PMSAcctNum,SSNArray) +"RTN","TMGSEQL1",608,0) + ;"Purpose: to determine if patient is inactive, and should be skipped. +"RTN","TMGSEQL1",609,0) + ;" This is determined by testing for existence of AccountNumber in SSNArray. +"RTN","TMGSEQL1",610,0) + ;" SSNArray is created from the 2nd demographics file. This is a list of ACTIVE patients, +"RTN","TMGSEQL1",611,0) + ;" which is different from the 1st demographics file--which holds ALL patients. +"RTN","TMGSEQL1",612,0) + ;"Input: PMSAcctNum -- as stored in PtInfo("PMS ACCOUNT NUM") +"RTN","TMGSEQL1",613,0) + ;" SSNArray: PASS BY REFERENCE. An array with social security numbers, as created by XtractSSNum() +"RTN","TMGSEQL1",614,0) + ;"Result: 1 if patient is INACTIVE, and should be skipped. +"RTN","TMGSEQL1",615,0) + ;" 0 if OK to use +"RTN","TMGSEQL1",616,0) + +"RTN","TMGSEQL1",617,0) + new result +"RTN","TMGSEQL1",618,0) + set result=+$get(SSNArray(PMSAcctNum))'>0 +"RTN","TMGSEQL1",619,0) + quit result +"RTN","TMGSEQL1",620,0) + +"RTN","TMGSEQL1",621,0) + +"RTN","TMGSEQL1",622,0) +InvalidProvider(SequelProvider) +"RTN","TMGSEQL1",623,0) + ;"Purpose: To return if provider should not be used (i.e. cause data to be skipped) +"RTN","TMGSEQL1",624,0) + ;"Input: SequelProvider +"RTN","TMGSEQL1",625,0) + ;"Result: 0: OK to use provider +"RTN","TMGSEQL1",626,0) + ;" 1: Don't use provider +"RTN","TMGSEQL1",627,0) + +"RTN","TMGSEQL1",628,0) + new result set result=0 +"RTN","TMGSEQL1",629,0) + +"RTN","TMGSEQL1",630,0) + if SequelProvider="SAMPLE" set result=1 +"RTN","TMGSEQL1",631,0) + if SequelProvider="GREENEVILLE" set result=1 +"RTN","TMGSEQL1",632,0) + if SequelProvider="AFOSTER" set result=1 +"RTN","TMGSEQL1",633,0) + if SequelProvider="AFTON" set result=1 +"RTN","TMGSEQL1",634,0) + if SequelProvider="JWRIGHT" set result=1 ;"not an active provider +"RTN","TMGSEQL1",635,0) + ;"These providers are leaving group, so don't import their data. +"RTN","TMGSEQL1",636,0) + if SequelProvider="CPERRY" set result=1 +"RTN","TMGSEQL1",637,0) + if SequelProvider="OSWARNER" set result=1 +"RTN","TMGSEQL1",638,0) + if SequelProvider="SGILES" set result=1 +"RTN","TMGSEQL1",639,0) + if SequelProvider="SPENNY" set result=1 +"RTN","TMGSEQL1",640,0) + if SequelProvider="TFULLER" set result=1 +"RTN","TMGSEQL1",641,0) + +"RTN","TMGSEQL1",642,0) + quit result +"RTN","TMGSEQL1",643,0) + +"RTN","TMGSEQL1",644,0) + +"RTN","TMGSEQL1",645,0) +UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog) +"RTN","TMGSEQL1",646,0) + ;"Purpose: To put that data from the PtInfo array into the database (if needed) +"RTN","TMGSEQL1",647,0) + ;"Input: PtInfo -- array (PASS BY REFERENCE), with the following items being used: +"RTN","TMGSEQL1",648,0) + ;" PtInfo("LAST NAME"), to hold 03- pat_last_name, +"RTN","TMGSEQL1",649,0) + ;" PtInfo("FIRST NAME"), to hold 04- pat_first_name, +"RTN","TMGSEQL1",650,0) + ;" PtInfo("PMS ACCOUNT NUM") ----> field 22701 (custom field) +"RTN","TMGSEQL1",651,0) + ;" PtInfo("ADDRESS") ----> field .111 +"RTN","TMGSEQL1",652,0) + ;" PtInfo("STATE") ----> field .115 +"RTN","TMGSEQL1",653,0) + ;" PtInfo("CITY") ----> field .114 +"RTN","TMGSEQL1",654,0) + ;" PtInfo("ZIP CODE") ----> field .1112 +"RTN","TMGSEQL1",655,0) + ;" PtInfo("PHONE NUM") ----> field .131 +"RTN","TMGSEQL1",656,0) + ;" PtInfo("PROVIDER") ----> field .1041 +"RTN","TMGSEQL1",657,0) + ;" PtInfo("SSNUM") ----> field .09 +"RTN","TMGSEQL1",658,0) + ;" AutoRegister: if 1, then patient will be automatically added/registered +"RTN","TMGSEQL1",659,0) + ;" ErrArray -- PASS BY REFERENCE. And OUT parameter to get back error info. +"RTN","TMGSEQL1",660,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1",661,0) + ;"Output: Data is put into database, if it is not there already. +"RTN","TMGSEQL1",662,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1",663,0) + +"RTN","TMGSEQL1",664,0) + new Entry +"RTN","TMGSEQL1",665,0) + new result set result=1 +"RTN","TMGSEQL1",666,0) + new Name,TMGDOB,DFN +"RTN","TMGSEQL1",667,0) + new TMGARRAY,TMGMSG +"RTN","TMGSEQL1",668,0) + new PriorErrorFound +"RTN","TMGSEQL1",669,0) + new NewInfo +"RTN","TMGSEQL1",670,0) + new IENS +"RTN","TMGSEQL1",671,0) + new index +"RTN","TMGSEQL1",672,0) + kill ErrArray +"RTN","TMGSEQL1",673,0) + new TMGDEBUG set TMGDEBUG=-1 ;"//EXTRA QUIET mode --> shut down TMGDBAPI messages +"RTN","TMGSEQL1",674,0) + +"RTN","TMGSEQL1",675,0) + +"RTN","TMGSEQL1",676,0) + ;"NOTE: I need to have some method such that IF a patient is positively matched +"RTN","TMGSEQL1",677,0) + ;" (i.e. via SSNUM or PMS Account number), THEN changes in spelling of name, or +"RTN","TMGSEQL1",678,0) + ;" DOB on Sequel side should be reflected in VistA. Currently, I don't this +"RTN","TMGSEQL1",679,0) + ;" this happens. +"RTN","TMGSEQL1",680,0) + +"RTN","TMGSEQL1",681,0) + new Fields +"RTN","TMGSEQL1",682,0) + set Fields(22701)="PMS ACCOUNT NUM" +"RTN","TMGSEQL1",683,0) + set Fields(.111)="ADDRESS1" +"RTN","TMGSEQL1",684,0) + set Fields(.112)="ADDRESS2" +"RTN","TMGSEQL1",685,0) + set Fields(.113)="ADDRESS3" +"RTN","TMGSEQL1",686,0) + set Fields(.115)="STATE" +"RTN","TMGSEQL1",687,0) + set Fields(.114)="CITY" +"RTN","TMGSEQL1",688,0) + set Fields(.1112)="ZIP CODE" +"RTN","TMGSEQL1",689,0) + set Fields(.131)="PHONE NUM" +"RTN","TMGSEQL1",690,0) + set Fields(.1041)="PROVIDER" +"RTN","TMGSEQL1",691,0) + set Fields(.02)="SEX" +"RTN","TMGSEQL1",692,0) + set Fields(.09)="SSNUM" +"RTN","TMGSEQL1",693,0) + set Fields="22701;.111;.112;.113;.115;.114;.1112;.131;.1041;.09" +"RTN","TMGSEQL1",694,0) + +"RTN","TMGSEQL1",695,0) + set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME")) +"RTN","TMGSEQL1",696,0) + set Name=$$FormatName^TMGMISC(Name) +"RTN","TMGSEQL1",697,0) + set TMGDOB=$get(PtInfo("DOB")) +"RTN","TMGSEQL1",698,0) + +"RTN","TMGSEQL1",699,0) + set Entry(.01)=Name +"RTN","TMGSEQL1",700,0) + set Entry(.03)=TMGDOB +"RTN","TMGSEQL1",701,0) + if $get(PtInfo("SEX"))'="" set Entry(.02)=$get(PtInfo("SEX")) +"RTN","TMGSEQL1",702,0) + set Entry(.09)=$get(PtInfo("SSNUM")) +"RTN","TMGSEQL1",703,0) + +"RTN","TMGSEQL1",704,0) + set DFN=$$GetDFN(.PtInfo) +"RTN","TMGSEQL1",705,0) + +"RTN","TMGSEQL1",706,0) + if (DFN=0)&($get(AutoRegister)=1) do +"RTN","TMGSEQL1",707,0) + . set ErrArray=-1 ;"extra quiet mode. +"RTN","TMGSEQL1",708,0) + . if $get(Entry(.02))="" do ;"autopick gender if missing +"RTN","TMGSEQL1",709,0) + . . new AutoPick +"RTN","TMGSEQL1",710,0) + . . set AutoPick=$$GET1^DIQ(22711,"1,","PICK GENDER FROM NAME?","I") +"RTN","TMGSEQL1",711,0) + . . if AutoPick'=1 quit +"RTN","TMGSEQL1",712,0) + . . set Entry(.02)=$$GetSex^TMGSEQL2($get(PtInfo("FIRST NAME"))) +"RTN","TMGSEQL1",713,0) + . ;"OK, can't find, so will add new patient. +"RTN","TMGSEQL1",714,0) + . set DFN=+$$AddNewPt^TMGGDFN(.Entry,.ErrArray) +"RTN","TMGSEQL1",715,0) + . if DFN'=0 set ChLog(Name_" "_TMGDOB,0)="ADDED PATIENT: "_Name_" "_TMGDOB +"RTN","TMGSEQL1",716,0) + if DFN=0 do goto UDBDone ;"failure +"RTN","TMGSEQL1",717,0) + . set result=0 +"RTN","TMGSEQL1",718,0) + . set ErrArray(0)=$$NameError^TMGSEQL2(.ErrArray) ;"get name if DIERR encountered. +"RTN","TMGSEQL1",719,0) + . if ErrArray(0)["DOB" do +"RTN","TMGSEQL1",720,0) + . . ;"write !,"DOB error found for: ",PtInfo("FULL NAME"),! +"RTN","TMGSEQL1",721,0) + . if ErrArray(0)="" do +"RTN","TMGSEQL1",722,0) + . . set ErrArray(0)="PATIENT NOT IN DATABASE:" ;"if changed, also change in TMGSEQL2.m +"RTN","TMGSEQL1",723,0) + set IENS=DFN_"," +"RTN","TMGSEQL1",724,0) + +"RTN","TMGSEQL1",725,0) + ;"use DFN(IEN in file 2) to get data into database +"RTN","TMGSEQL1",726,0) + do GETS^DIQ(2,IENS,Fields,"","TMGARRAY","TMGMSG") +"RTN","TMGSEQL1",727,0) + +"RTN","TMGSEQL1",728,0) + ;"check for errors. +"RTN","TMGSEQL1",729,0) + if $data(TMGMSG("DIERR"))'=0 do goto UDBDone +"RTN","TMGSEQL1",730,0) + . set result=0 +"RTN","TMGSEQL1",731,0) + . merge ErrArray=TMGMSG("DIERR") +"RTN","TMGSEQL1",732,0) + . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL1",733,0) + kill TMGMSG +"RTN","TMGSEQL1",734,0) + +"RTN","TMGSEQL1",735,0) + ;"If any data in data base differs from Array, setup NewInfo +"RTN","TMGSEQL1",736,0) + new UpdateNeeded set UpdateNeeded=0 +"RTN","TMGSEQL1",737,0) + new abort set abort=0 +"RTN","TMGSEQL1",738,0) + set index=$order(Fields("")) +"RTN","TMGSEQL1",739,0) + for do quit:(+index'>0)!(abort=1) +"RTN","TMGSEQL1",740,0) + . new field set field=Fields(index) +"RTN","TMGSEQL1",741,0) + . if $data(PtInfo(field)),$get(TMGARRAY(2,IENS,index))'=$get(PtInfo(field)) do +"RTN","TMGSEQL1",742,0) + . . new value set value=$get(PtInfo(field)) +"RTN","TMGSEQL1",743,0) + . . if index=.1112 do +"RTN","TMGSEQL1",744,0) + . . . if +value'=0 set NewInfo(index)=value +"RTN","TMGSEQL1",745,0) + . . else if (index=.09)&(+value'=0)&(+TMGARRAY(2,IENS,index)'=0) do +"RTN","TMGSEQL1",746,0) + . . . if TMGARRAY(2,IENS,index)["P" do quit +"RTN","TMGSEQL1",747,0) + . . . . set NewInfo(index)=value +"RTN","TMGSEQL1",748,0) + . . . ;"we have CONFLICTING SOCIAL SECURITY NUMBERS --> PROBLEM... +"RTN","TMGSEQL1",749,0) + . . . set ErrArray(0)="CONFLICTING SS-NUMBERS: " ;"NOTE! if error message format is changed, also change in TMGSEQL2 +"RTN","TMGSEQL1",750,0) + . . . set ErrArray(0)=ErrArray(0)_"Sequel#="_PtInfo(field)_" vs. VistA#="_TMGARRAY(2,IENS,index) +"RTN","TMGSEQL1",751,0) + . . . set abort=1,result=0 +"RTN","TMGSEQL1",752,0) + . . else set NewInfo(index)=value +"RTN","TMGSEQL1",753,0) + . . set UpdateNeeded=1 +"RTN","TMGSEQL1",754,0) + . set index=$order(Fields(index)) +"RTN","TMGSEQL1",755,0) + +"RTN","TMGSEQL1",756,0) + if (UpdateNeeded=0)!(abort=1) goto UDBDone +"RTN","TMGSEQL1",757,0) + +"RTN","TMGSEQL1",758,0) + ;"Setup FDA array for database update +"RTN","TMGSEQL1",759,0) + new TMGFDA +"RTN","TMGSEQL1",760,0) + set index=$order(NewInfo("")) +"RTN","TMGSEQL1",761,0) + if index'="" do +"RTN","TMGSEQL1",762,0) + . for do quit:(+index'>0) +"RTN","TMGSEQL1",763,0) + . . set TMGFDA(2,IENS,index)=NewInfo(index) +"RTN","TMGSEQL1",764,0) + . . set index=$order(NewInfo(index)) +"RTN","TMGSEQL1",765,0) + . ; +"RTN","TMGSEQL1",766,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") +"RTN","TMGSEQL1",767,0) + . if $data(TMGMSG("DIERR"))'=0 do ;"goto UDBDone +"RTN","TMGSEQL1",768,0) + . . set result=0 +"RTN","TMGSEQL1",769,0) + . . merge ErrArray=TMGMSG("DIERR") +"RTN","TMGSEQL1",770,0) + +"RTN","TMGSEQL1",771,0) + merge ChLog($get(Name,"?")_" "_$get(TMGDOB,"?"),1)=NewInfo +"RTN","TMGSEQL1",772,0) + +"RTN","TMGSEQL1",773,0) +UDBDone +"RTN","TMGSEQL1",774,0) + quit result +"RTN","TMGSEQL1",775,0) + +"RTN","TMGSEQL1",776,0) + +"RTN","TMGSEQL1",777,0) +GetDFN(PtInfo) +"RTN","TMGSEQL1",778,0) + ;"Purpose: Serve as interface to ^TMGGDFN functions (using PtInfo as input) +"RTN","TMGSEQL1",779,0) + ;"Input: PtInfo, Array of PtInfo, as defined in UpdateDB, and created by ParseLine +"RTN","TMGSEQL1",780,0) + ;"Result: the IEN in file 2 (i.e. DFN) if found, otherwise 0 if not found. +"RTN","TMGSEQL1",781,0) + +"RTN","TMGSEQL1",782,0) + new Entry,Name,DOB,DFN +"RTN","TMGSEQL1",783,0) + +"RTN","TMGSEQL1",784,0) + set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME")) +"RTN","TMGSEQL1",785,0) + set Name=$$FormatName^TMGMISC(Name) +"RTN","TMGSEQL1",786,0) + set DOB=$get(PtInfo("DOB")) +"RTN","TMGSEQL1",787,0) + +"RTN","TMGSEQL1",788,0) + set Entry(.01)=Name +"RTN","TMGSEQL1",789,0) + set Entry(.03)=DOB +"RTN","TMGSEQL1",790,0) + set Entry(.02)=$get(PtInfo("SEX")) +"RTN","TMGSEQL1",791,0) + set Entry(.09)=$get(PtInfo("SSNUM")) +"RTN","TMGSEQL1",792,0) + set DFN=+$$LookupPatient^TMGGDFN(.Entry) ;"get IEN in file 2 of patient +"RTN","TMGSEQL1",793,0) + ;"do an extended search with increasing intensity. +"RTN","TMGSEQL1",794,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,1) +"RTN","TMGSEQL1",795,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,2) +"RTN","TMGSEQL1",796,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,3) +"RTN","TMGSEQL1",797,0) + +"RTN","TMGSEQL1",798,0) + quit DFN +"RTN","TMGSEQL1",799,0) + +"RTN","TMGSEQL1",800,0) + +"RTN","TMGSEQL1",801,0) + +"RTN","TMGSEQL1",802,0) +XtractSSNum(G2Ref,SSNArray) +"RTN","TMGSEQL1",803,0) + ;"Purpose: To extract info from 2nd demographics file into an array of SSNums. +"RTN","TMGSEQL1",804,0) + ;"Input: G2Ref - Name of global array holding 2nd demographics file +"RTN","TMGSEQL1",805,0) + ;" Note: Format of each line is as follows: +"RTN","TMGSEQL1",806,0) + ;" scratchNum,AccountNumber,LastName,FirstName,SSNUM ... (other data is redundant) +"RTN","TMGSEQL1",807,0) + ;" i.e. SSNUM is the 5th piece +"RTN","TMGSEQL1",808,0) + ;" SSNArray -- PASS BY REFERENCE. An OUT parameter. See format below +"RTN","TMGSEQL1",809,0) + ;"Output: SSNArray will be filled as follows: +"RTN","TMGSEQL1",810,0) + ;" SSNArray(SequelAccountNumber)=SSNum +"RTN","TMGSEQL1",811,0) + ;"Result: None +"RTN","TMGSEQL1",812,0) + ;"Note: 3/2/06 modification: +"RTN","TMGSEQL1",813,0) + ;" An entry for every SequelAccountNumber will be created. If SSNum is invalid, it will +"RTN","TMGSEQL1",814,0) + ;" be converted to 0, but an entry will still be created, i.e. +"RTN","TMGSEQL1",815,0) + ;" SSNArray(SequelAccountNumber)=0 +"RTN","TMGSEQL1",816,0) + +"RTN","TMGSEQL1",817,0) + +"RTN","TMGSEQL1",818,0) + new i +"RTN","TMGSEQL1",819,0) + +"RTN","TMGSEQL1",820,0) + set i=$order(@G2Ref@("")) +"RTN","TMGSEQL1",821,0) + if i'="" for do quit:(i="") +"RTN","TMGSEQL1",822,0) + . new OneLine,AcctNum,SSNum +"RTN","TMGSEQL1",823,0) + . set OneLine=$get(@G2Ref@(i)) +"RTN","TMGSEQL1",824,0) + . set AcctNum=$piece(OneLine,",",2) +"RTN","TMGSEQL1",825,0) + . set SSNum=$$Trim^TMGSTUTL($piece(OneLine,",",5)) +"RTN","TMGSEQL1",826,0) + . new value set value=0 ;"default value +"RTN","TMGSEQL1",827,0) + . if +SSNum'<999999 do ;"force at least 6 digits --> allow 0000 11 1111 +"RTN","TMGSEQL1",828,0) + . . if $length(SSNum)'=9 do +"RTN","TMGSEQL1",829,0) + . . . set SSNArray("ERRORS",AcctNum)=SSNum ;"leaves value="" --> not used +"RTN","TMGSEQL1",830,0) + . . else do +"RTN","TMGSEQL1",831,0) + . . . ;"set SSNArray(AcctNum)=SSNum +"RTN","TMGSEQL1",832,0) + . . . set value=SSNum +"RTN","TMGSEQL1",833,0) + . set SSNArray(AcctNum)=value +"RTN","TMGSEQL1",834,0) + . set i=$order(@G2Ref@(i)) +"RTN","TMGSEQL1",835,0) + +"RTN","TMGSEQL1",836,0) + quit +"RTN","TMGSEQL1",837,0) + +"RTN","TMGSEQL1",838,0) + +"RTN","TMGSEQL1B") +0^75^B44760 +"RTN","TMGSEQL1B",1,0) +TMGSEQL1 ;TMG/kst/Interface with SequelSystems PMS ;03/25/06 +"RTN","TMGSEQL1B",2,0) + ;;1.0;TMG-LIB;**1**;01/09/06 +"RTN","TMGSEQL1B",3,0) + +"RTN","TMGSEQL1B",4,0) + ;"TMG SEQUEL IMPORT FUNCTIONS +"RTN","TMGSEQL1B",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGSEQL1B",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSEQL1B",7,0) + ;"1-9-2006 +"RTN","TMGSEQL1B",8,0) + +"RTN","TMGSEQL1B",9,0) + +"RTN","TMGSEQL1B",10,0) + ;"======================================================================= +"RTN","TMGSEQL1B",11,0) + ;" API -- Public Functions. +"RTN","TMGSEQL1B",12,0) + ;"======================================================================= +"RTN","TMGSEQL1B",13,0) + ;"ASKIMPORT +"RTN","TMGSEQL1B",14,0) + ;"RUNNOW provide an entry point for running import NOW. This will delete prior alerts +"RTN","TMGSEQL1B",15,0) + ;"AUTOIN ;"entry point for scheduled task +"RTN","TMGSEQL1B",16,0) + ;"QUIETIN +"RTN","TMGSEQL1B",17,0) + +"RTN","TMGSEQL1B",18,0) + ;"$$IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID) +"RTN","TMGSEQL1B",19,0) + ;"$$IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChgLog,PrgCallback,UserID) +"RTN","TMGSEQL1B",20,0) + +"RTN","TMGSEQL1B",21,0) + ;"======================================================================= +"RTN","TMGSEQL1B",22,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGSEQL1B",23,0) + ;"======================================================================= +"RTN","TMGSEQL1B",24,0) + ;"$$ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ) +"RTN","TMGSEQL1B",25,0) + ;"$$ParseLine(OneLine,Array,SSNArray) +"RTN","TMGSEQL1B",26,0) + ;"UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog) +"RTN","TMGSEQL1B",27,0) + ;"$$InactivePt(PMSAcctNum,SSNArray) +"RTN","TMGSEQL1B",28,0) + ;"$$InvalidProvider(SequelProvider) +"RTN","TMGSEQL1B",29,0) + ;"$$InvalPtName(FName,LName) +"RTN","TMGSEQL1B",30,0) + +"RTN","TMGSEQL1B",31,0) + +"RTN","TMGSEQL1B",32,0) + ;"======================================================================= +"RTN","TMGSEQL1B",33,0) + ;"DEPENDENCIES +"RTN","TMGSEQL1B",34,0) + ;"TMGIOUTL +"RTN","TMGSEQL1B",35,0) + ;"TMGMISC +"RTN","TMGSEQL1B",36,0) + ;"======================================================================= +"RTN","TMGSEQL1B",37,0) + ;"======================================================================= +"RTN","TMGSEQL1B",38,0) + +"RTN","TMGSEQL1B",39,0) + +"RTN","TMGSEQL1B",40,0) + +"RTN","TMGSEQL1B",41,0) + ;"======================================================================= +"RTN","TMGSEQL1B",42,0) + ;" Below are three custom files that are used by the TMGSEQL* code +"RTN","TMGSEQL1B",43,0) + ;"======================================================================= +"RTN","TMGSEQL1B",44,0) + +"RTN","TMGSEQL1B",45,0) + +"RTN","TMGSEQL1B",46,0) + ;"File: 22706 TMG DEMOGRAPHICS IMPORT ERRORS Branch: 1 +"RTN","TMGSEQL1B",47,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1B",48,0) + ;"=============================================================================== +"RTN","TMGSEQL1B",49,0) + ;" 1 0;1 .01 ACCOUNT NUMBER [RNJ9,0] +"RTN","TMGSEQL1B",50,0) + ;" 2 4;1 .02 CREATION DATE [D] +"RTN","TMGSEQL1B",51,0) + ;" 3 4;2 .03 PATIENT NAME [F] +"RTN","TMGSEQL1B",52,0) + ;" 4 0;2 1 MESSAGE [F] +"RTN","TMGSEQL1B",53,0) + ;" 2;0 2 IMPORT DATA <-WP [22706.02] +"RTN","TMGSEQL1B",54,0) + ;" 5 -0;1 .01 -IMPORT DATA [W] +"RTN","TMGSEQL1B",55,0) + ;" 3;0 3 DIERR MESSAGE <-WP [22706.03] +"RTN","TMGSEQL1B",56,0) + ;" 6 -0;1 .01 -DIERR MESSAGE [W] +"RTN","TMGSEQL1B",57,0) + ;" 7 4;3 4 ALERT IEN [NJ9,0] +"RTN","TMGSEQL1B",58,0) + ;" <> <> <> +"RTN","TMGSEQL1B",59,0) + ;" A.) FILE NAME:------------- TMG DEMOGRAPHICS IMPORT ERRORS +"RTN","TMGSEQL1B",60,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1B",61,0) + ;" B.) FILE NUMBER:----------- 22706 DD______ @ +"RTN","TMGSEQL1B",62,0) + ;" Read____ @ +"RTN","TMGSEQL1B",63,0) + ;" C.) NUM OF FLDS:----------- 9 Write___ @ +"RTN","TMGSEQL1B",64,0) + ;" Delete__ @ +"RTN","TMGSEQL1B",65,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22706, Laygo___ @ +"RTN","TMGSEQL1B",66,0) + ;" +"RTN","TMGSEQL1B",67,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 76 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1B",68,0) + ;"================================================================================ +"RTN","TMGSEQL1B",69,0) + +"RTN","TMGSEQL1B",70,0) + +"RTN","TMGSEQL1B",71,0) + +"RTN","TMGSEQL1B",72,0) + ;"File: 22707 TMG NAME SEX Branch: 1 +"RTN","TMGSEQL1B",73,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1B",74,0) + ;"=============================================================================== +"RTN","TMGSEQL1B",75,0) + ;" 1 0;1 .01 FIRST NAME [RF] +"RTN","TMGSEQL1B",76,0) + ;" 2 0;2 1 SEX [S] +"RTN","TMGSEQL1B",77,0) + ;"<> <> <> +"RTN","TMGSEQL1B",78,0) + ;" A.) FILE NAME:------------- TMG NAME SEX +"RTN","TMGSEQL1B",79,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1B",80,0) + ;" B.) FILE NUMBER:----------- 22707 DD______ @ +"RTN","TMGSEQL1B",81,0) + ;" Read____ @ +"RTN","TMGSEQL1B",82,0) + ;" C.) NUM OF FLDS:----------- 2 Write___ @ +"RTN","TMGSEQL1B",83,0) + ;" Delete__ @ +"RTN","TMGSEQL1B",84,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22707, Laygo___ @ +"RTN","TMGSEQL1B",85,0) + ;" +"RTN","TMGSEQL1B",86,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 698 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1B",87,0) + ;"================================================================================ +"RTN","TMGSEQL1B",88,0) + +"RTN","TMGSEQL1B",89,0) + +"RTN","TMGSEQL1B",90,0) + +"RTN","TMGSEQL1B",91,0) + ;"File: 22711 TMG UPLOAD SETTINGS Branch: 1 +"RTN","TMGSEQL1B",92,0) + ;"REF NODE;PIECE FLD NUM FIELD NAME +"RTN","TMGSEQL1B",93,0) + ;"=============================================================================== +"RTN","TMGSEQL1B",94,0) + ;" 1 0;1 .01 NAME [RFX] +"RTN","TMGSEQL1B",95,0) + ;" 2 0;2 1 DEBUG SHOW [NJ1,0X] +"RTN","TMGSEQL1B",96,0) + ;" 3 1;1 1.1 DEBUG OUTPUT FILE [F] +"RTN","TMGSEQL1B",97,0) + ;" 4 2;1 1.15 DEBUG OUTPUT PATH [F] +"RTN","TMGSEQL1B",98,0) + ;" 5 1;2 1.2 DEBUG CUMULATIVE [NJ1,0] +"RTN","TMGSEQL1B",99,0) + ;" 6 3;1 2 IMPORT DATAFILE NAME [F] +"RTN","TMGSEQL1B",100,0) + ;" 7 5;1 2.1 IMPORT DATAFILE 2 NAME [F] +"RTN","TMGSEQL1B",101,0) + ;" 8 4;1 2.5 IMPORT DATAFILE PATH [F] +"RTN","TMGSEQL1B",102,0) + ;" 9 6;1 3 ALERT RECIPIENT <-Pntr [P200'] +"RTN","TMGSEQL1B",103,0) + ;" 10 6;2 4 LAST IMPORT DATE [D] +"RTN","TMGSEQL1B",104,0) + ;" 11 6;3 5 DELETE DATAFILE AFTER IMPORT? [S] +"RTN","TMGSEQL1B",105,0) + ;" 12 6;4 6 PICK GENDER FROM NAME? [S] +"RTN","TMGSEQL1B",106,0) + ;" 13 6;5 7 IMPORT FREQUENCY (IN HOURS) [NJ4,0] +"RTN","TMGSEQL1B",107,0) + ;" <> <> <> +"RTN","TMGSEQL1B",108,0) + ;" A.) FILE NAME:------------- TMG UPLOAD SETTINGS +"RTN","TMGSEQL1B",109,0) + ;" F.) FILE ACCESS: +"RTN","TMGSEQL1B",110,0) + ;" B.) FILE NUMBER:----------- 22711 DD______ @ +"RTN","TMGSEQL1B",111,0) + ;" Read____ @ +"RTN","TMGSEQL1B",112,0) + ;" C.) NUM OF FLDS:----------- 12 Write___ @ +"RTN","TMGSEQL1B",113,0) + ;" Delete__ @ +"RTN","TMGSEQL1B",114,0) + ;" D.) DATA GLOBAL:----------- ^TMG(22711, Laygo___ @ +"RTN","TMGSEQL1B",115,0) + ;" +"RTN","TMGSEQL1B",116,0) + ;" E.) TOTAL GLOBAL ENTRIES:-- 1 G.) PRINTING STATUS:-- Off +"RTN","TMGSEQL1B",117,0) + ;"================================================================================ +"RTN","TMGSEQL1B",118,0) + +"RTN","TMGSEQL1B",119,0) + +"RTN","TMGSEQL1B",120,0) + +"RTN","TMGSEQL1B",121,0) + +"RTN","TMGSEQL1B",122,0) +ASKIMPORT +"RTN","TMGSEQL1B",123,0) + ;"Purpose: To ask user for filename and then import data. +"RTN","TMGSEQL1B",124,0) + ;"Input: None +"RTN","TMGSEQL1B",125,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1B",126,0) + ;"Result: None +"RTN","TMGSEQL1B",127,0) + +"RTN","TMGSEQL1B",128,0) + new DiscardName +"RTN","TMGSEQL1B",129,0) + new DefPath set DefPath="/tmp/" +"RTN","TMGSEQL1B",130,0) + new DefFName set DefFName="demographics.csv" +"RTN","TMGSEQL1B",131,0) + new DefF2Name set DefF2Name="demographics2.csv" +"RTN","TMGSEQL1B",132,0) + new FPath,FName,F2Name +"RTN","TMGSEQL1B",133,0) + new ErrArray,ChLog +"RTN","TMGSEQL1B",134,0) + new result +"RTN","TMGSEQL1B",135,0) + +"RTN","TMGSEQL1B",136,0) + new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)" +"RTN","TMGSEQL1B",137,0) + set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1" +"RTN","TMGSEQL1B",138,0) + +"RTN","TMGSEQL1B",139,0) + set DiscardName=$$GetFName^TMGIOUTL("Please enter file to import.",.DefPath,.DefFName,,.FPath,.FName) +"RTN","TMGSEQL1B",140,0) + if DiscardName="" goto AIDone +"RTN","TMGSEQL1B",141,0) + +"RTN","TMGSEQL1B",142,0) + set DiscardName=$$GetFName^TMGIOUTL("Please enter 2nd file to import.",.DefPath,.DefF2Name,,.FPath,.F2Name) +"RTN","TMGSEQL1B",143,0) + if DiscardName="" goto AIDone +"RTN","TMGSEQL1B",144,0) + +"RTN","TMGSEQL1B",145,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,.ErrArray,.ChLog,PrgsFn) +"RTN","TMGSEQL1B",146,0) + +"RTN","TMGSEQL1B",147,0) +AIDone +"RTN","TMGSEQL1B",148,0) + quit +"RTN","TMGSEQL1B",149,0) + +"RTN","TMGSEQL1B",150,0) + +"RTN","TMGSEQL1B",151,0) +RUNNOW +"RTN","TMGSEQL1B",152,0) + ;"Purpose: To provide an entry point for running import NOW. This will delete prior alerts +"RTN","TMGSEQL1B",153,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1B",154,0) + ;"Output: None. Progress shown to console. The database should be updated +"RTN","TMGSEQL1B",155,0) + ;"Results: none +"RTN","TMGSEQL1B",156,0) + +"RTN","TMGSEQL1B",157,0) + write !!,"Import Sequel Demographics Now...",! +"RTN","TMGSEQL1B",158,0) + +"RTN","TMGSEQL1B",159,0) + new FName,F2Name,FPath +"RTN","TMGSEQL1B",160,0) + new result +"RTN","TMGSEQL1B",161,0) + new ErrArray,ChLog +"RTN","TMGSEQL1B",162,0) + new DelFiles +"RTN","TMGSEQL1B",163,0) + new UserID +"RTN","TMGSEQL1B",164,0) + +"RTN","TMGSEQL1B",165,0) + set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME") +"RTN","TMGSEQL1B",166,0) + set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME") +"RTN","TMGSEQL1B",167,0) + set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH") +"RTN","TMGSEQL1B",168,0) + set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I") +"RTN","TMGSEQL1B",169,0) + set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1B",170,0) + +"RTN","TMGSEQL1B",171,0) + new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)" +"RTN","TMGSEQL1B",172,0) + set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1" +"RTN","TMGSEQL1B",173,0) + +"RTN","TMGSEQL1B",174,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,,,PrgsFn,,DelFiles,UserID) +"RTN","TMGSEQL1B",175,0) + +"RTN","TMGSEQL1B",176,0) + quit +"RTN","TMGSEQL1B",177,0) + +"RTN","TMGSEQL1B",178,0) + +"RTN","TMGSEQL1B",179,0) +AUTOIN +"RTN","TMGSEQL1B",180,0) + ;"Purpose: To provide an entry point for a scheduled task. This will delete prior alerts +"RTN","TMGSEQL1B",181,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1B",182,0) + ;"Output: None. There should be no console output. The database should be updated +"RTN","TMGSEQL1B",183,0) + ;"Results: none +"RTN","TMGSEQL1B",184,0) + +"RTN","TMGSEQL1B",185,0) + new InitTime set InitTime=$H +"RTN","TMGSEQL1B",186,0) + +"RTN","TMGSEQL1B",187,0) + new UserID set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1B",188,0) + +"RTN","TMGSEQL1B",189,0) + do ;"clear out 'next run task number' +"RTN","TMGSEQL1B",190,0) + . new TMGFDA,TMGMSG +"RTN","TMGSEQL1B",191,0) + . set TMGFDA(22711,"1,",8)="@" ;"#4 = TASK FOR NEXT RUN +"RTN","TMGSEQL1B",192,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1B",193,0) + +"RTN","TMGSEQL1B",194,0) + new temp set temp=$$QuietClear^TMGSEQL3(UserID) ;"clear prior alerts & errors +"RTN","TMGSEQL1B",195,0) + do QUIETIN ;" do import +"RTN","TMGSEQL1B",196,0) + +"RTN","TMGSEQL1B",197,0) + ;"Here I schedule the next task to run again. +"RTN","TMGSEQL1B",198,0) + new HrInterval set HrInterval=$$GET1^DIQ(22711,"1,","IMPORT FREQUENCY (IN HOURS)","I") +"RTN","TMGSEQL1B",199,0) + if +HrInterval>0 do +"RTN","TMGSEQL1B",200,0) + . new time set time=$$HADD^XLFDT(InitTime,0,HrInterval,0) +"RTN","TMGSEQL1B",201,0) + . new task set task=$$Schedule^TMGSEQL3(time,"AUTOIN^TMGSEQL1","Import of demographic data from Sequel billing system.") +"RTN","TMGSEQL1B",202,0) + . ;"store 'next run task number' +"RTN","TMGSEQL1B",203,0) + . set TMGFDA(22711,"1,",8)="`"_task ;"#4 = TASK FOR NEXT RUN +"RTN","TMGSEQL1B",204,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1B",205,0) + +"RTN","TMGSEQL1B",206,0) + quit +"RTN","TMGSEQL1B",207,0) + +"RTN","TMGSEQL1B",208,0) + +"RTN","TMGSEQL1B",209,0) +QUIETIN +"RTN","TMGSEQL1B",210,0) + ;"Purpose: To import data based on settings, with no user interaction (in or out) +"RTN","TMGSEQL1B",211,0) + ;"Input: none. Settings stored in File 22711 are used +"RTN","TMGSEQL1B",212,0) + ;"Output: None. There should be no console output. The database should be updated +"RTN","TMGSEQL1B",213,0) + ;"Results: none +"RTN","TMGSEQL1B",214,0) + +"RTN","TMGSEQL1B",215,0) + new FName,F2Name,FPath +"RTN","TMGSEQL1B",216,0) + new result +"RTN","TMGSEQL1B",217,0) + new ErrArray,ChLog +"RTN","TMGSEQL1B",218,0) + new DelFiles +"RTN","TMGSEQL1B",219,0) + new UserID +"RTN","TMGSEQL1B",220,0) + +"RTN","TMGSEQL1B",221,0) + set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME") +"RTN","TMGSEQL1B",222,0) + set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME") +"RTN","TMGSEQL1B",223,0) + set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH") +"RTN","TMGSEQL1B",224,0) + set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I") +"RTN","TMGSEQL1B",225,0) + set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I") +"RTN","TMGSEQL1B",226,0) + +"RTN","TMGSEQL1B",227,0) + set result=$$IMPORTFILE(FPath,FName,F2Name,,,,,DelFiles,UserID) +"RTN","TMGSEQL1B",228,0) + +"RTN","TMGSEQL1B",229,0) + quit +"RTN","TMGSEQL1B",230,0) + +"RTN","TMGSEQL1B",231,0) + +"RTN","TMGSEQL1B",232,0) +IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID) +"RTN","TMGSEQL1B",233,0) + ;"Purpose: To import data from file specified. +"RTN","TMGSEQL1B",234,0) + ;"Input: FilePath: Path of file to input. +"RTN","TMGSEQL1B",235,0) + ;" FileName: The Name of file of file to input. +"RTN","TMGSEQL1B",236,0) + ;" Note: This is written to import a specific file +"RTN","TMGSEQL1B",237,0) + ;" created by SequelMed Systems, filled with +"RTN","TMGSEQL1B",238,0) + ;" patient demographics, in CVS format +"RTN","TMGSEQL1B",239,0) + ;" Note: This file will be DELETED if DelFiles=1 +"RTN","TMGSEQL1B",240,0) + ;" F2Name : the name of the second demographics file in input +"RTN","TMGSEQL1B",241,0) + ;" The reason for 2 files is because Sequel doesn't report the SSN in the +"RTN","TMGSEQL1B",242,0) + ;" primary demographics report. So a second report must be used, and these +"RTN","TMGSEQL1B",243,0) + ;" two files are merged to provide complete patient demographics. +"RTN","TMGSEQL1B",244,0) + ;" Note: This file will be DELETED if DelFiles=1 +"RTN","TMGSEQL1B",245,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1B",246,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1B",247,0) + ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string +"RTN","TMGSEQL1B",248,0) + ;" will be xecuted periodically, to allow display of a progress bar etc. +"RTN","TMGSEQL1B",249,0) + ;" Note: the following variables with global scope will be declared and +"RTN","TMGSEQL1B",250,0) + ;" available for use: TMGCUR (current count), TMGMAX (max count), +"RTN","TMGSEQL1B",251,0) + ;" TMGSTART (the start time +"RTN","TMGSEQL1B",252,0) + ;" External function can signal a request an abort by setting TMGABORT=1 +"RTN","TMGSEQL1B",253,0) + ;" F2Path: OPTIONAL -- path of 2nd demographics file. Default=FilePath +"RTN","TMGSEQL1B",254,0) + ;" DelFiles: OPTIONAL -- if 1, then source files (FileName and F2Name) are deleted after import +"RTN","TMGSEQL1B",255,0) + ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ) +"RTN","TMGSEQL1B",256,0) + ;"Note: I have learned that SequelMed billing system exports ALL patients in the primary +"RTN","TMGSEQL1B",257,0) + ;" export file, including one that have been marked inactive do to invalid data etc. +"RTN","TMGSEQL1B",258,0) + ;" Thus, while the second file (F2Name) has limited info, it contains the list of +"RTN","TMGSEQL1B",259,0) + ;" ACTIVE patients. So if a name is not included in the 2nd file, then its info will +"RTN","TMGSEQL1B",260,0) + ;" be ignored in the 1st file. +"RTN","TMGSEQL1B",261,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1B",262,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1B",263,0) + +"RTN","TMGSEQL1B",264,0) + new GRef,GRef1 +"RTN","TMGSEQL1B",265,0) + new G2Ref,G2Ref1 +"RTN","TMGSEQL1B",266,0) + new result +"RTN","TMGSEQL1B",267,0) + +"RTN","TMGSEQL1B",268,0) + set F2Path=$get(F2Path,FilePath) +"RTN","TMGSEQL1B",269,0) + +"RTN","TMGSEQL1B",270,0) + set GRef=$name(^TMP("TMG","SEQUELIMPORT","DATA",1,$J)) ;"I use this to process array +"RTN","TMGSEQL1B",271,0) + set GRef1=$name(@GRef@(1)) ;"I use this to load file +"RTN","TMGSEQL1B",272,0) + kill @GRef +"RTN","TMGSEQL1B",273,0) + set result=$$FTG^%ZISH(FilePath,FileName,GRef1,6) ;"load file into a global +"RTN","TMGSEQL1B",274,0) + if result=0 goto IFDONE +"RTN","TMGSEQL1B",275,0) + +"RTN","TMGSEQL1B",276,0) + set G2Ref=$name(^TMP("TMG","SEQUELIMPORT","DATA",2,$J)) ;"I use this to process array +"RTN","TMGSEQL1B",277,0) + set G2Ref1=$name(@G2Ref@(1)) ;"I use this to load file +"RTN","TMGSEQL1B",278,0) + kill @G2Ref +"RTN","TMGSEQL1B",279,0) + set result=$$FTG^%ZISH(F2Path,F2Name,G2Ref1,6) ;"load file into a global +"RTN","TMGSEQL1B",280,0) + if result=0 goto IFDONE +"RTN","TMGSEQL1B",281,0) + +"RTN","TMGSEQL1B",282,0) + set UserID=$get(UserID,+$get(DUZ)) +"RTN","TMGSEQL1B",283,0) + +"RTN","TMGSEQL1B",284,0) + set result=$$IMPORTGLOBAL(GRef,G2Ref,.ErrArray,.ChLog,.PrgCallback,UserID) +"RTN","TMGSEQL1B",285,0) + +"RTN","TMGSEQL1B",286,0) + ;"Note: @GRef, @G2Ref killed at end of $$IMPORTGLOBAL() +"RTN","TMGSEQL1B",287,0) + +"RTN","TMGSEQL1B",288,0) + do ;"record the current time as the time of last import +"RTN","TMGSEQL1B",289,0) + . do NOW^%DTC +"RTN","TMGSEQL1B",290,0) + . new TMGFDA,TMGMSG +"RTN","TMGSEQL1B",291,0) + . set TMGFDA(22711,"1,",4)=% ;"#4 = LAST IMPORT DATE +"RTN","TMGSEQL1B",292,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors. +"RTN","TMGSEQL1B",293,0) + +"RTN","TMGSEQL1B",294,0) + if $get(DelFiles)=1 do +"RTN","TMGSEQL1B",295,0) + . ;"Notice: After I implemented this, I realized that I have a permissions problem +"RTN","TMGSEQL1B",296,0) + . ;" at my site... the uploaded files belong to the uploaded user, and deletion by +"RTN","TMGSEQL1B",297,0) + . ;" this user is being blocked. I'll leave in for now... +"RTN","TMGSEQL1B",298,0) + . new temp +"RTN","TMGSEQL1B",299,0) + . set temp=$$DelFile^TMGIOUTL(FilePath_FileName) +"RTN","TMGSEQL1B",300,0) + . set temp=$$DelFile^TMGIOUTL(F2Path_F2Name) +"RTN","TMGSEQL1B",301,0) + +"RTN","TMGSEQL1B",302,0) +IFDONE +"RTN","TMGSEQL1B",303,0) + quit result +"RTN","TMGSEQL1B",304,0) + +"RTN","TMGSEQL1B",305,0) +IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChLog,PrgCallback,UserID) +"RTN","TMGSEQL1B",306,0) + ;"Purpose: To import data from global specified. +"RTN","TMGSEQL1B",307,0) + ;"Input: GRef -- the NAME of array holding the data to import (1st file) +"RTN","TMGSEQL1B",308,0) + ;" Format: @GRef@(1)=OneLine +"RTN","TMGSEQL1B",309,0) + ;" @GRef@(2)=OneLine .. etc. +"RTN","TMGSEQL1B",310,0) + ;" Note: This is written to import a specific file +"RTN","TMGSEQL1B",311,0) + ;" created by SequelMed Systems, filled with +"RTN","TMGSEQL1B",312,0) + ;" patient demographics, in CVS format +"RTN","TMGSEQL1B",313,0) + ;" Note: Array will be KILLED at the end of this function. +"RTN","TMGSEQL1B",314,0) + ;" G2Ref -- the NAME of array holding the data to import (2nd file) +"RTN","TMGSEQL1B",315,0) + ;" Note: Array will be KILLED at the end of this function. +"RTN","TMGSEQL1B",316,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1B",317,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1B",318,0) + ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string +"RTN","TMGSEQL1B",319,0) + ;" will be xecuted periodically, to allow display of a progress bar etc. +"RTN","TMGSEQL1B",320,0) + ;" Note: the following variables with global scope will be declared and +"RTN","TMGSEQL1B",321,0) + ;" available for use: TMGCUR (current count), TMGMAX (max count), +"RTN","TMGSEQL1B",322,0) + ;" TMGSTART (the start time +"RTN","TMGSEQL1B",323,0) + ;" External function can signal a request an abort by setting TMGABORT=1 +"RTN","TMGSEQL1B",324,0) + ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ) +"RTN","TMGSEQL1B",325,0) + ;"Output: Database is updated with data from file. +"RTN","TMGSEQL1B",326,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1B",327,0) + +"RTN","TMGSEQL1B",328,0) + new TMGInvalid ;"Will be used as a globally-scoped variable in the module +"RTN","TMGSEQL1B",329,0) + new result set result=1 +"RTN","TMGSEQL1B",330,0) + new delay set delay=0 +"RTN","TMGSEQL1B",331,0) + new TMGCUR,TMGMAX,TMGSTART,TMGABORT ;"avail for PrgCallback function +"RTN","TMGSEQL1B",332,0) + set TMGABORT=0 +"RTN","TMGSEQL1B",333,0) + set TMGMAX=+$order(@GRef@(""),-1) +"RTN","TMGSEQL1B",334,0) + set TMGSTART=$H ;"store starting time. +"RTN","TMGSEQL1B",335,0) + set UserID=$get(UserID,+$get(DUZ)) +"RTN","TMGSEQL1B",336,0) + +"RTN","TMGSEQL1B",337,0) + new SSNArray +"RTN","TMGSEQL1B",338,0) + do XtractSSNum(G2Ref,.SSNArray) +"RTN","TMGSEQL1B",339,0) + +"RTN","TMGSEQL1B",340,0) + set TMGCUR=$order(@GRef@("")) +"RTN","TMGSEQL1B",341,0) + if TMGCUR'="" for do quit:(TMGCUR="")!(TMGABORT=1) +"RTN","TMGSEQL1B",342,0) + . new OneLine +"RTN","TMGSEQL1B",343,0) + . set OneLine=$get(@GRef@(TMGCUR)) +"RTN","TMGSEQL1B",344,0) + . set result=$$ProcessPt(OneLine,.ErrArray,.ChgLog,.SSNArray,UserID) +"RTN","TMGSEQL1B",345,0) + . set delay=delay+1 +"RTN","TMGSEQL1B",346,0) + . if (delay>30),$get(PrgCallback)'="" do ;"update progress bar every 30 cycles +"RTN","TMGSEQL1B",347,0) + . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGSEQL1B",348,0) + . . xecute PrgCallback ;"call the specified progress code. +"RTN","TMGSEQL1B",349,0) + . . set delay=0 +"RTN","TMGSEQL1B",350,0) + . set TMGCUR=$order(@GRef@(TMGCUR)) +"RTN","TMGSEQL1B",351,0) + +"RTN","TMGSEQL1B",352,0) + kill @GRef +"RTN","TMGSEQL1B",353,0) + kill @G2Ref +"RTN","TMGSEQL1B",354,0) + quit result +"RTN","TMGSEQL1B",355,0) + +"RTN","TMGSEQL1B",356,0) + +"RTN","TMGSEQL1B",357,0) + +"RTN","TMGSEQL1B",358,0) +ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ,InputFn) +"RTN","TMGSEQL1B",359,0) + ;"Purpose: To process one line from patient demographics file. +"RTN","TMGSEQL1B",360,0) + ;"Input: OneLine-- One line from CVS demographics file. +"RTN","TMGSEQL1B",361,0) + ;" Format is as follows, *** all on one line (comma delimited) +"RTN","TMGSEQL1B",362,0) + ;" 01- patient_seq_num, +"RTN","TMGSEQL1B",363,0) + ;" 02- facility_short_name, +"RTN","TMGSEQL1B",364,0) + ;" 03- pat_last_name, +"RTN","TMGSEQL1B",365,0) + ;" 04- pat_first_name, +"RTN","TMGSEQL1B",366,0) + ;" 05- pat_account_num, +"RTN","TMGSEQL1B",367,0) + ;" 06- pat_address, +"RTN","TMGSEQL1B",368,0) + ;" 07- state, +"RTN","TMGSEQL1B",369,0) + ;" 08- resp_last_name, +"RTN","TMGSEQL1B",370,0) + ;" 09- resp_first_name, +"RTN","TMGSEQL1B",371,0) + ;" 10- facility_seq_num, +"RTN","TMGSEQL1B",372,0) + ;" 11- register_date, +"RTN","TMGSEQL1B",373,0) + ;" 12- location_name, +"RTN","TMGSEQL1B",374,0) + ;" 13- city, +"RTN","TMGSEQL1B",375,0) + ;" 14- provider_short_name, +"RTN","TMGSEQL1B",376,0) + ;" 15- zipcode, +"RTN","TMGSEQL1B",377,0) + ;" 16- class_name, +"RTN","TMGSEQL1B",378,0) + ;" 17- pat_dob, +"RTN","TMGSEQL1B",379,0) + ;" 18- ref_prov_short_name, +"RTN","TMGSEQL1B",380,0) + ;" 19- pat_tel_num, +"RTN","TMGSEQL1B",381,0) + ;" 20- last_visit_days, +"RTN","TMGSEQL1B",382,0) + ;" 21- name, +"RTN","TMGSEQL1B",383,0) + ;" 22- description +"RTN","TMGSEQL1B",384,0) + ;" ADDENDUM: +"RTN","TMGSEQL1B",385,0) + ;" sometimes SEX will be appended to line. Format: +"RTN","TMGSEQL1B",386,0) + ;" previous data^MALE or previous data^FEMALE +"RTN","TMGSEQL1B",387,0) + ;" sometimes SSN will be appended to line. Format: +"RTN","TMGSEQL1B",388,0) + ;" previous data^(sex)^SSNUM +"RTN","TMGSEQL1B",389,0) + ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines. +"RTN","TMGSEQL1B",390,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1B",391,0) + ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers, +"RTN","TMGSEQL1B",392,0) + ;" as created by XtractSSNum() +"RTN","TMGSEQL1B",393,0) + ;" DUZ: The user who will recieve alerts of errors +"RTN","TMGSEQL1B",394,0) + ;" InputFn: OPTIONAL-- the name of a function to turn parse on csv line +"RTN","TMGSEQL1B",395,0) + ;" default value is "ParseLine" +"RTN","TMGSEQL1B",396,0) + ;" e.g. "MyFn" or "MyFn^MyRoutine". Must take same params as ParseLine +"RTN","TMGSEQL1B",397,0) + ;" This will allow this code to be used on a variety of .csv files, with +"RTN","TMGSEQL1B",398,0) + ;" different data-formats--each one with its own parser funtion. +"RTN","TMGSEQL1B",399,0) + ;"Output: Data is put into database, if it is not there already. +"RTN","TMGSEQL1B",400,0) + ;"Result: 1=OK To continue; 0=abort or bad data +"RTN","TMGSEQL1B",401,0) + +"RTN","TMGSEQL1B",402,0) + new XFn +"RTN","TMGSEQL1B",403,0) + new PtInfo,OneErrArray +"RTN","TMGSEQL1B",404,0) + new result set result=1 +"RTN","TMGSEQL1B",405,0) + new AutoRegister set AutoRegister=1 +"RTN","TMGSEQL1B",406,0) + set InputFn=$get(InputFn,"ParseLine") +"RTN","TMGSEQL1B",407,0) + +"RTN","TMGSEQL1B",408,0) + set XFn="set result=$$"_InputFn_"(.OneLine,.PtInfo,.SSNArray)" +"RTN","TMGSEQL1B",409,0) + xecute XFn ;"old -- set result=$$ParseLine(.OneLine,.PtInfo,.SSNArray) +"RTN","TMGSEQL1B",410,0) + if result'>0 goto PPtDone +"RTN","TMGSEQL1B",411,0) + if $get(PtInfo("FACILITY"))="SAMPLE" goto PPtDone +"RTN","TMGSEQL1B",412,0) + +"RTN","TMGSEQL1B",413,0) + if $$UpdateDB(.PtInfo,AutoRegister,.OneErrArray,.ChgLog)=0 do +"RTN","TMGSEQL1B",414,0) + . new count set count=+$get(ErrArray)+1 +"RTN","TMGSEQL1B",415,0) + . set ErrArray=count +"RTN","TMGSEQL1B",416,0) + . set ErrArray(count)=OneLine +"RTN","TMGSEQL1B",417,0) + . merge ErrArray(count,"INFO")=OneErrArray +"RTN","TMGSEQL1B",418,0) + . ;"------ +"RTN","TMGSEQL1B",419,0) + . do AlertError^TMGSEQL2(OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL1B",420,0) + +"RTN","TMGSEQL1B",421,0) +PPtDone +"RTN","TMGSEQL1B",422,0) + quit result +"RTN","TMGSEQL1B",423,0) + +"RTN","TMGSEQL1B",424,0) + +"RTN","TMGSEQL1B",425,0) +ParseLine(OneLine,Array,SSNArray) +"RTN","TMGSEQL1B",426,0) + ;"Purpose: To process one line from patient demographics file. +"RTN","TMGSEQL1B",427,0) + ;" Also gets data into an acceptible format. +"RTN","TMGSEQL1B",428,0) + ;"Input: OneLine -- One line from CVS demographics file. (Format as per ProcessPt) +"RTN","TMGSEQL1B",429,0) + ;" NOTE: if PASSED BY REFERENCE, then line may be altered such that SSN is +"RTN","TMGSEQL1B",430,0) + ;" added as a 3rd piece, using ^ as a delimiter. (2nd piece used elsewhere +"RTN","TMGSEQL1B",431,0) + ;" to store sex. +"RTN","TMGSEQL1B",432,0) + ;" When processing line, if SSNArray doesn't provide a SSN for patient, then +"RTN","TMGSEQL1B",433,0) + ;" this 3rd piece can provide the SSN +"RTN","TMGSEQL1B",434,0) + ;" Array -- PASS BY REFERENCE. And OUT parameter. Any prior data killed. +"RTN","TMGSEQL1B",435,0) + ;" Note: uses TMGInvalid (globally scoped var defined in this module) +"RTN","TMGSEQL1B",436,0) + ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers, +"RTN","TMGSEQL1B",437,0) + ;" as created by XtractSSNum() +"RTN","TMGSEQL1B",438,0) + ;"Output: Array is filled with Format as follows (note not all data used): +"RTN","TMGSEQL1B",439,0) + ;" Array("FACILITY"), to hold 02- facility_short_name +"RTN","TMGSEQL1B",440,0) + ;" Array("LAST NAME"), to hold 03- pat_last_name, +"RTN","TMGSEQL1B",441,0) + ;" Array("FIRST NAME"), to hold 04- pat_first_name, +"RTN","TMGSEQL1B",442,0) + ;" Array("PMS ACCOUNT NUM"), to hold 05- pat_account_num, +"RTN","TMGSEQL1B",443,0) + ;" Array("ADDRESS1"), to hold 06- pat_address, +"RTN","TMGSEQL1B",444,0) + ;" Array("ADDRESS2"), to hold 06- pat_address, +"RTN","TMGSEQL1B",445,0) + ;" Array("ADDRESS3"), to hold 06- pat_address, +"RTN","TMGSEQL1B",446,0) + ;" Array("STATE"), to hold 07- state, +"RTN","TMGSEQL1B",447,0) + ;" Array("RESP LAST NAME"), to hold 08- resp_last_name, +"RTN","TMGSEQL1B",448,0) + ;" Array("RESP FIRST NAME"), to hold 09- resp_first_name, +"RTN","TMGSEQL1B",449,0) + ;" Array("CITY"), to hold 13- city, +"RTN","TMGSEQL1B",450,0) + ;" Array("PROVIDER"), to hold 14- provider_short_name, +"RTN","TMGSEQL1B",451,0) + ;" Array("ZIP CODE"), to hold 15- zipcode, +"RTN","TMGSEQL1B",452,0) + ;" Array("DOB"), to hold 17- pat_dob, +"RTN","TMGSEQL1B",453,0) + ;" Array("PHONE NUM"), to hold 19- pat_tel_num, +"RTN","TMGSEQL1B",454,0) + ;" Array("SEX"), to hold Patient sex, if provided. +"RTN","TMGSEQL1B",455,0) + ;" Array("SSNUM")=Social security number +"RTN","TMGSEQL1B",456,0) + ;" Array("FULL NAME")=FIRSTNAME LASTNAME (DOB) +"RTN","TMGSEQL1B",457,0) + ;" Array("FULL NAME2")=LASTNAME,FIRSTNAME (DOB) +"RTN","TMGSEQL1B",458,0) + ;" Array("FULL NAME3")=LASTNAME,FIRSTNAME +"RTN","TMGSEQL1B",459,0) + ;"Result: 1=OK To continue; 0=abort or bad data; -1 skip, but don't store as error +"RTN","TMGSEQL1B",460,0) + +"RTN","TMGSEQL1B",461,0) + new temp +"RTN","TMGSEQL1B",462,0) + new result set result=1 +"RTN","TMGSEQL1B",463,0) + +"RTN","TMGSEQL1B",464,0) + set OneLine=$translate($get(OneLine),"""","'") ;" convert " to ' to avoid fileman error +"RTN","TMGSEQL1B",465,0) + +"RTN","TMGSEQL1B",466,0) + kill Array +"RTN","TMGSEQL1B",467,0) + set Array("FACILITY")=$piece(OneLine,",",2) +"RTN","TMGSEQL1B",468,0) + set Array("LAST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",3)) +"RTN","TMGSEQL1B",469,0) + set Array("FIRST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",4)) +"RTN","TMGSEQL1B",470,0) + set Array("PMS ACCOUNT NUM")=$piece(OneLine,",",5) +"RTN","TMGSEQL1B",471,0) + set Array("ADDRESS1")=$piece(OneLine,",",6) +"RTN","TMGSEQL1B",472,0) + set Array("STATE")=$piece(OneLine,",",7) +"RTN","TMGSEQL1B",473,0) + set Array("RESP LAST NAME")=$piece(OneLine,",",8) +"RTN","TMGSEQL1B",474,0) + set Array("RESP FIRST NAME")=$piece(OneLine,",",9) +"RTN","TMGSEQL1B",475,0) + set Array("CITY")=$$Trim^TMGSTUTL($piece(OneLine,",",13),"""") +"RTN","TMGSEQL1B",476,0) + set Array("PROVIDER")=$piece(OneLine,",",14) +"RTN","TMGSEQL1B",477,0) + set Array("ZIP CODE")=$piece(OneLine,",",15) +"RTN","TMGSEQL1B",478,0) + new DOB set DOB=$piece(OneLine,",",17) +"RTN","TMGSEQL1B",479,0) + set DOB=$$Trim^TMGSTUTL(DOB) +"RTN","TMGSEQL1B",480,0) + set DOB=$piece(DOB," ",1) ;" '03/09/05 00:00' --> '03/09/05' +"RTN","TMGSEQL1B",481,0) + set Array("DOB")=DOB +"RTN","TMGSEQL1B",482,0) + set Array("PHONE NUM")=$piece(OneLine,",",19) +"RTN","TMGSEQL1B",483,0) + set Array("SEX")=$piece(OneLine,"^",2) +"RTN","TMGSEQL1B",484,0) + +"RTN","TMGSEQL1B",485,0) + set Array("FULL NAME")=Array("FIRST NAME")_" "_Array("LAST NAME")_" ("_Array("DOB")_")" +"RTN","TMGSEQL1B",486,0) + set Array("FULL NAME2")=Array("LAST NAME")_","_Array("FIRST NAME")_" ("_Array("DOB")_")" +"RTN","TMGSEQL1B",487,0) + set Array("FULL NAME3")=Array("LAST NAME")_","_Array("FIRST NAME") +"RTN","TMGSEQL1B",488,0) + +"RTN","TMGSEQL1B",489,0) + ;"do a lookup on abreviattion for ALL states, convert to external format +"RTN","TMGSEQL1B",490,0) + new DIC,X,Y +"RTN","TMGSEQL1B",491,0) + set DIC=5 ;"STATE file +"RTN","TMGSEQL1B",492,0) + set DIC(0)="M" +"RTN","TMGSEQL1B",493,0) + set X=Array("STATE") +"RTN","TMGSEQL1B",494,0) + do ^DIC +"RTN","TMGSEQL1B",495,0) + set Array("STATE")=$piece(Y,"^",2) +"RTN","TMGSEQL1B",496,0) + +"RTN","TMGSEQL1B",497,0) + ;"convert Sequel format to VistA format +"RTN","TMGSEQL1B",498,0) + if Array("PROVIDER")'="" do +"RTN","TMGSEQL1B",499,0) + . set Array("PROVIDER")=$$ConvProvider(Array("PROVIDER")) +"RTN","TMGSEQL1B",500,0) + if Array("PROVIDER")="SKIP" set result=0 goto PLDone +"RTN","TMGSEQL1B",501,0) + +"RTN","TMGSEQL1B",502,0) + ;" VistA address allows for: +"RTN","TMGSEQL1B",503,0) + ;" .111 -- address line 1 +"RTN","TMGSEQL1B",504,0) + ;" .112 -- address line 2 +"RTN","TMGSEQL1B",505,0) + ;" .113 -- address line 3 +"RTN","TMGSEQL1B",506,0) + ;" BUT, each line must be 3-35 characters +"RTN","TMGSEQL1B",507,0) + ;" Sequel puts this all on one line. +"RTN","TMGSEQL1B",508,0) + ;" SO, I need to divide the Sequel line if not 3-35 +"RTN","TMGSEQL1B",509,0) + new value set value=Array("ADDRESS1") +"RTN","TMGSEQL1B",510,0) + if $length(value)'<35 do +"RTN","TMGSEQL1B",511,0) + . new s1,s2 +"RTN","TMGSEQL1B",512,0) + . do NiceSplit^TMGSTUTL(value,35,.s1,.s2,3) +"RTN","TMGSEQL1B",513,0) + . set Array("ADDRESS1")=s1 +"RTN","TMGSEQL1B",514,0) + . if $length(s2)'<35 do +"RTN","TMGSEQL1B",515,0) + . . do NiceSplit^TMGSTUTL(s1,35,.s1,.s2,3) +"RTN","TMGSEQL1B",516,0) + . . set Array("ADDRESS2")=s1 ;"<-- is this correct? +"RTN","TMGSEQL1B",517,0) + . . if s2'="" set Array("ADDRESS3")=$extract(s2,1,35) +"RTN","TMGSEQL1B",518,0) + . else set Array("ADDRESS2")=s2 +"RTN","TMGSEQL1B",519,0) + +"RTN","TMGSEQL1B",520,0) + ;"Ensure proper length of city. +"RTN","TMGSEQL1B",521,0) + set Array("CITY")=$extract(Array("CITY"),1,15) +"RTN","TMGSEQL1B",522,0) + if $length(Array("CITY"))=1 set Array("CITY")=Array("CITY")_" " +"RTN","TMGSEQL1B",523,0) + +"RTN","TMGSEQL1B",524,0) + ;"Ensure proper length of phone +"RTN","TMGSEQL1B",525,0) + if $length(Array("PHONE NUM"))<7 kill Array("PHONE NUM") +"RTN","TMGSEQL1B",526,0) + +"RTN","TMGSEQL1B",527,0) + new AcctNum set AcctNum=$get(Array("PMS ACCOUNT NUM")) +"RTN","TMGSEQL1B",528,0) + new SSNum set SSNum=$get(SSNArray(AcctNum)) +"RTN","TMGSEQL1B",529,0) + if SSNum=999999999 set SSNum=0 +"RTN","TMGSEQL1B",530,0) + if +SSNum=0 do ;"see if 3rd ^ piece holds SSNum data +"RTN","TMGSEQL1B",531,0) + . set SSNum=$piece(OneLine,"^",3) ;"note this won't overwrite valid data from SSNArray() +"RTN","TMGSEQL1B",532,0) + if SSNum>0 do +"RTN","TMGSEQL1B",533,0) + . set Array("SSNUM")=SSNum +"RTN","TMGSEQL1B",534,0) + . set $piece(OneLine,"^",3)=SSNum +"RTN","TMGSEQL1B",535,0) + +"RTN","TMGSEQL1B",536,0) + if result'=0 do +"RTN","TMGSEQL1B",537,0) + . if $$InvalPtName(Array("FIRST NAME"),Array("LAST NAME"))=1 set result=-1 quit +"RTN","TMGSEQL1B",538,0) + . if $$InactivePt(Array("PMS ACCOUNT NUM"),.SSNArray)=1 do +"RTN","TMGSEQL1B",539,0) +xx . . set result=-1 +"RTN","TMGSEQL1B",540,0) + . . ;"write !,"Skipping: ",Array("FULL NAME3"),! ;"temp +"RTN","TMGSEQL1B",541,0) + +"RTN","TMGSEQL1B",542,0) +PLDone +"RTN","TMGSEQL1B",543,0) + quit result +"RTN","TMGSEQL1B",544,0) + +"RTN","TMGSEQL1B",545,0) + +"RTN","TMGSEQL1B",546,0) +ConvProvider(SequelProvider) +"RTN","TMGSEQL1B",547,0) + ;"Purpose: To convert Sequel provider shortname to VistA file 200 name. +"RTN","TMGSEQL1B",548,0) + ;"Input: SequelProvider +"RTN","TMGSEQL1B",549,0) + ;"Result: VistA provider name (string), or "" if not found, or "SKIP" if not to be used +"RTN","TMGSEQL1B",550,0) + +"RTN","TMGSEQL1B",551,0) + new result set result="" +"RTN","TMGSEQL1B",552,0) + +"RTN","TMGSEQL1B",553,0) + if $$InvalidProvider(SequelProvider) set result="SKIP" goto ConPrDone +"RTN","TMGSEQL1B",554,0) + if SequelProvider="SAMPLE" set result="SKIP" goto ConPrDone +"RTN","TMGSEQL1B",555,0) + +"RTN","TMGSEQL1B",556,0) + +"RTN","TMGSEQL1B",557,0) + new TMGARRAY,TMGMSG +"RTN","TMGSEQL1B",558,0) + do FIND^DIC(200,,".01",,SequelProvider,"*","TMG",,,"TMGARRAY","TMGMSG") +"RTN","TMGSEQL1B",559,0) + if +TMGARRAY("DILIST",0)>0 do +"RTN","TMGSEQL1B",560,0) + . set result=TMGARRAY("DILIST",1,1) +"RTN","TMGSEQL1B",561,0) + else do +"RTN","TMGSEQL1B",562,0) + . new DIC +"RTN","TMGSEQL1B",563,0) + . set DIC=200 +"RTN","TMGSEQL1B",564,0) + . ;"try converting name and doing quiet lookup (KTOPPEN->TOPPEN,K) +"RTN","TMGSEQL1B",565,0) + . set X=$extract(SequelProvider,2,99)_","_$extract(SequelProvider,1) +"RTN","TMGSEQL1B",566,0) + . do ^DIC +"RTN","TMGSEQL1B",567,0) + . if (+Y=-1)&(1=0) do ;"<--- FEATURE TURNED OFF. If not found, don't ask (no longer needed) +"RTN","TMGSEQL1B",568,0) + . . if $data(TMGInvalid(SequelProvider))'=0 quit +"RTN","TMGSEQL1B",569,0) + . . write !,"Please help match the Sequel 'shortname' to a VistA provider name.",! +"RTN","TMGSEQL1B",570,0) + . . write "This should have to be done only once.",! +"RTN","TMGSEQL1B",571,0) + . . write "Enter ^ if the provider name is not valid.",! +"RTN","TMGSEQL1B",572,0) + . . write "Please enter VistA provider name for: '",SequelProvider,"'",! +"RTN","TMGSEQL1B",573,0) + . . set DIC(0)="AEQM" +"RTN","TMGSEQL1B",574,0) + . . do ^DIC +"RTN","TMGSEQL1B",575,0) + . . write ! +"RTN","TMGSEQL1B",576,0) + . if +Y>-1 do +"RTN","TMGSEQL1B",577,0) + . . new DFN set DFN=+Y +"RTN","TMGSEQL1B",578,0) + . . new TMGFDA set TMGFDA(200,DFN_",",22702)=SequelProvider +"RTN","TMGSEQL1B",579,0) + . . kill TMGMSG +"RTN","TMGSEQL1B",580,0) + . . do FILE^DIE(,"TMGFDA","TMGMSG") ;"ignore errors +"RTN","TMGSEQL1B",581,0) + . . set result=$piece(Y,"^",2) +"RTN","TMGSEQL1B",582,0) + . else do +"RTN","TMGSEQL1B",583,0) + . . set TMGInvalid(SequelProvider)="" +"RTN","TMGSEQL1B",584,0) +ConPrDone +"RTN","TMGSEQL1B",585,0) + quit result +"RTN","TMGSEQL1B",586,0) + +"RTN","TMGSEQL1B",587,0) + +"RTN","TMGSEQL1B",588,0) +InvalPtName(FName,LName) +"RTN","TMGSEQL1B",589,0) + ;"Purpose: To determine if the Patient name is invalid (i.e. CAP TOPPENBERG, or INSURANCE INSURANCE etc.) +"RTN","TMGSEQL1B",590,0) + ;"Input: FName,LName -- the first and last names +"RTN","TMGSEQL1B",591,0) + ;"Result: 1 if name is invalid, 0 if OK name +"RTN","TMGSEQL1B",592,0) + +"RTN","TMGSEQL1B",593,0) + new result set result=0 +"RTN","TMGSEQL1B",594,0) + +"RTN","TMGSEQL1B",595,0) + if FName="CAP" do ;"screen out 'CAP TOPPENBERG' etc ?? entries ?? +"RTN","TMGSEQL1B",596,0) + . new DIC set DIC=200 +"RTN","TMGSEQL1B",597,0) + . set DIC(0)="M" +"RTN","TMGSEQL1B",598,0) + . set X=LName +"RTN","TMGSEQL1B",599,0) + . do ^DIC +"RTN","TMGSEQL1B",600,0) + . if +Y>0 set result=1 +"RTN","TMGSEQL1B",601,0) + +"RTN","TMGSEQL1B",602,0) + if (FName="INSURANCE")&(LName="INSURANCE") set result=1 +"RTN","TMGSEQL1B",603,0) + +"RTN","TMGSEQL1B",604,0) + quit result +"RTN","TMGSEQL1B",605,0) + +"RTN","TMGSEQL1B",606,0) + +"RTN","TMGSEQL1B",607,0) +InactivePt(PMSAcctNum,SSNArray) +"RTN","TMGSEQL1B",608,0) + ;"Purpose: to determine if patient is inactive, and should be skipped. +"RTN","TMGSEQL1B",609,0) + ;" This is determined by testing for existence of AccountNumber in SSNArray. +"RTN","TMGSEQL1B",610,0) + ;" SSNArray is created from the 2nd demographics file. This is a list of ACTIVE patients, +"RTN","TMGSEQL1B",611,0) + ;" which is different from the 1st demographics file--which holds ALL patients. +"RTN","TMGSEQL1B",612,0) + ;"Input: PMSAcctNum -- as stored in PtInfo("PMS ACCOUNT NUM") +"RTN","TMGSEQL1B",613,0) + ;" SSNArray: PASS BY REFERENCE. An array with social security numbers, as created by XtractSSNum() +"RTN","TMGSEQL1B",614,0) + ;"Result: 1 if patient is INACTIVE, and should be skipped. +"RTN","TMGSEQL1B",615,0) + ;" 0 if OK to use +"RTN","TMGSEQL1B",616,0) + +"RTN","TMGSEQL1B",617,0) + new result +"RTN","TMGSEQL1B",618,0) + set result=+$get(SSNArray(PMSAcctNum))'>0 +"RTN","TMGSEQL1B",619,0) + quit result +"RTN","TMGSEQL1B",620,0) + +"RTN","TMGSEQL1B",621,0) + +"RTN","TMGSEQL1B",622,0) +InvalidProvider(SequelProvider) +"RTN","TMGSEQL1B",623,0) + ;"Purpose: To return if provider should not be used (i.e. cause data to be skipped) +"RTN","TMGSEQL1B",624,0) + ;"Input: SequelProvider +"RTN","TMGSEQL1B",625,0) + ;"Result: 0: OK to use provider +"RTN","TMGSEQL1B",626,0) + ;" 1: Don't use provider +"RTN","TMGSEQL1B",627,0) + +"RTN","TMGSEQL1B",628,0) + new result set result=0 +"RTN","TMGSEQL1B",629,0) + +"RTN","TMGSEQL1B",630,0) + if SequelProvider="SAMPLE" set result=1 +"RTN","TMGSEQL1B",631,0) + if SequelProvider="GREENEVILLE" set result=1 +"RTN","TMGSEQL1B",632,0) + if SequelProvider="AFOSTER" set result=1 +"RTN","TMGSEQL1B",633,0) + if SequelProvider="AFTON" set result=1 +"RTN","TMGSEQL1B",634,0) + if SequelProvider="JWRIGHT" set result=1 ;"not an active provider +"RTN","TMGSEQL1B",635,0) + ;"These providers are leaving group, so don't import their data. +"RTN","TMGSEQL1B",636,0) + if SequelProvider="CPERRY" set result=1 +"RTN","TMGSEQL1B",637,0) + if SequelProvider="OSWARNER" set result=1 +"RTN","TMGSEQL1B",638,0) + if SequelProvider="SGILES" set result=1 +"RTN","TMGSEQL1B",639,0) + if SequelProvider="SPENNY" set result=1 +"RTN","TMGSEQL1B",640,0) + if SequelProvider="TFULLER" set result=1 +"RTN","TMGSEQL1B",641,0) + +"RTN","TMGSEQL1B",642,0) + quit result +"RTN","TMGSEQL1B",643,0) + +"RTN","TMGSEQL1B",644,0) + +"RTN","TMGSEQL1B",645,0) +UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog) +"RTN","TMGSEQL1B",646,0) + ;"Purpose: To put that data from the PtInfo array into the database (if needed) +"RTN","TMGSEQL1B",647,0) + ;"Input: PtInfo -- array (PASS BY REFERENCE), with the following items being used: +"RTN","TMGSEQL1B",648,0) + ;" PtInfo("LAST NAME"), to hold 03- pat_last_name, +"RTN","TMGSEQL1B",649,0) + ;" PtInfo("FIRST NAME"), to hold 04- pat_first_name, +"RTN","TMGSEQL1B",650,0) + ;" PtInfo("PMS ACCOUNT NUM") ----> field 22701 (custom field) +"RTN","TMGSEQL1B",651,0) + ;" PtInfo("ADDRESS") ----> field .111 +"RTN","TMGSEQL1B",652,0) + ;" PtInfo("STATE") ----> field .115 +"RTN","TMGSEQL1B",653,0) + ;" PtInfo("CITY") ----> field .114 +"RTN","TMGSEQL1B",654,0) + ;" PtInfo("ZIP CODE") ----> field .1112 +"RTN","TMGSEQL1B",655,0) + ;" PtInfo("PHONE NUM") ----> field .131 +"RTN","TMGSEQL1B",656,0) + ;" PtInfo("PROVIDER") ----> field .1041 +"RTN","TMGSEQL1B",657,0) + ;" PtInfo("SSNUM") ----> field .09 +"RTN","TMGSEQL1B",658,0) + ;" AutoRegister: if 1, then patient will be automatically added/registered +"RTN","TMGSEQL1B",659,0) + ;" ErrArray -- PASS BY REFERENCE. And OUT parameter to get back error info. +"RTN","TMGSEQL1B",660,0) + ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database +"RTN","TMGSEQL1B",661,0) + ;"Output: Data is put into database, if it is not there already. +"RTN","TMGSEQL1B",662,0) + ;"Result: 1 successful completion, 0=error +"RTN","TMGSEQL1B",663,0) + +"RTN","TMGSEQL1B",664,0) + new Entry +"RTN","TMGSEQL1B",665,0) + new result set result=1 +"RTN","TMGSEQL1B",666,0) + new Name,TMGDOB,DFN +"RTN","TMGSEQL1B",667,0) + new TMGARRAY,TMGMSG +"RTN","TMGSEQL1B",668,0) + new PriorErrorFound +"RTN","TMGSEQL1B",669,0) + new NewInfo +"RTN","TMGSEQL1B",670,0) + new IENS +"RTN","TMGSEQL1B",671,0) + new index +"RTN","TMGSEQL1B",672,0) + kill ErrArray +"RTN","TMGSEQL1B",673,0) + new TMGDEBUG set TMGDEBUG=-1 ;"//EXTRA QUIET mode --> shut down TMGDBAPI messages +"RTN","TMGSEQL1B",674,0) + +"RTN","TMGSEQL1B",675,0) + +"RTN","TMGSEQL1B",676,0) + ;"NOTE: I need to have some method such that IF a patient is positively matched +"RTN","TMGSEQL1B",677,0) + ;" (i.e. via SSNUM or PMS Account number), THEN changes in spelling of name, or +"RTN","TMGSEQL1B",678,0) + ;" DOB on Sequel side should be reflected in VistA. Currently, I don't this +"RTN","TMGSEQL1B",679,0) + ;" this happens. +"RTN","TMGSEQL1B",680,0) + +"RTN","TMGSEQL1B",681,0) + new Fields +"RTN","TMGSEQL1B",682,0) + set Fields(22701)="PMS ACCOUNT NUM" +"RTN","TMGSEQL1B",683,0) + set Fields(.111)="ADDRESS1" +"RTN","TMGSEQL1B",684,0) + set Fields(.112)="ADDRESS2" +"RTN","TMGSEQL1B",685,0) + set Fields(.113)="ADDRESS3" +"RTN","TMGSEQL1B",686,0) + set Fields(.115)="STATE" +"RTN","TMGSEQL1B",687,0) + set Fields(.114)="CITY" +"RTN","TMGSEQL1B",688,0) + set Fields(.1112)="ZIP CODE" +"RTN","TMGSEQL1B",689,0) + set Fields(.131)="PHONE NUM" +"RTN","TMGSEQL1B",690,0) + set Fields(.1041)="PROVIDER" +"RTN","TMGSEQL1B",691,0) + set Fields(.02)="SEX" +"RTN","TMGSEQL1B",692,0) + set Fields(.09)="SSNUM" +"RTN","TMGSEQL1B",693,0) + set Fields="22701;.111;.112;.113;.115;.114;.1112;.131;.1041;.09" +"RTN","TMGSEQL1B",694,0) + +"RTN","TMGSEQL1B",695,0) + set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME")) +"RTN","TMGSEQL1B",696,0) + set Name=$$FormatName^TMGMISC(Name) +"RTN","TMGSEQL1B",697,0) + set TMGDOB=$get(PtInfo("DOB")) +"RTN","TMGSEQL1B",698,0) + +"RTN","TMGSEQL1B",699,0) + set Entry(.01)=Name +"RTN","TMGSEQL1B",700,0) + set Entry(.03)=TMGDOB +"RTN","TMGSEQL1B",701,0) + if $get(PtInfo("SEX"))'="" set Entry(.02)=$get(PtInfo("SEX")) +"RTN","TMGSEQL1B",702,0) + set Entry(.09)=$get(PtInfo("SSNUM")) +"RTN","TMGSEQL1B",703,0) + +"RTN","TMGSEQL1B",704,0) + set DFN=$$GetDFN(.PtInfo) +"RTN","TMGSEQL1B",705,0) + +"RTN","TMGSEQL1B",706,0) + if (DFN=0)&($get(AutoRegister)=1) do +"RTN","TMGSEQL1B",707,0) + . set ErrArray=-1 ;"extra quiet mode. +"RTN","TMGSEQL1B",708,0) + . if $get(Entry(.02))="" do ;"autopick gender if missing +"RTN","TMGSEQL1B",709,0) + . . new AutoPick +"RTN","TMGSEQL1B",710,0) + . . set AutoPick=$$GET1^DIQ(22711,"1,","PICK GENDER FROM NAME?","I") +"RTN","TMGSEQL1B",711,0) + . . if AutoPick'=1 quit +"RTN","TMGSEQL1B",712,0) + . . set Entry(.02)=$$GetSex^TMGSEQL2($get(PtInfo("FIRST NAME"))) +"RTN","TMGSEQL1B",713,0) + . ;"OK, can't find, so will add new patient. +"RTN","TMGSEQL1B",714,0) + . set DFN=+$$AddNewPt^TMGGDFN(.Entry,.ErrArray) +"RTN","TMGSEQL1B",715,0) + . if DFN'=0 set ChLog(Name_" "_TMGDOB,0)="ADDED PATIENT: "_Name_" "_TMGDOB +"RTN","TMGSEQL1B",716,0) + if DFN=0 do goto UDBDone ;"failure +"RTN","TMGSEQL1B",717,0) + . set result=0 +"RTN","TMGSEQL1B",718,0) + . set ErrArray(0)=$$NameError^TMGSEQL2(.ErrArray) ;"get name if DIERR encountered. +"RTN","TMGSEQL1B",719,0) + . if ErrArray(0)["DOB" do +"RTN","TMGSEQL1B",720,0) + . . ;"write !,"DOB error found for: ",PtInfo("FULL NAME"),! +"RTN","TMGSEQL1B",721,0) + . if ErrArray(0)="" do +"RTN","TMGSEQL1B",722,0) + . . set ErrArray(0)="PATIENT NOT IN DATABASE:" ;"if changed, also change in TMGSEQL2.m +"RTN","TMGSEQL1B",723,0) + set IENS=DFN_"," +"RTN","TMGSEQL1B",724,0) + +"RTN","TMGSEQL1B",725,0) + ;"use DFN(IEN in file 2) to get data into database +"RTN","TMGSEQL1B",726,0) + do GETS^DIQ(2,IENS,Fields,"","TMGARRAY","TMGMSG") +"RTN","TMGSEQL1B",727,0) + +"RTN","TMGSEQL1B",728,0) + ;"check for errors. +"RTN","TMGSEQL1B",729,0) + if $data(TMGMSG("DIERR"))'=0 do goto UDBDone +"RTN","TMGSEQL1B",730,0) + . set result=0 +"RTN","TMGSEQL1B",731,0) + . merge ErrArray=TMGMSG("DIERR") +"RTN","TMGSEQL1B",732,0) + . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL1B",733,0) + kill TMGMSG +"RTN","TMGSEQL1B",734,0) + +"RTN","TMGSEQL1B",735,0) + ;"If any data in data base differs from Array, setup NewInfo +"RTN","TMGSEQL1B",736,0) + new UpdateNeeded set UpdateNeeded=0 +"RTN","TMGSEQL1B",737,0) + new abort set abort=0 +"RTN","TMGSEQL1B",738,0) + set index=$order(Fields("")) +"RTN","TMGSEQL1B",739,0) + for do quit:(+index'>0)!(abort=1) +"RTN","TMGSEQL1B",740,0) + . new field set field=Fields(index) +"RTN","TMGSEQL1B",741,0) + . if $data(PtInfo(field)),$get(TMGARRAY(2,IENS,index))'=$get(PtInfo(field)) do +"RTN","TMGSEQL1B",742,0) + . . new value set value=$get(PtInfo(field)) +"RTN","TMGSEQL1B",743,0) + . . if index=.1112 do +"RTN","TMGSEQL1B",744,0) + . . . if +value'=0 set NewInfo(index)=value +"RTN","TMGSEQL1B",745,0) + . . else if (index=.09)&(+value'=0)&(+TMGARRAY(2,IENS,index)'=0) do +"RTN","TMGSEQL1B",746,0) + . . . if TMGARRAY(2,IENS,index)["P" do quit +"RTN","TMGSEQL1B",747,0) + . . . . set NewInfo(index)=value +"RTN","TMGSEQL1B",748,0) + . . . ;"we have CONFLICTING SOCIAL SECURITY NUMBERS --> PROBLEM... +"RTN","TMGSEQL1B",749,0) + . . . set ErrArray(0)="CONFLICTING SS-NUMBERS: " ;"NOTE! if error message format is changed, also change in TMGSEQL2 +"RTN","TMGSEQL1B",750,0) + . . . set ErrArray(0)=ErrArray(0)_"Sequel#="_PtInfo(field)_" vs. VistA#="_TMGARRAY(2,IENS,index) +"RTN","TMGSEQL1B",751,0) + . . . set abort=1,result=0 +"RTN","TMGSEQL1B",752,0) + . . else set NewInfo(index)=value +"RTN","TMGSEQL1B",753,0) + . . set UpdateNeeded=1 +"RTN","TMGSEQL1B",754,0) + . set index=$order(Fields(index)) +"RTN","TMGSEQL1B",755,0) + +"RTN","TMGSEQL1B",756,0) + if (UpdateNeeded=0)!(abort=1) goto UDBDone +"RTN","TMGSEQL1B",757,0) + +"RTN","TMGSEQL1B",758,0) + ;"Setup FDA array for database update +"RTN","TMGSEQL1B",759,0) + new TMGFDA +"RTN","TMGSEQL1B",760,0) + set index=$order(NewInfo("")) +"RTN","TMGSEQL1B",761,0) + if index'="" do +"RTN","TMGSEQL1B",762,0) + . for do quit:(+index'>0) +"RTN","TMGSEQL1B",763,0) + . . set TMGFDA(2,IENS,index)=NewInfo(index) +"RTN","TMGSEQL1B",764,0) + . . set index=$order(NewInfo(index)) +"RTN","TMGSEQL1B",765,0) + . ; +"RTN","TMGSEQL1B",766,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") +"RTN","TMGSEQL1B",767,0) + . if $data(TMGMSG("DIERR"))'=0 do ;"goto UDBDone +"RTN","TMGSEQL1B",768,0) + . . set result=0 +"RTN","TMGSEQL1B",769,0) + . . merge ErrArray=TMGMSG("DIERR") +"RTN","TMGSEQL1B",770,0) + +"RTN","TMGSEQL1B",771,0) + merge ChLog($get(Name,"?")_" "_$get(TMGDOB,"?"),1)=NewInfo +"RTN","TMGSEQL1B",772,0) + +"RTN","TMGSEQL1B",773,0) +UDBDone +"RTN","TMGSEQL1B",774,0) + quit result +"RTN","TMGSEQL1B",775,0) + +"RTN","TMGSEQL1B",776,0) + +"RTN","TMGSEQL1B",777,0) +GetDFN(PtInfo) +"RTN","TMGSEQL1B",778,0) + ;"Purpose: Serve as interface to ^TMGGDFN functions (using PtInfo as input) +"RTN","TMGSEQL1B",779,0) + ;"Input: PtInfo, Array of PtInfo, as defined in UpdateDB, and created by ParseLine +"RTN","TMGSEQL1B",780,0) + ;"Result: the IEN in file 2 (i.e. DFN) if found, otherwise 0 if not found. +"RTN","TMGSEQL1B",781,0) + +"RTN","TMGSEQL1B",782,0) + new Entry,Name,DOB,DFN +"RTN","TMGSEQL1B",783,0) + +"RTN","TMGSEQL1B",784,0) + set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME")) +"RTN","TMGSEQL1B",785,0) + set Name=$$FormatName^TMGMISC(Name) +"RTN","TMGSEQL1B",786,0) + set DOB=$get(PtInfo("DOB")) +"RTN","TMGSEQL1B",787,0) + +"RTN","TMGSEQL1B",788,0) + set Entry(.01)=Name +"RTN","TMGSEQL1B",789,0) + set Entry(.03)=DOB +"RTN","TMGSEQL1B",790,0) + set Entry(.02)=$get(PtInfo("SEX")) +"RTN","TMGSEQL1B",791,0) + set Entry(.09)=$get(PtInfo("SSNUM")) +"RTN","TMGSEQL1B",792,0) + set DFN=+$$LookupPatient^TMGGDFN(.Entry) ;"get IEN in file 2 of patient +"RTN","TMGSEQL1B",793,0) + ;"do an extended search with increasing intensity. +"RTN","TMGSEQL1B",794,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,1) +"RTN","TMGSEQL1B",795,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,2) +"RTN","TMGSEQL1B",796,0) + if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,3) +"RTN","TMGSEQL1B",797,0) + +"RTN","TMGSEQL1B",798,0) + quit DFN +"RTN","TMGSEQL1B",799,0) + +"RTN","TMGSEQL1B",800,0) + +"RTN","TMGSEQL1B",801,0) + +"RTN","TMGSEQL1B",802,0) +XtractSSNum(G2Ref,SSNArray) +"RTN","TMGSEQL1B",803,0) + ;"Purpose: To extract info from 2nd demographics file into an array of SSNums. +"RTN","TMGSEQL1B",804,0) + ;"Input: G2Ref - Name of global array holding 2nd demographics file +"RTN","TMGSEQL1B",805,0) + ;" Note: Format of each line is as follows: +"RTN","TMGSEQL1B",806,0) + ;" scratchNum,AccountNumber,LastName,FirstName,SSNUM ... (other data is redundant) +"RTN","TMGSEQL1B",807,0) + ;" i.e. SSNUM is the 5th piece +"RTN","TMGSEQL1B",808,0) + ;" SSNArray -- PASS BY REFERENCE. An OUT parameter. See format below +"RTN","TMGSEQL1B",809,0) + ;"Output: SSNArray will be filled as follows: +"RTN","TMGSEQL1B",810,0) + ;" SSNArray(SequelAccountNumber)=SSNum +"RTN","TMGSEQL1B",811,0) + ;"Result: None +"RTN","TMGSEQL1B",812,0) + ;"Note: 3/2/06 modification: +"RTN","TMGSEQL1B",813,0) + ;" An entry for every SequelAccountNumber will be created. If SSNum is invalid, it will +"RTN","TMGSEQL1B",814,0) + ;" be converted to 0, but an entry will still be created, i.e. +"RTN","TMGSEQL1B",815,0) + ;" SSNArray(SequelAccountNumber)=0 +"RTN","TMGSEQL1B",816,0) + +"RTN","TMGSEQL1B",817,0) + +"RTN","TMGSEQL1B",818,0) + new i +"RTN","TMGSEQL1B",819,0) + +"RTN","TMGSEQL1B",820,0) + set i=$order(@G2Ref@("")) +"RTN","TMGSEQL1B",821,0) + if i'="" for do quit:(i="") +"RTN","TMGSEQL1B",822,0) + . new OneLine,AcctNum,SSNum +"RTN","TMGSEQL1B",823,0) + . set OneLine=$get(@G2Ref@(i)) +"RTN","TMGSEQL1B",824,0) + . set AcctNum=$piece(OneLine,",",2) +"RTN","TMGSEQL1B",825,0) + . set SSNum=$$Trim^TMGSTUTL($piece(OneLine,",",5)) +"RTN","TMGSEQL1B",826,0) + . new value set value=0 ;"default value +"RTN","TMGSEQL1B",827,0) + . if +SSNum'<999999 do ;"force at least 6 digits --> allow 0000 11 1111 +"RTN","TMGSEQL1B",828,0) + . . if $length(SSNum)'=9 do +"RTN","TMGSEQL1B",829,0) + . . . set SSNArray("ERRORS",AcctNum)=SSNum ;"leaves value="" --> not used +"RTN","TMGSEQL1B",830,0) + . . else do +"RTN","TMGSEQL1B",831,0) + . . . ;"set SSNArray(AcctNum)=SSNum +"RTN","TMGSEQL1B",832,0) + . . . set value=SSNum +"RTN","TMGSEQL1B",833,0) + . set SSNArray(AcctNum)=value +"RTN","TMGSEQL1B",834,0) + . set i=$order(@G2Ref@(i)) +"RTN","TMGSEQL1B",835,0) + +"RTN","TMGSEQL1B",836,0) + quit +"RTN","TMGSEQL1B",837,0) + +"RTN","TMGSEQL1B",838,0) + +"RTN","TMGSEQL2") +0^76^B11873 +"RTN","TMGSEQL2",1,0) +TMGSEQL2 ;TMG/kst/Interface with SequelSystems PMS (Error Hndlng) ;03/25/06 +"RTN","TMGSEQL2",2,0) + ;;1.0;TMG-LIB;**1**;01/09/06 +"RTN","TMGSEQL2",3,0) + +"RTN","TMGSEQL2",4,0) + ;"TMG SEQUEL IMPORT ERROR-HANDLING FUNCTIONS +"RTN","TMGSEQL2",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGSEQL2",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSEQL2",7,0) + ;"1-9-2006 +"RTN","TMGSEQL2",8,0) + +"RTN","TMGSEQL2",9,0) + +"RTN","TMGSEQL2",10,0) + ;"======================================================================= +"RTN","TMGSEQL2",11,0) + ;" API -- Public Functions. +"RTN","TMGSEQL2",12,0) + ;"======================================================================= +"RTN","TMGSEQL2",13,0) + ;"AlertError(OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",14,0) + ;"HANDLE +"RTN","TMGSEQL2",15,0) + +"RTN","TMGSEQL2",16,0) + +"RTN","TMGSEQL2",17,0) + ;"======================================================================= +"RTN","TMGSEQL2",18,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGSEQL2",19,0) + ;"======================================================================= +"RTN","TMGSEQL2",20,0) + ;"EditOneLine(LineIn,LineOut) +"RTN","TMGSEQL2",21,0) + ;"MakeErrAlert(IEN,User,PtInfo) +"RTN","TMGSEQL2",22,0) + ;"$$StoreError(OneLine,PtInfo,ErrArray) +"RTN","TMGSEQL2",23,0) + ;"ErrRefile(OneLine,PtInfo,OneErrArray,DUZ) +"RTN","TMGSEQL2",24,0) + +"RTN","TMGSEQL2",25,0) + ;"$$FixRegProblem(PtInfo,OneLine,DelError) +"RTN","TMGSEQL2",26,0) + ;"$$FixGenProblem(PtInfo,ErrMsg,OneLine,ErrIEN,DelError) +"RTN","TMGSEQL2",27,0) + ;"$$FixSSNProblem(PtInfo,ErrMsg,OneLine,DelError) +"RTN","TMGSEQL2",28,0) + ;"$$FixDOBProblem(.PtInfo,ErrMsg,.OneLine,.DelError) +"RTN","TMGSEQL2",29,0) + +"RTN","TMGSEQL2",30,0) + ;"$$GetSex(Name) +"RTN","TMGSEQL2",31,0) + ;"$$SetSex(Name,Sex) +"RTN","TMGSEQL2",32,0) + ;"$$NameError(OneErrArray) +"RTN","TMGSEQL2",33,0) + +"RTN","TMGSEQL2",34,0) + ;"$$IsMissingSex(ErrArray) +"RTN","TMGSEQL2",35,0) + ;"$$GetSexMissing(PtInfo) +"RTN","TMGSEQL2",36,0) + +"RTN","TMGSEQL2",37,0) + ;"======================================================================= +"RTN","TMGSEQL2",38,0) + ;"DEPENDENCIES +"RTN","TMGSEQL2",39,0) + ;"TMGSEQL1 +"RTN","TMGSEQL2",40,0) + ;"TMGSTUTL +"RTN","TMGSEQL2",41,0) + ;"TMGDEBUG +"RTN","TMGSEQL2",42,0) + ;"======================================================================= +"RTN","TMGSEQL2",43,0) + ;"======================================================================= +"RTN","TMGSEQL2",44,0) + +"RTN","TMGSEQL2",45,0) + +"RTN","TMGSEQL2",46,0) +EditOneLine(LineIn,LineOut) +"RTN","TMGSEQL2",47,0) + ;"Purpose: To allow modification of a line to allow filing. +"RTN","TMGSEQL2",48,0) + ;"Input: LineIn -- The CSV line to modify. +"RTN","TMGSEQL2",49,0) + ;" LineOut -- PASS BY REFERENCE, the variable to receive changes +"RTN","TMGSEQL2",50,0) + ;"Result: 1 if changes made, 0 if no changes made, -1 if abort +"RTN","TMGSEQL2",51,0) + +"RTN","TMGSEQL2",52,0) + new tempArray +"RTN","TMGSEQL2",53,0) + new done set done=0 +"RTN","TMGSEQL2",54,0) + new abort set abort=0 +"RTN","TMGSEQL2",55,0) + set LineOut=$get(LineIn) +"RTN","TMGSEQL2",56,0) + new SavedInput set SavedInput=LineIn +"RTN","TMGSEQL2",57,0) + new result set result=0 +"RTN","TMGSEQL2",58,0) + new temp +"RTN","TMGSEQL2",59,0) + +"RTN","TMGSEQL2",60,0) + if $get(LineIn)="" do goto EOLDone +"RTN","TMGSEQL2",61,0) + . write !,"?? No data supplied to edit!",! +"RTN","TMGSEQL2",62,0) + +"RTN","TMGSEQL2",63,0) + for do quit:(done)!(abort) +"RTN","TMGSEQL2",64,0) + . write !,"CSV Line Editor:",! +"RTN","TMGSEQL2",65,0) + . write "------------------",! +"RTN","TMGSEQL2",66,0) + . write "1. Show raw CSV line data.",! +"RTN","TMGSEQL2",67,0) + . write "2. Show resulting parsed array from data.",! +"RTN","TMGSEQL2",68,0) + . write "3. Modify a specified piece (part) of data.",! +"RTN","TMGSEQL2",69,0) + . write "4. Display number of pieces, and current values.",! +"RTN","TMGSEQL2",70,0) + . write "5. Quit.",! +"RTN","TMGSEQL2",71,0) + . write "^. Abort changes.",! +"RTN","TMGSEQL2",72,0) + . read !,"Enter Choice: ^// ",temp:$get(DTIME,3600),! +"RTN","TMGSEQL2",73,0) + . if temp="" set temp="^" +"RTN","TMGSEQL2",74,0) + . if temp=1 do +"RTN","TMGSEQL2",75,0) + . . write OneLine,! +"RTN","TMGSEQL2",76,0) + . else if temp=2 do +"RTN","TMGSEQL2",77,0) + . . new Array,prsResult +"RTN","TMGSEQL2",78,0) + . . set prsResult=$$ParseLine^TMGSEQL1(LineOut,.Array) +"RTN","TMGSEQL2",79,0) + . . if prsResult'=0 do ArrayDump^TMGDEBUG("Array") +"RTN","TMGSEQL2",80,0) + . . ;"else if prsResult=0 write "There was either a problem parsing this info",! +"RTN","TMGSEQL2",81,0) + . . ;"else if prsResult-1 write "This patient is inactive, and should be ignored",! +"RTN","TMGSEQL2",82,0) + . else if temp=3 do +"RTN","TMGSEQL2",83,0) + . . new P,value +"RTN","TMGSEQL2",84,0) + . . write "Which piece do you want to edit? (i.e. 1 for first CSV value, 2 for the second etc.)",! +"RTN","TMGSEQL2",85,0) + . . read "Which piece?: ",P:$get(DTIME,3600),! +"RTN","TMGSEQL2",86,0) + . . if P="^" set abort=1 quit +"RTN","TMGSEQL2",87,0) + . . if +P=0 write "Please enter a numeric value.",! quit +"RTN","TMGSEQL2",88,0) + . . write "The current value for this piece is: ",$piece(LineOut,",",P),! +"RTN","TMGSEQL2",89,0) + . . read "Enter new value (^ to abort): ",value,! +"RTN","TMGSEQL2",90,0) + . . if value="^" quit +"RTN","TMGSEQL2",91,0) + . . set $piece(LineOut,",",P)=value +"RTN","TMGSEQL2",92,0) + . . set result=1 +"RTN","TMGSEQL2",93,0) + . else if temp=4 do +"RTN","TMGSEQL2",94,0) + . . new i for i=1:1:20 do +"RTN","TMGSEQL2",95,0) + . . . write "Piece #",i," = ",$piece(LineOut,",",i),! +"RTN","TMGSEQL2",96,0) + . else if temp=5 do +"RTN","TMGSEQL2",97,0) + . . set done=1 +"RTN","TMGSEQL2",98,0) + . else if temp="^" do +"RTN","TMGSEQL2",99,0) + . . set abort=1 +"RTN","TMGSEQL2",100,0) + . else do quit +"RTN","TMGSEQL2",101,0) + . . write "Please enter a valid choice, or ^ to abort.",! +"RTN","TMGSEQL2",102,0) + +"RTN","TMGSEQL2",103,0) + +"RTN","TMGSEQL2",104,0) +EOLDone +"RTN","TMGSEQL2",105,0) + if abort do +"RTN","TMGSEQL2",106,0) + . set result=-1 +"RTN","TMGSEQL2",107,0) + . set LineOut=SavedInput +"RTN","TMGSEQL2",108,0) + +"RTN","TMGSEQL2",109,0) + quit result +"RTN","TMGSEQL2",110,0) + +"RTN","TMGSEQL2",111,0) + +"RTN","TMGSEQL2",112,0) +AlertError(OneLine,PtInfo,OneErrArray,DUZ) +"RTN","TMGSEQL2",113,0) + ;"Purpose: To put the error information info into TMG DEMOGRAPHICS IMPORT ERRORS (22706) +"RTN","TMGSEQL2",114,0) + ;" and to create a corresponding alert +"RTN","TMGSEQL2",115,0) + ;"Input: OneLine -- The original CVS format data line +"RTN","TMGSEQL2",116,0) + ;" PtInfo -- PASS BY REFERENCE. an array containing patient info, as created by ParseLine() +"RTN","TMGSEQL2",117,0) + ;" ErrArray -- PASS BY REFERENCE. The Array containing the error information, +"RTN","TMGSEQL2",118,0) + ;" with following format: +"RTN","TMGSEQL2",119,0) + ;" ErrArray(0)=local message (if any) +"RTN","TMGSEQL2",120,0) + ;" ErrArray("DIERR")=Standard fileman DIERR array. +"RTN","TMGSEQL2",121,0) + ;" User -- the IEN in file 200 (i.e. DUZ) of user to receive alert. +"RTN","TMGSEQL2",122,0) + ;"Output: new record is created in file 22706 +"RTN","TMGSEQL2",123,0) + ;"Result: none +"RTN","TMGSEQL2",124,0) + +"RTN","TMGSEQL2",125,0) + new IEN,Msg +"RTN","TMGSEQL2",126,0) + set IEN=$$StoreError^TMGSEQL2(OneLine,.PtInfo,.OneErrArray) +"RTN","TMGSEQL2",127,0) + set Msg=$get(OneErrArray(0),"Problem with upload of Sequel data for:") +"RTN","TMGSEQL2",128,0) + set Msg=$piece(Msg,":",1) +"RTN","TMGSEQL2",129,0) + set Msg=Msg_" "_$get(PtInfo("FULL NAME")) +"RTN","TMGSEQL2",130,0) + do MakeErrAlert^TMGSEQL2(IEN,DUZ,Msg) +"RTN","TMGSEQL2",131,0) + +"RTN","TMGSEQL2",132,0) + quit +"RTN","TMGSEQL2",133,0) + +"RTN","TMGSEQL2",134,0) + +"RTN","TMGSEQL2",135,0) +StoreError(OneLine,PtInfo,ErrArray) +"RTN","TMGSEQL2",136,0) + ;"Purpose: To put the error information info into TMG DEMOGRAPHICS IMPORT ERRORS (22706) +"RTN","TMGSEQL2",137,0) + ;"Input: OneLine -- The original CVS format data line +"RTN","TMGSEQL2",138,0) + ;" PtInfo -- PASS BY REFERENCE. an array containing patient info, as created by ParseLine() +"RTN","TMGSEQL2",139,0) + ;" ErrArray -- PASS BY REFERENCE. The Array containing the error information, +"RTN","TMGSEQL2",140,0) + ;" with following format: +"RTN","TMGSEQL2",141,0) + ;" ErrArray(0)=local message (if any) +"RTN","TMGSEQL2",142,0) + ;" ErrArray("DIERR")=Standard fileman DIERR array. +"RTN","TMGSEQL2",143,0) + ;"Output: new record is created in file 22706 +"RTN","TMGSEQL2",144,0) + ;"Result: IEN of newly created record (or 0 if error). +"RTN","TMGSEQL2",145,0) + +"RTN","TMGSEQL2",146,0) + new result set result=0 +"RTN","TMGSEQL2",147,0) + new TMGFDA,Name +"RTN","TMGSEQL2",148,0) + set Name=$get(PtInfo("FULL NAME3")) +"RTN","TMGSEQL2",149,0) + set Msg=$get(ErrArray(0)) +"RTN","TMGSEQL2",150,0) + +"RTN","TMGSEQL2",151,0) + set TMGFDA(22706,"+1,",.01)=$get(PtInfo("SEQUEL ACCOUNT NUM")) ;".01=ACCOUNT NUMBER +"RTN","TMGSEQL2",152,0) + set TMGFDA(22706,"+1,",.02)="NOW" ;".02=CREATION DATE +"RTN","TMGSEQL2",153,0) + set TMGFDA(22706,"+1,",.03)=Name ;".03=PATIENT NAME +"RTN","TMGSEQL2",154,0) + if Msg'="" set TMGFDA(22706,"+1,",1)=Msg ;"1=MESSAGE +"RTN","TMGSEQL2",155,0) + new TMGIENA,TMGERR +"RTN","TMGSEQL2",156,0) + do UPDATE^DIE("E","TMGFDA","TMGIENA","TMGERR") +"RTN","TMGSEQL2",157,0) + new IEN set IEN=$get(TMGIENA(1)) +"RTN","TMGSEQL2",158,0) + +"RTN","TMGSEQL2",159,0) + new TMGWP +"RTN","TMGSEQL2",160,0) + new TMGDIERR merge TMGDIERR("DIERR")=ErrArray("DIERR") +"RTN","TMGSEQL2",161,0) + new ErrStr set ErrStr=$$GetErrStr^TMGDEBUG(.TMGDIERR) +"RTN","TMGSEQL2",162,0) + if ErrStr'="" do +"RTN","TMGSEQL2",163,0) + . do StrToWP^TMGSTUTL(ErrStr,"TMGWP",60," ") +"RTN","TMGSEQL2",164,0) + . if +IEN>0 do +"RTN","TMGSEQL2",165,0) + . . do WP^DIE(22706,IEN_",",3,,"TMGWP","TMGERR") ;"3=DIERR MESSAGE +"RTN","TMGSEQL2",166,0) + . . new PriorErrorFound set PriorErrorFound=0 +"RTN","TMGSEQL2",167,0) + . . if $data(TMGERR("DIERR")) do ShowDIERR^TMGDEBUG(.TMGERR,.PriorErrorFound) +"RTN","TMGSEQL2",168,0) + +"RTN","TMGSEQL2",169,0) + kill TMGWP +"RTN","TMGSEQL2",170,0) + do StrToWP^TMGSTUTL(OneLine,"TMGWP",60,",") +"RTN","TMGSEQL2",171,0) + if +IEN>0 do +"RTN","TMGSEQL2",172,0) + . do WP^DIE(22706,IEN_",",2,,"TMGWP","TMGERR") ;"2=IMPORT DATA +"RTN","TMGSEQL2",173,0) + . new PriorErrorFound set PriorErrorFound=0 +"RTN","TMGSEQL2",174,0) + . if $data(TMGERR("DIERR")) do ShowDIERR^TMGDEBUG(.TMGERR,.PriorErrorFound) +"RTN","TMGSEQL2",175,0) + +"RTN","TMGSEQL2",176,0) + set result=IEN +"RTN","TMGSEQL2",177,0) + +"RTN","TMGSEQL2",178,0) + quit result +"RTN","TMGSEQL2",179,0) + +"RTN","TMGSEQL2",180,0) + +"RTN","TMGSEQL2",181,0) +MakeErrAlert(IEN,User,Message) +"RTN","TMGSEQL2",182,0) + ;"Purpose: To create an alert regarding upload error +"RTN","TMGSEQL2",183,0) + ;"Input: IEN -- The IEN of the error, stored in file 22706 +"RTN","TMGSEQL2",184,0) + ;" User -- the IEN in file 200 (i.e. DUZ) of user to receive alert. +"RTN","TMGSEQL2",185,0) + ;" Message -- the Message of the alert +"RTN","TMGSEQL2",186,0) + ;"Output: An alert will be created in send to User +"RTN","TMGSEQL2",187,0) + ;"Result: none +"RTN","TMGSEQL2",188,0) + +"RTN","TMGSEQL2",189,0) + new XQA,XQAMSG,XQAID +"RTN","TMGSEQL2",190,0) + new XQAOPT ;" ensure no residual menu option specified +"RTN","TMGSEQL2",191,0) + +"RTN","TMGSEQL2",192,0) + set XQA(User)="" +"RTN","TMGSEQL2",193,0) + set XQAMSG=Message +"RTN","TMGSEQL2",194,0) + set XQAID="TMGSQLIMPORT" +"RTN","TMGSEQL2",195,0) + set XQADATA=IEN +"RTN","TMGSEQL2",196,0) + set XQAROU="HANDLE^TMGSEQL2" +"RTN","TMGSEQL2",197,0) + +"RTN","TMGSEQL2",198,0) + do SETUP^XQALERT +"RTN","TMGSEQL2",199,0) + +"RTN","TMGSEQL2",200,0) + quit +"RTN","TMGSEQL2",201,0) + +"RTN","TMGSEQL2",202,0) +ErrRefile(OneLine,PtInfo,OneErrArray,DUZ) +"RTN","TMGSEQL2",203,0) + ;"Purpose: A common point to process errors encountering errors on refilling +"RTN","TMGSEQL2",204,0) + ;"Input: OneLine -- the originial CSV data line. +"RTN","TMGSEQL2",205,0) + ;" PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1 +"RTN","TMGSEQL2",206,0) + ;" OneErrArray -- PASS BY REFERENCE -- The error array encountered, returned from Fileman +"RTN","TMGSEQL2",207,0) + ;" DUZ -- the user IEN (from file 2) to recieve alert +"RTN","TMGSEQL2",208,0) + ;"Output: A new alert will be created, and messages written to screen +"RTN","TMGSEQL2",209,0) + ;"Result : none +"RTN","TMGSEQL2",210,0) + +"RTN","TMGSEQL2",211,0) + write "There is still an error:",! +"RTN","TMGSEQL2",212,0) + zwr OneErrArray(*) +"RTN","TMGSEQL2",213,0) + write "A new alert will be made to handle this new error.",! +"RTN","TMGSEQL2",214,0) + set OneErrArray(0)=$$NameError(.OneErrArray) +"RTN","TMGSEQL2",215,0) + write OneErrArray(0),! +"RTN","TMGSEQL2",216,0) + do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",217,0) + +"RTN","TMGSEQL2",218,0) + quit +"RTN","TMGSEQL2",219,0) + +"RTN","TMGSEQL2",220,0) +HANDLE +"RTN","TMGSEQL2",221,0) + ;"Purpose: This is called by the alert system to handle the error alert +"RTN","TMGSEQL2",222,0) + ;"Input: All the inputs are via variables with global scope. Details below +"RTN","TMGSEQL2",223,0) + ;" XQADATA-- the IEN in file 22706 +"RTN","TMGSEQL2",224,0) + ;" XQAKILL-- 1 --> kill when done. To alter behavior, this function can change +"RTN","TMGSEQL2",225,0) + ;" (to prevent deletion when done, then KILL XQAKILL) +"RTN","TMGSEQL2",226,0) + ;"Output: Allows user to edit data and reattempt filing of data +"RTN","TMGSEQL2",227,0) + ;"Result: none. +"RTN","TMGSEQL2",228,0) + +"RTN","TMGSEQL2",229,0) + +"RTN","TMGSEQL2",230,0) + new Fixed set Fixed=0 +"RTN","TMGSEQL2",231,0) + +"RTN","TMGSEQL2",232,0) + new OneLine,PtInfo +"RTN","TMGSEQL2",233,0) + new TMGWP,TMGMSG +"RTN","TMGSEQL2",234,0) + new tempResult +"RTN","TMGSEQL2",235,0) + new ErrIEN +"RTN","TMGSEQL2",236,0) + new DelError set DelError=0 +"RTN","TMGSEQL2",237,0) + +"RTN","TMGSEQL2",238,0) + if $get(XQADATA)'>0 do goto HndDone +"RTN","TMGSEQL2",239,0) + . write !!,"No value in XQADATA, so quitting.",! +"RTN","TMGSEQL2",240,0) + . write "(Deleting alert.)",! +"RTN","TMGSEQL2",241,0) + . set Fixed=1,DelError=1 +"RTN","TMGSEQL2",242,0) + set ErrIEN=XQADATA +"RTN","TMGSEQL2",243,0) + +"RTN","TMGSEQL2",244,0) + write !!,"Problem with upload of Sequel data. ",! +"RTN","TMGSEQL2",245,0) + +"RTN","TMGSEQL2",246,0) + ;"temp +"RTN","TMGSEQL2",247,0) + write "IEN in file# 22706=",ErrIEN,! +"RTN","TMGSEQL2",248,0) + +"RTN","TMGSEQL2",249,0) + new x set x=$$GET1^DIQ(22706,ErrIEN_",",2,"","TMGWP","TMGMSG") +"RTN","TMGSEQL2",250,0) + if $data(TMGMSG("DIERR"))'=0 do goto HndDone +"RTN","TMGSEQL2",251,0) + . new PriorErrorFound +"RTN","TMGSEQL2",252,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL2",253,0) + . set Fixed=1,DelError=1 +"RTN","TMGSEQL2",254,0) + set OneLine=$$WPToStr^TMGSTUTL("TMGWP","") +"RTN","TMGSEQL2",255,0) + if $$ParseLine^TMGSEQL1(OneLine,.PtInfo)=0 do goto HndDone +"RTN","TMGSEQL2",256,0) + . write "Error parsing Alert data into patient data.",! +"RTN","TMGSEQL2",257,0) + write $get(PtInfo("FULL NAME")),! +"RTN","TMGSEQL2",258,0) + +"RTN","TMGSEQL2",259,0) + new ErrMsg set ErrMsg=$$GET1^DIQ(22706,ErrIEN_",",1) +"RTN","TMGSEQL2",260,0) + write ErrMsg,! +"RTN","TMGSEQL2",261,0) + +"RTN","TMGSEQL2",262,0) + kill TMGWP,TMGMSG +"RTN","TMGSEQL2",263,0) + new x set x=$$GET1^DIQ(22706,ErrIEN_",",3,"","TMGWP","TMGMSG") +"RTN","TMGSEQL2",264,0) + if $data(TMGMSG("DIERR"))'=0 do goto HndDone +"RTN","TMGSEQL2",265,0) + . new PriorErrorFound +"RTN","TMGSEQL2",266,0) + . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound) +"RTN","TMGSEQL2",267,0) + . set Fixed=1,DelError=1 +"RTN","TMGSEQL2",268,0) + if $data(TMGWP) do +"RTN","TMGSEQL2",269,0) + . do WriteWP^TMGSTUTL("TMGWP") +"RTN","TMGSEQL2",270,0) + +"RTN","TMGSEQL2",271,0) + if ErrMsg["PATIENT NOT IN DATABASE" do +"RTN","TMGSEQL2",272,0) + . set Fixed=$$FixRegProblem(.PtInfo,.OneLine,.DelError) +"RTN","TMGSEQL2",273,0) + else if ErrMsg["INVALID/MISSING GENDER" do +"RTN","TMGSEQL2",274,0) + . set Fixed=$$FixRegProblem(.PtInfo,.OneLine,.DelError) +"RTN","TMGSEQL2",275,0) + else if ErrMsg["CONFLICTING SS-NUMBERS" do +"RTN","TMGSEQL2",276,0) + . set Fixed=$$FixSSNProblem(.PtInfo,ErrMsg,.OneLine,.DelError) +"RTN","TMGSEQL2",277,0) + else if ErrMsg["INVALID DOB ERROR" do +"RTN","TMGSEQL2",278,0) + . write "Date of birth (DOB) is incorrect for this patient.",! +"RTN","TMGSEQL2",279,0) + . write "Note: The recommended method of correcting this problem is",! +"RTN","TMGSEQL2",280,0) + . write " to fix the problem in Sequel, not here. Otherwise",! +"RTN","TMGSEQL2",281,0) + . write " the same error will be encountered with each demographics",! +"RTN","TMGSEQL2",282,0) + . write " upload.",!! +"RTN","TMGSEQL2",283,0) + . set Fixed=$$FixGenProblem(.PtInfo,ErrMsg,.OneLine,.DelError) +"RTN","TMGSEQL2",284,0) + else do +"RTN","TMGSEQL2",285,0) + . set Fixed=$$FixGenProblem(.PtInfo,ErrMsg,.OneLine,.DelError,ErrIEN) +"RTN","TMGSEQL2",286,0) + +"RTN","TMGSEQL2",287,0) + if DelError=1 do +"RTN","TMGSEQL2",288,0) + . new temp,ErrArray +"RTN","TMGSEQL2",289,0) + . set temp=$$DelIEN^TMGDBAPI(22706,ErrIEN,.ErrArray) ;"success, so kill error entry in 22706 +"RTN","TMGSEQL2",290,0) + +"RTN","TMGSEQL2",291,0) +HndDone +"RTN","TMGSEQL2",292,0) + ;"if Fixed=1 write !,"SUCCESS!" +"RTN","TMGSEQL2",293,0) + +"RTN","TMGSEQL2",294,0) + if (Fixed=0)!(DelError=0) do ;"<------------- this logic may be off... +"RTN","TMGSEQL2",295,0) + . kill XQAKILL ;"--> don't delete alert +"RTN","TMGSEQL2",296,0) + . write "(Saving alert...)",! +"RTN","TMGSEQL2",297,0) + +"RTN","TMGSEQL2",298,0) + quit +"RTN","TMGSEQL2",299,0) + +"RTN","TMGSEQL2",300,0) + +"RTN","TMGSEQL2",301,0) +FixRegProblem(PtInfo,OneLine,DelError) +"RTN","TMGSEQL2",302,0) + ;"Purpose: To fix problems where patient couldn't be added to the database +"RTN","TMGSEQL2",303,0) + ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1 +"RTN","TMGSEQL2",304,0) + ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert +"RTN","TMGSEQL2",305,0) + ;" must be created, in which case it is stored in the new error message. +"RTN","TMGSEQL2",306,0) + ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error +"RTN","TMGSEQL2",307,0) + ;" record in file 22706 +"RTN","TMGSEQL2",308,0) + ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error +"RTN","TMGSEQL2",309,0) + ;" in file 22706 will deleted +"RTN","TMGSEQL2",310,0) + ;"Result: 1=problem fixed, 0=not fixed. +"RTN","TMGSEQL2",311,0) + +"RTN","TMGSEQL2",312,0) + new Fixed set Fixed=0 +"RTN","TMGSEQL2",313,0) + set DelError=0 +"RTN","TMGSEQL2",314,0) + new TMGRemSex,InitRemSex +"RTN","TMGSEQL2",315,0) + set TMGRemSex=+$$GET1^DIQ(22711,"1,","PICK GENDER FROM NAME?","I") +"RTN","TMGSEQL2",316,0) + set InitRemSex=TMGRemSex +"RTN","TMGSEQL2",317,0) + +"RTN","TMGSEQL2",318,0) + new AutoRegister set AutoRegister=1 ;"automatically add patient to database if not found +"RTN","TMGSEQL2",319,0) + new OneErrArray,ChgLog +"RTN","TMGSEQL2",320,0) + new done set done=0 +"RTN","TMGSEQL2",321,0) + for do quit:(done=1) +"RTN","TMGSEQL2",322,0) + . kill OneErrArray,ChgLog +"RTN","TMGSEQL2",323,0) + . new tempResult +"RTN","TMGSEQL2",324,0) + . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error +"RTN","TMGSEQL2",325,0) + . set DelError=1 +"RTN","TMGSEQL2",326,0) + . set Fixed=1 +"RTN","TMGSEQL2",327,0) + . set done=1 +"RTN","TMGSEQL2",328,0) + . if tempResult=0 do +"RTN","TMGSEQL2",329,0) + . . if $$IsMissingSex(.OneErrArray)=1 do +"RTN","TMGSEQL2",330,0) + . . . if $$GetSexMissing(.PtInfo,.TMGRemSex)=0 do +"RTN","TMGSEQL2",331,0) + . . . . set done=1 ;"0=failed +"RTN","TMGSEQL2",332,0) + . . . . set Fixed=0 +"RTN","TMGSEQL2",333,0) + . . else do +"RTN","TMGSEQL2",334,0) + . . . write "There is still an error:",! +"RTN","TMGSEQL2",335,0) + . . . ;"zwr OneErrArray(*) +"RTN","TMGSEQL2",336,0) + . . . write "A new alert will be made to handle this new error.",! +"RTN","TMGSEQL2",337,0) + . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",338,0) + . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray) +"RTN","TMGSEQL2",339,0) + . . . ;"write OneErrArray(0),! +"RTN","TMGSEQL2",340,0) + . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",341,0) + +"RTN","TMGSEQL2",342,0) + if TMGRemSex'=InitRemSex do ;"if status of auto-pick gender was changed in GetSexMissing, store in settings. +"RTN","TMGSEQL2",343,0) + . new TMGFDA,TMGMSG +"RTN","TMGSEQL2",344,0) + . set TMGFDA(22711,"1,",6)=TMGRemSex ;"field# 6='PICK GENDER FROM NAME?' +"RTN","TMGSEQL2",345,0) + . do FILE^DIE("E","TMGFDA","TMGMSG") ;"note TMGMSG is ignored here... +"RTN","TMGSEQL2",346,0) + +"RTN","TMGSEQL2",347,0) + quit Fixed +"RTN","TMGSEQL2",348,0) + +"RTN","TMGSEQL2",349,0) +IsMissingSex(ErrArray) +"RTN","TMGSEQL2",350,0) + ;"Purpose: To analyze a Fileman error array and see if field .02 (SEX) is missing, causing problem +"RTN","TMGSEQL2",351,0) + ;"Input: ErrArray -- PASS BY REFERENCE, an error message, as created by Fileman while adding patient. +"RTN","TMGSEQL2",352,0) + ;"Result: 1=missing sex (.02 field), other 0 +"RTN","TMGSEQL2",353,0) + ;"Note: this only reviews error #1 (ignores other errors, if present. So, if missing sex error +"RTN","TMGSEQL2",354,0) + ;" was in position #2, this function WOULD RETURN AN ERRORONEOUS ANSWER. +"RTN","TMGSEQL2",355,0) + +"RTN","TMGSEQL2",356,0) + new result set result=0 +"RTN","TMGSEQL2",357,0) + +"RTN","TMGSEQL2",358,0) + if $data(ErrArray("DIERR","E",311,1)) do ;"311=The record lacks some required identifiers. +"RTN","TMGSEQL2",359,0) + . if $get(ErrArray("DIERR",1,"PARAM","FIELD"))'=.02 quit +"RTN","TMGSEQL2",360,0) + . if $get(ErrArray("DIERR",1,"PARAM","FILE"))'=2 quit +"RTN","TMGSEQL2",361,0) + . set result=1 +"RTN","TMGSEQL2",362,0) + +"RTN","TMGSEQL2",363,0) + quit result +"RTN","TMGSEQL2",364,0) + +"RTN","TMGSEQL2",365,0) + +"RTN","TMGSEQL2",366,0) + +"RTN","TMGSEQL2",367,0) + +"RTN","TMGSEQL2",368,0) +GetSexMissing(PtInfo,TMGRemSex) +"RTN","TMGSEQL2",369,0) + ;"Purpose: To correct the PtInfo Array so that SEX is supplied answer. +"RTN","TMGSEQL2",370,0) + ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1 +"RTN","TMGSEQL2",371,0) + ;" TMGRemSex --PASS BY REFERENCE -- 1 if OK to automatically pick sex based on gender of name +"RTN","TMGSEQL2",372,0) + ;"Output: PtInfo should be filled with SEX of patient +"RTN","TMGSEQL2",373,0) + ;"Result: 1=OK to continue, 0=failed to get SEX +"RTN","TMGSEQL2",374,0) + +"RTN","TMGSEQL2",375,0) + new result set result=0 ;"default to failure +"RTN","TMGSEQL2",376,0) + new temp set temp="" +"RTN","TMGSEQL2",377,0) + new Abort set Abort=0 +"RTN","TMGSEQL2",378,0) + +"RTN","TMGSEQL2",379,0) + if $get(PtInfo("SEX"))'="" set result=1 goto GSMDone +"RTN","TMGSEQL2",380,0) + if $get(PtInfo("FULL NAME"))="" goto GSMDone +"RTN","TMGSEQL2",381,0) + new FName set FName=$get(PtInfo("FIRST NAME")) +"RTN","TMGSEQL2",382,0) + if FName="" goto GSMDone +"RTN","TMGSEQL2",383,0) + +"RTN","TMGSEQL2",384,0) + for do quit:(temp'="")!(Abort=1) +"RTN","TMGSEQL2",385,0) + . new presumedSex,RemName +"RTN","TMGSEQL2",386,0) + . set CurrentSex="" +"RTN","TMGSEQL2",387,0) + . set TMGRemSex=$get(TMGRemSex,0) +"RTN","TMGSEQL2",388,0) + . write "Trying to determine the SEX of: ",PtInfo("FULL NAME"),!! +"RTN","TMGSEQL2",389,0) + . write "OPTIONS:",! +"RTN","TMGSEQL2",390,0) + . write "-----------------",! +"RTN","TMGSEQL2",391,0) + . write "M or MALE --> Name is MALE",! +"RTN","TMGSEQL2",392,0) + . write "M! or MALE! --> ALWAYS consider this name as MALE",! +"RTN","TMGSEQL2",393,0) + . write "F or FEMALE --> Name is FEMALE",! +"RTN","TMGSEQL2",394,0) + . write "F! or FEMALE! --> ALWAYS consider this name as FEMALE",! +"RTN","TMGSEQL2",395,0) + . write "AUTO --> Turn auto-pick-gender: ",$select(TMGRemSex=1:"OFF",1:"ON"),! +"RTN","TMGSEQL2",396,0) + . write "^ Abort",! +"RTN","TMGSEQL2",397,0) + . set presumedSex=$$GetSex(FName) +"RTN","TMGSEQL2",398,0) + . write "Is ",FName," MALE or FEMALE? ",presumedSex,"//" +"RTN","TMGSEQL2",399,0) + . if (TMGRemSex=1)&(presumedSex'="") set temp=presumedSex +"RTN","TMGSEQL2",400,0) + . else read temp:$get(DTIME,3600) +"RTN","TMGSEQL2",401,0) + . if temp="" set temp=presumedSex +"RTN","TMGSEQL2",402,0) + . set RemName=(temp["!") +"RTN","TMGSEQL2",403,0) + . set temp=$translate(temp,"!","") +"RTN","TMGSEQL2",404,0) + . set temp=$$UP^XLFSTR(temp) +"RTN","TMGSEQL2",405,0) + . if (temp="M")!(temp="MALE") set CurrentSex="MALE" +"RTN","TMGSEQL2",406,0) + . else if (temp="F")!(temp="FEMALE") set CurrentSex="FEMALE" +"RTN","TMGSEQL2",407,0) + . else if temp="^" do quit +"RTN","TMGSEQL2",408,0) + . . write "aborting..",! +"RTN","TMGSEQL2",409,0) + . . set Abort=1 +"RTN","TMGSEQL2",410,0) + . else if temp="AUTO" do +"RTN","TMGSEQL2",411,0) + . . set TMGRemSex='(TMGRemSex) +"RTN","TMGSEQL2",412,0) + . if CurrentSex'="" do quit +"RTN","TMGSEQL2",413,0) + . . write " ",CurrentSex,! +"RTN","TMGSEQL2",414,0) + . . set PtInfo("SEX")=CurrentSex +"RTN","TMGSEQL2",415,0) + . . set result=1 +"RTN","TMGSEQL2",416,0) + . . if RemName do +"RTN","TMGSEQL2",417,0) + . . . new temp set temp=$$SetSex(FName,CurrentSex) +"RTN","TMGSEQL2",418,0) + . set temp="" ;" a signal to try again. +"RTN","TMGSEQL2",419,0) + +"RTN","TMGSEQL2",420,0) +GSMDone +"RTN","TMGSEQL2",421,0) + quit result +"RTN","TMGSEQL2",422,0) + +"RTN","TMGSEQL2",423,0) + +"RTN","TMGSEQL2",424,0) +FixSSNProblem(PtInfo,ErrMsg,OneLine,DelError) +"RTN","TMGSEQL2",425,0) + ;"Purpose: To fix problems of conflicting SS numbers +"RTN","TMGSEQL2",426,0) + ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1 +"RTN","TMGSEQL2",427,0) + ;" ErrMsg -- the message that holds the conflicting SSNums +"RTN","TMGSEQL2",428,0) + ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert +"RTN","TMGSEQL2",429,0) + ;" must be created, in which case it is stored in the new error message. +"RTN","TMGSEQL2",430,0) + ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error +"RTN","TMGSEQL2",431,0) + ;" record in file 22706 +"RTN","TMGSEQL2",432,0) + ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error +"RTN","TMGSEQL2",433,0) + ;" in file 22706 will deleted +"RTN","TMGSEQL2",434,0) + ;"Result: 1=problem fixed, 0=not fixed. +"RTN","TMGSEQL2",435,0) + +"RTN","TMGSEQL2",436,0) + new sqSSNum,vSSNum +"RTN","TMGSEQL2",437,0) + new Fixed set Fixed=0 +"RTN","TMGSEQL2",438,0) + new done set done=0 +"RTN","TMGSEQL2",439,0) + set DelError=0 +"RTN","TMGSEQL2",440,0) + +"RTN","TMGSEQL2",441,0) + if $get(ErrMsg)="" goto FSNPDone +"RTN","TMGSEQL2",442,0) + +"RTN","TMGSEQL2",443,0) + if ErrMsg["(Sequel#)" do ;"old format +"RTN","TMGSEQL2",444,0) + . set sqSSN=$piece(ErrMsg,"SS-NUMBERS: ",2) +"RTN","TMGSEQL2",445,0) + . set sqSSN=$piece(sqSSN," ",1) +"RTN","TMGSEQL2",446,0) + . set vSSN=$piece(ErrMsg,"vs. ",2) +"RTN","TMGSEQL2",447,0) + . set vSSN=$piece(vSSN," ",1) +"RTN","TMGSEQL2",448,0) + else do +"RTN","TMGSEQL2",449,0) + . set sqSSN=$piece(ErrMsg,"Sequel#=",2) +"RTN","TMGSEQL2",450,0) + . set sqSSN=$piece(sqSSN," ",1) +"RTN","TMGSEQL2",451,0) + . set vSSN=$piece(ErrMsg,"VistA#=",2) +"RTN","TMGSEQL2",452,0) + . set vSSN=$piece(vSSN," ",1) +"RTN","TMGSEQL2",453,0) + +"RTN","TMGSEQL2",454,0) + new vFullName +"RTN","TMGSEQL2",455,0) + do ;"get actual full name & DOB for VistA SSN +"RTN","TMGSEQL2",456,0) + . new vName,vDOB +"RTN","TMGSEQL2",457,0) + . new tempDFN set tempDFN=$$SSNumLookup^TMGGDFN(vSSN) +"RTN","TMGSEQL2",458,0) + . new TMGMSG,TMGERR,IENS +"RTN","TMGSEQL2",459,0) + . set IENS=+tempDFN_"," +"RTN","TMGSEQL2",460,0) + . do GETS^DIQ(2,IENS,".01;.03","E","TMGMSG","TMGERR") +"RTN","TMGSEQL2",461,0) + . if $data(TMGERR("DIERR")) do +"RTN","TMGSEQL2",462,0) + . . new PriorErrorFound +"RTN","TMGSEQL2",463,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL2",464,0) + . set vName=$get(TMGMSG(2,IENS,.01,"E")) +"RTN","TMGSEQL2",465,0) + . set vDOB=$get(TMGMSG(2,IENS,.03,"E")) +"RTN","TMGSEQL2",466,0) + . set vFullName=vName_" ("_vDOB_")" +"RTN","TMGSEQL2",467,0) + +"RTN","TMGSEQL2",468,0) + write ! +"RTN","TMGSEQL2",469,0) + +"RTN","TMGSEQL2",470,0) + for do quit:(done=1) +"RTN","TMGSEQL2",471,0) + . write "There is a conflict between Social Security Numbers (SSN):",! +"RTN","TMGSEQL2",472,0) + . write "1. ",sqSSN," is the Sequel SSN for: ",$get(PtInfo("FULL NAME2")),! +"RTN","TMGSEQL2",473,0) + . write "2. ",vSSN," is the VistA SSN for: ",$get(vFullName),! +"RTN","TMGSEQL2",474,0) + . write "3. (Don't change either one, but remove alert)",! +"RTN","TMGSEQL2",475,0) + . write !,"Which SSN is correct? (1, 2, 3, or ^ to abort)? // " +"RTN","TMGSEQL2",476,0) + . new temp read temp:$get(DTIME,3600),! +"RTN","TMGSEQL2",477,0) + . if temp="^" set done=1 quit ;"quit, error unfixed. +"RTN","TMGSEQL2",478,0) + . if temp=3 do quit ;"keep both +"RTN","TMGSEQL2",479,0) + . . write "OK, no data changes made. Will delete alert.",! +"RTN","TMGSEQL2",480,0) + . . set Fixed=1,done=1 +"RTN","TMGSEQL2",481,0) + . if temp=2 do quit ;"keep VistA, advice manual fix in Sequel database, delete alert. +"RTN","TMGSEQL2",482,0) + . . write "OK. Please manually alter the SSN in the Sequel Database. This should then be",! +"RTN","TMGSEQL2",483,0) + . . write "reflected in the next demographic data upload cycle.",! +"RTN","TMGSEQL2",484,0) + . . set Fixed=1 ;"This will signal the deletion of the alert +"RTN","TMGSEQL2",485,0) + . . set done=1 +"RTN","TMGSEQL2",486,0) + . if temp=1 do ;"keep Sequel, delete VistA SSN +"RTN","TMGSEQL2",487,0) + . . set done=1 +"RTN","TMGSEQL2",488,0) + . . set Fixed=1 +"RTN","TMGSEQL2",489,0) + . . set DelError=1 +"RTN","TMGSEQL2",490,0) + . . new DFN set DFN=$$GetDFN^TMGSEQL1(.PtInfo) +"RTN","TMGSEQL2",491,0) + . . new TMGFDA,TMGMSG,tempResult +"RTN","TMGSEQL2",492,0) + . . set TMGFDA(2,DFN_",",.09)="@" ;"delete .09 field (SSN) +"RTN","TMGSEQL2",493,0) + . . set tempResult=$$dbWrite^TMGDBAPI(.TMGFDA,1,,,.TMGMSG) +"RTN","TMGSEQL2",494,0) + . . if tempResult=0 quit ;"error found, so quit +"RTN","TMGSEQL2",495,0) + . . ;"Now try filing again. +"RTN","TMGSEQL2",496,0) + . . new OneErrErray,ChgLog +"RTN","TMGSEQL2",497,0) + . . new AutoRegister set AutoRegister=0 ;"should need to add patient, as must exist to confilict in first place! +"RTN","TMGSEQL2",498,0) + . . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error +"RTN","TMGSEQL2",499,0) + . . if tempResult=0 do +"RTN","TMGSEQL2",500,0) + . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",501,0) + . . . ;"write "There is still an error:",! +"RTN","TMGSEQL2",502,0) + . . . ;"zwr OneErrArray(*) +"RTN","TMGSEQL2",503,0) + . . . ;"write "A new alert will be made to handle this new error.",! +"RTN","TMGSEQL2",504,0) + . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray) +"RTN","TMGSEQL2",505,0) + . . . ;"write OneErrArray(0),! +"RTN","TMGSEQL2",506,0) + . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",507,0) + +"RTN","TMGSEQL2",508,0) +FSNPDone +"RTN","TMGSEQL2",509,0) + quit Fixed +"RTN","TMGSEQL2",510,0) + +"RTN","TMGSEQL2",511,0) + +"RTN","TMGSEQL2",512,0) + +"RTN","TMGSEQL2",513,0) +GetSex(Name) +"RTN","TMGSEQL2",514,0) + ;"Purpose: To return gender of Name, as stored in file 22707 +"RTN","TMGSEQL2",515,0) + ;"Input: Name - a FIRST name +"RTN","TMGSEQL2",516,0) + ;"Result: Returns MALE, FEMALE, or "" if not found +"RTN","TMGSEQL2",517,0) + +"RTN","TMGSEQL2",518,0) + new result set result="" +"RTN","TMGSEQL2",519,0) + if $get(Name)="" goto GSDone +"RTN","TMGSEQL2",520,0) + new DIC,X,Y +"RTN","TMGSEQL2",521,0) + set DIC=22707 +"RTN","TMGSEQL2",522,0) + set DIC(0)="M" +"RTN","TMGSEQL2",523,0) + set X=Name +"RTN","TMGSEQL2",524,0) + do ^DIC +"RTN","TMGSEQL2",525,0) + if +Y'>0 goto GSDone +"RTN","TMGSEQL2",526,0) + set result=$$GET1^DIQ(22707,+Y_",",1) +"RTN","TMGSEQL2",527,0) + +"RTN","TMGSEQL2",528,0) +GSDone +"RTN","TMGSEQL2",529,0) + quit result +"RTN","TMGSEQL2",530,0) + +"RTN","TMGSEQL2",531,0) + +"RTN","TMGSEQL2",532,0) + +"RTN","TMGSEQL2",533,0) +SetSex(Name,Sex) +"RTN","TMGSEQL2",534,0) + ;"Purpose: To create a new record in file 22707 to store gender of name +"RTN","TMGSEQL2",535,0) + ;"Input: Name -- a FIRST name to store gender for +"RTN","TMGSEQL2",536,0) + ;" Sex -- should be "MALE", or "FEMALE" +"RTN","TMGSEQL2",537,0) + ;"Note: Will not do anything if a record for name already exists +"RTN","TMGSEQL2",538,0) + ;"Result: 1=OK to continue 0=some error +"RTN","TMGSEQL2",539,0) + +"RTN","TMGSEQL2",540,0) + new result set result=1 +"RTN","TMGSEQL2",541,0) + if '$data(Name)!'$data(Sex) goto SSxDone +"RTN","TMGSEQL2",542,0) + if $$GetSex(Name)'="" goto SSxDone +"RTN","TMGSEQL2",543,0) + new TMGFDA +"RTN","TMGSEQL2",544,0) + set TMGFDA(22707,"+1,",.01)=Name +"RTN","TMGSEQL2",545,0) + set TMGFDA(22707,"+1,",1)=Sex +"RTN","TMGSEQL2",546,0) + set result=$$dbWrite^TMGDBAPI(.TMGFDA,0) +"RTN","TMGSEQL2",547,0) + +"RTN","TMGSEQL2",548,0) +SSxDone +"RTN","TMGSEQL2",549,0) + quit result +"RTN","TMGSEQL2",550,0) + +"RTN","TMGSEQL2",551,0) + +"RTN","TMGSEQL2",552,0) +NameError(OneErrArray) +"RTN","TMGSEQL2",553,0) + ;"Purpose: to review a fileman "DIERR" array and pick out common problems +"RTN","TMGSEQL2",554,0) + ;"Input: OneErrArray -- a fileman array containing "DIERR" message +"RTN","TMGSEQL2",555,0) + ;"Result: return a name for error +"RTN","TMGSEQL2",556,0) + +"RTN","TMGSEQL2",557,0) + new result set result="" +"RTN","TMGSEQL2",558,0) + +"RTN","TMGSEQL2",559,0) + new Array +"RTN","TMGSEQL2",560,0) + if $data(OneErrArray("DIERR"))>1 do +"RTN","TMGSEQL2",561,0) + . merge Array=OneErrArray("DIERR") +"RTN","TMGSEQL2",562,0) + else do +"RTN","TMGSEQL2",563,0) + . merge Array=OneErrArray +"RTN","TMGSEQL2",564,0) + +"RTN","TMGSEQL2",565,0) + new field set field=$get(Array(1,"PARAM","FIELD")) +"RTN","TMGSEQL2",566,0) + +"RTN","TMGSEQL2",567,0) + if $data(Array)>0 do +"RTN","TMGSEQL2",568,0) + . new FileNum set FileNum=+$get(Array(1,"PARAM","FILE")) +"RTN","TMGSEQL2",569,0) + . if (FileNum>0)&(FileNum'=2) quit +"RTN","TMGSEQL2",570,0) + . if field>0 set result="FILEMAN ERROR:" +"RTN","TMGSEQL2",571,0) + . if field=.03 do +"RTN","TMGSEQL2",572,0) + . . set result="INVALID DOB ERROR:" +"RTN","TMGSEQL2",573,0) + . if field=.02 do +"RTN","TMGSEQL2",574,0) + . . set result="INVALID/MISSING GENDER:" +"RTN","TMGSEQL2",575,0) + . if $data(Array(1,"TEXT")) do +"RTN","TMGSEQL2",576,0) + . . new s set s=$get(Array(1,"TEXT",1)) +"RTN","TMGSEQL2",577,0) + . . set result=result_$extract(s,1,80)_"..." +"RTN","TMGSEQL2",578,0) + . if result["CONFLICTING SS-NUMBERS" do +"RTN","TMGSEQL2",579,0) + . . set result="CONFLICTING SS-NUMBERS: " +"RTN","TMGSEQL2",580,0) + +"RTN","TMGSEQL2",581,0) + if result="" set result=$get(Array(0),"Sequel Import Error:") +"RTN","TMGSEQL2",582,0) + +"RTN","TMGSEQL2",583,0) + quit result +"RTN","TMGSEQL2",584,0) + +"RTN","TMGSEQL2",585,0) + +"RTN","TMGSEQL2",586,0) +FixGenProblem(PtInfo,ErrMsg,OneLine,DelError,ErrIEN) +"RTN","TMGSEQL2",587,0) + ;"Purpose: To fix a generic (no specified) error +"RTN","TMGSEQL2",588,0) + ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1 +"RTN","TMGSEQL2",589,0) + ;" ErrMsg -- the message that holds the conflicting SSNums +"RTN","TMGSEQL2",590,0) + ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert +"RTN","TMGSEQL2",591,0) + ;" must be created, in which case it is stored in the new error message. +"RTN","TMGSEQL2",592,0) + ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error +"RTN","TMGSEQL2",593,0) + ;" record in file 22706 +"RTN","TMGSEQL2",594,0) + ;" ErrIEN -- the IEN in file 22706 containing full error info. +"RTN","TMGSEQL2",595,0) + ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error +"RTN","TMGSEQL2",596,0) + ;" in file 22706 will deleted +"RTN","TMGSEQL2",597,0) + ;"Result: 1=problem fixed, 0=not fixed. +"RTN","TMGSEQL2",598,0) + +"RTN","TMGSEQL2",599,0) + new Fixed set Fixed=0 +"RTN","TMGSEQL2",600,0) + new done set done=0 +"RTN","TMGSEQL2",601,0) + set DelError=0 +"RTN","TMGSEQL2",602,0) + new done set done=0 +"RTN","TMGSEQL2",603,0) + new AutoRegister set AutoRegister=1 ;"automatically add patient to database if not found +"RTN","TMGSEQL2",604,0) + +"RTN","TMGSEQL2",605,0) + new temp +"RTN","TMGSEQL2",606,0) + set temp="?" +"RTN","TMGSEQL2",607,0) + for do quit:(done=1) +"RTN","TMGSEQL2",608,0) + . if temp="?" do quit +"RTN","TMGSEQL2",609,0) + . . write "Options:",! +"RTN","TMGSEQL2",610,0) + . . write "-----------------",! +"RTN","TMGSEQL2",611,0) + . . write "D Show the data line from the other computer (Sequel)",! +"RTN","TMGSEQL2",612,0) + . . write "E Edit data line.",! +"RTN","TMGSEQL2",613,0) + . . write "R Retry filing data into database to get more information.",! +"RTN","TMGSEQL2",614,0) + . . write "S Show parsed patient information.",! +"RTN","TMGSEQL2",615,0) + . . write "X Delete this Alert.",! +"RTN","TMGSEQL2",616,0) + . . write "Q Query the database to see existing entries.",! +"RTN","TMGSEQL2",617,0) + . . write "^ Abort.",! +"RTN","TMGSEQL2",618,0) + . . set temp="" +"RTN","TMGSEQL2",619,0) + . else if temp="Q" do quit +"RTN","TMGSEQL2",620,0) + . . new DIC set DIC=2 +"RTN","TMGSEQL2",621,0) + . . set DIC(0)="AEQM" +"RTN","TMGSEQL2",622,0) + . . do ^DIC +"RTN","TMGSEQL2",623,0) + . . set temp="" +"RTN","TMGSEQL2",624,0) + . else if temp="D" do quit +"RTN","TMGSEQL2",625,0) + . . write !,OneLine,! +"RTN","TMGSEQL2",626,0) + . . set temp="" +"RTN","TMGSEQL2",627,0) + . else if temp="S" do quit +"RTN","TMGSEQL2",628,0) + . . zwr PtInfo(*) +"RTN","TMGSEQL2",629,0) + . . set temp="" +"RTN","TMGSEQL2",630,0) + . else if temp="E" do quit +"RTN","TMGSEQL2",631,0) + . . new r,NewLine +"RTN","TMGSEQL2",632,0) + . . set r=$$EditOneLine(OneLine,.NewLine) +"RTN","TMGSEQL2",633,0) + . . if r=1 set OneLine=NewLine ;"NOTE: later I will save old line to keep from having to process each update cycle +"RTN","TMGSEQL2",634,0) + . . kill PtInfo +"RTN","TMGSEQL2",635,0) + . . if $$ParseLine^TMGSEQL1(OneLine,.PtInfo)=0 do quit +"RTN","TMGSEQL2",636,0) + . . . write "There was a problem processing this line after your edit. Sorry!",! +"RTN","TMGSEQL2",637,0) + . . write "OK, now try refilling data into database.",! +"RTN","TMGSEQL2",638,0) + . . set temp="?" +"RTN","TMGSEQL2",639,0) + . else if temp="^" do quit +"RTN","TMGSEQL2",640,0) + . . write "aborting..",! +"RTN","TMGSEQL2",641,0) + . . set done=1 +"RTN","TMGSEQL2",642,0) + . else if temp="X" do quit +"RTN","TMGSEQL2",643,0) + . . write "OK, will delete this alert.",! +"RTN","TMGSEQL2",644,0) + . . ;"Note: do something to delete alert. +"RTN","TMGSEQL2",645,0) + . . set done=1,DelError=1,Fixed=1 +"RTN","TMGSEQL2",646,0) + . else if temp="R" do quit +"RTN","TMGSEQL2",647,0) + . . new OneErrErray,ChgLog +"RTN","TMGSEQL2",648,0) + . . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error +"RTN","TMGSEQL2",649,0) + . . set DelError=1 +"RTN","TMGSEQL2",650,0) + . . set Fixed=1 ;"consider 'fixed' so alert will be deleted +"RTN","TMGSEQL2",651,0) + . . set done=1 +"RTN","TMGSEQL2",652,0) + . . if tempResult=0 do +"RTN","TMGSEQL2",653,0) + . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",654,0) + . . . ;"write "There is still an error:",! +"RTN","TMGSEQL2",655,0) + . . . ;"zwr OneErrArray(*) +"RTN","TMGSEQL2",656,0) + . . . ;"write "A new alert will be made to handle this new error.",! +"RTN","TMGSEQL2",657,0) + . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray) +"RTN","TMGSEQL2",658,0) + . . . ;"write OneErrArray(0),! +"RTN","TMGSEQL2",659,0) + . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ) +"RTN","TMGSEQL2",660,0) + . read !,"Enter Option: ?//",temp:$get(DTIME,3600),! +"RTN","TMGSEQL2",661,0) + . if temp="" set temp="?" +"RTN","TMGSEQL2",662,0) + . set temp=$$UP^XLFSTR(temp) +"RTN","TMGSEQL2",663,0) + . quit +"RTN","TMGSEQL2",664,0) + +"RTN","TMGSEQL2",665,0) +FGPDone +"RTN","TMGSEQL2",666,0) + quit Fixed +"RTN","TMGSEQL2",667,0) + +"RTN","TMGSEQL2",668,0) + +"RTN","TMGSEQL2",669,0) + +"RTN","TMGSEQL3") +0^77^B11370 +"RTN","TMGSEQL3",1,0) +TMGSEQL3 ;TMG/kst/Code to interface with SequelSystems PMS ;03/25/06 +"RTN","TMGSEQL3",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGSEQL3",3,0) + +"RTN","TMGSEQL3",4,0) + ;"TMG SEQUEL IMPORT UTILITY FUNCTIONS +"RTN","TMGSEQL3",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGSEQL3",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSEQL3",7,0) + ;"1-9-2006 +"RTN","TMGSEQL3",8,0) + +"RTN","TMGSEQL3",9,0) + +"RTN","TMGSEQL3",10,0) + ;"======================================================================= +"RTN","TMGSEQL3",11,0) + ;" API -- Public Functions. +"RTN","TMGSEQL3",12,0) + ;"======================================================================= +"RTN","TMGSEQL3",13,0) + ;"RPTSSNCF ;"i.e. Report SSN Conflict +"RTN","TMGSEQL3",14,0) + ;"RPTDOBER ;"i.e. Report DOB Errors +"RTN","TMGSEQL3",15,0) + ;"CLEARALL +"RTN","TMGSEQL3",16,0) + +"RTN","TMGSEQL3",17,0) + +"RTN","TMGSEQL3",18,0) + ;"FIXERRORS --OLD +"RTN","TMGSEQL3",19,0) + ;"FixOneError(OneLine,OneErr,OneChLog) -- OLD +"RTN","TMGSEQL3",20,0) + ;"tempMakeAlerts +"RTN","TMGSEQL3",21,0) + +"RTN","TMGSEQL3",22,0) + ;"======================================================================= +"RTN","TMGSEQL3",23,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGSEQL3",24,0) + ;"======================================================================= +"RTN","TMGSEQL3",25,0) + ;"ShowOneConflict(IEN,ErrMsg) +"RTN","TMGSEQL3",26,0) + ;"$$QuietClear(DUZ) +"RTN","TMGSEQL3",27,0) + +"RTN","TMGSEQL3",28,0) + +"RTN","TMGSEQL3",29,0) + ;"======================================================================= +"RTN","TMGSEQL3",30,0) + ;"DEPENDENCIES +"RTN","TMGSEQL3",31,0) + ;"TMGSEQL1 +"RTN","TMGSEQL3",32,0) + ;"TMGSEQL2 +"RTN","TMGSEQL3",33,0) + ;"TMGSTUTL +"RTN","TMGSEQL3",34,0) + ;"TMGGDFN +"RTN","TMGSEQL3",35,0) + ;"TMGDEBUG +"RTN","TMGSEQL3",36,0) + ;"======================================================================= +"RTN","TMGSEQL3",37,0) + ;"======================================================================= +"RTN","TMGSEQL3",38,0) + +"RTN","TMGSEQL3",39,0) + +"RTN","TMGSEQL3",40,0) + +"RTN","TMGSEQL3",41,0) +tempMakeAlerts +"RTN","TMGSEQL3",42,0) + ;"Purpose: To creat alerts for all entries in file 22706 +"RTN","TMGSEQL3",43,0) + ;"Input: none +"RTN","TMGSEQL3",44,0) + ;"Output: This will generate Alerts, sent to the current user (DUZ) +"RTN","TMGSEQL3",45,0) + ;"Result: none +"RTN","TMGSEQL3",46,0) + +"RTN","TMGSEQL3",47,0) + new i,OneLine +"RTN","TMGSEQL3",48,0) + +"RTN","TMGSEQL3",49,0) + set i=$order(^TMG(22706,0)) +"RTN","TMGSEQL3",50,0) + if +i>0 for do quit:(+i'>0) +"RTN","TMGSEQL3",51,0) + . new ref,IEN +"RTN","TMGSEQL3",52,0) + . set IEN=i +"RTN","TMGSEQL3",53,0) + . set i=$order(^TMG(22706,i)) +"RTN","TMGSEQL3",54,0) + . set ref="^TMG(22706,"_IEN_",2)" +"RTN","TMGSEQL3",55,0) + . set OneLine=$$WPToStr^TMGSTUTL(ref) +"RTN","TMGSEQL3",56,0) + . set Msg="Problem with upload of Sequel data" +"RTN","TMGSEQL3",57,0) + . do MakeErrAlert^TMGSEQL2(IEN,DUZ,Msg) +"RTN","TMGSEQL3",58,0) + +"RTN","TMGSEQL3",59,0) + quit +"RTN","TMGSEQL3",60,0) + +"RTN","TMGSEQL3",61,0) + +"RTN","TMGSEQL3",62,0) +FIXERRORS ;"NOTE-- this is an OLD function, not being used +"RTN","TMGSEQL3",63,0) + ;"Purpose: To handles errors encountered during the ASKIMPORT function +"RTN","TMGSEQL3",64,0) + ;"Input: none +"RTN","TMGSEQL3",65,0) + ;"Output: the database is modified +"RTN","TMGSEQL3",66,0) + ;"Results: none +"RTN","TMGSEQL3",67,0) + +"RTN","TMGSEQL3",68,0) + new index +"RTN","TMGSEQL3",69,0) + new Abort set Abort=0 +"RTN","TMGSEQL3",70,0) + new NewArray,newI +"RTN","TMGSEQL3",71,0) + new NewErrArray,NewChgLog +"RTN","TMGSEQL3",72,0) + new MaxCount +"RTN","TMGSEQL3",73,0) + new TMGRemSex +"RTN","TMGSEQL3",74,0) + set TMGRemSex=$$GET1^DIQ(22711,"1,",6,"I") ;"6=PICK GENDER FROM NAME? +"RTN","TMGSEQL3",75,0) + +"RTN","TMGSEQL3",76,0) + new Ref set Ref=$name(^TMP("TMG","SEQUELIMPORT","ERRORS")) +"RTN","TMGSEQL3",77,0) + set MaxCount=$order(@Ref@(""),-1) +"RTN","TMGSEQL3",78,0) + +"RTN","TMGSEQL3",79,0) + set index=$order(@Ref@("")) +"RTN","TMGSEQL3",80,0) + if index'="" for do quit:(+index'>0)!(Abort) +"RTN","TMGSEQL3",81,0) + . new result +"RTN","TMGSEQL3",82,0) + . new OneErrArray,OneChLog +"RTN","TMGSEQL3",83,0) + . merge OneErrArray=@Ref@(index) +"RTN","TMGSEQL3",84,0) + . new OneLine set OneLine=$get(@Ref@(index)) +"RTN","TMGSEQL3",85,0) + . write "(",index,"/",MaxCount,") " +"RTN","TMGSEQL3",86,0) + . set result=$$FixOneError^TMGSEQL2(OneLine,.OneErrArray,.OneChLog) +"RTN","TMGSEQL3",87,0) + . if result=-1 set Abort=1 quit +"RTN","TMGSEQL3",88,0) + . if result>0 do +"RTN","TMGSEQL3",89,0) + . . ;"merge NewChgLog(index)=OneChLog +"RTN","TMGSEQL3",90,0) + . . merge ^TMP("TMG","SEQUELIMPORT","CHANGES",$H,index)=OneChLog +"RTN","TMGSEQL3",91,0) + . else do +"RTN","TMGSEQL3",92,0) + . . kill @Ref@(index) +"RTN","TMGSEQL3",93,0) + . . merge @Ref@(index)=OneErrArray(1) +"RTN","TMGSEQL3",94,0) + . set index=$order(@Ref@(index)) +"RTN","TMGSEQL3",95,0) + +"RTN","TMGSEQL3",96,0) + if 1=0 do +"RTN","TMGSEQL3",97,0) + . set newI=$get(newI)+1 +"RTN","TMGSEQL3",98,0) + . set NewArray(newI)=OneLine +"RTN","TMGSEQL3",99,0) + . if $$ProcessPt^TMGSEQL1(OneLine,.NewErrArray,.NewChgLog) do +"RTN","TMGSEQL3",100,0) + . . MERGE ^TMP("TMG","SEQUELIMPORT","CHANGES",$H)=NewChgLog +"RTN","TMGSEQL3",101,0) + . . if $data(NewErrArray) do +"RTN","TMGSEQL3",102,0) + . . . MERGE ^TMP("TMG","SEQUELIMPORT","ERRORS")=NewErrArray +"RTN","TMGSEQL3",103,0) + . . . write "Here is the info about adding that patient:",! +"RTN","TMGSEQL3",104,0) + . . . zwr NewErrArray(*) +"RTN","TMGSEQL3",105,0) + . . . write !! +"RTN","TMGSEQL3",106,0) + . . . kill NewErrArray +"RTN","TMGSEQL3",107,0) + . . ;"write "killing: ",Ref,"(",Idx,")",! +"RTN","TMGSEQL3",108,0) + . . kill @Ref@(Idx) +"RTN","TMGSEQL3",109,0) + +"RTN","TMGSEQL3",110,0) + +"RTN","TMGSEQL3",111,0) + write !,"Goodbye.",! +"RTN","TMGSEQL3",112,0) +FEDone +"RTN","TMGSEQL3",113,0) + quit +"RTN","TMGSEQL3",114,0) + +"RTN","TMGSEQL3",115,0) + +"RTN","TMGSEQL3",116,0) +FixOneError(OneLine,OneErr,OneChLog) ;"NOTE-- this is an OLD function, not being used +"RTN","TMGSEQL3",117,0) + ;"Purpose: to Fix one filing error +"RTN","TMGSEQL3",118,0) + ;"Input: OneLine -- the original data line in CVS format. +"RTN","TMGSEQL3",119,0) + ;" OneErr -- PASS BY REFERENCE +"RTN","TMGSEQL3",120,0) + ;" coming in, it will pass the original error. +"RTN","TMGSEQL3",121,0) + ;" passed back out, it will contain any new errors. +"RTN","TMGSEQL3",122,0) + ;" OneChLog -- PASS BY REFERENCE +"RTN","TMGSEQL3",123,0) + ;" This will contain messages about changes made. +"RTN","TMGSEQL3",124,0) + ;" Note: uses var with global scipe: TMGRemSex +"RTN","TMGSEQL3",125,0) + ;"Result: 1 = error fixed +"RTN","TMGSEQL3",126,0) + ;" 0 = error NOT fixed +"RTN","TMGSEQL3",127,0) + ;" -1 = aborted +"RTN","TMGSEQL3",128,0) + +"RTN","TMGSEQL3",129,0) + new Abort set Abort=0 +"RTN","TMGSEQL3",130,0) + new NewArray,newI +"RTN","TMGSEQL3",131,0) + new NewErrArray,NewChgLog +"RTN","TMGSEQL3",132,0) + new result set result=0 +"RTN","TMGSEQL3",133,0) + +"RTN","TMGSEQL3",134,0) + new Len set Len=$length(OneLine) +"RTN","TMGSEQL3",135,0) + if $extract(OneLine,Len)=$char(13) set OneLine=$extract(OneLine,1,Len-1) +"RTN","TMGSEQL3",136,0) + +"RTN","TMGSEQL3",137,0) + new Info merge Info=OneErr("INFO") +"RTN","TMGSEQL3",138,0) + new DIERR merge DIERR=OneErr("INFO","DIERR") +"RTN","TMGSEQL3",139,0) + if OneLine="" goto FOEDone +"RTN","TMGSEQL3",140,0) + +"RTN","TMGSEQL3",141,0) + new LName,FName,DOB,SID +"RTN","TMGSEQL3",142,0) + set LName=$piece(OneLine,",",3) +"RTN","TMGSEQL3",143,0) + set FName=$piece(OneLine,",",4) +"RTN","TMGSEQL3",144,0) + set DOB=$piece($piece(OneLine,",",17)," ",1) +"RTN","TMGSEQL3",145,0) + set SID=$piece(OneLine,",",5) +"RTN","TMGSEQL3",146,0) + write FName," ",LName," ("_DOB_"); #",SID,"): " +"RTN","TMGSEQL3",147,0) + new Prov set Prov=$piece(OneLine,",",14) +"RTN","TMGSEQL3",148,0) + new skip set skip=0 +"RTN","TMGSEQL3",149,0) + new temp set temp="" +"RTN","TMGSEQL3",150,0) + +"RTN","TMGSEQL3",151,0) + if $$InvalPtName^TMGSEQL1(FName,LName) do goto FOEDone +"RTN","TMGSEQL3",152,0) + . write !,"Skipping and deleting, because name is: ",FName," ",LName,! +"RTN","TMGSEQL3",153,0) + . set result=0 +"RTN","TMGSEQL3",154,0) + +"RTN","TMGSEQL3",155,0) + if $$InvalidProvider^TMGSEQL1(Prov) do goto FOEDone +"RTN","TMGSEQL3",156,0) + . write !,"Skipping and deleting, because provider is: ",Prov,! +"RTN","TMGSEQL3",157,0) + . set result=0 +"RTN","TMGSEQL3",158,0) + +"RTN","TMGSEQL3",159,0) + if ($get(DIERR(1))=311)&($get(Info(0))="PATIENT NOT IN DATABASE")&($get(DIERR(1,"PARAM","FIELD"))=.02) do +"RTN","TMGSEQL3",160,0) + . set temp="" +"RTN","TMGSEQL3",161,0) + . for do quit:(temp'="")!(Abort=1) +"RTN","TMGSEQL3",162,0) + . . set skip=0 +"RTN","TMGSEQL3",163,0) + . . if TMGRemSex=1 set temp=$$GetSex^TMGSEQL2(FName) +"RTN","TMGSEQL3",164,0) + . . if temp="" read "MALE/FEMALE? ?// ",temp:$get(DTIME,3600) +"RTN","TMGSEQL3",165,0) + . . if temp="" set temp="?" +"RTN","TMGSEQL3",166,0) + . . set temp=$$UP^XLFSTR(temp) +"RTN","TMGSEQL3",167,0) + . . if temp="?" do quit +"RTN","TMGSEQL3",168,0) + . . . write "Options:",! +"RTN","TMGSEQL3",169,0) + . . . write "-----------------",! +"RTN","TMGSEQL3",170,0) + . . . write "M Name is MALE (and remember in future).",! +"RTN","TMGSEQL3",171,0) + . . . write "F Name is FEMALE (and remember in future).",! +"RTN","TMGSEQL3",172,0) + . . . write "D Show the data line from the other computer (Sequel)",! +"RTN","TMGSEQL3",173,0) + . . . ;"write "S Turn automatic selecting SEX based on first name: " +"RTN","TMGSEQL3",174,0) + . . . ;"write $select(TMGRemSex=1:"OFF",TMGRemSex=0:"ON"),! +"RTN","TMGSEQL3",175,0) + . . . write "x Skip this patient.",! +"RTN","TMGSEQL3",176,0) + . . . write "Q Query the database to see existing entries.",! +"RTN","TMGSEQL3",177,0) + . . . write "^ Abort.",! +"RTN","TMGSEQL3",178,0) + . . . set temp="" +"RTN","TMGSEQL3",179,0) + . . if temp="Q" do quit +"RTN","TMGSEQL3",180,0) + . . . new DIC set DIC=2 +"RTN","TMGSEQL3",181,0) + . . . set DIC(0)="AEQM" +"RTN","TMGSEQL3",182,0) + . . . do ^DIC +"RTN","TMGSEQL3",183,0) + . . . set temp="" +"RTN","TMGSEQL3",184,0) + . . if temp="S" do quit +"RTN","TMGSEQL3",185,0) + . . . ;"set TMGRemSex='TMGRemSex +"RTN","TMGSEQL3",186,0) + . . if temp="D" do quit +"RTN","TMGSEQL3",187,0) + . . . write !,OneLine,! +"RTN","TMGSEQL3",188,0) + . . . set temp="" +"RTN","TMGSEQL3",189,0) + . . if ("MALE"[temp)&(temp'="FEMALE") do quit +"RTN","TMGSEQL3",190,0) + . . . write "MALE",! +"RTN","TMGSEQL3",191,0) + . . . set OneLine=OneLine_"^MALE" +"RTN","TMGSEQL3",192,0) + . . . if TMGRemSex=1 do +"RTN","TMGSEQL3",193,0) + . . . . new temp +"RTN","TMGSEQL3",194,0) + . . . . set temp=$$SetSex^TMGSEQL2(FName,"MALE") +"RTN","TMGSEQL3",195,0) + . . else if "FEMALE"[temp do quit +"RTN","TMGSEQL3",196,0) + . . . write "FEMALE",! +"RTN","TMGSEQL3",197,0) + . . . set OneLine=OneLine_"^FEMALE" +"RTN","TMGSEQL3",198,0) + . . . if TMGRemSex=1 do +"RTN","TMGSEQL3",199,0) + . . . . new temp +"RTN","TMGSEQL3",200,0) + . . . . set temp=$$SetSex^TMGSEQL2(FName,"FEMALE") +"RTN","TMGSEQL3",201,0) + . . else if temp="^" do quit +"RTN","TMGSEQL3",202,0) + . . . write "aborting..",! +"RTN","TMGSEQL3",203,0) + . . . set Abort=1 +"RTN","TMGSEQL3",204,0) + . . else do quit +"RTN","TMGSEQL3",205,0) + . . . write "skip...",! +"RTN","TMGSEQL3",206,0) + . . . set skip=1,temp="x" +"RTN","TMGSEQL3",207,0) + else do +"RTN","TMGSEQL3",208,0) + . write "??",! +"RTN","TMGSEQL3",209,0) + . write "Here is info array. I don't know how to fix this:",! +"RTN","TMGSEQL3",210,0) + . zwr Info(*) +"RTN","TMGSEQL3",211,0) + . set temp="?" +"RTN","TMGSEQL3",212,0) + . for do quit:(temp'="")!(Abort=1) +"RTN","TMGSEQL3",213,0) + . . set skip=0 +"RTN","TMGSEQL3",214,0) + . . if temp="?" do quit +"RTN","TMGSEQL3",215,0) + . . . write "Options:",! +"RTN","TMGSEQL3",216,0) + . . . write "-----------------",! +"RTN","TMGSEQL3",217,0) + . . . write "D Show the data line from the other computer (Sequel)",! +"RTN","TMGSEQL3",218,0) + . . . write "E Edit data line.",! +"RTN","TMGSEQL3",219,0) + . . . write "x Skip this patient.",! +"RTN","TMGSEQL3",220,0) + . . . write "Q Query the database to see existing entries.",! +"RTN","TMGSEQL3",221,0) + . . . write "^ Abort.",! +"RTN","TMGSEQL3",222,0) + . . . set temp="" +"RTN","TMGSEQL3",223,0) + . . else if temp="Q" do quit +"RTN","TMGSEQL3",224,0) + . . . new DIC set DIC=2 +"RTN","TMGSEQL3",225,0) + . . . set DIC(0)="AEQM" +"RTN","TMGSEQL3",226,0) + . . . do ^DIC +"RTN","TMGSEQL3",227,0) + . . . set temp="" +"RTN","TMGSEQL3",228,0) + . . else if temp="S" do +"RTN","TMGSEQL3",229,0) + . . . set TMGRemSex='TMGRemSex +"RTN","TMGSEQL3",230,0) + . . else if temp="D" do quit +"RTN","TMGSEQL3",231,0) + . . . write !,OneLine,! +"RTN","TMGSEQL3",232,0) + . . . set temp="" +"RTN","TMGSEQL3",233,0) + . . else if temp="E" do +"RTN","TMGSEQL3",234,0) + . . . new r,NewLine +"RTN","TMGSEQL3",235,0) + . . . set r=$$EditOneLine^TMGSEQL2(OneLine,NewLine) +"RTN","TMGSEQL3",236,0) + . . . if r=1 set OneLine=NewLine ;"NOTE: later I will save old line to keep from having to process each update cycle +"RTN","TMGSEQL3",237,0) + . . else if temp="^" do quit +"RTN","TMGSEQL3",238,0) + . . . write "aborting..",! +"RTN","TMGSEQL3",239,0) + . . . set Abort=1 +"RTN","TMGSEQL3",240,0) + . . else do quit +"RTN","TMGSEQL3",241,0) + . . . write "skip...",! +"RTN","TMGSEQL3",242,0) + . . . set skip=1 +"RTN","TMGSEQL3",243,0) + . . read !,"Enter Option: ?//",temp:$get(DTIME,3600),! +"RTN","TMGSEQL3",244,0) + . . if temp="" set temp="?" +"RTN","TMGSEQL3",245,0) + . . set temp=$$UP^XLFSTR(temp) +"RTN","TMGSEQL3",246,0) + +"RTN","TMGSEQL3",247,0) + if skip=0 do +"RTN","TMGSEQL3",248,0) + . kill OneErr +"RTN","TMGSEQL3",249,0) + . if $$ProcessPt^TMGSEQL1(OneLine,.OneErr,.OneChLog) do +"RTN","TMGSEQL3",250,0) + . . if $data(OneErr) do +"RTN","TMGSEQL3",251,0) + . . . write "Here is the info about adding that patient:",! +"RTN","TMGSEQL3",252,0) + . . . zwr OneErr(*) +"RTN","TMGSEQL3",253,0) + . . . write !! +"RTN","TMGSEQL3",254,0) + . . else set result=1 +"RTN","TMGSEQL3",255,0) + +"RTN","TMGSEQL3",256,0) +FOEDone +"RTN","TMGSEQL3",257,0) + if Abort set result=-1 +"RTN","TMGSEQL3",258,0) + quit result +"RTN","TMGSEQL3",259,0) + +"RTN","TMGSEQL3",260,0) + +"RTN","TMGSEQL3",261,0) + +"RTN","TMGSEQL3",262,0) +RPTSSNCF ;"i.e. Report SSN Conflict +"RTN","TMGSEQL3",263,0) + ;"Purpose: to output a report of all instances of conflicted SSNum's +"RTN","TMGSEQL3",264,0) + +"RTN","TMGSEQL3",265,0) + do RptMsg("CONFLICTING SS-NUMBERS") +"RTN","TMGSEQL3",266,0) + quit +"RTN","TMGSEQL3",267,0) + +"RTN","TMGSEQL3",268,0) + +"RTN","TMGSEQL3",269,0) +RPTDOBER ;"i.e. Report DOB Errors +"RTN","TMGSEQL3",270,0) + ;"Purpose: to output a report of all instances of conflicted SSNum's +"RTN","TMGSEQL3",271,0) + +"RTN","TMGSEQL3",272,0) + do RptMsg("DOB") +"RTN","TMGSEQL3",273,0) + quit +"RTN","TMGSEQL3",274,0) + +"RTN","TMGSEQL3",275,0) + +"RTN","TMGSEQL3",276,0) +RptMsg(MatchMsg) ;"i.e. Alerts with matching message +"RTN","TMGSEQL3",277,0) + ;"Purpose: to output a report of all instances of errors with matching message +"RTN","TMGSEQL3",278,0) + ;"input: MatchMsg -- A message of error to match for. +"RTN","TMGSEQL3",279,0) + ;" e.g. CONFLICTING SS-NUMBERS +"RTN","TMGSEQL3",280,0) + +"RTN","TMGSEQL3",281,0) + set %ZIS("A")="Enter output printer or device (^ to abort): " +"RTN","TMGSEQL3",282,0) + do ^%ZIS +"RTN","TMGSEQL3",283,0) + if POP do goto RpmDone +"RTN","TMGSEQL3",284,0) + . write !,"Error selecting output printer or device. Aborting report.",! +"RTN","TMGSEQL3",285,0) + use IO +"RTN","TMGSEQL3",286,0) + +"RTN","TMGSEQL3",287,0) + new IEN,count +"RTN","TMGSEQL3",288,0) + set count=0 +"RTN","TMGSEQL3",289,0) + set IEN=$order(^TMG(22706,0)) +"RTN","TMGSEQL3",290,0) + if +IEN'=0 for do quit:(+IEN'>0) +"RTN","TMGSEQL3",291,0) + . new Node0 set Node0=$get(^TMG(22706,IEN,0)) +"RTN","TMGSEQL3",292,0) + . new SQLNum set SQLNum=$piece(Node0,"^",1) +"RTN","TMGSEQL3",293,0) + . new Msg set Msg=$piece(Node0,"^",2) +"RTN","TMGSEQL3",294,0) + . if Msg[MatchMsg do +"RTN","TMGSEQL3",295,0) + . . do ShowOneConflict(IEN,Msg) +"RTN","TMGSEQL3",296,0) + . . set count=count+1 +"RTN","TMGSEQL3",297,0) + . set IEN=$order(^TMG(22706,IEN)) +"RTN","TMGSEQL3",298,0) + +"RTN","TMGSEQL3",299,0) + write count," conflicts found." +"RTN","TMGSEQL3",300,0) + +"RTN","TMGSEQL3",301,0) + use IO(0) +"RTN","TMGSEQL3",302,0) + do ^%ZISC +"RTN","TMGSEQL3",303,0) + +"RTN","TMGSEQL3",304,0) +RpmDone +"RTN","TMGSEQL3",305,0) + write !,"Goodbye.",! +"RTN","TMGSEQL3",306,0) + quit +"RTN","TMGSEQL3",307,0) + +"RTN","TMGSEQL3",308,0) + +"RTN","TMGSEQL3",309,0) + +"RTN","TMGSEQL3",310,0) + +"RTN","TMGSEQL3",311,0) +ShowOneConflict(IEN,ErrMsg) +"RTN","TMGSEQL3",312,0) + ;"Purpose: to output one conflict +"RTN","TMGSEQL3",313,0) + ;"Input: IEN, the IEN from file 22706 +"RTN","TMGSEQL3",314,0) + +"RTN","TMGSEQL3",315,0) + new OneLine,TMGWP,TMGMSG,PtInfo +"RTN","TMGSEQL3",316,0) + new sqSSNum,vSSNum +"RTN","TMGSEQL3",317,0) + +"RTN","TMGSEQL3",318,0) + new x set x=$$GET1^DIQ(22706,IEN_",",2,"","TMGWP","TMGMSG") +"RTN","TMGSEQL3",319,0) + if $data(TMGMSG("DIERR"))'=0 do goto SOCDone +"RTN","TMGSEQL3",320,0) + . new PriorErrorFound +"RTN","TMGSEQL3",321,0) + . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL3",322,0) + set OneLine=$$WPToStr^TMGSTUTL("TMGWP","") +"RTN","TMGSEQL3",323,0) + if $$ParseLine^TMGSEQL1(OneLine,.PtInfo)=0 do goto SOCDone +"RTN","TMGSEQL3",324,0) + . write "Error parsing Alert data into patient data.",! +"RTN","TMGSEQL3",325,0) + +"RTN","TMGSEQL3",326,0) + if $get(ErrMsg)="" goto SOCDone +"RTN","TMGSEQL3",327,0) + +"RTN","TMGSEQL3",328,0) + set sqSSN=$piece(ErrMsg,"Sequel#=",2) +"RTN","TMGSEQL3",329,0) + set sqSSN=$piece(sqSSN," ",1) +"RTN","TMGSEQL3",330,0) + set vSSN=$piece(ErrMsg,"VistA#=",2) +"RTN","TMGSEQL3",331,0) + set vSSN=$piece(vSSN," ",1) +"RTN","TMGSEQL3",332,0) + +"RTN","TMGSEQL3",333,0) + new vFullName +"RTN","TMGSEQL3",334,0) + do ;"get actual full name & DOB for VistA SSN +"RTN","TMGSEQL3",335,0) + . new vName,vDOB +"RTN","TMGSEQL3",336,0) + . new tempDFN set tempDFN=$$SSNumLookup^TMGGDFN(vSSN) +"RTN","TMGSEQL3",337,0) + . new TMGMSG,TMGERR,IENS +"RTN","TMGSEQL3",338,0) + . set IENS=+tempDFN_"," +"RTN","TMGSEQL3",339,0) + . do GETS^DIQ(2,IENS,".01;.03","E","TMGMSG","TMGERR") +"RTN","TMGSEQL3",340,0) + . if $data(TMGERR("DIERR")) do +"RTN","TMGSEQL3",341,0) + . . new PriorErrorFound +"RTN","TMGSEQL3",342,0) + . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGSEQL3",343,0) + . set vName=$get(TMGMSG(2,IENS,.01,"E")) +"RTN","TMGSEQL3",344,0) + . set vDOB=$get(TMGMSG(2,IENS,.03,"E")) +"RTN","TMGSEQL3",345,0) + . set vFullName=vName_" ("_vDOB_")" +"RTN","TMGSEQL3",346,0) + +"RTN","TMGSEQL3",347,0) + write sqSSN," is Sequel SSN for: ",$get(PtInfo("FULL NAME2"))," phone: ",$get(PtInfo("PHONE NUM")),! +"RTN","TMGSEQL3",348,0) + write vSSN," is VistA SSN for: ",$get(vFullName),! +"RTN","TMGSEQL3",349,0) + write ! +"RTN","TMGSEQL3",350,0) + +"RTN","TMGSEQL3",351,0) +SOCDone +"RTN","TMGSEQL3",352,0) + quit +"RTN","TMGSEQL3",353,0) + +"RTN","TMGSEQL3",354,0) + +"RTN","TMGSEQL3",355,0) + +"RTN","TMGSEQL3",356,0) +CLEARALL +"RTN","TMGSEQL3",357,0) + ;"Purpose: Wrapper for QuietClear (which clears all entries in file 22706 and all alerts.) +"RTN","TMGSEQL3",358,0) + ;"Input: none, DUZ (in global scope) is used +"RTN","TMGSEQL3",359,0) + ;"Output: All entries in the file and all associated Alerts are deleted +"RTN","TMGSEQL3",360,0) + ;"Results: none +"RTN","TMGSEQL3",361,0) + +"RTN","TMGSEQL3",362,0) + new TMGLIST +"RTN","TMGSEQL3",363,0) + new i,count +"RTN","TMGSEQL3",364,0) + set count=0 +"RTN","TMGSEQL3",365,0) + +"RTN","TMGSEQL3",366,0) + write !,"-==Error Deleater==-",! +"RTN","TMGSEQL3",367,0) + write "This will delete all error alerts related to",! +"RTN","TMGSEQL3",368,0) + write "importing demographics from Sequel system",!! +"RTN","TMGSEQL3",369,0) + +"RTN","TMGSEQL3",370,0) + set count=$$QuietClear(DUZ) +"RTN","TMGSEQL3",371,0) + +"RTN","TMGSEQL3",372,0) + write count," data import errors " +"RTN","TMGSEQL3",373,0) + if count>0 write "deleted.",! +"RTN","TMGSEQL3",374,0) + else write "to delete.",! +"RTN","TMGSEQL3",375,0) + +"RTN","TMGSEQL3",376,0) + write !,"Goodbye.",! +"RTN","TMGSEQL3",377,0) + +"RTN","TMGSEQL3",378,0) + quit +"RTN","TMGSEQL3",379,0) + +"RTN","TMGSEQL3",380,0) + +"RTN","TMGSEQL3",381,0) +QuietClear(DUZ) +"RTN","TMGSEQL3",382,0) + ;"Purpose: To clear all entries in file 22706 and all alerts. +"RTN","TMGSEQL3",383,0) + ;"Input: DUZ, the user to delete alerts for. +"RTN","TMGSEQL3",384,0) + ;"Output: All entries in the file and all associated Alerts are deleted +"RTN","TMGSEQL3",385,0) + ;"Results: count of errors deleted. +"RTN","TMGSEQL3",386,0) + +"RTN","TMGSEQL3",387,0) + new TMGLIST +"RTN","TMGSEQL3",388,0) + new i,count +"RTN","TMGSEQL3",389,0) + set count=0 +"RTN","TMGSEQL3",390,0) + +"RTN","TMGSEQL3",391,0) + do USER^XQALERT("TMGLIST",DUZ) +"RTN","TMGSEQL3",392,0) + +"RTN","TMGSEQL3",393,0) + set i=$order(TMGLIST("")) +"RTN","TMGSEQL3",394,0) + if i'="" for do quit:(+i'>0) +"RTN","TMGSEQL3",395,0) + . new alertID,IEN,TMGDATA,line +"RTN","TMGSEQL3",396,0) + . set line=$get(TMGLIST(i)) +"RTN","TMGSEQL3",397,0) + . set i=$order(TMGLIST(i)) +"RTN","TMGSEQL3",398,0) + . set alertID=$piece(line,"^",2) +"RTN","TMGSEQL3",399,0) + . if $piece(alertID,";",1)'="TMGSQLIMPORT" quit +"RTN","TMGSEQL3",400,0) + . new XQAID +"RTN","TMGSEQL3",401,0) + . do GETACT^XQALERT(alertID) ;"loads XQADATA, XQAID +"RTN","TMGSEQL3",402,0) + . if +XQADATA>0 do +"RTN","TMGSEQL3",403,0) + . . new TMGERR,result +"RTN","TMGSEQL3",404,0) + . . set count=count+1 +"RTN","TMGSEQL3",405,0) + . . ;"write "Deleting from file 22706, IEN=",XQADATA,! +"RTN","TMGSEQL3",406,0) + . . set result=$$DelIEN^TMGDBAPI(22706,XQADATA,.TMGERR) +"RTN","TMGSEQL3",407,0) + . . if result=0 do ShowDIERR^TMGDEBUG(.TMGERR) +"RTN","TMGSEQL3",408,0) + . . else do +"RTN","TMGSEQL3",409,0) + . . . ;"write $piece(line,"^",1),!! +"RTN","TMGSEQL3",410,0) + . . . do DELETE^XQALERT +"RTN","TMGSEQL3",411,0) + . ;"else write "?? XQADATA ??",! +"RTN","TMGSEQL3",412,0) + +"RTN","TMGSEQL3",413,0) + quit count +"RTN","TMGSEQL3",414,0) + +"RTN","TMGSEQL3",415,0) + +"RTN","TMGSEQL3",416,0) + +"RTN","TMGSEQL3",417,0) +Schedule(Time,Routine,Descr) +"RTN","TMGSEQL3",418,0) + ;"Purpose: to schedule a task at the given time, to run the specified routine +"RTN","TMGSEQL3",419,0) + ;"Input: Time: The time to run the task, in FileMan or $HOROLOG format +"RTN","TMGSEQL3",420,0) + ;" Routine: the routine to run. E.g. "TEST^TMGSEQL3" +"RTN","TMGSEQL3",421,0) + ;" Descr: Task description (don't include package name) +"RTN","TMGSEQL3",422,0) + ;"Output: Will shedule the task with TaskMan +"RTN","TMGSEQL3",423,0) + ;"Result: returns the task number +"RTN","TMGSEQL3",424,0) + +"RTN","TMGSEQL3",425,0) + new result +"RTN","TMGSEQL3",426,0) + set result="" +"RTN","TMGSEQL3",427,0) + +"RTN","TMGSEQL3",428,0) + ;"New all vars used by taskman scheduler, to ensure to use of unexpected values +"RTN","TMGSEQL3",429,0) + new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU +"RTN","TMGSEQL3",430,0) + new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC +"RTN","TMGSEQL3",431,0) + +"RTN","TMGSEQL3",432,0) + set ZTRTN=$get(Routine) +"RTN","TMGSEQL3",433,0) + set ZTDESC="TMG SEQUELIMPORTER "_$get(Descr) +"RTN","TMGSEQL3",434,0) + set ZTDTH=$get(Time) +"RTN","TMGSEQL3",435,0) + set ZTIO="" +"RTN","TMGSEQL3",436,0) + +"RTN","TMGSEQL3",437,0) + do ^%ZTLOAD +"RTN","TMGSEQL3",438,0) + +"RTN","TMGSEQL3",439,0) + set result=$get(ZTSK) +"RTN","TMGSEQL3",440,0) + +"RTN","TMGSEQL3",441,0) +SchDone +"RTN","TMGSEQL3",442,0) + quit result +"RTN","TMGSEQL3",443,0) + +"RTN","TMGSEQL3",444,0) + +"RTN","TMGSEQL3",445,0) +SHOWTIME +"RTN","TMGSEQL3",446,0) + ;"Purpose: to show the last time that the import task was run +"RTN","TMGSEQL3",447,0) + ;"Input: none +"RTN","TMGSEQL3",448,0) + ;"Output: will write to screen +"RTN","TMGSEQL3",449,0) + ;"Result: none +"RTN","TMGSEQL3",450,0) + +"RTN","TMGSEQL3",451,0) + new time +"RTN","TMGSEQL3",452,0) + +"RTN","TMGSEQL3",453,0) + write !!,"SEQUEL BILLING SYSTEM DEMOGRAPHICS IMPORT",! +"RTN","TMGSEQL3",454,0) + write "Last demographics import date/time was: " +"RTN","TMGSEQL3",455,0) + set time=$$GET1^DIQ(22711,"1,","LAST IMPORT DATE","I") +"RTN","TMGSEQL3",456,0) + write $$FMTE^XLFDT(time,"P"),! +"RTN","TMGSEQL3",457,0) + +"RTN","TMGSEQL3",458,0) + new task +"RTN","TMGSEQL3",459,0) + set task=$$GET1^DIQ(22711,"1,","TASK FOR NEXT RUN","I") +"RTN","TMGSEQL3",460,0) + if +task>0 do +"RTN","TMGSEQL3",461,0) + . write "Next demographics import date/time is: " +"RTN","TMGSEQL3",462,0) + . set time=$$GET1^DIQ(14.4,task_",","Scheduled Run Time ($H)") +"RTN","TMGSEQL3",463,0) + . write $$HTE^XLFDT(time,"P"),! +"RTN","TMGSEQL3",464,0) + +"RTN","TMGSEQL3",465,0) + quit +"RTN","TMGSEQL3",466,0) + +"RTN","TMGSHORT") +0^78^B7015 +"RTN","TMGSHORT",1,0) +TMGSHORT ;TMG/kst/Code to Shorten Names ;03/25/06 +"RTN","TMGSHORT",2,0) + ;;1.0;TMG-LIB;**1**;12/23/06 +"RTN","TMGSHORT",3,0) + +"RTN","TMGSHORT",4,0) + ;" SHORTEN NAMES code +"RTN","TMGSHORT",5,0) + +"RTN","TMGSHORT",6,0) + ;"Kevin Toppenberg MD +"RTN","TMGSHORT",7,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGSHORT",8,0) + ;"12-23-2006 +"RTN","TMGSHORT",9,0) + +"RTN","TMGSHORT",10,0) + ;"======================================================================= +"RTN","TMGSHORT",11,0) + ;" API -- Public Functions. +"RTN","TMGSHORT",12,0) + ;"======================================================================= +"RTN","TMGSHORT",13,0) + ;"ShortNetName(GenericName,TradeName,Strength,Units,MaxLen) +"RTN","TMGSHORT",14,0) + ;"$$ShortenArray(Names,Dividers,MaxLen,AllowCut) -- core menus for shortening name +"RTN","TMGSHORT",15,0) + ;"$$PShortName(Name,Length,AskUser) -- shorten the drug smartly, using abbreviations +"RTN","TMGSHORT",16,0) + ;"$$ShortName(Name,Length,AskUser,DivStr) -- shorten the drug smartly, using abbreviations +"RTN","TMGSHORT",17,0) + ;"$$Short2Name(Name,Div1,Div2,.Words,.Dividers) -- Shorten a name to shortest form possible +"RTN","TMGSHORT",18,0) + ;"$$Short1Name(Name,MaxLen,Div1,Div2,Words,Dividers) -- An interactive editing of one name +"RTN","TMGSHORT",19,0) + ;"$$Cut1Name(Name,MaxLen,Div1,Div2,Words,Dividers) -- A non-interactive cut of one name +"RTN","TMGSHORT",20,0) + +"RTN","TMGSHORT",21,0) + ;"======================================================================= +"RTN","TMGSHORT",22,0) + ;" Private Functions. +"RTN","TMGSHORT",23,0) + ;"======================================================================= +"RTN","TMGSHORT",24,0) + ;"$$ReadJoin(JoinNum,Len,Words,Dividers) -- read out a phrase of joined words, Len words long +"RTN","TMGSHORT",25,0) + ;"SetJoin(JoinNum,Len,Words,Dividers) -- reform the Word and Dividers arrays such that +"RTN","TMGSHORT",26,0) + ;" words are joined together. E.g. #1='One' #2='Minute' ==> #1='One Minute' +"RTN","TMGSHORT",27,0) + ;"SubDivArray(Words,Dividers,Div1,Div2) -- check and handle if words in Words array need subdivision +"RTN","TMGSHORT",28,0) + ;"PackArrays(pNames,pDividers) -- pack the arrays, after items had been deleted. +"RTN","TMGSHORT",29,0) + ;"CompArray(Names,Dividers) -- reconstruct the resulting sentence from words in array. +"RTN","TMGSHORT",30,0) + ;"AutoShortenArray(.Names,.Dividers,MaxLen,Div1,Div2) -- automatically shorten the words in the array +"RTN","TMGSHORT",31,0) + ;"$$CutName(.Names,.Dividers,MaxLen) -- return a non-interactive shortened ('cut') name +"RTN","TMGSHORT",32,0) + +"RTN","TMGSHORT",33,0) + ;"======================================================================= +"RTN","TMGSHORT",34,0) + ;"======================================================================= +"RTN","TMGSHORT",35,0) + +"RTN","TMGSHORT",36,0) +ShortNetName(GenericName,TradeName,Strength,Units,MaxLen,AllowCut) +"RTN","TMGSHORT",37,0) + ;"Purpose: to create a shortened name from parts, not longer than MaxLen +"RTN","TMGSHORT",38,0) + ;"Input: GenericName -- Generic portion of name +"RTN","TMGSHORT",39,0) + ;" TradeName -- Tradename portion of name +"RTN","TMGSHORT",40,0) + ;" Strength -- OPTIONAL Strength portion of name +"RTN","TMGSHORT",41,0) + ;" Units -- OPTIONAL units portion of name +"RTN","TMGSHORT",42,0) + ;" MaxLen -- the maximum length +"RTN","TMGSHORT",43,0) + ;" AllowCut -- OPTIONAL If 1 then name may be cut off with ... to reach target length +"RTN","TMGSHORT",44,0) + ;" and user will not be asked for input +"RTN","TMGSHORT",45,0) + ;" If 2 then name wil be shortened as far as possible, but it +"RTN","TMGSHORT",46,0) + ;" wil not be cut off +"RTN","TMGSHORT",47,0) + ;"Result: Returns new shortened name, or "^" for user abort +"RTN","TMGSHORT",48,0) + +"RTN","TMGSHORT",49,0) + new result,temp +"RTN","TMGSHORT",50,0) + set GenericName=$get(GenericName) +"RTN","TMGSHORT",51,0) + set TradeName=$get(TradeName) +"RTN","TMGSHORT",52,0) + set Strength=$get(Strength) +"RTN","TMGSHORT",53,0) + set Units=$get(Units) +"RTN","TMGSHORT",54,0) + set MaxLen=$get(MaxLen,16) +"RTN","TMGSHORT",55,0) + set AllowCut=$get(AllowCut,0) +"RTN","TMGSHORT",56,0) + +"RTN","TMGSHORT",57,0) + new Names,Dividers +"RTN","TMGSHORT",58,0) + new unitsIdx,GenericIdx set GenericIdx=0,unitsIdx=0 +"RTN","TMGSHORT",59,0) + ;"sometimes 'Trade Name' is actually an expanded form of the Generic name +"RTN","TMGSHORT",60,0) + ;"e.g. ACETAZOLAMIDE (ACETAZOLAMIDE CAP USP) 250 +"RTN","TMGSHORT",61,0) + ;"In these cases I will delete the duplication +"RTN","TMGSHORT",62,0) +SNN0 if $extract(TradeName,1,$length(GenericName))=GenericName set GenericName="" +"RTN","TMGSHORT",63,0) + if (TradeName="")!(GenericName="") do +"RTN","TMGSHORT",64,0) + . new i set i=0 +"RTN","TMGSHORT",65,0) + . if TradeName'="" set i=i+1,Names(i)=TradeName,Dividers(i)=" " +"RTN","TMGSHORT",66,0) + . if GenericName'="" set i=i+1,Names(i)=GenericName,Dividers(i)=" ",GenericIdx=i +"RTN","TMGSHORT",67,0) + . ;"set Names(i)=TradeName,Dividers(i)=" ",i=i+1 +"RTN","TMGSHORT",68,0) + . if Strength'="" set i=i+1,Names(i)=Strength,Dividers(i)=" " +"RTN","TMGSHORT",69,0) + . if Units'="" set i=i+1,Names(i)=Units,unitsIdx=i,Dividers(i)="" +"RTN","TMGSHORT",70,0) + . set Names("MAXNODE")=i,Dividers("MAXNODE")=i +"RTN","TMGSHORT",71,0) + else do +"RTN","TMGSHORT",72,0) + . new i set i=0 +"RTN","TMGSHORT",73,0) + . set i=i+1,Names(i)=TradeName,Dividers(i)=" (" +"RTN","TMGSHORT",74,0) + . set i=i+1,Names(i)=GenericName,GenericIdx=i,Dividers(i)=") " +"RTN","TMGSHORT",75,0) + . ;"set i=i+1,Names(i)=GenericName,GenericIdx=i,Dividers(i)=" (" ;changed 10-30-07 +"RTN","TMGSHORT",76,0) + . ;"set i=i+1,Names(i)=TradeName,Dividers(i)=") " +"RTN","TMGSHORT",77,0) + . if Strength'="" set i=i+1,Names(i)=Strength,Dividers(i)=" " +"RTN","TMGSHORT",78,0) + . if Units'="" set i=i+1,Names(i)=Units,unitsIdx=i,Dividers(i)="" +"RTN","TMGSHORT",79,0) + . set Names("MAXNODE")=i,Dividers("MAXNODE")=i +"RTN","TMGSHORT",80,0) + +"RTN","TMGSHORT",81,0) + for i=1:1:Names("MAXNODE")-1 do ;"don't cleave units (e.g. MG/ML) +"RTN","TMGSHORT",82,0) + . set:(i>1) Names(i)=$translate(Names(i),"/","|") +"RTN","TMGSHORT",83,0) + do SubDivArray(.Names,.Dividers," ","/") +"RTN","TMGSHORT",84,0) + +"RTN","TMGSHORT",85,0) + set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut) +"RTN","TMGSHORT",86,0) + if result=0 kill Names,Dividers goto SNN0 ;"honor requested retry +"RTN","TMGSHORT",87,0) + +"RTN","TMGSHORT",88,0) + ;"If shortening required "...", see if removing parts of name allow goal. +"RTN","TMGSHORT",89,0) + if (AllowCut=1)&(result["...") do +"RTN","TMGSHORT",90,0) +SNN1 . ;"try removing units first +"RTN","TMGSHORT",91,0) + . kill Names(unitsIdx),Dividers(unitsIdx) +"RTN","TMGSHORT",92,0) + . do PackArrays("Names","Dividers") +"RTN","TMGSHORT",93,0) + . set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut) +"RTN","TMGSHORT",94,0) + . if result'["..." quit +"RTN","TMGSHORT",95,0) + . if GenericIdx'=0 do +"RTN","TMGSHORT",96,0) + . . kill Names(GenericIdx) +"RTN","TMGSHORT",97,0) + . . if Dividers(GenericIdx)=" (" set Dividers(GenericIdx+1)=" " +"RTN","TMGSHORT",98,0) + . . kill Dividers(GenericIdx) +"RTN","TMGSHORT",99,0) + . . do PackArrays("Names","Dividers") +"RTN","TMGSHORT",100,0) + . . set result=$$ShortenArray(.Names,.Dividers,MaxLen,AllowCut) +"RTN","TMGSHORT",101,0) + . if result'["..." quit +"RTN","TMGSHORT",102,0) + . ;"more later... ? +"RTN","TMGSHORT",103,0) + +"RTN","TMGSHORT",104,0) +SNNDone +"RTN","TMGSHORT",105,0) + set result=$$Trim^TMGSTUTL(result) +"RTN","TMGSHORT",106,0) + if $extract(result,1,1)="(" do ;"Input transform doesn't allow first chart to be '(' +"RTN","TMGSHORT",107,0) + . ;"NOTE: I should write better code to change only the LAST ) to "", i.e. not cut out ALL ()'s +"RTN","TMGSHORT",108,0) + . set result=$translate(result,"(","") +"RTN","TMGSHORT",109,0) + . set result=$translate(result,")","") +"RTN","TMGSHORT",110,0) + if (result[")")&(result'["(") set result=$translate(result,")","") +"RTN","TMGSHORT",111,0) + set result=$translate(result,"|","/") +"RTN","TMGSHORT",112,0) + quit result +"RTN","TMGSHORT",113,0) + +"RTN","TMGSHORT",114,0) + +"RTN","TMGSHORT",115,0) +ShortenArray(Names,Dividers,MaxLen,AllowCut) +"RTN","TMGSHORT",116,0) + ;"Purpose: shorten name +"RTN","TMGSHORT",117,0) + ;"Input: Names -- PASS BY REFERENCE. An array containing the words +"RTN","TMGSHORT",118,0) + ;" Dividers -- PASS BY REFERENCE. An array containing the bits between words +"RTN","TMGSHORT",119,0) + ;" MaxLen -- OPTIONAL. Default=1. The length that words must fit within +"RTN","TMGSHORT",120,0) + ;" AllowCut -- OPTIONAL. Default=0. Set 1 if automatic shortening is allowed. +"RTN","TMGSHORT",121,0) + ;" If 1, MaxLen value SHOULD BE supplied +"RTN","TMGSHORT",122,0) + ;" If 2 then name wil be shortened as far as possible, but it +"RTN","TMGSHORT",123,0) + ;" wil not be cut off. User will not be asked. +"RTN","TMGSHORT",124,0) + +"RTN","TMGSHORT",125,0) + ;"Result: returns the shortened name, or "^" for abort, or 0 for requested retry. +"RTN","TMGSHORT",126,0) + +"RTN","TMGSHORT",127,0) + new result set result="" +"RTN","TMGSHORT",128,0) + set MaxLen=$get(MaxLen,1) +"RTN","TMGSHORT",129,0) + set AllowCut=$get(AllowCut,0) +"RTN","TMGSHORT",130,0) + new UserAsked set UserAsked=0 +"RTN","TMGSHORT",131,0) + new StartOver set StartOver=0 +"RTN","TMGSHORT",132,0) + new OrigName set OrigName=$$CompArray(.Names,.Dividers) +"RTN","TMGSHORT",133,0) + +"RTN","TMGSHORT",134,0) + ;"First try a non-interactive shortening +"RTN","TMGSHORT",135,0) + set result=$$AutoShortenArray(.Names,.Dividers,MaxLen,"/"," ") +"RTN","TMGSHORT",136,0) + if (AllowCut'=1)&(result["...") goto SNA0 +"RTN","TMGSHORT",137,0) + if $length(result)'>MaxLen goto SNA1Done +"RTN","TMGSHORT",138,0) + +"RTN","TMGSHORT",139,0) +SNA0 if AllowCut=1 set result=$$CutName(.Names,.Dividers,MaxLen) goto SNA1Done +"RTN","TMGSHORT",140,0) + if AllowCut=2 set result=$$CompArray(.Names,.Dividers) goto SNA1Done +"RTN","TMGSHORT",141,0) + +"RTN","TMGSHORT",142,0) +SNA1 if result=0 goto SNA2Done ;"requesting retry. +"RTN","TMGSHORT",143,0) + set result=$$Trim^TMGSTUTL($$CompArray(.Names,.Dividers)) +"RTN","TMGSHORT",144,0) + if $length(result)'>MaxLen goto SNA1Done +"RTN","TMGSHORT",145,0) + +"RTN","TMGSHORT",146,0) + write OrigName,"-->",! +"RTN","TMGSHORT",147,0) + write "Current Name:",! +"RTN","TMGSHORT",148,0) + write result,! +"RTN","TMGSHORT",149,0) + if MaxLen>1 do +"RTN","TMGSHORT",150,0) + . new tempS set tempS="Shorten to ---> |" +"RTN","TMGSHORT",151,0) + . for i=1:1:MaxLen-$length(tempS) write " " +"RTN","TMGSHORT",152,0) + . write tempS +"RTN","TMGSHORT",153,0) + . for i=1:1:$length(result)-MaxLen write "x" +"RTN","TMGSHORT",154,0) + . write ! +"RTN","TMGSHORT",155,0) + +"RTN","TMGSHORT",156,0) + write "-----------------------",! +"RTN","TMGSHORT",157,0) + for i=1:1:Names("MAXNODE") do +"RTN","TMGSHORT",158,0) + . if $get(Names(i))="" quit +"RTN","TMGSHORT",159,0) + . write i,". ",Names(i) +"RTN","TMGSHORT",160,0) + . new temp set temp=$$GetAbvr^TMGABV(Names(i),0) +"RTN","TMGSHORT",161,0) + . if (temp'="")&(temp'=Names(i)) write " (<-- Quick Fix: ",temp,")" +"RTN","TMGSHORT",162,0) + . write ! +"RTN","TMGSHORT",163,0) + write "-----------------------",! +"RTN","TMGSHORT",164,0) + write " # (or #-#) -- Shorten name(s) Q# (or #-#) -- Use Quick FiX",! +"RTN","TMGSHORT",165,0) + write " S# -- Sub-edit name T -- Free text for ALL",! +"RTN","TMGSHORT",166,0) + write " S?# -- Sub-edit name (ask for divider character)",! +"RTN","TMGSHORT",167,0) + write " Sx# -- Sub-edit name (use any character (i.e. replace 'x') as divider)",! +"RTN","TMGSHORT",168,0) + write " J# -- Join word # to word #+1 F# -- Fix erroneous abbrev",! +"RTN","TMGSHORT",169,0) + write " D# (or D#-#) -- Delete # X# -- Kill Quick Fix",! +"RTN","TMGSHORT",170,0) + write " ! -- toggle debug mode ",$select(($get(TMGDBABV)=1):"OFF",1:"ON"),! +"RTN","TMGSHORT",171,0) + write " C -- cut to: ",$$CutName(.Names,.Dividers,MaxLen),! +"RTN","TMGSHORT",172,0) + ;"write " ^^ -- Abort",! +"RTN","TMGSHORT",173,0) + write "(^ to quit, ^^ to abort): ^//" +"RTN","TMGSHORT",174,0) + set UserAsked=1 +"RTN","TMGSHORT",175,0) + read temp:$get(DTIME,3600),! +"RTN","TMGSHORT",176,0) + set temp=$$UP^XLFSTR(temp) +"RTN","TMGSHORT",177,0) + if temp="" set temp="^" do goto SNA1Done +"RTN","TMGSHORT",178,0) + . set result=$$CompArray(.Names,.Dividers) +"RTN","TMGSHORT",179,0) + if temp="^^" set result="^" goto SNA2Done +"RTN","TMGSHORT",180,0) + if temp="C" set AllowCut=1 goto SNA0 +"RTN","TMGSHORT",181,0) + if "S"[$extract(temp,1) do +"RTN","TMGSHORT",182,0) + . new num1,s +"RTN","TMGSHORT",183,0) + . new nodeDiv set nodeDiv=" " +"RTN","TMGSHORT",184,0) + . set s=$extract(temp,2) +"RTN","TMGSHORT",185,0) + . if +s'=s do quit:(nodeDiv="^") +"RTN","TMGSHORT",186,0) + . . if s="?" do quit:(nodeDiv="^") +"RTN","TMGSHORT",187,0) + . . . write "Enter character that divides words (e.g. '/' ',' '|' ';' ' ' etc.)",! +"RTN","TMGSHORT",188,0) + . . . read "Divider character? ' '// ",nodeDiv,! +"RTN","TMGSHORT",189,0) + . . . if nodeDiv="" set nodeDiv=" " +"RTN","TMGSHORT",190,0) + . . else set nodeDiv=s +"RTN","TMGSHORT",191,0) + . . set num1=+$extract(temp,3,99) +"RTN","TMGSHORT",192,0) + . else set num1=+$extract(temp,2,99) +"RTN","TMGSHORT",193,0) + . if num1=0 read "Enter NUMBER of name to edit: ",num1:$get(DTIME,3600),! +"RTN","TMGSHORT",194,0) + . set num1=+num1 +"RTN","TMGSHORT",195,0) + . if (num1'>0)!(num1>Names("MAXNODE")) quit +"RTN","TMGSHORT",196,0) + . new temp set temp=$$Short1Name(Names(num1),$length(Names(num1))-1,nodeDiv) +"RTN","TMGSHORT",197,0) + . if (temp="^")!(temp="")!(temp=Names(num1)) quit +"RTN","TMGSHORT",198,0) + . do Write^TMGABV(Names(num1),temp,,1) ;"1=> confirm +"RTN","TMGSHORT",199,0) + . set Names(num1)=temp +"RTN","TMGSHORT",200,0) + if temp="T" do goto SNA1Done +"RTN","TMGSHORT",201,0) +TX1 . write "Enter text for ENTIRE name (combining all shown parts) (^ to abort):",! +"RTN","TMGSHORT",202,0) + . read "> ",input:$get(DTIME,3600),! +"RTN","TMGSHORT",203,0) + . if input="^" quit +"RTN","TMGSHORT",204,0) + . ;"kill Words,Dividers +"RTN","TMGSHORT",205,0) + . kill Names,Dividers +"RTN","TMGSHORT",206,0) + . ;"set Words(1)=input,Words("MAXNODE")=1,Dividers(1)="" +"RTN","TMGSHORT",207,0) + . set Names(1)=input,Names("MAXNODE")=1,Dividers(1)="" +"RTN","TMGSHORT",208,0) + if "J"[$extract(temp,1) do +"RTN","TMGSHORT",209,0) + . new JoinNum +"RTN","TMGSHORT",210,0) + . set JoinNum=+$extract(temp,2,99) +"RTN","TMGSHORT",211,0) + . if JoinNum'>0 read "Enter # to join: ",JoinNum:$get(DTIME,3600),! +"RTN","TMGSHORT",212,0) + . if +JoinNum'>0 quit +"RTN","TMGSHORT",213,0) + . ;"if JoinNum=Words("MAXNODE") do quit +"RTN","TMGSHORT",214,0) + . if JoinNum=Names("MAXNODE") do quit +"RTN","TMGSHORT",215,0) + . . write "Enter the # of the FIRST word to be joined.",! +"RTN","TMGSHORT",216,0) +JL1 . ;"do SetJoin(JoinNum,2,.Words,.Dividers) +"RTN","TMGSHORT",217,0) + . do SetJoin(JoinNum,2,.Names,.Dividers) +"RTN","TMGSHORT",218,0) + if (temp="D")!(temp?1"D".N)!(temp?1"D".N1"-".N) do goto SNA1 +"RTN","TMGSHORT",219,0) +JL2 . new delNum,delNum2,i +"RTN","TMGSHORT",220,0) + . set temp=$extract(temp,2,99) +"RTN","TMGSHORT",221,0) + . ;"if Words("MAXNODE")=1 set delNum=1,delNum2=1 +"RTN","TMGSHORT",222,0) + . if $get(Names("MAXNODE"))=1 set delNum=1,delNum2=1 +"RTN","TMGSHORT",223,0) + . else do +"RTN","TMGSHORT",224,0) + . . set delNum=+$piece(temp,"-",1) +"RTN","TMGSHORT",225,0) + . . set delNum2=+$piece(temp,"-",2) +"RTN","TMGSHORT",226,0) + . . if delNum20 quit +"RTN","TMGSHORT",228,0) + . . read "Enter # (or #-#) to delete: ",temp:$get(DTIME,3600),! +"RTN","TMGSHORT",229,0) + . . set delNum=+$piece(temp,"-",1) +"RTN","TMGSHORT",230,0) + . . set delNum2=+$piece(temp,"-",2) +"RTN","TMGSHORT",231,0) + . . if delNum20 kill Words(i),Dividers(i) +"RTN","TMGSHORT",234,0) + . . if +i>0 kill Names(i),Dividers(i) +"RTN","TMGSHORT",235,0) + . ;"do PackArrays("Words","Dividers") +"RTN","TMGSHORT",236,0) + . do PackArrays("Names","Dividers") +"RTN","TMGSHORT",237,0) + if "X"[$extract(temp,1) do +"RTN","TMGSHORT",238,0) + . new delNum +"RTN","TMGSHORT",239,0) + . ;"if Words("MAXNODE")=1 set delNum=1 +"RTN","TMGSHORT",240,0) + . if Names("MAXNODE")=1 set delNum=1 +"RTN","TMGSHORT",241,0) + . else do +"RTN","TMGSHORT",242,0) + . . set delNum=+$extract(temp,2,99) +"RTN","TMGSHORT",243,0) + . . if delNum>0 quit +"RTN","TMGSHORT",244,0) + . . read "Enter # of Quick Fix to delete: ",delNum:$get(DTIME,3600),! +"RTN","TMGSHORT",245,0) + . ;"if +delNum>0 do Del^TMGABV(Words(delNum)) +"RTN","TMGSHORT",246,0) + . if +delNum>0 do Del^TMGABV(Names(delNum)) +"RTN","TMGSHORT",247,0) + if (temp?.N)!(temp?.N1"-".N) do goto SNA1 +"RTN","TMGSHORT",248,0) + . new num1,num2 +"RTN","TMGSHORT",249,0) + . set num1=+$piece(temp,"-",1) +"RTN","TMGSHORT",250,0) + . set num2=+$piece(temp,"-",2) +"RTN","TMGSHORT",251,0) + . if num2=0 set num2=num1 +"RTN","TMGSHORT",252,0) + . new tempS set tempS="" +"RTN","TMGSHORT",253,0) + . for i=num1:1:num2 set tempS=tempS_Names(i)_" " +"RTN","TMGSHORT",254,0) + . set tempS=$$Trim^TMGSTUTL(tempS) +"RTN","TMGSHORT",255,0) + . set tempS=$$GetAbvr^TMGABV(tempS,1) +"RTN","TMGSHORT",256,0) + . for i=num1+1:1:num2 kill Names(i) +"RTN","TMGSHORT",257,0) + . for i=num1:1:(num2-1) kill Dividers(i) +"RTN","TMGSHORT",258,0) + . set Names(num1)=tempS +"RTN","TMGSHORT",259,0) + . do PackArrays("Names","Dividers") +"RTN","TMGSHORT",260,0) + if (temp="Q")!(temp?1"Q".N)!(temp?1"Q".N1"-".N) do goto SNA1 +"RTN","TMGSHORT",261,0) + . new num1,num2 +"RTN","TMGSHORT",262,0) + . set num1=+$extract(temp,2,99) +"RTN","TMGSHORT",263,0) + . if num1=0 do quit:(+num1=0) +"RTN","TMGSHORT",264,0) + . . read "Enter NUMBER(S) of Quick Fix to use: ",temp:$get(DTIME,3600),! +"RTN","TMGSHORT",265,0) + . . set num1=+$piece(temp,"-",1) +"RTN","TMGSHORT",266,0) + . . set num2=+$piece(temp,"-",2) +"RTN","TMGSHORT",267,0) + . if +$get(num2)=0 set num2=num1 +"RTN","TMGSHORT",268,0) + . for i=num1:1:num2 do +"RTN","TMGSHORT",269,0) + . . set Names(i)=$$GetAbvr^TMGABV(Names(i),0) +"RTN","TMGSHORT",270,0) + if (temp="F")!(temp?1"F"1N) do goto SNA1 +"RTN","TMGSHORT",271,0) + . new num1 set num1=+$extract(temp,2,99) +"RTN","TMGSHORT",272,0) + . if num1=0 do quit:(+num1=0) +"RTN","TMGSHORT",273,0) + . . read "Enter NUMBER of abbreviation to fix: ",temp:$get(DTIME,3600),! +"RTN","TMGSHORT",274,0) + . . set num1=+temp +"RTN","TMGSHORT",275,0) + . new s set s=$$Fix^TMGABV(Names(num1),OrigName) +"RTN","TMGSHORT",276,0) + . if s=0 set result=0 quit ;"signal retry +"RTN","TMGSHORT",277,0) + . set Names(num1)=s +"RTN","TMGSHORT",278,0) + . if Names(num1)="" do +"RTN","TMGSHORT",279,0) + . . kill Names(num1) +"RTN","TMGSHORT",280,0) + . . ;"do PackArrays("Words","Dividers") +"RTN","TMGSHORT",281,0) + . . do PackArrays("Names","Dividers") +"RTN","TMGSHORT",282,0) + if (temp="!") do goto SNA1 +"RTN","TMGSHORT",283,0) +JL5 . if $get(TMGDBABV)=1 kill TMGDBABV +"RTN","TMGSHORT",284,0) + . else set TMGDBABV=1 +"RTN","TMGSHORT",285,0) + . set result=0 ;"signal request for retry. +"RTN","TMGSHORT",286,0) + goto SNA1 +"RTN","TMGSHORT",287,0) + +"RTN","TMGSHORT",288,0) +SNA1Done set result=$$Trim^TMGSTUTL(result) +"RTN","TMGSHORT",289,0) +SNA2Done +"RTN","TMGSHORT",290,0) + if (UserAsked=1)&(+result'=0) write "Using: ",result,! +"RTN","TMGSHORT",291,0) + quit result +"RTN","TMGSHORT",292,0) + +"RTN","TMGSHORT",293,0) + +"RTN","TMGSHORT",294,0) +ReadJoin(JoinNum,Len,Words,Dividers) +"RTN","TMGSHORT",295,0) + ;"Purpose: To read out a phrase of joined words, Len words long +"RTN","TMGSHORT",296,0) + ;"Input: JoinNum -- the index in Words where joining begins +"RTN","TMGSHORT",297,0) + ;" Len -- the length to return. e.g. 2 --> two words joined +"RTN","TMGSHORT",298,0) + ;" Words -- PASS BY REFERENCE. Array holding words +"RTN","TMGSHORT",299,0) + ;" Dividers -- PASS BY REFERENCE. Array holding dividers between words +"RTN","TMGSHORT",300,0) + ;"Results: returns string of joined words +"RTN","TMGSHORT",301,0) + +"RTN","TMGSHORT",302,0) + new result set result="" +"RTN","TMGSHORT",303,0) + if (JoinNum+Len-1)>Words("MAXNODE") goto RJDone +"RTN","TMGSHORT",304,0) + set result=$get(Words(JoinNum)) +"RTN","TMGSHORT",305,0) + new i for i=JoinNum:1:(JoinNum+Len-2) do +"RTN","TMGSHORT",306,0) + . set result=result_Dividers(i)_$get(Words(i+1)) +"RTN","TMGSHORT",307,0) +RJDone quit result +"RTN","TMGSHORT",308,0) + +"RTN","TMGSHORT",309,0) + +"RTN","TMGSHORT",310,0) +SetJoin(JoinNum,Len,Words,Dividers) +"RTN","TMGSHORT",311,0) + ;"Purpose: To reform the Word and Dividers arrays such that words are +"RTN","TMGSHORT",312,0) + ;" joined together. E.g. #1='One' #2='Minute' ==> #1='One Minute' +"RTN","TMGSHORT",313,0) + ;"Input: JoinNum -- the index in Words where joining begins +"RTN","TMGSHORT",314,0) + ;" Len -- the length to return. e.g. 2 --> two words joined +"RTN","TMGSHORT",315,0) + ;" Words -- PASS BY REFERENCE. Array holding words +"RTN","TMGSHORT",316,0) + ;" Dividers -- PASS BY REFERENCE. Array holding dividers between words +"RTN","TMGSHORT",317,0) + ;"Results: None +"RTN","TMGSHORT",318,0) + +"RTN","TMGSHORT",319,0) + new temp set temp=$$ReadJoin^TMGSHORT(JoinNum,Len,.Words,.Dividers) +"RTN","TMGSHORT",320,0) + new i for i=JoinNum:1:(JoinNum+Len-1) do +"RTN","TMGSHORT",321,0) + . if i'=JoinNum kill Words(i) +"RTN","TMGSHORT",322,0) + . if i'=(JoinNum+Len-1) kill Dividers(i) +"RTN","TMGSHORT",323,0) + +"RTN","TMGSHORT",324,0) + set Words(JoinNum)=temp +"RTN","TMGSHORT",325,0) + do PackArrays("Words","Dividers") +"RTN","TMGSHORT",326,0) + +"RTN","TMGSHORT",327,0) + quit +"RTN","TMGSHORT",328,0) + +"RTN","TMGSHORT",329,0) + +"RTN","TMGSHORT",330,0) +Short1Name(Name,MaxLen,Div1,Div2,Words,Dividers) +"RTN","TMGSHORT",331,0) + ;"Purpose: An interactive editing of one name +"RTN","TMGSHORT",332,0) + ;"Input: Name -- the name (string) to shorten. +"RTN","TMGSHORT",333,0) + ;" MaxLen -- OPTIONAL. The Max length of the string. +"RTN","TMGSHORT",334,0) + ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " " +"RTN","TMGSHORT",335,0) + ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/" +"RTN","TMGSHORT",336,0) + ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words +"RTN","TMGSHORT",337,0) + ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words +"RTN","TMGSHORT",338,0) + ;"Results: returns shortened name, or "^" for user abort +"RTN","TMGSHORT",339,0) + +"RTN","TMGSHORT",340,0) + set Div1=$get(Div1," ") +"RTN","TMGSHORT",341,0) + set Div2=$get(Div2) +"RTN","TMGSHORT",342,0) + +"RTN","TMGSHORT",343,0) +S1N0 do CleaveToArray^TMGSTUTL(Name,Div1,.Words) +"RTN","TMGSHORT",344,0) + for i=1:1:Words("MAXNODE") set Dividers(i)=Div1 +"RTN","TMGSHORT",345,0) + set Dividers(Words("MAXNODE"))="" +"RTN","TMGSHORT",346,0) + if Div2'="" do SubDivArray(.Words,.Dividers,Div1,Div2) +"RTN","TMGSHORT",347,0) + +"RTN","TMGSHORT",348,0) + set result=$$ShortenArray^TMGSHORT(.Words,.Dividers,MaxLen,0) +"RTN","TMGSHORT",349,0) + if result=0 kill Words,Dividers goto S1N0 +"RTN","TMGSHORT",350,0) + +"RTN","TMGSHORT",351,0) + quit result +"RTN","TMGSHORT",352,0) + +"RTN","TMGSHORT",353,0) + +"RTN","TMGSHORT",354,0) +Cut1Name(Name,MaxLen,Div1,Div2,Words,Dividers) +"RTN","TMGSHORT",355,0) + ;"Purpose: A non-interactive cut of one name +"RTN","TMGSHORT",356,0) + ;"Input: Name -- the name (string) to shorten. +"RTN","TMGSHORT",357,0) + ;" MaxLen -- The length of the string to cut to. +"RTN","TMGSHORT",358,0) + ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " " +"RTN","TMGSHORT",359,0) + ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/" +"RTN","TMGSHORT",360,0) + ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words +"RTN","TMGSHORT",361,0) + ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words +"RTN","TMGSHORT",362,0) + ;"Results: returns cut name +"RTN","TMGSHORT",363,0) + +"RTN","TMGSHORT",364,0) + set Div1=$get(Div1," ") +"RTN","TMGSHORT",365,0) + set Div2=$get(Div2) +"RTN","TMGSHORT",366,0) + +"RTN","TMGSHORT",367,0) + do CleaveToArray^TMGSTUTL(Name,Div1,.Words) +"RTN","TMGSHORT",368,0) + for i=1:1:Words("MAXNODE") set Dividers(i)=Div1 +"RTN","TMGSHORT",369,0) + set Dividers(Words("MAXNODE"))="" +"RTN","TMGSHORT",370,0) + if Div2'="" do SubDivArray(.Words,.Dividers,Div1,Div2) +"RTN","TMGSHORT",371,0) + +"RTN","TMGSHORT",372,0) + set result=$$CutName(.Words,.Dividers,MaxLen) +"RTN","TMGSHORT",373,0) + +"RTN","TMGSHORT",374,0) + quit result +"RTN","TMGSHORT",375,0) + +"RTN","TMGSHORT",376,0) + +"RTN","TMGSHORT",377,0) +Short2Name(Name,Div1,Div2,Words,Dividers,Category) +"RTN","TMGSHORT",378,0) + ;"Purpose: Shorten a name, using abbreviations etc. to shortest form possible +"RTN","TMGSHORT",379,0) + ;" Will separate name into individual words, separated by spaces +"RTN","TMGSHORT",380,0) + ;" and try to abbreviate each one. +"RTN","TMGSHORT",381,0) + ;"Input: Name -- name to shorten +"RTN","TMGSHORT",382,0) + ;" Div1 -- OPTIONAL. The first character used to separate words. Default is " " +"RTN","TMGSHORT",383,0) + ;" Div2 -- OPTIONAL. The second character used to separate words. Default is "/" +"RTN","TMGSHORT",384,0) + ;" Words -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns Name divided up into words +"RTN","TMGSHORT",385,0) + ;" Dividers -- OPTIONAL. PASS BY REFERENCE, an OUT PARAMETER. Returns dividers between words +"RTN","TMGSHORT",386,0) + ;" Category -- OPTIONAL. a category to look for phrases in +"RTN","TMGSHORT",387,0) + ;"Result: returns a shortened form of name +"RTN","TMGSHORT",388,0) + ;"Note: no testing of length done. +"RTN","TMGSHORT",389,0) + ;"Note: this function is NOT interactive with the user +"RTN","TMGSHORT",390,0) + ;"Note: This functions should be called repetatively,using the output from +"RTN","TMGSHORT",391,0) + ;" the last run as the input for the next run, until there is not further +"RTN","TMGSHORT",392,0) + ;" change, to get the best results. +"RTN","TMGSHORT",393,0) + +"RTN","TMGSHORT",394,0) + new temp,result,i +"RTN","TMGSHORT",395,0) + set result="" +"RTN","TMGSHORT",396,0) + if $get(Name)="" goto SN2Don2 +"RTN","TMGSHORT",397,0) + +"RTN","TMGSHORT",398,0) + set result=$$GetAbvr^TMGABV(Name,0) +"RTN","TMGSHORT",399,0) + if (result'="")&(result'=Name) goto SN2Done +"RTN","TMGSHORT",400,0) + +"RTN","TMGSHORT",401,0) + set Div1=$get(Div1," ") if Div1="" set Div1="@@@@" +"RTN","TMGSHORT",402,0) + set Div2=$get(Div2,"/") if Div2="" set Div2="@@@@" +"RTN","TMGSHORT",403,0) + +"RTN","TMGSHORT",404,0) + kill Words,Dividers +"RTN","TMGSHORT",405,0) + do CleaveToArray^TMGSTUTL(Name,Div1,.Words) +"RTN","TMGSHORT",406,0) + for i=1:1:Words("MAXNODE") set Dividers(i)=Div1 +"RTN","TMGSHORT",407,0) + set Dividers(Words("MAXNODE"))="" ;"//kt added 10/27/06 +"RTN","TMGSHORT",408,0) + +"RTN","TMGSHORT",409,0) + ;"Note: This purposefully does not keep rechecking for ever shortening +"RTN","TMGSHORT",410,0) + ;" Abreviations (or abrv of abrv's) so that the calling function +"RTN","TMGSHORT",411,0) + ;" can concat the results from this onto others and determine a +"RTN","TMGSHORT",412,0) + ;" total length, and then recall if needed. +"RTN","TMGSHORT",413,0) + new count set count=Words("MAXNODE") +"RTN","TMGSHORT",414,0) + for i=1:1:count do +"RTN","TMGSHORT",415,0) + . new temp,temp2 +"RTN","TMGSHORT",416,0) + . if Words(i)[Div2 set temp=$$Short2Name(Words(i),Div2) +"RTN","TMGSHORT",417,0) + . else set temp=$$GetAbvr^TMGABV(Words(i),0) +"RTN","TMGSHORT",418,0) + . set Words(i)=temp +"RTN","TMGSHORT",419,0) + +"RTN","TMGSHORT",420,0) + ;"Now look for double word matches +"RTN","TMGSHORT",421,0) + set Category=$get(Category,0) +"RTN","TMGSHORT",422,0) +SNL0 for i=1:1:count do +"RTN","TMGSHORT",423,0) + . new temp,temp2 +"RTN","TMGSHORT",424,0) + . set temp=$$ReadJoin^TMGSHORT(i,2,.Words,.Dividers) +"RTN","TMGSHORT",425,0) + . set temp2=$$GetAbvr^TMGABV(temp,Category) +"RTN","TMGSHORT",426,0) + . if (temp2'="")&(temp'=temp2) do +"RTN","TMGSHORT",427,0) +SNL1 . . ;"write "Found double word match: ",temp,"-->",temp2,! +"RTN","TMGSHORT",428,0) + . . do SetJoin^TMGSHORT(i,2,.Words,.Dividers) +"RTN","TMGSHORT",429,0) + . . set Words(i)=temp2 +"RTN","TMGSHORT",430,0) + . . ;"zwr Words(*) +"RTN","TMGSHORT",431,0) + . . set i=0,count=Words("MAXNODE") +"RTN","TMGSHORT",432,0) + +"RTN","TMGSHORT",433,0) + set result=$$CompArray(.Words,.Dividers) +"RTN","TMGSHORT",434,0) + +"RTN","TMGSHORT",435,0) +SN2Done set result=$$Trim^TMGSTUTL(result) +"RTN","TMGSHORT",436,0) + if (Name'=result) do Write^TMGABV(Name,result) +"RTN","TMGSHORT",437,0) + +"RTN","TMGSHORT",438,0) +SN2Don2 quit result +"RTN","TMGSHORT",439,0) + +"RTN","TMGSHORT",440,0) + +"RTN","TMGSHORT",441,0) +SubDivArray(Words,Dividers,Div1,Div2) +"RTN","TMGSHORT",442,0) + ;"Purpose: To see if any words in Words array needs to be subdivided, +"RTN","TMGSHORT",443,0) + ;" and to handle if needed. +"RTN","TMGSHORT",444,0) + ;"Input: Words -- PASS BY REFERENCE. Array of words +"RTN","TMGSHORT",445,0) + ;" Dividers -- PASS BY REFERENCE. Array of dividing parts +"RTN","TMGSHORT",446,0) + ;" Div1 -- the first division character, e.g. "/" or " " +"RTN","TMGSHORT",447,0) + ;" Div2 -- the second division character, e.g. " " or "/" +"RTN","TMGSHORT",448,0) + ;"Results: none +"RTN","TMGSHORT",449,0) + +"RTN","TMGSHORT",450,0) + new i +"RTN","TMGSHORT",451,0) + for i=1:1:Words("MAXNODE") do +"RTN","TMGSHORT",452,0) + . if Words(i)[Div2 do +"RTN","TMGSHORT",453,0) + . . new tempWords,j +"RTN","TMGSHORT",454,0) + . . do CleaveToArray^TMGSTUTL(Words(i),Div2,.tempWords) +"RTN","TMGSHORT",455,0) + . . for j=1:1:tempWords("MAXNODE") do +"RTN","TMGSHORT",456,0) + . . . set Words(+(i_"."_j))=tempWords(j) +"RTN","TMGSHORT",457,0) + . . . if j'=tempWords("MAXNODE") set Dividers(+(i_"."_j))=Div2 +"RTN","TMGSHORT",458,0) + . . . else set Dividers(+(i_"."_j))=Div1 +"RTN","TMGSHORT",459,0) + . . kill Words(i),Dividers(i) +"RTN","TMGSHORT",460,0) + do PackArrays("Words","Dividers") +"RTN","TMGSHORT",461,0) + +"RTN","TMGSHORT",462,0) + quit +"RTN","TMGSHORT",463,0) + +"RTN","TMGSHORT",464,0) + +"RTN","TMGSHORT",465,0) +PackArrays(pNames,pDividers) +"RTN","TMGSHORT",466,0) + ;"Purpose: to pack the arrays, after items had been deleted. +"RTN","TMGSHORT",467,0) + ;"Input: Names -- PASS BY NAME. Array of words +"RTN","TMGSHORT",468,0) + ;" Dividers -- PASS BY NAME. Array of dividing parts +"RTN","TMGSHORT",469,0) + ;"Result: none +"RTN","TMGSHORT",470,0) + +"RTN","TMGSHORT",471,0) + do ListPack^TMGMISC(pNames) +"RTN","TMGSHORT",472,0) + do ListPack^TMGMISC(pDividers) +"RTN","TMGSHORT",473,0) + set @pNames@("MAXNODE")=$$ListCt^TMGMISC(pNames) +"RTN","TMGSHORT",474,0) + set @pDividers@("MAXNODE")=$$ListCt^TMGMISC(pDividers) +"RTN","TMGSHORT",475,0) + quit +"RTN","TMGSHORT",476,0) + +"RTN","TMGSHORT",477,0) + +"RTN","TMGSHORT",478,0) +CompArray(Names,Dividers) +"RTN","TMGSHORT",479,0) + ;"Purpose: to reconstruct the resulting sentence from words in array. +"RTN","TMGSHORT",480,0) + ;"Input: Names -- PASS BY REFERENCE. Array of words +"RTN","TMGSHORT",481,0) + ;" Dividers -- PASS BY REFERENCE. Array of dividing parts +"RTN","TMGSHORT",482,0) + ;"Result: returns the compiled result +"RTN","TMGSHORT",483,0) + +"RTN","TMGSHORT",484,0) + new result,j +"RTN","TMGSHORT",485,0) + set result="" +"RTN","TMGSHORT",486,0) + for j=1:1:Names("MAXNODE") do +"RTN","TMGSHORT",487,0) + . set result=result_Names(j) +"RTN","TMGSHORT",488,0) + . if Names(j)'="" set result=result_Dividers(j) +"RTN","TMGSHORT",489,0) + quit result +"RTN","TMGSHORT",490,0) + +"RTN","TMGSHORT",491,0) + +"RTN","TMGSHORT",492,0) +AutoShortenArray(Names,Dividers,MaxLen,Div1,Div2) +"RTN","TMGSHORT",493,0) + ;"Purpose: To automatically shorten the words in the array +"RTN","TMGSHORT",494,0) + ;"Input: Names -- PASS BY REFERENCE. Array of words +"RTN","TMGSHORT",495,0) + ;" Dividers -- PASS BY REFERENCE. Array of dividing parts +"RTN","TMGSHORT",496,0) + ;" Div1 -- the first division character, e.g. "/" or " " +"RTN","TMGSHORT",497,0) + ;" Div2 -- the second division character, e.g. " " or "/" +"RTN","TMGSHORT",498,0) + +"RTN","TMGSHORT",499,0) + new result,newName,changeMade +"RTN","TMGSHORT",500,0) + set result="" +"RTN","TMGSHORT",501,0) + +"RTN","TMGSHORT",502,0) + new temp set temp=$$CompArray(.Names,.Dividers) +"RTN","TMGSHORT",503,0) + set result=$$GetAbvr^TMGABV(temp,0) +"RTN","TMGSHORT",504,0) + if result="^" set result="" do Del^TMGABV(temp) +"RTN","TMGSHORT",505,0) + if (result'="")&($length(result)'>MaxLen) goto ASADone +"RTN","TMGSHORT",506,0) + +"RTN","TMGSHORT",507,0) + for do quit:(changeMade=0)!($length(result)'>MaxLen) +"RTN","TMGSHORT",508,0) + . set changeMade=0 +"RTN","TMGSHORT",509,0) + . for i=1:1:Names("MAXNODE") do +"RTN","TMGSHORT",510,0) + . . set newName=$$Short2Name(Names(i),.Div1,.Div2) +"RTN","TMGSHORT",511,0) + . . ;"there was a loop where a name was repeatitively being replace with longer names --> crash +"RTN","TMGSHORT",512,0) + . . if (newName'=Names(i))&($length(newName)<$length(Names(i))) do +"RTN","TMGSHORT",513,0) + . . . set Names(i)=newName +"RTN","TMGSHORT",514,0) + . . . set changeMade=1 +"RTN","TMGSHORT",515,0) + . set result=$$CompArray(.Names,.Dividers) +"RTN","TMGSHORT",516,0) + +"RTN","TMGSHORT",517,0) +ASADone +"RTN","TMGSHORT",518,0) + quit result +"RTN","TMGSHORT",519,0) + +"RTN","TMGSHORT",520,0) + +"RTN","TMGSHORT",521,0) +CutName(Names,Dividers,MaxLen) +"RTN","TMGSHORT",522,0) + ;"Purpose: To return a non-interactive shortened ('cut') name +"RTN","TMGSHORT",523,0) + ;"Input: Names - PASS BY REFERENCE. As created in ShortNetName +"RTN","TMGSHORT",524,0) + ;" This is an array with the various words in the name +"RTN","TMGSHORT",525,0) + ;" Dividers -- PASS BY REFERENCE As created in ShortNetName +"RTN","TMGSHORT",526,0) + ;" This is an array with the spaces or punctiation separating words +"RTN","TMGSHORT",527,0) + ;" MaxLen -- The target length for result +"RTN","TMGSHORT",528,0) + ;"Result: returns the shortened name +"RTN","TMGSHORT",529,0) + +"RTN","TMGSHORT",530,0) + new partA,partB,Max,i,lenA +"RTN","TMGSHORT",531,0) + new result +"RTN","TMGSHORT",532,0) + +"RTN","TMGSHORT",533,0) + set Max=$get(Names("MAXNODE")) +"RTN","TMGSHORT",534,0) + +"RTN","TMGSHORT",535,0) + if Max'>3 do goto CutDone +"RTN","TMGSHORT",536,0) + . set result=$$CompArray(.Names,.Dividers) +"RTN","TMGSHORT",537,0) + . set result=$extract(result,1,MaxLen) +"RTN","TMGSHORT",538,0) + +"RTN","TMGSHORT",539,0) + set partB=$get(Dividers(Max-3)) +"RTN","TMGSHORT",540,0) + for i=Max-2:1:Max do +"RTN","TMGSHORT",541,0) + . set partB=partB_Names(i) +"RTN","TMGSHORT",542,0) + . if Names(i)'="" set partB=partB_Dividers(i) +"RTN","TMGSHORT",543,0) + set partB=$$Trim^TMGSTUTL(partB) +"RTN","TMGSHORT",544,0) + set partA="" +"RTN","TMGSHORT",545,0) + for i=1:1:Max-3 set partA=partA_Names(i) set:(i<(Max-3))&(Names(i)'="") partA=partA_Dividers(i) +"RTN","TMGSHORT",546,0) + new allowedALen set allowedALen=MaxLen-$length(partB) +"RTN","TMGSHORT",547,0) + set lenA=$length(partA) +"RTN","TMGSHORT",548,0) + if lenA>allowedALen do +"RTN","TMGSHORT",549,0) + . set allowedALen=allowedALen-4 +"RTN","TMGSHORT",550,0) + . if lenA=0 set partA="" quit +"RTN","TMGSHORT",551,0) + . if (allowedALen/lenA)<0.4 set partA="" quit +"RTN","TMGSHORT",552,0) + . if allowedALen<4 set partA="" quit +"RTN","TMGSHORT",553,0) + . set partA=$extract(partA,1,allowedALen)_"... " +"RTN","TMGSHORT",554,0) + set result=$$Trim^TMGSTUTL(partA_partB) +"RTN","TMGSHORT",555,0) + if $length(result)>MaxLen do +"RTN","TMGSHORT",556,0) + . if partA="" do +"RTN","TMGSHORT",557,0) + . . set partB="" ;"$get(Dividers(Max-2)) +"RTN","TMGSHORT",558,0) + . . for i=Max-1:1:Max do +"RTN","TMGSHORT",559,0) + . . . set partB=partB_Names(i) +"RTN","TMGSHORT",560,0) + . . . if Names(i)'="" set partB=partB_Dividers(i) +"RTN","TMGSHORT",561,0) + . . set partB=$$Trim^TMGSTUTL(partB) +"RTN","TMGSHORT",562,0) + . . set partA=Names(Max-2) +"RTN","TMGSHORT",563,0) + . . new allowedALen set allowedALen=MaxLen-$length(partB)-4 +"RTN","TMGSHORT",564,0) + . . set partA=$extract(partA,1,allowedALen)_"... " +"RTN","TMGSHORT",565,0) + . . set result=partA_partB +"RTN","TMGSHORT",566,0) + . else set result=$extract(result,1,MaxLen) +"RTN","TMGSHORT",567,0) + +"RTN","TMGSHORT",568,0) +CutDone +"RTN","TMGSHORT",569,0) + quit result +"RTN","TMGSHORT",570,0) + +"RTN","TMGSHORT",571,0) + +"RTN","TMGSHORT",572,0) +PShortName(Name,Length,AskUser) +"RTN","TMGSHORT",573,0) + ;"Purpose: To shorten the drug smartly, using abbreviations +"RTN","TMGSHORT",574,0) + ;" This function differs from ShortName (see below) because it smartly +"RTN","TMGSHORT",575,0) + ;" 'P'icks whether to use '/' or ' ' as a divider str. +"RTN","TMGSHORT",576,0) + ;"Input: Name -- the drug name to shorten +"RTN","TMGSHORT",577,0) + ;" Expected format is that found in file 50.6 field .01, +"RTN","TMGSHORT",578,0) + ;" i.e. INGREDIENT/INGREDIENT/INGREDIENT... +"RTN","TMGSHORT",579,0) + ;" Length -- The desired string length +"RTN","TMGSHORT",580,0) + ;" AskUser -- OPTIONAL. Default=0. +"RTN","TMGSHORT",581,0) + ;" If 1 then user is asked to supply abreviations if needed. +"RTN","TMGSHORT",582,0) + ;" If 2 then name is shortened as much as possible, but it +"RTN","TMGSHORT",583,0) + ;" might be longer than Length, it is not cut, and user is +"RTN","TMGSHORT",584,0) + ;" not asked. +"RTN","TMGSHORT",585,0) + ;"Result : returns shortened name, "^" for abort. +"RTN","TMGSHORT",586,0) + +"RTN","TMGSHORT",587,0) + new DivStr,result +"RTN","TMGSHORT",588,0) + if $length(Name,"/")>2 set DivStr="/" +"RTN","TMGSHORT",589,0) + else set DivStr=" " +"RTN","TMGSHORT",590,0) + +"RTN","TMGSHORT",591,0) + set result=$$ShortName(.Name,.Length,.AskUser,DivStr) +"RTN","TMGSHORT",592,0) + quit result +"RTN","TMGSHORT",593,0) + +"RTN","TMGSHORT",594,0) +ShortName(Name,Length,AskUser,DivStr) +"RTN","TMGSHORT",595,0) + ;"Purpose: To shorten the drug smartly, using abbreviations +"RTN","TMGSHORT",596,0) + ;"Input: Name -- the drug name to shorten +"RTN","TMGSHORT",597,0) + ;" Expected format is that found in file 50.6 field .01, +"RTN","TMGSHORT",598,0) + ;" i.e. INGREDIENT/INGREDIENT/INGREDIENT... +"RTN","TMGSHORT",599,0) + ;" Length -- The desired string length +"RTN","TMGSHORT",600,0) + ;" AskUser -- OPTIONAL. Default=0. +"RTN","TMGSHORT",601,0) + ;" If 1 then user is asked to supply abreviations if needed. +"RTN","TMGSHORT",602,0) + ;" If 2 then name is shortened as much as possible, but it +"RTN","TMGSHORT",603,0) + ;" might be longer than Length, it is not cut, and user is +"RTN","TMGSHORT",604,0) + ;" not asked. +"RTN","TMGSHORT",605,0) + ;" DivStr -- the divider that separates parts. Default="/" +"RTN","TMGSHORT",606,0) + ;"Result : returns shortened name, "^" for abort. +"RTN","TMGSHORT",607,0) + +"RTN","TMGSHORT",608,0) + new temp,Words,Dividers +"RTN","TMGSHORT",609,0) + set AskUser=$get(AskUser,0) +"RTN","TMGSHORT",610,0) + set DivStr=$get(DivStr,"/") +"RTN","TMGSHORT",611,0) + +"RTN","TMGSHORT",612,0) + if Name="" set temp="^" goto SNDone +"RTN","TMGSHORT",613,0) + set temp=$$Read^TMGABV(Name,Length) +"RTN","TMGSHORT",614,0) + +"RTN","TMGSHORT",615,0) + if (temp'="")&($length(temp)'>Length) goto SNDone +"RTN","TMGSHORT",616,0) + +"RTN","TMGSHORT",617,0) + ;"Note: $$ShortName does NOT check length +"RTN","TMGSHORT",618,0) + new oldTemp,done +"RTN","TMGSHORT",619,0) + set temp=Name,done=0 +"RTN","TMGSHORT",620,0) + for do quit:done!($length(temp)'>Length) +"RTN","TMGSHORT",621,0) + . set oldTemp=temp +"RTN","TMGSHORT",622,0) + . set temp=$$Short2Name(temp,DivStr,"",.Words,.Dividers,Length) +"RTN","TMGSHORT",623,0) + . if temp=oldTemp set done=1 quit +"RTN","TMGSHORT",624,0) + . if ($length(temp)'>Length) set done=1 ;"don't quit yet +"RTN","TMGSHORT",625,0) + . if (temp["...")&(AskUser=1) write !,"Remove '...' from name",! set done=0 +"RTN","TMGSHORT",626,0) + +"RTN","TMGSHORT",627,0) + if (($length(temp)>Length)&(AskUser=1)) do +"RTN","TMGSHORT",628,0) +SNm0 . new killthis set killthis=0 +"RTN","TMGSHORT",629,0) + . write "IEN 50.6=",$get(IEN50d6,"?")," IEN 50.606=",$get(IEN50d606,"?") +"RTN","TMGSHORT",630,0) + . write " Dose=",$get(Dose,"?")," IEN 50=",$get(IEN50,"?"),! +"RTN","TMGSHORT",631,0) + . write Name,! +"RTN","TMGSHORT",632,0) +SNm1 . set temp=$$Short1Name(temp,Length,DivStr,"",.Words,.Dividers) +"RTN","TMGSHORT",633,0) + . if (temp'="")&(temp'="^")&(temp'=Name) do +"RTN","TMGSHORT",634,0) + . . do Write^TMGABV(Name,temp,Length,(AskUser=1)) +"RTN","TMGSHORT",635,0) + . write ! +"RTN","TMGSHORT",636,0) + +"RTN","TMGSHORT",637,0) + if ($length(temp)>Length)&(AskUser'=2) do +"RTN","TMGSHORT",638,0) + . if ($data(Words)=0)!($data(Dividers)=0) do quit +"RTN","TMGSHORT",639,0) + . . set temp=$extract(temp,1,Length) +"RTN","TMGSHORT",640,0) + . set temp=$$CutName(.Words,.Dividers,Length) +"RTN","TMGSHORT",641,0) +SNDone +"RTN","TMGSHORT",642,0) + if $extract(temp,1)="/" set temp=$extract(temp,2,Length) +"RTN","TMGSHORT",643,0) + quit temp +"RTN","TMGSHORT",644,0) + +"RTN","TMGSHORT",645,0) + +"RTN","TMGSTUTL") +0^79^B14081 +"RTN","TMGSTUTL",1,0) +TMGSTUTL ;TMG/kst/String Utilities and Library ;03/25/06 +"RTN","TMGSTUTL",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGSTUTL",3,0) + +"RTN","TMGSTUTL",4,0) + ;"TMG STRING UTILITIES +"RTN","TMGSTUTL",5,0) + +"RTN","TMGSTUTL",6,0) + ;"======================================================================= +"RTN","TMGSTUTL",7,0) + ;" API -- Public Functions. +"RTN","TMGSTUTL",8,0) + ;"======================================================================= +"RTN","TMGSTUTL",9,0) + ;"CleaveToArray^TMGSTUTL(Text,Divider,Array) +"RTN","TMGSTUTL",10,0) + ;"CatArray(Words,i1,i2,DivChr) -- return concat array from index1 to index2 +"RTN","TMGSTUTL",11,0) + ;"CleaveStr^TMGSTUTL(Text,Divider,PartB) +"RTN","TMGSTUTL",12,0) + ;"SplitStr^TMGSTUTL(Text,Width,PartB) +"RTN","TMGSTUTL",13,0) + ;"SetStrLen^TMGSTUTL(Text,Width) +"RTN","TMGSTUTL",14,0) + ;"$$NestSplit^TMGSTUTL(Text,OpenBracket,CloseBracket,SBefore,S,SAfter) +"RTN","TMGSTUTL",15,0) + ;"$$Substitute^TMGSTUTL(S,Match,NewValue) +"RTN","TMGSTUTL",16,0) + ;"$$FormatArray^TMGSTUTL(InArray,OutArray,Divider) +"RTN","TMGSTUTL",17,0) + ;"$$Trim^TMGSTUTL(S,TrimCh) +"RTN","TMGSTUTL",18,0) + ;"$$TrimL^TMGSTUTL(S,TrimCh) +"RTN","TMGSTUTL",19,0) + ;"$$TrimR^TMGSTUTL(S,TrimCh) +"RTN","TMGSTUTL",20,0) + ;"$$NumLWS^TMGSTUTL(S) +"RTN","TMGSTUTL",21,0) + ;"$$MakeWS^TMGSTUTL(n) +"RTN","TMGSTUTL",22,0) + ;"WordWrapArray^TMGSTUTL(.Array,Width,SpecialIndent) +"RTN","TMGSTUTL",23,0) + ;"SplitLine^TMGSTUTL(s,.LineArray,Width) +"RTN","TMGSTUTL",24,0) + ;"WriteWP^TMGSTUTL(NodeRef) +"RTN","TMGSTUTL",25,0) + ;"$$LPad^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below +"RTN","TMGSTUTL",26,0) + ;"$$RPad^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below +"RTN","TMGSTUTL",27,0) + ;"$$Center^TMGSTUTL(S,width) ;"NOTE: should use XLFSTR fn below +"RTN","TMGSTUTL",28,0) + ;"$$Clip^TMGSTUTL(S,width) +"RTN","TMGSTUTL",29,0) + ;"$$STRB2H^TMGSTUTL(s,F) Convert a string to hex characters +"RTN","TMGSTUTL",30,0) + ;"$$CapWords^TMGSTUTL(S,Divider) ;"capitalize the first character of each word in a string +"RTN","TMGSTUTL",31,0) + ;"$$LinuxStr^TMGSTUTL(S) ;"Convert string to a valid linux filename +"RTN","TMGSTUTL",32,0) + ;"StrToWP^TMGSTUTL(s,pArray,width,DivCh,InitLine) ;"wrap long string into a WP array +"RTN","TMGSTUTL",33,0) + ;"$$WPToStr^TMGSTUTL(pArray,DivCh,MaxLen,InitLine) +"RTN","TMGSTUTL",34,0) + ;"Comp2Strs(s1,s2) -- compare two strings and assign an arbritrary score to their similarity +"RTN","TMGSTUTL",35,0) + ;"$$PosNum(s,[Num],LeadingSpace) -- return position of a number in a string +"RTN","TMGSTUTL",36,0) + ;"IsNumeric(s) -- deterimine if word s is a numeric +"RTN","TMGSTUTL",37,0) + ;"ScrubNumeric(s) -- remove numeric words from a sentence +"RTN","TMGSTUTL",38,0) + ;"Pos(subStr,s,count) -- return the beginning position of subStr in s +"RTN","TMGSTUTL",39,0) + ;"DiffPos(s1,s2) -- Return the position of the first difference between s1 and s2 +"RTN","TMGSTUTL",40,0) + ;"DiffWords(Words1,Words2) -- Return index of first different word between Words arrays +"RTN","TMGSTUTL",41,0) + ;"SimStr(s1,p1,s2,p2) -- return matching string in s1 and s2, starting at position p1,p2 +"RTN","TMGSTUTL",42,0) + ;"SimWord(Words1,p1,Words2,p2) -- return the matching words in both words array 1 and 2, starting +"RTN","TMGSTUTL",43,0) + ;" at word positions p1 and p2. +"RTN","TMGSTUTL",44,0) + ;"SimPos(s1,s2) -- return the first position that two strings are similar. +"RTN","TMGSTUTL",45,0) + ;"SimWPos(Words1,Words2,DivStr,p1,p2,MatchStr) -- return the first position that two word arrays +"RTN","TMGSTUTL",46,0) + ;" are similar. This means the first index in Words array 1 that matches to words in Words array 2. +"RTN","TMGSTUTL",47,0) + ;"DiffStr(s1,s2,DivChr) -- Return how s1 differs from s2. +"RTN","TMGSTUTL",48,0) + ;"CatArray(Words,i1,i2,DivChr) -- return concat array from index1 to index2 +"RTN","TMGSTUTL",49,0) + ;"$$QtProtect(s) -- Protects quotes by converting all quotes do double quotes (" --> "") +"RTN","TMGSTUTL",50,0) + +"RTN","TMGSTUTL",51,0) + +"RTN","TMGSTUTL",52,0) + ;"======================================================================= +"RTN","TMGSTUTL",53,0) + ;"Dependancies +"RTN","TMGSTUTL",54,0) + ;" uses TMGDEBUG for debug messaging. +"RTN","TMGSTUTL",55,0) + ;"======================================================================= +"RTN","TMGSTUTL",56,0) + ;"======================================================================= +"RTN","TMGSTUTL",57,0) + +"RTN","TMGSTUTL",58,0) + ;"------------------------------------------------------------------------ +"RTN","TMGSTUTL",59,0) + ;"FYI, String functions in XLFSTR module: +"RTN","TMGSTUTL",60,0) + ;"------------------------------------------------------------------------ +"RTN","TMGSTUTL",61,0) + ;"$$CJ^XLFSTR(s,i[,p]) -- Returns a center-justified string +"RTN","TMGSTUTL",62,0) + ;" s=string, i=field size, p(optional)=pad character +"RTN","TMGSTUTL",63,0) + ;"$$LJ^XLFSTR(s,i[,p]) -- Returns a left-justified string +"RTN","TMGSTUTL",64,0) + ;" s=string, i=field size, p(optional)=pad character +"RTN","TMGSTUTL",65,0) + ;"$$RJ^XLFSTR(s,i[,p]) -- Returns a right-justified string +"RTN","TMGSTUTL",66,0) + ;" s=string, i=field size, p(optional)=pad character +"RTN","TMGSTUTL",67,0) + ;"$$INVERT^XLFSTR(s) -- returns an inverted string (i.e. "ABC"-->"CBA") +"RTN","TMGSTUTL",68,0) + ;"$$LOW^XLFSTR(s) -- returns string with all letters converted to lower-case +"RTN","TMGSTUTL",69,0) + ;"$$UP^XLFSTR(s) -- returns string with all letters converted to upper-case +"RTN","TMGSTUTL",70,0) + ;"$$REPEAT^XLFSTR(s,Count) -- returns a string that is a repeat of s Count times +"RTN","TMGSTUTL",71,0) + ;"$$REPLACE^XLFSTR(s,.spec) -- Uses a multi-character $TRanslate to return a +"RTN","TMGSTUTL",72,0) + ;" string with the specified string replaced +"RTN","TMGSTUTL",73,0) + ;" s=input string, spec=array passed by reference +"RTN","TMGSTUTL",74,0) + ;" spec format: +"RTN","TMGSTUTL",75,0) + ;" spec("Any_Search_String")="Replacement_String" +"RTN","TMGSTUTL",76,0) + ;"$$STRIP^XLFSTR(s,Char) -- returns string striped of all instances of Char +"RTN","TMGSTUTL",77,0) + +"RTN","TMGSTUTL",78,0) + ;"======================================================================= +"RTN","TMGSTUTL",79,0) + +"RTN","TMGSTUTL",80,0) +CleaveToArray(Text,Divider,Array,InitIndex) +"RTN","TMGSTUTL",81,0) + ;"Purpose: To take a string, delineated by 'divider' and +"RTN","TMGSTUTL",82,0) + ;" to split it up into all its parts, putting each part +"RTN","TMGSTUTL",83,0) + ;" into an array. e.g.: +"RTN","TMGSTUTL",84,0) + ;" This/Is/A/Test, with '/' divider would result in +"RTN","TMGSTUTL",85,0) + ;" Array(1)="This" +"RTN","TMGSTUTL",86,0) + ;" Array(2)="Is" +"RTN","TMGSTUTL",87,0) + ;" Array(3)="A" +"RTN","TMGSTUTL",88,0) + ;" Array(4)="Test" +"RTN","TMGSTUTL",89,0) + ;" Array(cMaxNode)=4 ;cMaxNode="MAXNODE" +"RTN","TMGSTUTL",90,0) + ;"Input: Text - the input string -- should NOT be passed by reference. +"RTN","TMGSTUTL",91,0) + ;" Divider - the delineating string +"RTN","TMGSTUTL",92,0) + ;" Array - The array to receive output **SHOULD BE PASSED BY REFERENCE. +"RTN","TMGSTUTL",93,0) + ;" InitIndex - OPTIONAL -- The index of the array to start with, i.e. 0 or 1. Default=1 +"RTN","TMGSTUTL",94,0) + ;"Output: Array is changed, as outlined above +"RTN","TMGSTUTL",95,0) + ;"Result: none +"RTN","TMGSTUTL",96,0) + ;"Notes: Note -- Text is NOT changed (unless passed by reference, in +"RTN","TMGSTUTL",97,0) + ;" which case the next to the last piece is put into Text) +"RTN","TMGSTUTL",98,0) + ;" Array is killed, the filled with data **ONLY** IF DIVISIONS FOUND +"RTN","TMGSTUTL",99,0) + ;" Limit of 256 nodes +"RTN","TMGSTUTL",100,0) + ;" if cMaxNode is not defined, "MAXNODE" will be used +"RTN","TMGSTUTL",101,0) + +"RTN","TMGSTUTL",102,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGSTUTL",103,0) + do DebugEntry^TMGDEBUG(.DBIndent,"CleaveToArray") +"RTN","TMGSTUTL",104,0) + +"RTN","TMGSTUTL",105,0) + set InitIndex=$get(InitIndex,1) +"RTN","TMGSTUTL",106,0) + new PartB +"RTN","TMGSTUTL",107,0) + new count set count=InitIndex +"RTN","TMGSTUTL",108,0) + set cMaxNode=$get(cMaxNode,"MAXNODE") +"RTN","TMGSTUTL",109,0) + +"RTN","TMGSTUTL",110,0) + kill Array ;"Clear out any old data +"RTN","TMGSTUTL",111,0) + +"RTN","TMGSTUTL",112,0) +C2ArLoop +"RTN","TMGSTUTL",113,0) + if '(Text[Divider) do goto C2ArDone +"RTN","TMGSTUTL",114,0) + . set Array(count)=Text ;"put it all into first line. +"RTN","TMGSTUTL",115,0) + . set Array(cMaxNode)=1 +"RTN","TMGSTUTL",116,0) + do CleaveStr(.Text,Divider,.PartB) +"RTN","TMGSTUTL",117,0) + set Array(count)=Text +"RTN","TMGSTUTL",118,0) + set Array(cMaxNode)=count +"RTN","TMGSTUTL",119,0) + set count=count+1 +"RTN","TMGSTUTL",120,0) + if '(PartB[Divider) do goto C2ArDone +"RTN","TMGSTUTL",121,0) + . set Array(count)=PartB +"RTN","TMGSTUTL",122,0) + . set Array(cMaxNode)=count +"RTN","TMGSTUTL",123,0) + else do goto C2ArLoop +"RTN","TMGSTUTL",124,0) + . set Text=$get(PartB) +"RTN","TMGSTUTL",125,0) + . set PartB="" +"RTN","TMGSTUTL",126,0) + +"RTN","TMGSTUTL",127,0) +C2ArDone +"RTN","TMGSTUTL",128,0) + do DebugExit^TMGDEBUG(.DBIndent,"CleaveToArray") +"RTN","TMGSTUTL",129,0) + quit +"RTN","TMGSTUTL",130,0) + +"RTN","TMGSTUTL",131,0) + +"RTN","TMGSTUTL",132,0) +CleaveStr(Text,Divider,PartB) +"RTN","TMGSTUTL",133,0) + ;"Purpse: To take a string, delineated by 'Divider' +"RTN","TMGSTUTL",134,0) + ;" and to split it into two parts: Text and PartB +"RTN","TMGSTUTL",135,0) + ;" e.g. Text="Hello\nThere" +"RTN","TMGSTUTL",136,0) + ;" Divider="\n" +"RTN","TMGSTUTL",137,0) + ;" Function will result in: Text="Hello", PartB="There" +"RTN","TMGSTUTL",138,0) + ;"Input: Text - the input string **SHOULD BE PASSED BY REFERENCE. +"RTN","TMGSTUTL",139,0) + ;" Divider - the delineating string +"RTN","TMGSTUTL",140,0) + ;" PartB - the string to get second part **SHOULD BE PASSED BY REFERENCE. +"RTN","TMGSTUTL",141,0) + ;"Output: Text and PartB will be changed +"RTN","TMGSTUTL",142,0) + ;" Function will result in: Text="Hello", PartB="There" +"RTN","TMGSTUTL",143,0) + ;"Result: none +"RTN","TMGSTUTL",144,0) + +"RTN","TMGSTUTL",145,0) + set DBIndent=$get(DBIndent,0) +"RTN","TMGSTUTL",146,0) + do DebugEntry^TMGDEBUG(.DBIndent,"CleaveStr") +"RTN","TMGSTUTL",147,0) + +"RTN","TMGSTUTL",148,0) + do DebugMsg^TMGDEBUG(DBIndent,"Text=",Text) +"RTN","TMGSTUTL",149,0) + +"RTN","TMGSTUTL",150,0) + if '$data(Text) goto CSDone +"RTN","TMGSTUTL",151,0) + if '$Data(Divider) goto CSDone +"RTN","TMGSTUTL",152,0) + set PartB="" +"RTN","TMGSTUTL",153,0) + +"RTN","TMGSTUTL",154,0) + new PartA +"RTN","TMGSTUTL",155,0) + +"RTN","TMGSTUTL",156,0) + if Text[Divider do +"RTN","TMGSTUTL",157,0) + . set PartA=$piece(Text,Divider,1) +"RTN","TMGSTUTL",158,0) + . set PartB=$piece(Text,Divider,2,256) +"RTN","TMGSTUTL",159,0) + . set Text=PartA +"RTN","TMGSTUTL",160,0) + +"RTN","TMGSTUTL",161,0) + do DebugMsg^TMGDEBUG(DBIndent,"After Processing, Text='",Text,"', and PartB='",PartB,"'") +"RTN","TMGSTUTL",162,0) +CSDone +"RTN","TMGSTUTL",163,0) + do DebugExit^TMGDEBUG(.DBIndent,"CleaveStr") +"RTN","TMGSTUTL",164,0) + quit +"RTN","TMGSTUTL",165,0) + +"RTN","TMGSTUTL",166,0) + +"RTN","TMGSTUTL",167,0) +SplitStr(Text,Width,PartB) +"RTN","TMGSTUTL",168,0) + ;"PUBLIC FUNCTION +"RTN","TMGSTUTL",169,0) + ;"Purpose: To a string into two parts. The first part will fit within 'Width' +"RTN","TMGSTUTL",170,0) + ;" the second part is what is left over +"RTN","TMGSTUTL",171,0) + ;" The split will be inteligent, so words are not divided (splits at a space) +"RTN","TMGSTUTL",172,0) + ;"Input: Text = input text. **Should be passed by reference +"RTN","TMGSTUTL",173,0) + ;" Width = the constraining width +"RTN","TMGSTUTL",174,0) + ;" PartB = the left over part. **Should be passed by reference +"RTN","TMGSTUTL",175,0) + ;"output: Text and PartB are modified +"RTN","TMGSTUTL",176,0) + ;"result: none. +"RTN","TMGSTUTL",177,0) + +"RTN","TMGSTUTL",178,0) + new Len +"RTN","TMGSTUTL",179,0) + set Width=$get(Width,80) +"RTN","TMGSTUTL",180,0) + new SpaceFound set SpaceFound=0 +"RTN","TMGSTUTL",181,0) + new SplitPoint set SplitPoint=Width +"RTN","TMGSTUTL",182,0) + set Text=$get(Text) +"RTN","TMGSTUTL",183,0) + set PartB="" +"RTN","TMGSTUTL",184,0) + +"RTN","TMGSTUTL",185,0) + set Len=$length(Text) +"RTN","TMGSTUTL",186,0) + if Len>Width do +"RTN","TMGSTUTL",187,0) + . new Ch +"RTN","TMGSTUTL",188,0) + . for SplitPoint=SplitPoint:-1:1 do quit:SpaceFound +"RTN","TMGSTUTL",189,0) + . . set Ch=$extract(Text,SplitPoint,SplitPoint) +"RTN","TMGSTUTL",190,0) + . . set SpaceFound=(Ch=" ") +"RTN","TMGSTUTL",191,0) + . if 'SpaceFound set SplitPoint=Width +"RTN","TMGSTUTL",192,0) + . set s1=$extract(Text,1,SplitPoint) +"RTN","TMGSTUTL",193,0) + . set PartB=$extract(Text,SplitPoint+1,1024) ;"max String length=1024 +"RTN","TMGSTUTL",194,0) + . set Text=s1 +"RTN","TMGSTUTL",195,0) + else do +"RTN","TMGSTUTL",196,0) + +"RTN","TMGSTUTL",197,0) + quit +"RTN","TMGSTUTL",198,0) + +"RTN","TMGSTUTL",199,0) + +"RTN","TMGSTUTL",200,0) + +"RTN","TMGSTUTL",201,0) +SetStrLen(Text,Width) +"RTN","TMGSTUTL",202,0) + ;"PUBLIC FUNCTION +"RTN","TMGSTUTL",203,0) + ;"Purpose: To make string exactly Width in length +"RTN","TMGSTUTL",204,0) + ;" Shorten as needed, or pad with terminal spaces as needed. +"RTN","TMGSTUTL",205,0) + ;"Input: Text -- should be passed as reference. This is string to alter. +"RTN","TMGSTUTL",206,0) + ;" Width -- the desired width +"RTN","TMGSTUTL",207,0) + ;"Results: none. +"RTN","TMGSTUTL",208,0) + +"RTN","TMGSTUTL",209,0) + set Text=$get(Text) +"RTN","TMGSTUTL",210,0) + set Width=$get(Width,80) +"RTN","TMGSTUTL",211,0) + new result set result=Text +"RTN","TMGSTUTL",212,0) + new i,Len +"RTN","TMGSTUTL",213,0) + +"RTN","TMGSTUTL",214,0) + set Len=$length(result) +"RTN","TMGSTUTL",215,0) + if Len>Width do +"RTN","TMGSTUTL",216,0) + . set result=$extract(result,1,Width) +"RTN","TMGSTUTL",217,0) + else if Len "ABC$$$DEF" +"RTN","TMGSTUTL",304,0) + ;" Substitute("ABC###DEF","###","$") --> "ABC$DEF" +"RTN","TMGSTUTL",305,0) + ;"Result: returns altered string (if any alterations indicated) +"RTN","TMGSTUTL",306,0) + ;"Output: S is altered, if passed by reference. +"RTN","TMGSTUTL",307,0) + +"RTN","TMGSTUTL",308,0) + ;"!!BUG NOTICE: +"RTN","TMGSTUTL",309,0) + ;" w $$Substitute("a b c "," ","\ ") --> endless loop and stack overflow +"RTN","TMGSTUTL",310,0) + ;"Note: Fixed by just using REPLACE^XLFSTR +"RTN","TMGSTUTL",311,0) + +"RTN","TMGSTUTL",312,0) + ;"do DebugEntry^TMGDEBUG(.DBIndent,"Substitute") +"RTN","TMGSTUTL",313,0) + +"RTN","TMGSTUTL",314,0) + new spec +"RTN","TMGSTUTL",315,0) + set spec($get(Match))=$get(NewValue) +"RTN","TMGSTUTL",316,0) + set S=$$REPLACE^XLFSTR(S,.spec) +"RTN","TMGSTUTL",317,0) + goto SbstDone +"RTN","TMGSTUTL",318,0) + +"RTN","TMGSTUTL",319,0) + ;"Code below not used. Delete later... +"RTN","TMGSTUTL",320,0) +SbstLoop +"RTN","TMGSTUTL",321,0) + if $data(S)#10=0 goto SbstDone +"RTN","TMGSTUTL",322,0) + do DebugMsg^TMGDEBUG(.DBIndent,S,"[",.Match,"=",S[Match) +"RTN","TMGSTUTL",323,0) + if '(S[Match) goto SbstDone +"RTN","TMGSTUTL",324,0) + new PartA,PartB +"RTN","TMGSTUTL",325,0) + set PartA=$piece(S,Match,1) +"RTN","TMGSTUTL",326,0) + set PartB=$piece(S,Match,2,999) +"RTN","TMGSTUTL",327,0) + set S=PartA_NewValue_PartB +"RTN","TMGSTUTL",328,0) + goto SbstLoop +"RTN","TMGSTUTL",329,0) + ;"End of part not used... +"RTN","TMGSTUTL",330,0) + +"RTN","TMGSTUTL",331,0) +SbstDone +"RTN","TMGSTUTL",332,0) + ;"do DebugExit^TMGDEBUG(.DBIndent,"Substitute") +"RTN","TMGSTUTL",333,0) + quit S +"RTN","TMGSTUTL",334,0) + +"RTN","TMGSTUTL",335,0) + +"RTN","TMGSTUTL",336,0) + +"RTN","TMGSTUTL",337,0) +FormatArray(InArray,OutArray,Divider) +"RTN","TMGSTUTL",338,0) + ;"PUBLIC FUNCTION +"RTN","TMGSTUTL",339,0) + ;"Purpose: The XML parser does not recognize whitespace, or end-of-line +"RTN","TMGSTUTL",340,0) + ;" characters. Thus many lines get lumped together. However, if there +"RTN","TMGSTUTL",341,0) + ;" is a significant amount of text, then the parser will put the text into +"RTN","TMGSTUTL",342,0) + ;" several lines (when get attrib text called etc.) +"RTN","TMGSTUTL",343,0) + ;" SO, this function is to take an array composed of input lines (each +"RTN","TMGSTUTL",344,0) + ;" with multiple sublines clumped together), and format it such that each +"RTN","TMGSTUTL",345,0) + ;" line is separated in the array. +"RTN","TMGSTUTL",346,0) + ;" e.g. Take this input array" +"RTN","TMGSTUTL",347,0) + ;" InArray(cText,1)="line one\nline two\nline three\n +"RTN","TMGSTUTL",348,0) + ;" InArray(cText,2)="line four\nline five\nline six\n +"RTN","TMGSTUTL",349,0) + ;" and convert to: +"RTN","TMGSTUTL",350,0) + ;" OutArray(1)="line one" +"RTN","TMGSTUTL",351,0) + ;" OutArray(2)="line two" +"RTN","TMGSTUTL",352,0) + ;" OutArray(3)="line three" +"RTN","TMGSTUTL",353,0) + ;" OutArray(4)="line four" +"RTN","TMGSTUTL",354,0) + ;" OutArray(5)="line five" +"RTN","TMGSTUTL",355,0) + ;" OutArray(6)="line six" +"RTN","TMGSTUTL",356,0) + ;"Input: InArray, best if passed by reference (faster) -- see example above +"RTN","TMGSTUTL",357,0) + ;" Note: expected to be in format: InArray(cText,n) +"RTN","TMGSTUTL",358,0) + ;" OutArray, must be passed by reference-- see example above +"RTN","TMGSTUTL",359,0) + ;" Divider: the character(s) that divides lines ("\n" in this example) +"RTN","TMGSTUTL",360,0) + ;"Note: It is expected that InArray will be index by integers (i.e. 1, 2, 3) +"RTN","TMGSTUTL",361,0) + ;" And this should be the case, as that is how XML functions pass back. +"RTN","TMGSTUTL",362,0) + ;" Limit of 256 separate lines on any one InArray line +"RTN","TMGSTUTL",363,0) + ;"Output: OutArray is set, any prior data is killed +"RTN","TMGSTUTL",364,0) + ;"result: 1=OK to continue, 0=abort +"RTN","TMGSTUTL",365,0) + +"RTN","TMGSTUTL",366,0) + set DEBUG=$get(DEBUG,0) +"RTN","TMGSTUTL",367,0) + set cOKToCont=$get(cOKToCont,1) +"RTN","TMGSTUTL",368,0) + set cAbort=$get(cAbort,0) +"RTN","TMGSTUTL",369,0) + +"RTN","TMGSTUTL",370,0) + if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"FormatArray") +"RTN","TMGSTUTL",371,0) + +"RTN","TMGSTUTL",372,0) + new result set result=cOKToCont +"RTN","TMGSTUTL",373,0) + new InIndex +"RTN","TMGSTUTL",374,0) + new OutIndex set OutIndex=1 +"RTN","TMGSTUTL",375,0) + new TempArray +"RTN","TMGSTUTL",376,0) + new Done +"RTN","TMGSTUTL",377,0) + +"RTN","TMGSTUTL",378,0) + kill OutArray ;"remove any prior data +"RTN","TMGSTUTL",379,0) + +"RTN","TMGSTUTL",380,0) + if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Input array:") +"RTN","TMGSTUTL",381,0) + if DEBUG do ArrayDump^TMGDEBUG("InArray") +"RTN","TMGSTUTL",382,0) + +"RTN","TMGSTUTL",383,0) + if $data(Divider)=0 do goto FADone +"RTN","TMGSTUTL",384,0) + . set result=cAbort +"RTN","TMGSTUTL",385,0) + +"RTN","TMGSTUTL",386,0) + set Done=0 +"RTN","TMGSTUTL",387,0) + for InIndex=1:1 do quit:Done +"RTN","TMGSTUTL",388,0) + . if $data(InArray(cText,InIndex))=0 set Done=1 quit +"RTN","TMGSTUTL",389,0) + . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Converting line: ",InArray(cText,InIndex)) +"RTN","TMGSTUTL",390,0) + . do CleaveToArray^TMGSTUTL(InArray(cText,InIndex),Divider,.TempArray,OutIndex) +"RTN","TMGSTUTL",391,0) + . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Resulting temp array:") +"RTN","TMGSTUTL",392,0) + . if DEBUG do ArrayDump^TMGDEBUG("TempArray") +"RTN","TMGSTUTL",393,0) + . set OutIndex=TempArray(cMaxNode)+1 +"RTN","TMGSTUTL",394,0) + . kill TempArray(cMaxNode) +"RTN","TMGSTUTL",395,0) + . merge OutArray=TempArray +"RTN","TMGSTUTL",396,0) + . if DEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"OutArray so far:") +"RTN","TMGSTUTL",397,0) + . if DEBUG do ArrayDump^TMGDEBUG("OutArray") +"RTN","TMGSTUTL",398,0) + +"RTN","TMGSTUTL",399,0) +FADone +"RTN","TMGSTUTL",400,0) + if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"FormatArray") +"RTN","TMGSTUTL",401,0) + quit result +"RTN","TMGSTUTL",402,0) + +"RTN","TMGSTUTL",403,0) + +"RTN","TMGSTUTL",404,0) + +"RTN","TMGSTUTL",405,0) +TrimL(S,TrimCh) +"RTN","TMGSTUTL",406,0) + ;"Purpose: To a trip a string of leading white space +"RTN","TMGSTUTL",407,0) + ;" i.e. convert " hello" into "hello" +"RTN","TMGSTUTL",408,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGSTUTL",409,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGSTUTL",410,0) + ;"Results: returns modified string +"RTN","TMGSTUTL",411,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGSTUTL",412,0) + +"RTN","TMGSTUTL",413,0) + set DEBUG=$get(DEBUG,0) +"RTN","TMGSTUTL",414,0) + set cOKToCont=$get(cOKToCont,1) +"RTN","TMGSTUTL",415,0) + set cAbort=$get(cAbort,0) +"RTN","TMGSTUTL",416,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGSTUTL",417,0) + +"RTN","TMGSTUTL",418,0) + new result set result=$get(S) +"RTN","TMGSTUTL",419,0) + new Ch set Ch="" +"RTN","TMGSTUTL",420,0) + +"RTN","TMGSTUTL",421,0) + for do quit:(Ch'=TrimCh) +"RTN","TMGSTUTL",422,0) + . set Ch=$extract(result,1,1) +"RTN","TMGSTUTL",423,0) + . if Ch=TrimCh set result=$extract(result,2,1024) +"RTN","TMGSTUTL",424,0) + +"RTN","TMGSTUTL",425,0) + quit result +"RTN","TMGSTUTL",426,0) + +"RTN","TMGSTUTL",427,0) + +"RTN","TMGSTUTL",428,0) +TrimR(S,TrimCh) +"RTN","TMGSTUTL",429,0) + ;"Purpose: To a trip a string of trailing white space +"RTN","TMGSTUTL",430,0) + ;" i.e. convert "hello " into "hello" +"RTN","TMGSTUTL",431,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGSTUTL",432,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGSTUTL",433,0) + ;"Results: returns modified string +"RTN","TMGSTUTL",434,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGSTUTL",435,0) + +"RTN","TMGSTUTL",436,0) + set DEBUG=$get(DEBUG,0) +"RTN","TMGSTUTL",437,0) + set cOKToCont=$get(cOKToCont,1) +"RTN","TMGSTUTL",438,0) + set cAbort=$get(cAbort,0) +"RTN","TMGSTUTL",439,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGSTUTL",440,0) + +"RTN","TMGSTUTL",441,0) + if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"TrimR") +"RTN","TMGSTUTL",442,0) + +"RTN","TMGSTUTL",443,0) + new result set result=$get(S) +"RTN","TMGSTUTL",444,0) + new Ch set Ch="" +"RTN","TMGSTUTL",445,0) + new L +"RTN","TMGSTUTL",446,0) + +"RTN","TMGSTUTL",447,0) + for do quit:(Ch'=TrimCh) +"RTN","TMGSTUTL",448,0) + . set L=$length(result) +"RTN","TMGSTUTL",449,0) + . set Ch=$extract(result,L,L) +"RTN","TMGSTUTL",450,0) + . if Ch=TrimCh do +"RTN","TMGSTUTL",451,0) + . . set result=$extract(result,1,L-1) +"RTN","TMGSTUTL",452,0) + +"RTN","TMGSTUTL",453,0) + if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"TrimR") +"RTN","TMGSTUTL",454,0) + quit result +"RTN","TMGSTUTL",455,0) + +"RTN","TMGSTUTL",456,0) +Trim(S,TrimCh) +"RTN","TMGSTUTL",457,0) + ;"Purpose: To a trip a string of leading and trailing white space +"RTN","TMGSTUTL",458,0) + ;" i.e. convert " hello " into "hello" +"RTN","TMGSTUTL",459,0) + ;"Input: S -- the string to convert. Won't be changed if passed by reference +"RTN","TMGSTUTL",460,0) + ;" TrimCh -- OPTIONAL: Charachter to trim. Default is " " +"RTN","TMGSTUTL",461,0) + ;"Results: returns modified string +"RTN","TMGSTUTL",462,0) + ;"Note: processing limitation is string length=1024 +"RTN","TMGSTUTL",463,0) + +"RTN","TMGSTUTL",464,0) + ;"NOTE: this function could be replaced with $$TRIM^XLFSTR +"RTN","TMGSTUTL",465,0) + +"RTN","TMGSTUTL",466,0) + set DEBUG=$get(DEBUG,0) +"RTN","TMGSTUTL",467,0) + set cOKToCont=$get(cOKToCont,1) +"RTN","TMGSTUTL",468,0) + set cAbort=$get(cAbort,0) +"RTN","TMGSTUTL",469,0) + set TrimCh=$get(TrimCh," ") +"RTN","TMGSTUTL",470,0) + +"RTN","TMGSTUTL",471,0) + if DEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"Trim") +"RTN","TMGSTUTL",472,0) + +"RTN","TMGSTUTL",473,0) + new result set result=$get(S) +"RTN","TMGSTUTL",474,0) + set result=$$TrimL(.result,TrimCh) +"RTN","TMGSTUTL",475,0) + set result=$$TrimR(.result,TrimCh) +"RTN","TMGSTUTL",476,0) + +"RTN","TMGSTUTL",477,0) + if DEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"Trim") +"RTN","TMGSTUTL",478,0) + quit result +"RTN","TMGSTUTL",479,0) + +"RTN","TMGSTUTL",480,0) + +"RTN","TMGSTUTL",481,0) +NumLWS(S) +"RTN","TMGSTUTL",482,0) + ;"Scopt: PUBLIC FUNCTION +"RTN","TMGSTUTL",483,0) + ;":Purpose: To count the number of white space characters on the left +"RTN","TMGSTUTL",484,0) + ;" side of the string +"RTN","TMGSTUTL",485,0) + +"RTN","TMGSTUTL",486,0) + new result set result=0 +"RTN","TMGSTUTL",487,0) + new i,ch +"RTN","TMGSTUTL",488,0) + set S=$get(S) +"RTN","TMGSTUTL",489,0) + +"RTN","TMGSTUTL",490,0) + for i=1:1:$length(S) do quit:(ch'=" ") +"RTN","TMGSTUTL",491,0) + . set ch=$extract(S,i,i) +"RTN","TMGSTUTL",492,0) + . if ch=" " set result=result+1 +"RTN","TMGSTUTL",493,0) + +"RTN","TMGSTUTL",494,0) + quit result +"RTN","TMGSTUTL",495,0) + +"RTN","TMGSTUTL",496,0) + +"RTN","TMGSTUTL",497,0) +MakeWS(n) +"RTN","TMGSTUTL",498,0) + ;"Scope: PUBLIC FUNCTION +"RTN","TMGSTUTL",499,0) + ;"Purpose: Return a whitespace string that is n characters long +"RTN","TMGSTUTL",500,0) + +"RTN","TMGSTUTL",501,0) + new result set result="" +"RTN","TMGSTUTL",502,0) + set n=$get(n,0) +"RTN","TMGSTUTL",503,0) + if n'>0 goto MWSDone +"RTN","TMGSTUTL",504,0) + +"RTN","TMGSTUTL",505,0) + new i +"RTN","TMGSTUTL",506,0) + for i=1:1:n set result=result_" " +"RTN","TMGSTUTL",507,0) + +"RTN","TMGSTUTL",508,0) +MWSDone +"RTN","TMGSTUTL",509,0) + quit result +"RTN","TMGSTUTL",510,0) + +"RTN","TMGSTUTL",511,0) + +"RTN","TMGSTUTL",512,0) +WordWrapArray(Array,Width,SpecialIndent) +"RTN","TMGSTUTL",513,0) + ;"Scope: PUBLIC FUNCTION +"RTN","TMGSTUTL",514,0) + ;"Purpose: To take an array and perform word wrapping such that +"RTN","TMGSTUTL",515,0) + ;" no line is longer than Width. +"RTN","TMGSTUTL",516,0) + ;" This function is really designed for reformatting a Fileman WP field +"RTN","TMGSTUTL",517,0) + ;"Input: Array MUST BE PASSED BY REFERENCE. This contains the array +"RTN","TMGSTUTL",518,0) + ;" to be reformatted. Changes will be made to this array. +"RTN","TMGSTUTL",519,0) + ;" It is expected that Array will be in this format: +"RTN","TMGSTUTL",520,0) + ;" Array(1)="Some text on the first line." +"RTN","TMGSTUTL",521,0) + ;" Array(2)="Some text on the second line." +"RTN","TMGSTUTL",522,0) + ;" Array(3)="Some text on the third line." +"RTN","TMGSTUTL",523,0) + ;" Array(4)="Some text on the fourth line." +"RTN","TMGSTUTL",524,0) + ;" or +"RTN","TMGSTUTL",525,0) + ;" Array(1,0)="Some text on the first line." +"RTN","TMGSTUTL",526,0) + ;" Array(2,0)="Some text on the second line." +"RTN","TMGSTUTL",527,0) + ;" Array(3,0)="Some text on the third line." +"RTN","TMGSTUTL",528,0) + ;" Array(4,0)="Some text on the fourth line." +"RTN","TMGSTUTL",529,0) + ;" Width -- the limit on the length of any line. Default value=70 +"RTN","TMGSTUTL",530,0) + ;" SpecialIndent : if 1, then wrapping is done like this: +"RTN","TMGSTUTL",531,0) + ;" " This is a very long line......" +"RTN","TMGSTUTL",532,0) + ;" will be wrapped like this: +"RTN","TMGSTUTL",533,0) + ;" " This is a very +"RTN","TMGSTUTL",534,0) + ;" " long line ... +"RTN","TMGSTUTL",535,0) + ;" Notice that the leading space is copied subsequent line. +"RTN","TMGSTUTL",536,0) + ;" Also, a line like this: +"RTN","TMGSTUTL",537,0) + ;" " 1. Here is the beginning of a paragraph that is very long..." +"RTN","TMGSTUTL",538,0) + ;" will be wrapped like this: +"RTN","TMGSTUTL",539,0) + ;" " 1. Here is the beginning of a paragraph +"RTN","TMGSTUTL",540,0) + ;" " that is very long..." +"RTN","TMGSTUTL",541,0) + ;" Notice that a pattern '#. ' causes the wrapping to match the start of +"RTN","TMGSTUTL",542,0) + ;" of the text on the line above. +"RTN","TMGSTUTL",543,0) + ;" The exact rules for matching this are as follows: +"RTN","TMGSTUTL",544,0) + ;" (FirstWord?.N1".")!(FirstWord?1.3E1".") +"RTN","TMGSTUTL",545,0) + ;" i.e. any number of digits, followed by "." +"RTN","TMGSTUTL",546,0) + ;" OR 1-4 all upper-case characters followed by a "." +"RTN","TMGSTUTL",547,0) + ;" This will allow "VIII. " pattern but not "viii. " +"RTN","TMGSTUTL",548,0) + ;" HOWEVER, might get confused with a word, like "NOTE. " +"RTN","TMGSTUTL",549,0) + ;" +"RTN","TMGSTUTL",550,0) + ;" This, below, is not dependant on SpecialIndent setting +"RTN","TMGSTUTL",551,0) + ;" Also, because some of the lines have already partly wrapped, like this: +"RTN","TMGSTUTL",552,0) + ;" " 1. Here is the beginning of a paragraph that is very long..." +"RTN","TMGSTUTL",553,0) + ;" "and this is a line that has already wrapped. +"RTN","TMGSTUTL",554,0) + ;" So when the first line is wrapped, it would look like this: +"RTN","TMGSTUTL",555,0) + ;" " 1. Here is the beginning of a paragraph +"RTN","TMGSTUTL",556,0) + ;" " that is very long..." +"RTN","TMGSTUTL",557,0) + ;" "and this is a line that has already wrapped. +"RTN","TMGSTUTL",558,0) + ;" But is should look like this: +"RTN","TMGSTUTL",559,0) + ;" " 1. Here is the beginning of a paragraph +"RTN","TMGSTUTL",560,0) + ;" " that is very long...and this is a line +"RTN","TMGSTUTL",561,0) + ;" " that has already wrapped. +"RTN","TMGSTUTL",562,0) + ;" But the next line SHOULD NOT be pulled up if it is the start +"RTN","TMGSTUTL",563,0) + ;" of a new paragraph. I will tell by looking for #. paattern. +"RTN","TMGSTUTL",564,0) + +"RTN","TMGSTUTL",565,0) + +"RTN","TMGSTUTL",566,0) + ;"Result -- none +"RTN","TMGSTUTL",567,0) + +"RTN","TMGSTUTL",568,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"WordWrapArray^TMGSTUTL") +"RTN","TMGSTUTL",569,0) + new tempArray set tempArray="" ;"holds result during work. +"RTN","TMGSTUTL",570,0) + new tindex set tindex=0 +"RTN","TMGSTUTL",571,0) + new index +"RTN","TMGSTUTL",572,0) + set index=$order(Array("")) +"RTN","TMGSTUTL",573,0) + new s +"RTN","TMGSTUTL",574,0) + new residualS set residualS="" +"RTN","TMGSTUTL",575,0) + new AddZero set AddZero=0 +"RTN","TMGSTUTL",576,0) + set Width=$get(Width,70) +"RTN","TMGSTUTL",577,0) + +"RTN","TMGSTUTL",578,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Starting loop") +"RTN","TMGSTUTL",579,0) + +"RTN","TMGSTUTL",580,0) + if index'="" for do quit:((index="")&(residualS="")) +"RTN","TMGSTUTL",581,0) + . set s=$get(Array(index)) +"RTN","TMGSTUTL",582,0) + . if s="" do +"RTN","TMGSTUTL",583,0) + . . set s=$get(Array(index,0)) +"RTN","TMGSTUTL",584,0) + . . set AddZero=1 +"RTN","TMGSTUTL",585,0) + . if residualS'="" do ;"See if should join to next line. Don't if '#. ' pattern +"RTN","TMGSTUTL",586,0) + . . new FirstWord set FirstWord=$piece($$Trim(s)," ",1) +"RTN","TMGSTUTL",587,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"First Word: ",FirstWord) +"RTN","TMGSTUTL",588,0) + . . if (FirstWord?.N1".")!(FirstWord?1.4U1".") do ;"match for '#.' pattern +"RTN","TMGSTUTL",589,0) + . . . ;"Here we have the next line is a new paragraph, so don't link to residualS +"RTN","TMGSTUTL",590,0) + . . . set tindex=tindex+1 +"RTN","TMGSTUTL",591,0) + . . . if AddZero=0 set tempArray(tindex)=residualS +"RTN","TMGSTUTL",592,0) + . . . else set tempArray(tindex,0)=residualS +"RTN","TMGSTUTL",593,0) + . . . set residualS="" +"RTN","TMGSTUTL",594,0) + . if $length(residualS)+$length(s)'<256 do +"RTN","TMGSTUTL",595,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"ERROR -- string too long.") +"RTN","TMGSTUTL",596,0) + . set s=residualS_s +"RTN","TMGSTUTL",597,0) + . set residualS="" +"RTN","TMGSTUTL",598,0) + . if $length(s)>Width do +"RTN","TMGSTUTL",599,0) + . . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Long line: ",s) +"RTN","TMGSTUTL",600,0) + . . new LineArray +"RTN","TMGSTUTL",601,0) + . . new NumLines +"RTN","TMGSTUTL",602,0) + . . set NumLines=$$SplitLine(.s,.LineArray,Width,.SpecialIndent) +"RTN","TMGSTUTL",603,0) + . . if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("LineArray") +"RTN","TMGSTUTL",604,0) + . . set s="" +"RTN","TMGSTUTL",605,0) + . . new LineIndex +"RTN","TMGSTUTL",606,0) + . . for LineIndex=1:1:NumLines do +"RTN","TMGSTUTL",607,0) + . . . set tindex=tindex+1 +"RTN","TMGSTUTL",608,0) + . . . if AddZero=0 set tempArray(tindex)=LineArray(LineIndex) +"RTN","TMGSTUTL",609,0) + . . . else set tempArray(tindex,0)=LineArray(LineIndex) +"RTN","TMGSTUTL",610,0) + . . ;"long wrap probably continues into next paragraph, so link together. +"RTN","TMGSTUTL",611,0) + . . if NumLines>2 do +"RTN","TMGSTUTL",612,0) + . . . if AddZero=0 set residualS=tempArray(tindex) set tempArray(tindex)="" +"RTN","TMGSTUTL",613,0) + . . . else set residualS=tempArray(tindex,0) set tempArray(tindex,0)="" +"RTN","TMGSTUTL",614,0) + . . . set tindex=tindex-1 +"RTN","TMGSTUTL",615,0) + . else do +"RTN","TMGSTUTL",616,0) + . . set tindex=tindex+1 +"RTN","TMGSTUTL",617,0) + . . if AddZero=0 set tempArray(tindex)=s +"RTN","TMGSTUTL",618,0) + . . else set tempArray(tindex,0)=s +"RTN","TMGSTUTL",619,0) + . set index=$order(Array(index)) +"RTN","TMGSTUTL",620,0) + else do +"RTN","TMGSTUTL",621,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Array appears empty") +"RTN","TMGSTUTL",622,0) + +"RTN","TMGSTUTL",623,0) + +"RTN","TMGSTUTL",624,0) + kill Array +"RTN","TMGSTUTL",625,0) + merge Array=tempArray +"RTN","TMGSTUTL",626,0) + +"RTN","TMGSTUTL",627,0) + if $get(TMGDEBUG)>0 do ArrayDump^TMGDEBUG("Array") +"RTN","TMGSTUTL",628,0) + +"RTN","TMGSTUTL",629,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent," WordWrapArray^TMGSTUTL") +"RTN","TMGSTUTL",630,0) + quit +"RTN","TMGSTUTL",631,0) + +"RTN","TMGSTUTL",632,0) + +"RTN","TMGSTUTL",633,0) +SplitLine(s,LineArray,Width,SpecialIndent,Indent) +"RTN","TMGSTUTL",634,0) + ;"Scope: PUBLIC FUNCTION +"RTN","TMGSTUTL",635,0) + ;"Purpose: To take a long line, and wrap into an array, such that each +"RTN","TMGSTUTL",636,0) + ;" line is not longer than Width. +"RTN","TMGSTUTL",637,0) + ;" Line breaks will be made at spaces, unless there are no spaces in +"RTN","TMGSTUTL",638,0) + ;" the entire line (in which case, the line will be divided at Width). +"RTN","TMGSTUTL",639,0) + ;"Input: s= string with the long line. **If passed by reference**, then +"RTN","TMGSTUTL",640,0) + ;" it WILL BE CHANGED to equal the last line of array. +"RTN","TMGSTUTL",641,0) + ;" LineArray -- MUST BE PASSED BY REFERENCE. This OUT variable will +"RTN","TMGSTUTL",642,0) + ;" receive the resulting array. +"RTN","TMGSTUTL",643,0) + ;" Width = the desired wrap width. +"RTN","TMGSTUTL",644,0) + ;" SpecialIndent [OPTIONAL]: if 1, then wrapping is done like this: +"RTN","TMGSTUTL",645,0) + ;" " This is a very long line......" +"RTN","TMGSTUTL",646,0) + ;" will be wrapped like this: +"RTN","TMGSTUTL",647,0) + ;" " This is a very +"RTN","TMGSTUTL",648,0) + ;" " long line ... +"RTN","TMGSTUTL",649,0) + ;" Notice that the leading space is copied subsequent line. +"RTN","TMGSTUTL",650,0) + ;" Also, a line like this: +"RTN","TMGSTUTL",651,0) + ;" " 1. Here is the beginning of a paragraph that is very long..." +"RTN","TMGSTUTL",652,0) + ;" will be wrapped like this: +"RTN","TMGSTUTL",653,0) + ;" " 1. Here is the beginning of a paragraph +"RTN","TMGSTUTL",654,0) + ;" " that is very long..." +"RTN","TMGSTUTL",655,0) + ;" Notice that a pattern '#. ' causes the wrapping to match the start +"RTN","TMGSTUTL",656,0) + ;" of the text on the line above. +"RTN","TMGSTUTL",657,0) + ;" Indent [OPTIONAL]: Any absolute amount that all lines should be indented by. +"RTN","TMGSTUTL",658,0) + ;" This could be used if this long line is continuation of an +"RTN","TMGSTUTL",659,0) + ;" indentation above it. +"RTN","TMGSTUTL",660,0) + ;"Result: resulting number of lines (1 if no wrap needed). +"RTN","TMGSTUTL",661,0) + +"RTN","TMGSTUTL",662,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"SplitLine") +"RTN","TMGSTUTL",663,0) + +"RTN","TMGSTUTL",664,0) + new result set result=0 +"RTN","TMGSTUTL",665,0) + kill LineArray +"RTN","TMGSTUTL",666,0) + if ($get(s)="")!($get(Width)'>0) goto SPDone +"RTN","TMGSTUTL",667,0) + new index set index=0 +"RTN","TMGSTUTL",668,0) + new p,tempS,splitPoint +"RTN","TMGSTUTL",669,0) + +"RTN","TMGSTUTL",670,0) + new PreSpace set PreSpace=$$NeededWS(s,.SpecialIndent,.Indent) +"RTN","TMGSTUTL",671,0) + +"RTN","TMGSTUTL",672,0) + if ($length(s)>Width) for do quit:($length(s)'>Width) +"RTN","TMGSTUTL",673,0) + . for splitPoint=1:1:Width do quit:($length(tempS)>Width) +"RTN","TMGSTUTL",674,0) + . . set tempS=$piece(s," ",1,splitPoint) +"RTN","TMGSTUTL",675,0) + . . ;"write "tempS>",tempS,! +"RTN","TMGSTUTL",676,0) + . if splitPoint>1 do +"RTN","TMGSTUTL",677,0) + . . set tempS=$piece(s," ",1,splitPoint-1) +"RTN","TMGSTUTL",678,0) + . . set s=$piece(s," ",splitPoint,Width) +"RTN","TMGSTUTL",679,0) + . else do +"RTN","TMGSTUTL",680,0) + . . ;"We must have a word > Width with no spaces--so just divide +"RTN","TMGSTUTL",681,0) + . . set tempS=$extract(s,1,Width) +"RTN","TMGSTUTL",682,0) + . . set s=$extract(s,Width+1,999) +"RTN","TMGSTUTL",683,0) + . set index=index+1 +"RTN","TMGSTUTL",684,0) + . set LineArray(index)=tempS +"RTN","TMGSTUTL",685,0) + . set s=PreSpace_s +"RTN","TMGSTUTL",686,0) + . ;"write "tempS>",tempS,! +"RTN","TMGSTUTL",687,0) + . ;"write "s>",s,! +"RTN","TMGSTUTL",688,0) + +"RTN","TMGSTUTL",689,0) + set index=index+1 +"RTN","TMGSTUTL",690,0) + set LineArray(index)=s +"RTN","TMGSTUTL",691,0) + +"RTN","TMGSTUTL",692,0) + set result=index +"RTN","TMGSTUTL",693,0) + +"RTN","TMGSTUTL",694,0) +SPDone +"RTN","TMGSTUTL",695,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"SplitLine") +"RTN","TMGSTUTL",696,0) + quit result +"RTN","TMGSTUTL",697,0) + +"RTN","TMGSTUTL",698,0) + +"RTN","TMGSTUTL",699,0) + +"RTN","TMGSTUTL",700,0) +NeededWS(S,SpecialIndent,Indent) +"RTN","TMGSTUTL",701,0) + ;"Scope: PRIVATE +"RTN","TMGSTUTL",702,0) + ;"Purpose: Evaluate the line, and create the white space string +"RTN","TMGSTUTL",703,0) + ;" need for wrapped lines +"RTN","TMGSTUTL",704,0) + ;"Input: s -- the string to eval. i.e. +"RTN","TMGSTUTL",705,0) + ;" " John is very happy today ... .. .. .. .." +"RTN","TMGSTUTL",706,0) + ;" or " 1. John is very happy today ... .. .. .. .." +"RTN","TMGSTUTL",707,0) + ;" SpecialIndent -- See SplitLine() discussion +"RTN","TMGSTUTL",708,0) + ;" Indent -- See SplitLine() discussion +"RTN","TMGSTUTL",709,0) + +"RTN","TMGSTUTL",710,0) + new result set result="" +"RTN","TMGSTUTL",711,0) + if $get(S)="" goto NdWSDone +"RTN","TMGSTUTL",712,0) + +"RTN","TMGSTUTL",713,0) + new WSNum +"RTN","TMGSTUTL",714,0) + set WSNum=+$get(Indent,0) +"RTN","TMGSTUTL",715,0) + set WSNum=WSNum+$$NumLWS(S) +"RTN","TMGSTUTL",716,0) + +"RTN","TMGSTUTL",717,0) + if $get(SpecialIndent)=1 do +"RTN","TMGSTUTL",718,0) + . new ts,FirstWord +"RTN","TMGSTUTL",719,0) + . set ts=$$TrimL(.S) +"RTN","TMGSTUTL",720,0) + . set FirstWord=$piece(ts," ",1) +"RTN","TMGSTUTL",721,0) + . if (FirstWord?.N1".")!(FirstWord?1.4U1".") do ;"match for '#.' pattern +"RTN","TMGSTUTL",722,0) + . . set WSNum=WSNum+$length(FirstWord) +"RTN","TMGSTUTL",723,0) + . . set ts=$piece(ts," ",2,9999) +"RTN","TMGSTUTL",724,0) + . . set WSNum=WSNum+$$NumLWS(.ts)+1 +"RTN","TMGSTUTL",725,0) + +"RTN","TMGSTUTL",726,0) + set result=$$MakeWS(WSNum) +"RTN","TMGSTUTL",727,0) + +"RTN","TMGSTUTL",728,0) +NdWSDone +"RTN","TMGSTUTL",729,0) + quit result +"RTN","TMGSTUTL",730,0) + +"RTN","TMGSTUTL",731,0) + +"RTN","TMGSTUTL",732,0) +WriteWP(NodeRef) +"RTN","TMGSTUTL",733,0) + ;"Purpose: Given a reference to a WP field, this function will print it out. +"RTN","TMGSTUTL",734,0) + ;"INput: NodeRef -- the name of the node to print out. +"RTN","TMGSTUTL",735,0) + ;" For example, "^PS(50.605,1,1)" +"RTN","TMGSTUTL",736,0) + ;"Modification: 2/10/06 -- I removed need for @NodeRef@(0) to contain data. +"RTN","TMGSTUTL",737,0) + +"RTN","TMGSTUTL",738,0) + new i +"RTN","TMGSTUTL",739,0) + ;"if $get(@NodeRef@(0))="" goto WWPDone +"RTN","TMGSTUTL",740,0) + set i=$order(@NodeRef@(0)) +"RTN","TMGSTUTL",741,0) + if i'="" for do quit:(i="") +"RTN","TMGSTUTL",742,0) + . new OneLine +"RTN","TMGSTUTL",743,0) + . set OneLine=$get(@NodeRef@(i)) +"RTN","TMGSTUTL",744,0) + . if OneLine="" set OneLine=$get(@NodeRef@(i,0)) +"RTN","TMGSTUTL",745,0) + . write OneLine,! +"RTN","TMGSTUTL",746,0) + . set i=$order(@NodeRef@(i)) +"RTN","TMGSTUTL",747,0) + +"RTN","TMGSTUTL",748,0) +WWPDone quit +"RTN","TMGSTUTL",749,0) + +"RTN","TMGSTUTL",750,0) + +"RTN","TMGSTUTL",751,0) +LPad(S,width) +"RTN","TMGSTUTL",752,0) + ;"Purpose: To add space ("pad") string S such that final width is per specified with. +"RTN","TMGSTUTL",753,0) + ;" space is added to left side of string +"RTN","TMGSTUTL",754,0) + ;"Input: S : the string to pad. +"RTN","TMGSTUTL",755,0) + ;" width : the desired final width +"RTN","TMGSTUTL",756,0) + ;"result: returns resulting string +"RTN","TMGSTUTL",757,0) + ;"Example: LPad("$5.23",7)=" $5.23" +"RTN","TMGSTUTL",758,0) + +"RTN","TMGSTUTL",759,0) + quit $$RJ^XLFSTR(.S,.width," ") +"RTN","TMGSTUTL",760,0) + +"RTN","TMGSTUTL",761,0) +RPad(S,width) +"RTN","TMGSTUTL",762,0) + ;"Purpose: To add space ("pad") string S such that final width is per specified with. +"RTN","TMGSTUTL",763,0) + ;" space is added to right side of string +"RTN","TMGSTUTL",764,0) + ;"Input: S : the string to pad. +"RTN","TMGSTUTL",765,0) + ;" width : the desired final width +"RTN","TMGSTUTL",766,0) + ;"result: returns resulting string +"RTN","TMGSTUTL",767,0) + ;"Example: RPad("$5.23",7)="$5.23 " +"RTN","TMGSTUTL",768,0) + +"RTN","TMGSTUTL",769,0) + quit $$LJ^XLFSTR(.S,.width," ") +"RTN","TMGSTUTL",770,0) + +"RTN","TMGSTUTL",771,0) +Center(S,width) +"RTN","TMGSTUTL",772,0) + ;"Purpose: to return a center justified string +"RTN","TMGSTUTL",773,0) + +"RTN","TMGSTUTL",774,0) + quit $$CJ^XLFSTR(.S,.width," ") +"RTN","TMGSTUTL",775,0) + +"RTN","TMGSTUTL",776,0) +Clip(S,width) +"RTN","TMGSTUTL",777,0) + ;"Purpose: to ensure that string S is no longer than width +"RTN","TMGSTUTL",778,0) + +"RTN","TMGSTUTL",779,0) + new result set result=$get(S) +"RTN","TMGSTUTL",780,0) + if result'="" set result=$extract(S,1,width) +"RTN","TMGSTUTL",781,0) +ClipDone +"RTN","TMGSTUTL",782,0) + quit result +"RTN","TMGSTUTL",783,0) + +"RTN","TMGSTUTL",784,0) + +"RTN","TMGSTUTL",785,0) +STRB2H(s,F,noSpace) +"RTN","TMGSTUTL",786,0) + ;"Convert a string to hex characters) +"RTN","TMGSTUTL",787,0) + ;"Input: s -- the input string (need not be ascii characters) +"RTN","TMGSTUTL",788,0) + ;" F -- (optional) if F>0 then will append an ascii display of string. +"RTN","TMGSTUTL",789,0) + ;" noSpace -- (Optional) if >0 then characters NOT separated by spaces +"RTN","TMGSTUTL",790,0) + ;"result -- the converted string +"RTN","TMGSTUTL",791,0) + +"RTN","TMGSTUTL",792,0) + new i,ch +"RTN","TMGSTUTL",793,0) + new result set result="" +"RTN","TMGSTUTL",794,0) + +"RTN","TMGSTUTL",795,0) + for i=1:1:$length(s) do +"RTN","TMGSTUTL",796,0) + . set ch=$extract(s,i) +"RTN","TMGSTUTL",797,0) + . set result=result_$$HEXCHR^TMGMISC($ascii(ch)) +"RTN","TMGSTUTL",798,0) + . if +$get(noSpace)=0 set result=result_" " +"RTN","TMGSTUTL",799,0) + +"RTN","TMGSTUTL",800,0) + if $get(F)>0 set result=result_" "_$$HIDECTRLS^TMGSTUTL(s) +"RTN","TMGSTUTL",801,0) + quit result +"RTN","TMGSTUTL",802,0) + +"RTN","TMGSTUTL",803,0) + +"RTN","TMGSTUTL",804,0) +HIDECTRLS(s) +"RTN","TMGSTUTL",805,0) + ;"hide all unprintable characters from a string +"RTN","TMGSTUTL",806,0) + new i,ch,byte +"RTN","TMGSTUTL",807,0) + new result set result="" +"RTN","TMGSTUTL",808,0) + for i=1:1:$length(s) do +"RTN","TMGSTUTL",809,0) + . set ch=$e(s,i) +"RTN","TMGSTUTL",810,0) + . set byte=$ascii(ch) +"RTN","TMGSTUTL",811,0) + . if (byte<32)!(byte>122) set result=result_"." +"RTN","TMGSTUTL",812,0) + . else set result=result_ch +"RTN","TMGSTUTL",813,0) + +"RTN","TMGSTUTL",814,0) + quit result +"RTN","TMGSTUTL",815,0) + +"RTN","TMGSTUTL",816,0) + +"RTN","TMGSTUTL",817,0) + +"RTN","TMGSTUTL",818,0) +CapWords(S,Divider) +"RTN","TMGSTUTL",819,0) + ;"Purpose: convert each word in the string: 'test string' --> 'Test String', 'TEST STRING' --> 'Test String' +"RTN","TMGSTUTL",820,0) + +"RTN","TMGSTUTL",821,0) + ;"Input: S -- the string to convert +"RTN","TMGSTUTL",822,0) + ;" Divider -- [OPTIONAL] the character used to separate string (default is ' ' [space]) +"RTN","TMGSTUTL",823,0) + ;"Result: returns the converted string +"RTN","TMGSTUTL",824,0) + +"RTN","TMGSTUTL",825,0) + new s2,part +"RTN","TMGSTUTL",826,0) + new result set result="" +"RTN","TMGSTUTL",827,0) + set Divider=$get(Divider," ") +"RTN","TMGSTUTL",828,0) + +"RTN","TMGSTUTL",829,0) + set s2=$$LOW^XLFSTR(S) +"RTN","TMGSTUTL",830,0) + +"RTN","TMGSTUTL",831,0) + for i=1:1 do quit:part="" +"RTN","TMGSTUTL",832,0) + . set part=$piece(s2,Divider,i) +"RTN","TMGSTUTL",833,0) + . if part="" quit +"RTN","TMGSTUTL",834,0) + . set $extract(part,1)=$$UP^XLFSTR($extract(part,1)) +"RTN","TMGSTUTL",835,0) + . if result'="" set result=result_Divider +"RTN","TMGSTUTL",836,0) + . set result=result_part +"RTN","TMGSTUTL",837,0) + +"RTN","TMGSTUTL",838,0) + quit result +"RTN","TMGSTUTL",839,0) + +"RTN","TMGSTUTL",840,0) + +"RTN","TMGSTUTL",841,0) +LinuxStr(S) +"RTN","TMGSTUTL",842,0) + ;"Purpose: convert string to a valid linux filename +"RTN","TMGSTUTL",843,0) + ;" e.g. 'File Name' --> 'File\ Name' +"RTN","TMGSTUTL",844,0) + +"RTN","TMGSTUTL",845,0) + quit $$Substitute(.S," ","\ ") +"RTN","TMGSTUTL",846,0) + +"RTN","TMGSTUTL",847,0) + +"RTN","TMGSTUTL",848,0) + +"RTN","TMGSTUTL",849,0) +NiceSplit(S,Len,s1,s2,s2Min,DivCh) +"RTN","TMGSTUTL",850,0) + ;"Purpose: to split S into two strings, s1 & s2 +"RTN","TMGSTUTL",851,0) + ;" Furthermore, s1's length must be <= length. +"RTN","TMGSTUTL",852,0) + ;" and the split will be made at spaces +"RTN","TMGSTUTL",853,0) + ;"Input: S -- the string to split +"RTN","TMGSTUTL",854,0) + ;" Len -- the length limit of s1 +"RTN","TMGSTUTL",855,0) + ;" s1 -- PASS BY REFERENCE, an OUT parameter +"RTN","TMGSTUTL",856,0) + ;" receives first part of split +"RTN","TMGSTUTL",857,0) + ;" s2 -- PASS BY REFERENCE, an OUT parameter +"RTN","TMGSTUTL",858,0) + ;" receives the rest of string +"RTN","TMGSTUTL",859,0) + ;" s2Min -- OPTIONAL -- the minimum that +"RTN","TMGSTUTL",860,0) + ;" length of s2 can be. Note, if s2 +"RTN","TMGSTUTL",861,0) + ;" is "", then this is not applied +"RTN","TMGSTUTL",862,0) + ;" DivCH -- OPTIONAL, default is " ". +"RTN","TMGSTUTL",863,0) + ;" This is the character to split words by +"RTN","TMGSTUTL",864,0) + ;"Output: s1 and s2 is filled with data +"RTN","TMGSTUTL",865,0) + ;"Result: none +"RTN","TMGSTUTL",866,0) + +"RTN","TMGSTUTL",867,0) + set (s1,s2)="" +"RTN","TMGSTUTL",868,0) + if $get(DivCh)="" set DivCh=" " +"RTN","TMGSTUTL",869,0) + +"RTN","TMGSTUTL",870,0) + if $length(S)'>Len do goto NSpDone +"RTN","TMGSTUTL",871,0) + . set s1=S +"RTN","TMGSTUTL",872,0) + +"RTN","TMGSTUTL",873,0) + new i +"RTN","TMGSTUTL",874,0) + new done +"RTN","TMGSTUTL",875,0) + for i=200:-1:1 do quit:(done) +"RTN","TMGSTUTL",876,0) + . set s1=$piece(S,DivCh,1,i)_DivCh +"RTN","TMGSTUTL",877,0) + . set s2=$piece(S,DivCh,i+1,999) +"RTN","TMGSTUTL",878,0) + . set done=($length(s1)'>Len) +"RTN","TMGSTUTL",879,0) + . if done,+$get(s2Min)>0 do +"RTN","TMGSTUTL",880,0) + . . if s2="" quit +"RTN","TMGSTUTL",881,0) + . . set done=($length(s2)'0) +"RTN","TMGSTUTL",941,0) + . set OneLine=$get(@pArray@(i)) +"RTN","TMGSTUTL",942,0) + . if OneLine="" set OneLine=$get(@pArray@(i,0)) +"RTN","TMGSTUTL",943,0) + . if OneLine="" quit +"RTN","TMGSTUTL",944,0) + . set Len=$length(result)+$length(DivCh) +"RTN","TMGSTUTL",945,0) + . if Len+$length(OneLine)>MaxLen do +"RTN","TMGSTUTL",946,0) + . . set OneLine=$extract(OneLine,1,(MaxLen-Len)) +"RTN","TMGSTUTL",947,0) + . set result=result_OneLine_DivCh +"RTN","TMGSTUTL",948,0) + . set Len=Len+$length(OneLine) +"RTN","TMGSTUTL",949,0) + . set i=$order(@pArray@(i)) +"RTN","TMGSTUTL",950,0) + +"RTN","TMGSTUTL",951,0) + quit result; +"RTN","TMGSTUTL",952,0) + +"RTN","TMGSTUTL",953,0) + +"RTN","TMGSTUTL",954,0) +Comp2Strs(s1,s2) +"RTN","TMGSTUTL",955,0) + ;"Purpose: To compare two strings and assign an arbritrary score to their similarity +"RTN","TMGSTUTL",956,0) + ;"Input: s1,s2 -- The two strings to compare +"RTN","TMGSTUTL",957,0) + ;"Result: a score comparing the two strings +"RTN","TMGSTUTL",958,0) + ;" 0.5 point for every word in s1 that is also in s2 (case specific) +"RTN","TMGSTUTL",959,0) + ;" 0.25 point for every word in s1 that is also in s2 (not case specific) +"RTN","TMGSTUTL",960,0) + ;" 0.5 point for every word in s2 that is also in s1 (case specific) +"RTN","TMGSTUTL",961,0) + ;" 0.25 point for every word in s2 that is also in s1 (not case specific) +"RTN","TMGSTUTL",962,0) + ;" 1 points if same number of words in string (compared each way) +"RTN","TMGSTUTL",963,0) + ;" 2 points for each word that is in the same position in each string (case specific) +"RTN","TMGSTUTL",964,0) + ;" 1.5 points for each word that is in the same position in each string (not case specific) +"RTN","TMGSTUTL",965,0) + +"RTN","TMGSTUTL",966,0) + new score set score=0 +"RTN","TMGSTUTL",967,0) + new Us1 set Us1=$$UP^XLFSTR(s1) +"RTN","TMGSTUTL",968,0) + new Us2 set Us2=$$UP^XLFSTR(s2) +"RTN","TMGSTUTL",969,0) + +"RTN","TMGSTUTL",970,0) + new i +"RTN","TMGSTUTL",971,0) + for i=1:1:$length(s1," ") do +"RTN","TMGSTUTL",972,0) + . if s2[$piece(s1," ",i) set score=score+0.5 +"RTN","TMGSTUTL",973,0) + . else if Us2[$piece(Us1," ",i) set score=score+0.25 +"RTN","TMGSTUTL",974,0) + . if $piece(s1," ",i)=$piece(s2," ",i) set score=score+1 +"RTN","TMGSTUTL",975,0) + . else if $piece(Us1," ",i)=$piece(Us2," ",i) set score=score+1.5 +"RTN","TMGSTUTL",976,0) + +"RTN","TMGSTUTL",977,0) + for i=1:1:$length(s2," ") do +"RTN","TMGSTUTL",978,0) + . if s1[$piece(s2," ",i) set score=score+0.5 +"RTN","TMGSTUTL",979,0) + . else if Us1[$piece(Us2," ",i) set score=score+0.25 +"RTN","TMGSTUTL",980,0) + . if $piece(s1," ",i)=$piece(s2," ",i) set score=score+1 +"RTN","TMGSTUTL",981,0) + . else if $piece(Us1," ",i)=$piece(Us2," ",i) set score=score+1.5 +"RTN","TMGSTUTL",982,0) + +"RTN","TMGSTUTL",983,0) + if $length(s1," ")=$length(s2," ") set score=score+2 +"RTN","TMGSTUTL",984,0) + +"RTN","TMGSTUTL",985,0) + quit score +"RTN","TMGSTUTL",986,0) + +"RTN","TMGSTUTL",987,0) + +"RTN","TMGSTUTL",988,0) +PosNum(s,Num,LeadingSpace) +"RTN","TMGSTUTL",989,0) + ;"Purpose: To return the position of the first Number in a string +"RTN","TMGSTUTL",990,0) + ;"Input: S -- string to check +"RTN","TMGSTUTL",991,0) + ;" Num -- OPTIONAL, default is 0-9 numbers. number to look for. +"RTN","TMGSTUTL",992,0) + ;" LeadingSpace -- OPTIONAL. If 1 then looks for " #" or " .#", not just "#" +"RTN","TMGSTUTL",993,0) + ;"Results: -1 if not found, otherwise position of found digit. +"RTN","TMGSTUTL",994,0) + +"RTN","TMGSTUTL",995,0) + new result set result=-1 +"RTN","TMGSTUTL",996,0) + new Leader set Leader="" +"RTN","TMGSTUTL",997,0) + if $get(LeadingSpace)=1 set Leader=" " +"RTN","TMGSTUTL",998,0) + +"RTN","TMGSTUTL",999,0) + if $get(Num) do goto PNDone +"RTN","TMGSTUTL",1000,0) + . set result=$find(s,Leader_Num)-1 +"RTN","TMGSTUTL",1001,0) + +"RTN","TMGSTUTL",1002,0) + new temp,i,decimalFound +"RTN","TMGSTUTL",1003,0) + for i=0:1:9 do +"RTN","TMGSTUTL",1004,0) + . set decimalFound=0 +"RTN","TMGSTUTL",1005,0) + . set temp=$find(s,Leader_i) +"RTN","TMGSTUTL",1006,0) + . if (temp=0)&(Leader'="") do +"RTN","TMGSTUTL",1007,0) + . . set temp=$find(s,Leader_"."_i) +"RTN","TMGSTUTL",1008,0) + . . if temp>-1 set decimalFound=1 +"RTN","TMGSTUTL",1009,0) + . if temp>-1 set temp=temp-$length(Leader_i) +"RTN","TMGSTUTL",1010,0) + . if decimalFound set temp=temp-1 +"RTN","TMGSTUTL",1011,0) + . if (temp>0)&((temp0)&(Leader=" ") set result=result+1 +"RTN","TMGSTUTL",1015,0) + quit result +"RTN","TMGSTUTL",1016,0) + +"RTN","TMGSTUTL",1017,0) + +"RTN","TMGSTUTL",1018,0) +IsNumeric(s) +"RTN","TMGSTUTL",1019,0) + ;"Purpose: To deterimine if word s is a numeric +"RTN","TMGSTUTL",1020,0) + ;" Examples of numeric words: +"RTN","TMGSTUTL",1021,0) + ;" 10, N-100, 0.5%, 50000UNT/ML +"RTN","TMGSTUTL",1022,0) + ;" the test will be if the word contains any digit 0-9 +"RTN","TMGSTUTL",1023,0) + ;"Results: 1 if is a numeric word, 0 if not. +"RTN","TMGSTUTL",1024,0) + +"RTN","TMGSTUTL",1025,0) + quit ($$PosNum(.s)>0) +"RTN","TMGSTUTL",1026,0) + +"RTN","TMGSTUTL",1027,0) + +"RTN","TMGSTUTL",1028,0) +ScrubNumeric(s) +"RTN","TMGSTUTL",1029,0) + ;"Purpose: This is a specialty function designed to remove numeric words +"RTN","TMGSTUTL",1030,0) + ;" from a sentence. E.g. +"RTN","TMGSTUTL",1031,0) + ;" BELLADONNA ALK 0.3/PHENOBARB 16MG CHW TB --> BELLADONNA ALK /PHENOBARB CHW TB +"RTN","TMGSTUTL",1032,0) + ;" ESTROGENS,CONJUGATED 2MG/ML INJ (IN OIL) --> ESTROGENS,CONJUGATED INJ (IN OIL) +"RTN","TMGSTUTL",1033,0) + +"RTN","TMGSTUTL",1034,0) + new Array,i,result +"RTN","TMGSTUTL",1035,0) + set s=$$Substitute(s,"/MG","") +"RTN","TMGSTUTL",1036,0) + set s=$$Substitute(s,"/ML","") +"RTN","TMGSTUTL",1037,0) + set s=$$Substitute(s,"/"," / ") +"RTN","TMGSTUTL",1038,0) + set s=$$Substitute(s,"-"," - ") +"RTN","TMGSTUTL",1039,0) + do CleaveToArray(s," ",.Array) +"RTN","TMGSTUTL",1040,0) + new ToKill +"RTN","TMGSTUTL",1041,0) + set i=0 for set i=$order(Array(i)) quit:+i'>0 do +"RTN","TMGSTUTL",1042,0) + . if (Array(i)="MG")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit +"RTN","TMGSTUTL",1043,0) + . if (Array(i)="MCG")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit +"RTN","TMGSTUTL",1044,0) + . if (Array(i)="MEQ")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit +"RTN","TMGSTUTL",1045,0) + . if (Array(i)="%")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit +"RTN","TMGSTUTL",1046,0) + . if (Array(i)="MM")&($get(ToKill(i-1))=1) set ToKill(i)=1 quit +"RTN","TMGSTUTL",1047,0) + . if $$IsNumeric(Array(i))=0 quit +"RTN","TMGSTUTL",1048,0) + . set ToKill(i)=1 +"RTN","TMGSTUTL",1049,0) + . new tempS set tempS=$get(Array(i-1)) +"RTN","TMGSTUTL",1050,0) + . if (tempS="/")!(tempS="-") set ToKill(i-1)=1 +"RTN","TMGSTUTL",1051,0) + . if (tempS="NO")!(tempS="#") set ToKill(i-1)=1 +"RTN","TMGSTUTL",1052,0) + +"RTN","TMGSTUTL",1053,0) + set i=0 for set i=$order(Array(i)) quit:+i'>0 do +"RTN","TMGSTUTL",1054,0) + . if $get(ToKill(i))=1 kill Array(i) +"RTN","TMGSTUTL",1055,0) + +"RTN","TMGSTUTL",1056,0) + set i="",result="" +"RTN","TMGSTUTL",1057,0) + for set i=$order(Array(i)) quit:+i'>0 do +"RTN","TMGSTUTL",1058,0) + . set result=result_Array(i)_" " +"RTN","TMGSTUTL",1059,0) + +"RTN","TMGSTUTL",1060,0) + set result=$$Trim(result) +"RTN","TMGSTUTL",1061,0) + set result=$$Substitute(result," / ","/") +"RTN","TMGSTUTL",1062,0) + set result=$$Substitute(result," - ","-") +"RTN","TMGSTUTL",1063,0) + +"RTN","TMGSTUTL",1064,0) + quit result +"RTN","TMGSTUTL",1065,0) + +"RTN","TMGSTUTL",1066,0) + +"RTN","TMGSTUTL",1067,0) +Pos(subStr,s,count) +"RTN","TMGSTUTL",1068,0) + ;"Purpose: return the beginning position of subStr in s +"RTN","TMGSTUTL",1069,0) + ;"Input: subStr -- the string to be searched for in s +"RTN","TMGSTUTL",1070,0) + ;" s -- the string to search +"RTN","TMGSTUTL",1071,0) + ;" count -- OPTIONAL, the instance to return pos of (1=1st, 2=2nd, etc.) +"RTN","TMGSTUTL",1072,0) + ;" if count=2 and only 1 instance exists, then 0 returned +"RTN","TMGSTUTL",1073,0) + ;"Result: the beginning position, or 0 if not found +"RTN","TMGSTUTL",1074,0) + ;"Note: This function differs from $find in that $find returns the pos of the +"RTN","TMGSTUTL",1075,0) + ;" first character AFTER the subStr +"RTN","TMGSTUTL",1076,0) + +"RTN","TMGSTUTL",1077,0) + set count=$get(count,1) +"RTN","TMGSTUTL",1078,0) + new result set result=0 +"RTN","TMGSTUTL",1079,0) + new instance set instance=1 +"RTN","TMGSTUTL",1080,0) +PS1 +"RTN","TMGSTUTL",1081,0) + set result=$find(s,subStr,result+1) +"RTN","TMGSTUTL",1082,0) + if result>0 set result=result-$length(subStr) +"RTN","TMGSTUTL",1083,0) + if count>instance set instance=instance+1 goto PS1 +"RTN","TMGSTUTL",1084,0) + +"RTN","TMGSTUTL",1085,0) + quit result +"RTN","TMGSTUTL",1086,0) + +"RTN","TMGSTUTL",1087,0) + +"RTN","TMGSTUTL",1088,0) +ArrayPos(array,s) +"RTN","TMGSTUTL",1089,0) + ;"Purpose: return the index position of s in array +"RTN","TMGSTUTL",1090,0) + +"RTN","TMGSTUTL",1091,0) + ;"... +"RTN","TMGSTUTL",1092,0) + +"RTN","TMGSTUTL",1093,0) + quit +"RTN","TMGSTUTL",1094,0) + +"RTN","TMGSTUTL",1095,0) +DiffPos(s1,s2) +"RTN","TMGSTUTL",1096,0) + ;"Purpose: Return the position of the first difference between s1 and s2 +"RTN","TMGSTUTL",1097,0) + ;"Input -- s1, s2 : The strings to compare. +"RTN","TMGSTUTL",1098,0) + ;"result: the position (in s1) of the first difference, or 0 if no difference +"RTN","TMGSTUTL",1099,0) + +"RTN","TMGSTUTL",1100,0) + new l set l=$length(s1) +"RTN","TMGSTUTL",1101,0) + if $length(s2)>l set l=$length(s2) +"RTN","TMGSTUTL",1102,0) + new done set done=0 +"RTN","TMGSTUTL",1103,0) + new i for i=1:1:l do quit:(done=1) +"RTN","TMGSTUTL",1104,0) + . set done=($extract(s1,1,i)'=$extract(s2,1,i)) +"RTN","TMGSTUTL",1105,0) + new result set result=0 +"RTN","TMGSTUTL",1106,0) + if done=1 set result=i +"RTN","TMGSTUTL",1107,0) + quit result +"RTN","TMGSTUTL",1108,0) + +"RTN","TMGSTUTL",1109,0) + +"RTN","TMGSTUTL",1110,0) +DiffWPos(Words1,Words2) +"RTN","TMGSTUTL",1111,0) + ;"Purpose: Return the index of the first different word between Words arrays +"RTN","TMGSTUTL",1112,0) + ;"Input: Words1,Words2 -- the array of words, such as would be made +"RTN","TMGSTUTL",1113,0) + ;" by CleaveToArray^TMGSTUTL +"RTN","TMGSTUTL",1114,0) + ;"Returns: Index of first different word in Words1, or 0 if no difference +"RTN","TMGSTUTL",1115,0) + +"RTN","TMGSTUTL",1116,0) + new l set l=+$get(Words1("MAXNODE")) +"RTN","TMGSTUTL",1117,0) + if +$get(Words2("MAXNODE"))>l set l=+$get(Words2("MAXNODE")) +"RTN","TMGSTUTL",1118,0) + new done set done=0 +"RTN","TMGSTUTL",1119,0) + new i for i=1:1:l do quit:(done=1) +"RTN","TMGSTUTL",1120,0) + . set done=($get(Words1(i))'=$get(Words2(i))) +"RTN","TMGSTUTL",1121,0) + new result +"RTN","TMGSTUTL",1122,0) + if done=1 set result=i +"RTN","TMGSTUTL",1123,0) + else set result=0 +"RTN","TMGSTUTL",1124,0) + quit result +"RTN","TMGSTUTL",1125,0) + +"RTN","TMGSTUTL",1126,0) + +"RTN","TMGSTUTL",1127,0) +SimStr(s1,p1,s2,p2) +"RTN","TMGSTUTL",1128,0) + ;"Purpose: return the matching string in both s1 and s2, starting +"RTN","TMGSTUTL",1129,0) + ;" at positions p1 and p2. +"RTN","TMGSTUTL",1130,0) + ;" Example: s1='Tom is 12 years old', p1=7 +"RTN","TMGSTUTL",1131,0) + ;" s2='Bill will be 12 years young tomorrow' p2=13 +"RTN","TMGSTUTL",1132,0) + ;" would return ' 12 years ' +"RTN","TMGSTUTL",1133,0) + +"RTN","TMGSTUTL",1134,0) + new ch1,ch2,offset,result,done +"RTN","TMGSTUTL",1135,0) + set result="",done=0 +"RTN","TMGSTUTL",1136,0) + for offset=0:1:9999 do quit:(done=1) +"RTN","TMGSTUTL",1137,0) + . set ch1=$extract(s1,p1+offset) +"RTN","TMGSTUTL",1138,0) + . set ch2=$extract(s2,p2+offset) +"RTN","TMGSTUTL",1139,0) + . if (ch1=ch2) set result=result_ch1 +"RTN","TMGSTUTL",1140,0) + . else set done=1 +"RTN","TMGSTUTL",1141,0) + quit result +"RTN","TMGSTUTL",1142,0) + +"RTN","TMGSTUTL",1143,0) + +"RTN","TMGSTUTL",1144,0) +SimWord(Words1,p1,Words2,p2) +"RTN","TMGSTUTL",1145,0) + ;"Purpose: return the matching words in both words array 1 and 2, starting +"RTN","TMGSTUTL",1146,0) + ;" at word positions p1 and p2. This function is different from +"RTN","TMGSTUTL",1147,0) + ;" SimStr in that it works with whole words +"RTN","TMGSTUTL",1148,0) + ;" Example: +"RTN","TMGSTUTL",1149,0) + ;" Words1(1)=Tom Words2(1)=Bill +"RTN","TMGSTUTL",1150,0) + ;" Words1(2)=is Words2(2)=will +"RTN","TMGSTUTL",1151,0) + ;" Words1(3)=12 Words2(3)=be +"RTN","TMGSTUTL",1152,0) + ;" Words1(4)=years Words2(4)=12 +"RTN","TMGSTUTL",1153,0) + ;" Words1(5)=old Words2(5)=years +"RTN","TMGSTUTL",1154,0) + ;" Words1("MAXNODE")=5 Words2(6)=young +"RTN","TMGSTUTL",1155,0) + ;" Words2(7)=tomorrow +"RTN","TMGSTUTL",1156,0) + ;" Words1("MAXNODE")=7 +"RTN","TMGSTUTL",1157,0) + ;" This will return 3, (where '12 years' starts) +"RTN","TMGSTUTL",1158,0) + ;" if p1=3 and p2=4 would return '12 years' +"RTN","TMGSTUTL",1159,0) + ;"Note: A '|' will be used as word separator when constructing result +"RTN","TMGSTUTL",1160,0) + ;"Input: Words1,Words2 -- the array of words, such as would be made +"RTN","TMGSTUTL",1161,0) + ;" by CleaveToArray^TMGSTUTL. e.g. +"RTN","TMGSTUTL",1162,0) + ;" p1,p2 -- the index of the word in Words array to start with +"RTN","TMGSTUTL",1163,0) + ;"result: (see example) +"RTN","TMGSTUTL",1164,0) + +"RTN","TMGSTUTL",1165,0) + new w1,w2,offset,result,done +"RTN","TMGSTUTL",1166,0) + set result="",done=0 +"RTN","TMGSTUTL",1167,0) + for offset=0:1:$get(Words1("MAXNODE")) do quit:(done=1) +"RTN","TMGSTUTL",1168,0) + . set w1=$get(Words1(offset+p1)) +"RTN","TMGSTUTL",1169,0) + . set w2=$get(Words2(offset+p2)) +"RTN","TMGSTUTL",1170,0) + . if (w1=w2)&(w1'="") do +"RTN","TMGSTUTL",1171,0) + . . if (result'="") set result=result_"|" +"RTN","TMGSTUTL",1172,0) + . . set result=result_w1 +"RTN","TMGSTUTL",1173,0) + . else set done=1 +"RTN","TMGSTUTL",1174,0) + quit result +"RTN","TMGSTUTL",1175,0) + +"RTN","TMGSTUTL",1176,0) + +"RTN","TMGSTUTL",1177,0) +SimPos(s1,s2,DivStr,pos1,pos2,MatchStr) +"RTN","TMGSTUTL",1178,0) + ;"Purpose: return the first position that two strings are similar. This means +"RTN","TMGSTUTL",1179,0) + ;" the first position in string s1 that characters match in s2. A +"RTN","TMGSTUTL",1180,0) + ;" match will be set to mean 3 or more characters being the same. +"RTN","TMGSTUTL",1181,0) + ;" Example: s1='Tom is 12 years old' +"RTN","TMGSTUTL",1182,0) + ;" s2='Bill will be 12 years young tomorrow' +"RTN","TMGSTUTL",1183,0) + ;" This will return 7, (where '12 years' starts) +"RTN","TMGSTUTL",1184,0) + ;"Input: s1,s2 -- the two strings to compare +"RTN","TMGSTUTL",1185,0) + ;" DivStr -- OPTIONAL, the character to use to separate the answers +"RTN","TMGSTUTL",1186,0) + ;" in the return string. Default is '^' +"RTN","TMGSTUTL",1187,0) + ;" pos1 -- OPTIONAL, an OUT PARAMETER. Returns Pos1 from result +"RTN","TMGSTUTL",1188,0) + ;" pos2 -- OPTIONAL, an OUT PARAMETER. Returns Pos2 from result +"RTN","TMGSTUTL",1189,0) + ;" MatchStr -- OPTIONAL, an OUT PARAMETER. Returns MatchStr from result +"RTN","TMGSTUTL",1190,0) + ;"Results: Pos1^Pos2^MatchStr Pos1=position in s1, Pos2=position in s2, +"RTN","TMGSTUTL",1191,0) + ;" MatchStr=the matching Str +"RTN","TMGSTUTL",1192,0) + +"RTN","TMGSTUTL",1193,0) + set DivStr=$get(DivStr,"^") +"RTN","TMGSTUTL",1194,0) + new startPos,subStr,found,s2Pos +"RTN","TMGSTUTL",1195,0) + set found=0,s2Pos=0 +"RTN","TMGSTUTL",1196,0) + for startPos=1:1:$length(s1) do quit:(found=1) +"RTN","TMGSTUTL",1197,0) + . set subStr=$extract(s1,startPos,startPos+3) +"RTN","TMGSTUTL",1198,0) + . set s2Pos=$$Pos(subStr,s2) +"RTN","TMGSTUTL",1199,0) + . set found=(s2Pos>0) +"RTN","TMGSTUTL",1200,0) + +"RTN","TMGSTUTL",1201,0) + new result +"RTN","TMGSTUTL",1202,0) + if found=1 do +"RTN","TMGSTUTL",1203,0) + . set pos1=startPos,pos2=s2Pos +"RTN","TMGSTUTL",1204,0) + . set MatchStr=$$SimStr(s1,startPos,s2,s2Pos) +"RTN","TMGSTUTL",1205,0) + else do +"RTN","TMGSTUTL",1206,0) + . set pos1=0,pos2=0,MatchStr="" +"RTN","TMGSTUTL",1207,0) + +"RTN","TMGSTUTL",1208,0) + set result=pos1_DivStr_pos2_DivStr_MatchStr +"RTN","TMGSTUTL",1209,0) + +"RTN","TMGSTUTL",1210,0) + quit result +"RTN","TMGSTUTL",1211,0) + +"RTN","TMGSTUTL",1212,0) + +"RTN","TMGSTUTL",1213,0) +SimWPos(Words1,Words2,DivStr,p1,p2,MatchStr) +"RTN","TMGSTUTL",1214,0) + ;"Purpose: return the first position that two word arrays are similar. This means +"RTN","TMGSTUTL",1215,0) + ;" the first index in Words array 1 that matches to words in Words array 2. +"RTN","TMGSTUTL",1216,0) + ;" A match will be set to mean the two words are equal +"RTN","TMGSTUTL",1217,0) + ;" Example: +"RTN","TMGSTUTL",1218,0) + ;" Words1(1)=Tom Words2(1)=Bill +"RTN","TMGSTUTL",1219,0) + ;" Words1(2)=is Words2(2)=will +"RTN","TMGSTUTL",1220,0) + ;" Words1(3)=12 Words2(3)=be +"RTN","TMGSTUTL",1221,0) + ;" Words1(4)=years Words2(4)=12 +"RTN","TMGSTUTL",1222,0) + ;" Words1(5)=old Words2(5)=years +"RTN","TMGSTUTL",1223,0) + ;" Words1("MAXNODE")=5 Words2(6)=young +"RTN","TMGSTUTL",1224,0) + ;" Words2(7)=tomorrow +"RTN","TMGSTUTL",1225,0) + ;" Words2("MAXNODE")=7 +"RTN","TMGSTUTL",1226,0) + ;" This will return 3, (where '12 years' starts) +"RTN","TMGSTUTL",1227,0) + ;"Input: Words1,Words2 -- the two arrays to compare +"RTN","TMGSTUTL",1228,0) + ;" DivStr -- OPTIONAL, the character to use to separate the answers +"RTN","TMGSTUTL",1229,0) + ;" in the return string. Default is '^' +"RTN","TMGSTUTL",1230,0) + ;" pos1 -- OPTIONAL, an OUT PARAMETER. Returns Pos1 from result +"RTN","TMGSTUTL",1231,0) + ;" pos2 -- OPTIONAL, an OUT PARAMETER. Returns Pos2 from result +"RTN","TMGSTUTL",1232,0) + ;" MatchStr -- OPTIONAL, an OUT PARAMETER. Returns MatchStr from result +"RTN","TMGSTUTL",1233,0) + ;"Results: Pos1^Pos2^MatchStr Pos1=position in Words1, Pos2=position in Words2, +"RTN","TMGSTUTL",1234,0) + ;" MatchStr=the first matching Word or phrase +"RTN","TMGSTUTL",1235,0) + ;" Note: | will be used as a word separator for phrases. +"RTN","TMGSTUTL",1236,0) + +"RTN","TMGSTUTL",1237,0) + set DivStr=$get(DivStr,"^") +"RTN","TMGSTUTL",1238,0) + new startPos,word1,found,w2Pos +"RTN","TMGSTUTL",1239,0) + set found=0,s2Pos=0 +"RTN","TMGSTUTL",1240,0) + for startPos=1:1:+$get(Words1("MAXNODE")) do quit:(found=1) +"RTN","TMGSTUTL",1241,0) + . set word1=$get(Words1(startPos)) +"RTN","TMGSTUTL",1242,0) + . set w2Pos=$$IndexOf^TMGMISC($name(Words2),word1) +"RTN","TMGSTUTL",1243,0) + . set found=(w2Pos>0) +"RTN","TMGSTUTL",1244,0) + +"RTN","TMGSTUTL",1245,0) + if found=1 do +"RTN","TMGSTUTL",1246,0) + . set p1=startPos,p2=w2Pos +"RTN","TMGSTUTL",1247,0) + . set MatchStr=$$SimWord(.Words1,p1,.Words2,p2) +"RTN","TMGSTUTL",1248,0) + else do +"RTN","TMGSTUTL",1249,0) + . set p1=0,p2=0,MatchStr="" +"RTN","TMGSTUTL",1250,0) + +"RTN","TMGSTUTL",1251,0) + new result set result=p1_DivStr_p2_DivStr_MatchStr +"RTN","TMGSTUTL",1252,0) + +"RTN","TMGSTUTL",1253,0) + quit result +"RTN","TMGSTUTL",1254,0) + +"RTN","TMGSTUTL",1255,0) + +"RTN","TMGSTUTL",1256,0) +DiffStr(s1,s2,DivChr) +"RTN","TMGSTUTL",1257,0) + ;"Purpose: Return how s1 differs from s2. E.g. +"RTN","TMGSTUTL",1258,0) + ;" s1='Today was the birthday of Bill and John' +"RTN","TMGSTUTL",1259,0) + ;" s2='Yesterday was the birthday of Tom and Sue' +"RTN","TMGSTUTL",1260,0) + ;" results='Today^1^Bill^26^John^35' +"RTN","TMGSTUTL",1261,0) + ;" This means that 'Today', starting at pos 1 in s1 differs +"RTN","TMGSTUTL",1262,0) + ;" from s2. And 'Bill' starting at pos 26 differs from s2 etc.. +"RTN","TMGSTUTL",1263,0) + ;"Input: s1,s2 -- the two strings to compare +"RTN","TMGSTUTL",1264,0) + ;" DivStr -- OPTIONAL, the character to use to separate the answers +"RTN","TMGSTUTL",1265,0) + ;" in the return string. Default is '^' +"RTN","TMGSTUTL",1266,0) + ;"Results: DiffStr1^pos1^DiffStr2^pos2^... +"RTN","TMGSTUTL",1267,0) + +"RTN","TMGSTUTL",1268,0) + set DivChr=$get(DivChr,"^") +"RTN","TMGSTUTL",1269,0) + new result set result="" +"RTN","TMGSTUTL",1270,0) + new offset set offset=0 +"RTN","TMGSTUTL",1271,0) + new p1,p2,matchStr,matchLen +"RTN","TMGSTUTL",1272,0) + new diffStr,temp +"RTN","TMGSTUTL",1273,0) +DSLoop +"RTN","TMGSTUTL",1274,0) + set temp=$$SimPos(s1,s2,DivChr,.p1,.p2,.matchStr) +"RTN","TMGSTUTL",1275,0) + ;"Returns: Pos1^Pos2^MatchStr Pos1=pos in s1, Pos2=pos in s2, MatchStr=the matching Str +"RTN","TMGSTUTL",1276,0) + if p1=0 set:(s1'="") result=result_s1_DivChr_(+offset) goto DSDone +"RTN","TMGSTUTL",1277,0) + +"RTN","TMGSTUTL",1278,0) + set matchLen=$length(matchStr) +"RTN","TMGSTUTL",1279,0) + +"RTN","TMGSTUTL",1280,0) + if p1>1 do +"RTN","TMGSTUTL",1281,0) + . set diffStr=$extract(s1,1,p1-1) +"RTN","TMGSTUTL",1282,0) + . set result=result_diffStr_DivChr_(1+offset)_DivChr +"RTN","TMGSTUTL",1283,0) + set offset=offset+(p1+matchLen-1) +"RTN","TMGSTUTL",1284,0) + set s1=$extract(s1,p1+matchLen,9999) ;"trim s1 +"RTN","TMGSTUTL",1285,0) + set s2=$extract(s2,p2+matchLen,9999) ;"trim s2 +"RTN","TMGSTUTL",1286,0) + goto DSLoop +"RTN","TMGSTUTL",1287,0) +DSDone +"RTN","TMGSTUTL",1288,0) + quit result +"RTN","TMGSTUTL",1289,0) + +"RTN","TMGSTUTL",1290,0) + +"RTN","TMGSTUTL",1291,0) +DiffWords(Words1,Words2,DivChr) +"RTN","TMGSTUTL",1292,0) + ;"Purpose: Return how Word arrays Words1 differs from Words2. E.g. +"RTN","TMGSTUTL",1293,0) + ;" Example: +"RTN","TMGSTUTL",1294,0) + ;" Words1(1)=Tom Words2(1)=Bill +"RTN","TMGSTUTL",1295,0) + ;" Words1(2)=is Words2(2)=will +"RTN","TMGSTUTL",1296,0) + ;" Words1(3)=12 Words2(3)=be +"RTN","TMGSTUTL",1297,0) + ;" Words1(4)=years Words2(4)=12 +"RTN","TMGSTUTL",1298,0) + ;" Words1(5)=old Words2(5)=years +"RTN","TMGSTUTL",1299,0) + ;" Words1("MAXNODE")=5 Words2(6)=young +"RTN","TMGSTUTL",1300,0) + ;" Words2(7)=tomorrow +"RTN","TMGSTUTL",1301,0) + ;" Words1("MAXNODE")=7 +"RTN","TMGSTUTL",1302,0) + ;" +"RTN","TMGSTUTL",1303,0) + ;" s1='Today was the birthday of Bill and John' +"RTN","TMGSTUTL",1304,0) + ;" s2='Yesterday was the birthday of Tom and Sue' +"RTN","TMGSTUTL",1305,0) + ;" results='Tom is^1^old^5' +"RTN","TMGSTUTL",1306,0) + ;" This means that 'Tom is', starting at pos 1 in Words1 differs +"RTN","TMGSTUTL",1307,0) + ;" from Words2. And 'old' starting at pos 5 differs from Words2 etc.. +"RTN","TMGSTUTL",1308,0) + ;"Input: Words1,Words2 -- PASS BY REFERENCE. The two word arrays to compare +"RTN","TMGSTUTL",1309,0) + ;" DivStr -- OPTIONAL, the character to use to separate the answers +"RTN","TMGSTUTL",1310,0) + ;" in the return string. Default is '^' +"RTN","TMGSTUTL",1311,0) + ;"Note: The words in DiffStr are divided by "|" +"RTN","TMGSTUTL",1312,0) + ;"Results: DiffStr1A>DiffStr1B^pos1>pos2^DiffStr2A>DiffStr2B^pos1>pos2^... +"RTN","TMGSTUTL",1313,0) + ;" The A DiffStr would be what the value is in Words1, and +"RTN","TMGSTUTL",1314,0) + ;" the B DiffStr would be what the value is in Words2, or @ if deleted. +"RTN","TMGSTUTL",1315,0) + +"RTN","TMGSTUTL",1316,0) + set DivChr=$get(DivChr,"^") +"RTN","TMGSTUTL",1317,0) + new result set result="" +"RTN","TMGSTUTL",1318,0) + new trimmed1,trimmed2 set trimmed1=0,trimmed2=0 +"RTN","TMGSTUTL",1319,0) + new p1,p2,matchStr,matchLen +"RTN","TMGSTUTL",1320,0) + new diffStr1,diffStr2,temp +"RTN","TMGSTUTL",1321,0) + new tWords1,tWords2 +"RTN","TMGSTUTL",1322,0) + merge tWords1=Words1 +"RTN","TMGSTUTL",1323,0) + merge tWords2=Words2 +"RTN","TMGSTUTL",1324,0) + new i,len1,len2,trimLen1,trimLen2 +"RTN","TMGSTUTL",1325,0) + new diffPos1,diffPos2 +"RTN","TMGSTUTL",1326,0) + set len1=+$get(tWords1("MAXNODE")) +"RTN","TMGSTUTL",1327,0) + set len2=+$get(tWords2("MAXNODE")) +"RTN","TMGSTUTL",1328,0) +DWLoop +"RTN","TMGSTUTL",1329,0) + set temp=$$SimWPos(.tWords1,.tWords2,DivChr,.p1,.p2,.matchStr) +"RTN","TMGSTUTL",1330,0) + ;"Returns: Pos1^Pos2^MatchStr Pos1=pos in s1, Pos2=pos in s2, MatchStr=the matching Str +"RTN","TMGSTUTL",1331,0) + +"RTN","TMGSTUTL",1332,0) + ;"Possible return options: +"RTN","TMGSTUTL",1333,0) + ;" p1=p2=0 -- two strings have nothing in common +"RTN","TMGSTUTL",1334,0) + ;" p1=p2=1 -- first word of each string is the same +"RTN","TMGSTUTL",1335,0) + ;" p1=p2=X -- words 1..(X-1) differ from each other. +"RTN","TMGSTUTL",1336,0) + ;" p1>p2 -- e.g. EXT REL TAB --> XR TAB +"RTN","TMGSTUTL",1337,0) + ;" p1 EXT REL TAB +"RTN","TMGSTUTL",1338,0) + +"RTN","TMGSTUTL",1339,0) + if (p1=0)&(p2=0) do +"RTN","TMGSTUTL",1340,0) + . set diffStr1=$$CatArray(.tWords1,1,len1,"|") +"RTN","TMGSTUTL",1341,0) + . set diffStr2=$$CatArray(.tWords2,1,len2,"|") +"RTN","TMGSTUTL",1342,0) + . set trimLen1=len1,trimLen2=len2 +"RTN","TMGSTUTL",1343,0) + . set diffPos1=1+trimmed1 +"RTN","TMGSTUTL",1344,0) + . set diffPos2=1+trimmed2 +"RTN","TMGSTUTL",1345,0) + else if (p1=1)&(p2=1) do +"RTN","TMGSTUTL",1346,0) + . set diffStr1="@",diffStr2="@" +"RTN","TMGSTUTL",1347,0) + . set trimLen1=1,trimLen2=1 +"RTN","TMGSTUTL",1348,0) + . set diffPos1=0,diffPos2=0 +"RTN","TMGSTUTL",1349,0) + else do +"RTN","TMGSTUTL",1350,0) + . set diffStr1=$$CatArray(.tWords1,1,p1-1,"|") +"RTN","TMGSTUTL",1351,0) + . set diffStr2=$$CatArray(.tWords2,1,p2-1,"|") +"RTN","TMGSTUTL",1352,0) + . set trimLen1=p1-1,trimLen2=p2-1 +"RTN","TMGSTUTL",1353,0) + . set diffPos1=1+trimmed1,diffPos2=1+trimmed2 +"RTN","TMGSTUTL",1354,0) + +"RTN","TMGSTUTL",1355,0) + if diffStr1="" set diffStr1="@" +"RTN","TMGSTUTL",1356,0) + if diffStr2="" set diffStr2="@" +"RTN","TMGSTUTL",1357,0) + +"RTN","TMGSTUTL",1358,0) + if '((diffStr1="@")&(diffStr1="@")) do +"RTN","TMGSTUTL",1359,0) + . set:(result'="")&($extract(result,$length(result))'=DivChr) result=result_DivChr +"RTN","TMGSTUTL",1360,0) + . set result=result_diffStr1_">"_diffStr2_DivChr +"RTN","TMGSTUTL",1361,0) + . set result=result_diffPos1_">"_diffPos2 +"RTN","TMGSTUTL",1362,0) + +"RTN","TMGSTUTL",1363,0) + do ListTrim^TMGMISC("tWords1",1,trimLen1,"MAXNODE") +"RTN","TMGSTUTL",1364,0) + do ListTrim^TMGMISC("tWords2",1,trimLen2,"MAXNODE") +"RTN","TMGSTUTL",1365,0) + set trimmed1=trimmed1+trimLen1 +"RTN","TMGSTUTL",1366,0) + set trimmed2=trimmed2+trimLen2 +"RTN","TMGSTUTL",1367,0) + +"RTN","TMGSTUTL",1368,0) + if ($get(tWords1("MAXNODE"))=0)&($get(tWords2("MAXNODE"))=0) goto DWDone +"RTN","TMGSTUTL",1369,0) + goto DWLoop +"RTN","TMGSTUTL",1370,0) + +"RTN","TMGSTUTL",1371,0) +DWDone +"RTN","TMGSTUTL",1372,0) + quit result +"RTN","TMGSTUTL",1373,0) + +"RTN","TMGSTUTL",1374,0) +CatArray(Words,i1,i2,DivChr) +"RTN","TMGSTUTL",1375,0) + ;"Purpose: For given word array, return contatenated results from index1 to index2 +"RTN","TMGSTUTL",1376,0) + ;"Input: Words -- PASS BY REFERENCE. Array of Words, as might be created by CleaveToArray +"RTN","TMGSTUTL",1377,0) + ;" i1 -- the index to start concat at +"RTN","TMGSTUTL",1378,0) + ;" i2 -- the last index to include in concat +"RTN","TMGSTUTL",1379,0) + ;" DivChr -- OPTIONAL. The character to used to separate words. Default=" " +"RTN","TMGSTUTL",1380,0) + +"RTN","TMGSTUTL",1381,0) + new result set result="" +"RTN","TMGSTUTL",1382,0) + set DivChr=$get(DivChr," ") +"RTN","TMGSTUTL",1383,0) + new i for i=i1:1:i2 do +"RTN","TMGSTUTL",1384,0) + . new word set word=$get(Words(i)) +"RTN","TMGSTUTL",1385,0) + . if word="" quit +"RTN","TMGSTUTL",1386,0) + . set:(result'="")&($extract(result,$length(result))'=DivChr) result=result_DivChr +"RTN","TMGSTUTL",1387,0) + . set result=result_word +"RTN","TMGSTUTL",1388,0) + quit result +"RTN","TMGSTUTL",1389,0) + +"RTN","TMGSTUTL",1390,0) + +"RTN","TMGSTUTL",1391,0) +QtProtect(s) +"RTN","TMGSTUTL",1392,0) + ;"Purpose: Protects quotes by converting all quotes do double quotes (" --> "") +"RTN","TMGSTUTL",1393,0) + ;"Input : s -- The string to be modified. Original string is unchanged. +"RTN","TMGSTUTL",1394,0) + ;"Result: returns a string with all instances of single instances of quotes +"RTN","TMGSTUTL",1395,0) + ;" being replaced with two quotes. +"RTN","TMGSTUTL",1396,0) + +"RTN","TMGSTUTL",1397,0) + new tempS +"RTN","TMGSTUTL",1398,0) + set tempS=$$Substitute($get(s),"""""","<^@^>") ;"protect original double quotes +"RTN","TMGSTUTL",1399,0) + set tempS=$$Substitute(tempS,"""","""""") +"RTN","TMGSTUTL",1400,0) + set tempS=$$Substitute(tempS,"<^@^>","""""") ;"reverse protection +"RTN","TMGSTUTL",1401,0) + quit tempS +"RTN","TMGTERM") +0^80^B16915 +"RTN","TMGTERM",1,0) +TMGTERM ;TMG/kst/Terminal interface (ANSI sequences) ;03/25/06 +"RTN","TMGTERM",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGTERM",3,0) + +"RTN","TMGTERM",4,0) + ;"Terminal interface +"RTN","TMGTERM",5,0) + ;"ANSI Standard (X3.64) Control Sequences for Video Terminals and Peripherals +"RTN","TMGTERM",6,0) + ;" in alphabetic order by mnemonic +"RTN","TMGTERM",7,0) + +"RTN","TMGTERM",8,0) + ;"Terminal interface +"RTN","TMGTERM",9,0) + ;"ANSI Standard (X3.64) Control Sequences for Video Terminals and Peripherals +"RTN","TMGTERM",10,0) + ;" in alphabetic order by mnemonic +"RTN","TMGTERM",11,0) + +"RTN","TMGTERM",12,0) + ;"CBT(Pn) ;CBT Cursor Backward Tab Esc [ Pn Z +"RTN","TMGTERM",13,0) + ;"CCH ;Cancel Previous Character Esc T +"RTN","TMGTERM",14,0) + ;"CHA(Pn) ;Cursor Horzntal Absolute Esc [ Pn G +"RTN","TMGTERM",15,0) + ;"CHT(Pn) ;Cursor Horizontal Tab Esc [ Pn I +"RTN","TMGTERM",16,0) + ;"CNL(Pn) ;Cursor Next Line Esc [ Pn E +"RTN","TMGTERM",17,0) + ;"CPL(Pn) ;Cursor Preceding Line Esc [ Pn F +"RTN","TMGTERM",18,0) + ;"CPR(Pn,P2) ;Cursor Position Report Esc [ Pn ; Pn R VT100 +"RTN","TMGTERM",19,0) + ;"CTC(Pn) ;Cursor Tab Control Esc [ Ps W +"RTN","TMGTERM",20,0) + ;"CUB(Pn) ;Cursor Backward Esc [ Pn D VT100 +"RTN","TMGTERM",21,0) + ;"CUD(Pn) ;Cursor Down Esc [ Pn B VT100 +"RTN","TMGTERM",22,0) + ;"CUF(Pn) ;Cursor Forward Esc [ Pn C VT100 +"RTN","TMGTERM",23,0) + ;"CUP(X,Y) ;Cursor Position Esc [ Pn ; Pn H VT100 +"RTN","TMGTERM",24,0) + ;"HOME ;Cursor Home Esc [ H ('home' is top left) +"RTN","TMGTERM",25,0) + ;"CUU(Pn) ;Cursor Up Esc [ Pn A VT100 +"RTN","TMGTERM",26,0) + ;"CVT(Pn) ;Cursor Vertical Tab Esc [ Pn Y +"RTN","TMGTERM",27,0) + ;"DCH(Pn) ;Delete Character Esc [ Pn P +"RTN","TMGTERM",28,0) + ;"DL(Pn) ;Delete Line Esc [ Pn M +"RTN","TMGTERM",29,0) + ;"EA(Pn) ;Erase in Area Esc [ Ps O +"RTN","TMGTERM",30,0) + ;"ECH(Pn) ;Erase Character Esc [ Pn X +"RTN","TMGTERM",31,0) + ;"ED(Pn) ;Erase in Display Esc [ Ps J VT100 +"RTN","TMGTERM",32,0) + ;"EF(Pn) ;Erase in Field Esc [ Ps N +"RTN","TMGTERM",33,0) + ;"EL(Pn) ;Erase in Line Esc [ Ps K VT100 +"RTN","TMGTERM",34,0) + ;"EPA ;End of Protected Area Esc W +"RTN","TMGTERM",35,0) + ;"ESA ;End of Selected Area Esc G +"RTN","TMGTERM",36,0) + ;"FNT(Pn,P2) ;Font Selection Esc [ Pn ; Pn Space D +"RTN","TMGTERM",37,0) + ;"GSM(Pn,P2) ;Graphic Size Modify Esc [ Pn ; Pn Space B +"RTN","TMGTERM",38,0) + ;"GSS(Pn) ;Graphic Size Selection Esc [ Pn Space C +"RTN","TMGTERM",39,0) + ;"HPA(Pn) ;Horz Position Absolute Esc [ Pn ` +"RTN","TMGTERM",40,0) + ;"HPR(Pn) ;Horz Position Relative Esc [ Pn a +"RTN","TMGTERM",41,0) + ;"HTJ ;Horz Tab w/Justification Esc I +"RTN","TMGTERM",42,0) + ;"HTS ;Horizontal Tab Set Esc H VT100 +"RTN","TMGTERM",43,0) + ;"HVP(Pn,P2) ;Horz & Vertical Position Esc [ Pn ; Pn f VT100 +"RTN","TMGTERM",44,0) + ;"ICH(Pn) ;Insert Character Esc [ Pn @ +"RTN","TMGTERM",45,0) + ;"IL(Pn) ;Insert Line Esc [ Pn L +"RTN","TMGTERM",46,0) + ;"IND ;Index Esc D VT100 +"RTN","TMGTERM",47,0) + ;"NEL ;Next Line Esc E VT100 +"RTN","TMGTERM",48,0) + ;"NP(Pn) ;Next Page Esc [ Pn U +"RTN","TMGTERM",49,0) + ;"PP(Pn) ;Preceding Page Esc [ Pn V +"RTN","TMGTERM",50,0) + ;"IS ;Reset to Initial State Esc c +"RTN","TMGTERM",51,0) + ;"RM(Pn) ;Reset Mode Esc [ Ps l VT100 +"RTN","TMGTERM",52,0) + ;"SD(Pn) ;Scroll Down Esc [ Pn T +"RTN","TMGTERM",53,0) + ;"SL(Pn) ;Scroll Left Esc [ Pn Space @ +"RTN","TMGTERM",54,0) + ;"SM(Pn) ;Select Mode Esc [ Ps h VT100 +"RTN","TMGTERM",55,0) + ;"SPA ;Start of Protected Area Esc V +"RTN","TMGTERM",56,0) + ;"SPI(Pn,P2) ;Spacing Increment Esc [ Pn ; Pn Space G +"RTN","TMGTERM",57,0) + ;"SR(Pn) ;Scroll Right Esc [ Pn Space A +"RTN","TMGTERM",58,0) + ;"SA ;Start of Selected Area Esc F +"RTN","TMGTERM",59,0) + ;"ST ;String Terminator Esc \ +"RTN","TMGTERM",60,0) + ;"SU(Pn) ;Scroll Up Esc [ Pn S +"RTN","TMGTERM",61,0) + ;"TBC(Pn) ;Tab Clear Esc [ Ps g VT100 +"RTN","TMGTERM",62,0) + ;"VPA(Pn) ;Vert Position Absolute Esc [ Pn d +"RTN","TMGTERM",63,0) + ;"VPR(Pn) ;Vert Position Relative Esc [ Pn e +"RTN","TMGTERM",64,0) + ;"VCULOAD ;Unsave Cursor ESC [ u +"RTN","TMGTERM",65,0) + ;"VCUSAV2 ;Save Cursor & Attrs ESC 7 +"RTN","TMGTERM",66,0) + ;"VCULOAD2 ;Restore Cursor & Attrs ESC 8 +"RTN","TMGTERM",67,0) + +"RTN","TMGTERM",68,0) + ;"VT100 specific calls +"RTN","TMGTERM",69,0) + ;"-------------------- +"RTN","TMGTERM",70,0) + ;"VCEL ;Erase from cursor to end of line Esc [ 0 K or Esc [ K +"RTN","TMGTERM",71,0) + ;"VCBL ;Erase from beginning of line to cursor Esc [ 1 K +"RTN","TMGTERM",72,0) + ;"VEL ;Erase line containing cursor Esc [ 2 K +"RTN","TMGTERM",73,0) + ;"VCES ;Erase from cursor to end of screen Esc [ 0 J or Esc [ J +"RTN","TMGTERM",74,0) + ;"VCBS ;Erase from beginning of screen to cursor Esc [ 1 J +"RTN","TMGTERM",75,0) + ;"VCS ;Erase entire screen Esc [ 2 J +"RTN","TMGTERM",76,0) + ;"VCUSAV ;Save Cursor ESC [ s +"RTN","TMGTERM",77,0) + ;"VTATRIB(n) ;Set Text attributes [{attr1};...;{attrn}m +"RTN","TMGTERM",78,0) + ;"VFGCOLOR(n);Set Text Foreground Color [{attr1};...;{attrn}m +"RTN","TMGTERM",79,0) + ;"VBGCOLOR(n);Set Text Background Color [{attr1};...;{attrn}m +"RTN","TMGTERM",80,0) + ;"VCOLORS(FG,BG) ;Set Text Colors [{attr1};...;{attrn}m +"RTN","TMGTERM",81,0) + ;"SetGlobals +"RTN","TMGTERM",82,0) + ;"KillGlobals +"RTN","TMGTERM",83,0) + ;"DemoColors +"RTN","TMGTERM",84,0) + ;"DemoClr2 +"RTN","TMGTERM",85,0) + +"RTN","TMGTERM",86,0) + +"RTN","TMGTERM",87,0) + ;"===================================================== +"RTN","TMGTERM",88,0) + +"RTN","TMGTERM",89,0) + +"RTN","TMGTERM",90,0) +EscN(Num,N2,Cmd) +"RTN","TMGTERM",91,0) + new tempX,tempY +"RTN","TMGTERM",92,0) + set tempX=$X +"RTN","TMGTERM",93,0) + set tempY=$Y +"RTN","TMGTERM",94,0) + set $X=1 ;"ensure escape chars don't cause a wrap. +"RTN","TMGTERM",95,0) + write $char(27,91)_Num +"RTN","TMGTERM",96,0) + if $data(N2) write ";"_N2 +"RTN","TMGTERM",97,0) + if $data(Cmd) write Cmd +"RTN","TMGTERM",98,0) + ;"reset $X,$Y so that escape characters aren't counted for line wrapping +"RTN","TMGTERM",99,0) + set $X=tempX +"RTN","TMGTERM",100,0) + set $Y=tempY +"RTN","TMGTERM",101,0) + quit +"RTN","TMGTERM",102,0) + +"RTN","TMGTERM",103,0) +CBT(Pn) ;"CBT Cursor Backward Tab Esc [ Pn Z +"RTN","TMGTERM",104,0) + do EscN(.Pn,,"Z") +"RTN","TMGTERM",105,0) + quit +"RTN","TMGTERM",106,0) + +"RTN","TMGTERM",107,0) +CCH ;"Cancel Previous Character Esc T +"RTN","TMGTERM",108,0) + write $char(27)_"T" +"RTN","TMGTERM",109,0) + +"RTN","TMGTERM",110,0) +CHA(Pn) ;"Cursor Horzntal Absolute Esc [ Pn G +"RTN","TMGTERM",111,0) + do EscN(.Pn,,"G") +"RTN","TMGTERM",112,0) + set $X=Pn +"RTN","TMGTERM",113,0) + quit +"RTN","TMGTERM",114,0) + +"RTN","TMGTERM",115,0) +CHT(Pn) ;"Cursor Horizontal Tab Esc [ Pn I +"RTN","TMGTERM",116,0) + do EscN(.Pn,,"I") quit +"RTN","TMGTERM",117,0) + +"RTN","TMGTERM",118,0) +CNL(Pn) ;"Cursor Next Line Esc [ Pn E +"RTN","TMGTERM",119,0) + do EscN(.Pn,,"E") +"RTN","TMGTERM",120,0) + set $Y=$Y+1 +"RTN","TMGTERM",121,0) + quit +"RTN","TMGTERM",122,0) + +"RTN","TMGTERM",123,0) +CPL(Pn) ;"Cursor Preceding Line Esc [ Pn F +"RTN","TMGTERM",124,0) + do EscN(.Pn,,"F") +"RTN","TMGTERM",125,0) + if $Y>0 set $Y=$Y-1 +"RTN","TMGTERM",126,0) + quit +"RTN","TMGTERM",127,0) + +"RTN","TMGTERM",128,0) +CPR(Pn,P2) ;"Cursor Position Report Esc [ Pn ; Pn R VT100 +"RTN","TMGTERM",129,0) + do EscN(.Pn,.P2,"R") quit +"RTN","TMGTERM",130,0) + +"RTN","TMGTERM",131,0) +CTC(Pn) ;"Cursor Tab Control Esc [ Ps W +"RTN","TMGTERM",132,0) + do EscN(.Pn,,"W") quit +"RTN","TMGTERM",133,0) + +"RTN","TMGTERM",134,0) +CUB(Pn) ;"Cursor Backward Esc [ Pn D VT100 +"RTN","TMGTERM",135,0) + do EscN(.Pn,,"D") +"RTN","TMGTERM",136,0) + set $X=$X-1 +"RTN","TMGTERM",137,0) + quit +"RTN","TMGTERM",138,0) + +"RTN","TMGTERM",139,0) +CUD(Pn) ;"Cursor Down Esc [ Pn B VT100 +"RTN","TMGTERM",140,0) + do EscN(.Pn,,"B") +"RTN","TMGTERM",141,0) + set $Y=$Y+1 +"RTN","TMGTERM",142,0) + quit +"RTN","TMGTERM",143,0) + +"RTN","TMGTERM",144,0) +CUF(Pn) ;"Cursor Forward Esc [ Pn C VT100 +"RTN","TMGTERM",145,0) + do EscN(.Pn,,"C") +"RTN","TMGTERM",146,0) + set $X=$X+1 +"RTN","TMGTERM",147,0) + quit +"RTN","TMGTERM",148,0) + +"RTN","TMGTERM",149,0) +CUP(X,Y) ;"Cursor Position Esc [ Pn ; Pn H VT100 +"RTN","TMGTERM",150,0) + do EscN(.Y,.X,"H") +"RTN","TMGTERM",151,0) + set $X=X +"RTN","TMGTERM",152,0) + set $Y=Y +"RTN","TMGTERM",153,0) + quit +"RTN","TMGTERM",154,0) + +"RTN","TMGTERM",155,0) +HOME ;"Cursor Home Esc [ H ('home' is top left) +"RTN","TMGTERM",156,0) + set $X=1 ;"ensure characters below don't cause a wrap. +"RTN","TMGTERM",157,0) + w $char(27,91)_"H" +"RTN","TMGTERM",158,0) + set $X=1 ;"now set $X to home value. +"RTN","TMGTERM",159,0) + set $Y=1 +"RTN","TMGTERM",160,0) + quit +"RTN","TMGTERM",161,0) + +"RTN","TMGTERM",162,0) +CUU(Pn) ;"Cursor Up Esc [ Pn A VT100 +"RTN","TMGTERM",163,0) + do EscN(.Pn,,"A") +"RTN","TMGTERM",164,0) + set $Y=$Y-1 +"RTN","TMGTERM",165,0) + quit +"RTN","TMGTERM",166,0) + +"RTN","TMGTERM",167,0) +CVT(Pn) ;"Cursor Vertical Tab Esc [ Pn Y +"RTN","TMGTERM",168,0) + do EscN(.Pn,,"Y") quit +"RTN","TMGTERM",169,0) + +"RTN","TMGTERM",170,0) +DCH(Pn) ;"Delete Character Esc [ Pn P +"RTN","TMGTERM",171,0) + do EscN(.Pn,,"P") quit +"RTN","TMGTERM",172,0) + +"RTN","TMGTERM",173,0) +DL(Pn) ;"Delete Line Esc [ Pn M +"RTN","TMGTERM",174,0) + do EscN(.Pn,,"M") quit +"RTN","TMGTERM",175,0) + +"RTN","TMGTERM",176,0) +EA(Pn) ;"Erase in Area Esc [ Ps O +"RTN","TMGTERM",177,0) + do EscN(.Pn,,"O") quit +"RTN","TMGTERM",178,0) + +"RTN","TMGTERM",179,0) +ECH(Pn) ;"Erase Character Esc [ Pn X +"RTN","TMGTERM",180,0) + do EscN(.Pn,,"X") quit +"RTN","TMGTERM",181,0) + +"RTN","TMGTERM",182,0) +ED(Pn) ;"Erase in Display Esc [ Ps J VT100 +"RTN","TMGTERM",183,0) + do EscN(.Pn,,"J") quit +"RTN","TMGTERM",184,0) + +"RTN","TMGTERM",185,0) +EF(Pn) ;"Erase in Field Esc [ Ps N +"RTN","TMGTERM",186,0) + do EscN(.Pn,,"N") quit +"RTN","TMGTERM",187,0) + +"RTN","TMGTERM",188,0) +EL(Pn) ;"Erase in Line Esc [ Ps K VT100 +"RTN","TMGTERM",189,0) + do EscN(.Pn,,"K") quit +"RTN","TMGTERM",190,0) + +"RTN","TMGTERM",191,0) +EPA ;"End of Protected Area Esc W +"RTN","TMGTERM",192,0) + w $char(27)_"W" quit +"RTN","TMGTERM",193,0) + +"RTN","TMGTERM",194,0) +ESA ;"End of Selected Area Esc G +"RTN","TMGTERM",195,0) + w $char(27)_"G" quit +"RTN","TMGTERM",196,0) + +"RTN","TMGTERM",197,0) +FNT(Pn,P2) ;"Font Selection Esc [ Pn ; Pn Space D +"RTN","TMGTERM",198,0) + do EscN(.Pn,P2,"D") quit +"RTN","TMGTERM",199,0) + +"RTN","TMGTERM",200,0) +GSM(Pn,P2) ;"Graphic Size Modify Esc [ Pn ; Pn Space B +"RTN","TMGTERM",201,0) + do EscN(.Pn,P2,"B") quit +"RTN","TMGTERM",202,0) + +"RTN","TMGTERM",203,0) +GSS(Pn) ;"Graphic Size Selection Esc [ Pn Space C +"RTN","TMGTERM",204,0) + do EscN(.Pn,,"C") quit +"RTN","TMGTERM",205,0) + +"RTN","TMGTERM",206,0) +HPA(Pn) ;"Horz Position Absolute Esc [ Pn ` +"RTN","TMGTERM",207,0) + do EscN(.Pn,,"`") quit +"RTN","TMGTERM",208,0) + +"RTN","TMGTERM",209,0) +HPR(Pn) ;"Horz Position Relative Esc [ Pn a +"RTN","TMGTERM",210,0) + do EscN(.Pn,,"a") quit +"RTN","TMGTERM",211,0) + +"RTN","TMGTERM",212,0) +HTJ ;"Horz Tab w/Justification Esc I +"RTN","TMGTERM",213,0) + w $char(27)_"I" quit +"RTN","TMGTERM",214,0) + +"RTN","TMGTERM",215,0) +HTS ;"Horizontal Tab Set Esc H VT100 +"RTN","TMGTERM",216,0) + w $char(27)_"H" quit +"RTN","TMGTERM",217,0) + +"RTN","TMGTERM",218,0) +HVP(Pn,P2) ;"Horz & Vertical Position Esc [ Pn ; Pn f VT100 +"RTN","TMGTERM",219,0) + do EscN(.Pn,P2,"A") quit +"RTN","TMGTERM",220,0) + +"RTN","TMGTERM",221,0) +ICH(Pn) ;"Insert Character Esc [ Pn @ +"RTN","TMGTERM",222,0) + do EscN(.Pn,,"@") quit +"RTN","TMGTERM",223,0) + +"RTN","TMGTERM",224,0) +IL(Pn) ;"Insert Line Esc [ Pn L +"RTN","TMGTERM",225,0) + do EscN(.Pn,,"L") quit +"RTN","TMGTERM",226,0) + +"RTN","TMGTERM",227,0) +IND ;"Index Esc D VT100 +"RTN","TMGTERM",228,0) + w $char(27)_"D" quit +"RTN","TMGTERM",229,0) + +"RTN","TMGTERM",230,0) +NEL ;"Next Line Esc E VT100 +"RTN","TMGTERM",231,0) + w $char(27)_"E" quit +"RTN","TMGTERM",232,0) + +"RTN","TMGTERM",233,0) +NP(Pn) ;"Next Page Esc [ Pn U +"RTN","TMGTERM",234,0) + do EscN(.Pn,,"U") quit +"RTN","TMGTERM",235,0) + +"RTN","TMGTERM",236,0) +PP(Pn) ;"Preceding Page Esc [ Pn V +"RTN","TMGTERM",237,0) + do EscN(.Pn,,"V") quit +"RTN","TMGTERM",238,0) + +"RTN","TMGTERM",239,0) +IS ;"Reset to Initial State Esc c +"RTN","TMGTERM",240,0) + w $char(27)_"c" quit +"RTN","TMGTERM",241,0) + +"RTN","TMGTERM",242,0) +RM(Pn) ;"Reset Mode Esc [ Ps l VT100 +"RTN","TMGTERM",243,0) + do EscN(.Pn,,"l") quit +"RTN","TMGTERM",244,0) + +"RTN","TMGTERM",245,0) +SD(Pn) ;"Scroll Down Esc [ Pn T +"RTN","TMGTERM",246,0) + do EscN(.Pn,,"T") quit +"RTN","TMGTERM",247,0) + +"RTN","TMGTERM",248,0) +SL(Pn) ;"Scroll Left Esc [ Pn Space @ +"RTN","TMGTERM",249,0) + do EscN(.Pn,," @") quit +"RTN","TMGTERM",250,0) + +"RTN","TMGTERM",251,0) +SM(Pn) ;"Select Mode Esc [ Ps h VT100 +"RTN","TMGTERM",252,0) + do EscN(.Pn,,"h") quit +"RTN","TMGTERM",253,0) + +"RTN","TMGTERM",254,0) +SPA ;"Start of Protected Area Esc V +"RTN","TMGTERM",255,0) + w $char(27)_"V" quit +"RTN","TMGTERM",256,0) + +"RTN","TMGTERM",257,0) +SPI(Pn,P2) ;"Spacing Increment Esc [ Pn ; Pn Space G +"RTN","TMGTERM",258,0) + do EscN(.Pn,P2," G") quit +"RTN","TMGTERM",259,0) + +"RTN","TMGTERM",260,0) +SR(Pn) ;"Scroll Right Esc [ Pn Space A +"RTN","TMGTERM",261,0) + do EscN(.Pn,," A") quit +"RTN","TMGTERM",262,0) + +"RTN","TMGTERM",263,0) +SA ;"Start of Selected Area Esc F +"RTN","TMGTERM",264,0) + w $char(27)_"F" quit +"RTN","TMGTERM",265,0) + +"RTN","TMGTERM",266,0) +ST ;"String Terminator Esc \ +"RTN","TMGTERM",267,0) + w $char(27)_"\" quit +"RTN","TMGTERM",268,0) + +"RTN","TMGTERM",269,0) +SU(Pn) ;"Scroll Up Esc [ Pn S +"RTN","TMGTERM",270,0) + do EscN(.Pn,,"S") quit +"RTN","TMGTERM",271,0) + +"RTN","TMGTERM",272,0) +TBC(Pn) ;"Tab Clear Esc [ Ps g VT100 +"RTN","TMGTERM",273,0) + do EscN(.Pn,,"g") quit +"RTN","TMGTERM",274,0) + +"RTN","TMGTERM",275,0) +VPA(Pn) ;"Vert Position Absolute Esc [ Pn d +"RTN","TMGTERM",276,0) + do EscN(.Pn,,"d") quit +"RTN","TMGTERM",277,0) + +"RTN","TMGTERM",278,0) +VPR(Pn) ;"Vert Position Relative Esc [ Pn e +"RTN","TMGTERM",279,0) + do EscN(.Pn,,"e") quit +"RTN","TMGTERM",280,0) + +"RTN","TMGTERM",281,0) + +"RTN","TMGTERM",282,0) +VCULOAD ;"Unsave Cursor ESC [ u +"RTN","TMGTERM",283,0) + w $char(27,91)_"u" quit +"RTN","TMGTERM",284,0) + +"RTN","TMGTERM",285,0) +VCUSAV2 ;"Save Cursor & Attrs ESC 7 +"RTN","TMGTERM",286,0) + w $char(27)_"7" quit +"RTN","TMGTERM",287,0) + +"RTN","TMGTERM",288,0) +VCULOAD2 ;"Restore Cursor & Attrs ESC 8 +"RTN","TMGTERM",289,0) + w $char(27)_"8" quit +"RTN","TMGTERM",290,0) + +"RTN","TMGTERM",291,0) + +"RTN","TMGTERM",292,0) + ;"-------------------------------------------------------------- +"RTN","TMGTERM",293,0) + ;"VT100 specific calls +"RTN","TMGTERM",294,0) + ;"Terminal interface +"RTN","TMGTERM",295,0) + +"RTN","TMGTERM",296,0) +VCEL ;"Erase from cursor to end of line Esc [ 0 K or Esc [ K +"RTN","TMGTERM",297,0) + do EscN("0",,"K") quit +"RTN","TMGTERM",298,0) + +"RTN","TMGTERM",299,0) +VCBL ;"Erase from beginning of line to cursor Esc [ 1 K +"RTN","TMGTERM",300,0) + do EscN("1",,"K") quit +"RTN","TMGTERM",301,0) + +"RTN","TMGTERM",302,0) +VEL ;"Erase line containing cursor Esc [ 2 K +"RTN","TMGTERM",303,0) + do EscN("2",,"K") quit +"RTN","TMGTERM",304,0) + +"RTN","TMGTERM",305,0) +VCES ;"Erase from cursor to end of screen Esc [ 0 J or Esc [ J +"RTN","TMGTERM",306,0) + do EscN("0",,"J") quit +"RTN","TMGTERM",307,0) + +"RTN","TMGTERM",308,0) +VCBS ;"Erase from beginning of screen to cursor Esc [ 1 J +"RTN","TMGTERM",309,0) + do EscN("1",,"J") quit +"RTN","TMGTERM",310,0) + +"RTN","TMGTERM",311,0) +VCS ;"Erase entire screen Esc [ 2 J +"RTN","TMGTERM",312,0) + do EscN("2",,"J") quit +"RTN","TMGTERM",313,0) + +"RTN","TMGTERM",314,0) +VCUSAV ;"Save Cursor ESC [ s +"RTN","TMGTERM",315,0) + w $char(27,91)_"s" quit +"RTN","TMGTERM",316,0) + +"RTN","TMGTERM",317,0) + ;"VCULOAD ;"Unsave Cursor ESC [ u +"RTN","TMGTERM",318,0) + ;" w $char(27,91)_"u" quit +"RTN","TMGTERM",319,0) + +"RTN","TMGTERM",320,0) + ;"VCUSAV2 ;"Save Cursor & Attrs ESC 7 +"RTN","TMGTERM",321,0) + ;" w $char(27)_"7" quit +"RTN","TMGTERM",322,0) + +"RTN","TMGTERM",323,0) + ;"VCULOAD2 ;"Restore Cursor & Attrs ESC 8 +"RTN","TMGTERM",324,0) + ;" w $char(27)_"8" quit +"RTN","TMGTERM",325,0) + +"RTN","TMGTERM",326,0) +VTATRIB(n) ;"Set Text attributes [{attr1};...;{attrn}m +"RTN","TMGTERM",327,0) + ;"0-Reset all attributes +"RTN","TMGTERM",328,0) + ;"1-Bright +"RTN","TMGTERM",329,0) + ;"2-Dim +"RTN","TMGTERM",330,0) + ;"4-Underscore +"RTN","TMGTERM",331,0) + ;"5-Blink +"RTN","TMGTERM",332,0) + ;"7-Reverse +"RTN","TMGTERM",333,0) + ;"8-Hidden +"RTN","TMGTERM",334,0) + do EscN(n,,"m") quit +"RTN","TMGTERM",335,0) + +"RTN","TMGTERM",336,0) +VFGCOLOR(n) ;"Set Text Foreground Color [{attr1};...;{attrn}m +"RTN","TMGTERM",337,0) + ;"See note about colors in VCOLORS +"RTN","TMGTERM",338,0) + do VTATRIB(0) +"RTN","TMGTERM",339,0) + if n>7 do +"RTN","TMGTERM",340,0) + . do VTATRIB(1) +"RTN","TMGTERM",341,0) + . set n=n-7 +"RTN","TMGTERM",342,0) + set n=n+30 +"RTN","TMGTERM",343,0) + do EscN(n,,"m") quit +"RTN","TMGTERM",344,0) + +"RTN","TMGTERM",345,0) +VBGCOLOR(n) ;"Set Text Background Color [{attr1};...;{attrn}m +"RTN","TMGTERM",346,0) + ;"See note about colors in VCOLORS +"RTN","TMGTERM",347,0) + do VTATRIB(0) +"RTN","TMGTERM",348,0) + if n>7 do +"RTN","TMGTERM",349,0) + . do VTATRIB(1) +"RTN","TMGTERM",350,0) + . set n=n-7 +"RTN","TMGTERM",351,0) + set n=n+40 +"RTN","TMGTERM",352,0) + do EscN(n,,"m") quit +"RTN","TMGTERM",353,0) + +"RTN","TMGTERM",354,0) +VCOLORS(FG,BG) ;Set Text Colors [{attr1};...;{attrn}m +"RTN","TMGTERM",355,0) + ;"Note: 5/29/06 I don't know if the color numbers are working +"RTN","TMGTERM",356,0) + ;" correctly. The best way to determine what the color should +"RTN","TMGTERM",357,0) + ;" be is to run DemoColor and pick the numbers wanted for desired colors +"RTN","TMGTERM",358,0) + do VTATRIB(0) +"RTN","TMGTERM",359,0) + if FG>7 do +"RTN","TMGTERM",360,0) + . do VTATRIB(1) +"RTN","TMGTERM",361,0) + . set FG=FG-7 +"RTN","TMGTERM",362,0) + if BG>7 do +"RTN","TMGTERM",363,0) + . do VTATRIB(1) +"RTN","TMGTERM",364,0) + . set BG=BG-7 +"RTN","TMGTERM",365,0) + +"RTN","TMGTERM",366,0) + set FG=FG+30 +"RTN","TMGTERM",367,0) + set BG=BG+40 +"RTN","TMGTERM",368,0) + do EscN(FG,BG,"m") quit +"RTN","TMGTERM",369,0) + quit +"RTN","TMGTERM",370,0) + +"RTN","TMGTERM",371,0) +SetGlobals +"RTN","TMGTERM",372,0) + set TMGcBlack=0 +"RTN","TMGTERM",373,0) + set TMGcRed=1 +"RTN","TMGTERM",374,0) + set TMGcGreen=2 +"RTN","TMGTERM",375,0) + set TMGcYellow=3 +"RTN","TMGTERM",376,0) + set TMGcBlue=4 +"RTN","TMGTERM",377,0) + set TMGcMagenta=5 +"RTN","TMGTERM",378,0) + set TMGcCyan=6 +"RTN","TMGTERM",379,0) + set TMGcGrey=7 +"RTN","TMGTERM",380,0) + +"RTN","TMGTERM",381,0) + set TMGcBRed=8 +"RTN","TMGTERM",382,0) + set TMGcBGreen=9 +"RTN","TMGTERM",383,0) + set TMGcBYellow=10 +"RTN","TMGTERM",384,0) + set TMGcBBlue=11 +"RTN","TMGTERM",385,0) + set TMGcBMagenta=12 +"RTN","TMGTERM",386,0) + set TMGcBCyan=13 +"RTN","TMGTERM",387,0) + set TMGcBGrey=14 +"RTN","TMGTERM",388,0) + set TMGcWhite=15 +"RTN","TMGTERM",389,0) + +"RTN","TMGTERM",390,0) + quit +"RTN","TMGTERM",391,0) + +"RTN","TMGTERM",392,0) +KillGlobals +"RTN","TMGTERM",393,0) + kill TMGcBlack +"RTN","TMGTERM",394,0) + kill TMGcRed +"RTN","TMGTERM",395,0) + kill TMGcGreen +"RTN","TMGTERM",396,0) + kill TMGcYellow +"RTN","TMGTERM",397,0) + kill TMGcBlue +"RTN","TMGTERM",398,0) + kill TMGcMagenta +"RTN","TMGTERM",399,0) + kill TMGcCyan +"RTN","TMGTERM",400,0) + kill TMGcGrey +"RTN","TMGTERM",401,0) + +"RTN","TMGTERM",402,0) + kill TMGcBRed +"RTN","TMGTERM",403,0) + kill TMGcBGreen +"RTN","TMGTERM",404,0) + kill TMGcBYellow +"RTN","TMGTERM",405,0) + kill TMGcBBlue +"RTN","TMGTERM",406,0) + kill TMGcBMagenta +"RTN","TMGTERM",407,0) + kill TMGcBCyan +"RTN","TMGTERM",408,0) + kill TMGcBGrey +"RTN","TMGTERM",409,0) + kill TMGcWhite +"RTN","TMGTERM",410,0) + +"RTN","TMGTERM",411,0) + quit +"RTN","TMGTERM",412,0) + +"RTN","TMGTERM",413,0) +DemoColors +"RTN","TMGTERM",414,0) + ;"Purpose: to write a grid on the screen, showing all the color combos +"RTN","TMGTERM",415,0) + +"RTN","TMGTERM",416,0) + do VTATRIB(1) +"RTN","TMGTERM",417,0) + new fg,bg +"RTN","TMGTERM",418,0) + for bg=1:1:14 do +"RTN","TMGTERM",419,0) + . for fg=1:1:14 do +"RTN","TMGTERM",420,0) + . . if fg=6 quit +"RTN","TMGTERM",421,0) + . . do VCUSAV2 +"RTN","TMGTERM",422,0) + . . do VCOLORS(fg,bg) +"RTN","TMGTERM",423,0) + . . write "/fg=",fg,";bg=",bg,"/ ",! +"RTN","TMGTERM",424,0) + . . do VCULOAD2 +"RTN","TMGTERM",425,0) + . write ! +"RTN","TMGTERM",426,0) + +"RTN","TMGTERM",427,0) + do VCOLORS(4,7) +"RTN","TMGTERM",428,0) + quit +"RTN","TMGTERM",429,0) + +"RTN","TMGTERM",430,0) + +"RTN","TMGTERM",431,0) +DemoClr2 +"RTN","TMGTERM",432,0) + ;"Purpose: to write a grid on the screen, showing all the color combos +"RTN","TMGTERM",433,0) + +"RTN","TMGTERM",434,0) + do VCUSAV2 +"RTN","TMGTERM",435,0) + +"RTN","TMGTERM",436,0) + new fg,bg +"RTN","TMGTERM",437,0) + for bg=1:1:14 do +"RTN","TMGTERM",438,0) + . for fg=1:1:14 do +"RTN","TMGTERM",439,0) + . . do VCOLORS(fg,bg) +"RTN","TMGTERM",440,0) + . . write "Text with background color #",bg," and foreground color #",fg +"RTN","TMGTERM",441,0) + . . do VTATRIB(0) +"RTN","TMGTERM",442,0) + . . write ! +"RTN","TMGTERM",443,0) + +"RTN","TMGTERM",444,0) + do VCULOAD2 +"RTN","TMGTERM",445,0) + quit +"RTN","TMGTERM",446,0) + +"RTN","TMGTIUOJ") +0^82^B11722 +"RTN","TMGTIUOJ",1,0) +TMGTIUOJ ;TMG/kst-Text objects for use in CPRS ;03/25/06 +"RTN","TMGTIUOJ",2,0) + ;;1.0;TMG-LIB;**1**;05/28/08 +"RTN","TMGTIUOJ",3,0) + +"RTN","TMGTIUOJ",4,0) + ;"TMG text objects +"RTN","TMGTIUOJ",5,0) + ;" +"RTN","TMGTIUOJ",6,0) + ;"These are bits of code that return text to be included in progress notes etc. +"RTN","TMGTIUOJ",7,0) + ;"They are called when the user puts text like this in a note: +"RTN","TMGTIUOJ",8,0) + ;" ... Mrs. Jone's vitals today are |VITALS|, measured in the office... +"RTN","TMGTIUOJ",9,0) + ;" 'VITALS' would be a TIU TEXT OBJECT, managed through menu option TIUFJ CREATE OBJECTS MGR +"RTN","TMGTIUOJ",10,0) + +"RTN","TMGTIUOJ",11,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",12,0) + ;"PUBLIC FUNCTIONS +"RTN","TMGTIUOJ",13,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",14,0) + +"RTN","TMGTIUOJ",15,0) + ;"$$VITALS(DFN,.TIU) +"RTN","TMGTIUOJ",16,0) + ;"$$NICENAME(DFN) +"RTN","TMGTIUOJ",17,0) + ;"$$FNAME(DFN) +"RTN","TMGTIUOJ",18,0) + ;"$$MNAME(DFN) +"RTN","TMGTIUOJ",19,0) + ;"$$LNAME(DFN) +"RTN","TMGTIUOJ",20,0) + ;"$$PHONENUM(DFN) +"RTN","TMGTIUOJ",21,0) + ;"$$GETTABLX(DFN,LABEL) +"RTN","TMGTIUOJ",22,0) + ;"$$WTTREND(DFN,.TIU) return text showing patient's trend in change of weight. +"RTN","TMGTIUOJ",23,0) + ;"$$WTDELTA(DFN,.TIU) return text showing patient's change in weight. +"RTN","TMGTIUOJ",24,0) + +"RTN","TMGTIUOJ",25,0) + +"RTN","TMGTIUOJ",26,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",27,0) + ;"PRIVATE FUNCTIONS +"RTN","TMGTIUOJ",28,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",29,0) + ;"FormatVitals(result,s,Label,CurDT,NoteDT) +"RTN","TMGTIUOJ",30,0) + ;"RemoveDT(S,DT) +"RTN","TMGTIUOJ",31,0) + ;"RemoveTime(DT) +"RTN","TMGTIUOJ",32,0) + ;"DateDelta(RefDT,DT) +"RTN","TMGTIUOJ",33,0) + ;"FormatHeight(HtS,PtAge) remove centimeters from patient's height for adults +"RTN","TMGTIUOJ",34,0) + ;"TMGVISDT(TIU) Return a string for date of visit +"RTN","TMGTIUOJ",35,0) + ;"GetLast2(Array,NTLast,Last) Returns last 2 values in array (as created by GetPriorVital) +"RTN","TMGTIUOJ",36,0) + ;"GetPriorVital(DFN,Date,Vital,Array) retrieve a list of prior vital entries for a patient +"RTN","TMGTIUOJ",37,0) + +"RTN","TMGTIUOJ",38,0) + ;"GetNotesList(DFN,List,IncDays) +"RTN","TMGTIUOJ",39,0) + ;"ExtractSpecial(IEN8925,StartMarkerS,EndMarkerS,Array) +"RTN","TMGTIUOJ",40,0) + ;"MergeInto(partArray,masterArray) +"RTN","TMGTIUOJ",41,0) + ;"GetSpecial(DFN,StartMarkerS,EndMarkerS,Months,Array,Mode) +"RTN","TMGTIUOJ",42,0) + +"RTN","TMGTIUOJ",43,0) + ;"Array2Str(Array) convert Array (as created by GetSpecial) into one long string +"RTN","TMGTIUOJ",44,0) + ;"AddIfAbsent(Array,Key,Pivot,Value) add one (empty) entry, if a value for this doesn't already exist. +"RTN","TMGTIUOJ",45,0) + ;"StubRecommendations(DFN,Array,Label) add stubs for recommended studies to Array +"RTN","TMGTIUOJ",46,0) + +"RTN","TMGTIUOJ",47,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",48,0) + ;"--------------------------------------------------------------------------- +"RTN","TMGTIUOJ",49,0) + +"RTN","TMGTIUOJ",50,0) +VITALS(DFN,TIU) +"RTN","TMGTIUOJ",51,0) + ;"Purpose: Return a composite Vitals string like this: +"RTN","TMGTIUOJ",52,0) + ;" T: 98.6 BP: 112/78 R: 17 P: 68 Wt.: 190 Ht.: 76 +"RTN","TMGTIUOJ",53,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",54,0) + ;" TIU -- this is an array created by TIU system that +"RTN","TMGTIUOJ",55,0) + ;" contains information about the document being +"RTN","TMGTIUOJ",56,0) + ;" edited/created. I believe it has this structure: +"RTN","TMGTIUOJ",57,0) + ;" TIU("VSTR") = LOC;VDT;VTYP +"RTN","TMGTIUOJ",58,0) + ;" TIU("VISIT") = Visit File IFN^date? +"RTN","TMGTIUOJ",59,0) + ;" TIU("LOC") +"RTN","TMGTIUOJ",60,0) + ;" TIU("VLOC") +"RTN","TMGTIUOJ",61,0) + ;" TIU("STOP") = mark to defer workload +"RTN","TMGTIUOJ",62,0) + ;" TIU("TYPE")=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT +"RTN","TMGTIUOJ",63,0) + ;" TIU("SVC")=service, e.g. "FAMILY PRACTICE" +"RTN","TMGTIUOJ",64,0) + ;" TIU("EDT")=TIUEDT^DateStr = event begin time: FMDate^DateStr +"RTN","TMGTIUOJ",65,0) + ;" TIU("LDT")=TIULDT^DateStr = event end time: FMDate^DateStr +"RTN","TMGTIUOJ",66,0) + ;" TIU("VSTR")=LOC;VDT;VTYP e.g. "x;x;OFFICE VISIT" +"RTN","TMGTIUOJ",67,0) + ;" TIU("VISIT")=Visit File IFN +"RTN","TMGTIUOJ",68,0) + ;" TIU("LOC")=TIULOC +"RTN","TMGTIUOJ",69,0) + ;" TIU("VLOC")=TIULOC +"RTN","TMGTIUOJ",70,0) + ;" TIU("STOP")=0 ;"0=FALSE, don't worry about stop codes. +"RTN","TMGTIUOJ",71,0) + ;"Output: returns result +"RTN","TMGTIUOJ",72,0) + +"RTN","TMGTIUOJ",73,0) + new result set result="" +"RTN","TMGTIUOJ",74,0) + new CurDT set CurDT="" +"RTN","TMGTIUOJ",75,0) + new NoteDT set NoteDT="" +"RTN","TMGTIUOJ",76,0) + +"RTN","TMGTIUOJ",77,0) + new PtAge +"RTN","TMGTIUOJ",78,0) + do +"RTN","TMGTIUOJ",79,0) + . new IENS,TMGARRAY +"RTN","TMGTIUOJ",80,0) + . set IENS=$get(DFN)_"," +"RTN","TMGTIUOJ",81,0) + . do GETS^DIQ(2,IENS,.033,"TMGARRAY") ;".033 is computed patient age +"RTN","TMGTIUOJ",82,0) + . set PtAge=+$get(TMGARRAY(2,IENS,.033)) ;"will return 0 if not found +"RTN","TMGTIUOJ",83,0) + +"RTN","TMGTIUOJ",84,0) + new Wt,Ht +"RTN","TMGTIUOJ",85,0) + set NoteDT=$$VISDATE^TIULO1(.TIU) ;"Get date of current note (in MM/DD/YY HR:MIN) +"RTN","TMGTIUOJ",86,0) + set NoteDT=$piece(NoteDT," ",1) ;"Drop time +"RTN","TMGTIUOJ",87,0) + set CurDT=NoteDT +"RTN","TMGTIUOJ",88,0) + +"RTN","TMGTIUOJ",89,0) + ;"set result="Resp="_$$RESP^TIULO(+$get(DFN))_", " +"RTN","TMGTIUOJ",90,0) + ;"set result="Pulse="_$$PULSE^TIULO(+$get(DFN))_", " +"RTN","TMGTIUOJ",91,0) + +"RTN","TMGTIUOJ",92,0) + do FormatVitals(.result,$$TEMP^TIULO(+$get(DFN)),"T",.CurDT,.NoteDT) +"RTN","TMGTIUOJ",93,0) + do FormatVitals(.result,$$BP^TIULO(+$get(DFN)),"BP",.CurDT,.NoteDT) +"RTN","TMGTIUOJ",94,0) + do FormatVitals(.result,$$RESP^TIULO(+$get(DFN)),"R",.CurDT,.NoteDT) +"RTN","TMGTIUOJ",95,0) + do FormatVitals(.result,$$PULSE^TIULO(+$get(DFN)),"P",.CurDT,.NoteDT) +"RTN","TMGTIUOJ",96,0) + set Wt=$$WEIGHT^TIULO(+$get(DFN)) +"RTN","TMGTIUOJ",97,0) + set Ht=$$HEIGHT^TIULO(+$get(DFN)) +"RTN","TMGTIUOJ",98,0) + set Ht=$$FormatHeight(Ht,.PtAge) +"RTN","TMGTIUOJ",99,0) + do FormatVitals(.result,Wt,"Wt",.CurDT,.NoteDT,1) +"RTN","TMGTIUOJ",100,0) + if (Wt'="")&(Ht'="") set result=result_$char(10)_$char(9) +"RTN","TMGTIUOJ",101,0) + do FormatVitals(.result,Ht,"Ht",.CurDT,.NoteDT,1) +"RTN","TMGTIUOJ",102,0) + ;"set result=result_";" ;temp!! +"RTN","TMGTIUOJ",103,0) + +"RTN","TMGTIUOJ",104,0) + ;"Now calculate BMI if Wt & Ht available +"RTN","TMGTIUOJ",105,0) + ;" BMI=kg/meters^2 +"RTN","TMGTIUOJ",106,0) + if (Wt'="")&(Ht'="") do +"RTN","TMGTIUOJ",107,0) + . new sWt,sHt +"RTN","TMGTIUOJ",108,0) + . new nWt,nHt,s1,BMI +"RTN","TMGTIUOJ",109,0) + . set sWt=$$RemoveDT(Wt) +"RTN","TMGTIUOJ",110,0) + . set sHt=$$RemoveDT(Ht) +"RTN","TMGTIUOJ",111,0) + . set s1=$piece(sWt,"[",2) ;"convert '200 lb [91.2 kg]' --> '91.2 kg]' +"RTN","TMGTIUOJ",112,0) + . set nWt=+$piece(s1," ",1) ;"convert '91.2 kg]' --> 91.2 +"RTN","TMGTIUOJ",113,0) + . set s1=$piece(sHt,"[",2) ;"convert '56 in [130 cm]' --> '130 cm]' +"RTN","TMGTIUOJ",114,0) + . set nHt=+$piece(s1," ",1) ;"convert '130 cm]' --> 130 +"RTN","TMGTIUOJ",115,0) + . set nHt=nHt/100 ;"convert centimeters to meters +"RTN","TMGTIUOJ",116,0) + . if nHt>0 do +"RTN","TMGTIUOJ",117,0) + . . new tempBMI,iBMI,Digit +"RTN","TMGTIUOJ",118,0) + . . new MSqr set MSqr=(nHt*nHt) +"RTN","TMGTIUOJ",119,0) + . . set tempBMI=(nWt/MSqr) +"RTN","TMGTIUOJ",120,0) + . . set Digit=(((tempBMI-(tempBMI\1))*10)\1)/10 +"RTN","TMGTIUOJ",121,0) + . . set BMI=(tempBMI\1)+Digit +"RTN","TMGTIUOJ",122,0) + . . do FormatVitals(.result,BMI,"BMI",.CurDT) +"RTN","TMGTIUOJ",123,0) + . . if BMI<18.5 do +"RTN","TMGTIUOJ",124,0) + . . . set result=result_" (<18.5 = ""UNDER-WT"")" +"RTN","TMGTIUOJ",125,0) + . . else if BMI<25.01 do +"RTN","TMGTIUOJ",126,0) + . . . set result=result_" (18.5-25 = ""HEALTHY"")" +"RTN","TMGTIUOJ",127,0) + . . else if BMI<30.01 do +"RTN","TMGTIUOJ",128,0) + . . . set result=result_" (25-30 = ""OVER-WT"")" +"RTN","TMGTIUOJ",129,0) + . . else if BMI<40.01 do +"RTN","TMGTIUOJ",130,0) + . . . set result=result_" (30-40 = ""OBESE"")" +"RTN","TMGTIUOJ",131,0) + . . else do +"RTN","TMGTIUOJ",132,0) + . . . set result=result_" (>40 = ""VERY OBESE"")" +"RTN","TMGTIUOJ",133,0) + . . new idealLb1,idealLb2 +"RTN","TMGTIUOJ",134,0) + . . set idealLb1=((18.5*MSqr)*2.2)\1 +"RTN","TMGTIUOJ",135,0) + . . set idealLb2=((25*MSqr)*2.2)\1 +"RTN","TMGTIUOJ",136,0) + . . set result=result_$char(10)_$char(9)_"(Ideal Wt="_idealLb1_"-"_idealLb2_" lbs" +"RTN","TMGTIUOJ",137,0) + . . if Wt>idealLb2 set result=result_"; "_(Wt-idealLb2)_" lbs over weight)" +"RTN","TMGTIUOJ",138,0) + . . else if Wt0)&($get(NoteDT)'="")&($get(ForceShow)'=1) quit ;"If NoteDT specified, don't allow delta>0 +"RTN","TMGTIUOJ",173,0) + . . if (result'="")&($extract(result,$length(result))'=$char(9)) set result=result_", " +"RTN","TMGTIUOJ",174,0) + . . set CurDT=DT +"RTN","TMGTIUOJ",175,0) + . . if (Delta>0)&(DT'="") set result=result_"("_DT_") " +"RTN","TMGTIUOJ",176,0) + . . set result=result_Label_" "_s +"RTN","TMGTIUOJ",177,0) +FVDone +"RTN","TMGTIUOJ",178,0) + quit +"RTN","TMGTIUOJ",179,0) + +"RTN","TMGTIUOJ",180,0) + +"RTN","TMGTIUOJ",181,0) +RemoveDT(S,DT) +"RTN","TMGTIUOJ",182,0) + ;"Purpose: to remove a date-Time string, and return in DT +"RTN","TMGTIUOJ",183,0) + ;" i.e. turn this: +"RTN","TMGTIUOJ",184,0) + ;" 127/56 (12/25/04 16:50) +"RTN","TMGTIUOJ",185,0) + ;" into these: +"RTN","TMGTIUOJ",186,0) + ;" '127/56' and '12/25/04 16:50' +"RTN","TMGTIUOJ",187,0) + ;"Input: S -- a string as above +"RTN","TMGTIUOJ",188,0) + ;" DT -- [Optional] an OUT parameter... must PASS BY REFERENCE +"RTN","TMGTIUOJ",189,0) + ;"result: returns input string with (date-time) removed +"RTN","TMGTIUOJ",190,0) + ;" Date-Time is returned in DT if passed by reference. +"RTN","TMGTIUOJ",191,0) + +"RTN","TMGTIUOJ",192,0) + new result set result=$get(S) +"RTN","TMGTIUOJ",193,0) + if result="" goto RDTDone +"RTN","TMGTIUOJ",194,0) + +"RTN","TMGTIUOJ",195,0) + set result=$piece(S,"(",1) +"RTN","TMGTIUOJ",196,0) + set result=$$Trim^TMGSTUTL(.result) +"RTN","TMGTIUOJ",197,0) + set DT=$piece(S,"(",2) +"RTN","TMGTIUOJ",198,0) + set DT=$piece(DT,")",1) +"RTN","TMGTIUOJ",199,0) + set DT=$$Trim^TMGSTUTL(.DT) +"RTN","TMGTIUOJ",200,0) + +"RTN","TMGTIUOJ",201,0) + quit result +"RTN","TMGTIUOJ",202,0) + +"RTN","TMGTIUOJ",203,0) + +"RTN","TMGTIUOJ",204,0) +RDTDone +"RTN","TMGTIUOJ",205,0) + quit result +"RTN","TMGTIUOJ",206,0) + +"RTN","TMGTIUOJ",207,0) +RemoveTime(DT) +"RTN","TMGTIUOJ",208,0) + ;"Purpose: to remove the time from a date/time string +"RTN","TMGTIUOJ",209,0) + ;"Input: DT -- the date/time string, i.e. '2/24/05 16:50' +"RTN","TMGTIUOJ",210,0) + ;"result: returns just the date, i.e. '2/25/05' +"RTN","TMGTIUOJ",211,0) + +"RTN","TMGTIUOJ",212,0) + new result +"RTN","TMGTIUOJ",213,0) + +"RTN","TMGTIUOJ",214,0) + set result=$piece(DT," ",1) +"RTN","TMGTIUOJ",215,0) + +"RTN","TMGTIUOJ",216,0) + quit result +"RTN","TMGTIUOJ",217,0) + +"RTN","TMGTIUOJ",218,0) + +"RTN","TMGTIUOJ",219,0) +FormatHeight(HtS,PtAge) +"RTN","TMGTIUOJ",220,0) + ;"Purpose: to remove centimeters from patient's height for adults +"RTN","TMGTIUOJ",221,0) + ;"Input: Ht, a height string, e.g. '74 in [154 cm]' +"RTN","TMGTIUOJ",222,0) + ;" PtAge, patient's age in years +"RTN","TMGTIUOJ",223,0) + ;"Result: returns patient height, with [154 cm] removed, if age > 16 +"RTN","TMGTIUOJ",224,0) + +"RTN","TMGTIUOJ",225,0) + new result set result=$get(HtS) +"RTN","TMGTIUOJ",226,0) + +"RTN","TMGTIUOJ",227,0) + if $get(PtAge)'<16 do +"RTN","TMGTIUOJ",228,0) + . set result=$piece(HtS,"[",1) +"RTN","TMGTIUOJ",229,0) + +"RTN","TMGTIUOJ",230,0) + quit result +"RTN","TMGTIUOJ",231,0) + +"RTN","TMGTIUOJ",232,0) + +"RTN","TMGTIUOJ",233,0) +DateDelta(RefDT,DT) +"RTN","TMGTIUOJ",234,0) + ;"Purpose: To determine the number of days between DT and now +"RTN","TMGTIUOJ",235,0) + ;" i.e. How many days DT was before RefDT. +"RTN","TMGTIUOJ",236,0) + ;"Input:RefDT -- a reference/baseline date/time string +"RTN","TMGTIUOJ",237,0) + ;" if not supplied, Current date/time used as default. +"RTN","TMGTIUOJ",238,0) + ;" DT -- a date/time string (i.e. '12/25/04 16:50') +"RTN","TMGTIUOJ",239,0) + ;"Result: Return number of days between DT and RefDT +"RTN","TMGTIUOJ",240,0) + ;" Positive numbers used when DT occured before current date +"RTN","TMGTIUOJ",241,0) + ;" i.e. result=RefDT-DT +"RTN","TMGTIUOJ",242,0) + +"RTN","TMGTIUOJ",243,0) + new iNowDT,iRefDT,iDT ;internal format of dates +"RTN","TMGTIUOJ",244,0) + new result set result=0 +"RTN","TMGTIUOJ",245,0) + +"RTN","TMGTIUOJ",246,0) + ;"write "DT='",DT,"'",! +"RTN","TMGTIUOJ",247,0) + ;"set iDT=$$IDATE^TIULC(.DT) ;"Convert date into internal +"RTN","TMGTIUOJ",248,0) + ;"write "iDT=",iDT,! +"RTN","TMGTIUOJ",249,0) + set X=DT do ^%DT set iDT=Y ;"Convert date into internal +"RTN","TMGTIUOJ",250,0) + if $get(RefDT)="" set iRefDT=$$DT^XLFDT +"RTN","TMGTIUOJ",251,0) + else set X=RefDT do ^%DT set iRefDT=Y ;"Convert date into internal +"RTN","TMGTIUOJ",252,0) + ;"write "iDT=",iDT,! +"RTN","TMGTIUOJ",253,0) + ;"set iNowDT=$$DT^XLFDT +"RTN","TMGTIUOJ",254,0) + ;"write "iNowDT=",iNowDT,! +"RTN","TMGTIUOJ",255,0) + ;"set result=$$FMDIFF^XLFDT(iNowDT,iDT) +"RTN","TMGTIUOJ",256,0) + set result=$$FMDIFF^XLFDT(iRefDT,iDT) +"RTN","TMGTIUOJ",257,0) + +"RTN","TMGTIUOJ",258,0) + quit result +"RTN","TMGTIUOJ",259,0) + +"RTN","TMGTIUOJ",260,0) + +"RTN","TMGTIUOJ",261,0) + +"RTN","TMGTIUOJ",262,0) +TMGVISDT(TIU) ; Visit date +"RTN","TMGTIUOJ",263,0) + ;"Purpose: Return a string for date of visit +"RTN","TMGTIUOJ",264,0) + ;"Note: This is based on the function VISDATE^TIULO1(TIU) +"RTN","TMGTIUOJ",265,0) + ;" However, that function seemed to return the appointment date associated +"RTN","TMGTIUOJ",266,0) + ;" with a note, rather than the specified date of the note +"RTN","TMGTIUOJ",267,0) + ;" Also, this will return date only--not time. +"RTN","TMGTIUOJ",268,0) + ;"Input: TIU -- this is an array created by TIU system that +"RTN","TMGTIUOJ",269,0) + ;" contains information about the document being +"RTN","TMGTIUOJ",270,0) + ;" edited/created. I believe it has this this structure: +"RTN","TMGTIUOJ",271,0) + ;" TIU("VSTR") = LOC;VDT;VTYP +"RTN","TMGTIUOJ",272,0) + ;" TIU("VISIT") = Visit File IFN^date? +"RTN","TMGTIUOJ",273,0) + ;" TIU("LOC") +"RTN","TMGTIUOJ",274,0) + ;" TIU("VLOC") +"RTN","TMGTIUOJ",275,0) + ;" TIU("STOP") = mark to defer workload +"RTN","TMGTIUOJ",276,0) + ;" TIU("TYPE")=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT +"RTN","TMGTIUOJ",277,0) + ;" TIU("SVC")=service, e.g. "FAMILY PRACTICE" +"RTN","TMGTIUOJ",278,0) + ;" TIU("EDT")=TIUEDT^DateStr = event begin time: FMDate^DateStr +"RTN","TMGTIUOJ",279,0) + ;" TIU("LDT")=TIULDT^DateStr = event end time: FMDate^DateStr +"RTN","TMGTIUOJ",280,0) + ;" TIU("VSTR")=LOC;VDT;VTYP e.g. "x;x;OFFICE VISIT" +"RTN","TMGTIUOJ",281,0) + ;" TIU("VISIT")=Visit File IFN +"RTN","TMGTIUOJ",282,0) + ;" TIU("LOC")=TIULOC +"RTN","TMGTIUOJ",283,0) + ;" TIU("VLOC")=TIULOC +"RTN","TMGTIUOJ",284,0) + ;" TIU("STOP")=0 ;"0=FALSE, don't worry about stop codes. +"RTN","TMGTIUOJ",285,0) + ;"Output: returns result +"RTN","TMGTIUOJ",286,0) + +"RTN","TMGTIUOJ",287,0) + N TIUX,TIUY +"RTN","TMGTIUOJ",288,0) + new result +"RTN","TMGTIUOJ",289,0) + +"RTN","TMGTIUOJ",290,0) + ;set result="VISIT="_$get(TIU("VISIT"))_" " +"RTN","TMGTIUOJ",291,0) + ;set result=result_"VSTR="_$get(TIU("VSTR"))_" " +"RTN","TMGTIUOJ",292,0) + ;set result=result_"EDT="_$get(TIU("EDT"))_" " +"RTN","TMGTIUOJ",293,0) + ;set result=result_"LDT="_$get(TIU("LDT"))_" " +"RTN","TMGTIUOJ",294,0) + +"RTN","TMGTIUOJ",295,0) + if $get(TIU("VISIT"))'="" do +"RTN","TMGTIUOJ",296,0) + . set result=$piece(TIU("VISIT"),U,2) +"RTN","TMGTIUOJ",297,0) + else if $get(TIU("VSTR"))'="" do +"RTN","TMGTIUOJ",298,0) + . set result=$piece(TIU("VSTR"),";",2) +"RTN","TMGTIUOJ",299,0) + else do +"RTN","TMGTIUOJ",300,0) + . set result="(Visit Date Unknown)" +"RTN","TMGTIUOJ",301,0) + +"RTN","TMGTIUOJ",302,0) + if +result>0 do +"RTN","TMGTIUOJ",303,0) + . set result=$$DATE^TIULS(result,"MM/DD/YY HR:MIN") +"RTN","TMGTIUOJ",304,0) + . set result=$piece(result," ",1) ;"cut off time. +"RTN","TMGTIUOJ",305,0) + +"RTN","TMGTIUOJ",306,0) +VDDone quit result +"RTN","TMGTIUOJ",307,0) + +"RTN","TMGTIUOJ",308,0) + +"RTN","TMGTIUOJ",309,0) +FNAME(DFN) +"RTN","TMGTIUOJ",310,0) + ;"Purpose: Return Patient's first name +"RTN","TMGTIUOJ",311,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",312,0) + ;"Output: returns result +"RTN","TMGTIUOJ",313,0) + new name +"RTN","TMGTIUOJ",314,0) + +"RTN","TMGTIUOJ",315,0) + set name=$piece($get(^DPT(DFN,0)),"^",1) +"RTN","TMGTIUOJ",316,0) + set name=$piece(name,",",2) +"RTN","TMGTIUOJ",317,0) + set name=$piece(name," ",1) +"RTN","TMGTIUOJ",318,0) + set name=$$CapWords^TMGSTUTL(name) +"RTN","TMGTIUOJ",319,0) + +"RTN","TMGTIUOJ",320,0) + quit name +"RTN","TMGTIUOJ",321,0) + +"RTN","TMGTIUOJ",322,0) + +"RTN","TMGTIUOJ",323,0) +MNAME(DFN) +"RTN","TMGTIUOJ",324,0) + ;"Purpose: Return Patient's middle name(s) +"RTN","TMGTIUOJ",325,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",326,0) + ;"Output: returns result +"RTN","TMGTIUOJ",327,0) + new name +"RTN","TMGTIUOJ",328,0) + +"RTN","TMGTIUOJ",329,0) + set name=$piece($get(^DPT(DFN,0)),"^",1) +"RTN","TMGTIUOJ",330,0) + set name=$piece(name,",",2) +"RTN","TMGTIUOJ",331,0) + set name=$piece(name," ",2,100) +"RTN","TMGTIUOJ",332,0) + set name=$$CapWords^TMGSTUTL(name) +"RTN","TMGTIUOJ",333,0) + +"RTN","TMGTIUOJ",334,0) + quit name +"RTN","TMGTIUOJ",335,0) + +"RTN","TMGTIUOJ",336,0) + +"RTN","TMGTIUOJ",337,0) +LNAME(DFN) +"RTN","TMGTIUOJ",338,0) + ;"Purpose: Return Patient's last name +"RTN","TMGTIUOJ",339,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",340,0) + ;"Output: returns result +"RTN","TMGTIUOJ",341,0) + +"RTN","TMGTIUOJ",342,0) + new name +"RTN","TMGTIUOJ",343,0) + +"RTN","TMGTIUOJ",344,0) + set name=$piece($get(^DPT(DFN,0)),"^",1) +"RTN","TMGTIUOJ",345,0) + set name=$piece(name,",",1) +"RTN","TMGTIUOJ",346,0) + set name=$$CapWords^TMGSTUTL(name) +"RTN","TMGTIUOJ",347,0) + +"RTN","TMGTIUOJ",348,0) + quit name +"RTN","TMGTIUOJ",349,0) + +"RTN","TMGTIUOJ",350,0) + +"RTN","TMGTIUOJ",351,0) +NICENAME(DFN) +"RTN","TMGTIUOJ",352,0) + ;"Purpose: Return Patient's name format: Firstname Middlename Lastname +"RTN","TMGTIUOJ",353,0) + ;" only the first letter of each name capitalized. +"RTN","TMGTIUOJ",354,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",355,0) + ;"Output: returns result +"RTN","TMGTIUOJ",356,0) + +"RTN","TMGTIUOJ",357,0) + new name +"RTN","TMGTIUOJ",358,0) + +"RTN","TMGTIUOJ",359,0) + set name=$piece($get(^DPT(DFN,0)),"^",1) +"RTN","TMGTIUOJ",360,0) + set name=$piece(name,",",2)_" "_$piece(name,",",1) ;"put first name first +"RTN","TMGTIUOJ",361,0) + set name=$$CapWords^TMGSTUTL(name) +"RTN","TMGTIUOJ",362,0) + +"RTN","TMGTIUOJ",363,0) + quit name +"RTN","TMGTIUOJ",364,0) + +"RTN","TMGTIUOJ",365,0) + +"RTN","TMGTIUOJ",366,0) +PHONENUM(DFN) +"RTN","TMGTIUOJ",367,0) + ;"Purpose: to return the patient's phone number +"RTN","TMGTIUOJ",368,0) + ;"Input: DFN -- the patient's unique ID (record#) +"RTN","TMGTIUOJ",369,0) + ;"Output: returns result +"RTN","TMGTIUOJ",370,0) + +"RTN","TMGTIUOJ",371,0) + new result set result="" +"RTN","TMGTIUOJ",372,0) + if +$get(DFN)=0 goto PNDone +"RTN","TMGTIUOJ",373,0) + +"RTN","TMGTIUOJ",374,0) + set result=$$GET1^DIQ(2,DFN_",",.131) +"RTN","TMGTIUOJ",375,0) + +"RTN","TMGTIUOJ",376,0) + set result=$translate(result," ","") +"RTN","TMGTIUOJ",377,0) + if $length(result)=10 do +"RTN","TMGTIUOJ",378,0) + . new temp set temp=result +"RTN","TMGTIUOJ",379,0) + . set result="("_$extract(result,1,3)_") "_$extract(result,4,6)_"-"_$extract(result,7,10) +"RTN","TMGTIUOJ",380,0) + +"RTN","TMGTIUOJ",381,0) + if $length(result)=7 do +"RTN","TMGTIUOJ",382,0) + . new temp set temp=result +"RTN","TMGTIUOJ",383,0) + . set result=$extract(result,1,3)_"-"_$extract(result,4,7) +"RTN","TMGTIUOJ",384,0) + +"RTN","TMGTIUOJ",385,0) +PNDone +"RTN","TMGTIUOJ",386,0) + quit result +"RTN","TMGTIUOJ",387,0) + +"RTN","TMGTIUOJ",388,0) + +"RTN","TMGTIUOJ",389,0) + ;"------------------------------------------------------------- +"RTN","TMGTIUOJ",390,0) + ;"------------------------------------------------------------- +"RTN","TMGTIUOJ",391,0) +WTTREND(DFN,TIU) +"RTN","TMGTIUOJ",392,0) + ;"Purpose: return text showing patient's trend in change of weight. +"RTN","TMGTIUOJ",393,0) + ;" e.g. 215 <== 212 <== 256 <== 278 +"RTN","TMGTIUOJ",394,0) + ;"Input: DFN=the Patient's IEN in file #2 +"RTN","TMGTIUOJ",395,0) + ;" TIU=PASS BY REFERENCE. Should be an Array of TIU note info +"RTN","TMGTIUOJ",396,0) + ;" See documentation in VITALS(DFN,TIU) +"RTN","TMGTIUOJ",397,0) + ;"Results: Returns string describing changes in weight. +"RTN","TMGTIUOJ",398,0) + +"RTN","TMGTIUOJ",399,0) + new result set result="" +"RTN","TMGTIUOJ",400,0) + new Date set Date=$get(TIU("EDT")) +"RTN","TMGTIUOJ",401,0) + if +Date'>0 do +"RTN","TMGTIUOJ",402,0) + . set result="(No wts available)" +"RTN","TMGTIUOJ",403,0) + . goto WTTRDone +"RTN","TMGTIUOJ",404,0) + +"RTN","TMGTIUOJ",405,0) + new Array +"RTN","TMGTIUOJ",406,0) + do GetPriorVital(.DFN,Date,"WEIGHT",.Array) +"RTN","TMGTIUOJ",407,0) + +"RTN","TMGTIUOJ",408,0) + new Date set Date="" +"RTN","TMGTIUOJ",409,0) + for set Date=$order(Array(Date),-1) quit:(+Date'>0) do +"RTN","TMGTIUOJ",410,0) + . if result'="" set result=result_" <== " +"RTN","TMGTIUOJ",411,0) + . set result=result_$order(Array(Date,"")) +"RTN","TMGTIUOJ",412,0) + +"RTN","TMGTIUOJ",413,0) + set result="Wt trend: "_result +"RTN","TMGTIUOJ",414,0) + +"RTN","TMGTIUOJ",415,0) +WTTRDone quit result +"RTN","TMGTIUOJ",416,0) + +"RTN","TMGTIUOJ",417,0) + +"RTN","TMGTIUOJ",418,0) +WTDELTA(DFN,TIU) +"RTN","TMGTIUOJ",419,0) + ;"Purpose: return text showing patient's change in weight. +"RTN","TMGTIUOJ",420,0) + ;"Input: DFN=the Patient's IEN in file #2 +"RTN","TMGTIUOJ",421,0) + ;" TIU=PASS BY REFERENCE. Should be an Array of TIU note info +"RTN","TMGTIUOJ",422,0) + ;" See documentation in VITALS(DFN,TIU) +"RTN","TMGTIUOJ",423,0) + ;"Results: Returns string describing change in weight. +"RTN","TMGTIUOJ",424,0) + +"RTN","TMGTIUOJ",425,0) + new result set result="Weight " +"RTN","TMGTIUOJ",426,0) + new delta +"RTN","TMGTIUOJ",427,0) + new Date set Date=$get(TIU("EDT")) ;"Episode date +"RTN","TMGTIUOJ",428,0) + if +Date'>0 do goto WTDDone +"RTN","TMGTIUOJ",429,0) + . set result=result_"change: ?" +"RTN","TMGTIUOJ",430,0) + +"RTN","TMGTIUOJ",431,0) + new Array +"RTN","TMGTIUOJ",432,0) + do GetPriorVital(.DFN,Date,"WEIGHT",.Array) +"RTN","TMGTIUOJ",433,0) + +"RTN","TMGTIUOJ",434,0) + new NTLast,Last +"RTN","TMGTIUOJ",435,0) + do GetLast2(.Array,.NTLast,.Last) +"RTN","TMGTIUOJ",436,0) + set Last=+Last +"RTN","TMGTIUOJ",437,0) + set NTLast=+NTLast +"RTN","TMGTIUOJ",438,0) + set delta=Last-NTLast +"RTN","TMGTIUOJ",439,0) + if delta>0 set result=result_"up "_delta_" lbs. " +"RTN","TMGTIUOJ",440,0) + else if delta<0 set result=result_"down "_-delta_" lbs. " +"RTN","TMGTIUOJ",441,0) + else do +"RTN","TMGTIUOJ",442,0) + . if Last=0 set result=result_"change: ?" quit +"RTN","TMGTIUOJ",443,0) + . set result=result_"unchanged. " +"RTN","TMGTIUOJ",444,0) + +"RTN","TMGTIUOJ",445,0) + if (Last>0)&(NTLast>0) do +"RTN","TMGTIUOJ",446,0) + . set result=result_"("_Last_" <== "_NTLast_" prior wt)" +"RTN","TMGTIUOJ",447,0) + +"RTN","TMGTIUOJ",448,0) +WTDDone quit result +"RTN","TMGTIUOJ",449,0) + +"RTN","TMGTIUOJ",450,0) + +"RTN","TMGTIUOJ",451,0) +GetLast2(Array,NTLast,Last) +"RTN","TMGTIUOJ",452,0) + ;"Purpose: Returns last 2 values in array (as created by GetPriorVital) +"RTN","TMGTIUOJ",453,0) + ;"Input: Array -- PASS BY REFERENCE. Array as created by GetPriorVital +"RTN","TMGTIUOJ",454,0) + ;" Array(FMDate,Value)="" +"RTN","TMGTIUOJ",455,0) + ;" Array(FMDate,Value)="" +"RTN","TMGTIUOJ",456,0) + ;" NTLast --PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGTIUOJ",457,0) + ;" Next-To-Last value in array list (sorted by ascending date) +"RTN","TMGTIUOJ",458,0) + ;" Last -- PASS BY REFERENCE, an OUT PARAMETER. +"RTN","TMGTIUOJ",459,0) + ;" Last value in array list (sorted by ascending date) +"RTN","TMGTIUOJ",460,0) + ;"Results: None +"RTN","TMGTIUOJ",461,0) + +"RTN","TMGTIUOJ",462,0) + new NTLastDate,LastDate +"RTN","TMGTIUOJ",463,0) + set LastDate="" +"RTN","TMGTIUOJ",464,0) + set LastDate=$order(Array(""),-1) +"RTN","TMGTIUOJ",465,0) + set Last=$order(Array(LastDate,"")) +"RTN","TMGTIUOJ",466,0) + +"RTN","TMGTIUOJ",467,0) + set NTLastDate=$order(Array(LastDate),-1) +"RTN","TMGTIUOJ",468,0) + set NTLast=$order(Array(NTLastDate,"")) +"RTN","TMGTIUOJ",469,0) + +"RTN","TMGTIUOJ",470,0) + quit +"RTN","TMGTIUOJ",471,0) + +"RTN","TMGTIUOJ",472,0) + +"RTN","TMGTIUOJ",473,0) +GetPriorVital(DFN,Date,Vital,Array) +"RTN","TMGTIUOJ",474,0) + ;"Purpose: To retrieve a list of prior vital entries for a patient +"RTN","TMGTIUOJ",475,0) + ;" Note: entries up to *AND INCLUDING* the current day will be retrieved +"RTN","TMGTIUOJ",476,0) + ;"Input: DFN: the IEN of the patient, in file #2 (PATIENT) +"RTN","TMGTIUOJ",477,0) + ;" Date: Date (in FM format) of the current event. Entries up to +"RTN","TMGTIUOJ",478,0) + ;" AND INCLUDING this date will be retrieved. +"RTN","TMGTIUOJ",479,0) + ;" Vital: Vital to retrieve, GMRV VITAL TYPE file (#120.51) +"RTN","TMGTIUOJ",480,0) + ;" Must be .01 value of a valid record +"RTN","TMGTIUOJ",481,0) + ;" E.g. "ABDOMINAL GIRTH","BLOOD PRESSURE","HEIGHT", etc. +"RTN","TMGTIUOJ",482,0) + ;" Array: PASS BY REFERENCE, an OUT PARAMETER. Prior values killed. Format as below. +"RTN","TMGTIUOJ",483,0) + ;"Output: Array is filled as follows: +"RTN","TMGTIUOJ",484,0) + ;" Array(FMDate,Value)="" +"RTN","TMGTIUOJ",485,0) + ;" Array(FMDate,Value)="" +"RTN","TMGTIUOJ",486,0) + ;" Or array will be empty if no values found. +"RTN","TMGTIUOJ",487,0) + ;"Result: None +"RTN","TMGTIUOJ",488,0) + +"RTN","TMGTIUOJ",489,0) + if +$get(DFN)=0 goto GPVDone +"RTN","TMGTIUOJ",490,0) + if +$get(Date)=0 goto GPVDone +"RTN","TMGTIUOJ",491,0) + if $get(Vital)="" goto GPVDone +"RTN","TMGTIUOJ",492,0) + new VitalTIEN +"RTN","TMGTIUOJ",493,0) + set VitalTIEN=+$order(^GMRD(120.51,"B",Vital,"")) +"RTN","TMGTIUOJ",494,0) + if VitalTIEN'>0 goto GPVDone +"RTN","TMGTIUOJ",495,0) + kill Array +"RTN","TMGTIUOJ",496,0) + +"RTN","TMGTIUOJ",497,0) + new IEN set IEN="" +"RTN","TMGTIUOJ",498,0) + new X,X1,X2,%Y +"RTN","TMGTIUOJ",499,0) + for set IEN=$order(^GMR(120.5,"C",DFN,IEN)) quit:(+IEN'>0) do +"RTN","TMGTIUOJ",500,0) + . new s set s=$get(^GMR(120.5,IEN,0)) +"RTN","TMGTIUOJ",501,0) + . if +$piece(s,"^",3)'=VitalTIEN quit +"RTN","TMGTIUOJ",502,0) + . set X1=Date +"RTN","TMGTIUOJ",503,0) + . set X2=+$piece(s,"^",1) +"RTN","TMGTIUOJ",504,0) + . do ^%DTC ;"date delta +"RTN","TMGTIUOJ",505,0) + . if %Y'=1 quit ;"data unworkable +"RTN","TMGTIUOJ",506,0) + . if X>-1 set Array(+$piece(s,"^",1),+$piece(s,"^",8))="" +"RTN","TMGTIUOJ",507,0) + +"RTN","TMGTIUOJ",508,0) +GPVDone quit +"RTN","TMGTIUOJ",509,0) + +"RTN","TMGTIUOJ",510,0) + ;"------------------------------------------------------------- +"RTN","TMGTIUOJ",511,0) + ;"------------------------------------------------------------- +"RTN","TMGTIUOJ",512,0) + +"RTN","TMGTIUOJ",513,0) +GetNotesList(DFN,List,IncDays) +"RTN","TMGTIUOJ",514,0) + ;"Purpose: Return a list of notes for patient in given time span +"RTN","TMGTIUOJ",515,0) + ;"Input: DFN -- IEN in PATIENT file (the patient record number) +"RTN","TMGTIUOJ",516,0) + ;" List -- PASS BY REFERENCE, an OUT PARAMETER. (Format below) +"RTN","TMGTIUOJ",517,0) + ;" IncDays -- Number of DAYS to search in. +"RTN","TMGTIUOJ",518,0) + ;" E.g. 4 --> get notes from last 4 days +"RTN","TMGTIUOJ",519,0) + ;"Output: List format: +"RTN","TMGTIUOJ",520,0) + ;" List(FMTimeOfNote,IEN8925)="" +"RTN","TMGTIUOJ",521,0) + ;" List(FMTimeOfNote,IEN8925)="" +"RTN","TMGTIUOJ",522,0) + ;" List(FMTimeOfNote,IEN8925)="" +"RTN","TMGTIUOJ",523,0) + ;" If no notes found, then array is left blank. Prior entries KILLED +"RTN","TMGTIUOJ",524,0) + ;"Results: none +"RTN","TMGTIUOJ",525,0) + +"RTN","TMGTIUOJ",526,0) + kill List +"RTN","TMGTIUOJ",527,0) + set DFN=+$get(DFN) +"RTN","TMGTIUOJ",528,0) + if DFN'>0 goto GNLDone +"RTN","TMGTIUOJ",529,0) + set IncDays=+$get(IncDays) +"RTN","TMGTIUOJ",530,0) + new temp,i +"RTN","TMGTIUOJ",531,0) + merge temp=^TIU(8925,"C",DFN) +"RTN","TMGTIUOJ",532,0) + set IEN="" +"RTN","TMGTIUOJ",533,0) + for set IEN=$order(temp(IEN)) quit:(IEN="") do +"RTN","TMGTIUOJ",534,0) + . new X,X1,X2,%Y,StartDate +"RTN","TMGTIUOJ",535,0) + . do NOW^%DTC set X1=X +"RTN","TMGTIUOJ",536,0) + . set StartDate=$piece($get(^TIU(8925,IEN,0)),"^",7) +"RTN","TMGTIUOJ",537,0) + . set X2=StartDate +"RTN","TMGTIUOJ",538,0) + . do ^%DTC ;"calculate X=X1-X2. Returns #days between +"RTN","TMGTIUOJ",539,0) + . if X>IncDays quit +"RTN","TMGTIUOJ",540,0) + . set List(StartDate,IEN)="" +"RTN","TMGTIUOJ",541,0) + +"RTN","TMGTIUOJ",542,0) +GNLDone quit +"RTN","TMGTIUOJ",543,0) + +"RTN","TMGTIUOJ",544,0) + +"RTN","TMGTIUOJ",545,0) +ExtractSpecial(IEN8925,StartMarkerS,EndMarkerS,Array) +"RTN","TMGTIUOJ",546,0) + ;"Purpose: To scan the REPORT TEXT field in given document and return +"RTN","TMGTIUOJ",547,0) + ;" paragraph of text that is started by StartMarkerS, and ended by EndMarkerS. +"RTN","TMGTIUOJ",548,0) + ;" I.E. Search for a line that contains MarkerS. Return that line and +"RTN","TMGTIUOJ",549,0) + ;" all following lines until line found with EndMarkerS, or +"RTN","TMGTIUOJ",550,0) + ;" end of text. +"RTN","TMGTIUOJ",551,0) + ;"Input: IEN8925 -- IEN in file 8925 (TIU DOCUMENT) +"RTN","TMGTIUOJ",552,0) + ;" StartMarkerS -- the string to search for that indicates start of block +"RTN","TMGTIUOJ",553,0) + ;" EndMarkerS -- the string to search for that indicates the end of block. +"RTN","TMGTIUOJ",554,0) + ;" NOTE: if EndMarkerS="BLANK_LINE", then search is +"RTN","TMGTIUOJ",555,0) + ;" ended when a blank line is encountered. +"RTN","TMGTIUOJ",556,0) + ;" Array -- PASS BY REFERENCE, an OUT PARAMETER. Prior values killed. +"RTN","TMGTIUOJ",557,0) + ;" Format: Array(0)=MaxLineCount +"RTN","TMGTIUOJ",558,0) + ;" Array(1)="Text line 1" +"RTN","TMGTIUOJ",559,0) + ;" Array(2)="Text line 2" ... +"RTN","TMGTIUOJ",560,0) + ;"Result: 1 if data found, otherwise 0 +"RTN","TMGTIUOJ",561,0) + +"RTN","TMGTIUOJ",562,0) + new result set result=0 +"RTN","TMGTIUOJ",563,0) + kill Array +"RTN","TMGTIUOJ",564,0) + set IEN8925=+$get(IEN8925) +"RTN","TMGTIUOJ",565,0) + if IEN8925'>0 goto ESDone +"RTN","TMGTIUOJ",566,0) + if $data(^TIU(8925,IEN8925,"TEXT"))'>0 goto ESDone +"RTN","TMGTIUOJ",567,0) + if $get(StartMarkerS)="" goto ESDone +"RTN","TMGTIUOJ",568,0) + if $get(EndMarkerS)="" goto ESDone +"RTN","TMGTIUOJ",569,0) + new line,i,BlockFound,Done +"RTN","TMGTIUOJ",570,0) + set line=0,i=0,BlockFound=0,Done=0 +"RTN","TMGTIUOJ",571,0) + for set line=$order(^TIU(8925,IEN8925,"TEXT",line)) quit:(line="")!Done do +"RTN","TMGTIUOJ",572,0) + . new lineS set lineS=$get(^TIU(8925,IEN8925,"TEXT",line,0)) +"RTN","TMGTIUOJ",573,0) + . if (BlockFound=0) do quit ;"don't include header line with output +"RTN","TMGTIUOJ",574,0) + . . if lineS[StartMarkerS set BlockFound=1 +"RTN","TMGTIUOJ",575,0) + . if (BlockFound=1) do +"RTN","TMGTIUOJ",576,0) + . . set i=i+1,Array(0)=i +"RTN","TMGTIUOJ",577,0) + . . new s2 set s2=$$Trim^TMGSTUTL(lineS," ") +"RTN","TMGTIUOJ",578,0) + . . set s2=$$Trim^TMGSTUTL(s2,$char(9)) +"RTN","TMGTIUOJ",579,0) + . . set Array(i)=lineS +"RTN","TMGTIUOJ",580,0) + . . if s2="" set Array(i)=s2 +"RTN","TMGTIUOJ",581,0) + . . set result=1 +"RTN","TMGTIUOJ",582,0) + . . if (EndMarkerS="BLANK_LINE")&(s2="") set BlockFound=0,Done=1 quit +"RTN","TMGTIUOJ",583,0) + . . if lineS[EndMarkerS set BlockFound=0,Done=1 quit ;"include line with END marker +"RTN","TMGTIUOJ",584,0) + +"RTN","TMGTIUOJ",585,0) +ESDone quit result +"RTN","TMGTIUOJ",586,0) + +"RTN","TMGTIUOJ",587,0) + +"RTN","TMGTIUOJ",588,0) +MergeInto(partArray,masterArray) +"RTN","TMGTIUOJ",589,0) + ;"Purpose: to combine partArray into MasterArray. +"RTN","TMGTIUOJ",590,0) + ;"Input: partArray -- PASS BY REFERENCE +"RTN","TMGTIUOJ",591,0) + ;" masterArray -- PASS BY REFERENCE +"RTN","TMGTIUOJ",592,0) + ;"Note: Arrays are combine in a 'transparent' manner such that newer entries +"RTN","TMGTIUOJ",593,0) + ;" will overwrite older entries only for identical values. For example: +"RTN","TMGTIUOJ",594,0) + ;" -- BLOCK -- <--- MasterArray +"RTN","TMGTIUOJ",595,0) + ;" TSH = 1.56 +"RTN","TMGTIUOJ",596,0) + ;" LDL = 140 +"RTN","TMGTIUOJ",597,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",598,0) + ;" +"RTN","TMGTIUOJ",599,0) + ;" -- BLOCK -- <--- partArray +"RTN","TMGTIUOJ",600,0) + ;" LDL = 150 +"RTN","TMGTIUOJ",601,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",602,0) + ;" +"RTN","TMGTIUOJ",603,0) + ;" The above two blocks will result in this final array +"RTN","TMGTIUOJ",604,0) + ;" -- BLOCK -- +"RTN","TMGTIUOJ",605,0) + ;" TSH = 1.56 +"RTN","TMGTIUOJ",606,0) + ;" LDL = 150 <--- this value overwrote older entry +"RTN","TMGTIUOJ",607,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",608,0) + ;" +"RTN","TMGTIUOJ",609,0) + ;" In this mode, only data that is in a LABEL <--> VALUE format +"RTN","TMGTIUOJ",610,0) + ;" will be checked for newer vs older entries. All other +"RTN","TMGTIUOJ",611,0) + ;" lines will simply be included in one large summation block. +"RTN","TMGTIUOJ",612,0) + ;" And the allowed format for LABEL <--> VALUE will be: +"RTN","TMGTIUOJ",613,0) + ;" Label = value or +"RTN","TMGTIUOJ",614,0) + ;" Label : value +"RTN","TMGTIUOJ",615,0) + ;" +"RTN","TMGTIUOJ",616,0) + ;"Output: MasterArray will be filled as follows: +"RTN","TMGTIUOJ",617,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",618,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",619,0) + ;" Array("KEY-VALUE",KeyName)=Value +"RTN","TMGTIUOJ",620,0) + ;" Array("KEY-VALUE",KeyName,"LINE")=original line +"RTN","TMGTIUOJ",621,0) + +"RTN","TMGTIUOJ",622,0) + new lineNum set lineNum=0 +"RTN","TMGTIUOJ",623,0) + for set lineNum=$order(tempArray(lineNum)) quit:(+lineNum'>0) do +"RTN","TMGTIUOJ",624,0) + . new line set line=$get(tempArray(lineNum)) +"RTN","TMGTIUOJ",625,0) + . if (line["=")!(line[":") do +"RTN","TMGTIUOJ",626,0) + . . new key,shortKey,value,pivot +"RTN","TMGTIUOJ",627,0) + . . if line["=" set pivot="=" +"RTN","TMGTIUOJ",628,0) + . . else set pivot=":" +"RTN","TMGTIUOJ",629,0) + . . set key=$piece(line,pivot,1) +"RTN","TMGTIUOJ",630,0) + . . set shortKey=$$UP^XLFSTR($$Trim^TMGSTUTL(key)) +"RTN","TMGTIUOJ",631,0) + . . set value=$piece(line,pivot,2,999) +"RTN","TMGTIUOJ",632,0) + . . set Array("KEY-VALUE",shortKey)=value +"RTN","TMGTIUOJ",633,0) + . . set Array("KEY-VALUE",shortKey,"LINE")=line +"RTN","TMGTIUOJ",634,0) + . else do +"RTN","TMGTIUOJ",635,0) + . . if line="" quit +"RTN","TMGTIUOJ",636,0) + . . set Array(line)="" +"RTN","TMGTIUOJ",637,0) + +"RTN","TMGTIUOJ",638,0) + quit +"RTN","TMGTIUOJ",639,0) + +"RTN","TMGTIUOJ",640,0) + +"RTN","TMGTIUOJ",641,0) +GetSpecial(DFN,StartMarkerS,EndMarkerS,Months,Array,Mode) +"RTN","TMGTIUOJ",642,0) + ;"Purpose: to return a block of text from notes for patient, starting with +"RTN","TMGTIUOJ",643,0) + ;" StartMarkerS, and ending with EndMarkerS, searching backwards +"RTN","TMGTIUOJ",644,0) + ;" within time period of 'Months'. +"RTN","TMGTIUOJ",645,0) + ;"Input: DFN -- IEN of patient in PATIENT file. +"RTN","TMGTIUOJ",646,0) + ;" StartMarkerS -- the string to search for that indicates start of block +"RTN","TMGTIUOJ",647,0) + ;" EndMarkerS -- the string to search for that indicates the end of block. +"RTN","TMGTIUOJ",648,0) + ;" NOTE: if EndMarkerS="BLANK_LINE", then search is +"RTN","TMGTIUOJ",649,0) + ;" ended when a blank line is encountered. +"RTN","TMGTIUOJ",650,0) + ;" Months -- Number of Months to search in. +"RTN","TMGTIUOJ",651,0) + ;" E.g. 4 --> search in notes from last 4 months +"RTN","TMGTIUOJ",652,0) + ;" Array -- PASS BY REFERENCE. an OUT PARAMETER. Old values killed. Format below +"RTN","TMGTIUOJ",653,0) + ;" Mode: operation mode. As follows: +"RTN","TMGTIUOJ",654,0) + ;" 1 = return only block from most recent match +"RTN","TMGTIUOJ",655,0) + ;" 2 = compile all. +"RTN","TMGTIUOJ",656,0) + ;" In this mode, the search is carried out from oldest to most +"RTN","TMGTIUOJ",657,0) + ;" recent, and newer blocks overlay older ones in a 'transparent' +"RTN","TMGTIUOJ",658,0) + ;" manner such that newer entries will overwrite older entries +"RTN","TMGTIUOJ",659,0) + ;" only for identical values. For example: +"RTN","TMGTIUOJ",660,0) + ;" -- BLOCK -- <--- from date 1/1/1980 +"RTN","TMGTIUOJ",661,0) + ;" TSH = 1.56 +"RTN","TMGTIUOJ",662,0) + ;" LDL = 140 +"RTN","TMGTIUOJ",663,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",664,0) + ;" +"RTN","TMGTIUOJ",665,0) + ;" -- BLOCK -- <--- from date 2/1/1980 +"RTN","TMGTIUOJ",666,0) + ;" LDL = 150 +"RTN","TMGTIUOJ",667,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",668,0) + ;" +"RTN","TMGTIUOJ",669,0) + ;" The above two blocks will result in this final block +"RTN","TMGTIUOJ",670,0) + ;" -- BLOCK -- +"RTN","TMGTIUOJ",671,0) + ;" TSH = 1.56 +"RTN","TMGTIUOJ",672,0) + ;" LDL = 150 <--- this value overwrote older entry +"RTN","TMGTIUOJ",673,0) + ;" -- END BLOCK -- +"RTN","TMGTIUOJ",674,0) + ;" +"RTN","TMGTIUOJ",675,0) + ;" In this mode, only data that is in a LABEL <--> VALUE format +"RTN","TMGTIUOJ",676,0) + ;" will be checked for newer vs older entries. All other +"RTN","TMGTIUOJ",677,0) + ;" lines will simply be included in one large summation block. +"RTN","TMGTIUOJ",678,0) + ;" And the allowed format for LABEL <--> VALUE will be: +"RTN","TMGTIUOJ",679,0) + ;" Label = value or +"RTN","TMGTIUOJ",680,0) + ;" Label : value +"RTN","TMGTIUOJ",681,0) + ;" +"RTN","TMGTIUOJ",682,0) + ;"Output: Array will be filled as follows: +"RTN","TMGTIUOJ",683,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",684,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",685,0) + ;" Array("KEY-VALUE",KeyName)=Value +"RTN","TMGTIUOJ",686,0) + ;" Array("KEY-VALUE",KeyName,"LINE")=original line +"RTN","TMGTIUOJ",687,0) + +"RTN","TMGTIUOJ",688,0) + ;"Results: none +"RTN","TMGTIUOJ",689,0) + +"RTN","TMGTIUOJ",690,0) + new NotesList +"RTN","TMGTIUOJ",691,0) + kill Array +"RTN","TMGTIUOJ",692,0) + set DFN=+$get(DFN) +"RTN","TMGTIUOJ",693,0) + if DFN'>0 goto GSDone +"RTN","TMGTIUOJ",694,0) + +"RTN","TMGTIUOJ",695,0) + new IncDays set IncDays=+$get(Months)*30 +"RTN","TMGTIUOJ",696,0) + do GetNotesList(DFN,.NotesList,IncDays) +"RTN","TMGTIUOJ",697,0) + +"RTN","TMGTIUOJ",698,0) + new direction +"RTN","TMGTIUOJ",699,0) + if Mode=2 set direction=-1 +"RTN","TMGTIUOJ",700,0) + new Done set Done=0 +"RTN","TMGTIUOJ",701,0) + new StartTime set StartTime="" +"RTN","TMGTIUOJ",702,0) + for set StartTime=$order(NotesList(StartTime),direction) quit:(StartTime="")!Done do +"RTN","TMGTIUOJ",703,0) + . new IEN8925 set IEN8925="" +"RTN","TMGTIUOJ",704,0) + . for set IEN8925=$order(NotesList(StartTime,IEN8925)) quit:(+IEN8925'>0)!Done do +"RTN","TMGTIUOJ",705,0) + . . new tempArray +"RTN","TMGTIUOJ",706,0) + . . if $$ExtractSpecial(IEN8925,.StartMarkerS,.EndMarkerS,.tempArray)=1 do +"RTN","TMGTIUOJ",707,0) + . . . if Mode=1 do +"RTN","TMGTIUOJ",708,0) + . . . . merge Array=tempArray +"RTN","TMGTIUOJ",709,0) + . . . . set Done=1 +"RTN","TMGTIUOJ",710,0) + . . . else do +"RTN","TMGTIUOJ",711,0) + . . . . do MergeInto(.tempArray,.Array) +"RTN","TMGTIUOJ",712,0) + +"RTN","TMGTIUOJ",713,0) +GSDone +"RTN","TMGTIUOJ",714,0) + quit +"RTN","TMGTIUOJ",715,0) + +"RTN","TMGTIUOJ",716,0) + +"RTN","TMGTIUOJ",717,0) +Array2Str(Array) +"RTN","TMGTIUOJ",718,0) + ;"Purpose: to convert Array (as created by GetSpecial) into one long string +"RTN","TMGTIUOJ",719,0) + ;"Input: Array. Format as follows: +"RTN","TMGTIUOJ",720,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",721,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",722,0) + ;" Array("KEY-VALUE",KeyName)=Value +"RTN","TMGTIUOJ",723,0) + ;" Array("KEY-VALUE",KeyName,"LINE")=original line +"RTN","TMGTIUOJ",724,0) + +"RTN","TMGTIUOJ",725,0) + new result set result="" +"RTN","TMGTIUOJ",726,0) + new keyName set keyName="" +"RTN","TMGTIUOJ",727,0) + +"RTN","TMGTIUOJ",728,0) + ;"First, put in key-value lines +"RTN","TMGTIUOJ",729,0) + for set keyName=$order(Array("KEY-VALUE",keyName)) quit:(keyName="") do +"RTN","TMGTIUOJ",730,0) + . new line +"RTN","TMGTIUOJ",731,0) + . set line=$get(Array("KEY-VALUE",keyName,"LINE")) +"RTN","TMGTIUOJ",732,0) + . if result'="" set result=result_$char(13)_$char(10) +"RTN","TMGTIUOJ",733,0) + . set result=result_line +"RTN","TMGTIUOJ",734,0) + kill Array("KEY-VALUE") +"RTN","TMGTIUOJ",735,0) + +"RTN","TMGTIUOJ",736,0) + ;"Next, put standard lines +"RTN","TMGTIUOJ",737,0) + new line set line="" +"RTN","TMGTIUOJ",738,0) + for set line=$order(Array(line)) quit:(line="") do +"RTN","TMGTIUOJ",739,0) + . if result'="" set result=result_$char(13)_$char(10) +"RTN","TMGTIUOJ",740,0) + . set result=result_line +"RTN","TMGTIUOJ",741,0) + +"RTN","TMGTIUOJ",742,0) + quit result +"RTN","TMGTIUOJ",743,0) + +"RTN","TMGTIUOJ",744,0) + +"RTN","TMGTIUOJ",745,0) +AddIfAbsent(Array,Key,Pivot,Value) +"RTN","TMGTIUOJ",746,0) + ;"Purpose: to add one (empty) entry, if a value for this doesn't already exist. +"RTN","TMGTIUOJ",747,0) + ;"Input: Array. Format as follows: +"RTN","TMGTIUOJ",748,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",749,0) + ;" Array("text line")="" +"RTN","TMGTIUOJ",750,0) + ;" Array("KEY-VALUE",KeyName)=Value +"RTN","TMGTIUOJ",751,0) + ;" Array("KEY-VALUE",KeyName,"LINE")=original line +"RTN","TMGTIUOJ",752,0) + ;" Key -- the name of the study +"RTN","TMGTIUOJ",753,0) + ;" Pivot -- ":", or "=" OPTIONAL. Default = ":" +"RTN","TMGTIUOJ",754,0) + ;" Value -- the description of the needed value. OPTIONAL. +"RTN","TMGTIUOJ",755,0) + ;" default value = '' +"RTN","TMGTIUOJ",756,0) + +"RTN","TMGTIUOJ",757,0) + +"RTN","TMGTIUOJ",758,0) + set Pivot=$get(Pivot,":") +"RTN","TMGTIUOJ",759,0) + set Value=$get(Value,"") +"RTN","TMGTIUOJ",760,0) + if $get(Key)="" goto AIADone +"RTN","TMGTIUOJ",761,0) + new UpKey set UpKey=$$UP^XLFSTR(Key) +"RTN","TMGTIUOJ",762,0) + if $data(Array("KEY-VALUE",UpKey))>0 goto AIADone +"RTN","TMGTIUOJ",763,0) + +"RTN","TMGTIUOJ",764,0) + set Array("KEY-VALUE",UpKey)=$get(Value) +"RTN","TMGTIUOJ",765,0) + new line set line=" "_$get(Key)_" "_$get(Pivot)_" "_$get(Value) +"RTN","TMGTIUOJ",766,0) + set Array("KEY-VALUE",UpKey,"LINE")=line +"RTN","TMGTIUOJ",767,0) + +"RTN","TMGTIUOJ",768,0) +AIADone +"RTN","TMGTIUOJ",769,0) + quit +"RTN","TMGTIUOJ",770,0) + +"RTN","TMGTIUOJ",771,0) + +"RTN","TMGTIUOJ",772,0) +StubRecommendations(DFN,Array,Label) +"RTN","TMGTIUOJ",773,0) + ;"Purpose: to add stubs for recommended studies to Array +"RTN","TMGTIUOJ",774,0) + +"RTN","TMGTIUOJ",775,0) + ;"Get age from DFN +"RTN","TMGTIUOJ",776,0) + if +$get(DFN)=0 goto SRDone +"RTN","TMGTIUOJ",777,0) + new Age set Age=+$$GET1^DIQ(2,DFN,.033) +"RTN","TMGTIUOJ",778,0) + new Sex set Sex=$$GET1^DIQ(2,DFN,.02) +"RTN","TMGTIUOJ",779,0) + +"RTN","TMGTIUOJ",780,0) + if Label="[STUDIES]" do +"RTN","TMGTIUOJ",781,0) + . if (Sex="FEMALE") do +"RTN","TMGTIUOJ",782,0) + . . if (Age>39) do AddIfAbsent(.Array,"Mammogram") +"RTN","TMGTIUOJ",783,0) + . . if (Age>49) do AddIfAbsent(.Array,"Bone Density") +"RTN","TMGTIUOJ",784,0) + . . do AddIfAbsent(.Array,"Pap") +"RTN","TMGTIUOJ",785,0) + . . if (Age>8)&(Age<27) do AddIfAbsent(.Array,"Gardasil",":","#1 ; #2 ; #3 ") +"RTN","TMGTIUOJ",786,0) + . if (Sex="MALE")&(Age>49) do AddIfAbsent(.Array,"PSA") +"RTN","TMGTIUOJ",787,0) + . if Age>64 do AddIfAbsent(.Array,"Pneumovax") +"RTN","TMGTIUOJ",788,0) + . if (Age>18) do AddIfAbsent(.Array,"Advance Directives") +"RTN","TMGTIUOJ",789,0) + . if (Age>49) do AddIfAbsent(.Array,"Td") +"RTN","TMGTIUOJ",790,0) + . if (Age>67) do AddIfAbsent(.Array,"Zostavax") +"RTN","TMGTIUOJ",791,0) + . if (Age>1)&(Age<21) do AddIfAbsent(.Array,"Varivax",":","#1 ; #2 ") +"RTN","TMGTIUOJ",792,0) + . if (Age>10)&(Age<50) do AddIfAbsent(.Array,"TdaP / Td") +"RTN","TMGTIUOJ",793,0) + . if (Age>10)&(Age<23) do AddIfAbsent(.Array,"MCV4 (Menactra)") +"RTN","TMGTIUOJ",794,0) + . if (Age>50) do AddIfAbsent(.Array,"Colonoscopy") +"RTN","TMGTIUOJ",795,0) + else if Label="[DIABETIC STUDIES]" do +"RTN","TMGTIUOJ",796,0) + . do AddIfAbsent(.Array,"HgbA1c","=") +"RTN","TMGTIUOJ",797,0) + . do AddIfAbsent(.Array,"Diabetic Eye Exam") +"RTN","TMGTIUOJ",798,0) + . do AddIfAbsent(.Array,"Urine Microalbumin") +"RTN","TMGTIUOJ",799,0) + . do AddIfAbsent(.Array,"Diabetic Foot Exam") +"RTN","TMGTIUOJ",800,0) + . do AddIfAbsent(.Array,"EKG") +"RTN","TMGTIUOJ",801,0) + else if Label="[LIPIDS]" do +"RTN","TMGTIUOJ",802,0) + . do AddIfAbsent(.Array,"Total Cholesterol","=") +"RTN","TMGTIUOJ",803,0) + . do AddIfAbsent(.Array,"LDL Cholesterol","=") +"RTN","TMGTIUOJ",804,0) + . do AddIfAbsent(.Array,"HDL Cholesterol","=") +"RTN","TMGTIUOJ",805,0) + . do AddIfAbsent(.Array,"Triglycerides","=") +"RTN","TMGTIUOJ",806,0) + else if Label="[SOCIAL]" do +"RTN","TMGTIUOJ",807,0) + . do AddIfAbsent(.Array,"Tobacco") +"RTN","TMGTIUOJ",808,0) + . do AddIfAbsent(.Array,"EtOH") +"RTN","TMGTIUOJ",809,0) + +"RTN","TMGTIUOJ",810,0) +SRDone +"RTN","TMGTIUOJ",811,0) + quit +"RTN","TMGTIUOJ",812,0) + +"RTN","TMGTIUOJ",813,0) + +"RTN","TMGTIUOJ",814,0) +GETTABLX(DFN,LABEL) +"RTN","TMGTIUOJ",815,0) + ;"Purpose: A call point for TIU objects, to return a table comprised from +"RTN","TMGTIUOJ",816,0) + ;" prior notes. +"RTN","TMGTIUOJ",817,0) + +"RTN","TMGTIUOJ",818,0) + new Array,result +"RTN","TMGTIUOJ",819,0) + if $get(LABEL)="" goto GTXDone +"RTN","TMGTIUOJ",820,0) + set result=" -- "_LABEL_" ---------"_$CHAR(13)_$CHAR(10) +"RTN","TMGTIUOJ",821,0) + do GetSpecial(DFN,LABEL,"BLANK_LINE",13,.Array,2) +"RTN","TMGTIUOJ",822,0) + do StubRecommendations(.DFN,.Array,LABEL) +"RTN","TMGTIUOJ",823,0) + set result=result_$$Array2Str(.Array) +"RTN","TMGTIUOJ",824,0) +GTXDone +"RTN","TMGTIUOJ",825,0) + quit result +"RTN","TMGTIUOJ",826,0) + +"RTN","TMGTRAN1") +0^83^B2382006 +"RTN","TMGTRAN1",1,0) +TMGTRAN1 ;TMG/kst/TRANSCRIPTION REPORT FUNCTIONS -- UI ;03/25/06 +"RTN","TMGTRAN1",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGTRAN1",3,0) + +"RTN","TMGTRAN1",4,0) + ;" TRANSCRIPTION REPORT FUNCTIONS +"RTN","TMGTRAN1",5,0) + +"RTN","TMGTRAN1",6,0) + ;"======================================================================= +"RTN","TMGTRAN1",7,0) + ;" API -- Public Functions. +"RTN","TMGTRAN1",8,0) + ;"======================================================================= +"RTN","TMGTRAN1",9,0) + ;"RPTCUR +"RTN","TMGTRAN1",10,0) + ;"RPTASK +"RTN","TMGTRAN1",11,0) + ;"RPTQUIET(OPTIONS) +"RTN","TMGTRAN1",12,0) + ;"FREECUR +"RTN","TMGTRAN1",13,0) + ;"FREEASK +"RTN","TMGTRAN1",14,0) + ;"ScanSign(OPTIONS,SIGNED) +"RTN","TMGTRAN1",15,0) + ;"PWDSNOOP(IEN) +"RTN","TMGTRAN1",16,0) + ;"SHOWUNSIGNED +"RTN","TMGTRAN1",17,0) + ;"SIGNDOC(DocIEN,OPTIONS) +"RTN","TMGTRAN1",18,0) + ;"PRINT(DocArray) ; Prompt and print, or array +"RTN","TMGTRAN1",19,0) + +"RTN","TMGTRAN1",20,0) + +"RTN","TMGTRAN1",21,0) + +"RTN","TMGTRAN1",22,0) + ;"======================================================================= +"RTN","TMGTRAN1",23,0) + ;" Private Functions. +"RTN","TMGTRAN1",24,0) + ;"======================================================================= +"RTN","TMGTRAN1",25,0) + ;"AskDatesRPT(Options) +"RTN","TMGTRAN1",26,0) + ;"FreeDocs(AuthorIEN,ShowDetails) +"RTN","TMGTRAN1",27,0) + +"RTN","TMGTRAN1",28,0) + ;"======================================================================= +"RTN","TMGTRAN1",29,0) +RPTCUR +"RTN","TMGTRAN1",30,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",31,0) + ;"Purpose: To report transcription productivity for the current user (DUZ) +"RTN","TMGTRAN1",32,0) + ;"Input: none. User will be asked for start and end dates +"RTN","TMGTRAN1",33,0) + ;"Output: Produces a report to choses output channel. +"RTN","TMGTRAN1",34,0) + +"RTN","TMGTRAN1",35,0) + new Options +"RTN","TMGTRAN1",36,0) + +"RTN","TMGTRAN1",37,0) + write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!! +"RTN","TMGTRAN1",38,0) + write "Showing credit for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! +"RTN","TMGTRAN1",39,0) + +"RTN","TMGTRAN1",40,0) + set Options("TRANS")=DUZ +"RTN","TMGTRAN1",41,0) + do AskDatesRPT(.Options) +"RTN","TMGTRAN1",42,0) + +"RTN","TMGTRAN1",43,0) + quit +"RTN","TMGTRAN1",44,0) + +"RTN","TMGTRAN1",45,0) +RPTASK +"RTN","TMGTRAN1",46,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",47,0) + ;"Purpose: To report transcription productivity for a chosen user +"RTN","TMGTRAN1",48,0) + ;"Input: none. User will be asked for the user to report on, and also +"RTN","TMGTRAN1",49,0) + ;" start and end dates +"RTN","TMGTRAN1",50,0) + ;"Output: Produces a report to choses output channel. +"RTN","TMGTRAN1",51,0) + +"RTN","TMGTRAN1",52,0) + new Options +"RTN","TMGTRAN1",53,0) + +"RTN","TMGTRAN1",54,0) + ;"set TMGDEBUG=1 ;"TEMP!!! +"RTN","TMGTRAN1",55,0) + +"RTN","TMGTRAN1",56,0) + write !,"-- TRANSCRIPTION PRODUCTIVITY CREDIT REPORT -- ",!! +"RTN","TMGTRAN1",57,0) + +"RTN","TMGTRAN1",58,0) + set DIC=200 ;"NEW PERSON file +"RTN","TMGTRAN1",59,0) + set DIC(0)="MAQE" +"RTN","TMGTRAN1",60,0) + set DIC("A")="Enter name of transcriptionist (^ to abort): " +"RTN","TMGTRAN1",61,0) + do ^DIC +"RTN","TMGTRAN1",62,0) + if +Y=-1 do goto RADone +"RTN","TMGTRAN1",63,0) + . write !,"No transcriptionist selected. Aborting report.",! +"RTN","TMGTRAN1",64,0) + +"RTN","TMGTRAN1",65,0) + set Options("TRANS")=+Y +"RTN","TMGTRAN1",66,0) + +"RTN","TMGTRAN1",67,0) + do AskDatesRPT(.Options) +"RTN","TMGTRAN1",68,0) +RADone +"RTN","TMGTRAN1",69,0) + quit +"RTN","TMGTRAN1",70,0) + +"RTN","TMGTRAN1",71,0) +RPTCURA +"RTN","TMGTRAN1",72,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",73,0) + ;"Purpose: To report current user's (DUZ) cost for all transcriptionists +"RTN","TMGTRAN1",74,0) + ;"Input: none. User will be asked for start and end dates +"RTN","TMGTRAN1",75,0) + ;"Output: Produces a report to choses output channel. +"RTN","TMGTRAN1",76,0) + +"RTN","TMGTRAN1",77,0) + new Options +"RTN","TMGTRAN1",78,0) + +"RTN","TMGTRAN1",79,0) + write !,"-- TRANSCRIPTION COST REPORT -- ",!! +"RTN","TMGTRAN1",80,0) + write "Showing cost for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! +"RTN","TMGTRAN1",81,0) + +"RTN","TMGTRAN1",82,0) + set Options("AUTHOR")=DUZ +"RTN","TMGTRAN1",83,0) + do AskDatesRPT(.Options) +"RTN","TMGTRAN1",84,0) + +"RTN","TMGTRAN1",85,0) + quit +"RTN","TMGTRAN1",86,0) + +"RTN","TMGTRAN1",87,0) +RPTASKA +"RTN","TMGTRAN1",88,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",89,0) + ;"Purpose: To report transcription costs for a chosen user +"RTN","TMGTRAN1",90,0) + ;"Input: none. User will be asked for the user to report on, and also +"RTN","TMGTRAN1",91,0) + ;" start and end dates +"RTN","TMGTRAN1",92,0) + ;"Output: Produces a report to choses output channel. +"RTN","TMGTRAN1",93,0) + +"RTN","TMGTRAN1",94,0) + new Options +"RTN","TMGTRAN1",95,0) + +"RTN","TMGTRAN1",96,0) + write !,"-- TRANSCRIPTION COST REPORT -- ",!! +"RTN","TMGTRAN1",97,0) + +"RTN","TMGTRAN1",98,0) + set DIC=200 ;"NEW PERSON file +"RTN","TMGTRAN1",99,0) + set DIC(0)="MAQE" +"RTN","TMGTRAN1",100,0) + set DIC("A")="Enter name of author (^ to abort): " +"RTN","TMGTRAN1",101,0) + do ^DIC +"RTN","TMGTRAN1",102,0) + if +Y=-1 do goto RAADone +"RTN","TMGTRAN1",103,0) + . write !,"No author selected. Aborting report.",! +"RTN","TMGTRAN1",104,0) + +"RTN","TMGTRAN1",105,0) + set Options("AUTHOR")=+Y +"RTN","TMGTRAN1",106,0) + +"RTN","TMGTRAN1",107,0) + do AskDatesRPT(.Options) +"RTN","TMGTRAN1",108,0) +RAADone +"RTN","TMGTRAN1",109,0) + quit +"RTN","TMGTRAN1",110,0) + +"RTN","TMGTRAN1",111,0) + +"RTN","TMGTRAN1",112,0) + +"RTN","TMGTRAN1",113,0) +AskDatesRPT(Options) +"RTN","TMGTRAN1",114,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",115,0) + ;"Purpose: to finish the interactive report process. +"RTN","TMGTRAN1",116,0) + ;"Input: An array that should contain Options("TRANS")=IEN +"RTN","TMGTRAN1",117,0) + +"RTN","TMGTRAN1",118,0) + write !!! +"RTN","TMGTRAN1",119,0) + write "NOTE: Enter date range for note ENTRY into system, not date of service.",! +"RTN","TMGTRAN1",120,0) + new %DT +"RTN","TMGTRAN1",121,0) + set %DT="AEP" +"RTN","TMGTRAN1",122,0) + set %DT("A")="Enter starting date (^ to abort): " +"RTN","TMGTRAN1",123,0) + do ^%DT +"RTN","TMGTRAN1",124,0) + if Y=-1 do goto ADRDone +"RTN","TMGTRAN1",125,0) + . write "Invalid date. Aborting report.",! +"RTN","TMGTRAN1",126,0) + set Options("START")=Y +"RTN","TMGTRAN1",127,0) + +"RTN","TMGTRAN1",128,0) + set %DT("A")="Enter ending date (^ to abort): " +"RTN","TMGTRAN1",129,0) + do ^%DT +"RTN","TMGTRAN1",130,0) + if Y=-1 do goto ADRDone +"RTN","TMGTRAN1",131,0) + . write "Invalid date. Aborting report.",! +"RTN","TMGTRAN1",132,0) + set Options("END")=Y +"RTN","TMGTRAN1",133,0) + +"RTN","TMGTRAN1",134,0) + new YN +"RTN","TMGTRAN1",135,0) + read !,"Show Details? YES// ",YN:$get(DTIME,3600) +"RTN","TMGTRAN1",136,0) + if YN="" set YN="Y" +"RTN","TMGTRAN1",137,0) + set Options("DETAILS")=($$UP^XLFSTR(YN)["Y") +"RTN","TMGTRAN1",138,0) + if YN="^" write "Aborting.",! goto ADRDone +"RTN","TMGTRAN1",139,0) + +"RTN","TMGTRAN1",140,0) + set %ZIS("A")="Enter output printer or device (^ to abort): " +"RTN","TMGTRAN1",141,0) + do ^%ZIS +"RTN","TMGTRAN1",142,0) + if POP do goto ADRDone +"RTN","TMGTRAN1",143,0) + . write !,"Error selecting output printer or device. Aborting report.",! +"RTN","TMGTRAN1",144,0) + +"RTN","TMGTRAN1",145,0) + use IO +"RTN","TMGTRAN1",146,0) + do RPTQUIET(.Options) +"RTN","TMGTRAN1",147,0) + use IO(0) +"RTN","TMGTRAN1",148,0) + +"RTN","TMGTRAN1",149,0) + do ^%ZISC +"RTN","TMGTRAN1",150,0) + +"RTN","TMGTRAN1",151,0) +ADRDone +"RTN","TMGTRAN1",152,0) + quit +"RTN","TMGTRAN1",153,0) + +"RTN","TMGTRAN1",154,0) + +"RTN","TMGTRAN1",155,0) +RPTQUIET(OPTIONS) +"RTN","TMGTRAN1",156,0) + ;"SCOPE: PUBLIC +"RTN","TMGTRAN1",157,0) + ;"Purpose: To create a report on transcription productivity based on +"RTN","TMGTRAN1",158,0) + ;" options specified in OPTIONS. +"RTN","TMGTRAN1",159,0) + ;"Input: The following elements in OPTIONS should be defined +"RTN","TMGTRAN1",160,0) + ;" 0PTIONS("TRANS") ;"the IEN of the transcriptionst (IEN from file 200) +"RTN","TMGTRAN1",161,0) + ;" This term is to limit the search. If all transcriptionsts are +"RTN","TMGTRAN1",162,0) + ;" wanted, then don't define OPTIONS("TRANS") +"RTN","TMGTRAN1",163,0) + ;" If multiple transcriptionists need to be specified, use this format: +"RTN","TMGTRAN1",164,0) + ;" OPTIONS("TRANS")="*" +"RTN","TMGTRAN1",165,0) + ;" OPTIONS("TRANS",1)=IEN#1 +"RTN","TMGTRAN1",166,0) + ;" OPTIONS("TRANS",2)=IEN#2 +"RTN","TMGTRAN1",167,0) + ;" OPTIONS("TRANS",3)=IEN#3 +"RTN","TMGTRAN1",168,0) + ;" 0PTIONS("AUTHOR") ;"the IEN of the author (IEN from file 200) +"RTN","TMGTRAN1",169,0) + ;" This term is to limit the search. If all authors are +"RTN","TMGTRAN1",170,0) + ;" wanted, then don't define OPTIONS("AUTHOR") +"RTN","TMGTRAN1",171,0) + ;" If multiple authors need to be specified, use this format: +"RTN","TMGTRAN1",172,0) + ;" OPTIONS("AUTHOR")="*" +"RTN","TMGTRAN1",173,0) + ;" OPTIONS("AUTHOR",1)=IEN#1 +"RTN","TMGTRAN1",174,0) + ;" OPTIONS("AUTHOR",2)=IEN#2 +"RTN","TMGTRAN1",175,0) + ;" OPTIONS("AUTHOR",3)=IEN#3 +"RTN","TMGTRAN1",176,0) + ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format +"RTN","TMGTRAN1",177,0) + ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format +"RTN","TMGTRAN1",178,0) + ;" OPTIONS("DETAILS") ;"if 1, then each document showed +"RTN","TMGTRAN1",179,0) + ;"Note: This will create a report by writing to the current device +"RTN","TMGTRAN1",180,0) + ;" If the user wants output to go to a DEVICE, then they should call +"RTN","TMGTRAN1",181,0) + ;" ^%ZIS prior to calling this function, and call ^%ZISC aftewards to close +"RTN","TMGTRAN1",182,0) + +"RTN","TMGTRAN1",183,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1") +"RTN","TMGTRAN1",184,0) + +"RTN","TMGTRAN1",185,0) + new index +"RTN","TMGTRAN1",186,0) + new TransIEN,AuthorIEN +"RTN","TMGTRAN1",187,0) + new TransArrayP set TransArrayP="OPTIONS(""TRANS"")" +"RTN","TMGTRAN1",188,0) + new AuthorArrayP set AuthorArrayP="OPTIONS(""AUTHOR"")" +"RTN","TMGTRAN1",189,0) + new ChrCt set ChrCt=0 +"RTN","TMGTRAN1",190,0) + new LineCt set LineCt=0 +"RTN","TMGTRAN1",191,0) + new StartDT,EndDT +"RTN","TMGTRAN1",192,0) + new CtAuthor ;"An array to subdivide lines to each doctor's account +"RTN","TMGTRAN1",193,0) + new CtTrans ;"An array to track transcriptionists lines and income +"RTN","TMGTRAN1",194,0) + new AuthorInitials,TransInitials +"RTN","TMGTRAN1",195,0) + new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS")) +"RTN","TMGTRAN1",196,0) + +"RTN","TMGTRAN1",197,0) + set StartDT=+$get(OPTIONS("START")) +"RTN","TMGTRAN1",198,0) + if (StartDT=0) do goto RQDone +"RTN","TMGTRAN1",199,0) + . write "No start date specified. Aborting.",! +"RTN","TMGTRAN1",200,0) + set EndDT=+$get(OPTIONS("END"))\1 ;" \1 removes time from date +"RTN","TMGTRAN1",201,0) + if (EndDT=0) do goto RQDone +"RTN","TMGTRAN1",202,0) + . write "No end date specified. Aborting.",! +"RTN","TMGTRAN1",203,0) + +"RTN","TMGTRAN1",204,0) + new CharsPerLine set CharsPerLine=+$piece($get(^TIU(8925.99,1,0)),"^",3) +"RTN","TMGTRAN1",205,0) + if CharsPerLine=0 set CharsPerLine=65 +"RTN","TMGTRAN1",206,0) + +"RTN","TMGTRAN1",207,0) + write !!," Visit;" +"RTN","TMGTRAN1",208,0) + write $$RJ^XLFSTR("Entry Date;",15) +"RTN","TMGTRAN1",209,0) + write $$RJ^XLFSTR("Lines@Rate=$Cost",23),"; " +"RTN","TMGTRAN1",210,0) + write "Trn; Ath; Sgn; Patient",! +"RTN","TMGTRAN1",211,0) + write "------------------------------------------------------------------------------",! +"RTN","TMGTRAN1",212,0) + set index=$order(^TIU(8925,0)) +"RTN","TMGTRAN1",213,0) + for do quit:(index="") +"RTN","TMGTRAN1",214,0) + . ;"write "." +"RTN","TMGTRAN1",215,0) + . if index="" quit +"RTN","TMGTRAN1",216,0) + . new k +"RTN","TMGTRAN1",217,0) + . use IO(0) read *k:0 use IO +"RTN","TMGTRAN1",218,0) + . if k=27 do quit +"RTN","TMGTRAN1",219,0) + . . set index="" +"RTN","TMGTRAN1",220,0) + . . write "Report aborted by ESC from user.",! +"RTN","TMGTRAN1",221,0) + . new tDate set tDate=$piece($get(^TIU(8925,index,12)),"^",1) +"RTN","TMGTRAN1",222,0) + . set tDate=tDate\1 ;"remove time from date +"RTN","TMGTRAN1",223,0) + . ;"set mC=mC+1 set tC=tC+1 if tC>100 write mC," " set tC=0 +"RTN","TMGTRAN1",224,0) + . if (tDate'EndDT) do +"RTN","TMGTRAN1",225,0) + . . set TransIEN=+$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 +"RTN","TMGTRAN1",226,0) + . . ;"write "index=",index," " +"RTN","TMGTRAN1",227,0) + . . ;"write "TransIEN='" +"RTN","TMGTRAN1",228,0) + . . ;"write TransIEN,"'" +"RTN","TMGTRAN1",229,0) + . . if ($data(OPTIONS("TRANS"))=0)!($$InList^TMGMISC(TransIEN,TransArrayP)=1) do +"RTN","TMGTRAN1",230,0) + . . . set AuthorIEN=$piece($get(^TIU(8925,index,12)),"^",2) ;field 1202 +"RTN","TMGTRAN1",231,0) + . . . if ($data(OPTIONS("AUTHOR"))=0)!($$InList^TMGMISC(AuthorIEN,AuthorArrayP)=1) do +"RTN","TMGTRAN1",232,0) + . . . . new tCharCt,tLineCt,Date,DateS,Pt +"RTN","TMGTRAN1",233,0) + . . . . new VDate,VDateSi +"RTN","TMGTRAN1",234,0) + . . . . new pStatus +"RTN","TMGTRAN1",235,0) + . . . . new Status set Status="N" +"RTN","TMGTRAN1",236,0) + . . . . new Patient set Patient="" +"RTN","TMGTRAN1",237,0) + . . . . set tCharCt=+$piece($get(^TIU(8925,index,"TMG")),"^",2);"field 22711=char count +"RTN","TMGTRAN1",238,0) + . . . . set tLineCt=+$piece($get(^TIU(8925,index,0)),"^",10) ;"field .1 = line count +"RTN","TMGTRAN1",239,0) + . . . . set pStatus=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 is status file pointer +"RTN","TMGTRAN1",240,0) + . . . . if +pStatus'=0 do +"RTN","TMGTRAN1",241,0) + . . . . . set Status=$piece($get(^TIU(8925.6,pStatus,0)),"^",2) ;"8925.6=TIU Status. field .02=symbol +"RTN","TMGTRAN1",242,0) + . . . . . if Status="c" set Status="Y" +"RTN","TMGTRAN1",243,0) + . . . . . else set Status="N" +"RTN","TMGTRAN1",244,0) + . . . . if (tLineCt=0)!(tCharCt=0) do +"RTN","TMGTRAN1",245,0) + . . . . . if (tLineCt=0)&(tCharCt'=0) do +"RTN","TMGTRAN1",246,0) + . . . . . . set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10 +"RTN","TMGTRAN1",247,0) + . . . . . else if (tCharCt=0)&(tLineCt'=0) do +"RTN","TMGTRAN1",248,0) + . . . . . . set tCharCt=tLineCt*CharsPerLine +"RTN","TMGTRAN1",249,0) + . . . . . else do +"RTN","TMGTRAN1",250,0) + . . . . . . set tLineCt=$$DocLines^TMGMISC(index,.tCharCt) +"RTN","TMGTRAN1",251,0) + . . . . . . if tLineCt=0 set tLineCt=(((tCharCt/CharsPerLine)*10)\1)/10 +"RTN","TMGTRAN1",252,0) + . . . . . set tLineCt=$$Round^TMGMISC(tLineCt) +"RTN","TMGTRAN1",253,0) + . . . . . set tCharCt=$$Round^TMGMISC(tCharCt) +"RTN","TMGTRAN1",254,0) + . . . . . ;"Store values, so next time we won't have to calculate it. +"RTN","TMGTRAN1",255,0) + . . . . . set $piece(^TIU(8925,index,0),"^",10)=+tLineCt ;"field .1 = line count +"RTN","TMGTRAN1",256,0) + . . . . . set $piece(^TIU(8925,index,"TMG"),"^",2)=tCharCt ;"field 22711 = char count +"RTN","TMGTRAN1",257,0) + . . . . set Date=$piece($get(^TIU(8925,index,12)),"^",1) ;"field 1201 = Entry Date +"RTN","TMGTRAN1",258,0) + . . . . ;"set DateS=$$FMTE^XLFDT(Date,"D") +"RTN","TMGTRAN1",259,0) + . . . . set DateS=$$DTFormat^TMGMISC(Date,"ww mm/dd/yy") +"RTN","TMGTRAN1",260,0) + . . . . set VDate=$piece($get(^TIU(8925,index,13)),"^",1) ;"field 1301=Ref/Visit Date +"RTN","TMGTRAN1",261,0) + . . . . ;"set VDateS=$$FMTE^XLFDT(VDate,"D") +"RTN","TMGTRAN1",262,0) + . . . . set VDateS=$$DTFormat^TMGMISC(VDate,"mm/dd/yy") +"RTN","TMGTRAN1",263,0) + . . . . set AuthorInitials=$piece($get(^VA(200,AuthorIEN,0)),"^",2) +"RTN","TMGTRAN1",264,0) + . . . . set TransInitials=$piece($get(^VA(200,TransIEN,0)),"^",2) ;"field 1 = initials +"RTN","TMGTRAN1",265,0) + . . . . set CtAuthor(AuthorIEN,"LINES")=$get(CtAuthor(AuthorIEN,"LINES"))+tLineCt +"RTN","TMGTRAN1",266,0) + . . . . set CtAuthor(AuthorIEN,"NOTES")=+$get(CtAuthor(AuthorIEN,"NOTES"))+1 +"RTN","TMGTRAN1",267,0) + . . . . set CtTrans(TransIEN,"LINES")=$get(CtTrans(TransIEN,"LINES"))+tLineCt +"RTN","TMGTRAN1",268,0) + . . . . set CtTrans(TransIEN,"NOTES")=+$get(CtTrans(TransIEN,"NOTES"))+1 +"RTN","TMGTRAN1",269,0) + . . . . set Pt=+$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient +"RTN","TMGTRAN1",270,0) + . . . . if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name +"RTN","TMGTRAN1",271,0) + . . . . new NoteBonus set NoteBonus=0 +"RTN","TMGTRAN1",272,0) + . . . . new PayRate set PayRate=$$PayRate(TransIEN,Date,.NoteBonus) +"RTN","TMGTRAN1",273,0) + . . . . ;"new LineCost set LineCost=$$RoundDn^TMGMISC(tLineCt*PayRate) +"RTN","TMGTRAN1",274,0) + . . . . ;"new LineCost set LineCost=(tLineCt*PayRate) +"RTN","TMGTRAN1",275,0) + . . . . new LineCost set LineCost=(tLineCt*PayRate)+NoteBonus +"RTN","TMGTRAN1",276,0) + . . . . set CtAuthor(AuthorIEN,"COST")=+$get(CtAuthor(AuthorIEN,"COST"))+LineCost +"RTN","TMGTRAN1",277,0) + . . . . set CtAuthor(AuthorIEN,"BONUS")=+$get(CtAuthor(AuthorIEN,"BONUS"))+NoteBonus +"RTN","TMGTRAN1",278,0) + . . . . set CtTrans(TransIEN,"COST")=+$get(CtTrans(TransIEN,"COST"))+LineCost +"RTN","TMGTRAN1",279,0) + . . . . set CtTrans(TransIEN,"BONUS")=+$get(CtTrans(TransIEN,"BONUS"))+NoteBonus +"RTN","TMGTRAN1",280,0) + . . . . if ShowDetails do +"RTN","TMGTRAN1",281,0) + . . . . . write VDateS,"; " +"RTN","TMGTRAN1",282,0) + . . . . . write $$RJ^XLFSTR(DateS,13),";" +"RTN","TMGTRAN1",283,0) + . . . . . new tS set tS=tLineCt_" @"_PayRate +"RTN","TMGTRAN1",284,0) + . . . . . if NoteBonus>0 set tS=tS_")+"_NoteBonus +"RTN","TMGTRAN1",285,0) + . . . . . write $$RJ^XLFSTR(.tS,15) +"RTN","TMGTRAN1",286,0) + . . . . . set tS=" =$"_LineCost_"; " +"RTN","TMGTRAN1",287,0) + . . . . . write $$RJ^XLFSTR(.tS,10) +"RTN","TMGTRAN1",288,0) + . . . . . write TransInitials,"; ",AuthorInitials,"; " +"RTN","TMGTRAN1",289,0) + . . . . . write " ",Status,"; " +"RTN","TMGTRAN1",290,0) + . . . . . write $$Clip^TMGSTUTL(Patient,15),! +"RTN","TMGTRAN1",291,0) + . . . . set LineCt=LineCt+tLineCt +"RTN","TMGTRAN1",292,0) + . set index=+$order(^TIU(8925,index)) +"RTN","TMGTRAN1",293,0) + . if index=0 set index="" +"RTN","TMGTRAN1",294,0) + +"RTN","TMGTRAN1",295,0) + write !,"Transcriptionist breakdown",! +"RTN","TMGTRAN1",296,0) + write "-----------------------------",! +"RTN","TMGTRAN1",297,0) + set index=$order(CtTrans("")) +"RTN","TMGTRAN1",298,0) + for do quit:(index="") +"RTN","TMGTRAN1",299,0) + . new TransS,Lines,Notes +"RTN","TMGTRAN1",300,0) + . if index="" quit +"RTN","TMGTRAN1",301,0) + . set TransS=$piece($get(^VA(200,index,0)),"^",1) +"RTN","TMGTRAN1",302,0) + . if TransS="" set TransS="(Unknown Transcriptionist)" +"RTN","TMGTRAN1",303,0) + . set Lines=+$get(CtTrans(index,"LINES")) +"RTN","TMGTRAN1",304,0) + . set Notes=+$get(CtTrans(index,"NOTES")) +"RTN","TMGTRAN1",305,0) + . write " ",TransS,": ",Lines," lines in ",Notes," notes." +"RTN","TMGTRAN1",306,0) + . write " $",$get(CtTrans(index,"COST")) +"RTN","TMGTRAN1",307,0) + . write " (income)",! +"RTN","TMGTRAN1",308,0) + . if +$get(CtTrans(index,"BONUS"))>0 do +"RTN","TMGTRAN1",309,0) + . . new c set c=+$get(CtTrans(index,"COST")) +"RTN","TMGTRAN1",310,0) + . . new b set b=$get(CtTrans(index,"BONUS")) +"RTN","TMGTRAN1",311,0) + . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",! +"RTN","TMGTRAN1",312,0) + . set index=$order(CtTrans(index)) +"RTN","TMGTRAN1",313,0) + +"RTN","TMGTRAN1",314,0) + write !,"Author breakdown",! +"RTN","TMGTRAN1",315,0) + write "--------------------",! +"RTN","TMGTRAN1",316,0) + set index=$order(CtAuthor("")) +"RTN","TMGTRAN1",317,0) + for do quit:(index="") +"RTN","TMGTRAN1",318,0) + . new AuthorS,Lines,Notes +"RTN","TMGTRAN1",319,0) + . if index="" quit +"RTN","TMGTRAN1",320,0) + . set AuthorS=$piece($get(^VA(200,index,0)),"^",1) +"RTN","TMGTRAN1",321,0) + . if AuthorS="" set AuthorS="(Unknown Author)" +"RTN","TMGTRAN1",322,0) + . set Lines=+$get(CtAuthor(index,"LINES")) +"RTN","TMGTRAN1",323,0) + . set Notes=+$get(CtAuthor(index,"NOTES")) +"RTN","TMGTRAN1",324,0) + . write " ",AuthorS,": ",Lines," lines in ",Notes," notes." +"RTN","TMGTRAN1",325,0) + . write " $",$get(CtAuthor(index,"COST"))," (expense)",! +"RTN","TMGTRAN1",326,0) + . if +$get(CtAuthor(index,"BONUS"))>0 do +"RTN","TMGTRAN1",327,0) + . . new c set c=+$get(CtAuthor(index,"COST")) +"RTN","TMGTRAN1",328,0) + . . new b set b=$get(CtAuthor(index,"BONUS")) +"RTN","TMGTRAN1",329,0) + . . write ?15,"$",c," = $",(c-b)," + $",b," per-note bonus.",! +"RTN","TMGTRAN1",330,0) + . set index=$order(CtAuthor(index)) +"RTN","TMGTRAN1",331,0) + +"RTN","TMGTRAN1",332,0) + write !!,"Done.",! +"RTN","TMGTRAN1",333,0) + +"RTN","TMGTRAN1",334,0) +RQDone +"RTN","TMGTRAN1",335,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"RPTQUIET^TMGTRANS1") +"RTN","TMGTRAN1",336,0) + quit +"RTN","TMGTRAN1",337,0) + +"RTN","TMGTRAN1",338,0) + +"RTN","TMGTRAN1",339,0) +PayRateE(TransIEN,Date) +"RTN","TMGTRAN1",340,0) + ;"Purpose: To provide a 'shell' for PayRate below, except external +"RTN","TMGTRAN1",341,0) + ;" format of date alowed +"RTN","TMGTRAN1",342,0) + +"RTN","TMGTRAN1",343,0) + new IDate +"RTN","TMGTRAN1",344,0) + +"RTN","TMGTRAN1",345,0) + set X=$get(Date) +"RTN","TMGTRAN1",346,0) + ;"set IDate= +"RTN","TMGTRAN1",347,0) + +"RTN","TMGTRAN1",348,0) + ;"COMPLETE FUNCTION LATER... +"RTN","TMGTRAN1",349,0) + +"RTN","TMGTRAN1",350,0) + quit +"RTN","TMGTRAN1",351,0) + +"RTN","TMGTRAN1",352,0) + +"RTN","TMGTRAN1",353,0) +PayRate(TransIEN,Date,NoteBonus) +"RTN","TMGTRAN1",354,0) + ;"Purpose: Get payrate in effect at time of Date +"RTN","TMGTRAN1",355,0) + ;"Input: TransIEN -- the record number in file 200 +"RTN","TMGTRAN1",356,0) + ;" Date: reference date to lookup, ** in internal fileman format ** +"RTN","TMGTRAN1",357,0) + ;" NoteBonus -- [OPTIONAL] This is an out parameter. See below. +"RTN","TMGTRAN1",358,0) + ;"Result: The payrate found in file TMG TRANSCRIPTION PAYRATE file +"RTN","TMGTRAN1",359,0) + ;" This is dollars/line +"RTN","TMGTRAN1",360,0) + ;" If NoteBonus was passed by reference, then the value of the +"RTN","TMGTRAN1",361,0) + ;" NOTE BONUS field (field #3) is returned, or 0 if not found. +"RTN","TMGTRAN1",362,0) + ;" Note: a result of 0 is returned if TransIEN not found, or +"RTN","TMGTRAN1",363,0) + ;" no date range covers Date +"RTN","TMGTRAN1",364,0) + +"RTN","TMGTRAN1",365,0) + new result set result=0 +"RTN","TMGTRAN1",366,0) + new bonusresult set bonusresult=0 +"RTN","TMGTRAN1",367,0) + new RateIEN +"RTN","TMGTRAN1",368,0) + new index +"RTN","TMGTRAN1",369,0) + +"RTN","TMGTRAN1",370,0) + if (+$get(TransIEN)=0)!(+$get(Date)=0) goto PRDone +"RTN","TMGTRAN1",371,0) + set Date=Date\1 +"RTN","TMGTRAN1",372,0) + set RateIEN=+$order(^TMG(22704,"B",TransIEN,"")) +"RTN","TMGTRAN1",373,0) + if RateIEN=0 goto PRDone +"RTN","TMGTRAN1",374,0) + merge PayRates=^TMG(22704,RateIEN,1) +"RTN","TMGTRAN1",375,0) + set index=$order(^TMG(22704,RateIEN,1,0)) +"RTN","TMGTRAN1",376,0) + for do quit:(index="") +"RTN","TMGTRAN1",377,0) + . if index="" quit +"RTN","TMGTRAN1",378,0) + . new Rate set Rate=$get(^TMG(22704,RateIEN,1,index,0)) +"RTN","TMGTRAN1",379,0) + . if Rate'="" do +"RTN","TMGTRAN1",380,0) + . . new StartDate,EndDate +"RTN","TMGTRAN1",381,0) + . . set StartDate=$piece(Rate,"^",2) +"RTN","TMGTRAN1",382,0) + . . set EndDate=$piece(Rate,"^",3) +"RTN","TMGTRAN1",383,0) + . . if DateEndDate) do quit +"RTN","TMGTRAN1",386,0) + . . . ;"write "Date=",Date," EndDate=",EndDate,! +"RTN","TMGTRAN1",387,0) + . . set result=$piece(Rate,"^",1) +"RTN","TMGTRAN1",388,0) + . . set bonusresult=$piece(Rate,"^",4) ;"field#3 (NOTE BONUS) +"RTN","TMGTRAN1",389,0) + . if result'=0 set index="" quit +"RTN","TMGTRAN1",390,0) + . set index=$order(^TMG(22704,RateIEN,1,index)) +"RTN","TMGTRAN1",391,0) + +"RTN","TMGTRAN1",392,0) + if result=0 do +"RTN","TMGTRAN1",393,0) + . ;"write !,"TransIEN=",TransIEN," Date=",Date,! +"RTN","TMGTRAN1",394,0) +PRDone +"RTN","TMGTRAN1",395,0) + set NoteBonus=bonusresult +"RTN","TMGTRAN1",396,0) + quit result +"RTN","TMGTRAN1",397,0) + +"RTN","TMGTRAN1",398,0) + ;"======================================================================= +"RTN","TMGTRAN1",399,0) + +"RTN","TMGTRAN1",400,0) +FREECUR +"RTN","TMGTRAN1",401,0) + ;"Purpose: For current user, cycle through all alerts regarding +"RTN","TMGTRAN1",402,0) + ;" documents needing to be signed, and automatically sign +"RTN","TMGTRAN1",403,0) + ;" them, then print if user wants. +"RTN","TMGTRAN1",404,0) + ;"Input: none. User will be asked for signature password, +"RTN","TMGTRAN1",405,0) + ;" and if they want documents printed. +"RTN","TMGTRAN1",406,0) + ;"Output: Produces a report to chosen output channel. +"RTN","TMGTRAN1",407,0) + +"RTN","TMGTRAN1",408,0) + ;"write @IOF +"RTN","TMGTRAN1",409,0) + write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!! +"RTN","TMGTRAN1",410,0) + write "Releasing transcription for: ",$piece($get(^VA(200,DUZ,0)),"^",1),!! +"RTN","TMGTRAN1",411,0) + +"RTN","TMGTRAN1",412,0) + do FreeDocs(DUZ,1) +"RTN","TMGTRAN1",413,0) + +"RTN","TMGTRAN1",414,0) + write !,"Goodbye.",! +"RTN","TMGTRAN1",415,0) + +"RTN","TMGTRAN1",416,0) + quit +"RTN","TMGTRAN1",417,0) + +"RTN","TMGTRAN1",418,0) + +"RTN","TMGTRAN1",419,0) +FREEASK +"RTN","TMGTRAN1",420,0) + ;"Purpose: Ask for chosen user, then cycle through all alerts +"RTN","TMGTRAN1",421,0) + ;" regarding documents needing to be signed, and automatically +"RTN","TMGTRAN1",422,0) + ;" sign them, then print if user wants. +"RTN","TMGTRAN1",423,0) + ;"Input: none. User will be asked for signature password, +"RTN","TMGTRAN1",424,0) + ;" and if they want documents printed. +"RTN","TMGTRAN1",425,0) + ;"Output: Produces a report to choses output channel. +"RTN","TMGTRAN1",426,0) + +"RTN","TMGTRAN1",427,0) + new Y,DIC,TransIEN,DocIEN +"RTN","TMGTRAN1",428,0) + set TransIEN=-1 +"RTN","TMGTRAN1",429,0) + +"RTN","TMGTRAN1",430,0) + ;"write @IOF +"RTN","TMGTRAN1",431,0) + write !!,"-- RELEASE UNSIGNED DOCUMENTS -- ",!! +"RTN","TMGTRAN1",432,0) + +"RTN","TMGTRAN1",433,0) + set DIC=200 ;"NEW PERSON file +"RTN","TMGTRAN1",434,0) + set DIC(0)="MAQE" +"RTN","TMGTRAN1",435,0) + set DIC("A")="Enter name of author (^ to abort): " +"RTN","TMGTRAN1",436,0) + do ^DIC +"RTN","TMGTRAN1",437,0) + if +Y'>0 do goto RADone +"RTN","TMGTRAN1",438,0) + . write !,"No author selected. Aborting report.",! +"RTN","TMGTRAN1",439,0) + set DocIEN=+Y +"RTN","TMGTRAN1",440,0) + +"RTN","TMGTRAN1",441,0) + write !!,"OPTIONAL-- Enter name of transcriptionist to screen for. If specified, ",! +"RTN","TMGTRAN1",442,0) + write "only notes entered by this transcriptionist will be signed and released." +"RTN","TMGTRAN1",443,0) + set DIC("A")="Enter name of transcriptionist (ENTER or ^ to skip): " +"RTN","TMGTRAN1",444,0) + do ^DIC +"RTN","TMGTRAN1",445,0) + write !! +"RTN","TMGTRAN1",446,0) + if +Y'>0 set TransIEN=+Y +"RTN","TMGTRAN1",447,0) + +"RTN","TMGTRAN1",448,0) + do FreeDocs(DocIEN,1,TransIEN) +"RTN","TMGTRAN1",449,0) + +"RTN","TMGTRAN1",450,0) + write !,"Goodbye.",! +"RTN","TMGTRAN1",451,0) + +"RTN","TMGTRAN1",452,0) +FADone +"RTN","TMGTRAN1",453,0) + quit +"RTN","TMGTRAN1",454,0) + +"RTN","TMGTRAN1",455,0) + +"RTN","TMGTRAN1",456,0) +FreeDocs(AuthorIEN,ShowDetails,TransIEN) +"RTN","TMGTRAN1",457,0) + ;"Purpose: to finish the interactive release documents process. +"RTN","TMGTRAN1",458,0) + ;" This separate entry point allows restriction of the author +"RTN","TMGTRAN1",459,0) + ;" whose's documents are to be released. +"RTN","TMGTRAN1",460,0) + ;"Input: AuthorIEN, the record number of the author in file 200 +"RTN","TMGTRAN1",461,0) + ;" ShowDetails: optional. Default is to show details (1) +"RTN","TMGTRAN1",462,0) + ;" 0=don't show, 1=show +"RTN","TMGTRAN1",463,0) + ;" TransIEN: OPTIONAL -- the IEN of the transcriptionist. +"RTN","TMGTRAN1",464,0) + ;" IF specified, then ONLY those notes created by this +"RTN","TMGTRAN1",465,0) + ;" transcriptionist will be finished/released +"RTN","TMGTRAN1",466,0) + +"RTN","TMGTRAN1",467,0) + new Signed +"RTN","TMGTRAN1",468,0) + new abort set abort=0 +"RTN","TMGTRAN1",469,0) + new Options +"RTN","TMGTRAN1",470,0) + new PrintAfter +"RTN","TMGTRAN1",471,0) + new YN +"RTN","TMGTRAN1",472,0) + new SignAll +"RTN","TMGTRAN1",473,0) + +"RTN","TMGTRAN1",474,0) + set Options("AUTHOR")=+$get(AuthorIEN) +"RTN","TMGTRAN1",475,0) + set Options("SIG")=0 +"RTN","TMGTRAN1",476,0) + set Options("DETAILS")=$get(ShowDetails,1) +"RTN","TMGTRAN1",477,0) + if +$get(TransIEN)>0 set Options("TRANS")=+TransIEN +"RTN","TMGTRAN1",478,0) + +"RTN","TMGTRAN1",479,0) + do +"RTN","TMGTRAN1",480,0) + . write "Enter 'your' (meaning author's) signature code below." +"RTN","TMGTRAN1",481,0) + . new DUZ +"RTN","TMGTRAN1",482,0) + . set DUZ=+$get(AuthorIEN) +"RTN","TMGTRAN1",483,0) + . if DUZ=0 quit +"RTN","TMGTRAN1",484,0) + . do SIG^XUSESIG +"RTN","TMGTRAN1",485,0) + . write ! +"RTN","TMGTRAN1",486,0) + . if X1'="" set Options("SIG")=1 +"RTN","TMGTRAN1",487,0) + if Options("SIG")'=1 do goto FADDone +"RTN","TMGTRAN1",488,0) + . write "Signature code incorrect. Aborting.",! +"RTN","TMGTRAN1",489,0) + +"RTN","TMGTRAN1",490,0) + read "Sign all notes at once (^/Y/N): YES// ",SignAll:$get(DTIME,3600),! +"RTN","TMGTRAN1",491,0) + if SignAll="" set SignAll="Y" +"RTN","TMGTRAN1",492,0) + if SignAll="^" write "Aborting.",! goto ADRDone +"RTN","TMGTRAN1",493,0) + set Options("SIGN ALL")=($$UP^XLFSTR(SignAll)["Y") +"RTN","TMGTRAN1",494,0) + +"RTN","TMGTRAN1",495,0) + write !,"Print Notes after signing? (^/Y/N): YES// " +"RTN","TMGTRAN1",496,0) + read YN:$get(DTIME,3600),! +"RTN","TMGTRAN1",497,0) + if YN="^" write "Aborting.",! goto ADRDone +"RTN","TMGTRAN1",498,0) + if YN="" set YN="Y" +"RTN","TMGTRAN1",499,0) + set PrintAfter=($$UP^XLFSTR(YN)["Y") +"RTN","TMGTRAN1",500,0) + +"RTN","TMGTRAN1",501,0) + do AlertSign(.Options,.Signed) +"RTN","TMGTRAN1",502,0) + +"RTN","TMGTRAN1",503,0) + write "Now look at ALL documents to find any unsigned ones.",! +"RTN","TMGTRAN1",504,0) + set Options("START")="0001111" +"RTN","TMGTRAN1",505,0) + do NOW^%DTC +"RTN","TMGTRAN1",506,0) + set Options("END")=X +"RTN","TMGTRAN1",507,0) + do ScanSign(.Options,.Signed) +"RTN","TMGTRAN1",508,0) + +"RTN","TMGTRAN1",509,0) + merge ^TMG("BATCH SIGNED DOCS",$J)=Signed +"RTN","TMGTRAN1",510,0) + +"RTN","TMGTRAN1",511,0) + if PrintAfter do PRINT(.Signed) +"RTN","TMGTRAN1",512,0) + +"RTN","TMGTRAN1",513,0) +FADDone +"RTN","TMGTRAN1",514,0) + quit +"RTN","TMGTRAN1",515,0) + +"RTN","TMGTRAN1",516,0) + +"RTN","TMGTRAN1",517,0) +ScanSign(OPTIONS,SIGNED) +"RTN","TMGTRAN1",518,0) + ;"Purpose: To scan through all TIU DOCUMENTS, and release those +"RTN","TMGTRAN1",519,0) + ;" that have a status of unsigned to completed +"RTN","TMGTRAN1",520,0) + ;"Input: The following elements in OPTIONS should be defined +"RTN","TMGTRAN1",521,0) + ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) +"RTN","TMGTRAN1",522,0) + ;" OPTIONS("START") ;"Earliest date of documents, in Fileman internal format +"RTN","TMGTRAN1",523,0) + ;" ;"Note if not specified, then all dates are matched +"RTN","TMGTRAN1",524,0) + ;" OPTIONS("END") ;"Latest date of documents, in Fileman internal format +"RTN","TMGTRAN1",525,0) + ;" ;"Note if not specified, then all dates are matched +"RTN","TMGTRAN1",526,0) + ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet) +"RTN","TMGTRAN1",527,0) + ;" OPTIONS("SIG") ;"1 if signature has been verified. +"RTN","TMGTRAN1",528,0) + ;" -----------Optional OPTIONS below--------------- +"RTN","TMGTRAN1",529,0) + ;" OPTIONS("TRANS") ;"the IEN of note. If specified, then note will not be signed +"RTN","TMGTRAN1",530,0) + ;" ;"unless the transcriptionist (i.e. ENTERED BY field) = this IEN +"RTN","TMGTRAN1",531,0) + ;" ------------------------------------------------------- +"RTN","TMGTRAN1",532,0) + ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference +"RTN","TMGTRAN1",533,0) + ;" This will contain list of documents freed/signed, in this format: +"RTN","TMGTRAN1",534,0) + ;" SIGNED(1234)=1234 with 1234 being IEN of document signed. +"RTN","TMGTRAN1",535,0) + ;" SIGNED(1235)=1235 with 1235 being IEN of document signed. +"RTN","TMGTRAN1",536,0) + ;" SIGNED(1236)=1236 with 1235 being IEN of document signed. +"RTN","TMGTRAN1",537,0) + +"RTN","TMGTRAN1",538,0) + new index +"RTN","TMGTRAN1",539,0) + new DocAuth,Status,EnteredBy +"RTN","TMGTRAN1",540,0) + new User,initials +"RTN","TMGTRAN1",541,0) + new NeedsCR set NeedsCR=1 +"RTN","TMGTRAN1",542,0) + new StartDT,EndDT +"RTN","TMGTRAN1",543,0) + new ShowDetails set ShowDetails=+$get(OPTIONS("DETAILS")) +"RTN","TMGTRAN1",544,0) + +"RTN","TMGTRAN1",545,0) + if +$get(OPTIONS("START"))=0 do +"RTN","TMGTRAN1",546,0) + . new %DT +"RTN","TMGTRAN1",547,0) + . set %DT="AEP" +"RTN","TMGTRAN1",548,0) + . set %DT("A")="Enter starting date (^ to abort): " +"RTN","TMGTRAN1",549,0) + . do ^%DT +"RTN","TMGTRAN1",550,0) + . set OPTIONS("START")=Y +"RTN","TMGTRAN1",551,0) + if $get(OPTIONS("START"))'>0 do goto SSDone +"RTN","TMGTRAN1",552,0) + . if ShowDetails write "START date invalid. Aborting.",! +"RTN","TMGTRAN1",553,0) + +"RTN","TMGTRAN1",554,0) + if +$get(OPTIONS("END"))=0 do +"RTN","TMGTRAN1",555,0) + . set %DT("A")="Enter ending date (^ to abort): " +"RTN","TMGTRAN1",556,0) + . do ^%DT +"RTN","TMGTRAN1",557,0) + . set OPTIONS("END")=Y +"RTN","TMGTRAN1",558,0) + if $get(OPTIONS("END"))'>0 do goto SSDone +"RTN","TMGTRAN1",559,0) + . if ShowDetails write "END date invalid. Aborting.",! +"RTN","TMGTRAN1",560,0) + +"RTN","TMGTRAN1",561,0) + set User=+$get(OPTIONS("AUTHOR")) +"RTN","TMGTRAN1",562,0) + if User=0 do goto RQDone +"RTN","TMGTRAN1",563,0) + . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",! +"RTN","TMGTRAN1",564,0) + set StartDT=+$get(OPTIONS("START")) +"RTN","TMGTRAN1",565,0) + set EndDT=+$get(OPTIONS("END")) +"RTN","TMGTRAN1",566,0) + +"RTN","TMGTRAN1",567,0) + if $get(OPTIONS("DETAILS")) do +"RTN","TMGTRAN1",568,0) + . write !,"------------------------------------------------",! +"RTN","TMGTRAN1",569,0) + . write "Starting scan of all documents. [ESC] will abort.",! +"RTN","TMGTRAN1",570,0) + . write "------------------------------------------------",! +"RTN","TMGTRAN1",571,0) + +"RTN","TMGTRAN1",572,0) + set initials=$piece($get(^VA(200,User,0)),"^",2) ;"field 1 = initials +"RTN","TMGTRAN1",573,0) + new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED","")) +"RTN","TMGTRAN1",574,0) + new sUnverified set sUnverified=$order(^TIU(8925.6,"B","UNVERIFIED","")) +"RTN","TMGTRAN1",575,0) + +"RTN","TMGTRAN1",576,0) + set index=$order(^TIU(8925,0)) +"RTN","TMGTRAN1",577,0) + for do quit:(index="") +"RTN","TMGTRAN1",578,0) + . if index="" quit +"RTN","TMGTRAN1",579,0) + . new k read *k:0 +"RTN","TMGTRAN1",580,0) + . if k=27 do quit +"RTN","TMGTRAN1",581,0) + . . set index="" +"RTN","TMGTRAN1",582,0) + . . if $get(OPTIONS("DETAILS")) write "Release aborted by ESC from user.",! +"RTN","TMGTRAN1",583,0) + . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author +"RTN","TMGTRAN1",584,0) + . set EnteredBy=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered By +"RTN","TMGTRAN1",585,0) + . if (DocAuth=$get(OPTIONS("AUTHOR"))) do +"RTN","TMGTRAN1",586,0) + . . if $data(OPTIONS("TRANS"))&($get(OPTIONS("TRANS"))'=EnteredBy) quit +"RTN","TMGTRAN1",587,0) + . . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status +"RTN","TMGTRAN1",588,0) + . . if (Status=sUnsigned)!(Status=sUnverified) do ;"*** What else should go here?!! +"RTN","TMGTRAN1",589,0) + . . . new tDate +"RTN","TMGTRAN1",590,0) + . . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1) +"RTN","TMGTRAN1",591,0) + . . . set tDate=tDate\1 ;"integer round down (removes time decimal amount) +"RTN","TMGTRAN1",592,0) + . . . if (StartDT=0)!(EndDT=0)!((tDate'EndDT)) do +"RTN","TMGTRAN1",593,0) + . . . . if $$SIGNDOC(index,.OPTIONS) do +"RTN","TMGTRAN1",594,0) + . . . . . set SIGNED(index)=index +"RTN","TMGTRAN1",595,0) + . set index=+$order(^TIU(8925,index)) +"RTN","TMGTRAN1",596,0) + . if index=0 set index="" +"RTN","TMGTRAN1",597,0) + +"RTN","TMGTRAN1",598,0) +SSDone +"RTN","TMGTRAN1",599,0) + if $get(OPTIONS("DETAILS")) write !,"Done scanning all documents.",! +"RTN","TMGTRAN1",600,0) + +"RTN","TMGTRAN1",601,0) + quit +"RTN","TMGTRAN1",602,0) + +"RTN","TMGTRAN1",603,0) + +"RTN","TMGTRAN1",604,0) +AlertSign(OPTIONS,SIGNED) +"RTN","TMGTRAN1",605,0) + ;"Purpose: To cycle through all alerts for AUTHOR, and release TIU DOCUMENTS +"RTN","TMGTRAN1",606,0) + ;" needing signature. +"RTN","TMGTRAN1",607,0) + ;"Input: The following elements in OPTIONS should be defined +"RTN","TMGTRAN1",608,0) + ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) +"RTN","TMGTRAN1",609,0) + ;" OPTIONS("DETAILS") ;"if 1, then each document is shown as signed (not quiet) +"RTN","TMGTRAN1",610,0) + ;" OPTIONS("SIG") ;"1 if signature has been verified. +"RTN","TMGTRAN1",611,0) + ;" OPTIONS("SIGN ALL");"if 1, then all are signed without asking each one. +"RTN","TMGTRAN1",612,0) + ;" SIGNED: OPTIONAL. This is an OUT PARAMETER -- must be passed by reference +"RTN","TMGTRAN1",613,0) + ;" This will contain list of documents freed/signed, in this format: +"RTN","TMGTRAN1",614,0) + ;" SIGNED(1234)=1234 with 1234 being IEN of document signed. +"RTN","TMGTRAN1",615,0) + ;" SIGNED(1235)=1235 with 1235 being IEN of document signed. +"RTN","TMGTRAN1",616,0) + ;" SIGNED(1236)=1236 with 1235 being IEN of document signed. +"RTN","TMGTRAN1",617,0) + +"RTN","TMGTRAN1",618,0) + new index +"RTN","TMGTRAN1",619,0) + new Abort set Abort=0 +"RTN","TMGTRAN1",620,0) + new Alert +"RTN","TMGTRAN1",621,0) + new DocIEN +"RTN","TMGTRAN1",622,0) + new NumFound set NumFound=0 +"RTN","TMGTRAN1",623,0) + new SignAll set SignAll=+$get(OPTIONS("SIGN ALL")) +"RTN","TMGTRAN1",624,0) + +"RTN","TMGTRAN1",625,0) + set User=+$get(OPTIONS("AUTHOR")) +"RTN","TMGTRAN1",626,0) + if User=0 do goto RQDone +"RTN","TMGTRAN1",627,0) + . if $get(OPTIONS("DETAILS")) write "No author IEN supplied. Aborting.",! +"RTN","TMGTRAN1",628,0) + +"RTN","TMGTRAN1",629,0) + if $get(OPTIONS("DETAILS")) do +"RTN","TMGTRAN1",630,0) + . write !,"-------------------------------------------------------",! +"RTN","TMGTRAN1",631,0) + . write "Search for 'signature-needed' alerts. [ESC] will abort.",! +"RTN","TMGTRAN1",632,0) + . write "-------------------------------------------------------",! +"RTN","TMGTRAN1",633,0) + +"RTN","TMGTRAN1",634,0) + if SignAll'=1 do if NumFound=0 goto ASgn2 +"RTN","TMGTRAN1",635,0) + . write !!,"-------- List of Documents to be Signed --------",! +"RTN","TMGTRAN1",636,0) + . set index=$order(^XTV(8992,User,"XQA",0)) +"RTN","TMGTRAN1",637,0) + . for do quit:(index="") +"RTN","TMGTRAN1",638,0) + . . if index="" quit +"RTN","TMGTRAN1",639,0) + . . new k read *k:0 +"RTN","TMGTRAN1",640,0) + . . if k=27 do quit +"RTN","TMGTRAN1",641,0) + . . . set index="" +"RTN","TMGTRAN1",642,0) + . . . if $get(OPTIONS("DETAILS")) write "List aborted by ESC from user.",! +"RTN","TMGTRAN1",643,0) + . . set Alert=$get(^XTV(8992,User,"XQA",index,0)) +"RTN","TMGTRAN1",644,0) + . . if $piece(Alert,"^",3)["available for SIGNATURE" do +"RTN","TMGTRAN1",645,0) + . . . write $piece(Alert,"^",3),! +"RTN","TMGTRAN1",646,0) + . . . set NumFound=NumFound+1 +"RTN","TMGTRAN1",647,0) + . . set index=$order(^XTV(8992,User,"XQA",index)) +"RTN","TMGTRAN1",648,0) + . write "-----------------------------------------------",! +"RTN","TMGTRAN1",649,0) + . write !,NumFound," documents needing signature.",!! +"RTN","TMGTRAN1",650,0) + . if NumFound=0 do quit +"RTN","TMGTRAN1",651,0) + . . write "No alerts for a missing signature found.!",! +"RTN","TMGTRAN1",652,0) + +"RTN","TMGTRAN1",653,0) + ;"WRITE "STARTING SIGN LOOP",! +"RTN","TMGTRAN1",654,0) + set NumFound=0 +"RTN","TMGTRAN1",655,0) + set index=$order(^XTV(8992,User,"XQA",0)) +"RTN","TMGTRAN1",656,0) + for do quit:(index="")!(Abort=1) +"RTN","TMGTRAN1",657,0) + . new Title,YN +"RTN","TMGTRAN1",658,0) + . if index="" quit +"RTN","TMGTRAN1",659,0) + . set Alert=$get(^XTV(8992,User,"XQA",index,0)) +"RTN","TMGTRAN1",660,0) + . set Title=$piece(Alert,"^",3) +"RTN","TMGTRAN1",661,0) + . if Title["available for SIGNATURE" do +"RTN","TMGTRAN1",662,0) + . . set NumFound=NumFound+1 +"RTN","TMGTRAN1",663,0) + . . if SignAll'=1 do +"RTN","TMGTRAN1",664,0) + . . . write "Sign: ",$piece(Title," ",1),"? (Y/N/ALL): ALL// " +"RTN","TMGTRAN1",665,0) + . . . read YN:$get(DTIME,3600),! +"RTN","TMGTRAN1",666,0) + . . . set YN=$$UP^XLFSTR(YN) +"RTN","TMGTRAN1",667,0) + . . else set YN="Y" +"RTN","TMGTRAN1",668,0) + . . if YN="" set YN="ALL" write "ALL",! +"RTN","TMGTRAN1",669,0) + . . if YN="ALL" set SignAll=1 set YN="Y" +"RTN","TMGTRAN1",670,0) + . . else if YN["^" write !,"Aborting.",! set Abort=1 quit +"RTN","TMGTRAN1",671,0) + . . if YN["Y" do +"RTN","TMGTRAN1",672,0) + . . . set DocIEN=+$get(^XTV(8992,User,"XQA",index,1)) +"RTN","TMGTRAN1",673,0) + . . . if DocIEN'=0 do +"RTN","TMGTRAN1",674,0) + . . . . if $$SIGNDOC(DocIEN,.OPTIONS) do +"RTN","TMGTRAN1",675,0) + . . . . . set SIGNED(DocIEN)=DocIEN +"RTN","TMGTRAN1",676,0) + . set index=$order(^XTV(8992,User,"XQA",index)) +"RTN","TMGTRAN1",677,0) + +"RTN","TMGTRAN1",678,0) + if $get(OPTIONS("DETAILS")) do +"RTN","TMGTRAN1",679,0) + . write !!,"Done searching for 'needed-signature' alerts.",! +"RTN","TMGTRAN1",680,0) + +"RTN","TMGTRAN1",681,0) +ASgn2 +"RTN","TMGTRAN1",682,0) + if (1=0) do ;"if (NumFound=0) do +"RTN","TMGTRAN1",683,0) + . if $get(OPTIONS("DETAILS")) do +"RTN","TMGTRAN1",684,0) + . . write "No alert indicating a signature is needed was found....",! +"RTN","TMGTRAN1",685,0) + . . write "...So starting a scan of all documents to look for unsigned documents.",! +"RTN","TMGTRAN1",686,0) + . set OPTIONS("START")="0001111" +"RTN","TMGTRAN1",687,0) + . do NOW^%DTC +"RTN","TMGTRAN1",688,0) + . set OPTIONS("END")=X +"RTN","TMGTRAN1",689,0) + . do ScanSign(.OPTIONS,.Signed) +"RTN","TMGTRAN1",690,0) + +"RTN","TMGTRAN1",691,0) +ASgnDone +"RTN","TMGTRAN1",692,0) + quit +"RTN","TMGTRAN1",693,0) + +"RTN","TMGTRAN1",694,0) + +"RTN","TMGTRAN1",695,0) +SIGNDOC(DocIEN,OPTIONS) +"RTN","TMGTRAN1",696,0) + ;"Purpose: To sign one document +"RTN","TMGTRAN1",697,0) + ;"Input: DocIEN -- the record number of the document to sign +"RTN","TMGTRAN1",698,0) + ;" OPTIONS -- An array with input values. The following are used: +"RTN","TMGTRAN1",699,0) + ;" 0PTIONS("AUTHOR") ;"the IEN of the user (IEN from file 200) +"RTN","TMGTRAN1",700,0) + ;" OPTIONS("DETAILS") ;"if 1, then each document showed +"RTN","TMGTRAN1",701,0) + ;" OPTIONS("SIG") ;"1 if signature has been verified. +"RTN","TMGTRAN1",702,0) + ;"Results: 1 = successful sign. 0 = failure +"RTN","TMGTRAN1",703,0) + +"RTN","TMGTRAN1",704,0) + new result set result=0 ;"default to failure +"RTN","TMGTRAN1",705,0) + new Node0 +"RTN","TMGTRAN1",706,0) + new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED","")) +"RTN","TMGTRAN1",707,0) + new NewStatus +"RTN","TMGTRAN1",708,0) + if $get(OPTIONS("SIG"))'=1 goto SDCDone +"RTN","TMGTRAN1",709,0) + if +$get(OPTIONS("AUTHOR"))'>0 goto SDCDone +"RTN","TMGTRAN1",710,0) + if $get(DocIEN)="" goto SDCDone +"RTN","TMGTRAN1",711,0) + +"RTN","TMGTRAN1",712,0) + new SignerS +"RTN","TMGTRAN1",713,0) + set SignerS=1_"^"_$piece($get(^VA(200,+OPTIONS("AUTHOR"),20)),"^",2,3) +"RTN","TMGTRAN1",714,0) + if $data(^TIU(8925,DocIEN,0))=0 do goto SDCDone +"RTN","TMGTRAN1",715,0) + . write "Unable to sign document #",DocIEN," because it doesn't seem to exist.",! +"RTN","TMGTRAN1",716,0) + do ES^TIURS(DocIEN,SignerS) +"RTN","TMGTRAN1",717,0) + ;"Note: alert(s) r.e. "Note available for signature" are automatically removed +"RTN","TMGTRAN1",718,0) + +"RTN","TMGTRAN1",719,0) +SDLoop +"RTN","TMGTRAN1",720,0) + set Node0=$get(^TIU(8925,DocIEN,0)) +"RTN","TMGTRAN1",721,0) + set NewStatus=$piece(Node0,"^",5) ;"field .05 = Status +"RTN","TMGTRAN1",722,0) + +"RTN","TMGTRAN1",723,0) + new Date,DateS,Pt +"RTN","TMGTRAN1",724,0) + set Date=$piece(Node0,"^",7) ;"field .07 = Episode begin date/time +"RTN","TMGTRAN1",725,0) + set DateS=$$FMTE^XLFDT(Date,"D") +"RTN","TMGTRAN1",726,0) + set Pt=+$piece(Node0,"^",2) ;"field .02 = patient +"RTN","TMGTRAN1",727,0) + if Pt'=0 set Patient=$piece($get(^DPT(Pt,0)),"^",1) ;"field .01 = name +"RTN","TMGTRAN1",728,0) + if OPTIONS("DETAILS")=1 do +"RTN","TMGTRAN1",729,0) + . write DateS," -- ",Patient +"RTN","TMGTRAN1",730,0) + +"RTN","TMGTRAN1",731,0) + if NewStatus'=sCompleted do goto SDLoop +"RTN","TMGTRAN1",732,0) + . if OPTIONS("DETAILS")=1 do +"RTN","TMGTRAN1",733,0) + . . new s +"RTN","TMGTRAN1",734,0) + . . set s=$piece($get(^TIU(8925.6,NewStatus,0)),"^",1) +"RTN","TMGTRAN1",735,0) + . . write " NOT completed. Status=",s +"RTN","TMGTRAN1",736,0) + . . write !," TRYING AGAIN. (utilizing a lower-level signature method.)",! +"RTN","TMGTRAN1",737,0) + . . set $piece(^TIU(8925,DocIEN,0),"^",5)=sCompleted +"RTN","TMGTRAN1",738,0) + +"RTN","TMGTRAN1",739,0) + if OPTIONS("DETAILS")=1 do +"RTN","TMGTRAN1",740,0) + . write " Released (auto-'signed')",! +"RTN","TMGTRAN1",741,0) + +"RTN","TMGTRAN1",742,0) + set result=1 ;"success +"RTN","TMGTRAN1",743,0) + +"RTN","TMGTRAN1",744,0) +SDCDone +"RTN","TMGTRAN1",745,0) + quit result +"RTN","TMGTRAN1",746,0) + +"RTN","TMGTRAN1",747,0) + +"RTN","TMGTRAN1",748,0) +PRINT(DocArray) ; Prompt and print, or array +"RTN","TMGTRAN1",749,0) + ;"This function was copied from PRINT^TIUEPRNT, to allow modification +"RTN","TMGTRAN1",750,0) + ;"Function modification: changed to allow array input. +"RTN","TMGTRAN1",751,0) + ;" DocArray: This will contain list of documents to print, in this format: +"RTN","TMGTRAN1",752,0) + ;" DocArray(1234)=1234 with 1234 being IEN of document to be printed. +"RTN","TMGTRAN1",753,0) + ;" DocArray(1235)=1235 with 1235 being IEN of document to be printed. +"RTN","TMGTRAN1",754,0) + ;" DocArray(1236)=1236 with 1235 being IEN of document to be printed. +"RTN","TMGTRAN1",755,0) + ;" Note: Is appears that DocArray(IEN)="" is the needed format. +"RTN","TMGTRAN1",756,0) + +"RTN","TMGTRAN1",757,0) + New TIUDEV,TIUTYP,DFN,TIUPMTHD,TIUD0,TIUMSG,TIUPR,TIUDARR,TIUDPRM +"RTN","TMGTRAN1",758,0) + new TIUFLAG set TIUFLAG="x" +"RTN","TMGTRAN1",759,0) + New TIUPGRP,TIUPFHDR,TIUPFNBR +"RTN","TMGTRAN1",760,0) + +"RTN","TMGTRAN1",761,0) + new index set index=$order(DocArray("")) +"RTN","TMGTRAN1",762,0) + if index="" goto PRINT1X +"RTN","TMGTRAN1",763,0) + for do quit:(index="") +"RTN","TMGTRAN1",764,0) + . set DocIEN=index +"RTN","TMGTRAN1",765,0) + . ; +"RTN","TMGTRAN1",766,0) + . If +$$ISADDNDM^TIULC1(DocIEN) Set DocIEN=$Piece($Get(^TIU(8925,+DocIEN,0)),U,6) +"RTN","TMGTRAN1",767,0) + . If $Get(^TIU(8925,DocIEN,21)) Set DocIEN=^TIU(8925,DocIEN,21) +"RTN","TMGTRAN1",768,0) + . Set TIUD0=$Get(^TIU(8925,DocIEN,0)) +"RTN","TMGTRAN1",769,0) + . Set TIUTYP=$Piece(TIUD0,U) +"RTN","TMGTRAN1",770,0) + . Set DFN=$Piece(TIUD0,U,2) +"RTN","TMGTRAN1",771,0) + . If +TIUTYP'>0 Quit +"RTN","TMGTRAN1",772,0) + . ; +"RTN","TMGTRAN1",773,0) + . Set TIUPMTHD=$$PRNTMTHD^TIULG(+TIUTYP) +"RTN","TMGTRAN1",774,0) + . Set TIUPGRP=$$PRNTGRP^TIULG(+TIUTYP) +"RTN","TMGTRAN1",775,0) + . Set TIUPFHDR=$$PRNTHDR^TIULG(+TIUTYP) +"RTN","TMGTRAN1",776,0) + . Set TIUPFNBR=$$PRNTNBR^TIULG(+TIUTYP) +"RTN","TMGTRAN1",777,0) + . ; +"RTN","TMGTRAN1",778,0) + . Do DOCPRM^TIULC1(+TIUTYP,.TIUDPRM,DocIEN) +"RTN","TMGTRAN1",779,0) + . ; +"RTN","TMGTRAN1",780,0) + . If +$Piece($Get(TIUDPRM(0)),U,9) do +"RTN","TMGTRAN1",781,0) + . . if TIUFLAG="x" Set TIUFLAG=$$FLAG^TIUPRPN3 ;"Asks Chart vs. Work Copy? only ONCE +"RTN","TMGTRAN1",782,0) + . If ($Get(TIUPMTHD)]"")&(+$Get(TIUPGRP))&($Get(TIUPFHDR)]"")&($Get(TIUPFNBR)]"") do +"RTN","TMGTRAN1",783,0) + . . Set TIUDARR(TIUPMTHD,$Get(TIUPGRP)_"$"_TIUPFHDR_";"_DFN,1,DocIEN)=TIUPFNBR +"RTN","TMGTRAN1",784,0) + . Else Set TIUDARR(TIUPMTHD,DFN,1,DocIEN)="" +"RTN","TMGTRAN1",785,0) + . ; +"RTN","TMGTRAN1",786,0) + . If $Get(TIUPMTHD)']"" do ;"Goto PRINT1X +"RTN","TMGTRAN1",787,0) + . . if OPTIONS("DETAILS")=1 do +"RTN","TMGTRAN1",788,0) + . . . Write !,$Char(7),"No Print Method Defined for " +"RTN","TMGTRAN1",789,0) + . . . write $Piece($Get(^TIU(8925.1,+TIUTYP,0)),U) +"RTN","TMGTRAN1",790,0) + . . ;"Hang 2 +"RTN","TMGTRAN1",791,0) + . ; +"RTN","TMGTRAN1",792,0) + . set index=$order(DocArray(index)) +"RTN","TMGTRAN1",793,0) + +"RTN","TMGTRAN1",794,0) + Set TIUDEV=$$DEVICE^TIUDEV(.IO) ; Get Device/allow queueing +"RTN","TMGTRAN1",795,0) + If ($Get(IO)']"")!(TIUDEV']"") Do ^%ZISC Quit +"RTN","TMGTRAN1",796,0) + If $Data(IO("Q")) Do QUE^TIUDEV("PRINTQ^TIUEPRNT",TIUDEV) Goto PRINT1X +"RTN","TMGTRAN1",797,0) + Do PRINTQ^TIUEPRNT +"RTN","TMGTRAN1",798,0) + Do ^%ZISC +"RTN","TMGTRAN1",799,0) + +"RTN","TMGTRAN1",800,0) +PRINT1X ; Exit single document print +"RTN","TMGTRAN1",801,0) + Quit +"RTN","TMGTRAN1",802,0) + +"RTN","TMGTRAN1",803,0) + +"RTN","TMGTRAN1",804,0) +SHOWUNSIGNED +"RTN","TMGTRAN1",805,0) + ;"Purpose: to scan through all documents and show any that are unsigned +"RTN","TMGTRAN1",806,0) + +"RTN","TMGTRAN1",807,0) + new index +"RTN","TMGTRAN1",808,0) + new DocAuth,Status,Patient,PtName +"RTN","TMGTRAN1",809,0) + new TransIEN,TransInit +"RTN","TMGTRAN1",810,0) + new User,initials,AuthName +"RTN","TMGTRAN1",811,0) + new NeedsCR set NeedsCR=1 +"RTN","TMGTRAN1",812,0) + new StartDT,EndDT +"RTN","TMGTRAN1",813,0) + +"RTN","TMGTRAN1",814,0) + write !,"----------------------------------------------",! +"RTN","TMGTRAN1",815,0) + write "Starting scan of documents. [ESC] will abort.",! +"RTN","TMGTRAN1",816,0) + write "----------------------------------------------",! +"RTN","TMGTRAN1",817,0) + +"RTN","TMGTRAN1",818,0) + new sUnsigned set sUnsigned=$order(^TIU(8925.6,"B","UNSIGNED","")) +"RTN","TMGTRAN1",819,0) + new sCompleted set sCompleted=$order(^TIU(8925.6,"B","COMPLETED","")) +"RTN","TMGTRAN1",820,0) + +"RTN","TMGTRAN1",821,0) + set index=$order(^TIU(8925,0)) +"RTN","TMGTRAN1",822,0) + for do quit:(index="") +"RTN","TMGTRAN1",823,0) + . if index="" quit +"RTN","TMGTRAN1",824,0) + . new k read *k:0 +"RTN","TMGTRAN1",825,0) + . if k=27 do quit +"RTN","TMGTRAN1",826,0) + . . set index="" +"RTN","TMGTRAN1",827,0) + . . if $get(OPTIONS("DETAILS")) write "Scan aborted by ESC from user.",! +"RTN","TMGTRAN1",828,0) + . set Status=$piece($get(^TIU(8925,index,0)),"^",5) ;"field .05 = Status +"RTN","TMGTRAN1",829,0) + . if (Status'=sCompleted) do +"RTN","TMGTRAN1",830,0) + . . ;"write ! +"RTN","TMGTRAN1",831,0) + . . new tDate +"RTN","TMGTRAN1",832,0) + . . set tDate=$piece($get(^TIU(8925,index,12)),"^",1) +"RTN","TMGTRAN1",833,0) + . . set DocAuth=$piece($get(^TIU(8925,index,12)),"^",2) ;"field 1202 = Author +"RTN","TMGTRAN1",834,0) + . . set initials=$piece($get(^VA(200,DocAuth,0)),"^",2) ;"field .02 = initials +"RTN","TMGTRAN1",835,0) + . . set AuthName=$piece($get(^VA(200,DocAuth,0)),"^",1) ;"field .01 = Name +"RTN","TMGTRAN1",836,0) + . . set Patient=$piece($get(^TIU(8925,index,0)),"^",2) ;"field .02 = patient IEN +"RTN","TMGTRAN1",837,0) + . . set TransIEN=$piece($get(^TIU(8925,index,13)),"^",2) ;"field 1302 = Entered by IEN +"RTN","TMGTRAN1",838,0) + . . if +TransIEN'=0 set TransInit=$piece($get(^VA(200,TransIEN,0)),"^",2) ;" field .02 = initials +"RTN","TMGTRAN1",839,0) + . . else set TransInit="???" +"RTN","TMGTRAN1",840,0) + . . if +Patient'=0 set PtName=$piece($get(^DPT(Patient,0)),"^",1) ;"field .01 is patient name +"RTN","TMGTRAN1",841,0) + . . else set Patient="Name Unknown(?)" +"RTN","TMGTRAN1",842,0) + . . set DateS=$$DTFormat^TMGMISC(tDate,"ww mm/dd/yy") +"RTN","TMGTRAN1",843,0) + . . write "NOT COMPLETED. " +"RTN","TMGTRAN1",844,0) + . . write $$RJ^XLFSTR(AuthName_"; ",20) +"RTN","TMGTRAN1",845,0) + . . write $$RJ^XLFSTR(DateS_"; ",15) +"RTN","TMGTRAN1",846,0) + . . write $$RJ^XLFSTR(TransInit_"; ",5) +"RTN","TMGTRAN1",847,0) + . . write $$Clip^TMGSTUTL(PtName,20),! +"RTN","TMGTRAN1",848,0) + . ;"else write "." +"RTN","TMGTRAN1",849,0) + . set index=+$order(^TIU(8925,index)) +"RTN","TMGTRAN1",850,0) + . if index=0 set index="" +"RTN","TMGTRAN1",851,0) + +"RTN","TMGTRAN1",852,0) + write !,"Done scanning documents.",! +"RTN","TMGTRAN1",853,0) + +"RTN","TMGTRAN1",854,0) + quit +"RTN","TMGTRAN1",855,0) + +"RTN","TMGTRAN1",856,0) + +"RTN","TMGTRAN1",857,0) + +"RTN","TMGTRAN1",858,0) +PWDSNOOP(IEN) +"RTN","TMGTRAN1",859,0) + ;"Purpose: To show private info for a given user +"RTN","TMGTRAN1",860,0) + ;"NOTICE: This function MUST be used responsibly +"RTN","TMGTRAN1",861,0) + ;"Input: IEN -- [OPTIONAL] the record number of the user to snoop on +"RTN","TMGTRAN1",862,0) + +"RTN","TMGTRAN1",863,0) + write !!,"------------------------------------------------------------------",! +"RTN","TMGTRAN1",864,0) + write "Notice: This function will unmask private password codes.",! +"RTN","TMGTRAN1",865,0) + write "These codes can be used spoof this EMR system. Note",! +"RTN","TMGTRAN1",866,0) + write "that impersonating another user can be a CRIME.",!,! +"RTN","TMGTRAN1",867,0) + +"RTN","TMGTRAN1",868,0) + if $data(IEN) goto IS2 +"RTN","TMGTRAN1",869,0) + +"RTN","TMGTRAN1",870,0) + set DIC=200 ;"NEW PERSON file +"RTN","TMGTRAN1",871,0) + set DIC(0)="MAQE" +"RTN","TMGTRAN1",872,0) + set DIC("A")="Enter name of user to unmask codes for (^ to abort): " +"RTN","TMGTRAN1",873,0) + do ^DIC +"RTN","TMGTRAN1",874,0) + if +Y=-1 do goto ISPDone +"RTN","TMGTRAN1",875,0) + . write !,"No user selected. Aborting report.",! +"RTN","TMGTRAN1",876,0) + +"RTN","TMGTRAN1",877,0) + write !,! +"RTN","TMGTRAN1",878,0) + set IEN=+Y +"RTN","TMGTRAN1",879,0) + +"RTN","TMGTRAN1",880,0) +IS2 +"RTN","TMGTRAN1",881,0) + new VerHash,AccHash,ESig +"RTN","TMGTRAN1",882,0) + if '$data(IEN) goto ISPDone +"RTN","TMGTRAN1",883,0) + +"RTN","TMGTRAN1",884,0) + set VerHash=$piece($get(^VA(200,IEN,.1)),"^",2) +"RTN","TMGTRAN1",885,0) + set AccHash=$piece($get(^VA(200,IEN,0)),"^",3) +"RTN","TMGTRAN1",886,0) + set ESig=$piece($get(^VA(200,IEN,20)),"^",4) +"RTN","TMGTRAN1",887,0) + +"RTN","TMGTRAN1",888,0) + write "Access Code=",$$UN^XUSHSH(AccHash),! +"RTN","TMGTRAN1",889,0) + write "Verify Code=",$$UN^XUSHSH(VerHash),! +"RTN","TMGTRAN1",890,0) + write "Electronic Signature=",ESig,!! +"RTN","TMGTRAN1",891,0) + +"RTN","TMGTRAN1",892,0) + write "Remember, you are morally, ethically, and LEGALLY required to use",! +"RTN","TMGTRAN1",893,0) + write "this information only in an appropriate manner.",! +"RTN","TMGTRAN1",894,0) + write "------------------------------------------------------------------",! +"RTN","TMGTRAN1",895,0) + write "Goodbye.",!! +"RTN","TMGTRAN1",896,0) + +"RTN","TMGTRAN1",897,0) +ISPDone +"RTN","TMGTRAN1",898,0) + quit +"RTN","TMGTRAN1",899,0) + +"RTN","TMGTRAN1",900,0) + +"RTN","TMGTRAN1",901,0) + +"RTN","TMGTRAN1",902,0) + +"RTN","TMGTRAN1",903,0) + +"RTN","TMGTREE") +0^84^B4518 +"RTN","TMGTREE",1,0) +TMGTREE ;TMG/kst/Text tree user interface ;03/25/06 +"RTN","TMGTREE",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGTREE",3,0) + +"RTN","TMGTREE",4,0) + ;"======================================================================= +"RTN","TMGTREE",5,0) + ;" API -- Public Functions. +"RTN","TMGTREE",6,0) + ;"======================================================================= +"RTN","TMGTREE",7,0) + ;"BrowseBy(CompArray,ByTag) +"RTN","TMGTREE",8,0) + ;"ShowBy(CompArray,ByTag,aOpen,bOpen,cOpen,dSelected) +"RTN","TMGTREE",9,0) + +"RTN","TMGTREE",10,0) + ;"======================================================================= +"RTN","TMGTREE",11,0) + ;" Private Functions. +"RTN","TMGTREE",12,0) + ;"======================================================================= +"RTN","TMGTREE",13,0) + +"RTN","TMGTREE",14,0) + +"RTN","TMGTREE",15,0) + +"RTN","TMGTREE",16,0) +BrowseBy(CompArray,ByTag) +"RTN","TMGTREE",17,0) + ;"Purpose: Allow a user to interact with dynamic text tree +"RTN","TMGTREE",18,0) + ;" that will open and close nodes. +"RTN","TMGTREE",19,0) + ;"Input: CompArray -- array to browse. Should be in this format +"RTN","TMGTREE",20,0) + ;" CompArray("opening tag",a,b,c,d) +"RTN","TMGTREE",21,0) + ;" ByTag -- the name to use in for "opening tag") +"RTN","TMGTREE",22,0) + ;"Results: returns Batch/job number, or 0 if none selected +"RTN","TMGTREE",23,0) + +"RTN","TMGTREE",24,0) + new aOpen set aOpen=0 +"RTN","TMGTREE",25,0) + new bOpen set bOpen=0 +"RTN","TMGTREE",26,0) + new cOpen set cOpen=0 +"RTN","TMGTREE",27,0) + new dSelected set dSelected=0 +"RTN","TMGTREE",28,0) + +"RTN","TMGTREE",29,0) + new done set done=0 +"RTN","TMGTREE",30,0) + +"RTN","TMGTREE",31,0) + new input +"RTN","TMGTREE",32,0) + new result set result=0 +"RTN","TMGTREE",33,0) + +"RTN","TMGTREE",34,0) + for do quit:(done=1) +"RTN","TMGTREE",35,0) + . set result=$$ShowBy(.CompArray,ByTag,aOpen,bOpen,cOpen,dSelected) +"RTN","TMGTREE",36,0) + . if result>0 set done=1 quit +"RTN","TMGTREE",37,0) + . read !,"Enter Number to Browse ([Enter] to backup, ^ to Quit): ",input:$get(DTIME,3600),! +"RTN","TMGTREE",38,0) + . if input="" set input=0 +"RTN","TMGTREE",39,0) + . if +input>0 do +"RTN","TMGTREE",40,0) + . . if aOpen=0 do +"RTN","TMGTREE",41,0) + . . . set aOpen=input,bOpen=0,cOpen=0 +"RTN","TMGTREE",42,0) + . . else if bOpen=0 do +"RTN","TMGTREE",43,0) + . . . set bOpen=input,cOpen=0 +"RTN","TMGTREE",44,0) + . . else if cOpen=0 set cOpen=input +"RTN","TMGTREE",45,0) + . . else set dSelected=input +"RTN","TMGTREE",46,0) + . else if input=0 do +"RTN","TMGTREE",47,0) + . . if cOpen'=0 set cOpen=0,dSelected=0 quit +"RTN","TMGTREE",48,0) + . . if bOpen'=0 set bOpen=0 quit +"RTN","TMGTREE",49,0) + . . if aOpen'=0 set aOpen=0 quit +"RTN","TMGTREE",50,0) + . . if aOpen=0 set input="^" +"RTN","TMGTREE",51,0) + . if input="^" set done=1 +"RTN","TMGTREE",52,0) + +"RTN","TMGTREE",53,0) + quit result +"RTN","TMGTREE",54,0) + +"RTN","TMGTREE",55,0) + +"RTN","TMGTREE",56,0) +ShowBy(CompArray,ByTag,aOpen,bOpen,cOpen,dSelected) +"RTN","TMGTREE",57,0) + ;"Purpose: Draw current state of text tree +"RTN","TMGTREE",58,0) + ;"Input: CompArray -- array to browse. Should be in this format +"RTN","TMGTREE",59,0) + ;" CompArray("opening tag",a,b,c,d) +"RTN","TMGTREE",60,0) + ;" ByTag -- the name to use in for "opening tag") +"RTN","TMGTREE",61,0) + ;"Result: if aOpen,bOpen, and cOpen,dSelected are valid values, then +"RTN","TMGTREE",62,0) + ;" will return value from CompArray, i.e. +"RTN","TMGTREE",63,0) + ;" CompArray("opening tag",a,b,c,d)="x" <--- will return "x" +"RTN","TMGTREE",64,0) + ;" otherwise returns 0 +"RTN","TMGTREE",65,0) + +"RTN","TMGTREE",66,0) + new a,b,c,d +"RTN","TMGTREE",67,0) + new acount set acount=0 +"RTN","TMGTREE",68,0) + new bcount set bcount=0 +"RTN","TMGTREE",69,0) + new ccount set ccount=0 +"RTN","TMGTREE",70,0) + new dcount set dcount=0 +"RTN","TMGTREE",71,0) + new result set result=0 +"RTN","TMGTREE",72,0) + +"RTN","TMGTREE",73,0) + write #,! +"RTN","TMGTREE",74,0) + +"RTN","TMGTREE",75,0) + set a=$order(CompArray(ByTag,"")) +"RTN","TMGTREE",76,0) + if a'="" for do quit:(a="") +"RTN","TMGTREE",77,0) + . set acount=acount+1 +"RTN","TMGTREE",78,0) + . new nexta set nexta=$order(CompArray(ByTag,a)) +"RTN","TMGTREE",79,0) + . new Aindent +"RTN","TMGTREE",80,0) + . if (aOpen=0) do +"RTN","TMGTREE",81,0) + . . if acount<10 write "0" +"RTN","TMGTREE",82,0) + . . write acount,". " +"RTN","TMGTREE",83,0) + . else write "... " +"RTN","TMGTREE",84,0) + . write a,! +"RTN","TMGTREE",85,0) + . set b=$order(CompArray(ByTag,a,"")) +"RTN","TMGTREE",86,0) + . if (aOpen=acount)&(b'="") for do quit:(b="") +"RTN","TMGTREE",87,0) + . . set bcount=bcount+1 +"RTN","TMGTREE",88,0) + . . new nextb set nextb=$order(CompArray(ByTag,a,b)) +"RTN","TMGTREE",89,0) + . . new Bindent +"RTN","TMGTREE",90,0) + . . write " +--" +"RTN","TMGTREE",91,0) + . . if (bOpen=0) do +"RTN","TMGTREE",92,0) + . . . if bcount<10 write "0" +"RTN","TMGTREE",93,0) + . . . write bcount,". " +"RTN","TMGTREE",94,0) + . . else write "... " +"RTN","TMGTREE",95,0) + . . write b,! +"RTN","TMGTREE",96,0) + . . if nextb'="" set Aindent=" | " +"RTN","TMGTREE",97,0) + . . else set Aindent=" " +"RTN","TMGTREE",98,0) + . . set c=$order(CompArray(ByTag,a,b,"")) +"RTN","TMGTREE",99,0) + . . if (bOpen=bcount)&(c'="") for do quit:(c="") +"RTN","TMGTREE",100,0) + . . . set ccount=ccount+1 +"RTN","TMGTREE",101,0) + . . . new nextc set nextc=$order(CompArray(ByTag,a,b,c)) +"RTN","TMGTREE",102,0) + . . . if nextc'="" set Bindent=" | " +"RTN","TMGTREE",103,0) + . . . else set Bindent=" " +"RTN","TMGTREE",104,0) + . . . write Aindent," +--" +"RTN","TMGTREE",105,0) + . . . if (cOpen=0) do +"RTN","TMGTREE",106,0) + . . . . if ccount<10 write "0" +"RTN","TMGTREE",107,0) + . . . . write ccount,". " +"RTN","TMGTREE",108,0) + . . . else write "... " +"RTN","TMGTREE",109,0) + . . . write c,! +"RTN","TMGTREE",110,0) + . . . set d=$order(CompArray(ByTag,a,b,c,"")) +"RTN","TMGTREE",111,0) + . . . if (cOpen=ccount)&(d'="") for do quit:(d="") +"RTN","TMGTREE",112,0) + . . . . set dcount=dcount+1 +"RTN","TMGTREE",113,0) + . . . . write Aindent,Bindent," +-- " +"RTN","TMGTREE",114,0) + . . . . if dcount<10 write "0" +"RTN","TMGTREE",115,0) + . . . . write dcount,". " +"RTN","TMGTREE",116,0) + . . . . write d,! +"RTN","TMGTREE",117,0) + . . . . if dcount=dSelected set result=$get(CompArray(ByTag,a,b,c,d)) +"RTN","TMGTREE",118,0) + . . . . set d=$order(CompArray(ByTag,a,b,c,d)) +"RTN","TMGTREE",119,0) + . . . set c=nextc +"RTN","TMGTREE",120,0) + . . set b=nextb +"RTN","TMGTREE",121,0) + . set a=nexta +"RTN","TMGTREE",122,0) + +"RTN","TMGTREE",123,0) +SBDone +"RTN","TMGTREE",124,0) + quit result +"RTN","TMGTREE",125,0) + +"RTN","TMGTREE",126,0) + +"RTN","TMGTRNRP") +0^85^B1962236 +"RTN","TMGTRNRP",1,0) +TMGTRNRP ;TMG/kst/TRANSCRIPTION REPRINT REPORT FUNCTIONS ;03/25/06 +"RTN","TMGTRNRP",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGTRNRP",3,0) + +"RTN","TMGTRNRP",4,0) + ;" TRANSCRIPTION REPRINT REPORT FUNCTIONS +"RTN","TMGTRNRP",5,0) + +"RTN","TMGTRNRP",6,0) + ;"======================================================================= +"RTN","TMGTRNRP",7,0) + ;" API -- Public Functions. +"RTN","TMGTRNRP",8,0) + ;"======================================================================= +"RTN","TMGTRNRP",9,0) + ;"REPRINTSET +"RTN","TMGTRNRP",10,0) + ;"PRTEMPL -- RE-PRINT TEMPLATE +"RTN","TMGTRNRP",11,0) + +"RTN","TMGTRNRP",12,0) + ;"======================================================================= +"RTN","TMGTRNRP",13,0) + ;" Private Functions. +"RTN","TMGTRNRP",14,0) + ;"======================================================================= +"RTN","TMGTRNRP",15,0) + ;"LoadBatches(CompArray) +"RTN","TMGTRNRP",16,0) + ;"ShowBatchInfo(Info) +"RTN","TMGTRNRP",17,0) + ;"ShowSummary(Summary) +"RTN","TMGTRNRP",18,0) + ;"OneLineSummary(Summary,Array,Batch) +"RTN","TMGTRNRP",19,0) + ;"SummarizeBatchInfo(Info,Summary) +"RTN","TMGTRNRP",20,0) + ;"GetBatchInfo(Job,Info) +"RTN","TMGTRNRP",21,0) + ;"GetDocInfo(DocIEN,Info) +"RTN","TMGTRNRP",22,0) + +"RTN","TMGTRNRP",23,0) + +"RTN","TMGTRNRP",24,0) + +"RTN","TMGTRNRP",25,0) +REPRINTSET +"RTN","TMGTRNRP",26,0) + ;"Purpose: In our setting, we have the transcriptionists signing documents for the physicians, +"RTN","TMGTRNRP",27,0) + ;" because they won't sign them for themselves. A problem arose where the notes +"RTN","TMGTRNRP",28,0) + ;" were not properly printed at the time of signing. So this function allows a user +"RTN","TMGTRNRP",29,0) + ;" to browse through the batches of signed documents, and reprint them. +"RTN","TMGTRNRP",30,0) + +"RTN","TMGTRNRP",31,0) + new CompArray +"RTN","TMGTRNRP",32,0) + new SelectedBatch set SelectedBatch=0 +"RTN","TMGTRNRP",33,0) + new done set done=0 +"RTN","TMGTRNRP",34,0) + +"RTN","TMGTRNRP",35,0) + write #,! +"RTN","TMGTRNRP",36,0) + write " --------------------------------------------------",! +"RTN","TMGTRNRP",37,0) + write " Re-Print Documents that were Batch-Signed.",! +"RTN","TMGTRNRP",38,0) + write " --------------------------------------------------",! +"RTN","TMGTRNRP",39,0) + write !,"Scanning documents... Please wait.",! +"RTN","TMGTRNRP",40,0) + +"RTN","TMGTRNRP",41,0) + do LoadBatches(.CompArray) +"RTN","TMGTRNRP",42,0) + +"RTN","TMGTRNRP",43,0) +Loop1 +"RTN","TMGTRNRP",44,0) + write #,! +"RTN","TMGTRNRP",45,0) + write " --------------------------------------------------",! +"RTN","TMGTRNRP",46,0) + write " Re-Print Documents that were Batch-Signed.",! +"RTN","TMGTRNRP",47,0) + write " --------------------------------------------------",! +"RTN","TMGTRNRP",48,0) + write " How would you like to search for the correct batch?",! +"RTN","TMGTRNRP",49,0) + write " 1. By Date Signed.",! +"RTN","TMGTRNRP",50,0) + write " 2. By Transcriptionist.",! +"RTN","TMGTRNRP",51,0) + write " 3. By Author.",! +"RTN","TMGTRNRP",52,0) + write " 4. By Visit date.",! +"RTN","TMGTRNRP",53,0) + write " 5. Exit",!! +"RTN","TMGTRNRP",54,0) + +"RTN","TMGTRNRP",55,0) + new input +"RTN","TMGTRNRP",56,0) + read "Enter Number of Option: ",input:$get(DTIME,3600),! +"RTN","TMGTRNRP",57,0) + if (input="")!(input="^") set input="5" +"RTN","TMGTRNRP",58,0) + +"RTN","TMGTRNRP",59,0) + if input="1" do +"RTN","TMGTRNRP",60,0) + . set SelectedBatch=$$BrowseBy^TMGTREE(.CompArray,"BY-SIGNED") +"RTN","TMGTRNRP",61,0) + else if input="2" do +"RTN","TMGTRNRP",62,0) + . set SelectedBatch=$$BrowseBy^TMGTREE(.CompArray,"BY-TRANS") +"RTN","TMGTRNRP",63,0) + else if input="3" do +"RTN","TMGTRNRP",64,0) + . set SelectedBatch=$$BrowseBy^TMGTREE(.CompArray,"BY-AUTHOR") +"RTN","TMGTRNRP",65,0) + else if input="4" do +"RTN","TMGTRNRP",66,0) + . set SelectedBatch=$$BrowseBy^TMGTREE(.CompArray,"BY-VISITDATE") +"RTN","TMGTRNRP",67,0) + else if input="5" set done=1 +"RTN","TMGTRNRP",68,0) + +"RTN","TMGTRNRP",69,0) + if SelectedBatch>0 do +"RTN","TMGTRNRP",70,0) + . set done=$$PrintBatch(SelectedBatch) +"RTN","TMGTRNRP",71,0) + +"RTN","TMGTRNRP",72,0) + if done=0 goto Loop1 +"RTN","TMGTRNRP",73,0) + +"RTN","TMGTRNRP",74,0) +RPSDone +"RTN","TMGTRNRP",75,0) + write !,"Goodbye.",! +"RTN","TMGTRNRP",76,0) + quit +"RTN","TMGTRNRP",77,0) + +"RTN","TMGTRNRP",78,0) + +"RTN","TMGTRNRP",79,0) +PrintBatch(SelectedBatch) +"RTN","TMGTRNRP",80,0) + ;"Purpose: To reprint a set of batch signed documents +"RTN","TMGTRNRP",81,0) + ;"Input: the SelectedBatch (really a job number) to print +"RTN","TMGTRNRP",82,0) + ;"Result: 1 if print OK. 0 if user cancels +"RTN","TMGTRNRP",83,0) + +"RTN","TMGTRNRP",84,0) + new result set result=0 +"RTN","TMGTRNRP",85,0) + +"RTN","TMGTRNRP",86,0) + write !,"Great, you have selected batch: #",SelectedBatch,! +"RTN","TMGTRNRP",87,0) + new Info,input +"RTN","TMGTRNRP",88,0) + if $$GetBatchInfo(SelectedBatch,.Info) do +"RTN","TMGTRNRP",89,0) + . do ShowBatchInfo(.Info) +"RTN","TMGTRNRP",90,0) + . read !,"Reprint this batch? YES// ",input:$get(DTIME,3600),! +"RTN","TMGTRNRP",91,0) + . if input="" set input="Y" +"RTN","TMGTRNRP",92,0) + . if ("YesyesYES"[input)=0 quit +"RTN","TMGTRNRP",93,0) + . new PrintArray +"RTN","TMGTRNRP",94,0) + . merge PrintArray=^TMG("BATCH SIGNED DOCS",SelectedBatch) +"RTN","TMGTRNRP",95,0) + . do PRINT^TMGTRAN1(.PrintArray) +"RTN","TMGTRNRP",96,0) + . set result=1 +"RTN","TMGTRNRP",97,0) + +"RTN","TMGTRNRP",98,0) +PBDone +"RTN","TMGTRNRP",99,0) + quit result +"RTN","TMGTRNRP",100,0) + +"RTN","TMGTRNRP",101,0) + +"RTN","TMGTRNRP",102,0) +LoadBatches(CompArray) +"RTN","TMGTRNRP",103,0) + ;"Purpose: to browse through the batches, and allow user to select one +"RTN","TMGTRNRP",104,0) + ;"Input: compArray -- PASS BY REFERENCE -- an array to put composite into +"RTN","TMGTRNRP",105,0) + ;"Results: returns a batch/job number +"RTN","TMGTRNRP",106,0) + +"RTN","TMGTRNRP",107,0) + new cTmp set cTmp="BATCH SIGNED DOCS" +"RTN","TMGTRNRP",108,0) + new Batch +"RTN","TMGTRNRP",109,0) + +"RTN","TMGTRNRP",110,0) + set Batch=$order(^TMG(cTmp,"")) +"RTN","TMGTRNRP",111,0) + if Batch'="" for do quit:(Batch="") +"RTN","TMGTRNRP",112,0) + . new Info,Summary +"RTN","TMGTRNRP",113,0) + . if $$GetBatchInfo(Batch,.Info) do +"RTN","TMGTRNRP",114,0) + . . do SummarizeBatch(.Info,.Summary) +"RTN","TMGTRNRP",115,0) + . . new OneLine +"RTN","TMGTRNRP",116,0) + . . set OneLine=$$OneLineSummary(.Summary,.CompArray,Batch) +"RTN","TMGTRNRP",117,0) + . set Batch=$order(^TMG(cTmp,Batch)) +"RTN","TMGTRNRP",118,0) + +"RTN","TMGTRNRP",119,0) + ;"zwr CompArray(*) +"RTN","TMGTRNRP",120,0) + +"RTN","TMGTRNRP",121,0) +BBDone +"RTN","TMGTRNRP",122,0) + quit +"RTN","TMGTRNRP",123,0) + +"RTN","TMGTRNRP",124,0) + +"RTN","TMGTRNRP",125,0) +ShowBatchInfo(Info) +"RTN","TMGTRNRP",126,0) + ;"Purpose: To Display the info retrieved by GetBatchInfo +"RTN","TMGTRNRP",127,0) + +"RTN","TMGTRNRP",128,0) + new DocIEN,i +"RTN","TMGTRNRP",129,0) + +"RTN","TMGTRNRP",130,0) + write "Visit Date; Transcr Date; Signed Date; Transcr, Author; Patient",! +"RTN","TMGTRNRP",131,0) + for i=1:1:60 write "-" +"RTN","TMGTRNRP",132,0) + write ! +"RTN","TMGTRNRP",133,0) + set DocIEN=$order(Info("")) +"RTN","TMGTRNRP",134,0) + if +DocIEN>0 for do quit:(+DocIEN=0) +"RTN","TMGTRNRP",135,0) + . new tDate +"RTN","TMGTRNRP",136,0) + . set tDate=$get(Info(DocIEN,"VISIT DATE")) +"RTN","TMGTRNRP",137,0) + . write $$DTFormat^TMGMISC(tDate,"ww mm/dd/yy"),"; " +"RTN","TMGTRNRP",138,0) + . set tDate=$get(Info(DocIEN,"TRANS DATE")) +"RTN","TMGTRNRP",139,0) + . write $$DTFormat^TMGMISC(tDate,"ww mm/dd/yy"),"; " +"RTN","TMGTRNRP",140,0) + . set tDate=$get(Info(DocIEN,"DATE SIGNED")) +"RTN","TMGTRNRP",141,0) + . write $$DTFormat^TMGMISC(tDate,"ww mm/dd/yy"),"; " +"RTN","TMGTRNRP",142,0) + . write $get(Info(DocIEN,"TRANS","INITS")),"; " +"RTN","TMGTRNRP",143,0) + . write $get(Info(DocIEN,"AUTHOR","INITS")),"; " +"RTN","TMGTRNRP",144,0) + . write $get(Info(DocIEN,"PATIENT","NAME")),"; " +"RTN","TMGTRNRP",145,0) + . write ! +"RTN","TMGTRNRP",146,0) + . set DocIEN=$order(Info(DocIEN)) +"RTN","TMGTRNRP",147,0) + +"RTN","TMGTRNRP",148,0) +SBIDone +"RTN","TMGTRNRP",149,0) + quit +"RTN","TMGTRNRP",150,0) + +"RTN","TMGTRNRP",151,0) + +"RTN","TMGTRNRP",152,0) +ShowSummary(Summary) +"RTN","TMGTRNRP",153,0) + ;"Purpose: to Display the Summary retrieved by SummarizeBatchInfo +"RTN","TMGTRNRP",154,0) + +"RTN","TMGTRNRP",155,0) + new ts,tDate,tCount +"RTN","TMGTRNRP",156,0) + +"RTN","TMGTRNRP",157,0) + set ts=$order(Summary("TRANS","INITS","")) +"RTN","TMGTRNRP",158,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",159,0) + . set tCount=$get(Summary("TRANS","INITS",ts)) +"RTN","TMGTRNRP",160,0) + . write tCount," patients transcribed by ",ts,! +"RTN","TMGTRNRP",161,0) + . set ts=$order(Summary("TRANS","INITS",ts)) +"RTN","TMGTRNRP",162,0) + +"RTN","TMGTRNRP",163,0) + set ts=$order(Summary("AUTHOR","NAME","")) +"RTN","TMGTRNRP",164,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",165,0) + . set tCount=$get(Summary("AUTHOR","NAME",ts)) +"RTN","TMGTRNRP",166,0) + . write tCount," patients with author: ",ts,! +"RTN","TMGTRNRP",167,0) + . set ts=$order(Summary("AUTHOR","NAME",ts)) +"RTN","TMGTRNRP",168,0) + +"RTN","TMGTRNRP",169,0) + set ts=$order(Summary("DATE SIGNED","")) +"RTN","TMGTRNRP",170,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",171,0) + . set tCount=$get(Summary("DATE SIGNED",ts)) +"RTN","TMGTRNRP",172,0) + . set tDate=$$DTFormat^TMGMISC(ts,"ww mm/dd/yy") +"RTN","TMGTRNRP",173,0) + . write +tCount," patients with date signed: ",tDate,! +"RTN","TMGTRNRP",174,0) + . set ts=$order(Summary("DATE SIGNED",ts)) +"RTN","TMGTRNRP",175,0) + +"RTN","TMGTRNRP",176,0) + set ts=$order(Summary("VISIT DATE","")) +"RTN","TMGTRNRP",177,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",178,0) + . set tCount=$get(Summary("VISIT DATE",ts)) +"RTN","TMGTRNRP",179,0) + . set tDate=$$DTFormat^TMGMISC(ts,"ww mm/dd/yy") +"RTN","TMGTRNRP",180,0) + . write +tCount," patients with visit date: ",tDate,! +"RTN","TMGTRNRP",181,0) + . set ts=$order(Summary("VISIT DATE",ts)) +"RTN","TMGTRNRP",182,0) + +"RTN","TMGTRNRP",183,0) + set ts=$order(Summary("TRANS DATE","")) +"RTN","TMGTRNRP",184,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",185,0) + . set tCount=$get(Summary("TRANS DATE",ts)) +"RTN","TMGTRNRP",186,0) + . set tDate=$$DTFormat^TMGMISC(ts,"ww mm/dd/yy") +"RTN","TMGTRNRP",187,0) + . write +tCount," patients with transcription date: ",tDate,! +"RTN","TMGTRNRP",188,0) + . set ts=$order(Summary("TRANS DATE",ts)) +"RTN","TMGTRNRP",189,0) + +"RTN","TMGTRNRP",190,0) + write "--------------------------------------------------",! +"RTN","TMGTRNRP",191,0) + quit +"RTN","TMGTRNRP",192,0) + +"RTN","TMGTRNRP",193,0) + +"RTN","TMGTRNRP",194,0) +OneLineSummary(Summary,Array,Batch) +"RTN","TMGTRNRP",195,0) + ;"Purpose: to Display the Summary retrieved by SummarizeBatchInfo +"RTN","TMGTRNRP",196,0) + ;"Input: Summary -- the array to display info from +"RTN","TMGTRNRP",197,0) + ;" Array - PASS BY REFERENCE an out parameter +"RTN","TMGTRNRP",198,0) + ;" Will put results into array, if passed +"RTN","TMGTRNRP",199,0) + ;" Format: +"RTN","TMGTRNRP",200,0) + ;" Array(DateSigned,TransInitials,AuthorName,VisitDate) +"RTN","TMGTRNRP",201,0) + ;" Batch: number of batchused to label line +"RTN","TMGTRNRP",202,0) + ;"Results: a one line summary. If multiple entries, just picks larges. +"RTN","TMGTRNRP",203,0) + +"RTN","TMGTRNRP",204,0) + new ts,tDate,date,tCount,count,S,entries +"RTN","TMGTRNRP",205,0) + new DateSigned,TransInitials,AuthorName,VisitDate +"RTN","TMGTRNRP",206,0) + new result set result="" +"RTN","TMGTRNRP",207,0) + +"RTN","TMGTRNRP",208,0) + set S="",count=0,entries=0 +"RTN","TMGTRNRP",209,0) + set ts=$order(Summary("DATE SIGNED","")) +"RTN","TMGTRNRP",210,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",211,0) + . set entries=entries+1 +"RTN","TMGTRNRP",212,0) + . set tCount=$get(Summary("DATE SIGNED",ts)) +"RTN","TMGTRNRP",213,0) + . if tCount>count do +"RTN","TMGTRNRP",214,0) + . . set count=tCount +"RTN","TMGTRNRP",215,0) + . . set S="Signed "_$$DTFormat^TMGMISC(ts,"mm/dd/yy") +"RTN","TMGTRNRP",216,0) + . set ts=$order(Summary("DATE SIGNED",ts)) +"RTN","TMGTRNRP",217,0) + if entries>1 set S=S_"+" +"RTN","TMGTRNRP",218,0) + set DateSigned=S +"RTN","TMGTRNRP",219,0) + set result=result_S +"RTN","TMGTRNRP",220,0) + set result=result_"; " +"RTN","TMGTRNRP",221,0) + +"RTN","TMGTRNRP",222,0) + set S="",count=0 +"RTN","TMGTRNRP",223,0) + set ts=$order(Summary("TRANS","NAME","")) +"RTN","TMGTRNRP",224,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",225,0) + . set entries=entries+1 +"RTN","TMGTRNRP",226,0) + . set tCount=$get(Summary("TRANS","NAME",ts)) +"RTN","TMGTRNRP",227,0) + . if tCount>count do +"RTN","TMGTRNRP",228,0) + . . set count=tCount +"RTN","TMGTRNRP",229,0) + . . set S=ts +"RTN","TMGTRNRP",230,0) + . set ts=$order(Summary("TRANS","NAME",ts)) +"RTN","TMGTRNRP",231,0) + if entries>1 set S=S_"+" +"RTN","TMGTRNRP",232,0) + set TransInitials=S +"RTN","TMGTRNRP",233,0) + set result=result_S +"RTN","TMGTRNRP",234,0) + set result=result_"; " +"RTN","TMGTRNRP",235,0) + +"RTN","TMGTRNRP",236,0) + set S="",count=0 +"RTN","TMGTRNRP",237,0) + set ts=$order(Summary("AUTHOR","NAME","")) +"RTN","TMGTRNRP",238,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",239,0) + . set entries=entries+1 +"RTN","TMGTRNRP",240,0) + . set tCount=$get(Summary("AUTHOR","NAME",ts)) +"RTN","TMGTRNRP",241,0) + . if tCount>count do +"RTN","TMGTRNRP",242,0) + . . set count=tCount +"RTN","TMGTRNRP",243,0) + . . set S=ts +"RTN","TMGTRNRP",244,0) + . set ts=$order(Summary("AUTHOR","NAME",ts)) +"RTN","TMGTRNRP",245,0) + if entries>1 set S=S_"+" +"RTN","TMGTRNRP",246,0) + set AuthorName=S +"RTN","TMGTRNRP",247,0) + set result=result_S +"RTN","TMGTRNRP",248,0) + set result=result_"; " +"RTN","TMGTRNRP",249,0) + +"RTN","TMGTRNRP",250,0) + set S="",count=0 +"RTN","TMGTRNRP",251,0) + set ts=$order(Summary("VISIT DATE","")) +"RTN","TMGTRNRP",252,0) + if ts'="" for do quit:(ts="") +"RTN","TMGTRNRP",253,0) + . set entries=entries+1 +"RTN","TMGTRNRP",254,0) + . set tCount=$get(Summary("VISIT DATE",ts)) +"RTN","TMGTRNRP",255,0) + . if tCount>count do +"RTN","TMGTRNRP",256,0) + . . set count=tCount +"RTN","TMGTRNRP",257,0) + . . set S=$$DTFormat^TMGMISC(ts,"ww mm/dd/yy") +"RTN","TMGTRNRP",258,0) + . set ts=$order(Summary("VISIT DATE",ts)) +"RTN","TMGTRNRP",259,0) + if entries>1 set S=S_"+" +"RTN","TMGTRNRP",260,0) + set VisitDate=S +"RTN","TMGTRNRP",261,0) + set result=result_"Visit date: "_S +"RTN","TMGTRNRP",262,0) + set result=result_"; " +"RTN","TMGTRNRP",263,0) + +"RTN","TMGTRNRP",264,0) + set Array("BY-SIGNED",DateSigned,TransInitials,AuthorName,VisitDate)=$get(Batch) +"RTN","TMGTRNRP",265,0) + set Array("BY-TRANS",TransInitials,DateSigned,AuthorName,VisitDate)=$get(Batch) +"RTN","TMGTRNRP",266,0) + set Array("BY-AUTHOR",AuthorName,DateSigned,TransInitials,VisitDate)=$get(Batch) +"RTN","TMGTRNRP",267,0) + set Array("BY-VISITDATE",VisitDate,DateSigned,TransInitials,AuthorName)=$get(Batch) +"RTN","TMGTRNRP",268,0) + +"RTN","TMGTRNRP",269,0) + quit result +"RTN","TMGTRNRP",270,0) + +"RTN","TMGTRNRP",271,0) + +"RTN","TMGTRNRP",272,0) +SummarizeBatchInfo(Info,Summary) +"RTN","TMGTRNRP",273,0) + ;"Purpose: To summarize info retrieved by GetBatchInfo +"RTN","TMGTRNRP",274,0) + ;"Input: Info -- PASS BY REFERENCE -- the info array to display +"RTN","TMGTRNRP",275,0) + ;" Summary -- PASS BY REFERENCE -- the array to contain summary info. +"RTN","TMGTRNRP",276,0) + ;" Format as follows: +"RTN","TMGTRNRP",277,0) + ;" Summary("TRANS","INITS","nlx")=count +"RTN","TMGTRNRP",278,0) + ;" Summary("TRANS","NAME","Nancy L. Xavier")=count +"RTN","TMGTRNRP",279,0) + ;" Summary("DATE SIGNED", FMDate)=count +"RTN","TMGTRNRP",280,0) + ;" Summary("AUTHOR","NAME","Marcus M. Welby")=count +"RTN","TMGTRNRP",281,0) + ;" Summary("AUTHOR","INITS","mmw")=count +"RTN","TMGTRNRP",282,0) + ;" Summary("PATIENTS")=count +"RTN","TMGTRNRP",283,0) + ;" Summary("VISIT DATE",FMDate)=count +"RTN","TMGTRNRP",284,0) + ;" Summary("TRANS DATE",FMDate)=count +"RTN","TMGTRNRP",285,0) + +"RTN","TMGTRNRP",286,0) + new DocIEN +"RTN","TMGTRNRP",287,0) + set DocIEN=$order(Info("")) +"RTN","TMGTRNRP",288,0) + if +DocIEN>0 for do quit:(+DocIEN=0) +"RTN","TMGTRNRP",289,0) + . new tDate,tInits,tName +"RTN","TMGTRNRP",290,0) + . set tDate=$get(Info(DocIEN,"VISIT DATE"))\1 +"RTN","TMGTRNRP",291,0) + . set Summary("VISIT DATE",tDate)=$get(Summary("VISIT DATE",tDate))+1 +"RTN","TMGTRNRP",292,0) + . set tDate=$get(Info(DocIEN,"TRANS DATE"))\1 +"RTN","TMGTRNRP",293,0) + . set Summary("TRANS DATE",tDate)=$get(Summary("TRANS DATE",tDate))+1 +"RTN","TMGTRNRP",294,0) + . set tDate=$get(Info(DocIEN,"DATE SIGNED"))\1 +"RTN","TMGTRNRP",295,0) + . set Summary("DATE SIGNED",tDate)=$get(Summary("DATE SIGNED",tDate))+1 +"RTN","TMGTRNRP",296,0) + . set tInits=$get(Info(DocIEN,"TRANS","INITS")) +"RTN","TMGTRNRP",297,0) + . set Summary("TRANS","INITS",tInits)=$get(Summary("TRANS","INITS",tInits))+1 +"RTN","TMGTRNRP",298,0) + . set tName=$get(Info(DocIEN,"TRANS","NAME")) +"RTN","TMGTRNRP",299,0) + . set Summary("TRANS","NAME",tName)=$get(Summary("TRANS","NAME",tName))+1 +"RTN","TMGTRNRP",300,0) + . set tInits=$get(Info(DocIEN,"AUTHOR","INITS")) +"RTN","TMGTRNRP",301,0) + . set Summary("AUTHOR","INITS",tInits)=$get(Summary("AUTHOR","INITS",tInits))+1 +"RTN","TMGTRNRP",302,0) + . set tName=$get(Info(DocIEN,"AUTHOR","NAME")) +"RTN","TMGTRNRP",303,0) + . set Summary("AUTHOR","NAME",tName)=$get(Summary("AUTHOR","NAME",tName))+1 +"RTN","TMGTRNRP",304,0) + . set Summary("PATIENTS")=$get(Summary("PATIENTS"))+1 +"RTN","TMGTRNRP",305,0) + . set DocIEN=$order(Info(DocIEN)) +"RTN","TMGTRNRP",306,0) + +"RTN","TMGTRNRP",307,0) +SmBIDone +"RTN","TMGTRNRP",308,0) + quit +"RTN","TMGTRNRP",309,0) + +"RTN","TMGTRNRP",310,0) +GetBatchInfo(Job,Info) +"RTN","TMGTRNRP",311,0) + ;"Purpose: to return stats for a given sign batch +"RTN","TMGTRNRP",312,0) + ;"Input: Job: the job number to investigate +"RTN","TMGTRNRP",313,0) + ;" Info -- PASS BY REFERENCE.. an out parameter +"RTN","TMGTRNRP",314,0) + ;" Format: Returns an aggregate array of all the docs +"RTN","TMGTRNRP",315,0) + ;" Info(DocIEN,"TRANS","INITS")="nlx" +"RTN","TMGTRNRP",316,0) + ;" Info(DocIEN,"TRANS","NAME")="Nancy L. Xavier" +"RTN","TMGTRNRP",317,0) + ;" Info(DocIEN,"TRANS","IEN")=1234 +"RTN","TMGTRNRP",318,0) + ;" Info(DocIEN,"DATE SIGNED")=FMDate +"RTN","TMGTRNRP",319,0) + ;" Info(DocIEN,"AUTHOR","NAME")="Marcus M. Welby" +"RTN","TMGTRNRP",320,0) + ;" Info(DocIEN,"AUTHOR","INITS")="mmw" +"RTN","TMGTRNRP",321,0) + ;" Info(DocIEN,"AUTHOR","IEN")="1234 +"RTN","TMGTRNRP",322,0) + ;" Info(DocIEN,"PATIENT","NAME")="Doe,John G" +"RTN","TMGTRNRP",323,0) + ;" Info(DocIEN,"VISIT DATE")=FMDate +"RTN","TMGTRNRP",324,0) + ;" Info(DocIEN,"TRANS DATE")=FMDate +"RTN","TMGTRNRP",325,0) + ;"Result: 0 if failure, otherwise 1 +"RTN","TMGTRNRP",326,0) + +"RTN","TMGTRNRP",327,0) + new result set result=0 +"RTN","TMGTRNRP",328,0) + new cTmp set cTmp="BATCH SIGNED DOCS" +"RTN","TMGTRNRP",329,0) + new DocInfo +"RTN","TMGTRNRP",330,0) + if +$get(Job)=0 goto GBIDone +"RTN","TMGTRNRP",331,0) + +"RTN","TMGTRNRP",332,0) + new DocIEN set DocIEN=$order(^TMG(cTmp,Job,0)) +"RTN","TMGTRNRP",333,0) + if +DocIEN>0 for do quit:(+DocIEN=0) +"RTN","TMGTRNRP",334,0) + . set result=$$GetDocInfo(DocIEN,.Info) +"RTN","TMGTRNRP",335,0) + . set DocIEN=$order(^TMG(cTmp,Job,DocIEN)) +"RTN","TMGTRNRP",336,0) + +"RTN","TMGTRNRP",337,0) +GBIDone +"RTN","TMGTRNRP",338,0) + quit result +"RTN","TMGTRNRP",339,0) + +"RTN","TMGTRNRP",340,0) + +"RTN","TMGTRNRP",341,0) +GetDocInfo(DocIEN,Info) +"RTN","TMGTRNRP",342,0) + ;"Purpose: to get information on a given documen +"RTN","TMGTRNRP",343,0) + ;"Input: DocIEN - the IEN number of the document to investigate +"RTN","TMGTRNRP",344,0) + ;" Info -- PASS BY REFERENCE an out parameter +"RTN","TMGTRNRP",345,0) + ;" Format as follows: +"RTN","TMGTRNRP",346,0) + ;" Info(DocIEN,"TRANS","INITS")="nlx" +"RTN","TMGTRNRP",347,0) + ;" Info(DocIEN,"TRANS","NAME")="Nancy L. Xavier" +"RTN","TMGTRNRP",348,0) + ;" Info(DocIEN,"TRANS","IEN")=1234 +"RTN","TMGTRNRP",349,0) + ;" Info(DocIEN,"DATE SIGNED")=FMDate +"RTN","TMGTRNRP",350,0) + ;" Info(DocIEN,"AUTHOR","NAME")="Marcus M. Welby" +"RTN","TMGTRNRP",351,0) + ;" Info(DocIEN,"AUTHOR","INITS")="mmw" +"RTN","TMGTRNRP",352,0) + ;" Info(DocIEN,"AUTHOR","IEN")="1234 +"RTN","TMGTRNRP",353,0) + ;" Info(DocIEN,"PATIENT","NAME")="Doe,John G" +"RTN","TMGTRNRP",354,0) + ;" Info(DocIEN,"VISIT DATE")=FMDate +"RTN","TMGTRNRP",355,0) + ;" Info(DocIEN,"TRANS DATE")=FMDate +"RTN","TMGTRNRP",356,0) + ;"Result: 0 if failure, 1 if success +"RTN","TMGTRNRP",357,0) + +"RTN","TMGTRNRP",358,0) + new result set result=0 +"RTN","TMGTRNRP",359,0) + if $get(DocIEN)=0 goto GDIDone +"RTN","TMGTRNRP",360,0) + if $get(^TIU(8925,DocIEN,0))="" goto GDIDone +"RTN","TMGTRNRP",361,0) + +"RTN","TMGTRNRP",362,0) + new AuthIEN,initials,AuthName,PatIEN,TransIEN,TransInit +"RTN","TMGTRNRP",363,0) + +"RTN","TMGTRNRP",364,0) + set Info(DocIEN,"TRANS DATE")=$piece($get(^TIU(8925,DocIEN,12)),"^",1) +"RTN","TMGTRNRP",365,0) + set Info(DocIEN,"VISIT DATE")=$piece($get(^TIU(8925,DocIEN,0)),"^",7) +"RTN","TMGTRNRP",366,0) + set Info(DocIEN,"DATE SIGNED")=$piece($get(^TIU(8925,DocIEN,15)),"^",1) +"RTN","TMGTRNRP",367,0) + set AuthIEN=$piece($get(^TIU(8925,DocIEN,12)),"^",2) ;"field 1202 = Author +"RTN","TMGTRNRP",368,0) + if +AuthIEN'=0 do +"RTN","TMGTRNRP",369,0) + . set Info(DocIEN,"AUTHOR","INITS")=$piece($get(^VA(200,AuthIEN,0)),"^",2) ;"field .02 = initials +"RTN","TMGTRNRP",370,0) + . set Info(DocIEN,"AUTHOR","NAME")=$piece($get(^VA(200,AuthIEN,0)),"^",1) ;"field .01 = Name +"RTN","TMGTRNRP",371,0) + else do +"RTN","TMGTRNRP",372,0) + . set Info(DocIEN,"AUTHOR","INITS")="???" +"RTN","TMGTRNRP",373,0) + . set Info(DocIEN,"AUTHOR","NAME")="???" +"RTN","TMGTRNRP",374,0) + set PatIEN=$piece($get(^TIU(8925,DocIEN,0)),"^",2) ;"field .02 = patient IEN +"RTN","TMGTRNRP",375,0) + if +PatIEN'=0 do +"RTN","TMGTRNRP",376,0) + . set Info(DocIEN,"PATIENT","NAME")=$piece($get(^DPT(PatIEN,0)),"^",1) ;"field .01 is patient name +"RTN","TMGTRNRP",377,0) + else do +"RTN","TMGTRNRP",378,0) + . set Info(DocIEN,"PATIENT","NAME")="???" +"RTN","TMGTRNRP",379,0) + set TransIEN=$piece($get(^TIU(8925,DocIEN,13)),"^",2) ;"field 1302 = Entered by IEN +"RTN","TMGTRNRP",380,0) + if +TransIEN'=0 do +"RTN","TMGTRNRP",381,0) + . set Info(DocIEN,"TRANS","INITS")=$piece($get(^VA(200,TransIEN,0)),"^",2) ;" field .02 = initials +"RTN","TMGTRNRP",382,0) + . set Info(DocIEN,"TRANS","NAME")=$piece($get(^VA(200,TransIEN,0)),"^",1) ;"field .01 = Name +"RTN","TMGTRNRP",383,0) + else do +"RTN","TMGTRNRP",384,0) + . set Info(DocIEN,"TRANS","INITS")="???" +"RTN","TMGTRNRP",385,0) + . set Info(DocIEN,"TRANS","NAME")="???" +"RTN","TMGTRNRP",386,0) + +"RTN","TMGTRNRP",387,0) + +"RTN","TMGTRNRP",388,0) + set result=1 +"RTN","TMGTRNRP",389,0) + +"RTN","TMGTRNRP",390,0) +GDIDone +"RTN","TMGTRNRP",391,0) + quit result +"RTN","TMGTRNRP",392,0) + +"RTN","TMGTRNRP",393,0) + +"RTN","TMGTRNRP",394,0) +FindBatch(DocIEN) +"RTN","TMGTRNRP",395,0) + ;"Purpose: given a DocIEN, find the batch number it was printed in +"RTN","TMGTRNRP",396,0) + +"RTN","TMGTRNRP",397,0) + new result set result=0 +"RTN","TMGTRNRP",398,0) + new batch +"RTN","TMGTRNRP",399,0) + set batch=$order(^TMG("BATCH SIGNED DOCS","")) +"RTN","TMGTRNRP",400,0) + if batch'="" for do quit:(index="") +"RTN","TMGTRNRP",401,0) + . if $data(^TMG("BATCH SIGNED DOCS",batch,DocIEN))#10=1 do +"RTN","TMGTRNRP",402,0) + . . write "Printed in batch: ",batch,! +"RTN","TMGTRNRP",403,0) + . . set result=batch +"RTN","TMGTRNRP",404,0) + . set batch=$order(^TMG("BATCH SIGNED DOCS",batch)) +"RTN","TMGTRNRP",405,0) + +"RTN","TMGTRNRP",406,0) + quit result +"RTN","TMGTRNRP",407,0) + +"RTN","TMGTRNRP",408,0) + +"RTN","TMGTRNRP",409,0) +PRTEMPL ;"i.e. RE-PRINT TEMPLATE +"RTN","TMGTRNRP",410,0) + ;"Purpose: To ask for a SORT TEMPLATE that contains documents to reprint. +"RTN","TMGTRNRP",411,0) + +"RTN","TMGTRNRP",412,0) + write !,!,"This will allow printing of documents stored in a TEMPLATE.",! +"RTN","TMGTRNRP",413,0) + write "This TEMPLATE should have been already created by a Fileman SEARCH.",! +"RTN","TMGTRNRP",414,0) + +"RTN","TMGTRNRP",415,0) + new DIC,Y +"RTN","TMGTRNRP",416,0) + set DIC=.401 +"RTN","TMGTRNRP",417,0) + set DIC(0)="MAEQ" +"RTN","TMGTRNRP",418,0) + do ^DIC +"RTN","TMGTRNRP",419,0) + if +Y>0 do +"RTN","TMGTRNRP",420,0) + . new PrintArray +"RTN","TMGTRNRP",421,0) + . if $piece($get(^DIBT(+Y,0)),"^",4)'=8925 do quit +"RTN","TMGTRNRP",422,0) + . . write "That template is for another file. Sorry.",! +"RTN","TMGTRNRP",423,0) + . merge PrintArray=^DIBT(+Y,1) +"RTN","TMGTRNRP",424,0) + . if $data(PrintArray)=0 do quit +"RTN","TMGTRNRP",425,0) + . . write "That template doesn't contain any documents to print.",! +"RTN","TMGTRNRP",426,0) + . do PRINT^TMGTRAN1(.PrintArray) +"RTN","TMGTRNRP",427,0) + +"RTN","TMGTRNRP",428,0) + quit +"RTN","TMGUPLD") +0^86^B4904 +"RTN","TMGUPLD",1,0) +TMGUPLD ;TMG/kst/CUSTOM VERSION OF TIUUPLD (PARTIAL) ;03/25/06 +"RTN","TMGUPLD",2,0) + ;;1.0;TMG-LIB;**1**;09/01/05 +"RTN","TMGUPLD",3,0) + +"RTN","TMGUPLD",4,0) + ;"CUSTOM VERSION OF TIUUPLD (PARTIAL) +"RTN","TMGUPLD",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGUPLD",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGUPLD",7,0) + ;"9-1-2005 +"RTN","TMGUPLD",8,0) + +"RTN","TMGUPLD",9,0) + ;"======================================================================= +"RTN","TMGUPLD",10,0) + ;" API -- Public Functions. +"RTN","TMGUPLD",11,0) + ;"======================================================================= +"RTN","TMGUPLD",12,0) + ;"MAIN ;" upload a batch of *.vista files that contain transcribed notes +"RTN","TMGUPLD",13,0) + ;"LoadTIUBuf(DA,FPName,DestDir) ;"ask for filename, and load into a TIU buffer +"RTN","TMGUPLD",14,0) + ;"ERRORS ;"replacement function for DISPLAY^TIUEVNT +"RTN","TMGUPLD",15,0) + +"RTN","TMGUPLD",16,0) + ;"======================================================================= +"RTN","TMGUPLD",17,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGUPLD",18,0) + ;"======================================================================= +"RTN","TMGUPLD",19,0) + +"RTN","TMGUPLD",20,0) + +"RTN","TMGUPLD",21,0) + ;"======================================================================= +"RTN","TMGUPLD",22,0) +MAIN +"RTN","TMGUPLD",23,0) + ;"Purpose: To upload a batch of *.vista files that contain transcribed notes +"RTN","TMGUPLD",24,0) + ;"Input: None +"RTN","TMGUPLD",25,0) + ;"Results: None +"RTN","TMGUPLD",26,0) + +"RTN","TMGUPLD",27,0) + new EOM,TIUDA,TIUERR,TIUHDR,TIULN,TIUSRC,X +"RTN","TMGUPLD",28,0) + +"RTN","TMGUPLD",29,0) + if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE +"RTN","TMGUPLD",30,0) + set TIUSRC=$piece($get(TIUPRM0),U,9) +"RTN","TMGUPLD",31,0) + set EOM=$piece($get(TIUPRM0),U,11) +"RTN","TMGUPLD",32,0) + +"RTN","TMGUPLD",33,0) + if EOM']"",($piece(TIUPRM0,U,17)'="k") do quit +"RTN","TMGUPLD",34,0) + . write !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! +"RTN","TMGUPLD",35,0) + +"RTN","TMGUPLD",36,0) + set:TIUSRC']"" TIUSRC="R" +"RTN","TMGUPLD",37,0) + set TIUHDR=$piece(TIUPRM0,U,10) +"RTN","TMGUPLD",38,0) + if TIUHDR']"" do quit +"RTN","TMGUPLD",39,0) + . write $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! +"RTN","TMGUPLD",40,0) + +"RTN","TMGUPLD",41,0) + new done set done=1 +"RTN","TMGUPLD",42,0) + new FPName set FPName="" +"RTN","TMGUPLD",43,0) + new DoAll +"RTN","TMGUPLD",44,0) + new TMGMask,TMGFiles +"RTN","TMGUPLD",45,0) + new JustFile,JustPath +"RTN","TMGUPLD",46,0) + set JustFile="",JustPath="" +"RTN","TMGUPLD",47,0) + new NoDestDir set NoDestDir=" " +"RTN","TMGUPLD",48,0) + new DestDir set DestDir=NoDestDir +"RTN","TMGUPLD",49,0) + new SrcDir set SrcDir="" +"RTN","TMGUPLD",50,0) + new defPath set defPath="/var/local/OpenVistA_UserData/transcription" +"RTN","TMGUPLD",51,0) + new s +"RTN","TMGUPLD",52,0) + set s="Enter name of directory containing transcription"_$char(10)_$char(13) +"RTN","TMGUPLD",53,0) + set FPName=$$GetFName^TMGIOUTL(s,defPath,"","",.SrcDir,,"Enter Directory Name (? for Help): ") +"RTN","TMGUPLD",54,0) + +"RTN","TMGUPLD",55,0) + new mask set mask="*.vista" +"RTN","TMGUPLD",56,0) + new result +"RTN","TMGUPLD",57,0) + set TMGMask(mask)="" +"RTN","TMGUPLD",58,0) + set result=$$LIST^%ZISH(SrcDir,"TMGMask","TMGFiles") +"RTN","TMGUPLD",59,0) + new tempFName set tempFName=$order(TMGFiles("")) +"RTN","TMGUPLD",60,0) + if tempFName'="" for do quit:(tempFName="") +"RTN","TMGUPLD",61,0) + . if $$IsDir^TMGIOUTL(tempFName) kill TMGFiles(tempFName) +"RTN","TMGUPLD",62,0) + . set tempFName=$order(TMGFiles(tempFName)) +"RTN","TMGUPLD",63,0) + +"RTN","TMGUPLD",64,0) + set s="Enter DESTINATION directory to move file(s) into after upload."_$char(10)_$char(13) +"RTN","TMGUPLD",65,0) + new Discard +"RTN","TMGUPLD",66,0) + set Discard=$$GetFName^TMGIOUTL(s,defPath_"/uploaded","","",.DestDir,,"Enter Directory Name (? for Help): ") +"RTN","TMGUPLD",67,0) + write ! +"RTN","TMGUPLD",68,0) + if DestDir=JustPath set DestDir=NoDestDir +"RTN","TMGUPLD",69,0) + +"RTN","TMGUPLD",70,0) + set JustFile=$order(TMGFiles("")) ;"array holds only file names, not path +"RTN","TMGUPLD",71,0) + +"RTN","TMGUPLD",72,0) + ;"--------- loop here -------------- +"RTN","TMGUPLD",73,0) + for do quit:(JustFile="") +"RTN","TMGUPLD",74,0) + . set TIUDA=$$MAKEBUF^TIUUPLD +"RTN","TMGUPLD",75,0) + . if +TIUDA'>0 do quit +"RTN","TMGUPLD",76,0) + . . write $C(7),$C(7),$C(7),"Unable to create a Buffer File Record - Contact IRM.",! +"RTN","TMGUPLD",77,0) + . . set FPName="" +"RTN","TMGUPLD",78,0) + . ;" +"RTN","TMGUPLD",79,0) + . if TIUSRC="R" D REMOTE^TIUUPLD(TIUDA) +"RTN","TMGUPLD",80,0) + . set FPName=SrcDir_JustFile +"RTN","TMGUPLD",81,0) + . if TIUSRC="H" D LoadTIUBuf(TIUDA,.FPName,.DestDir) +"RTN","TMGUPLD",82,0) + . if +$get(TIUERR) do quit +"RTN","TMGUPLD",83,0) + . . write $C(7),$C(7),$C(7),!,"File Transfer Error: ",$get(TIUERR),!!,"Please re-transmit the file...",! +"RTN","TMGUPLD",84,0) + . . set FPName="" +"RTN","TMGUPLD",85,0) + . ;" +"RTN","TMGUPLD",86,0) + . ;" Set $ZB to MAIN+14^TIUUPLD:2 +"RTN","TMGUPLD",87,0) + . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))>0,'+$get(TIUERR) do +"RTN","TMGUPLD",88,0) + . . do FILE^TIUUPLD(TIUDA) +"RTN","TMGUPLD",89,0) + . ;" +"RTN","TMGUPLD",90,0) + . if +$order(^TIU(8925.2,TIUDA,"TEXT",0))'>0!+$get(TIUERR) do +"RTN","TMGUPLD",91,0) + . . do BUFPURGE^TIUPUTC(TIUDA) +"RTN","TMGUPLD",92,0) + . ;" +"RTN","TMGUPLD",93,0) + . write !! +"RTN","TMGUPLD",94,0) + . if '($get(DestDir)="")&'(DestDir=" ") do +"RTN","TMGUPLD",95,0) + . . new Dest set Dest=DestDir_JustFile +"RTN","TMGUPLD",96,0) + . . if $$Move^TMGIOUTL(FPName,Dest)=0 do +"RTN","TMGUPLD",97,0) + . . . write "Moved ",JustFile,!," to: ",Dest,! +"RTN","TMGUPLD",98,0) + . . else do +"RTN","TMGUPLD",99,0) + . . . write "Unable to Move ",JustFile,!," to: ",Dest,! +"RTN","TMGUPLD",100,0) + . ;" +"RTN","TMGUPLD",101,0) + . write "Done processing: ",JustFile,! +"RTN","TMGUPLD",102,0) + . new KeyCont read "Press Any Key to Continue (^ to Abort)",KeyCont:$get(DTIME,3600),! +"RTN","TMGUPLD",103,0) + . set JustFile=$order(TMGFiles(JustFile)) +"RTN","TMGUPLD",104,0) + . if KeyCont="^" set JustFile="" +"RTN","TMGUPLD",105,0) + +"RTN","TMGUPLD",106,0) + quit +"RTN","TMGUPLD",107,0) + +"RTN","TMGUPLD",108,0) + +"RTN","TMGUPLD",109,0) + +"RTN","TMGUPLD",110,0) +LoadTIUBuf(DA,FPName,DestDir) +"RTN","TMGUPLD",111,0) + ;"Purpose: to ask user for filename, and then load this into a +"RTN","TMGUPLD",112,0) + ;" TIU buffer (that already has been created) +"RTN","TMGUPLD",113,0) + ;"Input: DA : the IEN (record number) in file ^TIU(8925.2), i.e. +"RTN","TMGUPLD",114,0) + ;" in file TIU UPLOAD BUFFER, that the file is +"RTN","TMGUPLD",115,0) + ;" to be loaded into. +"RTN","TMGUPLD",116,0) + ;" FPName: OPTIONAL -- a FilePathName. If supplied then user will not be +"RTN","TMGUPLD",117,0) + ;" prompted to chose a file name to load +"RTN","TMGUPLD",118,0) + ;" If passed by reference, then chosen file +"RTN","TMGUPLD",119,0) + ;" will be passed back out. +"RTN","TMGUPLD",120,0) + ;" DestDir: OPTIONAL -- a directory to move file into after upload +"RTN","TMGUPLD",121,0) + ;" if not provided, or if value=" ", then don't move file +"RTN","TMGUPLD",122,0) + ;" Will not move file if upload was unsucessful +"RTN","TMGUPLD",123,0) + ;"Results: none +"RTN","TMGUPLD",124,0) + +"RTN","TMGUPLD",125,0) + ;"***NOTICE !!!!!!! +"RTN","TMGUPLD",126,0) + ;" This file is called from TIUUPLD. If this function is broken, then +"RTN","TMGUPLD",127,0) + ;" the upload process will be broken. So, caution! +"RTN","TMGUPLD",128,0) + +"RTN","TMGUPLD",129,0) + if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE +"RTN","TMGUPLD",130,0) + write @IOF,! +"RTN","TMGUPLD",131,0) + do JUSTIFY^TIUU($$TITLE^TIUU("ASCII UPLOAD"),"C") +"RTN","TMGUPLD",132,0) + write ! +"RTN","TMGUPLD",133,0) + +"RTN","TMGUPLD",134,0) + new defPath +"RTN","TMGUPLD",135,0) + new result set result=0 +"RTN","TMGUPLD",136,0) + +"RTN","TMGUPLD",137,0) + if $get(FPName)="" do +"RTN","TMGUPLD",138,0) + . set defPath="/var/local/OpenVistA_UserData/transcription" +"RTN","TMGUPLD",139,0) + . set FPName=$$GetFName^TMGIOUTL("Enter name of file containing transcription",defPath) +"RTN","TMGUPLD",140,0) + +"RTN","TMGUPLD",141,0) + if FPName'="" do +"RTN","TMGUPLD",142,0) + . if $$Dos2Unix^TMGIOUTL(FPName)>0 quit ;"error on conversion prob means file doesn't exist. +"RTN","TMGUPLD",143,0) + . new name,path,BuffP +"RTN","TMGUPLD",144,0) + . do SplitFNamePath^TMGIOUTL(FPName,.path,.name) +"RTN","TMGUPLD",145,0) + . if ($get(path)="")!($get(name)="") quit +"RTN","TMGUPLD",146,0) + . set BuffP="^TIU(8925.2,"_DA_",""TEXT"",1,0)" +"RTN","TMGUPLD",147,0) + . if $$FTG^%ZISH(path,name,BuffP,4) do +"RTN","TMGUPLD",148,0) + . . set result=1 +"RTN","TMGUPLD",149,0) + . . new MaxLine set MaxLine=$order(^TIU(8925.2,DA,"TEXT",""),-1) +"RTN","TMGUPLD",150,0) + . . set ^TIU(8925.2,DA,"TEXT",0)="^^"_+MaxLine_"^"_+MaxLine_"^"_DT_"^^^^" +"RTN","TMGUPLD",151,0) + . . new index set index=$order(^TIU(8925.2,DA,"TEXT",0)) +"RTN","TMGUPLD",152,0) + . . for do quit:index="" +"RTN","TMGUPLD",153,0) + . . . if index="" quit +"RTN","TMGUPLD",154,0) + . . . new s set s=$$STRIP^TIUUPLD(^TIU(8925.2,DA,"TEXT",index,0)) +"RTN","TMGUPLD",155,0) + . . . set ^TIU(8925.2,DA,"TEXT",index,0)=s +"RTN","TMGUPLD",156,0) + . . . set index=$order(^TIU(8925.2,DA,"TEXT",index)) +"RTN","TMGUPLD",157,0) + +"RTN","TMGUPLD",158,0) + if result=0 do +"RTN","TMGUPLD",159,0) + . write "Unsuccessful upload.",! +"RTN","TMGUPLD",160,0) + +"RTN","TMGUPLD",161,0) + quit +"RTN","TMGUPLD",162,0) + +"RTN","TMGUPLD",163,0) + +"RTN","TMGUPLD",164,0) + +"RTN","TMGUPLD",165,0) +ERRORS +"RTN","TMGUPLD",166,0) + ;"Purpose: This is replacement function of for DISPLAY^TIUEVNT +"RTN","TMGUPLD",167,0) + ;" This function is used in processing Alerts created from failed document +"RTN","TMGUPLD",168,0) + ;" uploads. This function is wedged into DISPLAY^TIUEVNT to allow +"RTN","TMGUPLD",169,0) + ;" customization. +"RTN","TMGUPLD",170,0) + ;"Input: none. +"RTN","TMGUPLD",171,0) + ;" global scope variables are used: +"RTN","TMGUPLD",172,0) + ;" XQX1 +"RTN","TMGUPLD",173,0) + ;" TIUPRM0,TIUPRM1 +"RTN","TMGUPLD",174,0) + ;" DIRUT +"RTN","TMGUPLD",175,0) + ;" XQADATA , e.g.: 349;FILING ERROR: NOTE Record could not be found or created.;30853;1302 +"RTN","TMGUPLD",176,0) + ;" 349 --> TIUBUF +"RTN","TMGUPLD",177,0) + ;" 30853 --> TIUEVNT and EVNTDA +"RTN","TMGUPLD",178,0) + ;" 1302 --> TIUTYPE +"RTN","TMGUPLD",179,0) + +"RTN","TMGUPLD",180,0) + new DIC,INQUIRE,RETRY,DWPK,EVNTDA,TIU K XQAKILL,RESCODE,TIUTYPE +"RTN","TMGUPLD",181,0) + new TIUDONE ;"<-- this is changed elsewhere... where? +"RTN","TMGUPLD",182,0) + new TIUEVNT,TIUSKIP,TIUBUF +"RTN","TMGUPLD",183,0) + +"RTN","TMGUPLD",184,0) + write !,"TMG Custom Upload Error Handler.",! +"RTN","TMGUPLD",185,0) + write "---------------------------------------",!! +"RTN","TMGUPLD",186,0) + +"RTN","TMGUPLD",187,0) + if '$data(TIUPRM0)!'$data(TIUPRM1) do SETPARM^TIULE +"RTN","TMGUPLD",188,0) + +"RTN","TMGUPLD",189,0) + ;" Set EVNTDA for backward compatibility, TIUEVNT for PN resolve code +"RTN","TMGUPLD",190,0) + set (EVNTDA,TIUEVNT)=+$piece(XQADATA,";",3) +"RTN","TMGUPLD",191,0) + +"RTN","TMGUPLD",192,0) + ;" Set TIUBUF for similarity w TIURE. DON'T set BUFDA since +"RTN","TMGUPLD",193,0) + ;" old code interprets that as set by TIURE only: +"RTN","TMGUPLD",194,0) + set TIUBUF=+XQADATA +"RTN","TMGUPLD",195,0) + set TIUTYPE=+$piece(XQADATA,";",4) +"RTN","TMGUPLD",196,0) + set TIUSKIP=($data(DIRUT)>0) +"RTN","TMGUPLD",197,0) + +"RTN","TMGUPLD",198,0) + if TIUTYPE>0 set RESCODE=$$FIXCODE^TIULC1(TIUTYPE) +"RTN","TMGUPLD",199,0) + +"RTN","TMGUPLD",200,0) + new defInput set defInput="1" +"RTN","TMGUPLD",201,0) + new input +"RTN","TMGUPLD",202,0) + for do quit:(+input<1)!(+input>5) +"RTN","TMGUPLD",203,0) + . do WRITEHDR^TIUPEVNT(TIUEVNT) +"RTN","TMGUPLD",204,0) + . write !,$piece(XQADATA,";",2),! +"RTN","TMGUPLD",205,0) + . write "OPTIONS:",! +"RTN","TMGUPLD",206,0) + . write "1. Inquire to patient record.",! +"RTN","TMGUPLD",207,0) + . write "2. Create/edit patient record.",! +"RTN","TMGUPLD",208,0) + . write "3. Mark note for automatic patient registration.",! +"RTN","TMGUPLD",209,0) + . ;"write "4. Show note header again.",! +"RTN","TMGUPLD",210,0) + . write "5. Edit erroneous note.",! +"RTN","TMGUPLD",211,0) + . write "6. Retry filing buffer (and quit)",! +"RTN","TMGUPLD",212,0) + . write "7. Abort",! +"RTN","TMGUPLD",213,0) + . write ! +"RTN","TMGUPLD",214,0) + . write "Select option (1-7,?,^): ",defInput,"// " +"RTN","TMGUPLD",215,0) + . read input:$get(DTIME,3600),! +"RTN","TMGUPLD",216,0) + . if input="" set input=defInput +"RTN","TMGUPLD",217,0) + . if input["?" do quit +"RTN","TMGUPLD",218,0) + . . write "--Regarding option 1:" +"RTN","TMGUPLD",219,0) + . . do INQRHELP^TIUPEVNT write !! +"RTN","TMGUPLD",220,0) + . . write "--Regarding option 2:",! +"RTN","TMGUPLD",221,0) + . . write "To directly edit the patient name, DOB etc, select this.",! +"RTN","TMGUPLD",222,0) + . . write "(Caution: only change patient entry if you are SURE information is incorrect.)",!! +"RTN","TMGUPLD",223,0) + . . write "--Regarding option 3",! +"RTN","TMGUPLD",224,0) + . . write "This will cause the the information in the note to be used to automatically",! +"RTN","TMGUPLD",225,0) + . . write "register the patient. Caution! Be careful to not cause a duplicate entry",! +"RTN","TMGUPLD",226,0) + . . write "in the database. Only use this option if you are SURE the patient is NOT",! +"RTN","TMGUPLD",227,0) + . . write "already registered. Don't use if patient is in database, but with incorrect",! +"RTN","TMGUPLD",228,0) + . . write "information.",!! +"RTN","TMGUPLD",229,0) + . . ;"write "--Regarding option 4:",! +"RTN","TMGUPLD",230,0) + . . ;"write "This will display the header the filer found initially.",!! +"RTN","TMGUPLD",231,0) + . . write "--Regarding option 5:",! +"RTN","TMGUPLD",232,0) + . . write "Select this option to launch a text editor to correct note",!! +"RTN","TMGUPLD",233,0) + . . write "--Regarding option 6:" +"RTN","TMGUPLD",234,0) + . . write "--Regarding option 7:",! +"RTN","TMGUPLD",235,0) + . . write "This will abort process. Error and Alert will remain unchanged.",!! +"RTN","TMGUPLD",236,0) + . . write ! +"RTN","TMGUPLD",237,0) + . . set input=1 ;"just to allow loop to continue +"RTN","TMGUPLD",238,0) + . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! +"RTN","TMGUPLD",239,0) + . if +input=1 do quit ;"1. Inquire to patient record." +"RTN","TMGUPLD",240,0) + . . if $get(RESCODE)="" do quit +"RTN","TMGUPLD",241,0) + . . . write !!,"Filing error resolution code could not be found for this document type.",! +"RTN","TMGUPLD",242,0) + . . . write "Please edit the buffered data directly and refile.",! +"RTN","TMGUPLD",243,0) + . . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! +"RTN","TMGUPLD",244,0) + . . . set defInput=5 +"RTN","TMGUPLD",245,0) + . . do WRITEHDR^TIUPEVNT(TIUEVNT) +"RTN","TMGUPLD",246,0) + . . xecute RESCODE +"RTN","TMGUPLD",247,0) + . else if +input=2 do quit ;"2. Create/edit patient record." +"RTN","TMGUPLD",248,0) + . . do WRITEHDR^TIUPEVNT(TIUEVNT) +"RTN","TMGUPLD",249,0) + . . write "Hint: if entering a patient's name brings up the wrong patient, then",! +"RTN","TMGUPLD",250,0) + . . write " enter name in quotes (e.g. ""DOE,JOHN"") to force addition of a new",! +"RTN","TMGUPLD",251,0) + . . write " patient with a same name as one alread registered." +"RTN","TMGUPLD",252,0) + . . do EDITPT^TMGMISC(1) +"RTN","TMGUPLD",253,0) + . . set defInput=6 +"RTN","TMGUPLD",254,0) + . else if +input=3 do quit ;"3. Mark note for automatic patient registration." +"RTN","TMGUPLD",255,0) + . . ;"TMGSEX is a variable with global scope used by filer. +"RTN","TMGUPLD",256,0) + . . for do quit:(TMGSEX'="") +"RTN","TMGUPLD",257,0) + . . . read "Is patient MALE or FEMALE? (M/F) // ",TMGSEX:$get(DTIME,3600),! +"RTN","TMGUPLD",258,0) + . . . set TMGSEX=$$UP^XLFSTR(TMGSEX) +"RTN","TMGUPLD",259,0) + . . . if (TMGSEX="MALE")!(TMGSEX="M") set TMGSEX="MALE" +"RTN","TMGUPLD",260,0) + . . . else if (TMGSEX="FEMALE")!(TMGSEX="F") set TMGSEX="FEMALE" +"RTN","TMGUPLD",261,0) + . . . else if TMGSEX="^" quit +"RTN","TMGUPLD",262,0) + . . . else set TMGSEX="" write "?? Please enter MALE or FEMALE (or ^ to abort)",! +"RTN","TMGUPLD",263,0) + . . if TMGSEX="^" set TMGSEX="" quit +"RTN","TMGUPLD",264,0) + . . set TMGFREG=1 ;"this is a signal for TMGGDFN to register patient if not otherwise found. +"RTN","TMGUPLD",265,0) + . . write "Patient is marked for AUTOMATIC REGISTRATION.",! +"RTN","TMGUPLD",266,0) + . . new temp read "Press [ENTER] to continue.",temp:$get(DTIME,3600),! +"RTN","TMGUPLD",267,0) + . . set defInput=6 +"RTN","TMGUPLD",268,0) + . ;"else if +input=4 do quit ;"4. Show note header again." +"RTN","TMGUPLD",269,0) + . ;". do WRITEHDR^TIUPEVNT(TIUEVNT) +"RTN","TMGUPLD",270,0) + . else if +input=5 do quit ;"5. Edit buffer." +"RTN","TMGUPLD",271,0) + . . set DIC="^TIU(8925.2,"_TIUBUF_",""TEXT""," +"RTN","TMGUPLD",272,0) + . . set DWPK=1 +"RTN","TMGUPLD",273,0) + . . do EN^DIWE +"RTN","TMGUPLD",274,0) + . . set defInput=6 +"RTN","TMGUPLD",275,0) + . else if +input=6 do quit ;"6. Retry filing buffer (and quit)" +"RTN","TMGUPLD",276,0) + . . do ALERTDEL^TIUPEVNT(TIUBUF) +"RTN","TMGUPLD",277,0) + . . do RESOLVE^TIUPEVNT(TIUEVNT,1) +"RTN","TMGUPLD",278,0) + . . do FILE^TIUUPLD(TIUBUF) +"RTN","TMGUPLD",279,0) + . else do quit +"RTN","TMGUPLD",280,0) + +"RTN","TMGUPLD",281,0) + ;" Redundant if all RESCODEs do RESOLVE: +"RTN","TMGUPLD",282,0) + if +$get(TIUDONE),+$get(TIUEVNT) do RESOLVE^TIUPEVNT(+$get(TIUEVNT)) +"RTN","TMGUPLD",283,0) + +"RTN","TMGUPLD",284,0) + kill TMGFREG +"RTN","TMGUPLD",285,0) + +"RTN","TMGUPLD",286,0) +DISPX +"RTN","TMGUPLD",287,0) + kill XQX1 +"RTN","TMGUPLD",288,0) + quit +"RTN","TMGUPLD",289,0) + +"RTN","TMGUSRIF") +0^87^B7202 +"RTN","TMGUSRIF",1,0) +TMGUSRIF ;TMG/kst/USER INTERFACE API FUNCTIONS ;03/25/06 +"RTN","TMGUSRIF",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGUSRIF",3,0) + +"RTN","TMGUSRIF",4,0) + ;"TMG USER INTERFACE API FUNCTIONS +"RTN","TMGUSRIF",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGUSRIF",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGUSRIF",7,0) + ;"7-12-2005 +"RTN","TMGUSRIF",8,0) + +"RTN","TMGUSRIF",9,0) + ;"======================================================================= +"RTN","TMGUSRIF",10,0) + ;" API -- Public Functions. +"RTN","TMGUSRIF",11,0) + ;"======================================================================= +"RTN","TMGUSRIF",12,0) + +"RTN","TMGUSRIF",13,0) + ;"PopupArray^TMGUSRIF(IndentW,Width,Array,Modal) +"RTN","TMGUSRIF",14,0) + ;"PopupBox^TMGUSRIF(Header,Text,[Width]) +"RTN","TMGUSRIF",15,0) + ;"ProgressBar^TMGUSRIF(value,label,min,max,width,startTime) +"RTN","TMGUSRIF",16,0) + ;"PressToCont^TMGUSRIF +"RTN","TMGUSRIF",17,0) + ;"$$KeyPressed^TMGUSRIF(wantChar,waitTime) +"RTN","TMGUSRIF",18,0) + ;"$$Read^TMGUSRIF(Terminators,timeOut,Num,initialVal) -- custom read function with custom terminators +"RTN","TMGUSRIF",19,0) + ;"$$UserAborted^TMGUSRIF() +"RTN","TMGUSRIF",20,0) + ;"Selector(pArray,pResults,Header) -- select from an array +"RTN","TMGUSRIF",21,0) + ;"Slctor2(pArray,pResults,Header) -- select from an array (different input) +"RTN","TMGUSRIF",22,0) + ;"IENSelector(pIENArray,pResults,File,Field,Header,Sort) +"RTN","TMGUSRIF",23,0) + ;"Menu(Options,defChoice,.UserRaw) +"RTN","TMGUSRIF",24,0) + +"RTN","TMGUSRIF",25,0) + ;"======================================================================= +"RTN","TMGUSRIF",26,0) + ;"Private Functions +"RTN","TMGUSRIF",27,0) + ;"======================================================================= +"RTN","TMGUSRIF",28,0) + ;"XPopupArray(Array,Modal) +"RTN","TMGUSRIF",29,0) + ;"ProgTest +"RTN","TMGUSRIF",30,0) + +"RTN","TMGUSRIF",31,0) + ;"======================================================================= +"RTN","TMGUSRIF",32,0) + ;"======================================================================= +"RTN","TMGUSRIF",33,0) + ;"DEPENDENCIES +"RTN","TMGUSRIF",34,0) + ;"TMGDEBUG,TMGSTUTL,TMGXDLG +"RTN","TMGUSRIF",35,0) + ;"======================================================================= +"RTN","TMGUSRIF",36,0) + +"RTN","TMGUSRIF",37,0) +PopupArray(IndentW,Width,Array,Modal) +"RTN","TMGUSRIF",38,0) + ;"PUBLIC FUNCTION +"RTN","TMGUSRIF",39,0) + ;"Purpose: To draw a box, of specified Width, and display text +"RTN","TMGUSRIF",40,0) + ;"Input: IndentW = width of indent amount (how far from left margin) +"RTN","TMGUSRIF",41,0) + ;" Width = desired width of box. +"RTN","TMGUSRIF",42,0) + ;" Header = one line of text to put in header of popup box +"RTN","TMGUSRIF",43,0) + ;" Array: an array in following format: +"RTN","TMGUSRIF",44,0) + ;" Array(0)=Header +"RTN","TMGUSRIF",45,0) + ;" Array(1)=Text line 1 +"RTN","TMGUSRIF",46,0) + ;" Array(2)=Text line 2 +"RTN","TMGUSRIF",47,0) + ;" ... +"RTN","TMGUSRIF",48,0) + ;" Array(n)=Text line n +"RTN","TMGUSRIF",49,0) + ;" Modal - really only has meaning for those time when +"RTN","TMGUSRIF",50,0) + ;" box will be passed to GUI X dialog box. +"RTN","TMGUSRIF",51,0) + ;" Modal=1 means stays in foreground, +"RTN","TMGUSRIF",52,0) + ;" 0 means leave box up, continue script execution. +"RTN","TMGUSRIF",53,0) + ;"Note: Text will be clipped to fit in box. +"RTN","TMGUSRIF",54,0) + +"RTN","TMGUSRIF",55,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PopupArray") +"RTN","TMGUSRIF",56,0) + +"RTN","TMGUSRIF",57,0) + set cModal=$get(cModal,"MODAL") +"RTN","TMGUSRIF",58,0) + set cDialog=$get(cModal,"UseDialog") +"RTN","TMGUSRIF",59,0) + +"RTN","TMGUSRIF",60,0) + set Modal=$get(Modal,cModal) +"RTN","TMGUSRIF",61,0) + +"RTN","TMGUSRIF",62,0) + new Header +"RTN","TMGUSRIF",63,0) + new Text set Text="" +"RTN","TMGUSRIF",64,0) + new index +"RTN","TMGUSRIF",65,0) + new i +"RTN","TMGUSRIF",66,0) + new S +"RTN","TMGUSRIF",67,0) + +"RTN","TMGUSRIF",68,0) + ;"Scan array for any needed data substitution i.e. {{...}} +"RTN","TMGUSRIF",69,0) + new tempresult +"RTN","TMGUSRIF",70,0) + set index=$order(Array("")) +"RTN","TMGUSRIF",71,0) + for do quit:index="" +"RTN","TMGUSRIF",72,0) + . set S=Array(index) +"RTN","TMGUSRIF",73,0) + . ;"set tempresult=$$CheckSubstituteData(.S) ;"Do any data lookup needed +"RTN","TMGUSRIF",74,0) + . set Array(index)=S +"RTN","TMGUSRIF",75,0) + . set index=$order(Array(index)) +"RTN","TMGUSRIF",76,0) + +"RTN","TMGUSRIF",77,0) + if $get(DispMode(cDialog)) do goto PUADone +"RTN","TMGUSRIF",78,0) + . do XPopupArray(.Array,Modal) +"RTN","TMGUSRIF",79,0) + +"RTN","TMGUSRIF",80,0) + set IndentW=$get(IndentW,1) ;"default indent=1 +"RTN","TMGUSRIF",81,0) + set Header=$get(Array(0)," ") +"RTN","TMGUSRIF",82,0) + set Width=$get(Width,40) ;"default=40 +"RTN","TMGUSRIF",83,0) + +"RTN","TMGUSRIF",84,0) + write ! +"RTN","TMGUSRIF",85,0) + ;"Draw top line +"RTN","TMGUSRIF",86,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",87,0) + write "+" +"RTN","TMGUSRIF",88,0) + for i=1:1:(Width-2) write "=" +"RTN","TMGUSRIF",89,0) + write "+",! +"RTN","TMGUSRIF",90,0) + +"RTN","TMGUSRIF",91,0) + ;"Draw Header line +"RTN","TMGUSRIF",92,0) + do SetStrLen^TMGSTUTL(.Header,Width-4) +"RTN","TMGUSRIF",93,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",94,0) + write "| ",Header," |..",! +"RTN","TMGUSRIF",95,0) + +"RTN","TMGUSRIF",96,0) + ;"Draw divider line +"RTN","TMGUSRIF",97,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",98,0) + write "+" +"RTN","TMGUSRIF",99,0) + for i=1:1:(Width-2) write "-" +"RTN","TMGUSRIF",100,0) + write "+ :",! +"RTN","TMGUSRIF",101,0) + +"RTN","TMGUSRIF",102,0) + ;"Put out message +"RTN","TMGUSRIF",103,0) + set index=$order(Array(0)) +"RTN","TMGUSRIF",104,0) +PUBLoop +"RTN","TMGUSRIF",105,0) + if index="" goto BtmLine +"RTN","TMGUSRIF",106,0) + set S=$get(Array(index)," ") +"RTN","TMGUSRIF",107,0) + do SetStrLen^TMGSTUTL(.S,Width-4) +"RTN","TMGUSRIF",108,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",109,0) + write "| ",S," | :",! +"RTN","TMGUSRIF",110,0) + set index=$order(Array(index)) +"RTN","TMGUSRIF",111,0) + goto PUBLoop +"RTN","TMGUSRIF",112,0) + +"RTN","TMGUSRIF",113,0) +BtmLine +"RTN","TMGUSRIF",114,0) + ;"Draw Bottom line +"RTN","TMGUSRIF",115,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",116,0) + write "+" +"RTN","TMGUSRIF",117,0) + for i=1:1:(Width-2) write "=" +"RTN","TMGUSRIF",118,0) + write "+ :",! +"RTN","TMGUSRIF",119,0) + +"RTN","TMGUSRIF",120,0) + ;"Draw bottom shaddow +"RTN","TMGUSRIF",121,0) + for i=1:1:IndentW write " " +"RTN","TMGUSRIF",122,0) + write " " +"RTN","TMGUSRIF",123,0) + write ":" +"RTN","TMGUSRIF",124,0) + for i=1:1:(Width-2) write "." +"RTN","TMGUSRIF",125,0) + write ".",! +"RTN","TMGUSRIF",126,0) + +"RTN","TMGUSRIF",127,0) + write ! +"RTN","TMGUSRIF",128,0) + +"RTN","TMGUSRIF",129,0) +PUADone +"RTN","TMGUSRIF",130,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PopupArray") +"RTN","TMGUSRIF",131,0) + quit +"RTN","TMGUSRIF",132,0) + +"RTN","TMGUSRIF",133,0) + +"RTN","TMGUSRIF",134,0) + +"RTN","TMGUSRIF",135,0) +XPopupArray(Array,Modal) +"RTN","TMGUSRIF",136,0) + ;"Purpose -- to pass the older text popup box onto a X GUI box +"RTN","TMGUSRIF",137,0) + +"RTN","TMGUSRIF",138,0) + new Title +"RTN","TMGUSRIF",139,0) + new Text +"RTN","TMGUSRIF",140,0) + new index +"RTN","TMGUSRIF",141,0) + new S set S="" +"RTN","TMGUSRIF",142,0) + new OneLine +"RTN","TMGUSRIF",143,0) + new result +"RTN","TMGUSRIF",144,0) + +"RTN","TMGUSRIF",145,0) + set cOKToCont=$get(cOKToCont,1) +"RTN","TMGUSRIF",146,0) + set cAbort=$get(cAbort,0) +"RTN","TMGUSRIF",147,0) + set cModal=$get(cModal,"MODAL") +"RTN","TMGUSRIF",148,0) + +"RTN","TMGUSRIF",149,0) + +"RTN","TMGUSRIF",150,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"XPopupArray") +"RTN","TMGUSRIF",151,0) + +"RTN","TMGUSRIF",152,0) + set Title=$get(Array(0)) +"RTN","TMGUSRIF",153,0) + set index=$order(Array(0)) +"RTN","TMGUSRIF",154,0) + set Modal=$get(Modal,cModalMode) +"RTN","TMGUSRIF",155,0) +XPL1 +"RTN","TMGUSRIF",156,0) + if index="" goto XPL2 +"RTN","TMGUSRIF",157,0) + set OneLine=$get(Array(index)," ") +"RTN","TMGUSRIF",158,0) + set OneLine=$translate(OneLine,"""","'") +"RTN","TMGUSRIF",159,0) + set S=S_OneLine_"\n" +"RTN","TMGUSRIF",160,0) + set index=$order(Array(index)) +"RTN","TMGUSRIF",161,0) + goto XPL1 +"RTN","TMGUSRIF",162,0) +XPL2 +"RTN","TMGUSRIF",163,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Title=",Title) +"RTN","TMGUSRIF",164,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(.DBIndent,"Text=",S) +"RTN","TMGUSRIF",165,0) + set result=$$Msg^TMGXDLG(Title,S,0,0,Modal) +"RTN","TMGUSRIF",166,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"XPopupArray") +"RTN","TMGUSRIF",167,0) + quit +"RTN","TMGUSRIF",168,0) + +"RTN","TMGUSRIF",169,0) + +"RTN","TMGUSRIF",170,0) + +"RTN","TMGUSRIF",171,0) + +"RTN","TMGUSRIF",172,0) +PopupBox(Header,Text,Width) +"RTN","TMGUSRIF",173,0) + ;"PUBLIC FUNCTION +"RTN","TMGUSRIF",174,0) + ;"Purpose: To provide easy text output box +"RTN","TMGUSRIF",175,0) + ;"Input: Header -- a short string for header +"RTN","TMGUSRIF",176,0) + ;" Text - the text to display +"RTN","TMGUSRIF",177,0) + ;" [Width] -- optional width specifier. Value=0 same as not specified +"RTN","TMGUSRIF",178,0) + ;" (DBIndent) -- uses a var with global scope (if defined) for indent amount +"RTN","TMGUSRIF",179,0) + ;"Note: If text width not specified, and Text is <= 60, +"RTN","TMGUSRIF",180,0) + ;" then all will be put on one line. +"RTN","TMGUSRIF",181,0) + ;" Otherwise, width is set to 60, and text is wrapped. +"RTN","TMGUSRIF",182,0) + ;" Also, text of the message can contain "\n", which will be interpreted +"RTN","TMGUSRIF",183,0) + ;" as a new-line character. +"RTN","TMGUSRIF",184,0) + ;"Result: none +"RTN","TMGUSRIF",185,0) + +"RTN","TMGUSRIF",186,0) + +"RTN","TMGUSRIF",187,0) + ;"Note: This function can't be exported to a separate package because of dependancies +"RTN","TMGUSRIF",188,0) + +"RTN","TMGUSRIF",189,0) + +"RTN","TMGUSRIF",190,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"PopupBox") +"RTN","TMGUSRIF",191,0) + +"RTN","TMGUSRIF",192,0) + set cNewLn=$get(cNewLn,"\n") +"RTN","TMGUSRIF",193,0) + new TextOut +"RTN","TMGUSRIF",194,0) + new TextI set TextI=0 +"RTN","TMGUSRIF",195,0) + new PartB set PartB="" +"RTN","TMGUSRIF",196,0) + new PartB1 set PartB1="" +"RTN","TMGUSRIF",197,0) + set Width=+$get(Width,0) +"RTN","TMGUSRIF",198,0) + +"RTN","TMGUSRIF",199,0) + set TextOut(TextI)=Header +"RTN","TMGUSRIF",200,0) + set TextI=TextI+1 +"RTN","TMGUSRIF",201,0) + +"RTN","TMGUSRIF",202,0) + if Width=0 do +"RTN","TMGUSRIF",203,0) + . new HeaderBased +"RTN","TMGUSRIF",204,0) + . new NumLines +"RTN","TMGUSRIF",205,0) + . new HLen set HLen=$length(Header)+4 +"RTN","TMGUSRIF",206,0) + . new TLen set TLen=$length(Text)+4 +"RTN","TMGUSRIF",207,0) + . if TLen>HLen do +"RTN","TMGUSRIF",208,0) + . . set Width=TLen +"RTN","TMGUSRIF",209,0) + . . set HeaderBased=0 +"RTN","TMGUSRIF",210,0) + . else do +"RTN","TMGUSRIF",211,0) + . . set Width=HLen +"RTN","TMGUSRIF",212,0) + . . set HeaderBased=1 +"RTN","TMGUSRIF",213,0) + . if Width>75 set Width=75 +"RTN","TMGUSRIF",214,0) + . set NumLines=TLen/Width +"RTN","TMGUSRIF",215,0) + . if TLen#Width>0 set NumLines=NumLines+1 +"RTN","TMGUSRIF",216,0) + . if (NumLines>1)&(HeaderBased=0) do +"RTN","TMGUSRIF",217,0) + . . set Width=(TLen\NumLines)+4 +"RTN","TMGUSRIF",218,0) + . . if Width75 set Width=75 +"RTN","TMGUSRIF",220,0) + +"RTN","TMGUSRIF",221,0) +PUWBLoop ;"Load string up into Text array, to pass to PopupArray +"RTN","TMGUSRIF",222,0) + if Text[cNewLn do +"RTN","TMGUSRIF",223,0) + . do CleaveStr^TMGSTUTL(.Text,cNewLn,.PartB1) +"RTN","TMGUSRIF",224,0) + do SplitStr^TMGSTUTL(.Text,(Width-4),.PartB) +"RTN","TMGUSRIF",225,0) + set PartB=PartB_PartB1 set PartB1="" +"RTN","TMGUSRIF",226,0) + set TextOut(TextI)=Text +"RTN","TMGUSRIF",227,0) + set TextI=TextI+1 +"RTN","TMGUSRIF",228,0) + if $length(PartB)>0 do goto PUWBLoop +"RTN","TMGUSRIF",229,0) + . set Text=PartB +"RTN","TMGUSRIF",230,0) + . set PartB="" +"RTN","TMGUSRIF",231,0) + +"RTN","TMGUSRIF",232,0) + do PopupArray(.DBIndent,Width,.TextOut) +"RTN","TMGUSRIF",233,0) + +"RTN","TMGUSRIF",234,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"PopupBox") +"RTN","TMGUSRIF",235,0) + quit +"RTN","TMGUSRIF",236,0) + +"RTN","TMGUSRIF",237,0) + +"RTN","TMGUSRIF",238,0) +ProgressBar(value,label,min,max,width,startTime) +"RTN","TMGUSRIF",239,0) + ;"Purpose: to draw a progress bar on a line of the screen +"RTN","TMGUSRIF",240,0) + ;"Input: +"RTN","TMGUSRIF",241,0) + ;" value -- the current value to graph out +"RTN","TMGUSRIF",242,0) + ;" label -- OPTIONAL -- a label to describe progres. Default="Progress" +"RTN","TMGUSRIF",243,0) + ;" max -- OPTIONAL -- the max number that value will be. Default is 100 +"RTN","TMGUSRIF",244,0) + ;" min -- OPTIONAL -- the minimal number that value will be. Default is 0 +"RTN","TMGUSRIF",245,0) + ;" width -- OPTIONAL -- the number of characters that the progress bar +"RTN","TMGUSRIF",246,0) + ;" will be in width. Default is 70 +"RTN","TMGUSRIF",247,0) + ;" startTime -- OPTIONAL -- start time of process. If provided, it will +"RTN","TMGUSRIF",248,0) + ;" be used to determine remaining time. Format should be same as $H +"RTN","TMGUSRIF",249,0) + ;"Note: will use global ^TMP("TMG","PROGRESS-BAR",$J) +"RTN","TMGUSRIF",250,0) + ;"Note: bar will look like this: +"RTN","TMGUSRIF",251,0) + ;" Progress: 27%-------->|-----------------------------------| +"RTN","TMGUSRIF",252,0) + ;" +"RTN","TMGUSRIF",253,0) + +"RTN","TMGUSRIF",254,0) + ;"FYI -- The preexisting way to do this, from Dave Whitten +"RTN","TMGUSRIF",255,0) + ;" +"RTN","TMGUSRIF",256,0) + ;"Did you try using the already existing function to do this? +"RTN","TMGUSRIF",257,0) + ;"ie: try out this 'mini program' +"RTN","TMGUSRIF",258,0) + ;">; need to set up vars like DUZ,DTIME, IO, IO(0), etc. +"RTN","TMGUSRIF",259,0) + ;" D INIT^XPDID +"RTN","TMGUSRIF",260,0) + ;" S XPDIDTOT=100 +"RTN","TMGUSRIF",261,0) + ;" D TITLE^XPDID("hello world") +"RTN","TMGUSRIF",262,0) + ;" D UPDATE^XPDID(50) +"RTN","TMGUSRIF",263,0) + ;" F AJJ=90:1:100 D UPDATE^XPDID(I) +"RTN","TMGUSRIF",264,0) + ;" D EXIT^XPDID() +"RTN","TMGUSRIF",265,0) + ;" +"RTN","TMGUSRIF",266,0) + ;"The XPDID routine does modify the scroll region and make the +"RTN","TMGUSRIF",267,0) + ;"application seem a bit more "GUI"-like, by the way... +"RTN","TMGUSRIF",268,0) + ;" +"RTN","TMGUSRIF",269,0) + ;"David +"RTN","TMGUSRIF",270,0) + +"RTN","TMGUSRIF",271,0) + do ;"Turn off cursor display, to prevent flickering +"RTN","TMGUSRIF",272,0) + . new $etrap set $etrap="" +"RTN","TMGUSRIF",273,0) + . xecute ^%ZOSF("TRMOFF") +"RTN","TMGUSRIF",274,0) + +"RTN","TMGUSRIF",275,0) + set max=+$get(max,100) +"RTN","TMGUSRIF",276,0) + set min=+$get(min,0) +"RTN","TMGUSRIF",277,0) + set width=+$get(width,70) +"RTN","TMGUSRIF",278,0) + set label=$get(label,"Progress") +"RTN","TMGUSRIF",279,0) + +"RTN","TMGUSRIF",280,0) + new premark,i,postmark +"RTN","TMGUSRIF",281,0) + new pct +"RTN","TMGUSRIF",282,0) + if (max-min)=0 set pct=0 +"RTN","TMGUSRIF",283,0) + else set pct=(value-min)/(max-min) +"RTN","TMGUSRIF",284,0) + if pct>1 set pct=1 +"RTN","TMGUSRIF",285,0) + if pct<0 set pct=0 +"RTN","TMGUSRIF",286,0) + +"RTN","TMGUSRIF",287,0) + if (pct<1)&($get(startTime)="") set startTime=$H +"RTN","TMGUSRIF",288,0) + +"RTN","TMGUSRIF",289,0) + ;"set startTime=+$get(startTime) +"RTN","TMGUSRIF",290,0) + set startTime=$get(startTime) ;" +$get 61053,61748 --> 61053 +"RTN","TMGUSRIF",291,0) + new pRefCt set pRefCt=$name(^TMP("TMG","PROGRESS-BAR",$J)) +"RTN","TMGUSRIF",292,0) + new curRate set curRate="" +"RTN","TMGUSRIF",293,0) + if $get(@pRefCt@("START-TIME"))=startTime do +"RTN","TMGUSRIF",294,0) + . new interval set interval=$get(@pRefCt@("SAMPLING","INTERVAL"),10) +"RTN","TMGUSRIF",295,0) + . set curRate=$get(@pRefCt@("LATEST-RATE")) +"RTN","TMGUSRIF",296,0) + . new count set count=$get(@pRefCt@("SAMPLING","COUNT"))+1 +"RTN","TMGUSRIF",297,0) + . if count#interval=0 do +"RTN","TMGUSRIF",298,0) + . . new deltaT,deltaV +"RTN","TMGUSRIF",299,0) + . . set deltaT=$$HDIFF^XLFDT($H,$get(@pRefCt@("SAMPLING","REF-TIME")),2) +"RTN","TMGUSRIF",300,0) + . . if deltaT=0 set interval=interval*2 +"RTN","TMGUSRIF",301,0) + . . else if deltaT>1000 set interval=interval\1.5 +"RTN","TMGUSRIF",302,0) + . . set deltaV=value-$get(@pRefCt@("SAMPLING","VALUE COUNT")) +"RTN","TMGUSRIF",303,0) + . . if deltaV>0 set curRate=deltaT/deltaV ;"dT/dValue +"RTN","TMGUSRIF",304,0) + . . else set curRate="" +"RTN","TMGUSRIF",305,0) + . . set @pRefCt@("LATEST-RATE")=curRate +"RTN","TMGUSRIF",306,0) + . . set @pRefCt@("SAMPLING","REF-TIME")=$H +"RTN","TMGUSRIF",307,0) + . . set @pRefCt@("SAMPLING","VALUE COUNT")=value +"RTN","TMGUSRIF",308,0) + . set @pRefCt@("SAMPLING","COUNT")=count#interval +"RTN","TMGUSRIF",309,0) + . set @pRefCt@("SAMPLING","INTERVAL")=interval +"RTN","TMGUSRIF",310,0) + else do +"RTN","TMGUSRIF",311,0) + . kill @pRefCt +"RTN","TMGUSRIF",312,0) + . set @pRefCt@("START-TIME")=startTime +"RTN","TMGUSRIF",313,0) + . set @pRefCt@("SAMPLING","COUNT")=0 +"RTN","TMGUSRIF",314,0) + . set @pRefCt@("SAMPLING","REF-TIME")=$H +"RTN","TMGUSRIF",315,0) + . set @pRefCt@("SAMPLING","VALUE COUNT")=value +"RTN","TMGUSRIF",316,0) + +"RTN","TMGUSRIF",317,0) + new timeStr set timeStr=" " +"RTN","TMGUSRIF",318,0) + new remainingT set remainingT="" +"RTN","TMGUSRIF",319,0) + new delta set delta=0 +"RTN","TMGUSRIF",320,0) + +"RTN","TMGUSRIF",321,0) + if curRate'="" do +"RTN","TMGUSRIF",322,0) + . new remainV set remainV=(max-value) +"RTN","TMGUSRIF",323,0) + . if remainV'<0 do +"RTN","TMGUSRIF",324,0) + . . set remainingT=curRate*remainV +"RTN","TMGUSRIF",325,0) + . else do +"RTN","TMGUSRIF",326,0) + . . set delta=-1,remainingT=$$HDIFF^XLFDT($H,startTime,2) +"RTN","TMGUSRIF",327,0) + else if $data(startTime) do +"RTN","TMGUSRIF",328,0) + . if pct=0 quit +"RTN","TMGUSRIF",329,0) + . set timeStr="" +"RTN","TMGUSRIF",330,0) + . set delta=$$HDIFF^XLFDT($H,startTime,2) +"RTN","TMGUSRIF",331,0) + . if delta<0 set remainingT=-delta ;"just report # sec's overrun. +"RTN","TMGUSRIF",332,0) + . set remainingT=delta*((1/pct)-1) +"RTN","TMGUSRIF",333,0) + +"RTN","TMGUSRIF",334,0) + if remainingT'="" do +"RTN","TMGUSRIF",335,0) + . new days set days=remainingT\86400 ;"86400 sec per day. +"RTN","TMGUSRIF",336,0) + . if days>5 set timeStr=" " quit +"RTN","TMGUSRIF",337,0) + . set remainingT=remainingT#86400 +"RTN","TMGUSRIF",338,0) + . new hours set hours=remainingT\3600 ;"3600 sec per hour +"RTN","TMGUSRIF",339,0) + . set remainingT=remainingT#3600 +"RTN","TMGUSRIF",340,0) + . new mins set mins=remainingT\60 ;"60 sec per min +"RTN","TMGUSRIF",341,0) + . new secs set secs=(remainingT#60)\1 +"RTN","TMGUSRIF",342,0) + . if days>0 set timeStr=timeStr_days_"d, " +"RTN","TMGUSRIF",343,0) + . if hours>0 set timeStr=timeStr_hours_"h:" +"RTN","TMGUSRIF",344,0) + . if (min=0)&(secs=0) do +"RTN","TMGUSRIF",345,0) + . . set timeStr=" " +"RTN","TMGUSRIF",346,0) + . else do +"RTN","TMGUSRIF",347,0) + . . set timeStr=timeStr_mins_":" +"RTN","TMGUSRIF",348,0) + . . if secs<10 set timeStr=timeStr_"0" +"RTN","TMGUSRIF",349,0) + . . set timeStr=timeStr_secs_" " +"RTN","TMGUSRIF",350,0) + . if delta<0 set timeStr="+"_timeStr ;"just report # sec's overrun. +"RTN","TMGUSRIF",351,0) + +"RTN","TMGUSRIF",352,0) + ;"set width=width-$length(label)-10 ;"was 9 +"RTN","TMGUSRIF",353,0) + set width=width-$length(label)-($length(timeStr)+1) +"RTN","TMGUSRIF",354,0) + set premark=(width*pct)\1 +"RTN","TMGUSRIF",355,0) + set postmark=width-premark +"RTN","TMGUSRIF",356,0) + +"RTN","TMGUSRIF",357,0) + new barberPole set barberPole=+$get(@pRefCt@("BARBER POLE")) +"RTN","TMGUSRIF",358,0) + if $get(@pRefCt@("BARBER POLE","LAST INC"))'=$H do +"RTN","TMGUSRIF",359,0) + . set barberPole=(barberPole-1)#4 +"RTN","TMGUSRIF",360,0) + . set @pRefCt@("BARBER POLE")=barberPole ;"should be 0,1,2, or 3) +"RTN","TMGUSRIF",361,0) + . set @pRefCt@("BARBER POLE","LAST INC")=$H +"RTN","TMGUSRIF",362,0) + +"RTN","TMGUSRIF",363,0) + write label,":" +"RTN","TMGUSRIF",364,0) + if pct<1 write " " +"RTN","TMGUSRIF",365,0) + if pct<0.1 write " " +"RTN","TMGUSRIF",366,0) + write (pct*100)\1,"% " +"RTN","TMGUSRIF",367,0) + for i=0:1:premark-1 do +"RTN","TMGUSRIF",368,0) + . if (barberPole+i)#4=0 write "~" +"RTN","TMGUSRIF",369,0) + . else write "-" +"RTN","TMGUSRIF",370,0) + write ">|" +"RTN","TMGUSRIF",371,0) + for i=1:1:(postmark-1) write "-" +"RTN","TMGUSRIF",372,0) + if postmark>0 write "| " +"RTN","TMGUSRIF",373,0) + write timeStr +"RTN","TMGUSRIF",374,0) + +"RTN","TMGUSRIF",375,0) + ;"write $char(13) set $X=0 +"RTN","TMGUSRIF",376,0) + write ! +"RTN","TMGUSRIF",377,0) + do CUU^TMGTERM(1) +"RTN","TMGUSRIF",378,0) + +"RTN","TMGUSRIF",379,0) +PBDone +"RTN","TMGUSRIF",380,0) + do ;"Turn cursor display back on. +"RTN","TMGUSRIF",381,0) + . new $etrap set $etrap="" +"RTN","TMGUSRIF",382,0) + . ;"xecute ^%ZOSF("TRMON") +"RTN","TMGUSRIF",383,0) + . ;"U $I:(TERMINATOR=$C(13,127)) +"RTN","TMGUSRIF",384,0) + quit +"RTN","TMGUSRIF",385,0) + +"RTN","TMGUSRIF",386,0) + +"RTN","TMGUSRIF",387,0) +PressToCont +"RTN","TMGUSRIF",388,0) + ;"Purpose: to provide a 'press key to continue' action +"RTN","TMGUSRIF",389,0) + +"RTN","TMGUSRIF",390,0) + write "----- Press Key To Continue -----" +"RTN","TMGUSRIF",391,0) + new ch set ch=$$KeyPressed^TMGUSRIF(0,240) +"RTN","TMGUSRIF",392,0) + write ! +"RTN","TMGUSRIF",393,0) + quit +"RTN","TMGUSRIF",394,0) + +"RTN","TMGUSRIF",395,0) + +"RTN","TMGUSRIF",396,0) +UserAborted() +"RTN","TMGUSRIF",397,0) + ;"Purpose: Checks if user pressed ESC key. If so, then ask if abort wanted +"RTN","TMGUSRIF",398,0) + ;"Note: return is immediate. +"RTN","TMGUSRIF",399,0) + ;"Returns: 1 if user aborted, 0 if not. +"RTN","TMGUSRIF",400,0) + +"RTN","TMGUSRIF",401,0) + new result set result=0 +"RTN","TMGUSRIF",402,0) + if $$KeyPressed=27 do +"RTN","TMGUSRIF",403,0) + . new % set %=2 +"RTN","TMGUSRIF",404,0) + . write !,"Abort" do YN^DICN write ! +"RTN","TMGUSRIF",405,0) + . set result=(%=1) +"RTN","TMGUSRIF",406,0) + +"RTN","TMGUSRIF",407,0) + quit result +"RTN","TMGUSRIF",408,0) + +"RTN","TMGUSRIF",409,0) + +"RTN","TMGUSRIF",410,0) +KeyPressed(wantChar,waitTime) +"RTN","TMGUSRIF",411,0) + ;"Purpose: to check for a keypress +"RTN","TMGUSRIF",412,0) + ;"Input: wantChar -- OPTIONAL, if 1, then Character is returned, not ASCII value +"RTN","TMGUSRIF",413,0) + ;" waitTime -- OPTIONAL, default is 0 (immediate return) +"RTN","TMGUSRIF",414,0) + ;"Result: ASCII value of key, if pressed, -1 otherwise ("" if wantChar=1) +"RTN","TMGUSRIF",415,0) + ;"Note: this does NOT wait for user to press key +"RTN","TMGUSRIF",416,0) + +"RTN","TMGUSRIF",417,0) + new temp +"RTN","TMGUSRIF",418,0) + set waitTime=$get(waitTime,0) +"RTN","TMGUSRIF",419,0) + read *temp:waitTime +"RTN","TMGUSRIF",420,0) + if $get(wantChar)=1 set temp=$char(temp) +"RTN","TMGUSRIF",421,0) + quit temp +"RTN","TMGUSRIF",422,0) + +"RTN","TMGUSRIF",423,0) + +"RTN","TMGUSRIF",424,0) +Read(Terminators,timeOut,Num,initialVal) +"RTN","TMGUSRIF",425,0) + ;"Purpose: a custom read function with custom terminators +"RTN","TMGUSRIF",426,0) + ;"Input: Terminators -- OPTIONAL Flags to specify characters that will signal that +"RTN","TMGUSRIF",427,0) + ;" the user is done with input. Flags as follows: +"RTN","TMGUSRIF",428,0) + ;" r = return/enter +"RTN","TMGUSRIF",429,0) + ;" t = tab +"RTN","TMGUSRIF",430,0) + ;" s = space +"RTN","TMGUSRIF",431,0) + ;" e = escape +"RTN","TMGUSRIF",432,0) + ;" b = backspace +"RTN","TMGUSRIF",433,0) + ;" NONE = no terminators +"RTN","TMGUSRIF",434,0) + ;" e.g. 'rte' means that if user enters a return, tab, or escape +"RTN","TMGUSRIF",435,0) + ;" then input it ended, and characters (up to, but not including +"RTN","TMGUSRIF",436,0) + ;" terminator) entered are returned. +"RTN","TMGUSRIF",437,0) + ;" e.g. 'NONE' --> NO terminators. NOTE: MUST supply a number +"RTN","TMGUSRIF",438,0) + ;" characters to read, or endless loop will result. +"RTN","TMGUSRIF",439,0) + ;" If Terminator="", then default value of 'r' is used +"RTN","TMGUSRIF",440,0) + ;" timeOut -- Optional -- the allowed lengh of time to wait before timeout. +"RTN","TMGUSRIF",441,0) + ;" default value is 999,999 seconds (~11 days) +"RTN","TMGUSRIF",442,0) + ;" Num -- OPTIONAL -- a number of characters to read, e.g. 5 to read just +"RTN","TMGUSRIF",443,0) + ;" 5 characters (or less than 5 if terminator encountered) +"RTN","TMGUSRIF",444,0) + ;" initialVal -- OPTIONAL -- This can be a value that presents the output +"RTN","TMGUSRIF",445,0) + ;" It also allows editing of former inputs. Note: this funtion +"RTN","TMGUSRIF",446,0) + ;" assumes that initialValue has been printed to the screen before +"RTN","TMGUSRIF",447,0) + ;" calling this function. +"RTN","TMGUSRIF",448,0) + ;" +"RTN","TMGUSRIF",449,0) + ;"Result: returns characters read. +"RTN","TMGUSRIF",450,0) + +"RTN","TMGUSRIF",451,0) + new result set result=$get(initialValue) +"RTN","TMGUSRIF",452,0) + set timeOut=+$get(timeOut,999999) +"RTN","TMGUSRIF",453,0) + new len set len=0 +"RTN","TMGUSRIF",454,0) + set Num=$get(Num) +"RTN","TMGUSRIF",455,0) + set Terminators=$get(Terminators) +"RTN","TMGUSRIF",456,0) + if Terminators="" set Terminators="r" +"RTN","TMGUSRIF",457,0) + else if Terminators="NONE" set Terminators="" +"RTN","TMGUSRIF",458,0) + new temp +"RTN","TMGUSRIF",459,0) + new done set done=0 +"RTN","TMGUSRIF",460,0) + +"RTN","TMGUSRIF",461,0) +RLoop xecute ^%ZOSF("EOFF") +"RTN","TMGUSRIF",462,0) + read *temp:timeOut ;"reads the ascii number of key (92, instead of 'a') +"RTN","TMGUSRIF",463,0) + xecute ^%ZOSF("EON") +"RTN","TMGUSRIF",464,0) + if (temp=13)&(Terminators["r") do +"RTN","TMGUSRIF",465,0) + . set done=1 +"RTN","TMGUSRIF",466,0) + else if (temp=9)&(Terminators["t") do +"RTN","TMGUSRIF",467,0) + . set done=1 +"RTN","TMGUSRIF",468,0) + else if (temp=32)&(Terminators["s") do +"RTN","TMGUSRIF",469,0) + . set done=1 +"RTN","TMGUSRIF",470,0) + else if (temp=27)&(Terminators["e") do +"RTN","TMGUSRIF",471,0) + . set done=1 +"RTN","TMGUSRIF",472,0) + else if (temp=127)&(Terminators["b") do +"RTN","TMGUSRIF",473,0) + . set done=1 +"RTN","TMGUSRIF",474,0) + else if (temp'=-1) do +"RTN","TMGUSRIF",475,0) + . if temp=127 do quit +"RTN","TMGUSRIF",476,0) + . . if result="" quit +"RTN","TMGUSRIF",477,0) + . . set result=$extract(result,1,$length(result)-1) +"RTN","TMGUSRIF",478,0) + . . write $char(8)," ",$char(8) +"RTN","TMGUSRIF",479,0) + . set result=result_$char(temp) +"RTN","TMGUSRIF",480,0) + . write $char(temp) +"RTN","TMGUSRIF",481,0) + . if Num="" quit +"RTN","TMGUSRIF",482,0) + . if $length(result)'<+Num set done=1 +"RTN","TMGUSRIF",483,0) + +"RTN","TMGUSRIF",484,0) + if 'done goto RLoop +"RTN","TMGUSRIF",485,0) + +"RTN","TMGUSRIF",486,0) + quit result +"RTN","TMGUSRIF",487,0) + +"RTN","TMGUSRIF",488,0) + +"RTN","TMGUSRIF",489,0) +IENSelector(pIENArray,pResults,File,Fields,Widths,Header,SortFlds,SaveArray) +"RTN","TMGUSRIF",490,0) + ;"Purpose: to allow selecting records from an IEN array +"RTN","TMGUSRIF",491,0) + ;"Input: pIENArray, PASS BY NAME. An array of IENS to select from +"RTN","TMGUSRIF",492,0) + ;" format: +"RTN","TMGUSRIF",493,0) + ;" @pIENArray@(IEN)="" +"RTN","TMGUSRIF",494,0) + ;" @pIENArray@(IEN)="" +"RTN","TMGUSRIF",495,0) + ;" @pIENArray@(IEN,"SEL")="" ;"<-- Optional marker to have this preselected +"RTN","TMGUSRIF",496,0) + ;" pResults -- NAME OF array to have results returned in +"RTN","TMGUSRIF",497,0) + ;" ** Note: Prior contents of array WILL be KILLED first +"RTN","TMGUSRIF",498,0) + ;" Format of returned array: Only those valuse that user selected will +"RTN","TMGUSRIF",499,0) + ;" be aded to list +"RTN","TMGUSRIF",500,0) + ;" @pResults@(IEN)=DisplayLineNumber +"RTN","TMGUSRIF",501,0) + ;" @pResults@(IEN)=DisplayLineNumber +"RTN","TMGUSRIF",502,0) + ;" File: The file that IEN's are from. +"RTN","TMGUSRIF",503,0) + ;" Fields: OPTIONAL. The Field(s) that should be shown for record. .01 is Default +"RTN","TMGUSRIF",504,0) + ;" Fields may also be a ';' delimited list of Fields, e.g. ".01;.02;1". +"RTN","TMGUSRIF",505,0) + ;" Widths: Optional. The widths of the columns to display Fields in. +"RTN","TMGUSRIF",506,0) + ;" Format: e.g. "10;12;24" for three colums of widths: +"RTN","TMGUSRIF",507,0) + ;" Sequence must match sequence given in Fields +"RTN","TMGUSRIF",508,0) + ;" Default is to evenly space colums +"RTN","TMGUSRIF",509,0) + ;" Header -- OPTIONAL -- A header text to show. +"RTN","TMGUSRIF",510,0) + ;" SortFlds -- OPTIONAL -- Provide sorting fields +"RTN","TMGUSRIF",511,0) + ;" Format: 'FldNum1;FldNum2;FldNum3...' +"RTN","TMGUSRIF",512,0) + ;" SaveArray -- OPTIONAL -- PASS BY REFERENCE, +"RTN","TMGUSRIF",513,0) + ;" This variable will be filled with the NAME of the array +"RTN","TMGUSRIF",514,0) + ;" used for displaying the array. The FIRST time this function +"RTN","TMGUSRIF",515,0) + ;" is called, this variable should = "". On SUBSEQUENT calls, +"RTN","TMGUSRIF",516,0) + ;" if this variable holds the name of a variable (a reference), then +"RTN","TMGUSRIF",517,0) + ;" that array will be used, rather than taking the time to create +"RTN","TMGUSRIF",518,0) + ;" the display array again. Format of array: +"RTN","TMGUSRIF",519,0) + ;" @SaveArray(LineNumber)=IEN_$C(9)_Field1_"|"_Field2... +"RTN","TMGUSRIF",520,0) + ;" @SaveArray(LineNumber)=IEN_$C(9)_Field1_"|"_Field2... +"RTN","TMGUSRIF",521,0) + ;" Note: The LineNumber is the same number as the DisplayLineNumber +"RTN","TMGUSRIF",522,0) + ;" returned in @pResults@(IEN)=DisplayLineNUmber +"RTN","TMGUSRIF",523,0) + ;"Results: none +"RTN","TMGUSRIF",524,0) + +"RTN","TMGUSRIF",525,0) + if $get(pResults)'="" kill @pResults +"RTN","TMGUSRIF",526,0) + new PreSelArray +"RTN","TMGUSRIF",527,0) + new ref +"RTN","TMGUSRIF",528,0) + if $get(SaveArray)="" do +"RTN","TMGUSRIF",529,0) + . set ref=$name(^TMP("VEE",$J)) +"RTN","TMGUSRIF",530,0) + . kill @ref +"RTN","TMGUSRIF",531,0) + . set SaveArray=ref +"RTN","TMGUSRIF",532,0) + else do goto IS1 ;"Skip recreating array if SaveArray holds reference +"RTN","TMGUSRIF",533,0) + . set ref=SaveArray +"RTN","TMGUSRIF",534,0) + +"RTN","TMGUSRIF",535,0) + new ref2 set ref2=$name(^TMG("TMP",$J,"IEN-SELECT")) +"RTN","TMGUSRIF",536,0) + kill @ref2 +"RTN","TMGUSRIF",537,0) + if $get(Header)'="" set @ref@("HD")=Header +"RTN","TMGUSRIF",538,0) + set Sort=$get(Sort,0) +"RTN","TMGUSRIF",539,0) + set IOM=$get(IOM,80) +"RTN","TMGUSRIF",540,0) + set Fields=$get(Fields,".01") +"RTN","TMGUSRIF",541,0) + set Widths=$get(Widths) +"RTN","TMGUSRIF",542,0) + new Sort set Sort=($data(SortFlds)'=0) +"RTN","TMGUSRIF",543,0) + +"RTN","TMGUSRIF",544,0) + ;"Setup FldArray. Format: +"RTN","TMGUSRIF",545,0) + ;" FldArray=number of colums +"RTN","TMGUSRIF",546,0) + ;" FldArray(Sequence#)=field;fieldWidth +"RTN","TMGUSRIF",547,0) + ;" FldArray(Sequence#)=field;fieldWidth +"RTN","TMGUSRIF",548,0) + ;" FldArray(Sequence#)=field;fieldWidth +"RTN","TMGUSRIF",549,0) + new FldArray,i +"RTN","TMGUSRIF",550,0) + set FldArray=0 +"RTN","TMGUSRIF",551,0) + new WRemain set WRemain=IOM +"RTN","TMGUSRIF",552,0) + for i=1:1:$length(Fields,";") do +"RTN","TMGUSRIF",553,0) + . new Fld,W +"RTN","TMGUSRIF",554,0) + . set Fld=$piece(Fields,";",i) +"RTN","TMGUSRIF",555,0) + . if Fld="" quit +"RTN","TMGUSRIF",556,0) + . set W=+$piece(Widths,";",i) +"RTN","TMGUSRIF",557,0) + . if W=0 do +"RTN","TMGUSRIF",558,0) + . . if FldArray>0 set W=IOM/FldArray +"RTN","TMGUSRIF",559,0) + . . else set W=20 ;"some arbitrary number +"RTN","TMGUSRIF",560,0) + . if W>WRemain set W=WRemain ;"this isn't perfect +"RTN","TMGUSRIF",561,0) + . set WRemain=WRemain-W +"RTN","TMGUSRIF",562,0) + . if WRemain<1 set WRemain=1 +"RTN","TMGUSRIF",563,0) + . set FldArray(i)=Fld_";"_W +"RTN","TMGUSRIF",564,0) + . set FldArray=FldArray+1 +"RTN","TMGUSRIF",565,0) + +"RTN","TMGUSRIF",566,0) + new Itr,IEN,name,PriorErrorFound +"RTN","TMGUSRIF",567,0) + new abort set abort=0 +"RTN","TMGUSRIF",568,0) + new order set order=1 +"RTN","TMGUSRIF",569,0) + new IENPreSelected +"RTN","TMGUSRIF",570,0) + write "Prepairing list to display..." +"RTN","TMGUSRIF",571,0) + set IEN=$$ItrAInit^TMGITR(pIENArray,.Itr) +"RTN","TMGUSRIF",572,0) + do PrepProgress^TMGITR(.Itr,100,0,"IEN") +"RTN","TMGUSRIF",573,0) + write ! +"RTN","TMGUSRIF",574,0) + if IEN'="" for do quit:($$ItrANext^TMGITR(.Itr,.IEN)="")!(abort=1) +"RTN","TMGUSRIF",575,0) + . new TMGOUT,TMGMSG,IENS,showS,i +"RTN","TMGUSRIF",576,0) + . set showS="" +"RTN","TMGUSRIF",577,0) + . set IENS=IEN_"," +"RTN","TMGUSRIF",578,0) + . new tempFields +"RTN","TMGUSRIF",579,0) + . set IENPreSelected=($data(@pIENArray@(IEN,"SEL"))>0) +"RTN","TMGUSRIF",580,0) + . new i for i=1:1:FldArray do +"RTN","TMGUSRIF",581,0) + . . if showS'="" set showS=showS_"|" +"RTN","TMGUSRIF",582,0) + . . new Fld,tempS +"RTN","TMGUSRIF",583,0) + . . set Fld=$piece(FldArray(i),";",1) +"RTN","TMGUSRIF",584,0) + . . set tempS=$$GET1^DIQ(File,IENS,Fld,,"TMGOUT","TMGMSG") +"RTN","TMGUSRIF",585,0) + . . if $data(TMGMSG("DIERR")) do set abort=1 quit +"RTN","TMGUSRIF",586,0) + . . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) +"RTN","TMGUSRIF",587,0) + . . new W set W=$piece(FldArray(i),";",2) +"RTN","TMGUSRIF",588,0) + . . set tempS=$extract(tempS,1,W) +"RTN","TMGUSRIF",589,0) + . . if Sort set tempFields(Fld)=tempS +"RTN","TMGUSRIF",590,0) + . . set showS=showS_$$LJ^XLFSTR(tempS,W," ") +"RTN","TMGUSRIF",591,0) + . if Sort=0 do +"RTN","TMGUSRIF",592,0) + . . set @ref@(order)=IEN_$char(9)_showS +"RTN","TMGUSRIF",593,0) + . . if IENPreSelected set PreSelArray(order)="" +"RTN","TMGUSRIF",594,0) + . . set order=order+1 +"RTN","TMGUSRIF",595,0) + . else do +"RTN","TMGUSRIF",596,0) + . . new tempRef set tempRef=ref2 +"RTN","TMGUSRIF",597,0) + . . for i=1:1:$length(SortFlds,";") do +"RTN","TMGUSRIF",598,0) + . . . new oneFld set oneFld=$piece(SortFlds,";",i) +"RTN","TMGUSRIF",599,0) + . . . new F set F=$get(tempFields(oneFld)) +"RTN","TMGUSRIF",600,0) + . . . if F="" quit +"RTN","TMGUSRIF",601,0) + . . . set tempRef=$name(@tempRef@(F)) +"RTN","TMGUSRIF",602,0) + . . set @tempRef@(IEN)=IEN_$char(9)_showS +"RTN","TMGUSRIF",603,0) + . . if IENPreSelected set @tempRef@(IEN,"SEL")="" +"RTN","TMGUSRIF",604,0) + . . ;"Sets up sorted variable as follows: +"RTN","TMGUSRIF",605,0) + . . ;" @tempRef@(sortFld1,sortFld2,sortFld3,IEN)='IEN_$char(9)_showS' +"RTN","TMGUSRIF",606,0) + . . ;" @tempRef@(sortFld1,sortFld2,sortFld3,IEN)='IEN_$char(9)_showS' +"RTN","TMGUSRIF",607,0) + . . ;" @tempRef@(sortFld1,sortFld2,sortFld3,IEN)='IEN_$char(9)_showS' +"RTN","TMGUSRIF",608,0) + do ProgressDone^TMGITR(.Itr) +"RTN","TMGUSRIF",609,0) + write ! +"RTN","TMGUSRIF",610,0) + +"RTN","TMGUSRIF",611,0) + if abort=1 goto ISDone +"RTN","TMGUSRIF",612,0) + +"RTN","TMGUSRIF",613,0) +IES1 if Sort=1 do +"RTN","TMGUSRIF",614,0) + . write "Sorting... " +"RTN","TMGUSRIF",615,0) + . set order=1 +"RTN","TMGUSRIF",616,0) + . new tempRef2 set tempRef2=ref2 +"RTN","TMGUSRIF",617,0) + . new showS,NumNodes,Done +"RTN","TMGUSRIF",618,0) + . set Done=0 +"RTN","TMGUSRIF",619,0) + . for do quit:(tempRef2="")!(Done=1) +"RTN","TMGUSRIF",620,0) + . . set tempRef2=$query(@tempRef2) +"RTN","TMGUSRIF",621,0) + . . if (tempRef2="") quit +"RTN","TMGUSRIF",622,0) + . . if $qsubscript(tempRef2,$qlength(tempRef2))="SEL" do quit +"RTN","TMGUSRIF",623,0) + . . . set PreSelArray(order-1)="" +"RTN","TMGUSRIF",624,0) + . . if (tempRef2'[$$OREF^DILF(ref2)) set Done=1 quit +"RTN","TMGUSRIF",625,0) + . . set showS=$get(@tempRef2) +"RTN","TMGUSRIF",626,0) + . . set @ref@(order)=showS +"RTN","TMGUSRIF",627,0) + . . set order=order+1 +"RTN","TMGUSRIF",628,0) + +"RTN","TMGUSRIF",629,0) + ;"Note: Rules of use: +"RTN","TMGUSRIF",630,0) + ;" ref must=^TMP("VEE",$J) +"RTN","TMGUSRIF",631,0) + ;" Each line should be in this format: +"RTN","TMGUSRIF",632,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",633,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",634,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",635,0) + ;" Note: if DisplayValue is to be divided into colums, then +"RTN","TMGUSRIF",636,0) + ;" use | character to separate +"RTN","TMGUSRIF",637,0) + ;" @ref@("HD")=Header to display +"RTN","TMGUSRIF",638,0) + ;" Results come back in: +"RTN","TMGUSRIF",639,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",640,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",641,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",642,0) + ;" To preselect entries, provide an array like this: +"RTN","TMGUSRIF",643,0) + ;" array(number)="" <-- number is same number as above, shows selected +"RTN","TMGUSRIF",644,0) + ;" array(number)="" +"RTN","TMGUSRIF",645,0) + ;" array(number)="" +"RTN","TMGUSRIF",646,0) + ;" pass array by name: SELECT^%ZVEMKT(ref,,"array") +"RTN","TMGUSRIF",647,0) +IS1 +"RTN","TMGUSRIF",648,0) + new NumberLines set NumberLines=0 ;"1--> number each line +"RTN","TMGUSRIF",649,0) + new AddNew set AddNew=0 ;"1-> Allow adding new entry +"RTN","TMGUSRIF",650,0) + +"RTN","TMGUSRIF",651,0) + write "Passing off to selector..." +"RTN","TMGUSRIF",652,0) + D SELECT^%ZVEMKT(ref,NumberLines,AddNew,"PreSelArray") +"RTN","TMGUSRIF",653,0) + +"RTN","TMGUSRIF",654,0) + ;"Format results +"RTN","TMGUSRIF",655,0) + new Itr2,index +"RTN","TMGUSRIF",656,0) + set index=$$ItrAInit^TMGITR($name(^TMP("VPE","SELECT",$J)),.Itr2) +"RTN","TMGUSRIF",657,0) + if index'="" for do quit:($$ItrANext^TMGITR(.Itr2,.index)="") +"RTN","TMGUSRIF",658,0) + . new s set s=$piece($get(^TMP("VPE","SELECT",$J,index)),$char(9),1) +"RTN","TMGUSRIF",659,0) + . set @pResults@(s)=index +"RTN","TMGUSRIF",660,0) + +"RTN","TMGUSRIF",661,0) + kill ^TMP("VPE","SELECT",$J) +"RTN","TMGUSRIF",662,0) + if $get(ref2) kill @ref2 ;"i.e. ^TMG("TMP",$J,"IEN-SELECT") +"RTN","TMGUSRIF",663,0) + +"RTN","TMGUSRIF",664,0) +ISDone +"RTN","TMGUSRIF",665,0) + quit +"RTN","TMGUSRIF",666,0) + +"RTN","TMGUSRIF",667,0) + +"RTN","TMGUSRIF",668,0) +Selector(pArray,pResults,Header) +"RTN","TMGUSRIF",669,0) + ;"Purpose: Interface with VPE Selector code to select from an array +"RTN","TMGUSRIF",670,0) + ;"Input: pArray -- NAME OF array holding items to be selected from +"RTN","TMGUSRIF",671,0) + ;" Expected format: +"RTN","TMGUSRIF",672,0) + ;" @pArray@("Display Choice Words")=ReturnValue <-- ReturnValue is optional +"RTN","TMGUSRIF",673,0) + ;" @pArray@("Display Choice Words")=ReturnValue +"RTN","TMGUSRIF",674,0) + ;" @pArray@("Display Choice Words")=ReturnValue +"RTN","TMGUSRIF",675,0) + ;" @pArray@("Display Choice Words","SEL")="" <-- optional preselection indicator +"RTN","TMGUSRIF",676,0) + ;" pResults -- NAME OF array to have results returned in +"RTN","TMGUSRIF",677,0) + ;" ** Note: Prior contents of array will NOT be KILLED first +"RTN","TMGUSRIF",678,0) + ;" Format of returned array: Only those valuse that user selected will be returned +"RTN","TMGUSRIF",679,0) + ;" @pResults@("Display Choice Words")=ReturnValue <-- ReturnValue is optional +"RTN","TMGUSRIF",680,0) + ;" @pResults@("Display Choice Words")=ReturnValue +"RTN","TMGUSRIF",681,0) + ;" @pResults@("Display Choice Words")=ReturnValue +"RTN","TMGUSRIF",682,0) + ;" Header -- OPTIONAL -- A header text to show. +"RTN","TMGUSRIF",683,0) + +"RTN","TMGUSRIF",684,0) + new ref set ref=$name(^TMP("VEE",$J)) +"RTN","TMGUSRIF",685,0) + kill @ref +"RTN","TMGUSRIF",686,0) + if $get(pArray)="" goto SelDone +"RTN","TMGUSRIF",687,0) + if $get(pResults)="" goto SelDone +"RTN","TMGUSRIF",688,0) + +"RTN","TMGUSRIF",689,0) + new PreSelArray +"RTN","TMGUSRIF",690,0) + +"RTN","TMGUSRIF",691,0) + ;"First set up array of options +"RTN","TMGUSRIF",692,0) + new DispWords,RtnValue +"RTN","TMGUSRIF",693,0) + new order set order=1 +"RTN","TMGUSRIF",694,0) + set DispWords=$order(@pArray@("")) +"RTN","TMGUSRIF",695,0) + if DispWords'="" for do quit:(DispWords="") +"RTN","TMGUSRIF",696,0) + . set RtnValue=$get(@pArray@(DispWords),"") +"RTN","TMGUSRIF",697,0) + . set @ref@(order)=RtnValue_$char(9)_$extract(DispWords,1,$get(IOM,80)) +"RTN","TMGUSRIF",698,0) + . if $data(@pArray@(DispWords,"SEL")) set PreSelArray(order)="" ;"mark as preselected +"RTN","TMGUSRIF",699,0) + . set order=order+1 +"RTN","TMGUSRIF",700,0) + . set DispWords=$order(@pArray@(DispWords)) +"RTN","TMGUSRIF",701,0) + +"RTN","TMGUSRIF",702,0) + if $get(Header)'="" set @ref@("HD")=Header +"RTN","TMGUSRIF",703,0) + +"RTN","TMGUSRIF",704,0) + ;"Note: Rules of use: +"RTN","TMGUSRIF",705,0) + ;" ref must=^TMP("VEE",$J) +"RTN","TMGUSRIF",706,0) + ;" Each line should be in this format: +"RTN","TMGUSRIF",707,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",708,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",709,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",710,0) + ;" Note: if DisplayValue is to be divided into colums, then +"RTN","TMGUSRIF",711,0) + ;" use | character to separate +"RTN","TMGUSRIF",712,0) + ;" Results come back in: +"RTN","TMGUSRIF",713,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",714,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",715,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",716,0) + ;" To preselect entries, provide an array like this: +"RTN","TMGUSRIF",717,0) + ;" array(number)="" <-- number is same number as above, shows selected +"RTN","TMGUSRIF",718,0) + ;" array(number)="" +"RTN","TMGUSRIF",719,0) + ;" array(number)="" +"RTN","TMGUSRIF",720,0) + ;" pass array by name: SELECT^%ZVEMKT(ref,,"array") +"RTN","TMGUSRIF",721,0) + +"RTN","TMGUSRIF",722,0) + new NumberLines set NumberLines=0 ;"1--> number each line +"RTN","TMGUSRIF",723,0) + new AddNew set AddNew=0 ;"1-> Allow adding new entry +"RTN","TMGUSRIF",724,0) + +"RTN","TMGUSRIF",725,0) + D SELECT^%ZVEMKT(ref,NumberLines,AddNew,"PreSelArray") +"RTN","TMGUSRIF",726,0) + +"RTN","TMGUSRIF",727,0) + ;"Format selected options. +"RTN","TMGUSRIF",728,0) + new index set index=$order(^TMP("VPE","SELECT",$J,"")) +"RTN","TMGUSRIF",729,0) + if index'="" for do quit:(index="") +"RTN","TMGUSRIF",730,0) + . new s,s1,s2 +"RTN","TMGUSRIF",731,0) + . set s=$get(^TMP("VPE","SELECT",$J,index)) +"RTN","TMGUSRIF",732,0) + . set s1=$piece(s,$char(9),1) +"RTN","TMGUSRIF",733,0) + . set s2=$piece(s,$char(9),2) +"RTN","TMGUSRIF",734,0) + . set @pResults@(s2)=s1 +"RTN","TMGUSRIF",735,0) + . set index=$order(^TMP("VPE","SELECT",$J,index)) +"RTN","TMGUSRIF",736,0) + +"RTN","TMGUSRIF",737,0) + kill ^TMP("VPE","SELECT",$J) +"RTN","TMGUSRIF",738,0) + kill @ref +"RTN","TMGUSRIF",739,0) + +"RTN","TMGUSRIF",740,0) +SelDone +"RTN","TMGUSRIF",741,0) + quit +"RTN","TMGUSRIF",742,0) + +"RTN","TMGUSRIF",743,0) + +"RTN","TMGUSRIF",744,0) +Slctor2(pArray,pResults,Header) +"RTN","TMGUSRIF",745,0) + ;"Purpose: Interface with VPE Selector code to select from an array +"RTN","TMGUSRIF",746,0) + ;" Note: This allows a different format of input. In Selector() above, +"RTN","TMGUSRIF",747,0) + ;" it is NOT possible to have two similar Display Words with +"RTN","TMGUSRIF",748,0) + ;" different return values. E.g. two drugs with LISINOPRIL, but +"RTN","TMGUSRIF",749,0) + ;" different IEN return values. This fn allows this +"RTN","TMGUSRIF",750,0) + ;"Input: pArray -- NAME OF array holding items to be selected from +"RTN","TMGUSRIF",751,0) + ;" Expected format: +"RTN","TMGUSRIF",752,0) + ;" @pArray@("Display Choice Words",ReturnValue)="" <-- return value IS required +"RTN","TMGUSRIF",753,0) + ;" @pArray@("Display Choice Words",ReturnValue)="" +"RTN","TMGUSRIF",754,0) + ;" @pArray@("Display Choice Words",ReturnValue)="" +"RTN","TMGUSRIF",755,0) + ;" @pArray@("Display Choice Words",ReturnValue,"SEL")="" <-- optional preselection indicator +"RTN","TMGUSRIF",756,0) + ;" pResults -- NAME OF array to have results returned in +"RTN","TMGUSRIF",757,0) + ;" ** Note: Prior contents of array will NOT be KILLED first +"RTN","TMGUSRIF",758,0) + ;" Format of returned array: Only those values that user selected will be returned +"RTN","TMGUSRIF",759,0) + ;" @pResults@("Display Choice Words",ReturnValue)="" +"RTN","TMGUSRIF",760,0) + ;" @pResults@("Display Choice Words",ReturnValue)="" +"RTN","TMGUSRIF",761,0) + ;" @pResults@("Display Choice Words",ReturnValue)="" +"RTN","TMGUSRIF",762,0) + ;" Header -- OPTIONAL -- A header text to show. +"RTN","TMGUSRIF",763,0) + +"RTN","TMGUSRIF",764,0) + new ref set ref=$name(^TMP("VEE",$J)) +"RTN","TMGUSRIF",765,0) + kill @ref +"RTN","TMGUSRIF",766,0) + if $get(pArray)="" goto Sl2Done +"RTN","TMGUSRIF",767,0) + if $get(pResults)="" goto Sl2Done +"RTN","TMGUSRIF",768,0) + +"RTN","TMGUSRIF",769,0) + new PreSelArray +"RTN","TMGUSRIF",770,0) + +"RTN","TMGUSRIF",771,0) + ;"First set up array of options +"RTN","TMGUSRIF",772,0) + new DispWords,RtnValue +"RTN","TMGUSRIF",773,0) + new order set order=1 +"RTN","TMGUSRIF",774,0) + set DispWords="" +"RTN","TMGUSRIF",775,0) + for set DispWords=$order(@pArray@(DispWords)) quit:(DispWords="") do +"RTN","TMGUSRIF",776,0) + . set RtnValue="" +"RTN","TMGUSRIF",777,0) + . for set RtnValue=$order(@pArray@(DispWords,RtnValue)) quit:(RtnValue="") do +"RTN","TMGUSRIF",778,0) + . . set @ref@(order)=RtnValue_$char(9)_$extract(DispWords,1,$get(IOM,80)) +"RTN","TMGUSRIF",779,0) + . . if $data(@pArray@(DispWords,RtnValue,"SEL")) set PreSelArray(order)="" ;"mark as preselected +"RTN","TMGUSRIF",780,0) + . . set order=order+1 +"RTN","TMGUSRIF",781,0) + +"RTN","TMGUSRIF",782,0) + if $get(Header)'="" set @ref@("HD")=Header +"RTN","TMGUSRIF",783,0) + +"RTN","TMGUSRIF",784,0) + ;"Note: Rules of use: +"RTN","TMGUSRIF",785,0) + ;" ref must=^TMP("VEE",$J) +"RTN","TMGUSRIF",786,0) + ;" Each line should be in this format: +"RTN","TMGUSRIF",787,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",788,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",789,0) + ;" @ref@(number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",790,0) + ;" Note: if DisplayValue is to be divided into colums, then +"RTN","TMGUSRIF",791,0) + ;" use | character to separate +"RTN","TMGUSRIF",792,0) + ;" Results come back in: +"RTN","TMGUSRIF",793,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",794,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",795,0) + ;" ^TMP("VPE","SELECT",$J,number)=ReturnValue_$char(9)_DisplayValue +"RTN","TMGUSRIF",796,0) + ;" To preselect entries, provide an array like this: +"RTN","TMGUSRIF",797,0) + ;" array(number)="" <-- number is same number as above, shows selected +"RTN","TMGUSRIF",798,0) + ;" array(number)="" +"RTN","TMGUSRIF",799,0) + ;" array(number)="" +"RTN","TMGUSRIF",800,0) + ;" pass array by name: SELECT^%ZVEMKT(ref,,"array") +"RTN","TMGUSRIF",801,0) + +"RTN","TMGUSRIF",802,0) + new NumberLines set NumberLines=0 ;"1--> number each line +"RTN","TMGUSRIF",803,0) + new AddNew set AddNew=0 ;"1-> Allow adding new entry +"RTN","TMGUSRIF",804,0) + +"RTN","TMGUSRIF",805,0) + D SELECT^%ZVEMKT(ref,NumberLines,AddNew,"PreSelArray") +"RTN","TMGUSRIF",806,0) + +"RTN","TMGUSRIF",807,0) + ;"Format selected options. +"RTN","TMGUSRIF",808,0) + new index set index=$order(^TMP("VPE","SELECT",$J,"")) +"RTN","TMGUSRIF",809,0) + if index'="" for do quit:(index="") +"RTN","TMGUSRIF",810,0) + . new s,s1,s2 +"RTN","TMGUSRIF",811,0) + . set s=$get(^TMP("VPE","SELECT",$J,index)) +"RTN","TMGUSRIF",812,0) + . set s1=$piece(s,$char(9),1) +"RTN","TMGUSRIF",813,0) + . set s2=$piece(s,$char(9),2) +"RTN","TMGUSRIF",814,0) + . set @pResults@(s2,s1)="" +"RTN","TMGUSRIF",815,0) + . set index=$order(^TMP("VPE","SELECT",$J,index)) +"RTN","TMGUSRIF",816,0) + +"RTN","TMGUSRIF",817,0) + kill ^TMP("VPE","SELECT",$J) +"RTN","TMGUSRIF",818,0) + kill @ref +"RTN","TMGUSRIF",819,0) + +"RTN","TMGUSRIF",820,0) +Sl2Done +"RTN","TMGUSRIF",821,0) + quit +"RTN","TMGUSRIF",822,0) + +"RTN","TMGUSRIF",823,0) + +"RTN","TMGUSRIF",824,0) + +"RTN","TMGUSRIF",825,0) + +"RTN","TMGUSRIF",826,0) +Menu(Options,defChoice,UserRaw) +"RTN","TMGUSRIF",827,0) + ;"Purpose: to provide a simple menuing system +"RTN","TMGUSRIF",828,0) + ;"Input: Options -- PASS BY REFERENCE +"RTN","TMGUSRIF",829,0) + ;" Format: +"RTN","TMGUSRIF",830,0) + ;" Options(0)=Header Text <--- optional, default is MENU +"RTN","TMGUSRIF",831,0) + ;" Options(DispNumber)=MenuText_$C(9)_ReturnValue <-- _$C(9)_ReturnValue OPTIONAL, default is DispNumber +"RTN","TMGUSRIF",832,0) + ;" Options(DispNumber)=MenuText_$C(9)_ReturnValue +"RTN","TMGUSRIF",833,0) + ;" Options(DispNumber)=MenuText_$C(9)_ReturnValue +"RTN","TMGUSRIF",834,0) + ;" defChoice: OPTIONAL, the default menu value +"RTN","TMGUSRIF",835,0) + ;" UserRaw : OPTIONAL, PASS BY REFERENCE, an OUT PARAMETER. Returns users raw input +"RTN","TMGUSRIF",836,0) + ;"Results: The selected ReturnValue (or DispNumber if no ReturnValue provided), or ^ for abort +"RTN","TMGUSRIF",837,0) + +"RTN","TMGUSRIF",838,0) + new result set result="^" +"RTN","TMGUSRIF",839,0) +MNU1 +"RTN","TMGUSRIF",840,0) + write "====================================================",! +"RTN","TMGUSRIF",841,0) + write $get(Options(0),"MENU"),! +"RTN","TMGUSRIF",842,0) + write "====================================================",! +"RTN","TMGUSRIF",843,0) + write "Options:",! +"RTN","TMGUSRIF",844,0) + +"RTN","TMGUSRIF",845,0) + new s +"RTN","TMGUSRIF",846,0) + new DispNumber set DispNumber=$order(Options(0)) +"RTN","TMGUSRIF",847,0) + if DispNumber'="" for do quit:(DispNumber="") +"RTN","TMGUSRIF",848,0) + . set s=$get(Options(DispNumber)) +"RTN","TMGUSRIF",849,0) + . write " ",DispNumber,".",$char(9),$piece(s,$char(9),1),! +"RTN","TMGUSRIF",850,0) + . set DispNumber=$order(Options(DispNumber)) +"RTN","TMGUSRIF",851,0) + +"RTN","TMGUSRIF",852,0) + write "====================================================",!! +"RTN","TMGUSRIF",853,0) + +"RTN","TMGUSRIF",854,0) + set defChoice=$get(defChoice,"^") +"RTN","TMGUSRIF",855,0) + new input +"RTN","TMGUSRIF",856,0) + write "Enter selection (^ to abort): ",defChoice,"// " +"RTN","TMGUSRIF",857,0) + read input:$get(DTIME,3600),! +"RTN","TMGUSRIF",858,0) + if input="" set input=defChoice +"RTN","TMGUSRIF",859,0) + set UserRaw=input +"RTN","TMGUSRIF",860,0) + if input="^" goto MNUDone +"RTN","TMGUSRIF",861,0) + +"RTN","TMGUSRIF",862,0) + set s=$get(Options(input)) +"RTN","TMGUSRIF",863,0) + if s="" set s=$get(Options($$UP^XLFSTR(input))) +"RTN","TMGUSRIF",864,0) + ;"if s="" write "??",!! goto MNU1 +"RTN","TMGUSRIF",865,0) + set result=$piece(s,$char(9),2) +"RTN","TMGUSRIF",866,0) + if result="" set result=input +"RTN","TMGUSRIF",867,0) + +"RTN","TMGUSRIF",868,0) +MNUDone +"RTN","TMGUSRIF",869,0) + quit result +"RTN","TMGUSRIF",870,0) + +"RTN","TMGUSRIF",871,0) + +"RTN","TMGUSRIF",872,0) +ProgTest +"RTN","TMGUSRIF",873,0) + ;"Purpose: test progress bar. +"RTN","TMGUSRIF",874,0) + +"RTN","TMGUSRIF",875,0) + new i,u,max +"RTN","TMGUSRIF",876,0) + set max=1000 +"RTN","TMGUSRIF",877,0) + for i=0:1:max do +"RTN","TMGUSRIF",878,0) + . do ProgressBar(i,"%",1,max) +"RTN","TMGUSRIF",879,0) + +"RTN","TMGUSRIF",880,0) + for i=0:1:max do +"RTN","TMGUSRIF",881,0) + . do ProgressBar(i,"%",1,max) +"RTN","TMGUSRIF",882,0) + +"RTN","TMGUSRIF",883,0) + quit +"RTN","TMGVPE") +0^88^B112139 +"RTN","TMGVPE",1,0) +TMGVPE ;TMG/kst/Simple VPE launcher ;03/25/06 +"RTN","TMGVPE",2,0) + ;;1.0;TMG-LIB;**1**;09/21/04 +"RTN","TMGVPE",3,0) + +"RTN","TMGVPE",4,0) + +"RTN","TMGVPE",5,0) + x ^%ZVEMS +"RTN","TMGVPE",6,0) + quit +"RTN","TMGXDLG") +0^97^B61415 +"RTN","TMGXDLG",1,0) +TMGXDLG ;TMG/kst/M <--> Xdialog Interface ;03/25/06 +"RTN","TMGXDLG",2,0) + ;;1.0;TMG-LIB;**1**;09/21/04 +"RTN","TMGXDLG",3,0) + +"RTN","TMGXDLG",4,0) + ;"M <--> Xdialog Interface +"RTN","TMGXDLG",5,0) + +"RTN","TMGXDLG",6,0) + ;"+------------------------------------------------------------+ +"RTN","TMGXDLG",7,0) + ;"| O P E N - V I S T A C O D E |.. +"RTN","TMGXDLG",8,0) + ;"+------------------------------------------------------------+ : +"RTN","TMGXDLG",9,0) + ;"| | : +"RTN","TMGXDLG",10,0) + ;"| M <--> Xdialog Interface | : +"RTN","TMGXDLG",11,0) + ;"| | : +"RTN","TMGXDLG",12,0) + ;"| Kevin Toppenberg,MD | : +"RTN","TMGXDLG",13,0) + ;"| Started 9-21-04 | : +"RTN","TMGXDLG",14,0) + ;"| GNU License Applies | : +"RTN","TMGXDLG",15,0) + ;"| | : +"RTN","TMGXDLG",16,0) + ;"| Purpose: Linux command 'Xdialog' (and 'dialog') | : +"RTN","TMGXDLG",17,0) + ;"| provide a convenient graphic interface that | : +"RTN","TMGXDLG",18,0) + ;"| can be accessed in GT.M via the ZSYSTEM command | : +"RTN","TMGXDLG",19,0) + ;"| This library is a wrapper for Xdialog. | : +"RTN","TMGXDLG",20,0) + ;"| Note: Xdialog requires the X display system. This is a | : +"RTN","TMGXDLG",21,0) + ;"| true GIU interface. 'dialog' provides the same | : +"RTN","TMGXDLG",22,0) + ;"| functionality in a character-based environment | : +"RTN","TMGXDLG",23,0) + ;"| The command Xdialog should be in /usr/bin. If not, | : +"RTN","TMGXDLG",24,0) + ;"| it may simply be copied into place. | : +"RTN","TMGXDLG",25,0) + ;"| A good web site that documents Xdialog is: | : +"RTN","TMGXDLG",26,0) + ;"| http://xdialog.dyns.net/ and | : +"RTN","TMGXDLG",27,0) + ;"| http://thgodef.nerim.net/xdialog/doc/index.html | : +"RTN","TMGXDLG",28,0) + ;"| http://linuxgazette.net/101/sunil.html | : +"RTN","TMGXDLG",29,0) + ;"+------------------------------------------------------------+ : +"RTN","TMGXDLG",30,0) + ;" :............................................................: +"RTN","TMGXDLG",31,0) + +"RTN","TMGXDLG",32,0) + ;"Note: Some of the following names are longer than 8 characters. +"RTN","TMGXDLG",33,0) + ;" However, the first 8 characters are . You may leave +"RTN","TMGXDLG",34,0) + ;" off all characters > 8 -- but I put them in for 'beauty' +"RTN","TMGXDLG",35,0) + +"RTN","TMGXDLG",36,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",37,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",38,0) + +"RTN","TMGXDLG",39,0) + ;"Higher-level Interface (API) +"RTN","TMGXDLG",40,0) + ;"------------------------------- +"RTN","TMGXDLG",41,0) + +"RTN","TMGXDLG",42,0) + ;"SetupConsts() +"RTN","TMGXDLG",43,0) + ;"KillConsts() +"RTN","TMGXDLG",44,0) + ;"ChClrScr() +"RTN","TMGXDLG",45,0) + +"RTN","TMGXDLG",46,0) + ;"$$YesNo^TMGXDLG(Text,width,height) +"RTN","TMGXDLG",47,0) + ;"$$Msg^TMGXDLG(Title,Text,width,height,Modal,x,y) +"RTN","TMGXDLG",48,0) + ;"$$Info^TMGXDLG(Text,width,height,timeout,Modal,x,y) +"RTN","TMGXDLG",49,0) + ;"$$Edit^TMGXDLG(file,width,height,Results,x,y) +"RTN","TMGXDLG",50,0) + ;"$$Log^TMGXDLG(file,width,height,Modal,x,y) +"RTN","TMGXDLG",51,0) + ;"$$Text^TMGXDLG(file,width,height,Modal,x,y) +"RTN","TMGXDLG",52,0) + ;"$$Tail^TMGXDLG(file,width,height,Modal,x,y) +"RTN","TMGXDLG",53,0) + ;"$$Input^TMGXDLG(Title,width,height,InitText,Result,x,y) +"RTN","TMGXDLG",54,0) + ;"$$Input2^TMGXDLG(Title,width,height,Label1,Init1Text,Label2,Init2Text,Result2,x,y) +"RTN","TMGXDLG",55,0) + ;"$$Input3^TMGXDLG(Title,width,height,Label1,Init1Text,Label2,Init2Text,Label3,Init3Text,Result2,Result3,x,y) +"RTN","TMGXDLG",56,0) + ;"$$RadioList^TMGXDLG(Text,List,width,height,x,y) +"RTN","TMGXDLG",57,0) + ;"$$FileSel^TMGXDLG(Title,InitFile,width,height,x,y) +"RTN","TMGXDLG",58,0) + ;"$$DirSel^TMGXDLG(Title,InitDir,width,height,x,y) +"RTN","TMGXDLG",59,0) + ;"$$DateSel^TMGXDLG(Text,width,height,InitDay,InitMonth,InitYear,x,y) +"RTN","TMGXDLG",60,0) + ;"$$TimeSel^TMGXDLG(Text,width,height,InitHour,InitMinute,InitSecond,x,y) +"RTN","TMGXDLG",61,0) + ;"$$FontSel^TMGXDLG(InitFont,width,height,x,y) +"RTN","TMGXDLG",62,0) + ;"$$Combo^TMGXDLG(Text,width,height,List,x,y) +"RTN","TMGXDLG",63,0) + ;"$$Range^TMGXDLG(Text,width,height,min,max,init,x,y) +"RTN","TMGXDLG",64,0) + ;"$$Range2^TMGXDLG(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,Result2,x,y) +"RTN","TMGXDLG",65,0) + ;"$$Range3^TMGXDLG(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,label3,min3,max3,init3,Result2,Result3,x,y) +"RTN","TMGXDLG",66,0) + ;"$$Spin^TMGXDLG(Text,width,height,min,max,label,init,x,y) +"RTN","TMGXDLG",67,0) + ;"$$Spin2^TMGXDLG(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,Result2,x,y) +"RTN","TMGXDLG",68,0) + ;"$$Spin3^TMGXDLG(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,label3,min3,max3,init3,Result2,Result3,x,y) +"RTN","TMGXDLG",69,0) + +"RTN","TMGXDLG",70,0) + +"RTN","TMGXDLG",71,0) + +"RTN","TMGXDLG",72,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",73,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",74,0) + +"RTN","TMGXDLG",75,0) + +"RTN","TMGXDLG",76,0) + ;"Lower-level Interface (API) +"RTN","TMGXDLG",77,0) + ;"------------------------------- +"RTN","TMGXDLG",78,0) + ;"xyesno(Options,Results,Modal) +"RTN","TMGXDLG",79,0) + ;"xmsg(Options,Results,Modal) +"RTN","TMGXDLG",80,0) + ;"xinfo(Options,Results,Modal) +"RTN","TMGXDLG",81,0) + ;"xguage(Options,Results,Modal) +"RTN","TMGXDLG",82,0) + ;"xprogress(Options,Results,Modal) +"RTN","TMGXDLG",83,0) + ;"xinput(Options,Results,Modal) +"RTN","TMGXDLG",84,0) + ;"x2inputs(Options,Results,Modal) +"RTN","TMGXDLG",85,0) + ;"x3inputs(Options,Results,Modal) +"RTN","TMGXDLG",86,0) + ;"xcombo(Options,Results,Modal) +"RTN","TMGXDLG",87,0) + ;"xrange(Options,Results,Modal) +"RTN","TMGXDLG",88,0) + ;"x2range(Options,Results,Modal) +"RTN","TMGXDLG",89,0) + ;"x3range(Options,Results,Modal) +"RTN","TMGXDLG",90,0) + ;"xspin(Options,Results,Modal) +"RTN","TMGXDLG",91,0) + ;"x2spin(Options,Results,Modal) +"RTN","TMGXDLG",92,0) + ;"x3spin(Options,Results,Modal) +"RTN","TMGXDLG",93,0) + ;"xlog(Options,Results,Modal) +"RTN","TMGXDLG",94,0) + ;"xedit(Options,Results,Modal) +"RTN","TMGXDLG",95,0) + ;"xtext(Options,Results,Modal) +"RTN","TMGXDLG",96,0) + ;"xtail(Options,Results,Modal) +"RTN","TMGXDLG",97,0) + ;"xchecklist(Options,Results,Modal) +"RTN","TMGXDLG",98,0) + ;"xradiolist(Options,Results,Modal) +"RTN","TMGXDLG",99,0) + ;"xmenu(Options,Results,Modal) +"RTN","TMGXDLG",100,0) + ;"xtreeview(Options,Results,Modal) +"RTN","TMGXDLG",101,0) + ;"xfilesel(Options,Results,Modal) +"RTN","TMGXDLG",102,0) + ;"xdirsel(Options,Results,Modal) +"RTN","TMGXDLG",103,0) + ;"xcalendarsel(Options,Results,Modal) +"RTN","TMGXDLG",104,0) + ;"xtimesel(Options,Results,Modal) +"RTN","TMGXDLG",105,0) + ;"xbuildlist(Options,Results,Modal) +"RTN","TMGXDLG",106,0) + ;"xcolorsel(Options,Results,Modal) +"RTN","TMGXDLG",107,0) + ;"xfontsel(Options,Results,Modal) +"RTN","TMGXDLG",108,0) + +"RTN","TMGXDLG",109,0) + +"RTN","TMGXDLG",110,0) + ;"Expected format for Options: +"RTN","TMGXDLG",111,0) + +"RTN","TMGXDLG",112,0) + ;"The documentation for these options may be found at: +"RTN","TMGXDLG",113,0) + ;"http://thgodef.nerim.net/xdialog/doc/index.html +"RTN","TMGXDLG",114,0) + +"RTN","TMGXDLG",115,0) + ;"Options should be an array inthe following format: +"RTN","TMGXDLG",116,0) + ;" +"RTN","TMGXDLG",117,0) + ;" Options(xcCommon,xcWMClass)= +"RTN","TMGXDLG",118,0) + ;" Options(xcCommon,xcRxcFile)= +"RTN","TMGXDLG",119,0) + ;" Options(xcCommon,xcBackTitle)= +"RTN","TMGXDLG",120,0) + ;" Options(xcCommon,xcTitle"= +"RTN","TMGXDLG",121,0) + ;" Options(xcCommon,xcAllowClose)=1 } A. +"RTN","TMGXDLG",122,0) + ;" Options(xcCommon,xcNoClose)=1 } B. A & B are opposites +"RTN","TMGXDLG",123,0) + ;" Options(xcCommon,xcScreenCenter)=1 } A. +"RTN","TMGXDLG",124,0) + ;" Options(xcCommon,xcUnderMouse)=1 } B. +"RTN","TMGXDLG",125,0) + ;" Options(xcCommon,xcAutoPlacement)=1 } C. A,B & C are mutually exclusive options +"RTN","TMGXDLG",126,0) + ;" Options(xcCommon,xcCenter)=1 } A. +"RTN","TMGXDLG",127,0) + ;" Options(xcCommon,xcRight)=1 } B. +"RTN","TMGXDLG",128,0) + ;" Options(xcCommon,xcLeft)=1 } C. +"RTN","TMGXDLG",129,0) + ;" Options(xcCommon,xcFill)=1 } D. A,B,C & D are mutually exclusive options +"RTN","TMGXDLG",130,0) + ;" Options(xcCommon,xcNoWrap)=1 } A +"RTN","TMGXDLG",131,0) + ;" Options(xcCommon,xcWrap)=1 } B A & B are opposites +"RTN","TMGXDLG",132,0) + ;" Options(xcCommon,xcCRWrap)=1 } A. +"RTN","TMGXDLG",133,0) + ;" Options(xcCommon,xcNoCRWrap)=1 } B. A & B are opposites +"RTN","TMGXDLG",134,0) + ;" Options(xcCommon,xcStdErr)=1 } A. +"RTN","TMGXDLG",135,0) + ;" Options(xcCommon,xcStdOut)=1 } B. A & B are opposites +"RTN","TMGXDLG",136,0) + ;" Options(xcCommon,xcSeparator)=<character> } A. +"RTN","TMGXDLG",137,0) + ;" Options(xcCommon,xcSeparateOutput)=1 } B. A & B are opposites. +"RTN","TMGXDLG",138,0) + ;" Options(xcCommon,xcButtonsStyle)="default" or "icon" or "text" (only one of these three values) +"RTN","TMGXDLG",139,0) + ;" Options(xcTransient,xcFixedFont)=1 +"RTN","TMGXDLG",140,0) + ;" Options(xcTransient,xcPassword)=1 +"RTN","TMGXDLG",141,0) + ;" Options(xcTransient,xcEditable)=1 +"RTN","TMGXDLG",142,0) + ;" Options(xcTransient,xcTimeStamp)=1 } A. +"RTN","TMGXDLG",143,0) + ;" Options(xcTransient,xcDateStamp)=1 } B. A & B are mutually exclusive +"RTN","TMGXDLG",144,0) + ;" Options(xcTransient,xcReverse)=1 +"RTN","TMGXDLG",145,0) + ;" Options(xcTransient,xcKeepColors)=1 +"RTN","TMGXDLG",146,0) + ;" Options(xcTransient,xcInterval)=<timeout> +"RTN","TMGXDLG",147,0) + ;" Options(xcTransient,xcNotags)=1 +"RTN","TMGXDLG",148,0) + ;" Options(xcTransient,xxcItemHelp)=1 +"RTN","TMGXDLG",149,0) + ;" Options(xcTransient,xxcDefaultItem)=<tag> +"RTN","TMGXDLG",150,0) + ;" Options(xcTransient,xcIcon)=<xpm filename> +"RTN","TMGXDLG",151,0) + ;" Options(xcTransient,xcNook)=1 +"RTN","TMGXDLG",152,0) + ;" Options(xcTransient,xcNoCancel)=1 +"RTN","TMGXDLG",153,0) + ;" Options(xcTransient,xcNoButtons)=1 +"RTN","TMGXDLG",154,0) + ;" Options(xcTransient,xxcDefaultNo)=1 +"RTN","TMGXDLG",155,0) + ;" Options(xcTransient,xcWizard)=1 +"RTN","TMGXDLG",156,0) + ;" Options(xcTransient,xcHelp)=<help> +"RTN","TMGXDLG",157,0) + ;" Options(xcTransient,xcPrint)=<printer> +"RTN","TMGXDLG",158,0) + ;" Options(xcTransient,xcCheck)=<label [<status>]> +"RTN","TMGXDLG",159,0) + ;" Options(xcTransient,xcOKLabel)=<label> +"RTN","TMGXDLG",160,0) + ;" Options(xcTransient,xcCancelLabel)=<label> +"RTN","TMGXDLG",161,0) + ;" Options(xcTransient,xcBeep)=1 +"RTN","TMGXDLG",162,0) + ;" Options(xcTransient,xcBeepafter)=1 +"RTN","TMGXDLG",163,0) + ;" Options(xcTransient,xcBegin)= <Yorg Xorg> +"RTN","TMGXDLG",164,0) + ;" Options(xcTransient,xcIgnoreEOF)=1 +"RTN","TMGXDLG",165,0) + ;" Options(xcTransient,xcSmooth)=1 +"RTN","TMGXDLG",166,0) + ;" Options(xcBox,xcText)=<value> +"RTN","TMGXDLG",167,0) + ;" Options(xcBox,xcHeight)=<value> +"RTN","TMGXDLG",168,0) + ;" Options(xcBox,xcWidth)=<value> +"RTN","TMGXDLG",169,0) + ;" Options(xcBox,xcTimeOut)=<value> +"RTN","TMGXDLG",170,0) + ;" Options(xcBox,xcPercent)=<value> +"RTN","TMGXDLG",171,0) + ;" Options(xcBox,xxcMaxDots)=<value> +"RTN","TMGXDLG",172,0) + ;" Options(xcBox,xcMsgLen)=<value> +"RTN","TMGXDLG",173,0) + ;" Options(xcBox,xcInit)=<value> +"RTN","TMGXDLG",174,0) + ;" Options(xcBox,xcLabel,N)=<value> +"RTN","TMGXDLG",175,0) + ;" Options(xcBox,xcInit,N)=<value> +"RTN","TMGXDLG",176,0) + ;" Options(xcBox,xcMin,N)=<value> +"RTN","TMGXDLG",177,0) + ;" Options(xcBox,xcMax,N)=<value> +"RTN","TMGXDLG",178,0) + ;" Options(xcBox,xcDefault,N)=<value +"RTN","TMGXDLG",179,0) + ;" Options(xcBox,xcFile)=<value> +"RTN","TMGXDLG",180,0) + ;" Options(xcBox,xcDirectory)=<value> +"RTN","TMGXDLG",181,0) + ;" Options(xcBox,xcFontName)=<value> +"RTN","TMGXDLG",182,0) + ;" Options(xcBox,xcDay)=<value> +"RTN","TMGXDLG",183,0) + ;" Options(xcBox,xcMonth)=<value> +"RTN","TMGXDLG",184,0) + ;" Options(xcBox,xcYear)=<value> +"RTN","TMGXDLG",185,0) + ;" Options(xcBox,xcHours)=<value> +"RTN","TMGXDLG",186,0) + ;" Options(xcBox,xcMinutes)=<value> +"RTN","TMGXDLG",187,0) + ;" Options(xcBox,xcSeconds)=<value> +"RTN","TMGXDLG",188,0) + ;" Options(xcBox,xcTag,N)=<value> +"RTN","TMGXDLG",189,0) + ;" Options(xcBox,xcItem,N)=<value> +"RTN","TMGXDLG",190,0) + ;" Options(xcBox,xcHelp,N)=<value> +"RTN","TMGXDLG",191,0) + ;" Options(xcBox,xcStatus,N)=<value> {"on", "off", or "unavailable"} +"RTN","TMGXDLG",192,0) + ;" Options(xcBox,xcListHeight)=<value> +"RTN","TMGXDLG",193,0) + ;" Options(xcBox,xcItemdepth,N)=<value> +"RTN","TMGXDLG",194,0) + +"RTN","TMGXDLG",195,0) + ;"Notes: +"RTN","TMGXDLG",196,0) + ;" - Not all options will apply to all dialogs, but if the +"RTN","TMGXDLG",197,0) + ;" option is desired, it should be in the above format. +"RTN","TMGXDLG",198,0) + ;" - No syntax checking is performed. The options are simply +"RTN","TMGXDLG",199,0) + ;" passed to the Xdialog command in the proper order. +"RTN","TMGXDLG",200,0) + ;" - Everything below should be considered CASE-SENSITIVE. +"RTN","TMGXDLG",201,0) + ;" - Notice that the indexes used are constants (i.e. xcCommon) +"RTN","TMGXDLG",202,0) + ;" these are set up by SetupConsts(), and may later be killed +"RTN","TMGXDLG",203,0) + ;" via KillConsts(). Their use will avoid spelling errors +"RTN","TMGXDLG",204,0) + ;" resulting in a missed parameter. +"RTN","TMGXDLG",205,0) + +"RTN","TMGXDLG",206,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",207,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",208,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",209,0) + +"RTN","TMGXDLG",210,0) + +"RTN","TMGXDLG",211,0) +SetupConsts() +"RTN","TMGXDLG",212,0) + set vDialog="Xdialog" +"RTN","TMGXDLG",213,0) + set xcCommon="common" +"RTN","TMGXDLG",214,0) + set xcWMClass="wmclass" +"RTN","TMGXDLG",215,0) + set xcRxcFile="rxcFile" +"RTN","TMGXDLG",216,0) + set xcBackTitle="backtitle" +"RTN","TMGXDLG",217,0) + set xcTitle="title" +"RTN","TMGXDLG",218,0) + set xcAllowClose="allow-close" +"RTN","TMGXDLG",219,0) + set xcNoClose="no-close" +"RTN","TMGXDLG",220,0) + set xcScreenCenter="cscreen-center" +"RTN","TMGXDLG",221,0) + set xcUnderMouse="under-mouse" +"RTN","TMGXDLG",222,0) + set xcAutoPlacement="autoplacement" +"RTN","TMGXDLG",223,0) + set xcCenter="center" +"RTN","TMGXDLG",224,0) + set xcRight="right" +"RTN","TMGXDLG",225,0) + set xcLeft="left" +"RTN","TMGXDLG",226,0) + set xcFill="fill" +"RTN","TMGXDLG",227,0) + set xcNoWrap="no-wrap" +"RTN","TMGXDLG",228,0) + set xcWrap="wrap" +"RTN","TMGXDLG",229,0) + set xcCRWrap="cr-wrap" +"RTN","TMGXDLG",230,0) + set xcNoCRWrap="no-cr-wrap" +"RTN","TMGXDLG",231,0) + set xcStdErr="stderr" +"RTN","TMGXDLG",232,0) + set xcStdOut="stdout" +"RTN","TMGXDLG",233,0) + set xcSeparator="separator" +"RTN","TMGXDLG",234,0) + set xcSeparateOutput="separate-output" +"RTN","TMGXDLG",235,0) + set xcButtonsStyle="buttons-style" +"RTN","TMGXDLG",236,0) + set xcTransient="transient" +"RTN","TMGXDLG",237,0) + set xcFixedFont="fixed-font" +"RTN","TMGXDLG",238,0) + set xcPassword="password" +"RTN","TMGXDLG",239,0) + set xcEditable="editable" +"RTN","TMGXDLG",240,0) + set xcTimeStamp="time-stamp" +"RTN","TMGXDLG",241,0) + set xcDateStamp="date-stamp" +"RTN","TMGXDLG",242,0) + set xcReverse="reverse" +"RTN","TMGXDLG",243,0) + set xcKeepColors="keep-colors" +"RTN","TMGXDLG",244,0) + set xcInterval="interval" +"RTN","TMGXDLG",245,0) + set xcNotags="no-tags" +"RTN","TMGXDLG",246,0) + set xxcItemHelp="item-help" +"RTN","TMGXDLG",247,0) + set xxcDefaultItem="default-item" +"RTN","TMGXDLG",248,0) + set xcIcon="icon" +"RTN","TMGXDLG",249,0) + set xcNook="no-ok" +"RTN","TMGXDLG",250,0) + set xcNoCancel="no-cancel" +"RTN","TMGXDLG",251,0) + set xcNoButtons="no-buttons" +"RTN","TMGXDLG",252,0) + set xxcDefaultNo="default-no" +"RTN","TMGXDLG",253,0) + set xcWizard="wizard" +"RTN","TMGXDLG",254,0) + set xcHelp="help" +"RTN","TMGXDLG",255,0) + set xcPrint="print" +"RTN","TMGXDLG",256,0) + set xcCheck="check" +"RTN","TMGXDLG",257,0) + set xcOKLabel="ok-label" +"RTN","TMGXDLG",258,0) + set xcCancelLabel="cancel-label" +"RTN","TMGXDLG",259,0) + set xcBeep="beep" +"RTN","TMGXDLG",260,0) + set xcBeepafter="beep-after" +"RTN","TMGXDLG",261,0) + set xcBegin="begin" +"RTN","TMGXDLG",262,0) + set xcIgnoreEOF="ignore-eof" +"RTN","TMGXDLG",263,0) + set xcSmooth="smooth" +"RTN","TMGXDLG",264,0) + set xcBox="box" +"RTN","TMGXDLG",265,0) + set xcText="text" +"RTN","TMGXDLG",266,0) + set xcHeight="height" +"RTN","TMGXDLG",267,0) + set xcWidth="width" +"RTN","TMGXDLG",268,0) + set xcTimeOut="timeout" +"RTN","TMGXDLG",269,0) + set xcPercent="percent" +"RTN","TMGXDLG",270,0) + set xxcMaxDots="maxdots" +"RTN","TMGXDLG",271,0) + set xcMsgLen="msglen" +"RTN","TMGXDLG",272,0) + set xcInit="init" +"RTN","TMGXDLG",273,0) + set xcLabel="label" +"RTN","TMGXDLG",274,0) + set xcMin="min" +"RTN","TMGXDLG",275,0) + set xcMax="max" +"RTN","TMGXDLG",276,0) + set xcDefault="default" +"RTN","TMGXDLG",277,0) + set xcFile="file" +"RTN","TMGXDLG",278,0) + set xcDirectory="directory" +"RTN","TMGXDLG",279,0) + set xcFontName="font name" +"RTN","TMGXDLG",280,0) + set xcDay="day" +"RTN","TMGXDLG",281,0) + set xcMonth="month" +"RTN","TMGXDLG",282,0) + set xcYear="year" +"RTN","TMGXDLG",283,0) + set xcHours="hours" +"RTN","TMGXDLG",284,0) + set xcMinutes="minutes" +"RTN","TMGXDLG",285,0) + set xcSeconds="seconds" +"RTN","TMGXDLG",286,0) + set xcTag="tag" +"RTN","TMGXDLG",287,0) + set xcItem="item" +"RTN","TMGXDLG",288,0) + set xcHelp="help" +"RTN","TMGXDLG",289,0) + set xcStatus="status" +"RTN","TMGXDLG",290,0) + set xcListHeight="list height" +"RTN","TMGXDLG",291,0) + set xcItemdepth="item depth" +"RTN","TMGXDLG",292,0) + set xcCmdLine="command_line_params" +"RTN","TMGXDLG",293,0) + set xcCmdArray="Array" +"RTN","TMGXDLG",294,0) + set xcCmdMaxLine="Max_line" +"RTN","TMGXDLG",295,0) + set xcDlgResult="Dialog Result" +"RTN","TMGXDLG",296,0) + set xcDlgOutput="Dialog Output" +"RTN","TMGXDLG",297,0) + set xcModalMode=1 +"RTN","TMGXDLG",298,0) + set xcNonModal=0 +"RTN","TMGXDLG",299,0) + set xcOptional=1 +"RTN","TMGXDLG",300,0) + set xcNotOptional=0 +"RTN","TMGXDLG",301,0) + set xcAddQuote=1 +"RTN","TMGXDLG",302,0) + set xcNoQuote=0 +"RTN","TMGXDLG",303,0) + set mrYes=0 +"RTN","TMGXDLG",304,0) + set mrOK=0 +"RTN","TMGXDLG",305,0) + set mrNext=0 +"RTN","TMGXDLG",306,0) + set mrNo=1 +"RTN","TMGXDLG",307,0) + set mrCancel=1 +"RTN","TMGXDLG",308,0) + set mrHelp=2 +"RTN","TMGXDLG",309,0) + set mrPrev=3 +"RTN","TMGXDLG",310,0) + set mrError=255 +"RTN","TMGXDLG",311,0) + quit +"RTN","TMGXDLG",312,0) + +"RTN","TMGXDLG",313,0) + +"RTN","TMGXDLG",314,0) +KillConstants() +"RTN","TMGXDLG",315,0) + kill vDialog +"RTN","TMGXDLG",316,0) + kill xcCommon +"RTN","TMGXDLG",317,0) + kill xcWMClass +"RTN","TMGXDLG",318,0) + kill xcRxcFile +"RTN","TMGXDLG",319,0) + kill xcBackTitle +"RTN","TMGXDLG",320,0) + kill xcTitle +"RTN","TMGXDLG",321,0) + kill xcAllowClose +"RTN","TMGXDLG",322,0) + kill xcNoClose +"RTN","TMGXDLG",323,0) + kill xcScreenCenter +"RTN","TMGXDLG",324,0) + kill xcUnderMouse +"RTN","TMGXDLG",325,0) + kill xcAutoPlacement +"RTN","TMGXDLG",326,0) + kill xcCenter +"RTN","TMGXDLG",327,0) + kill xcRight +"RTN","TMGXDLG",328,0) + kill xcLeft +"RTN","TMGXDLG",329,0) + kill xcFill +"RTN","TMGXDLG",330,0) + kill xcNoWrap +"RTN","TMGXDLG",331,0) + kill xcWrap +"RTN","TMGXDLG",332,0) + kill xcCRWrap +"RTN","TMGXDLG",333,0) + kill xcNoCRWrap +"RTN","TMGXDLG",334,0) + kill xcStdErr +"RTN","TMGXDLG",335,0) + kill xcStdOut +"RTN","TMGXDLG",336,0) + kill xcSeparator +"RTN","TMGXDLG",337,0) + kill xcSeparateOutput +"RTN","TMGXDLG",338,0) + kill xcButtonsStyle +"RTN","TMGXDLG",339,0) + kill xcTransient +"RTN","TMGXDLG",340,0) + kill xcFixedFont +"RTN","TMGXDLG",341,0) + kill xcPassword +"RTN","TMGXDLG",342,0) + kill xcEditable +"RTN","TMGXDLG",343,0) + kill xcTimeStamp +"RTN","TMGXDLG",344,0) + kill xcDateStamp +"RTN","TMGXDLG",345,0) + kill xcReverse +"RTN","TMGXDLG",346,0) + kill xcKeepColors +"RTN","TMGXDLG",347,0) + kill xcInterval +"RTN","TMGXDLG",348,0) + kill xcNotags +"RTN","TMGXDLG",349,0) + kill xxcItemHelp +"RTN","TMGXDLG",350,0) + kill xxcDefaultItem +"RTN","TMGXDLG",351,0) + kill xcIcon +"RTN","TMGXDLG",352,0) + kill xcNook +"RTN","TMGXDLG",353,0) + kill xcNoCancel +"RTN","TMGXDLG",354,0) + kill xcNoButtons +"RTN","TMGXDLG",355,0) + kill xxcDefaultNo +"RTN","TMGXDLG",356,0) + kill xcWizard +"RTN","TMGXDLG",357,0) + kill xcHelp +"RTN","TMGXDLG",358,0) + kill xcPrint +"RTN","TMGXDLG",359,0) + kill xcCheck +"RTN","TMGXDLG",360,0) + kill xcOKLabel +"RTN","TMGXDLG",361,0) + kill xcCancelLabel +"RTN","TMGXDLG",362,0) + kill xcBeep +"RTN","TMGXDLG",363,0) + kill xcBeepafter +"RTN","TMGXDLG",364,0) + kill xcBegin +"RTN","TMGXDLG",365,0) + kill xcIgnoreEOF +"RTN","TMGXDLG",366,0) + kill xcSmooth +"RTN","TMGXDLG",367,0) + kill xcBox +"RTN","TMGXDLG",368,0) + kill xcText +"RTN","TMGXDLG",369,0) + kill xcHeight +"RTN","TMGXDLG",370,0) + kill xcWidth +"RTN","TMGXDLG",371,0) + kill xcTimeOut +"RTN","TMGXDLG",372,0) + kill xcPercent +"RTN","TMGXDLG",373,0) + kill xxcMaxDots +"RTN","TMGXDLG",374,0) + kill xcMsgLen +"RTN","TMGXDLG",375,0) + kill xcLabel +"RTN","TMGXDLG",376,0) + kill xcInit +"RTN","TMGXDLG",377,0) + kill xcMin +"RTN","TMGXDLG",378,0) + kill xcMax +"RTN","TMGXDLG",379,0) + kill xcDefault +"RTN","TMGXDLG",380,0) + kill xcFile +"RTN","TMGXDLG",381,0) + kill xcDirectory +"RTN","TMGXDLG",382,0) + kill xcFontName +"RTN","TMGXDLG",383,0) + kill xcDay +"RTN","TMGXDLG",384,0) + kill xcMonth +"RTN","TMGXDLG",385,0) + kill xcYear +"RTN","TMGXDLG",386,0) + kill xcHours +"RTN","TMGXDLG",387,0) + kill xcMinutes +"RTN","TMGXDLG",388,0) + kill xcSeconds +"RTN","TMGXDLG",389,0) + kill xcTag +"RTN","TMGXDLG",390,0) + kill xcItem +"RTN","TMGXDLG",391,0) + kill xcHelp +"RTN","TMGXDLG",392,0) + kill xcStatus +"RTN","TMGXDLG",393,0) + kill xcListHeight +"RTN","TMGXDLG",394,0) + kill xcItemdepth +"RTN","TMGXDLG",395,0) + kill xcCmdLine +"RTN","TMGXDLG",396,0) + kill xcCmdMaxLine +"RTN","TMGXDLG",397,0) + kill xcCmdArray +"RTN","TMGXDLG",398,0) + kill xcDlgResult +"RTN","TMGXDLG",399,0) + kill xcModalMode +"RTN","TMGXDLG",400,0) + kill xcNonModal +"RTN","TMGXDLG",401,0) + kill xcOptional +"RTN","TMGXDLG",402,0) + kill xcNotOptional +"RTN","TMGXDLG",403,0) + kill xcAddQuote +"RTN","TMGXDLG",404,0) + kill xcNoQuote +"RTN","TMGXDLG",405,0) + kill xcDlgOutput +"RTN","TMGXDLG",406,0) + kill mrYes +"RTN","TMGXDLG",407,0) + kill mrOK +"RTN","TMGXDLG",408,0) + kill mrNo +"RTN","TMGXDLG",409,0) + kill mrAbort +"RTN","TMGXDLG",410,0) + kill mrCancel +"RTN","TMGXDLG",411,0) + kill mrNext +"RTN","TMGXDLG",412,0) + kill mrHelp +"RTN","TMGXDLG",413,0) + kill mrPrev +"RTN","TMGXDLG",414,0) + kill mrError +"RTN","TMGXDLG",415,0) + +"RTN","TMGXDLG",416,0) + quit +"RTN","TMGXDLG",417,0) + +"RTN","TMGXDLG",418,0) +SetGUI(UseGUI) +"RTN","TMGXDLG",419,0) + ;"For those who do not have an X system (i.e. a graphic display for unix/linux) +"RTN","TMGXDLG",420,0) + ;" then there is a backup plan that can do most of these functions +"RTN","TMGXDLG",421,0) + ;" on a text display (cool, eh?) +"RTN","TMGXDLG",422,0) + ;"Input: UseGUI -- if 1 (the default), then the graphic method is used +"RTN","TMGXDLG",423,0) + ;" if 0, then the character (text drawing) based method is used +"RTN","TMGXDLG",424,0) + +"RTN","TMGXDLG",425,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",426,0) + +"RTN","TMGXDLG",427,0) + set UseGUI=$get(UseGUI,1) +"RTN","TMGXDLG",428,0) + if UseGUI=0 set vDialog="dialog" +"RTN","TMGXDLG",429,0) + else set vDialog="Xdialog" +"RTN","TMGXDLG",430,0) + quit +"RTN","TMGXDLG",431,0) + +"RTN","TMGXDLG",432,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",433,0) + +"RTN","TMGXDLG",434,0) +YesNo(Text,width,height,x,y) +"RTN","TMGXDLG",435,0) + ;"Purpose: To provide an easier access to xyesnot +"RTN","TMGXDLG",436,0) + ;"Input: Text to display +"RTN","TMGXDLG",437,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",438,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",439,0) + ;"Output: (none) +"RTN","TMGXDLG",440,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",441,0) + ;"Notes: (none) +"RTN","TMGXDLG",442,0) + +"RTN","TMGXDLG",443,0) + new Options +"RTN","TMGXDLG",444,0) + new Results,result +"RTN","TMGXDLG",445,0) + +"RTN","TMGXDLG",446,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",447,0) + +"RTN","TMGXDLG",448,0) + set Options(xcBox,xcText)=Text +"RTN","TMGXDLG",449,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",450,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",451,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",452,0) + +"RTN","TMGXDLG",453,0) + do xyesno(.Options,.Results,xcModalMode) ;"Force won't return until dialog closed. +"RTN","TMGXDLG",454,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",455,0) + +"RTN","TMGXDLG",456,0) + quit result; +"RTN","TMGXDLG",457,0) + +"RTN","TMGXDLG",458,0) + +"RTN","TMGXDLG",459,0) +xyesno(Options,Results,Modal) +"RTN","TMGXDLG",460,0) + ;" --yesno <text> <height> <width> +"RTN","TMGXDLG",461,0) + new Added +"RTN","TMGXDLG",462,0) + +"RTN","TMGXDLG",463,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",464,0) + do SetCommons(.Options) +"RTN","TMGXDLG",465,0) + do SetTrans(.Options) +"RTN","TMGXDLG",466,0) + do ParamTextAdd(.Options," --yesno ") +"RTN","TMGXDLG",467,0) + +"RTN","TMGXDLG",468,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",469,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",470,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",471,0) + +"RTN","TMGXDLG",472,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",473,0) + +"RTN","TMGXDLG",474,0) + quit +"RTN","TMGXDLG",475,0) + +"RTN","TMGXDLG",476,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",477,0) + +"RTN","TMGXDLG",478,0) +Msg(Title,Text,width,height,Modal,x,y) +"RTN","TMGXDLG",479,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",480,0) + ;"Input: Text to display +"RTN","TMGXDLG",481,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",482,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",483,0) + ;" Modal: if true, function does not return until dialog is closed. +"RTN","TMGXDLG",484,0) + ;" if false, function returns immediately, and functions do NOT +"RTN","TMGXDLG",485,0) + ;" reflect the user's button press. +"RTN","TMGXDLG",486,0) + ;"Output: (none) +"RTN","TMGXDLG",487,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",488,0) + ;"Notes: (none) +"RTN","TMGXDLG",489,0) + +"RTN","TMGXDLG",490,0) + new Options +"RTN","TMGXDLG",491,0) + new Results,result +"RTN","TMGXDLG",492,0) + +"RTN","TMGXDLG",493,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",494,0) + if $data(Title) set Options(xcCommon,xcTitle)=Title +"RTN","TMGXDLG",495,0) + set Options(xcBox,xcText)=Text +"RTN","TMGXDLG",496,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",497,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",498,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",499,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",500,0) + +"RTN","TMGXDLG",501,0) + do xmsg(.Options,.Results,Modal) +"RTN","TMGXDLG",502,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",503,0) + +"RTN","TMGXDLG",504,0) + quit result; +"RTN","TMGXDLG",505,0) + +"RTN","TMGXDLG",506,0) + +"RTN","TMGXDLG",507,0) +xmsg(Options,Results,Modal) +"RTN","TMGXDLG",508,0) + ;" --msgbox <text> <height> <width> +"RTN","TMGXDLG",509,0) + new Added +"RTN","TMGXDLG",510,0) + +"RTN","TMGXDLG",511,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",512,0) + do SetCommons(.Options) +"RTN","TMGXDLG",513,0) + do SetTrans(.Options) +"RTN","TMGXDLG",514,0) + do ParamTextAdd(.Options," --msgbox ") +"RTN","TMGXDLG",515,0) + +"RTN","TMGXDLG",516,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",517,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",518,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",519,0) + +"RTN","TMGXDLG",520,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",521,0) + +"RTN","TMGXDLG",522,0) + quit +"RTN","TMGXDLG",523,0) + +"RTN","TMGXDLG",524,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",525,0) + +"RTN","TMGXDLG",526,0) +Info(Text,width,height,timeout,Modal,x,y) +"RTN","TMGXDLG",527,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",528,0) + ;"Input: Text to display +"RTN","TMGXDLG",529,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",530,0) + ;" [timeout]: time (in sec) delay until box automatically closes. +"RTN","TMGXDLG",531,0) + ;" OPTIONAL--default=1 +"RTN","TMGXDLG",532,0) + ;" [Modal]: if true, function does not return until dialog is closed. +"RTN","TMGXDLG",533,0) + ;" if false, function returns immediately, and functions do NOT +"RTN","TMGXDLG",534,0) + ;" reflect the user's button press. OPTIONAL -- default=xcNonModal +"RTN","TMGXDLG",535,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",536,0) + ;"Output: (none) +"RTN","TMGXDLG",537,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",538,0) + ;"Notes: (none) +"RTN","TMGXDLG",539,0) + +"RTN","TMGXDLG",540,0) + new Options +"RTN","TMGXDLG",541,0) + new Results,result +"RTN","TMGXDLG",542,0) + +"RTN","TMGXDLG",543,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",544,0) + +"RTN","TMGXDLG",545,0) + set Options(xcBox,xcText)=Text +"RTN","TMGXDLG",546,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",547,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",548,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",549,0) + if $data(timeout) set Options(xcBox,xcTimeOut)=timeout*1000 +"RTN","TMGXDLG",550,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",551,0) + +"RTN","TMGXDLG",552,0) + do xinfo(.Options,.Results,Modal) +"RTN","TMGXDLG",553,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",554,0) + +"RTN","TMGXDLG",555,0) + quit result; +"RTN","TMGXDLG",556,0) + +"RTN","TMGXDLG",557,0) + +"RTN","TMGXDLG",558,0) +xinfo(Options,Results,Modal) +"RTN","TMGXDLG",559,0) + ;" --infobox <text> <height> <width> [<timeout>] +"RTN","TMGXDLG",560,0) + new Added +"RTN","TMGXDLG",561,0) + +"RTN","TMGXDLG",562,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",563,0) + do SetCommons(.Options) +"RTN","TMGXDLG",564,0) + do SetTrans(.Options) +"RTN","TMGXDLG",565,0) + do ParamTextAdd(.Options," --infobox ") +"RTN","TMGXDLG",566,0) + +"RTN","TMGXDLG",567,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",568,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",569,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",570,0) + set Added=$$AddParam(.Options,,xcTimeOut,1) +"RTN","TMGXDLG",571,0) + +"RTN","TMGXDLG",572,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",573,0) + +"RTN","TMGXDLG",574,0) + quit +"RTN","TMGXDLG",575,0) + +"RTN","TMGXDLG",576,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",577,0) + ;"NOT WORKING -- SEE NOTES ON GuageUpdate below... +"RTN","TMGXDLG",578,0) + +"RTN","TMGXDLG",579,0) +Guage(Text,width,height,Percent,x,y) +"RTN","TMGXDLG",580,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",581,0) + ;" This is called to first display a guage dialog. +"RTN","TMGXDLG",582,0) + ;"Input: Text to display +"RTN","TMGXDLG",583,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",584,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",585,0) + ;" Percent -- Percentage of progress bar to show +"RTN","TMGXDLG",586,0) + ;"Output: (none) +"RTN","TMGXDLG",587,0) + ;"Results: Returns a handle that is used in GuageUpdate +"RTN","TMGXDLG",588,0) + ;"Notes: Box is left open unless Percent is > 100% +"RTN","TMGXDLG",589,0) + ;"NOTICE: This function is not working. +"RTN","TMGXDLG",590,0) + new Options +"RTN","TMGXDLG",591,0) + new Results,result +"RTN","TMGXDLG",592,0) + +"RTN","TMGXDLG",593,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",594,0) + +"RTN","TMGXDLG",595,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",596,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",597,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",598,0) + set Options(xcBox,xcPercent)=$get(Percent,0) +"RTN","TMGXDLG",599,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",600,0) + +"RTN","TMGXDLG",601,0) + do xguage(.Options,.Results,xcNonModal) ;"note: Xdialog will show box as non-modal regardless (I think) +"RTN","TMGXDLG",602,0) + set result=$get(Text)_"^"_$get(height)_"^"_$get(width) ;"This will be used as a handle. +"RTN","TMGXDLG",603,0) + +"RTN","TMGXDLG",604,0) + quit result; +"RTN","TMGXDLG",605,0) + +"RTN","TMGXDLG",606,0) +GuageUpdate(Handle,Percent) +"RTN","TMGXDLG",607,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",608,0) + ;" This is called to update the percentage on an existing form. +"RTN","TMGXDLG",609,0) + ;"Input: Handle -- the handle returned from original call to Guage +"RTN","TMGXDLG",610,0) + ;" Percent -- Percentage of progress bar to show +"RTN","TMGXDLG",611,0) + ;"Output: (none) +"RTN","TMGXDLG",612,0) + ;"Results: 'StillActive' i.e. 1: box still open. 0:box closed +"RTN","TMGXDLG",613,0) + ;"Notes: Box is left open unless Percent is > 100% +"RTN","TMGXDLG",614,0) + ;"NOTICE: This function is not working. To update a guage, the dialog is setup to accept new values +"RTN","TMGXDLG",615,0) + ;" on stdin. I'm not sure how to do this from inside M.... +"RTN","TMGXDLG",616,0) + ;" Perhaps I could redirect stdin to a file, then write values out to that file... +"RTN","TMGXDLG",617,0) + ;" However, when EOF is reached, then box is closed.... +"RTN","TMGXDLG",618,0) + +"RTN","TMGXDLG",619,0) + new Text +"RTN","TMGXDLG",620,0) + new height +"RTN","TMGXDLG",621,0) + new width +"RTN","TMGXDLG",622,0) + set Handle=$get(Handle) +"RTN","TMGXDLG",623,0) + set Percent=$get(Percent) +"RTN","TMGXDLG",624,0) + +"RTN","TMGXDLG",625,0) + set Text=$piece(Handle,"^",1) +"RTN","TMGXDLG",626,0) + set height=$piece(Handle,"^",2) +"RTN","TMGXDLG",627,0) + set width=$piece(Handle,"^",3) +"RTN","TMGXDLG",628,0) + +"RTN","TMGXDLG",629,0) + new dump +"RTN","TMGXDLG",630,0) + set dump=$$Guage(Text,width,height,Percent) +"RTN","TMGXDLG",631,0) + +"RTN","TMGXDLG",632,0) + quit '(Percent>100) +"RTN","TMGXDLG",633,0) + +"RTN","TMGXDLG",634,0) + +"RTN","TMGXDLG",635,0) +xguage(Options,Results,Modal) +"RTN","TMGXDLG",636,0) + ;" --gauge <text> <height> <width> [<percent>] +"RTN","TMGXDLG",637,0) + new Added +"RTN","TMGXDLG",638,0) + +"RTN","TMGXDLG",639,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",640,0) + do SetCommons(.Options) +"RTN","TMGXDLG",641,0) + do SetTrans(.Options) +"RTN","TMGXDLG",642,0) + do ParamTextAdd(.Options," --gauge ") +"RTN","TMGXDLG",643,0) + +"RTN","TMGXDLG",644,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",645,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",646,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",647,0) + set Added=$$AddParam(.Options,,xcPercent) +"RTN","TMGXDLG",648,0) + +"RTN","TMGXDLG",649,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",650,0) + +"RTN","TMGXDLG",651,0) + quit +"RTN","TMGXDLG",652,0) + +"RTN","TMGXDLG",653,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",654,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",655,0) + ;"Note: I will have the same problems with this function as I did with Guage... +"RTN","TMGXDLG",656,0) + ;" So for now, I WON'T IMPLEMENT THIS... +"RTN","TMGXDLG",657,0) + +"RTN","TMGXDLG",658,0) +xprogress(Options,Results,Modal) +"RTN","TMGXDLG",659,0) + ;"Purpose: +"RTN","TMGXDLG",660,0) + ;"Input: +"RTN","TMGXDLG",661,0) + ;"Output: +"RTN","TMGXDLG",662,0) + ;"Results: +"RTN","TMGXDLG",663,0) + ;"Notes: +"RTN","TMGXDLG",664,0) + ;" --progress <text> <height> <width> [<maxdots> [[-]<msglen>]] +"RTN","TMGXDLG",665,0) + +"RTN","TMGXDLG",666,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",667,0) +Input(Title,width,height,InitText,Result,x,y) +"RTN","TMGXDLG",668,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",669,0) + ;"Input: Title -- text of input prompt to display +"RTN","TMGXDLG",670,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",671,0) + ;" InitText -- default value [optional] +"RTN","TMGXDLG",672,0) + ;" Result -- a variable to put input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",673,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",674,0) + ;"Output: The user input value is return in Result +"RTN","TMGXDLG",675,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",676,0) + ;"Notes: (none) +"RTN","TMGXDLG",677,0) + +"RTN","TMGXDLG",678,0) + new Options +"RTN","TMGXDLG",679,0) + new Results,result +"RTN","TMGXDLG",680,0) + +"RTN","TMGXDLG",681,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",682,0) + +"RTN","TMGXDLG",683,0) + set Options(xcBox,xcText)=$get(Title) +"RTN","TMGXDLG",684,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",685,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",686,0) + if $data(InitText) set Options(xcBox,xcInit)=InitText +"RTN","TMGXDLG",687,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",688,0) + +"RTN","TMGXDLG",689,0) + do xinput(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",690,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",691,0) + +"RTN","TMGXDLG",692,0) + ;"zwr Results(*) +"RTN","TMGXDLG",693,0) + +"RTN","TMGXDLG",694,0) + set Result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",695,0) + +"RTN","TMGXDLG",696,0) + quit result; +"RTN","TMGXDLG",697,0) + +"RTN","TMGXDLG",698,0) +xinput(Options,Results,Modal) +"RTN","TMGXDLG",699,0) + ;" --inputbox <text> <height> <width> [<init>] +"RTN","TMGXDLG",700,0) + +"RTN","TMGXDLG",701,0) + new Added +"RTN","TMGXDLG",702,0) + +"RTN","TMGXDLG",703,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",704,0) + do SetCommons(.Options) +"RTN","TMGXDLG",705,0) + do SetTrans(.Options) +"RTN","TMGXDLG",706,0) + do ParamTextAdd(.Options," --inputbox ") +"RTN","TMGXDLG",707,0) + +"RTN","TMGXDLG",708,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",709,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",710,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",711,0) + set Added=$$AddParam(.Options,,xcInit) +"RTN","TMGXDLG",712,0) + +"RTN","TMGXDLG",713,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",714,0) + +"RTN","TMGXDLG",715,0) + quit +"RTN","TMGXDLG",716,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",717,0) +Input2(Title,width,height,Label1,Init1Text,Label2,Init2Text,Result1,Result2,x,y) +"RTN","TMGXDLG",718,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",719,0) + ;"Input: Title -- text of input prompt to display +"RTN","TMGXDLG",720,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",721,0) + ;" Label1 -- text of label for input 1 [optional] +"RTN","TMGXDLG",722,0) + ;" Init1Text -- default value [optional] +"RTN","TMGXDLG",723,0) + ;" Label2 -- text of label for input 2 [optional] +"RTN","TMGXDLG",724,0) + ;" Init2Text -- default value [optional] +"RTN","TMGXDLG",725,0) + ;" Result1 -- a variable to put first input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",726,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",727,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",728,0) + ;"Output: The user input value is return in Result1 +"RTN","TMGXDLG",729,0) + ;" result of 2nd user-input put into Result2 +"RTN","TMGXDLG",730,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",731,0) + ;"Notes: (none) +"RTN","TMGXDLG",732,0) + +"RTN","TMGXDLG",733,0) + new Options +"RTN","TMGXDLG",734,0) + new Results,result +"RTN","TMGXDLG",735,0) + +"RTN","TMGXDLG",736,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",737,0) + +"RTN","TMGXDLG",738,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",739,0) + set Options(xcBox,xcText)=$get(Title) +"RTN","TMGXDLG",740,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",741,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",742,0) + set Options(xcBox,xcLabel,1)=$get(Label1," ") +"RTN","TMGXDLG",743,0) + set Options(xcBox,xcInit,1)=$get(Init1Text," ") +"RTN","TMGXDLG",744,0) + set Options(xcBox,xcLabel,2)=$get(Label2," ") +"RTN","TMGXDLG",745,0) + set Options(xcBox,xcInit,2)=$get(Init2Text," ") +"RTN","TMGXDLG",746,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",747,0) + +"RTN","TMGXDLG",748,0) + do x2inputs(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",749,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",750,0) + +"RTN","TMGXDLG",751,0) + set Result1=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",752,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",753,0) + +"RTN","TMGXDLG",754,0) + quit result; +"RTN","TMGXDLG",755,0) + +"RTN","TMGXDLG",756,0) + +"RTN","TMGXDLG",757,0) +x2inputs(Options,Results,Modal) +"RTN","TMGXDLG",758,0) + ;" --2inputsbox <text> <height> <width> <label1> <init1> <label2> <init2> +"RTN","TMGXDLG",759,0) + new Added +"RTN","TMGXDLG",760,0) + +"RTN","TMGXDLG",761,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",762,0) + do SetCommons(.Options) +"RTN","TMGXDLG",763,0) + do SetTrans(.Options) +"RTN","TMGXDLG",764,0) + do ParamTextAdd(.Options," --2inputsbox ") +"RTN","TMGXDLG",765,0) + +"RTN","TMGXDLG",766,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",767,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",768,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",769,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",770,0) + set Added=$$AddParam(.Options,1,xcInit,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",771,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",772,0) + set Added=$$AddParam(.Options,2,xcInit,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",773,0) + +"RTN","TMGXDLG",774,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",775,0) + +"RTN","TMGXDLG",776,0) + quit +"RTN","TMGXDLG",777,0) + +"RTN","TMGXDLG",778,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",779,0) +Input3(Title,width,height,Label1,Init1Text,Label2,Init2Text,Label3,Init3Text,Result1,Result2,Result3,x,y) +"RTN","TMGXDLG",780,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",781,0) + ;"Input: Title -- text of input prompt to display +"RTN","TMGXDLG",782,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",783,0) + ;" Label1 -- text of label for input 1 +"RTN","TMGXDLG",784,0) + ;" Init1Text -- default value +"RTN","TMGXDLG",785,0) + ;" Label2 -- text of label for input 2 +"RTN","TMGXDLG",786,0) + ;" Init2Text -- default value +"RTN","TMGXDLG",787,0) + ;" Label3 -- text of label for input 3 +"RTN","TMGXDLG",788,0) + ;" Init3Text -- default value +"RTN","TMGXDLG",789,0) + ;" Result1 -- a variable to put first input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",790,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",791,0) + ;" Result3 -- a variable to put third input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",792,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",793,0) + ;"Output: The user input value is return in Result1 +"RTN","TMGXDLG",794,0) + ;" result of 2nd user-input put into Result2 +"RTN","TMGXDLG",795,0) + ;" result of 3rd user-input put into Result3 +"RTN","TMGXDLG",796,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",797,0) + ;"Notes: (none) +"RTN","TMGXDLG",798,0) + +"RTN","TMGXDLG",799,0) + new Options +"RTN","TMGXDLG",800,0) + new Results,result +"RTN","TMGXDLG",801,0) + +"RTN","TMGXDLG",802,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",803,0) + +"RTN","TMGXDLG",804,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",805,0) + set Options(xcBox,xcText)=$get(Title) +"RTN","TMGXDLG",806,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",807,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",808,0) + set Options(xcBox,xcLabel,1)=$get(Label1," ") +"RTN","TMGXDLG",809,0) + set Options(xcBox,xcInit,1)=$get(Init1Text," ") +"RTN","TMGXDLG",810,0) + set Options(xcBox,xcLabel,2)=$get(Label2," ") +"RTN","TMGXDLG",811,0) + set Options(xcBox,xcInit,2)=$get(Init2Text," ") +"RTN","TMGXDLG",812,0) + set Options(xcBox,xcLabel,3)=$get(Label3," ") +"RTN","TMGXDLG",813,0) + set Options(xcBox,xcInit,3)=$get(Init3Text," ") +"RTN","TMGXDLG",814,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",815,0) + +"RTN","TMGXDLG",816,0) + do x3inputs(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",817,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",818,0) + +"RTN","TMGXDLG",819,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",820,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",821,0) + set Result3=$get(Results(xcDlgOutput,2)) +"RTN","TMGXDLG",822,0) + +"RTN","TMGXDLG",823,0) + quit result; +"RTN","TMGXDLG",824,0) + +"RTN","TMGXDLG",825,0) + +"RTN","TMGXDLG",826,0) +x3inputs(Options,Results,Modal) +"RTN","TMGXDLG",827,0) + ;" --3inputsbox <text> <height> <width> <label1> <init1> <label2> <init2> <label3> <init3> +"RTN","TMGXDLG",828,0) + new Added +"RTN","TMGXDLG",829,0) + +"RTN","TMGXDLG",830,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",831,0) + do SetCommons(.Options) +"RTN","TMGXDLG",832,0) + do SetTrans(.Options) +"RTN","TMGXDLG",833,0) + do ParamTextAdd(.Options," --3inputsbox ") +"RTN","TMGXDLG",834,0) + +"RTN","TMGXDLG",835,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",836,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",837,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",838,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",839,0) + set Added=$$AddParam(.Options,1,xcInit,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",840,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",841,0) + set Added=$$AddParam(.Options,2,xcInit,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",842,0) + set Added=$$AddParam(.Options,3,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",843,0) + set Added=$$AddParam(.Options,3,xcInit,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",844,0) + +"RTN","TMGXDLG",845,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",846,0) + +"RTN","TMGXDLG",847,0) + quit +"RTN","TMGXDLG",848,0) + +"RTN","TMGXDLG",849,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",850,0) +Combo(Text,width,height,List,x,y) +"RTN","TMGXDLG",851,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",852,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",853,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",854,0) + ;" List -- Best if passed by reference. Holds list of options to be displayed as follows: +"RTN","TMGXDLG",855,0) + ;" List(1)=<Selection Option> +"RTN","TMGXDLG",856,0) + ;" List(2)=<Selection Option> +"RTN","TMGXDLG",857,0) + ;" List(3)=<Selection Option> +"RTN","TMGXDLG",858,0) + ;" ... etc up to any number N +"RTN","TMGXDLG",859,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",860,0) + ;"Output: (none) +"RTN","TMGXDLG",861,0) + ;"Results: Returns text of selected option. +"RTN","TMGXDLG",862,0) + ;"Notes: (none) +"RTN","TMGXDLG",863,0) + +"RTN","TMGXDLG",864,0) + new Options +"RTN","TMGXDLG",865,0) + new Results +"RTN","TMGXDLG",866,0) + set result="" +"RTN","TMGXDLG",867,0) + new i,Done +"RTN","TMGXDLG",868,0) + new status,help +"RTN","TMGXDLG",869,0) + +"RTN","TMGXDLG",870,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",871,0) + +"RTN","TMGXDLG",872,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",873,0) + +"RTN","TMGXDLG",874,0) + set Done=0 +"RTN","TMGXDLG",875,0) + for i=1:1 do quit:Done +"RTN","TMGXDLG",876,0) + . if $data(List(i))=0 set Done=1 quit +"RTN","TMGXDLG",877,0) + . set Options(xcBox,xcItem,i)=$get(List(i)) +"RTN","TMGXDLG",878,0) + +"RTN","TMGXDLG",879,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",880,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",881,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",882,0) + +"RTN","TMGXDLG",883,0) + do xcombo(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",884,0) + +"RTN","TMGXDLG",885,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",886,0) + quit result; +"RTN","TMGXDLG",887,0) + +"RTN","TMGXDLG",888,0) + +"RTN","TMGXDLG",889,0) +xcombo(Options,Results,Modal) +"RTN","TMGXDLG",890,0) + ;" --combobox <text> <height> <width> <item1> ... <itemN> +"RTN","TMGXDLG",891,0) + new Added,GroupAdded +"RTN","TMGXDLG",892,0) + new N +"RTN","TMGXDLG",893,0) + +"RTN","TMGXDLG",894,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",895,0) + do SetCommons(.Options) +"RTN","TMGXDLG",896,0) + do SetTrans(.Options) +"RTN","TMGXDLG",897,0) + do ParamTextAdd(.Options," --combobox ") +"RTN","TMGXDLG",898,0) + +"RTN","TMGXDLG",899,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",900,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",901,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",902,0) + set N=1 +"RTN","TMGXDLG",903,0) +xcl1 if $data(Options(xcBox,xcItem,N))=0 goto xcl2 +"RTN","TMGXDLG",904,0) + set GroupAdded=$$AddParam(.Options,N,xcItem,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",905,0) + if GroupAdded=0 goto xcl2 +"RTN","TMGXDLG",906,0) + set N=N+1 goto xcl1 +"RTN","TMGXDLG",907,0) +xcl2 +"RTN","TMGXDLG",908,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",909,0) + +"RTN","TMGXDLG",910,0) + quit +"RTN","TMGXDLG",911,0) + +"RTN","TMGXDLG",912,0) + +"RTN","TMGXDLG",913,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",914,0) +Range(Text,width,height,min,max,init,x,y) +"RTN","TMGXDLG",915,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",916,0) + ;" A range dialog presents a horizontal slider bar to user +"RTN","TMGXDLG",917,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",918,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",919,0) + ;" min -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",920,0) + ;" max -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",921,0) + ;" init -- the initial input value -- (default = 50) +"RTN","TMGXDLG",922,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",923,0) + ;"Output: (none) +"RTN","TMGXDLG",924,0) + ;"Results: Returns input value +"RTN","TMGXDLG",925,0) + ;"Notes: (none) +"RTN","TMGXDLG",926,0) + +"RTN","TMGXDLG",927,0) + new Options +"RTN","TMGXDLG",928,0) + new Results,result +"RTN","TMGXDLG",929,0) + +"RTN","TMGXDLG",930,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",931,0) + +"RTN","TMGXDLG",932,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",933,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",934,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",935,0) + set Options(xcBox,xcMin,1)=$get(min,0) +"RTN","TMGXDLG",936,0) + set Options(xcBox,xcMax,1)=$get(max,100) +"RTN","TMGXDLG",937,0) + set Options(xcBox,xcDefault,1)=$get(init,50) +"RTN","TMGXDLG",938,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",939,0) + +"RTN","TMGXDLG",940,0) + do xrange(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",941,0) + +"RTN","TMGXDLG",942,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",943,0) + +"RTN","TMGXDLG",944,0) + quit result; +"RTN","TMGXDLG",945,0) + +"RTN","TMGXDLG",946,0) + +"RTN","TMGXDLG",947,0) +xrange(Options,Results,Modal) +"RTN","TMGXDLG",948,0) + ;" --rangebox <text> <height> <width> <min value> <max value> [<default value>] +"RTN","TMGXDLG",949,0) + new Added +"RTN","TMGXDLG",950,0) + +"RTN","TMGXDLG",951,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",952,0) + do SetCommons(.Options) +"RTN","TMGXDLG",953,0) + do SetTrans(.Options) +"RTN","TMGXDLG",954,0) + do ParamTextAdd(.Options," --rangebox ") +"RTN","TMGXDLG",955,0) + +"RTN","TMGXDLG",956,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",957,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",958,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",959,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",960,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",961,0) + set Added=$$AddParam(.Options,1,xcDefault,xcOptional) +"RTN","TMGXDLG",962,0) + +"RTN","TMGXDLG",963,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",964,0) + +"RTN","TMGXDLG",965,0) + quit +"RTN","TMGXDLG",966,0) + +"RTN","TMGXDLG",967,0) + +"RTN","TMGXDLG",968,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",969,0) +Range2(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,Result2,x,y) +"RTN","TMGXDLG",970,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",971,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",972,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",973,0) + ;" label1 -- the label to show for range +"RTN","TMGXDLG",974,0) + ;" min1 -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",975,0) + ;" max1 -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",976,0) + ;" init1 -- the initial input value -- (default = 50) +"RTN","TMGXDLG",977,0) + ;" label2 -- the label to show for range +"RTN","TMGXDLG",978,0) + ;" min2 -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",979,0) + ;" max2 -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",980,0) + ;" init2 -- the initial input value -- (default = 50) +"RTN","TMGXDLG",981,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",982,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",983,0) + ;"Output: (none) +"RTN","TMGXDLG",984,0) + ;"Results: returns result of 1st user-input. result of 2nd user-input put into Result2 +"RTN","TMGXDLG",985,0) + ;"Notes: (none) +"RTN","TMGXDLG",986,0) + +"RTN","TMGXDLG",987,0) + new Options +"RTN","TMGXDLG",988,0) + new Results,result +"RTN","TMGXDLG",989,0) + +"RTN","TMGXDLG",990,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",991,0) + +"RTN","TMGXDLG",992,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",993,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",994,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",995,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",996,0) + set Options(xcBox,xcLabel,1)=$get(label1,"") +"RTN","TMGXDLG",997,0) + set Options(xcBox,xcMin,1)=$get(min1,0) +"RTN","TMGXDLG",998,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",999,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1000,0) + set Options(xcBox,xcDefault,1)=$get(init1,50) +"RTN","TMGXDLG",1001,0) + set Options(xcBox,xcLabel,2)=$get(label2,"") +"RTN","TMGXDLG",1002,0) + set Options(xcBox,xcMin,2)=$get(min2,0) +"RTN","TMGXDLG",1003,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1004,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1005,0) + set Options(xcBox,xcDefault,2)=$get(init2,50) +"RTN","TMGXDLG",1006,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1007,0) + +"RTN","TMGXDLG",1008,0) + do x2range(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1009,0) + +"RTN","TMGXDLG",1010,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1011,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",1012,0) + +"RTN","TMGXDLG",1013,0) + quit result; +"RTN","TMGXDLG",1014,0) + +"RTN","TMGXDLG",1015,0) + +"RTN","TMGXDLG",1016,0) +x2range(Options,Results,Modal) +"RTN","TMGXDLG",1017,0) + ;" --2rangesbox <text> <height> <width> <label1> <min1> <max1> <def1> <label2> <min2> <max2> <def2> +"RTN","TMGXDLG",1018,0) + new Added +"RTN","TMGXDLG",1019,0) + +"RTN","TMGXDLG",1020,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1021,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1022,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1023,0) + do ParamTextAdd(.Options," --2rangesbox ") +"RTN","TMGXDLG",1024,0) + +"RTN","TMGXDLG",1025,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1026,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1027,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1028,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1029,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",1030,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",1031,0) + set Added=$$AddParam(.Options,1,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1032,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1033,0) + set Added=$$AddParam(.Options,2,xcMin,xcNotOptional) +"RTN","TMGXDLG",1034,0) + set Added=$$AddParam(.Options,2,xcMax,xcNotOptional) +"RTN","TMGXDLG",1035,0) + set Added=$$AddParam(.Options,2,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1036,0) + +"RTN","TMGXDLG",1037,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1038,0) + +"RTN","TMGXDLG",1039,0) + quit +"RTN","TMGXDLG",1040,0) + +"RTN","TMGXDLG",1041,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1042,0) +Range3(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,label3,min3,max3,init3,Result2,Result3,x,y) +"RTN","TMGXDLG",1043,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1044,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",1045,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",1046,0) + ;" labelN -- the title to show for the range. +"RTN","TMGXDLG",1047,0) + ;" minN -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",1048,0) + ;" maxN -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",1049,0) + ;" initN -- the initial input value -- (default = 50) +"RTN","TMGXDLG",1050,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1051,0) + ;" Result3 -- a variable to put third input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1052,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1053,0) + ;"Output: (none) +"RTN","TMGXDLG",1054,0) + ;"Results: returns result of 1st user-input. +"RTN","TMGXDLG",1055,0) + ;" result of 2nd user-input put into Result2 +"RTN","TMGXDLG",1056,0) + ;" result of 3rd user-input put into Result3 +"RTN","TMGXDLG",1057,0) + ;"Notes: (none) +"RTN","TMGXDLG",1058,0) + +"RTN","TMGXDLG",1059,0) + new Options +"RTN","TMGXDLG",1060,0) + new Results,result +"RTN","TMGXDLG",1061,0) + +"RTN","TMGXDLG",1062,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1063,0) + +"RTN","TMGXDLG",1064,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",1065,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",1066,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1067,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1068,0) + set Options(xcBox,xcLabel,1)=$get(label1,"") +"RTN","TMGXDLG",1069,0) + set Options(xcBox,xcMin,1)=$get(min1,0) +"RTN","TMGXDLG",1070,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1071,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1072,0) + set Options(xcBox,xcDefault,1)=$get(init1,50) +"RTN","TMGXDLG",1073,0) + set Options(xcBox,xcLabel,2)=$get(label2,"") +"RTN","TMGXDLG",1074,0) + set Options(xcBox,xcMin,2)=$get(min2,0) +"RTN","TMGXDLG",1075,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1076,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1077,0) + set Options(xcBox,xcDefault,2)=$get(init2,50) +"RTN","TMGXDLG",1078,0) + set Options(xcBox,xcLabel,3)=$get(label3,"") +"RTN","TMGXDLG",1079,0) + set Options(xcBox,xcMin,3)=$get(min3,0) +"RTN","TMGXDLG",1080,0) + set Options(xcBox,xcMax,3)=$get(max3,100) +"RTN","TMGXDLG",1081,0) + set Options(xcBox,xcMax,3)=$get(max3,100) +"RTN","TMGXDLG",1082,0) + set Options(xcBox,xcDefault,3)=$get(init3,50) +"RTN","TMGXDLG",1083,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1084,0) + +"RTN","TMGXDLG",1085,0) + do x3range(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1086,0) + +"RTN","TMGXDLG",1087,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1088,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",1089,0) + set Result3=$get(Results(xcDlgOutput,2)) +"RTN","TMGXDLG",1090,0) + +"RTN","TMGXDLG",1091,0) + quit result; +"RTN","TMGXDLG",1092,0) + +"RTN","TMGXDLG",1093,0) + +"RTN","TMGXDLG",1094,0) +x3range(Options,Results,Modal) +"RTN","TMGXDLG",1095,0) + ;" --3rangesbox <text> <height> <width> <label1> <min1> <max1> <def1> <label2> <min2> <max2> <def2> <label3> <min3> <max3> <def3> +"RTN","TMGXDLG",1096,0) + new Added +"RTN","TMGXDLG",1097,0) + +"RTN","TMGXDLG",1098,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1099,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1100,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1101,0) + do ParamTextAdd(.Options," --3rangesbox ") +"RTN","TMGXDLG",1102,0) + +"RTN","TMGXDLG",1103,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1104,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1105,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1106,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1107,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",1108,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",1109,0) + set Added=$$AddParam(.Options,1,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1110,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1111,0) + set Added=$$AddParam(.Options,2,xcMin,xcNotOptional) +"RTN","TMGXDLG",1112,0) + set Added=$$AddParam(.Options,2,xcMax,xcNotOptional) +"RTN","TMGXDLG",1113,0) + set Added=$$AddParam(.Options,2,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1114,0) + set Added=$$AddParam(.Options,3,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1115,0) + set Added=$$AddParam(.Options,3,xcMin,xcNotOptional) +"RTN","TMGXDLG",1116,0) + set Added=$$AddParam(.Options,3,xcMax,xcNotOptional) +"RTN","TMGXDLG",1117,0) + set Added=$$AddParam(.Options,3,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1118,0) + +"RTN","TMGXDLG",1119,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1120,0) + +"RTN","TMGXDLG",1121,0) + quit +"RTN","TMGXDLG",1122,0) + +"RTN","TMGXDLG",1123,0) + +"RTN","TMGXDLG",1124,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1125,0) +Spin(Text,width,height,label,min,max,init,Result,x,y) +"RTN","TMGXDLG",1126,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1127,0) + ;" A spinner is a dialable number input dialog. +"RTN","TMGXDLG",1128,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",1129,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",1130,0) + ;" min -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",1131,0) + ;" max -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",1132,0) + ;" init -- the initial input value -- (default = 50) +"RTN","TMGXDLG",1133,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1134,0) + ;"Output: The user input value is return in Result +"RTN","TMGXDLG",1135,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",1136,0) + ;"Notes: (none) +"RTN","TMGXDLG",1137,0) + +"RTN","TMGXDLG",1138,0) + new Options +"RTN","TMGXDLG",1139,0) + new Results,result +"RTN","TMGXDLG",1140,0) + +"RTN","TMGXDLG",1141,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1142,0) + +"RTN","TMGXDLG",1143,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",1144,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1145,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1146,0) + set Options(xcBox,xcMin,1)=$get(min,0) +"RTN","TMGXDLG",1147,0) + set Options(xcBox,xcMax,1)=$get(max,100) +"RTN","TMGXDLG",1148,0) + set Options(xcBox,xcMax,1)=$get(max,100) +"RTN","TMGXDLG",1149,0) + set Options(xcBox,xcLabel,1)=$get(label,"") +"RTN","TMGXDLG",1150,0) + set Options(xcBox,xcDefault,1)=$get(init,50) +"RTN","TMGXDLG",1151,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1152,0) + +"RTN","TMGXDLG",1153,0) + do xspin(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1154,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1155,0) + +"RTN","TMGXDLG",1156,0) + set Result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1157,0) + +"RTN","TMGXDLG",1158,0) + quit result; +"RTN","TMGXDLG",1159,0) + +"RTN","TMGXDLG",1160,0) + +"RTN","TMGXDLG",1161,0) +xspin(Options,Results,Modal) +"RTN","TMGXDLG",1162,0) + ;" --spinbox <text> <height> <width> <min> <max> <def> <label> +"RTN","TMGXDLG",1163,0) + new Added +"RTN","TMGXDLG",1164,0) + +"RTN","TMGXDLG",1165,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1166,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1167,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1168,0) + do ParamTextAdd(.Options," --spinbox ") +"RTN","TMGXDLG",1169,0) + +"RTN","TMGXDLG",1170,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1171,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1172,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1173,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",1174,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",1175,0) + set Added=$$AddParam(.Options,1,xcDefault,xcOptional) +"RTN","TMGXDLG",1176,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1177,0) + +"RTN","TMGXDLG",1178,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1179,0) + +"RTN","TMGXDLG",1180,0) + quit +"RTN","TMGXDLG",1181,0) + +"RTN","TMGXDLG",1182,0) + +"RTN","TMGXDLG",1183,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1184,0) +Spin2(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,Result1,Result2,x,y) +"RTN","TMGXDLG",1185,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1186,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",1187,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",1188,0) + ;" label1 -- the label to show for range +"RTN","TMGXDLG",1189,0) + ;" min1 -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",1190,0) + ;" max1 -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",1191,0) + ;" init1 -- the initial input value -- (default = 50) +"RTN","TMGXDLG",1192,0) + ;" label2 -- the label to show for range +"RTN","TMGXDLG",1193,0) + ;" min2 -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",1194,0) + ;" max2 -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",1195,0) + ;" init2 -- the initial input value -- (default = 50) +"RTN","TMGXDLG",1196,0) + ;" Result1 -- a variable to put first input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1197,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1198,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1199,0) + ;"Output: The user input value is return in Result1 +"RTN","TMGXDLG",1200,0) + ;" result of 2nd user-input put into Result2 +"RTN","TMGXDLG",1201,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",1202,0) + ;"Notes: (none) +"RTN","TMGXDLG",1203,0) + new Options +"RTN","TMGXDLG",1204,0) + new Results,result +"RTN","TMGXDLG",1205,0) + +"RTN","TMGXDLG",1206,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1207,0) + +"RTN","TMGXDLG",1208,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",1209,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",1210,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1211,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1212,0) + set Options(xcBox,xcLabel,1)=$get(label1,"") +"RTN","TMGXDLG",1213,0) + set Options(xcBox,xcMin,1)=$get(min1,0) +"RTN","TMGXDLG",1214,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1215,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1216,0) + set Options(xcBox,xcDefault,1)=$get(init1,50) +"RTN","TMGXDLG",1217,0) + set Options(xcBox,xcLabel,2)=$get(label2,"") +"RTN","TMGXDLG",1218,0) + set Options(xcBox,xcMin,2)=$get(min2,0) +"RTN","TMGXDLG",1219,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1220,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1221,0) + set Options(xcBox,xcDefault,2)=$get(init2,50) +"RTN","TMGXDLG",1222,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1223,0) + +"RTN","TMGXDLG",1224,0) + do x2spin(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1225,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1226,0) + +"RTN","TMGXDLG",1227,0) + set Result1=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1228,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",1229,0) + +"RTN","TMGXDLG",1230,0) + quit result; +"RTN","TMGXDLG",1231,0) + +"RTN","TMGXDLG",1232,0) + +"RTN","TMGXDLG",1233,0) +x2spin(Options,Results,Modal) +"RTN","TMGXDLG",1234,0) + ;" --2spinsbox <text> <height> <width> <min1> <max1> <def1> <label1> <min2> <max2> <def2> <label2> +"RTN","TMGXDLG",1235,0) + new Added +"RTN","TMGXDLG",1236,0) + +"RTN","TMGXDLG",1237,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1238,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1239,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1240,0) + +"RTN","TMGXDLG",1241,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1242,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1243,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1244,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",1245,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",1246,0) + set Added=$$AddParam(.Options,1,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1247,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1248,0) + set Added=$$AddParam(.Options,2,xcMin,xcNotOptional) +"RTN","TMGXDLG",1249,0) + set Added=$$AddParam(.Options,2,xcMax,xcNotOptional) +"RTN","TMGXDLG",1250,0) + set Added=$$AddParam(.Options,2,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1251,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1252,0) + +"RTN","TMGXDLG",1253,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1254,0) + +"RTN","TMGXDLG",1255,0) + quit +"RTN","TMGXDLG",1256,0) + +"RTN","TMGXDLG",1257,0) + +"RTN","TMGXDLG",1258,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1259,0) +Spin3(Text,width,height,label1,min1,max1,init1,label2,min2,max2,init2,label3,min3,max3,init3,Result1,Result2,Result3,x,y) +"RTN","TMGXDLG",1260,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1261,0) + ;"Input: Text -- text of input prompt to display +"RTN","TMGXDLG",1262,0) + ;" width,height of dialog -- [optional] +"RTN","TMGXDLG",1263,0) + ;" labelN -- the title to show for the range. +"RTN","TMGXDLG",1264,0) + ;" minN -- the minimum possible range of input value (default = 0) +"RTN","TMGXDLG",1265,0) + ;" maxN -- the minimum possible range of input value (default = 100) +"RTN","TMGXDLG",1266,0) + ;" initN -- the initial input value -- (default = 50) +"RTN","TMGXDLG",1267,0) + ;" Result1 -- a variable to put first input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1268,0) + ;" Result2 -- a variable to put second input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1269,0) + ;" Result3 -- a variable to put third input into for return. PASS BY REFERENCE +"RTN","TMGXDLG",1270,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1271,0) + ;"Output: The user input value is return in Result1 +"RTN","TMGXDLG",1272,0) + ;" result of 2nd user-input put into Result2 +"RTN","TMGXDLG",1273,0) + ;" result of 3rd user-input put into Result3 +"RTN","TMGXDLG",1274,0) + ;"Results: returns results of box closure. +"RTN","TMGXDLG",1275,0) + ;"Notes: (none) +"RTN","TMGXDLG",1276,0) + +"RTN","TMGXDLG",1277,0) + new Options +"RTN","TMGXDLG",1278,0) + new Results,result +"RTN","TMGXDLG",1279,0) + +"RTN","TMGXDLG",1280,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1281,0) + +"RTN","TMGXDLG",1282,0) + set Options(xcCommon,xcSeparator)="^" +"RTN","TMGXDLG",1283,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",1284,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1285,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1286,0) + set Options(xcBox,xcLabel,1)=$get(label1,"") +"RTN","TMGXDLG",1287,0) + set Options(xcBox,xcMin,1)=$get(min1,0) +"RTN","TMGXDLG",1288,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1289,0) + set Options(xcBox,xcMax,1)=$get(max1,100) +"RTN","TMGXDLG",1290,0) + set Options(xcBox,xcDefault,1)=$get(init1,50) +"RTN","TMGXDLG",1291,0) + set Options(xcBox,xcLabel,2)=$get(label2,"") +"RTN","TMGXDLG",1292,0) + set Options(xcBox,xcMin,2)=$get(min2,0) +"RTN","TMGXDLG",1293,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1294,0) + set Options(xcBox,xcMax,2)=$get(max2,100) +"RTN","TMGXDLG",1295,0) + set Options(xcBox,xcDefault,2)=$get(init2,50) +"RTN","TMGXDLG",1296,0) + set Options(xcBox,xcLabel,3)=$get(label3,"") +"RTN","TMGXDLG",1297,0) + set Options(xcBox,xcMin,3)=$get(min3,0) +"RTN","TMGXDLG",1298,0) + set Options(xcBox,xcMax,3)=$get(max3,100) +"RTN","TMGXDLG",1299,0) + set Options(xcBox,xcMax,3)=$get(max3,100) +"RTN","TMGXDLG",1300,0) + set Options(xcBox,xcDefault,3)=$get(init3,50) +"RTN","TMGXDLG",1301,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1302,0) + +"RTN","TMGXDLG",1303,0) + do x3spin(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1304,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1305,0) + +"RTN","TMGXDLG",1306,0) + set Result1=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1307,0) + set Result2=$get(Results(xcDlgOutput,1)) +"RTN","TMGXDLG",1308,0) + set Result3=$get(Results(xcDlgOutput,2)) +"RTN","TMGXDLG",1309,0) + +"RTN","TMGXDLG",1310,0) + quit result; +"RTN","TMGXDLG",1311,0) + +"RTN","TMGXDLG",1312,0) + +"RTN","TMGXDLG",1313,0) +x3spin(Options,Results,Modal) +"RTN","TMGXDLG",1314,0) + ;" --3spinsbox <text> <height> <width> <text> <height> <width> <min1> <max1> <def1> <label1> <min2> <max2> <def2> <label2> <min3> <max3> <def3> <label3> +"RTN","TMGXDLG",1315,0) + new Added +"RTN","TMGXDLG",1316,0) + +"RTN","TMGXDLG",1317,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1318,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1319,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1320,0) + do ParamTextAdd(.Options," --2spinsbox ") +"RTN","TMGXDLG",1321,0) + +"RTN","TMGXDLG",1322,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1323,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1324,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1325,0) + set Added=$$AddParam(.Options,1,xcMin,xcNotOptional) +"RTN","TMGXDLG",1326,0) + set Added=$$AddParam(.Options,1,xcMax,xcNotOptional) +"RTN","TMGXDLG",1327,0) + set Added=$$AddParam(.Options,1,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1328,0) + set Added=$$AddParam(.Options,1,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1329,0) + set Added=$$AddParam(.Options,2,xcMin,xcNotOptional) +"RTN","TMGXDLG",1330,0) + set Added=$$AddParam(.Options,2,xcMax,xcNotOptional) +"RTN","TMGXDLG",1331,0) + set Added=$$AddParam(.Options,2,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1332,0) + set Added=$$AddParam(.Options,2,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1333,0) + set Added=$$AddParam(.Options,3,xcMin,xcNotOptional) +"RTN","TMGXDLG",1334,0) + set Added=$$AddParam(.Options,3,xcMax,xcNotOptional) +"RTN","TMGXDLG",1335,0) + set Added=$$AddParam(.Options,3,xcDefault,xcNotOptional) +"RTN","TMGXDLG",1336,0) + set Added=$$AddParam(.Options,3,xcLabel,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1337,0) + +"RTN","TMGXDLG",1338,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1339,0) + +"RTN","TMGXDLG",1340,0) + quit +"RTN","TMGXDLG",1341,0) + +"RTN","TMGXDLG",1342,0) + +"RTN","TMGXDLG",1343,0) + +"RTN","TMGXDLG",1344,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1345,0) + +"RTN","TMGXDLG",1346,0) +Log(file,width,height,Modal,x,y) +"RTN","TMGXDLG",1347,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1348,0) + ;"Input: file to display +"RTN","TMGXDLG",1349,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",1350,0) + ;" [Modal]: if true, function does not return until dialog is closed. +"RTN","TMGXDLG",1351,0) + ;" if false, function returns immediately, and functions do NOT +"RTN","TMGXDLG",1352,0) + ;" reflect the user's button press. OPTIONAL -- default=xcNonModal +"RTN","TMGXDLG",1353,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1354,0) + ;"Output: (none) +"RTN","TMGXDLG",1355,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",1356,0) + ;"Notes: (none) +"RTN","TMGXDLG",1357,0) + +"RTN","TMGXDLG",1358,0) + new Options +"RTN","TMGXDLG",1359,0) + new Results,result +"RTN","TMGXDLG",1360,0) + +"RTN","TMGXDLG",1361,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1362,0) + +"RTN","TMGXDLG",1363,0) + set Options(xcBox,xcFile)=$get(file) +"RTN","TMGXDLG",1364,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1365,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1366,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",1367,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1368,0) + +"RTN","TMGXDLG",1369,0) + do xlog(.Options,.Results,Modal) +"RTN","TMGXDLG",1370,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1371,0) + +"RTN","TMGXDLG",1372,0) + quit result; +"RTN","TMGXDLG",1373,0) + +"RTN","TMGXDLG",1374,0) + +"RTN","TMGXDLG",1375,0) +xlog(Options,Results,Modal) +"RTN","TMGXDLG",1376,0) + ;" --logbox <file> <height> <width> +"RTN","TMGXDLG",1377,0) + new Added +"RTN","TMGXDLG",1378,0) + +"RTN","TMGXDLG",1379,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1380,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1381,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1382,0) + do ParamTextAdd(.Options," --logbox ") +"RTN","TMGXDLG",1383,0) + +"RTN","TMGXDLG",1384,0) + +"RTN","TMGXDLG",1385,0) + set Added=$$AddParam(.Options,,xcFile,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1386,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1387,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1388,0) + +"RTN","TMGXDLG",1389,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1390,0) + +"RTN","TMGXDLG",1391,0) + quit +"RTN","TMGXDLG",1392,0) + +"RTN","TMGXDLG",1393,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1394,0) + +"RTN","TMGXDLG",1395,0) +Edit(file,width,height,Results,x,y) +"RTN","TMGXDLG",1396,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1397,0) + ;"Input: file to display for editing, +"RTN","TMGXDLG",1398,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",1399,0) + ;" Results -- the array to put results into. MUST BE PASSED BY REFERENCE. +"RTN","TMGXDLG",1400,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1401,0) + ;"Output: The modified text is put into Results +"RTN","TMGXDLG",1402,0) + ;" Example of returned results after editing a script file.: +"RTN","TMGXDLG",1403,0) + ;" Results("Dialog Output",1)="<!DOCTYPE INSTALL_SCRIPT>" +"RTN","TMGXDLG",1404,0) + ;" Results("Dialog Output",2)="<INSTALL_SCRIPT>" +"RTN","TMGXDLG",1405,0) + ;" Results("Dialog Output",3)="<Script>" +"RTN","TMGXDLG",1406,0) + ;" Results("Dialog Output",4)=" <Show>This is a test script system.</Show>" +"RTN","TMGXDLG",1407,0) + ;" Results("Dialog Output",5)="</Script>" +"RTN","TMGXDLG",1408,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",1409,0) + ;"Notes: If dialog is not closed with an OK, then changes are NOT returned in Results +"RTN","TMGXDLG",1410,0) + +"RTN","TMGXDLG",1411,0) + new Options +"RTN","TMGXDLG",1412,0) + new Results,result +"RTN","TMGXDLG",1413,0) + +"RTN","TMGXDLG",1414,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1415,0) + +"RTN","TMGXDLG",1416,0) + set Options(xcBox,xcFile)=$get(file) +"RTN","TMGXDLG",1417,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1418,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1419,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1420,0) + +"RTN","TMGXDLG",1421,0) + do xedit(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1422,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1423,0) + +"RTN","TMGXDLG",1424,0) + quit result; +"RTN","TMGXDLG",1425,0) + +"RTN","TMGXDLG",1426,0) + +"RTN","TMGXDLG",1427,0) +xedit(Options,Results,Modal) +"RTN","TMGXDLG",1428,0) + ;" --editbox <file> <height> <width> +"RTN","TMGXDLG",1429,0) + new Added +"RTN","TMGXDLG",1430,0) + +"RTN","TMGXDLG",1431,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1432,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1433,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1434,0) + do ParamTextAdd(.Options," --editbox ") +"RTN","TMGXDLG",1435,0) + +"RTN","TMGXDLG",1436,0) + set Added=$$AddParam(.Options,,xcFile,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1437,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1438,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1439,0) + +"RTN","TMGXDLG",1440,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1441,0) + +"RTN","TMGXDLG",1442,0) + quit +"RTN","TMGXDLG",1443,0) + +"RTN","TMGXDLG",1444,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1445,0) + +"RTN","TMGXDLG",1446,0) +Text(file,width,height,Modal,x,y) +"RTN","TMGXDLG",1447,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1448,0) + ;"Input: file to display +"RTN","TMGXDLG",1449,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",1450,0) + ;" [Modal]: if true, function does not return until dialog is closed. +"RTN","TMGXDLG",1451,0) + ;" if false, function returns immediately, and functions do NOT +"RTN","TMGXDLG",1452,0) + ;" reflect the user's button press. OPTIONAL -- default=xcNonModal +"RTN","TMGXDLG",1453,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1454,0) + ;"Output: (none) +"RTN","TMGXDLG",1455,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",1456,0) + ;"Notes: (none) +"RTN","TMGXDLG",1457,0) + +"RTN","TMGXDLG",1458,0) + new Options +"RTN","TMGXDLG",1459,0) + new Results,result +"RTN","TMGXDLG",1460,0) + +"RTN","TMGXDLG",1461,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1462,0) + +"RTN","TMGXDLG",1463,0) + set Options(xcBox,xcFile)=$get(file) +"RTN","TMGXDLG",1464,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1465,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1466,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",1467,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1468,0) + +"RTN","TMGXDLG",1469,0) + do xtext(.Options,.Results,Modal) +"RTN","TMGXDLG",1470,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1471,0) + +"RTN","TMGXDLG",1472,0) + quit result; +"RTN","TMGXDLG",1473,0) + +"RTN","TMGXDLG",1474,0) + +"RTN","TMGXDLG",1475,0) +xtext(Options,Results,Modal) +"RTN","TMGXDLG",1476,0) + ;" --textbox <file> <height> <width> +"RTN","TMGXDLG",1477,0) + new Added +"RTN","TMGXDLG",1478,0) + +"RTN","TMGXDLG",1479,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1480,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1481,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1482,0) + do ParamTextAdd(.Options," --textbox ") +"RTN","TMGXDLG",1483,0) + +"RTN","TMGXDLG",1484,0) + set Added=$$AddParam(.Options,,xcFile,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1485,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1486,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1487,0) + +"RTN","TMGXDLG",1488,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1489,0) + +"RTN","TMGXDLG",1490,0) + quit +"RTN","TMGXDLG",1491,0) + +"RTN","TMGXDLG",1492,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1493,0) + +"RTN","TMGXDLG",1494,0) +Tail(file,width,height,Modal,x,y) +"RTN","TMGXDLG",1495,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1496,0) + ;" A tailbox is one that keeps at the bottom, updating as the file is updated. +"RTN","TMGXDLG",1497,0) + ;"Input: file to display +"RTN","TMGXDLG",1498,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",1499,0) + ;" [Modal]: if true, function does not return until dialog is closed. +"RTN","TMGXDLG",1500,0) + ;" if false, function returns immediately, and functions do NOT +"RTN","TMGXDLG",1501,0) + ;" reflect the user's button press. OPTIONAL -- default=xcNonModal +"RTN","TMGXDLG",1502,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1503,0) + ;"Output: (none) +"RTN","TMGXDLG",1504,0) + ;"Results: Returns results of box closure (see Modal note above) +"RTN","TMGXDLG",1505,0) + ;"Notes: (none) +"RTN","TMGXDLG",1506,0) + +"RTN","TMGXDLG",1507,0) + new Options +"RTN","TMGXDLG",1508,0) + new Results,result +"RTN","TMGXDLG",1509,0) + +"RTN","TMGXDLG",1510,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1511,0) + +"RTN","TMGXDLG",1512,0) + set Options(xcBox,xcFile)=$get(file) +"RTN","TMGXDLG",1513,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1514,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1515,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",1516,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1517,0) + +"RTN","TMGXDLG",1518,0) + do xtail(.Options,.Results,Modal) +"RTN","TMGXDLG",1519,0) + set result=Results(xcDlgResult) +"RTN","TMGXDLG",1520,0) + +"RTN","TMGXDLG",1521,0) + quit result; +"RTN","TMGXDLG",1522,0) + +"RTN","TMGXDLG",1523,0) + +"RTN","TMGXDLG",1524,0) +xtail(Options,Results,Modal) +"RTN","TMGXDLG",1525,0) + ;" --tailbox <file> <height> <width> +"RTN","TMGXDLG",1526,0) + new Added +"RTN","TMGXDLG",1527,0) + +"RTN","TMGXDLG",1528,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1529,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1530,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1531,0) + do ParamTextAdd(.Options," --tailbox ") +"RTN","TMGXDLG",1532,0) + +"RTN","TMGXDLG",1533,0) + set Added=$$AddParam(.Options,,xcFile,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1534,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1535,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1536,0) + +"RTN","TMGXDLG",1537,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1538,0) + +"RTN","TMGXDLG",1539,0) + quit +"RTN","TMGXDLG",1540,0) + +"RTN","TMGXDLG",1541,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1542,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",1543,0) + +"RTN","TMGXDLG",1544,0) +xchecklist(Options,Results,Modal) +"RTN","TMGXDLG",1545,0) + ;" --checklist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}... +"RTN","TMGXDLG",1546,0) + +"RTN","TMGXDLG",1547,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1548,0) + +"RTN","TMGXDLG",1549,0) +RadioList(Text,List,width,height,x,y) +"RTN","TMGXDLG",1550,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1551,0) + ;" A tailbox is one that keeps at the bottom, updating as the file is updated. +"RTN","TMGXDLG",1552,0) + ;"Input: Text -- title text. +"RTN","TMGXDLG",1553,0) + ;" List -- Best if passed by reference. Holds radio list as follows: +"RTN","TMGXDLG",1554,0) + ;" List(1,xcTag)=<return value> -- the output the be returned if selected. +"RTN","TMGXDLG",1555,0) + ;" List(1,xcItem)=<text of radio item> +"RTN","TMGXDLG",1556,0) + ;" List(1,xcStatus)=<status> must be: {"on", "off", or "unavailable"} +"RTN","TMGXDLG",1557,0) + ;" List(1,xcHelp)=<hover tip> -- [optional] +"RTN","TMGXDLG",1558,0) + ;" List(2,xcTag)=<return value> -- the output the be returned if selected. +"RTN","TMGXDLG",1559,0) + ;" List(2,xcItem)=<text of radio item> +"RTN","TMGXDLG",1560,0) + ;" List(2,xcStatus)=<status> must be: {"on", "off", or "unavailable"} +"RTN","TMGXDLG",1561,0) + ;" List(2,xcHelp)=<hover tip> -- [optional] +"RTN","TMGXDLG",1562,0) + ;" ... etc up to any number N +"RTN","TMGXDLG",1563,0) + ;" height & width of dialog -- [optional] +"RTN","TMGXDLG",1564,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1565,0) + ;"Output: (none) +"RTN","TMGXDLG",1566,0) + ;"Results: Returns selected 'tag'. If cancel pressed, then returns "" +"RTN","TMGXDLG",1567,0) + ;"Notes: (none) +"RTN","TMGXDLG",1568,0) + +"RTN","TMGXDLG",1569,0) + new Options +"RTN","TMGXDLG",1570,0) + new Results +"RTN","TMGXDLG",1571,0) + set result="" +"RTN","TMGXDLG",1572,0) + new i,Done +"RTN","TMGXDLG",1573,0) + new status,help +"RTN","TMGXDLG",1574,0) + +"RTN","TMGXDLG",1575,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1576,0) + +"RTN","TMGXDLG",1577,0) + set Options(xcBox,xcText)=$get(Text) +"RTN","TMGXDLG",1578,0) + +"RTN","TMGXDLG",1579,0) + set Done=0 +"RTN","TMGXDLG",1580,0) + for i=1:1 do quit:Done +"RTN","TMGXDLG",1581,0) + . if $data(List(i,xcTag))=0 set Done=1 quit +"RTN","TMGXDLG",1582,0) + . set Options(xcBox,xcTag,i)=$get(List(i,xcTag)) +"RTN","TMGXDLG",1583,0) + . set Options(xcBox,xcItem,i)=$get(List(i,xcItem)) +"RTN","TMGXDLG",1584,0) + . set status=$get(List(i,xcStatus)) +"RTN","TMGXDLG",1585,0) + . if (status'="on")&(status'="unavailable") set status="off" +"RTN","TMGXDLG",1586,0) + . set Options(xcBox,xcStatus,i)=status +"RTN","TMGXDLG",1587,0) + . set help=$get(List(i,xcHelp,i)) +"RTN","TMGXDLG",1588,0) + . if help'="" set Options(xcTransient,xxcItemHelp)=1 +"RTN","TMGXDLG",1589,0) + . set help=($get(Options(xcTransient,xxcItemHelp))=1) +"RTN","TMGXDLG",1590,0) + . if help set Options(xcBox,xcHelp,i)=$get(List(i,xcHelp)) +"RTN","TMGXDLG",1591,0) + +"RTN","TMGXDLG",1592,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1593,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1594,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1595,0) + +"RTN","TMGXDLG",1596,0) + do xradiolist(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1597,0) + +"RTN","TMGXDLG",1598,0) + set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1599,0) + quit result; +"RTN","TMGXDLG",1600,0) + +"RTN","TMGXDLG",1601,0) + +"RTN","TMGXDLG",1602,0) +xradiolist(Options,Results,Modal) +"RTN","TMGXDLG",1603,0) + ;" --radiolist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}... +"RTN","TMGXDLG",1604,0) + new Added,GroupAdded +"RTN","TMGXDLG",1605,0) + new N +"RTN","TMGXDLG",1606,0) + +"RTN","TMGXDLG",1607,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1608,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1609,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1610,0) + do ParamTextAdd(.Options," --radiolist ") +"RTN","TMGXDLG",1611,0) + +"RTN","TMGXDLG",1612,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1613,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1614,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1615,0) + set Added=$$AddParam(.Options,,xcListHeight) +"RTN","TMGXDLG",1616,0) + set N=1 +"RTN","TMGXDLG",1617,0) +xrl1 set GroupAdded=$$AddParam(.Options,N,xcTag,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1618,0) + if GroupAdded=0 goto xrl2 +"RTN","TMGXDLG",1619,0) + set Added=$$AddParam(.Options,N,xcItem,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1620,0) + set Added=$$AddParam(.Options,N,xcStatus,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1621,0) + if (Added=1)&($get(Option(xcTransient,xxcItemHelp))=1) do +"RTN","TMGXDLG",1622,0) + . set Added=$$AddParam(.Options,N,xcHelp,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1623,0) + set N=N+1 goto xrl1 +"RTN","TMGXDLG",1624,0) +xrl2 +"RTN","TMGXDLG",1625,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1626,0) + +"RTN","TMGXDLG",1627,0) + quit +"RTN","TMGXDLG",1628,0) + +"RTN","TMGXDLG",1629,0) + +"RTN","TMGXDLG",1630,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1631,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",1632,0) + +"RTN","TMGXDLG",1633,0) +xmenu(Options,Results,Modal) +"RTN","TMGXDLG",1634,0) + ;" --menubox <text> <height> <width> <menu height> <tag1> <item1> {<help1>}... +"RTN","TMGXDLG",1635,0) + +"RTN","TMGXDLG",1636,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1637,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",1638,0) + +"RTN","TMGXDLG",1639,0) +xtreeview(Options,Results,Modal) +"RTN","TMGXDLG",1640,0) + ;" --treeview <text> <height> <width> <list height> <tag1> <item1> <status1> <item_depth1> {<help1>}... +"RTN","TMGXDLG",1641,0) + +"RTN","TMGXDLG",1642,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1643,0) + +"RTN","TMGXDLG",1644,0) +FileSel(Title,InitFile,width,height,x,y) +"RTN","TMGXDLG",1645,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1646,0) + ;" A tailbox is one that keeps at the bottom, updating as the file is updated. +"RTN","TMGXDLG",1647,0) + ;"Input: InitFile. The initial file to select, and the default file. [optional] +"RTN","TMGXDLG",1648,0) + ;" width,height -- the initial size of box. [Optional] +"RTN","TMGXDLG",1649,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1650,0) + ;"Output:(none) +"RTN","TMGXDLG",1651,0) + ;"Results: returns the selected filename +"RTN","TMGXDLG",1652,0) + ;"Notes: (none) +"RTN","TMGXDLG",1653,0) + +"RTN","TMGXDLG",1654,0) + new Options +"RTN","TMGXDLG",1655,0) + new Results +"RTN","TMGXDLG",1656,0) + new result set result="" +"RTN","TMGXDLG",1657,0) + +"RTN","TMGXDLG",1658,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1659,0) + if $data(Title) set Options(xcCommon,xcTitle)=Title +"RTN","TMGXDLG",1660,0) + set Options(xcBox,xcFile)=$get(InitFile,"") +"RTN","TMGXDLG",1661,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1662,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1663,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1664,0) + +"RTN","TMGXDLG",1665,0) + do xfilesel(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1666,0) + +"RTN","TMGXDLG",1667,0) + if Results(xcDlgResult)=0 set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1668,0) + +"RTN","TMGXDLG",1669,0) + quit result; +"RTN","TMGXDLG",1670,0) + +"RTN","TMGXDLG",1671,0) +xfilesel(Options,Results,Modal) +"RTN","TMGXDLG",1672,0) + ;" --fselect <file> <height> <width> +"RTN","TMGXDLG",1673,0) + new Added +"RTN","TMGXDLG",1674,0) + +"RTN","TMGXDLG",1675,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1676,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1677,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1678,0) + do ParamTextAdd(.Options," --fselect ") +"RTN","TMGXDLG",1679,0) + +"RTN","TMGXDLG",1680,0) + set Added=$$AddParam(.Options,,xcFile,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1681,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1682,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1683,0) + +"RTN","TMGXDLG",1684,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1685,0) + +"RTN","TMGXDLG",1686,0) + quit +"RTN","TMGXDLG",1687,0) + +"RTN","TMGXDLG",1688,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1689,0) + +"RTN","TMGXDLG",1690,0) +DirSel(Title,InitDir,width,height,x,y) +"RTN","TMGXDLG",1691,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1692,0) + ;" A tailbox is one that keeps at the bottom, updating as the file is updated. +"RTN","TMGXDLG",1693,0) + ;"Input: InitDir: The initial file to select, and the default file. [optional] +"RTN","TMGXDLG",1694,0) + ;" width,height -- the initial size of box. [Optional] +"RTN","TMGXDLG",1695,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1696,0) + ;"Output:(none) +"RTN","TMGXDLG",1697,0) + ;"Results: returns the selected directory +"RTN","TMGXDLG",1698,0) + ;"Notes: (none) +"RTN","TMGXDLG",1699,0) + +"RTN","TMGXDLG",1700,0) + new Options +"RTN","TMGXDLG",1701,0) + new Results +"RTN","TMGXDLG",1702,0) + new result set result="" +"RTN","TMGXDLG",1703,0) + +"RTN","TMGXDLG",1704,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1705,0) + if $data(Title) set Options(xcCommon,xcTitle)=Title +"RTN","TMGXDLG",1706,0) + set Options(xcBox,xcDirectory)=$get(InitDir,"") +"RTN","TMGXDLG",1707,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1708,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1709,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1710,0) + +"RTN","TMGXDLG",1711,0) + do xdirsel(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1712,0) + +"RTN","TMGXDLG",1713,0) + if Results(xcDlgResult)=0 set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1714,0) + +"RTN","TMGXDLG",1715,0) + quit result; +"RTN","TMGXDLG",1716,0) + +"RTN","TMGXDLG",1717,0) + +"RTN","TMGXDLG",1718,0) +xdirsel(Options,Results,Modal) +"RTN","TMGXDLG",1719,0) + ;" --dselect <directory> <height> <width> +"RTN","TMGXDLG",1720,0) + new Added +"RTN","TMGXDLG",1721,0) + +"RTN","TMGXDLG",1722,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1723,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1724,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1725,0) + do ParamTextAdd(.Options," --dselect ") +"RTN","TMGXDLG",1726,0) + +"RTN","TMGXDLG",1727,0) + +"RTN","TMGXDLG",1728,0) + set Added=$$AddParam(.Options,,xcDirectory,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1729,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1730,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1731,0) + +"RTN","TMGXDLG",1732,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1733,0) + +"RTN","TMGXDLG",1734,0) + quit +"RTN","TMGXDLG",1735,0) + +"RTN","TMGXDLG",1736,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1737,0) + +"RTN","TMGXDLG",1738,0) +DateSel(Text,width,height,InitDay,InitMonth,InitYear,x,y) +"RTN","TMGXDLG",1739,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1740,0) + ;" Shows a calendar and allows user to select date. +"RTN","TMGXDLG",1741,0) + ;"Input: Text -- a title / msg to show. +"RTN","TMGXDLG",1742,0) + ;" width,height -- the initial size of box. [Optional] +"RTN","TMGXDLG",1743,0) + ;" InitDay/Month/Year -- Initial date to show. +"RTN","TMGXDLG",1744,0) + ;" NOTE: These three variables are optional BUT if InitDay given all 3 should be present. +"RTN","TMGXDLG",1745,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1746,0) + ;"Output:(none) +"RTN","TMGXDLG",1747,0) + ;"Results: returns the selected date +"RTN","TMGXDLG",1748,0) + ;"Notes: (none) +"RTN","TMGXDLG",1749,0) + +"RTN","TMGXDLG",1750,0) + new Options +"RTN","TMGXDLG",1751,0) + new Results +"RTN","TMGXDLG",1752,0) + new result set result="" +"RTN","TMGXDLG",1753,0) + +"RTN","TMGXDLG",1754,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1755,0) + +"RTN","TMGXDLG",1756,0) + set Options(xcBox,xcText)=$get(Text,"") +"RTN","TMGXDLG",1757,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1758,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1759,0) + if $data(InitDay) do +"RTN","TMGXDLG",1760,0) + . set Options(xcBox,xcDay)=InitDay +"RTN","TMGXDLG",1761,0) + . set Options(xcBox,xcMonth)=$get(InitMonth,0) +"RTN","TMGXDLG",1762,0) + . set Options(xcBox,xcYear)=$get(InitYear,0) +"RTN","TMGXDLG",1763,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1764,0) + +"RTN","TMGXDLG",1765,0) + do xcalendarsel(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1766,0) + +"RTN","TMGXDLG",1767,0) + if Results(xcDlgResult)=0 set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1768,0) + +"RTN","TMGXDLG",1769,0) + quit result; +"RTN","TMGXDLG",1770,0) + +"RTN","TMGXDLG",1771,0) +xcalendarsel(Options,Results,Modal) +"RTN","TMGXDLG",1772,0) + ;" --calendar <text> <height> <width> [<day> <month> <year>] +"RTN","TMGXDLG",1773,0) + +"RTN","TMGXDLG",1774,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1775,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1776,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1777,0) + do ParamTextAdd(.Options," --calendar ") +"RTN","TMGXDLG",1778,0) + +"RTN","TMGXDLG",1779,0) + set Added=$$AddParam(.Options,,xcText,xcAddQuote) +"RTN","TMGXDLG",1780,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1781,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1782,0) + if $data(Options(xcDay)) do +"RTN","TMGXDLG",1783,0) + . set Added=$$AddParam(.Options,,xcDay,xcNotOptional) +"RTN","TMGXDLG",1784,0) + . set Added=$$AddParam(.Options,,xcMonth,xcNotOptional) +"RTN","TMGXDLG",1785,0) + . set Added=$$AddParam(.Options,,xcYear,xcNotOptional) +"RTN","TMGXDLG",1786,0) + +"RTN","TMGXDLG",1787,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1788,0) + +"RTN","TMGXDLG",1789,0) + quit +"RTN","TMGXDLG",1790,0) + +"RTN","TMGXDLG",1791,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1792,0) + +"RTN","TMGXDLG",1793,0) +TimeSel(Text,width,height,InitHour,InitMinute,InitSecond,x,y) +"RTN","TMGXDLG",1794,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1795,0) + ;" Shows a calendar and allows user to select date. +"RTN","TMGXDLG",1796,0) + ;"Input: Text -- a title / msg to show. +"RTN","TMGXDLG",1797,0) + ;" width,height -- the initial size of box. [Optional] +"RTN","TMGXDLG",1798,0) + ;" InitHour/Minute/Second -- Initial time to show. +"RTN","TMGXDLG",1799,0) + ;" NOTE: These three variables are optional BUT if InitDay given all 3 should be present. +"RTN","TMGXDLG",1800,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1801,0) + ;"Output:(none) +"RTN","TMGXDLG",1802,0) + ;"Results: returns the selected date +"RTN","TMGXDLG",1803,0) + ;"Notes: (none) +"RTN","TMGXDLG",1804,0) + +"RTN","TMGXDLG",1805,0) + new Options +"RTN","TMGXDLG",1806,0) + new Results +"RTN","TMGXDLG",1807,0) + new result set result="" +"RTN","TMGXDLG",1808,0) + +"RTN","TMGXDLG",1809,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1810,0) + +"RTN","TMGXDLG",1811,0) + set Options(xcBox,xcText)=$get(Text,"") +"RTN","TMGXDLG",1812,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1813,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1814,0) + if $data(InitHour) do +"RTN","TMGXDLG",1815,0) + . set Options(xcBox,xcHours)=InitDay +"RTN","TMGXDLG",1816,0) + . set Options(xcBox,xcMinutes)=$get(InitMinute,0) +"RTN","TMGXDLG",1817,0) + . set Options(xcBox,xcSeconds)=$get(InitSecond,0) +"RTN","TMGXDLG",1818,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1819,0) + +"RTN","TMGXDLG",1820,0) + do xtimesel(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1821,0) + +"RTN","TMGXDLG",1822,0) + if Results(xcDlgResult)=0 set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1823,0) + +"RTN","TMGXDLG",1824,0) + quit result; +"RTN","TMGXDLG",1825,0) + +"RTN","TMGXDLG",1826,0) +xtimesel(Options,Results,Modal) +"RTN","TMGXDLG",1827,0) + ;" --timebox <text> <height> <width> [<hours> <minutes> <seconds>] +"RTN","TMGXDLG",1828,0) + +"RTN","TMGXDLG",1829,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1830,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1831,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1832,0) + do ParamTextAdd(.Options," --timebox ") +"RTN","TMGXDLG",1833,0) + +"RTN","TMGXDLG",1834,0) + set Added=$$AddParam(.Options,,xcText,xcAddQuote) +"RTN","TMGXDLG",1835,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1836,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1837,0) + if $data(Options(xcHours)) do +"RTN","TMGXDLG",1838,0) + . set Added=$$AddParam(.Options,,xcHours,xcNotOptional) +"RTN","TMGXDLG",1839,0) + . set Added=$$AddParam(.Options,,xcMinutes,xcNotOptional) +"RTN","TMGXDLG",1840,0) + . set Added=$$AddParam(.Options,,xcSeconds,xcNotOptional) +"RTN","TMGXDLG",1841,0) + +"RTN","TMGXDLG",1842,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1843,0) + +"RTN","TMGXDLG",1844,0) + quit +"RTN","TMGXDLG",1845,0) + +"RTN","TMGXDLG",1846,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1847,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",1848,0) + +"RTN","TMGXDLG",1849,0) +xbuildlist(Options,Results,Modal) +"RTN","TMGXDLG",1850,0) + ;" --buildlist <text> <height> <width> <list height> <tag1> <item1> <status1> {<help1>}... +"RTN","TMGXDLG",1851,0) + +"RTN","TMGXDLG",1852,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1853,0) + ;"TO BE COMPLETED +"RTN","TMGXDLG",1854,0) + +"RTN","TMGXDLG",1855,0) +xcolorsel(Options,Results,Modal) +"RTN","TMGXDLG",1856,0) + ;" --colorsel <text> <height> <width> +"RTN","TMGXDLG",1857,0) + new Added +"RTN","TMGXDLG",1858,0) + +"RTN","TMGXDLG",1859,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1860,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1861,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1862,0) + do ParamTextAdd(.Options," --colorsel ") +"RTN","TMGXDLG",1863,0) + +"RTN","TMGXDLG",1864,0) + set Added=$$AddParam(.Options,,xcText,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1865,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1866,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1867,0) + +"RTN","TMGXDLG",1868,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1869,0) + +"RTN","TMGXDLG",1870,0) + quit +"RTN","TMGXDLG",1871,0) + +"RTN","TMGXDLG",1872,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1873,0) +FontSel(InitFont,width,height,x,y) +"RTN","TMGXDLG",1874,0) + ;"Purpose: To provide an easier access to Xdialog function +"RTN","TMGXDLG",1875,0) + ;" Shows a font-pick +"RTN","TMGXDLG",1876,0) + ;"Input: InitFont -- name of initial font to show [Optional] +"RTN","TMGXDLG",1877,0) + ;" width,height -- the initial size of box. [Optional] +"RTN","TMGXDLG",1878,0) + ;" x,y -- the display location of the dialog [optional] +"RTN","TMGXDLG",1879,0) + ;"Output:(none) +"RTN","TMGXDLG",1880,0) + ;"Results: returns the selected date +"RTN","TMGXDLG",1881,0) + ;"Notes: (none) +"RTN","TMGXDLG",1882,0) + +"RTN","TMGXDLG",1883,0) + new Options +"RTN","TMGXDLG",1884,0) + new Results +"RTN","TMGXDLG",1885,0) + new result set result="" +"RTN","TMGXDLG",1886,0) + +"RTN","TMGXDLG",1887,0) + if $data(xcCommon)=0 do SetupConsts() +"RTN","TMGXDLG",1888,0) + +"RTN","TMGXDLG",1889,0) + set Options(xcBox,xcFontName)=$get(InitFont,"") +"RTN","TMGXDLG",1890,0) + set Options(xcBox,xcHeight)=$get(height,0) +"RTN","TMGXDLG",1891,0) + set Options(xcBox,xcWidth)=$get(width,0) +"RTN","TMGXDLG",1892,0) + if $data(x) set Options(xcTransient,xcBegin)=x_" "_$get(y,0) +"RTN","TMGXDLG",1893,0) + +"RTN","TMGXDLG",1894,0) + do xfontsel(.Options,.Results,xcModalMode) +"RTN","TMGXDLG",1895,0) + +"RTN","TMGXDLG",1896,0) + if Results(xcDlgResult)=0 set result=$get(Results(xcDlgOutput,"")) +"RTN","TMGXDLG",1897,0) + +"RTN","TMGXDLG",1898,0) + quit result; +"RTN","TMGXDLG",1899,0) + +"RTN","TMGXDLG",1900,0) + +"RTN","TMGXDLG",1901,0) +xfontsel(Options,Results,Modal) +"RTN","TMGXDLG",1902,0) + ;" --fontsel <font name> <height> <width> +"RTN","TMGXDLG",1903,0) + new Added +"RTN","TMGXDLG",1904,0) + +"RTN","TMGXDLG",1905,0) + do ParamTextAdd(.Options,vDialog) +"RTN","TMGXDLG",1906,0) + do SetCommons(.Options) +"RTN","TMGXDLG",1907,0) + do SetTrans(.Options) +"RTN","TMGXDLG",1908,0) + do ParamTextAdd(.Options," --fontsel ") +"RTN","TMGXDLG",1909,0) + +"RTN","TMGXDLG",1910,0) + set Added=$$AddParam(.Options,,xcFontName,xcNotOptional,xcAddQuote) +"RTN","TMGXDLG",1911,0) + set Added=$$AddParam(.Options,,xcHeight) +"RTN","TMGXDLG",1912,0) + set Added=$$AddParam(.Options,,xcWidth) +"RTN","TMGXDLG",1913,0) + +"RTN","TMGXDLG",1914,0) + do LaunchCmd(.Options,.Results,.Modal) +"RTN","TMGXDLG",1915,0) + +"RTN","TMGXDLG",1916,0) + quit +"RTN","TMGXDLG",1917,0) + +"RTN","TMGXDLG",1918,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1919,0) +ChClrScr() +"RTN","TMGXDLG",1920,0) + ;"Purpose: When working with text menus, after the dialog exits, +"RTN","TMGXDLG",1921,0) + ;" it leaves the drawing of the menu on the text screen. +"RTN","TMGXDLG",1922,0) + ;" So I'll have a function that clears the screen. +"RTN","TMGXDLG",1923,0) + ;"Note: I can't depend on the VistA system to have set up +"RTN","TMGXDLG",1924,0) + ;" variables that will clear the screen. So I'll do it quick and dirty +"RTN","TMGXDLG",1925,0) + ;" by many newline characters. +"RTN","TMGXDLG",1926,0) + +"RTN","TMGXDLG",1927,0) + new count +"RTN","TMGXDLG",1928,0) + +"RTN","TMGXDLG",1929,0) + for count=1:1:50 write ! +"RTN","TMGXDLG",1930,0) + +"RTN","TMGXDLG",1931,0) + quit +"RTN","TMGXDLG",1932,0) + +"RTN","TMGXDLG",1933,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1934,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1935,0) + +"RTN","TMGXDLG",1936,0) +SetCommons(Options) +"RTN","TMGXDLG",1937,0) + ;"Purpose: to put common options into a parameter string that will be sent to Xdialog +"RTN","TMGXDLG",1938,0) + ;"Input: Options -- MUST BE PASSED BY REFERENCE +"RTN","TMGXDLG",1939,0) + ;" See docs re. Options above. +"RTN","TMGXDLG",1940,0) + ;"Output: The Options array will contain an entry containing output string: +"RTN","TMGXDLG",1941,0) + ;" Options(xcCmdLine)=<composite options> +"RTN","TMGXDLG",1942,0) + +"RTN","TMGXDLG",1943,0) + new i +"RTN","TMGXDLG",1944,0) + new s set s=" " +"RTN","TMGXDLG",1945,0) + new AddQuote set AddQuote=0 +"RTN","TMGXDLG",1946,0) + +"RTN","TMGXDLG",1947,0) + if $data(xcCommon)=0 do SetupConsts() ;"Ensure constants created. +"RTN","TMGXDLG",1948,0) + +"RTN","TMGXDLG",1949,0) + +"RTN","TMGXDLG",1950,0) + set i=$order(Options(xcCommon,"")) +"RTN","TMGXDLG",1951,0) + for do q:i="" +"RTN","TMGXDLG",1952,0) + . if i=xcCmdLine quit +"RTN","TMGXDLG",1953,0) + . if (i'=xcCmdLine)&($data(Options(xcCommon,i))'=0) do +"RTN","TMGXDLG",1954,0) + . . set s=s_"--"_i_" " +"RTN","TMGXDLG",1955,0) + . . if $get(Options(xcCommon,i))'=1 do +"RTN","TMGXDLG",1956,0) + . . . set s=s_""""_Options(xcCommon,i)_""" " +"RTN","TMGXDLG",1957,0) + . set i=$order(Options(xcCommon,i)) +"RTN","TMGXDLG",1958,0) + +"RTN","TMGXDLG",1959,0) + ;"set Options(xcCmdLine)=s +"RTN","TMGXDLG",1960,0) + do ParamTextAdd(.Options,s) +"RTN","TMGXDLG",1961,0) + +"RTN","TMGXDLG",1962,0) + quit +"RTN","TMGXDLG",1963,0) + +"RTN","TMGXDLG",1964,0) + +"RTN","TMGXDLG",1965,0) +SetTrans(Options) +"RTN","TMGXDLG",1966,0) + ;"Purpose: to put transient options into a parameter string that will be sent to Xdialog +"RTN","TMGXDLG",1967,0) + ;"Input: Options -- MUST BE PASSED BY REFERENCE +"RTN","TMGXDLG",1968,0) + ;" See docs re. Options above. +"RTN","TMGXDLG",1969,0) + ;"Output: The Options array will contain an entry containing output string: +"RTN","TMGXDLG",1970,0) + ;" Options(xcCmdLine)=<composite options> +"RTN","TMGXDLG",1971,0) + ;"Note: This function should be called AFTER SetCommons() +"RTN","TMGXDLG",1972,0) + +"RTN","TMGXDLG",1973,0) + new i +"RTN","TMGXDLG",1974,0) + ;"new s set s=$get(Options(xcCmdLine)) +"RTN","TMGXDLG",1975,0) + new s set s=" " +"RTN","TMGXDLG",1976,0) + +"RTN","TMGXDLG",1977,0) + set i=$order(Options(xcTransient,"")) +"RTN","TMGXDLG",1978,0) + for do q:i="" +"RTN","TMGXDLG",1979,0) + . if i=xcCmdLine quit +"RTN","TMGXDLG",1980,0) + . if (i'=xcCmdLine)&($data(Options(xcTransient,i))'=0) do +"RTN","TMGXDLG",1981,0) + . . set s=s_"--"_i_" " +"RTN","TMGXDLG",1982,0) + . . if $get(Options(xcTransient,i))'=1 set s=s_Options(xcTransient,i)_" " +"RTN","TMGXDLG",1983,0) + . set i=$order(Options(xcTransient,i)) +"RTN","TMGXDLG",1984,0) + +"RTN","TMGXDLG",1985,0) + ;"set Options(xcCmdLine)=$get(Options(xcCmdLine))_s +"RTN","TMGXDLG",1986,0) + do ParamTextAdd(.Options,s) +"RTN","TMGXDLG",1987,0) + +"RTN","TMGXDLG",1988,0) + quit +"RTN","TMGXDLG",1989,0) + +"RTN","TMGXDLG",1990,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",1991,0) + +"RTN","TMGXDLG",1992,0) +AddParam(Options,N,index,optional,AddQuote) +"RTN","TMGXDLG",1993,0) + ;"Purpose: to add index'd box parameter to the composite parameters +"RTN","TMGXDLG",1994,0) + ;"Input: Options -- see above. MUST BE PASSED BY REFERENCE +"RTN","TMGXDLG",1995,0) + ;" N -- should NOT be passed, unless index item has a 'subscript', i.e.: +"RTN","TMGXDLG",1996,0) + ;" Options(xcBox,xcItem,1)="Bill" +"RTN","TMGXDLG",1997,0) + ;" Options(xcBox,xcItem,2)="Bill" +"RTN","TMGXDLG",1998,0) + ;" Options(xcBox,xcItem,3)="Bill" +"RTN","TMGXDLG",1999,0) + ;" index -- specifies which parameter to add (if found) +"RTN","TMGXDLG",2000,0) + ;" optional -- specifies if parameter is optional +"RTN","TMGXDLG",2001,0) + ;" default=not optional (0). Value of 1=is optional +"RTN","TMGXDLG",2002,0) + ;" AddQuote -- if parameter should be in quotes -- default is 0 / no +"RTN","TMGXDLG",2003,0) + ;"results: returns if data was added. (1=added, 0=not added) +"RTN","TMGXDLG",2004,0) + +"RTN","TMGXDLG",2005,0) + new result set result=0 +"RTN","TMGXDLG",2006,0) + new s,sCurrent +"RTN","TMGXDLG",2007,0) + new CurLine +"RTN","TMGXDLG",2008,0) + new Param +"RTN","TMGXDLG",2009,0) + +"RTN","TMGXDLG",2010,0) + set optional=$get(optional,xcNotOptional) +"RTN","TMGXDLG",2011,0) + if optional'=xcNotOptional set optional=xcOptional +"RTN","TMGXDLG",2012,0) + set AddQuote=$get(AddQuote,xcNoQuote) +"RTN","TMGXDLG",2013,0) + +"RTN","TMGXDLG",2014,0) + ;"write "Starting AddParam",! +"RTN","TMGXDLG",2015,0) + +"RTN","TMGXDLG",2016,0) + set s="" +"RTN","TMGXDLG",2017,0) + +"RTN","TMGXDLG",2018,0) + if $data(N) do ;"i.e. user is looking for a subscripted element... +"RTN","TMGXDLG",2019,0) + . set Param=$get(Options(xcBox,index,N)) +"RTN","TMGXDLG",2020,0) + else do ;"i.e. user is NOT looking for a subscripted element... +"RTN","TMGXDLG",2021,0) + . set Param=$get(Options(xcBox,index)) +"RTN","TMGXDLG",2022,0) + +"RTN","TMGXDLG",2023,0) + if Param'="" do ;"Parameter found. +"RTN","TMGXDLG",2024,0) + . if AddQuote set s=s_"""" +"RTN","TMGXDLG",2025,0) + . set s=s_Param +"RTN","TMGXDLG",2026,0) + . set result=1 +"RTN","TMGXDLG",2027,0) + else do ;"There has not been any parameter found. +"RTN","TMGXDLG",2028,0) + . if $data(N) quit ;"If user was looking for (absent) subscripted param, then ignore NotOptional +"RTN","TMGXDLG",2029,0) + . if (optional=xcNotOptional) do +"RTN","TMGXDLG",2030,0) + . . if AddQuote set s=s_"""" +"RTN","TMGXDLG",2031,0) + . . set s=s_"0" ;"put in a 0 for non-optional values. +"RTN","TMGXDLG",2032,0) + . . set result=1 +"RTN","TMGXDLG",2033,0) + +"RTN","TMGXDLG",2034,0) + if result=1 do +"RTN","TMGXDLG",2035,0) + . if (AddQuote=xcAddQuote) set s=s_""" " +"RTN","TMGXDLG",2036,0) + . else set s=s_" " +"RTN","TMGXDLG",2037,0) + +"RTN","TMGXDLG",2038,0) + do ParamTextAdd(.Options,s) +"RTN","TMGXDLG",2039,0) + +"RTN","TMGXDLG",2040,0) + +"RTN","TMGXDLG",2041,0) + quit result +"RTN","TMGXDLG",2042,0) + +"RTN","TMGXDLG",2043,0) +ParamTextAdd(Options,Text) +"RTN","TMGXDLG",2044,0) + ;"Purpose: to actually add the text of the new parameter etc +"RTN","TMGXDLG",2045,0) + ;" into the Options variable +"RTN","TMGXDLG",2046,0) + ;"Input: Options .. same as variable used everywhere else +"RTN","TMGXDLG",2047,0) + ;" MUST BE PASSED BY REFERENCE +"RTN","TMGXDLG",2048,0) + ;" Text -- the text to add +"RTN","TMGXDLG",2049,0) + +"RTN","TMGXDLG",2050,0) + new sCurrent +"RTN","TMGXDLG",2051,0) + new CurLine +"RTN","TMGXDLG",2052,0) + +"RTN","TMGXDLG",2053,0) + ;"First the simple way -- with max of ~230 characters +"RTN","TMGXDLG",2054,0) + set Options(xcCmdLine)=$get(Options(xcCmdLine))_Text +"RTN","TMGXDLG",2055,0) + +"RTN","TMGXDLG",2056,0) + ;"Next, array method, with unlimited length. +"RTN","TMGXDLG",2057,0) + set CurLine=$get(Options(xcCmdLine,xcCmdArray,xcCmdMaxLine),0) +"RTN","TMGXDLG",2058,0) + set sCurrent=$get(Options(xcCmdLine,xcCmdArray,CurLine)) +"RTN","TMGXDLG",2059,0) + if $length(sCurrent)>80 do +"RTN","TMGXDLG",2060,0) + . set CurLine=CurLine+1 +"RTN","TMGXDLG",2061,0) + . set sCurrent="" +"RTN","TMGXDLG",2062,0) + +"RTN","TMGXDLG",2063,0) + set sCurrent=sCurrent_Text +"RTN","TMGXDLG",2064,0) + ;"write "After additions, sCurrent=",sCurrent,! +"RTN","TMGXDLG",2065,0) + set Options(xcCmdLine,xcCmdArray,CurLine)=sCurrent +"RTN","TMGXDLG",2066,0) + set Options(xcCmdLine,xcCmdArray,xcCmdMaxLine)=CurLine +"RTN","TMGXDLG",2067,0) + quit +"RTN","TMGXDLG",2068,0) + +"RTN","TMGXDLG",2069,0) + +"RTN","TMGXDLG",2070,0) +LaunchCmd(Options,Results,Modal) +"RTN","TMGXDLG",2071,0) + ;"Purpose: To actually launch the dialog, and to retrieve results +"RTN","TMGXDLG",2072,0) + ;"Input: Options -- see Docs above. The only part of the Options array +"RTN","TMGXDLG",2073,0) + ;" that is used here is Options(xcCmdLine) +"RTN","TMGXDLG",2074,0) + ;" Results -- an array to pass results back in. +"RTN","TMGXDLG",2075,0) + ;" Modal -- if =xcModalMode, then execution does not continue until dialog is closed +"RTN","TMGXDLG",2076,0) + ;" if xcNonModal, then execution immediately continues. Note in this +"RTN","TMGXDLG",2077,0) + ;" case the result of the execution will be 0 (unless an error +"RTN","TMGXDLG",2078,0) + ;" occurs creating the dialog.) It will NOT be the result of +"RTN","TMGXDLG",2079,0) + ;" the user's button press. +"RTN","TMGXDLG",2080,0) + +"RTN","TMGXDLG",2081,0) + new Cmd,HookCmd +"RTN","TMGXDLG",2082,0) + new FileHandle +"RTN","TMGXDLG",2083,0) + new CommFPath set CommFPath="/tmp/" +"RTN","TMGXDLG",2084,0) + new CommFName set CommFName="M_xdialog_comm_"_$J_".tmp" +"RTN","TMGXDLG",2085,0) + new CommFile set CommFile=CommFPath_CommFName +"RTN","TMGXDLG",2086,0) + +"RTN","TMGXDLG",2087,0) + ;"set Cmd=vDialog_" "_$get(Options(xcCmdLine)) +"RTN","TMGXDLG",2088,0) + ;"set Cmd=Cmd_" 2>"_CommFile +"RTN","TMGXDLG",2089,0) + do ParamTextAdd(.Options," 2>"_CommFile) +"RTN","TMGXDLG",2090,0) + +"RTN","TMGXDLG",2091,0) + set Modal=$get(Modal,xcNonModal) +"RTN","TMGXDLG",2092,0) + if (Modal=xcNonModal) do +"RTN","TMGXDLG",2093,0) + . do ParamTextAdd(.Options," & ") +"RTN","TMGXDLG",2094,0) + +"RTN","TMGXDLG",2095,0) + new result,killme +"RTN","TMGXDLG",2096,0) + new FRef +"RTN","TMGXDLG",2097,0) + ;"write "--------------------------------------------------",! +"RTN","TMGXDLG",2098,0) + ;"zwr Options(xcCmdLine,xcCmdArray,*) +"RTN","TMGXDLG",2099,0) + set FRef=$name(Options(xcCmdLine,xcCmdArray,0)) +"RTN","TMGXDLG",2100,0) + set result=$$GTF^%ZISH(FRef,3,CommFPath,CommFName) +"RTN","TMGXDLG",2101,0) + +"RTN","TMGXDLG",2102,0) + ;"set HookCmd="cat "_CommFile +"RTN","TMGXDLG",2103,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2104,0) + ;"zsystem HookCmd +"RTN","TMGXDLG",2105,0) + +"RTN","TMGXDLG",2106,0) + ;"Explaination of following line: +"RTN","TMGXDLG",2107,0) + ;"I can't always pass the command in one string, because of limitation of string length +"RTN","TMGXDLG",2108,0) + ;"So I am writing out the command as a text file (to CommFile)--which will have the long +"RTN","TMGXDLG",2109,0) + ;"string divided up into multiple lines. However, the bash command shell +"RTN","TMGXDLG",2110,0) + ;"can't deal with the command split up like this. +"RTN","TMGXDLG",2111,0) + ;"I have researched to find this method of stripping newlines from the end of +"RTN","TMGXDLG",2112,0) + ;"a line--there are probably 8 other ways to do this too. :-) +"RTN","TMGXDLG",2113,0) + ;" echo `<file` >file +"RTN","TMGXDLG",2114,0) + ;"I then execute the file by typing: +"RTN","TMGXDLG",2115,0) + ;" sh file +"RTN","TMGXDLG",2116,0) + ;"And the two commands are separated on the line by a ";" +"RTN","TMGXDLG",2117,0) + ;"So the composite is: +"RTN","TMGXDLG",2118,0) + ;" echo `<file` >file ; sh file +"RTN","TMGXDLG",2119,0) + ;"Note that the instructions contained in 'file' include an instruction to put +"RTN","TMGXDLG",2120,0) + ;" the output from the dialog back into 'file'. This is ok, because it won't +"RTN","TMGXDLG",2121,0) + ;" be overwriten until after the command has started to execute. +"RTN","TMGXDLG",2122,0) + +"RTN","TMGXDLG",2123,0) + ;"set HookCmd="echo `<"_CommFile_"` >"_CommFile_" ; sh "_CommFile +"RTN","TMGXDLG",2124,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2125,0) + ;"zsystem HookCmd +"RTN","TMGXDLG",2126,0) + +"RTN","TMGXDLG",2127,0) + set HookCmd="echo `<"_CommFile_"` >"_CommFile +"RTN","TMGXDLG",2128,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2129,0) + zsystem HookCmd +"RTN","TMGXDLG",2130,0) + +"RTN","TMGXDLG",2131,0) + ;"set HookCmd="cat "_CommFile +"RTN","TMGXDLG",2132,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2133,0) + ;"zsystem HookCmd +"RTN","TMGXDLG",2134,0) + +"RTN","TMGXDLG",2135,0) + set HookCmd="sh "_CommFile +"RTN","TMGXDLG",2136,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2137,0) + zsystem HookCmd +"RTN","TMGXDLG",2138,0) + +"RTN","TMGXDLG",2139,0) + +"RTN","TMGXDLG",2140,0) + set Results(xcDlgResult)=$ZSYSTEM&255 ;"get result of execution. (low byte only) +"RTN","TMGXDLG",2141,0) + +"RTN","TMGXDLG",2142,0) + ;"Read output info Results +"RTN","TMGXDLG",2143,0) + ;"set HookCmd="cat "_CommFile +"RTN","TMGXDLG",2144,0) + ;"write "Here is hook command",!,!,HookCmd,!,! +"RTN","TMGXDLG",2145,0) + ;"zsystem HookCmd +"RTN","TMGXDLG",2146,0) + set FileHandle=$$FTG^%ZISH(CommFPath,CommFName,$name(Results(xcDlgOutput)),3) +"RTN","TMGXDLG",2147,0) + ;"zwr Results(*) +"RTN","TMGXDLG",2148,0) + +"RTN","TMGXDLG",2149,0) + ;"Now kill the communication file... no longer needed. +"RTN","TMGXDLG",2150,0) + new FileSpec +"RTN","TMGXDLG",2151,0) + set FileSpec(CommFile)="" +"RTN","TMGXDLG",2152,0) + set result=$$DEL^%ZISH(CommFPath,$name(FileSpec)) +"RTN","TMGXDLG",2153,0) + +"RTN","TMGXDLG",2154,0) + quit +"RTN","TMGXDLG",2155,0) + +"RTN","TMGXDLG",2156,0) + +"RTN","TMGXDLG",2157,0) + +"RTN","TMGXDLG",2158,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",2159,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",2160,0) + +"RTN","TMGXDLG",2161,0) +Demo +"RTN","TMGXDLG",2162,0) + ;"Purpose: To show the functionality of the library, and +"RTN","TMGXDLG",2163,0) + ;" to give a programming demo. +"RTN","TMGXDLG",2164,0) + +"RTN","TMGXDLG",2165,0) + +"RTN","TMGXDLG",2166,0) + new result +"RTN","TMGXDLG",2167,0) + new Feedback +"RTN","TMGXDLG",2168,0) + new s +"RTN","TMGXDLG",2169,0) + new UserPick,filename +"RTN","TMGXDLG",2170,0) + new UseGUI +"RTN","TMGXDLG",2171,0) + +"RTN","TMGXDLG",2172,0) + set UseGUI=0 +"RTN","TMGXDLG",2173,0) + +"RTN","TMGXDLG",2174,0) + do SetupConsts() +"RTN","TMGXDLG",2175,0) + +"RTN","TMGXDLG",2176,0) + do SetGUI(UseGUI) +"RTN","TMGXDLG",2177,0) + +"RTN","TMGXDLG",2178,0) + new List +"RTN","TMGXDLG",2179,0) + set List(1,xcTag)="Graphic" +"RTN","TMGXDLG",2180,0) + set List(1,xcItem)="Select this for full X-system GUI" +"RTN","TMGXDLG",2181,0) + set List(1,xcStatus)="on" +"RTN","TMGXDLG",2182,0) + set List(2,xcTag)="Text" +"RTN","TMGXDLG",2183,0) + set List(2,xcItem)="Select this for character interface" +"RTN","TMGXDLG",2184,0) + set List(2,xcStatus)="off" +"RTN","TMGXDLG",2185,0) + set UserPick=$$RadioList("Which type of boxes would you like to use?",.List) +"RTN","TMGXDLG",2186,0) + +"RTN","TMGXDLG",2187,0) + do ChClrScr^TMGXDLG() +"RTN","TMGXDLG",2188,0) + +"RTN","TMGXDLG",2189,0) + if UserPick="Graphic" do +"RTN","TMGXDLG",2190,0) + . set UseGUI=1 +"RTN","TMGXDLG",2191,0) + . do SetGUI(UseGUI) +"RTN","TMGXDLG",2192,0) + +"RTN","TMGXDLG",2193,0) + if UseGUI=0 goto l1 +"RTN","TMGXDLG",2194,0) + +"RTN","TMGXDLG",2195,0) + set s="Welcome to the Xdialog Demo \nThis box is 'non-modal' " +"RTN","TMGXDLG",2196,0) + set s=s_"so its program can continue without" +"RTN","TMGXDLG",2197,0) + set s=s_"waiting for a user response." +"RTN","TMGXDLG",2198,0) + set result=$$Msg("Welcome",s,0,0,xcNonModal,1,2) ;"height&width of 0,0 means "auto size" +"RTN","TMGXDLG",2199,0) + +"RTN","TMGXDLG",2200,0) +l1 +"RTN","TMGXDLG",2201,0) + set result=$$YesNo^TMGXDLG("Do you want to see a demo \n of this Xdialog wrapper library?") +"RTN","TMGXDLG",2202,0) + if result'=mrYes goto DemoDone +"RTN","TMGXDLG",2203,0) + +"RTN","TMGXDLG",2204,0) + ;"Note: This don't seem to work in character mode... +"RTN","TMGXDLG",2205,0) + set s="OK, Check out this 'Info' box. It will auto close in 6 seconds" +"RTN","TMGXDLG",2206,0) + set result=$$Info(s,0,0,6,xcModalMode) +"RTN","TMGXDLG",2207,0) + +"RTN","TMGXDLG",2208,0) + new List +"RTN","TMGXDLG",2209,0) + set List(1,xcTag)="Edit box" +"RTN","TMGXDLG",2210,0) + set List(1,xcItem)="Select this for an Edit Box" +"RTN","TMGXDLG",2211,0) + set List(1,xcStatus)="on" +"RTN","TMGXDLG",2212,0) + set List(2,xcTag)="Log box" +"RTN","TMGXDLG",2213,0) + set List(2,xcItem)="Select this for a Log Box" +"RTN","TMGXDLG",2214,0) + set List(2,xcStatus)="off" +"RTN","TMGXDLG",2215,0) + set List(3,xcTag)="Text box" +"RTN","TMGXDLG",2216,0) + set List(3,xcItem)="Select this for a Text Box" +"RTN","TMGXDLG",2217,0) + set List(3,xcStatus)="off" +"RTN","TMGXDLG",2218,0) + set List(4,xcTag)="Tail box" +"RTN","TMGXDLG",2219,0) + set List(4,xcItem)="Select this for a Tail Box" +"RTN","TMGXDLG",2220,0) + set List(4,xcStatus)="off" +"RTN","TMGXDLG",2221,0) + set UserPick=$$RadioList("Select Tool to See",.List) +"RTN","TMGXDLG",2222,0) + +"RTN","TMGXDLG",2223,0) + write "You selected: ",UserPick,! +"RTN","TMGXDLG",2224,0) + +"RTN","TMGXDLG",2225,0) + ;"Note: This don't seem to work in character mode... +"RTN","TMGXDLG",2226,0) + if UserPick'="" do +"RTN","TMGXDLG",2227,0) + . set filename=$$FileSel("Select a file to load") +"RTN","TMGXDLG",2228,0) + . if UserPick="Edit box" do quit +"RTN","TMGXDLG",2229,0) + . . set result=$$Edit(filename,0,0,.Feedback) +"RTN","TMGXDLG",2230,0) + . if UserPick="Log box" do quit +"RTN","TMGXDLG",2231,0) + . . set result=$$Log(filename,0,0,xcModalMode) +"RTN","TMGXDLG",2232,0) + . if UserPick="Text box" do quit +"RTN","TMGXDLG",2233,0) + . . set result=$$Text(filename,0,0,xcModalMode) +"RTN","TMGXDLG",2234,0) + . if UserPick="Tail box" do quit +"RTN","TMGXDLG",2235,0) + . . set result=$$Tail(filename,0,0,xcModalMode) +"RTN","TMGXDLG",2236,0) + +"RTN","TMGXDLG",2237,0) + new FName,LName,Zip +"RTN","TMGXDLG",2238,0) + new DumpVar +"RTN","TMGXDLG",2239,0) + +"RTN","TMGXDLG",2240,0) + set result=$$Input("Enter Name",0,0,"John",.FName) +"RTN","TMGXDLG",2241,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2242,0) + write "Here is name:",FName,! +"RTN","TMGXDLG",2243,0) + ;"read "Press any key to coninue",*DumpVar,! +"RTN","TMGXDLG",2244,0) + +"RTN","TMGXDLG",2245,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2246,0) + set result=$$Input2("Enter Name",0,0,"First","John","Last","Smith",.FName,.LName) +"RTN","TMGXDLG",2247,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2248,0) + write "Here is name:",FName," ",LName,! +"RTN","TMGXDLG",2249,0) + ;"read "Press any key to coninue",*DumpVar,! +"RTN","TMGXDLG",2250,0) + +"RTN","TMGXDLG",2251,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2252,0) + set result=$$Input3("Enter Name",0,0,"First","John","Last","Smith","Zip","12345",.FName,.LName,.Zip) +"RTN","TMGXDLG",2253,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2254,0) + write "Here is name:",FName," ",LName,! +"RTN","TMGXDLG",2255,0) + write "zip: ",Zip,! +"RTN","TMGXDLG",2256,0) + +"RTN","TMGXDLG",2257,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2258,0) + kill List +"RTN","TMGXDLG",2259,0) + set List(1)="Cookies" +"RTN","TMGXDLG",2260,0) + set List(2)="Ice Cream" +"RTN","TMGXDLG",2261,0) + set List(3)="Cake" +"RTN","TMGXDLG",2262,0) + set result=$$Combo("Pick your favorite dessert:",0,0,.List) +"RTN","TMGXDLG",2263,0) + write "You picked: ",result,! +"RTN","TMGXDLG",2264,0) + +"RTN","TMGXDLG",2265,0) + new Result1,Result2,Result3 +"RTN","TMGXDLG",2266,0) + +"RTN","TMGXDLG",2267,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2268,0) + set result=$$Range("Enter some numbers",0,0,25,250,100,.Result1) +"RTN","TMGXDLG",2269,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2270,0) + write "$=",Result1,! +"RTN","TMGXDLG",2271,0) + +"RTN","TMGXDLG",2272,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2273,0) + set result=$$Range2("Enter some numbers",0,0,"$",25,250,100,"%",33,66,44,.Result1,.Result2) +"RTN","TMGXDLG",2274,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2275,0) + write "$=",Result1," and %=",Result2,! +"RTN","TMGXDLG",2276,0) + +"RTN","TMGXDLG",2277,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2278,0) + set result=$$Range3("Enter some numbers",0,0,"$",25,250,100,"%",33,66,44,"#",1000,2000,1500,.Result1,.Result2,.Result3) +"RTN","TMGXDLG",2279,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2280,0) + write "$=",Result1," and %=",Result2," and #=",Result3,! +"RTN","TMGXDLG",2281,0) + +"RTN","TMGXDLG",2282,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2283,0) + set result=$$Spin("Enter a number",0,0,"$",25,250,100,.Result1) +"RTN","TMGXDLG",2284,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2285,0) + write "$=",Result1,! +"RTN","TMGXDLG",2286,0) + +"RTN","TMGXDLG",2287,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2288,0) + set result=$$Spin2("Enter some numbers",0,0,"$",25,250,100,"%",33,66,44,.Result1,.Result2) +"RTN","TMGXDLG",2289,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2290,0) + write "$=",Result1," and %=",Result2,! +"RTN","TMGXDLG",2291,0) + +"RTN","TMGXDLG",2292,0) + ;"Note: This not supported in character mode... +"RTN","TMGXDLG",2293,0) + set result=$$Spin3("Enter some numbers",0,0,"$",25,250,100,"%",33,66,44,"#",1000,2000,1500,.Result1,.Result2,.Result3) +"RTN","TMGXDLG",2294,0) + if result=mrCancel goto GBye +"RTN","TMGXDLG",2295,0) + write "$=",Result1," and %=",Result2," and #=",Result3,! +"RTN","TMGXDLG",2296,0) + +"RTN","TMGXDLG",2297,0) +GBye +"RTN","TMGXDLG",2298,0) + set result=$$Msg("Goodbye","That''s all for now folks!",0,0,xcModalMode) +"RTN","TMGXDLG",2299,0) + +"RTN","TMGXDLG",2300,0) + if UseGUI=0 do ChClrScr^TMGXDLG() +"RTN","TMGXDLG",2301,0) + +"RTN","TMGXDLG",2302,0) +DemoDone +"RTN","TMGXDLG",2303,0) + quit +"RTN","TMGXDLG",2304,0) + +"RTN","TMGXDLG",2305,0) + +"RTN","TMGXDLG",2306,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXDLG",2307,0) + ;"Progress Notes: +"RTN","TMGXDLG",2308,0) + ;"9-26-04 On my server, Xdialog was missing. I had to simply copy the +"RTN","TMGXDLG",2309,0) + ;" Xdialog file into /usr/bin ... I ought to have some way to +"RTN","TMGXDLG",2310,0) + ;" check for existance of file and give message if it is absent. +"RTN","TMGXDLG",2311,0) + ;"=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +"RTN","TMGXGF") +0^98^B43054173 +"RTN","TMGXGF",1,0) +TMGXGF ;SFISC/VYD - Graphics Functions ;11/06/2002 11:10 +"RTN","TMGXGF",2,0) + ;;8.0;KERNEL;**269**;5/5/07 by kt +"RTN","TMGXGF",3,0) + ; +"RTN","TMGXGF",4,0) +PREP ;prepair graphics environment +"RTN","TMGXGF",5,0) + D PREP^XGSETUP +"RTN","TMGXGF",6,0) + D CLRCLIP ;"//kt 5/5/07 added +"RTN","TMGXGF",7,0) + Q +"RTN","TMGXGF",8,0) + ; +"RTN","TMGXGF",9,0) + ; +"RTN","TMGXGF",10,0) +IOXY(R,C) ;cursor positioning R:row, C:col +"RTN","TMGXGF",11,0) + D ADJRC +"RTN","TMGXGF",12,0) + ;"//kt 5/6/07 modification. +"RTN","TMGXGF",13,0) + ;"Although this XGF system allows for off-screen coordinates, the underlying +"RTN","TMGXGF",14,0) + ;" M systems will not. So trying to position cursor to (-4,-5) MUST result +"RTN","TMGXGF",15,0) + ;" in cursor being put at (0,0). This may be worked around by not depending +"RTN","TMGXGF",16,0) + ;" on the current $X,$Y for writing etc. Instead, always specify coordinates. +"RTN","TMGXGF",17,0) + S:R<0 R=0 ;"//kt +"RTN","TMGXGF",18,0) + S:C<0 C=0 ;"//kt +"RTN","TMGXGF",19,0) + d CLIOXY^TMGXGS(R,C,"") +"RTN","TMGXGF",20,0) + S $Y=R,$X=C +"RTN","TMGXGF",21,0) + Q +"RTN","TMGXGF",22,0) + ; +"RTN","TMGXGF",23,0) + ; +"RTN","TMGXGF",24,0) +SAY(R,C,S,A) ;coordinate output instead of WRITE +"RTN","TMGXGF",25,0) + D ADJRC +"RTN","TMGXGF",26,0) + ;"//kt 5/6/07 mod. Clipping to occur in CLIOXY^TMGXGS() +"RTN","TMGXGF",27,0) + ;"S:C+$L(S)>IOM S=$E(S,1,IOM-C) ;truncate if longer than screen +"RTN","TMGXGF",28,0) + I $L($G(A)) S A=$$UP^XLFSTR(A) D SAY^TMGXGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1 +"RTN","TMGXGF",29,0) + E D SAY^TMGXGS(R,C,S) +"RTN","TMGXGF",30,0) + Q +"RTN","TMGXGF",31,0) + ; +"RTN","TMGXGF",32,0) + ; +"RTN","TMGXGF",33,0) +VSAY(R,C,S,A) ;coordinate output instead of WRITE: Vertical write ;"//kt added 5/10/07 +"RTN","TMGXGF",34,0) + D ADJRC +"RTN","TMGXGF",35,0) + I $L($G(A)) S A=$$UP^XLFSTR(A) D VSAY^TMGXGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1 +"RTN","TMGXGF",36,0) + E D VSAY^TMGXGS(R,C,S) +"RTN","TMGXGF",37,0) + Q +"RTN","TMGXGF",38,0) + ; +"RTN","TMGXGF",39,0) + ; +"RTN","TMGXGF",40,0) +SAYU(R,C,S,A) ;coordinate output w/ underline instead of WRITE +"RTN","TMGXGF",41,0) + D ADJRC +"RTN","TMGXGF",42,0) + I $L($G(A)) S A=$$UP^XLFSTR(A) D SAYU^TMGXGS(R,C,S,$S($$ATRSYNTX(A):A,1:"")) I 1 +"RTN","TMGXGF",43,0) + E D SAYU^TMGXGS(R,C,S) +"RTN","TMGXGF",44,0) + Q +"RTN","TMGXGF",45,0) + ; +"RTN","TMGXGF",46,0) + ; +"RTN","TMGXGF",47,0) +ADJRC ;adjust row and column R and C are assumed to exist +"RTN","TMGXGF",48,0) + S R=$S($G(R)="":$Y,1:R),C=$S($G(C)="":$X,1:C) ;use current coords if none are passed +"RTN","TMGXGF",49,0) + ;"//kt 5/6/07 modified. NOTE: it seems that code was written to allow coords +"RTN","TMGXGF",50,0) + ;" to be specified as relative to $X,$Y. E.g. SAY(+4,-2,'HELLO'). +"RTN","TMGXGF",51,0) + ;" I must remove this functionality so that I can allow specifying coordinates that +"RTN","TMGXGF",52,0) + ;" are offscreen. Thus if the left-hand part of a window is a bit off the left +"RTN","TMGXGF",53,0) + ;" side of the screen, then C will be -2 etc. +"RTN","TMGXGF",54,0) + ;"S:"+-"[$E(R) R=$Y+$S(R="+":1,R="-":-1,1:R) ;increment/decrement +"RTN","TMGXGF",55,0) + ;"S:"+-"[$E(C) C=$X+$S(C="+":1,C="-":-1,1:C) +"RTN","TMGXGF",56,0) + ;"S R=$S(R<0:0,1:R\1),C=$S(C<0:0,1:C\1) ;make sure only pos int +"RTN","TMGXGF",57,0) + ;"//kt modified line below +"RTN","TMGXGF",58,0) + S R=R\1,C=C\1 ;"make sure only integer values (clipping will occur in CLIOXY()) +"RTN","TMGXGF",59,0) + Q +"RTN","TMGXGF",60,0) + ; +"RTN","TMGXGF",61,0) + ; +"RTN","TMGXGF",62,0) +SETA(XGATR) ;set screen attribute(s) regardless of previous state +"RTN","TMGXGF",63,0) + ;XGATR=1 char when converted to binary represents all new attr +"RTN","TMGXGF",64,0) + N XGOLDX,XGOLDY +"RTN","TMGXGF",65,0) + S XGOLDX=$X,XGOLDY=$Y ;save $X $Y +"RTN","TMGXGF",66,0) + W $$SET^XGSA(XGATR) +"RTN","TMGXGF",67,0) + S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y +"RTN","TMGXGF",68,0) + Q +"RTN","TMGXGF",69,0) + ; +"RTN","TMGXGF",70,0) + ; +"RTN","TMGXGF",71,0) +CHGA(XGATR) ;change screen attribute(s) w/ respect to previous state +"RTN","TMGXGF",72,0) + ;XGNEWATR=string of attr to change eg. "B0U1" or "E1" +"RTN","TMGXGF",73,0) + N XGOLDX,XGOLDY,XGSYNTX,XGACODE,% +"RTN","TMGXGF",74,0) + S XGATR=$$UP^XLFSTR(XGATR) ;make sure all attr codes are in upper case +"RTN","TMGXGF",75,0) + D:$$ATRSYNTX(XGATR) +"RTN","TMGXGF",76,0) + . S XGOLDX=$X,XGOLDY=$Y ;save $X $Y +"RTN","TMGXGF",77,0) + . W $$CHG^XGSA(XGATR) +"RTN","TMGXGF",78,0) + . S $X=XGOLDX,$Y=XGOLDY ;restore $X $Y +"RTN","TMGXGF",79,0) + Q +"RTN","TMGXGF",80,0) + ; +"RTN","TMGXGF",81,0) + ; +"RTN","TMGXGF",82,0) +ATRSYNTX(XGATR) ;check attribute code syntax +"RTN","TMGXGF",83,0) + ;proper attr is 1 or more (char from {BIRGUE} concat w/ 1 or 0) +"RTN","TMGXGF",84,0) + N XGSYNTX,% +"RTN","TMGXGF",85,0) + S XGSYNTX=$S($L(XGATR)&($L(XGATR)#2=0):1,1:0) ;even # of chars +"RTN","TMGXGF",86,0) + F %=1:2:$L(XGATR) S:"B1B0I1I0R1R0G1G0U1U0E1"'[$E(XGATR,%,%+1) XGSYNTX=0 +"RTN","TMGXGF",87,0) + Q XGSYNTX +"RTN","TMGXGF",88,0) + ; +"RTN","TMGXGF",89,0) + ; +"RTN","TMGXGF",90,0) +RESTORE(S) ;restore screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT +"RTN","TMGXGF",91,0) + D RESTORE^TMGXGSW(S) Q +"RTN","TMGXGF",92,0) + K @S +"RTN","TMGXGF",93,0) + ; +"RTN","TMGXGF",94,0) + ; +"RTN","TMGXGF",95,0) +SAVE(T,L,B,R,S) ;save screen region TOP,LEFT,BOTTOM,RIGHT,SAVE ROOT +"RTN","TMGXGF",96,0) + D SAVE^TMGXGSW(T,L,B,R,S) Q +"RTN","TMGXGF",97,0) + ; +"RTN","TMGXGF",98,0) + ; +"RTN","TMGXGF",99,0) +WIN(T,L,B,R,S) ;put up a window TOP,LEFT,BOTTOM,RIGHT[,SAVE ROOT] +"RTN","TMGXGF",100,0) + ;window style is not yet implemented +"RTN","TMGXGF",101,0) + I $L($G(S)) D WIN^TMGXGSW(T,L,B,R,S) I 1 +"RTN","TMGXGF",102,0) + E D WIN^TMGXGSW(T,L,B,R) +"RTN","TMGXGF",103,0) + Q +"RTN","TMGXGF",104,0) + ; +"RTN","TMGXGF",105,0) + ; +"RTN","TMGXGF",106,0) +FRAME(T,L,B,R) ;put a frame without clearing the inside TOP,LEFT,BOTTOM,RIGHT +"RTN","TMGXGF",107,0) + D FRAME^TMGXSBOX(T,L,B,R) Q +"RTN","TMGXGF",108,0) + ; +"RTN","TMGXGF",109,0) + ; +"RTN","TMGXGF",110,0) +CLEAR(T,L,B,R) ;clear screen portion TOP,LEFT,BOTTOM,RIGHT +"RTN","TMGXGF",111,0) + D CLEAR^TMGXSBOX(T,L,B,R) Q +"RTN","TMGXGF",112,0) + ; +"RTN","TMGXGF",113,0) + ; +"RTN","TMGXGF",114,0) +CLEAN ;clean up and destroy graphics environment +"RTN","TMGXGF",115,0) + D CLEAN^XGSETUP Q +"RTN","TMGXGF",116,0) + ; +"RTN","TMGXGF",117,0) + ; +"RTN","TMGXGF",118,0) +INITKB(XGTRM) ;initialize keyboard +"RTN","TMGXGF",119,0) + ;turn escape processing on, turn on passed terminators (if any) +"RTN","TMGXGF",120,0) + D INIT^XGKB($G(XGTRM)) Q +"RTN","TMGXGF",121,0) + ; +"RTN","TMGXGF",122,0) + ; +"RTN","TMGXGF",123,0) +READ(XGCHARS,XGTO) ;read the keyboard +"RTN","TMGXGF",124,0) + ;XGCHARS:number of chars to read, XGTO:timeout +"RTN","TMGXGF",125,0) + ;"//kt 5/5/07 modified to allow putting characters back. +"RTN","TMGXGF",126,0) + new TMGRESLT set TMGRESLT="" +"RTN","TMGXGF",127,0) + if ($get(TMGWCBUF)="")&($get(TMGWXGRT)="") do +"RTN","TMGXGF",128,0) + . set TMGRESLT=$$READ^XGKB($G(XGCHARS),$G(XGTO)) +"RTN","TMGXGF",129,0) + else do +"RTN","TMGXGF",130,0) + . set TMGRESLT=$get(TMGWCBUF) set TMGWCBUF="" +"RTN","TMGXGF",131,0) + . set XGRT=$get(TMGWXGRT) set TMGWXGRT="" +"RTN","TMGXGF",132,0) + quit TMGRESLT +"RTN","TMGXGF",133,0) + ; +"RTN","TMGXGF",134,0) + ; +"RTN","TMGXGF",135,0) +UNREAD(XGCHARS,XGRT) ;"//kt 5/5/07 added. +"RTN","TMGXGF",136,0) + ;Purpose: to put characters back into read stream after a READ +"RTN","TMGXGF",137,0) + ; Note: may only be called once before a subsequent READ, or will overwrite +"RTN","TMGXGF",138,0) + ;Input: XGCHARS -- the character(s) to put back into stream +"RTN","TMGXGF",139,0) + ; XGRT -- the command characters to put back into stream (i.e. XGRT) +"RTN","TMGXGF",140,0) + set TMGWCBUF=XGCHARS +"RTN","TMGXGF",141,0) + set TMGWXGRT=XGRT +"RTN","TMGXGF",142,0) + quit +"RTN","TMGXGF",143,0) + ; +"RTN","TMGXGF",144,0) + ; +"RTN","TMGXGF",145,0) +RESETKB ;reset keyboard(escape processing off, terminators off) +"RTN","TMGXGF",146,0) + D EXIT^XGKB Q +"RTN","TMGXGF",147,0) + ; +"RTN","TMGXGF",148,0) + ; +"RTN","TMGXGF",149,0) +SETCLIP(T,L,B,R) ;"//kt 5/5/07 added +"RTN","TMGXGF",150,0) + ;Pupose: define a clipping area. XGF writes clipped to area +"RTN","TMGXGF",151,0) + ;Input: TOP,LEFT,BOTTOM,ROGHT +"RTN","TMGXGF",152,0) + set TMGCLT=+$get(T),TMGCLL=$get(L) +"RTN","TMGXGF",153,0) + set TMGCLB=+$get(B),TMGCLR=$get(R) +"RTN","TMGXGF",154,0) + quit +"RTN","TMGXGF",155,0) + ; +"RTN","TMGXGF",156,0) + ; +"RTN","TMGXGF",157,0) +CLRCLIP ;"//kt 5/5/07 added +"RTN","TMGXGF",158,0) + ;Pupose: clear clipping area. +"RTN","TMGXGF",159,0) + set TMGCLT=0,TMGCLL=0 +"RTN","TMGXGF",160,0) + set TMGCLB=IOSL-1,TMGCLR=IOM-1 +"RTN","TMGXGF",161,0) + quit +"RTN","TMGXGS") +0^99^B32818030 +"RTN","TMGXGS",1,0) +TMGXGS ;SFISC/VYD - SCREEN PRIMITIVES ;03/16/95 11:00 +"RTN","TMGXGS",2,0) + ;;8.0;KERNEL;;5/7/07 by //kt +"RTN","TMGXGS",3,0) +SAY(R,C,S,A) ;use this for coordinate output instead of WRITE +"RTN","TMGXGS",4,0) + ;output to screen and update virtual screen (XGSCRN) +"RTN","TMGXGS",5,0) + ;params: Row (0-IOSL),Col (0-IOM),string, +"RTN","TMGXGS",6,0) + ;scrn attrib ie. I1R0B1 (optional) +"RTN","TMGXGS",7,0) + N XGSAVATR,XGESC,XGOUTPUT ;save attribute,escape str,output stream +"RTN","TMGXGS",8,0) + N % +"RTN","TMGXGS",9,0) + ;set output stream to either XGSCRN (virtual screen) or some window +"RTN","TMGXGS",10,0) + S XGOUTPUT=$S($G(XGFLAG("PAINT"),21)=21:"XGSCRN",1:$NA(^TMP("XGS",$J,XGW1))) +"RTN","TMGXGS",11,0) + S XGSAVATR=XGCURATR ;preserve current attribute to restore later +"RTN","TMGXGS",12,0) + S $X=C+$L(S) +"RTN","TMGXGS",13,0) + S XGESC=$S($L($G(A)):$$CHG^XGSA(A),1:"") +"RTN","TMGXGS",14,0) + S $E(@XGOUTPUT@(R,0),(C+1),$X)=S +"RTN","TMGXGS",15,0) + S $E(@XGOUTPUT@(R,1),(C+1),$X)=$TR($J("",$L(S))," ",XGCURATR) +"RTN","TMGXGS",16,0) + ;S $P(%,XGCURATR,$L(S)+1)="",$E(@XGOUTPUT@(R,1),(C+1),$X)=% +"RTN","TMGXGS",17,0) + I XGOUTPUT="XGSCRN" D I 1 ;if screen painting is to occur +"RTN","TMGXGS",18,0) + . ;output string in a proper place in proper attribute and restore attr +"RTN","TMGXGS",19,0) + . ;;W $$IOXY(R,C)_XGESC_S_$S($L($G(A)):$$SET^XGSA(XGSAVATR),1:"") +"RTN","TMGXGS",20,0) + . ;W $$IOXY(R,C)_XGESC_S_$S(XGSAVATR'=XGCURATR:$$SET^XGSA(XGSAVATR),1:"") +"RTN","TMGXGS",21,0) + . DO CLIOXY(R,C,XGESC_S_$S(XGSAVATR'=XGCURATR:$$SET^XGSA(XGSAVATR),1:"")) +"RTN","TMGXGS",22,0) + . S $Y=R,$X=C+$L(S)-1 +"RTN","TMGXGS",23,0) + E S XGCURATR=XGSAVATR +"RTN","TMGXGS",24,0) + Q +"RTN","TMGXGS",25,0) + ; +"RTN","TMGXGS",26,0) + ; +"RTN","TMGXGS",27,0) +VSAY(R,C,S,A) ;"//kt added 5/10/07 +"RTN","TMGXGS",28,0) + ;use this for coordinate output instead of WRITE ("Vertical write") +"RTN","TMGXGS",29,0) + ;output to screen and update virtual screen (XGSCRN) +"RTN","TMGXGS",30,0) + ;params: Row (0-IOSL),Col (0-IOM),string, +"RTN","TMGXGS",31,0) + ;scrn attrib ie. I1R0B1 (optional) +"RTN","TMGXGS",32,0) + ;"Note: write is from top to bottom +"RTN","TMGXGS",33,0) + N XGSAVATR,XGESC,XGOUTPUT ;save attribute,escape str,output stream +"RTN","TMGXGS",34,0) + N % +"RTN","TMGXGS",35,0) + ;set output stream to either XGSCRN (virtual screen) or some window +"RTN","TMGXGS",36,0) + S XGOUTPUT=$S($G(XGFLAG("PAINT"),21)=21:"XGSCRN",1:$NA(^TMP("XGS",$J,XGW1))) +"RTN","TMGXGS",37,0) + S XGSAVATR=XGCURATR ;preserve current attribute to restore later +"RTN","TMGXGS",38,0) + new TMGi +"RTN","TMGXGS",39,0) + for TMGi=1:1:$L(S) do ;"write each character sequentially +"RTN","TMGXGS",40,0) + . new SS set SS=$E(S,TMGi) +"RTN","TMGXGS",41,0) + . S XGESC=$S($L($G(A)):$$CHG^XGSA(A),1:"") +"RTN","TMGXGS",42,0) + . S $X=C+1 +"RTN","TMGXGS",43,0) + . S $E(@XGOUTPUT@(R,0),(C+1),$X)=SS +"RTN","TMGXGS",44,0) + . S $E(@XGOUTPUT@(R,1),(C+1),$X)=$TR(" "," ",XGCURATR) ;"<-- '??' +"RTN","TMGXGS",45,0) + . I XGOUTPUT="XGSCRN" D I 1 ;if screen painting is to occur +"RTN","TMGXGS",46,0) + . . ;output string in a proper place in proper attribute and restore attr +"RTN","TMGXGS",47,0) + . . DO CLIOXY(R,C,XGESC_SS_$S(XGSAVATR'=XGCURATR:$$SET^XGSA(XGSAVATR),1:"")) +"RTN","TMGXGS",48,0) + . . if TMGi'=$L(S) S R=R+1 +"RTN","TMGXGS",49,0) + . . set $X=C,$Y=R +"RTN","TMGXGS",50,0) + . E S XGCURATR=XGSAVATR +"RTN","TMGXGS",51,0) + Q +"RTN","TMGXGS",52,0) + ; +"RTN","TMGXGS",53,0) + ; +"RTN","TMGXGS",54,0) +SAYU(R,C,S,A) ;use this for coordinate output instead of WRITE +"RTN","TMGXGS",55,0) + ;output to screen and update virtual screen (XGSCRN) +"RTN","TMGXGS",56,0) + ;params: Row (0-IOSL),Col (0-IOM),string, +"RTN","TMGXGS",57,0) + ;scrn attrib ie. I1R0B1 (optional) +"RTN","TMGXGS",58,0) + N XGSAVATR,XGESC,XGOUTPUT ;save attribute,escape str,output stream +"RTN","TMGXGS",59,0) + N %,%S,P,P1,P2,X ;P1:piece before &, P2:piece from & to the end +"RTN","TMGXGS",60,0) + N XGATR +"RTN","TMGXGS",61,0) + ;set output stream to either XGSCRN (virtual screen) or some window +"RTN","TMGXGS",62,0) + S XGOUTPUT=$S($G(XGFLAG("PAINT"),21)=21:"XGSCRN",1:$NA(^TMP("XGS",$J,XGW1))) +"RTN","TMGXGS",63,0) + S P=$L(S,"&&") +"RTN","TMGXGS",64,0) + F %=1:1:P S $P(X,$C(1),%)=$P(S,"&&",%) ;replace all && with $C(1) +"RTN","TMGXGS",65,0) + I X["&",$G(A)'["U1",'$$STAT^XGSA("U")!($G(A)["U0") D I 1 +"RTN","TMGXGS",66,0) + . S XGSAVATR=XGCURATR ;preserve current attribute to restore later +"RTN","TMGXGS",67,0) + . S XGESC=$S($L($G(A)):$$CHG^XGSA(A),1:"") +"RTN","TMGXGS",68,0) + . S XGATR=XGCURATR ;get pre-underline attributes +"RTN","TMGXGS",69,0) + . S $X=C+$L(X)-1 ;adjust for a single &, which is not printable +"RTN","TMGXGS",70,0) + . ;S $E(XGSCRN(R,0),(C+1),$X)=$TR($TR(X,"&",""),$C(1),"&") +"RTN","TMGXGS",71,0) + . S $E(@XGOUTPUT@(R,0),(C+1),$X)=$TR($P(X,"&")_$P(X,"&",2,999),$C(1),"&") +"RTN","TMGXGS",72,0) + . S $E(@XGOUTPUT@(R,1),(C+1),$X)=$TR($J("",$X-C)," ",XGCURATR) +"RTN","TMGXGS",73,0) + . S P1=$TR($P(X,"&"),$C(1),"&"),P2=$TR($P(X,"&",2,999),$C(1),"&") +"RTN","TMGXGS",74,0) + . S %S=P1_$$CHG^XGSA("U1")_$E(P2) ;preunderline_underlinechar +"RTN","TMGXGS",75,0) + . S $E(@XGOUTPUT@(R,1),(C+1+$L(P1)))=XGCURATR ;record underlinechar +"RTN","TMGXGS",76,0) + . ;S %S=%S_$$CHG^XGSA("U0")_$E(P2,2,999) ;%S_postunderline +"RTN","TMGXGS",77,0) + . S %S=%S_$$SET^XGSA(XGATR)_$E(P2,2,999) ;%S_postunderline +"RTN","TMGXGS",78,0) + . I XGOUTPUT="XGSCRN" D I 1 +"RTN","TMGXGS",79,0) + . . ;output string in a proper place in proper attribute and restore attr +"RTN","TMGXGS",80,0) + . . ;;W $$IOXY(R,C)_XGESC_%S_$S($L($G(A)):$$SET^XGSA(XGSAVATR),1:"") +"RTN","TMGXGS",81,0) + . . ;W $$IOXY(R,C)_XGESC_%S_$S(XGCURATR'=XGSAVATR:$$SET^XGSA(XGSAVATR),1:"") +"RTN","TMGXGS",82,0) + . . DO CLIOXY(R,C,XGESC_%S_$S(XGCURATR'=XGSAVATR:$$SET^XGSA(XGSAVATR),1:"")) +"RTN","TMGXGS",83,0) + . . S $Y=R,$X=C+$L(X)-2 +"RTN","TMGXGS",84,0) + . E S XGCURATR=XGSAVATR +"RTN","TMGXGS",85,0) + E D SAY(R,C,$TR(S,"&"),A):$D(A),SAY(R,C,$TR(S,"&")):'$D(A) +"RTN","TMGXGS",86,0) + Q +"RTN","TMGXGS",87,0) + ; +"RTN","TMGXGS",88,0) + ; +"RTN","TMGXGS",89,0) +IOXY(R,C) ;cursor positioning WRITE argument instead of execute +"RTN","TMGXGS",90,0) + ;Row,Col +"RTN","TMGXGS",91,0) + Q $C(27,91)_((R+1))_$C(59)_((C+1))_$C(72) +"RTN","TMGXGS",92,0) + ; +"RTN","TMGXGS",93,0) + ; +"RTN","TMGXGS",94,0) +CLIOXY(R,C,S) ;"5/5/07 //kt added +"RTN","TMGXGS",95,0) + ;Purpose: a unified function for writing to screen, that also handles clipping +"RTN","TMGXGS",96,0) + ;Input: R,C -- row and column +"RTN","TMGXGS",97,0) + ; S -- TEXT to put to screen. +"RTN","TMGXGS",98,0) + I (R<TMGCLT)!(R>TMGCLB) GOTO CLDONE +"RTN","TMGXGS",99,0) + I (C>TMGCLR) GOTO CLDONE +"RTN","TMGXGS",100,0) + I (C<TMGCLL) DO ;clip leftward +"RTN","TMGXGS",101,0) + . new ESC set ESC="" +"RTN","TMGXGS",102,0) + . if $EXTRACT(S,1)=$CHAR(27) do +"RTN","TMGXGS",103,0) +CL1 . . do CLIPESC(.S,.ESC) ;"remove leading escape sequences prior to clipping. +"RTN","TMGXGS",104,0) + . NEW TMGCLIP SET TMGCLIP=TMGCLL-C +"RTN","TMGXGS",105,0) + . SET S=ESC_$EXTRACT(S,1+TMGCLIP,9999) +"RTN","TMGXGS",106,0) + . SET C=TMGCLL +"RTN","TMGXGS",107,0) + +"RTN","TMGXGS",108,0) + WRITE $$IOXY(R,C) ;position to R,C +"RTN","TMGXGS",109,0) + NEW TMGSPL S TMGSPL=TMGCLR-C+1 ;find space left to clipping margin +"RTN","TMGXGS",110,0) + WRITE $EXTRACT(S,1,TMGSPL) +"RTN","TMGXGS",111,0) +CLDONE +"RTN","TMGXGS",112,0) + quit +"RTN","TMGXGS",113,0) + +"RTN","TMGXGS",114,0) +CLIPESC(S,ESC) ;"5/26/07 //kt added +"RTN","TMGXGS",115,0) + ;Purpose: to separate an escape sequence from the beginning of a string +"RTN","TMGXGS",116,0) + ;Input: S -- the string to work on +"RTN","TMGXGS",117,0) + ; ESC -- PASS BY REFERENCE, an OUT PARAMETER +"RTN","TMGXGS",118,0) + ; Note: prior entries in ESC will NOT be killed. Results will be appended +"RTN","TMGXGS",119,0) + ;Output: if S has one more leading escape sequences, these will be removed +"RTN","TMGXGS",120,0) + ;results: none +"RTN","TMGXGS",121,0) + ;Note: The rule that will be used to determine the end of the escape sequence +"RTN","TMGXGS",122,0) + ; will be when an uppercase letter is encountered, or another ESC(#27) is found +"RTN","TMGXGS",123,0) + +"RTN","TMGXGS",124,0) + if $extract(S,1)'=$char(27) goto CEDone +"RTN","TMGXGS",125,0) + set ESC=$get(ESC)_$char(27) +"RTN","TMGXGS",126,0) + new p set p=2 +"RTN","TMGXGS",127,0) + new done set done=0 +"RTN","TMGXGS",128,0) + for do quit:(done=1) +"RTN","TMGXGS",129,0) + . new ch,chNum set ch=$extract(S,p),chNum=$ascii(ch) +"RTN","TMGXGS",130,0) + . if chNum=27 set done=1 quit +"RTN","TMGXGS",131,0) + . if (chNum'<$ascii("A"))&(chNum'>$ascii("Z")) set done=1 quit +"RTN","TMGXGS",132,0) + . set ESC=ESC_ch +"RTN","TMGXGS",133,0) + . set p=p+1 +"RTN","TMGXGS",134,0) + set S=$extract(S,p,9999) +"RTN","TMGXGS",135,0) + do CLIPESC(.S,.ESC) ;"check for further escape sequences +"RTN","TMGXGS",136,0) +CEDone +"RTN","TMGXGS",137,0) + quit +"RTN","TMGXGSW") +0^100^B23984227 +"RTN","TMGXGSW",1,0) +TMGXGSW ;SFISC/VYD - screen window primitives ;01/11/95 15:58 +"RTN","TMGXGSW",2,0) + ;;8.0;KERNEL;;5/7/07 by //kt +"RTN","TMGXGSW",3,0) + ; +"RTN","TMGXGSW",4,0) +WIN(T,L,B,R,S) ;draw a bordered window +"RTN","TMGXGSW",5,0) + ;top,left,bottom,right,screen root +"RTN","TMGXGSW",6,0) + ;"//kt 5/5/07 removed next two lines. CLIOXY will do clipping. +"RTN","TMGXGSW",7,0) + ;"S:B'<IOSL B=IOSL-1,XGFLAG("TOO LONG")=1 ;adjust if longer than screen +"RTN","TMGXGSW",8,0) + ;"S:R'<IOM R=IOM-1,XGFLAG("TOO WIDE")=1 ;adjust if wider than screen +"RTN","TMGXGSW",9,0) + D:$D(S) SAVE(T,L,B,R,S) +"RTN","TMGXGSW",10,0) + N L2,R2,%MIDDLE,%MID0,%MID1,XGSAVATR,%S,Y +"RTN","TMGXGSW",11,0) + N XGGR0 ;graphics attribute off +"RTN","TMGXGSW",12,0) + S XGSAVATR=XGCURATR ;save current attr +"RTN","TMGXGSW",13,0) + W $$CHG^XGSA("G0") S XGGR0=XGCURATR ;store attributes w/out graphics +"RTN","TMGXGSW",14,0) + W $$CHG^XGSA("G1") ;now turn on gr attr and leave it on +"RTN","TMGXGSW",15,0) + S %MIDDLE=R-L-1 +"RTN","TMGXGSW",16,0) + S %MID0=IOVL_$J("",%MIDDLE)_$S($D(XGFLAG("TOO WIDE")):" ",1:IOVL) +"RTN","TMGXGSW",17,0) + S %MID1=XGCURATR_$TR($J("",%MIDDLE)," ",XGGR0)_$S($D(XGFLAG("TOO WIDE")):XGGR0,1:XGCURATR) +"RTN","TMGXGSW",18,0) + S L2=L+1,R2=R+1 +"RTN","TMGXGSW",19,0) + ;if window for LISTBUTTON gadget, don't draw top of frame +"RTN","TMGXGSW",20,0) + I $L($G(XGW)),$L($G(XGG)),$G(^TMP("XGW",$J,XGW,"G",XGG,"TYPE"))="LISTBUTTON",$G(XGMENU)="" D +"RTN","TMGXGSW",21,0) + . S $E(XGSCRN(T,0),L2,R2)=%MID0,%S=%MID0,$E(XGSCRN(T,1),L2,R2)=%MID1 +"RTN","TMGXGSW",22,0) + E D ;draw the top of the box +"RTN","TMGXGSW",23,0) + . S %S=IOTLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOTRC) +"RTN","TMGXGSW",24,0) + . S $E(XGSCRN(T,0),L2,R2)=%S +"RTN","TMGXGSW",25,0) + . S $E(XGSCRN(T,1),L2,R2)=$TR($J("",(R-L+1))," ",XGCURATR) +"RTN","TMGXGSW",26,0) + ;W $$IOXY^TMGXGS(T,L)_%S +"RTN","TMGXGSW",27,0) + do CLIOXY^TMGXGS(T,L,%S) +"RTN","TMGXGSW",28,0) + F Y=T+1:1:$S($D(XGFLAG("TOO LONG")):B,1:B-1) D +"RTN","TMGXGSW",29,0) + . S $E(XGSCRN(Y,0),L2,R2)=%MID0 +"RTN","TMGXGSW",30,0) + . S $E(XGSCRN(Y,1),L2,R2)=%MID1 +"RTN","TMGXGSW",31,0) + . ;W $$IOXY^TMGXGS(Y,L)_%MID0 +"RTN","TMGXGSW",32,0) + . DO CLIOXY^TMGXGS(Y,L,%MID0) +"RTN","TMGXGSW",33,0) + S %S=$S($D(XGFLAG("TOO LONG")):%MID0,1:IOBLC_$TR($J("",%MIDDLE)," ",IOHL)_$S($D(XGFLAG("TOO WIDE")):IOHL,1:IOBRC)) +"RTN","TMGXGSW",34,0) + S $E(XGSCRN(B,0),L2,R2)=%S +"RTN","TMGXGSW",35,0) + S $E(XGSCRN(B,1),L2,R2)=$S($D(XGFLAG("TOO LONG")):%MID1,1:$TR($J("",(R-L+1))," ",XGCURATR)) +"RTN","TMGXGSW",36,0) + ;W $$IOXY^TMGXGS(B,L)_%S +"RTN","TMGXGSW",37,0) + DO CLIOXY^TMGXGS(B,L,%S) +"RTN","TMGXGSW",38,0) + W $$SET^XGSA(XGSAVATR) +"RTN","TMGXGSW",39,0) + K XGFLAG("TOO LONG"),XGFLAG("TOO WIDE") +"RTN","TMGXGSW",40,0) + S $Y=B,$X=R +"RTN","TMGXGSW",41,0) + Q +"RTN","TMGXGSW",42,0) + ; +"RTN","TMGXGSW",43,0) + ; +"RTN","TMGXGSW",44,0) +RESTORE(S) ;restore portion of screen +"RTN","TMGXGSW",45,0) + ;if S="XGSCRN" then simply refresh the entire screen +"RTN","TMGXGSW",46,0) + N %,X,Y,%ROW,L2,R2 ;L2 left position in $E R2 right position in $E +"RTN","TMGXGSW",47,0) + N T,L,B,R +"RTN","TMGXGSW",48,0) + N %RCOUNT,%CP,%S,A ;row counter,char pos,string,attr +"RTN","TMGXGSW",49,0) + N XGSAVATR,XGWIDTH +"RTN","TMGXGSW",50,0) + S T=$P(@S@("COORDS"),U,1),L2=$P(@S@("COORDS"),U,2) +"RTN","TMGXGSW",51,0) + S B=$P(@S@("COORDS"),U,3),R2=$P(@S@("COORDS"),U,4) +"RTN","TMGXGSW",52,0) + S %RCOUNT=0,XGSAVATR=XGCURATR +"RTN","TMGXGSW",53,0) + S XGWIDTH=R2-L2+1 +"RTN","TMGXGSW",54,0) + F %ROW=T:1:B D +"RTN","TMGXGSW",55,0) + . S Y=$S($D(T):(T+%RCOUNT),1:%ROW) +"RTN","TMGXGSW",56,0) + . S XGFLAG("UPDATE")=$S(S="XGSCRN":1,1:0) +"RTN","TMGXGSW",57,0) + . ;check to see if a line from window needs to be placed on screen +"RTN","TMGXGSW",58,0) + . ; and if S="XGSCRN" then don't bother checking, refresh screen anyway +"RTN","TMGXGSW",59,0) + . I S'="XGSCRN" F X=0,1 I $E(XGSCRN(Y,X),L2,R2)'=$E(@S@(Y,X),L2,R2) S XGFLAG("UPDATE")=1 Q +"RTN","TMGXGSW",60,0) + . D:XGFLAG("UPDATE") ;if what's on screen is different from window +"RTN","TMGXGSW",61,0) + . . I $E(@S@(Y,1),L2,R2)=$TR($J("",XGWIDTH)," ",XGCURATR)&('$D(XGWSTAMP)) S %S=$E(@S@(Y,0),L2,R2) +"RTN","TMGXGSW",62,0) + . . E S %S="",%=L2,A=XGCURATR D +"RTN","TMGXGSW",63,0) + . . . F %CP=L2:1:R2 D:$E(@S@(Y,1),%CP)'=A +"RTN","TMGXGSW",64,0) + . . . . S A=$E(@S@(Y,1),%CP),%S=%S_$E(@S@(Y,0),%,%CP-1)_$$SET^XGSA(A),%=%CP +"RTN","TMGXGSW",65,0) + . . . S %S=%S_$E(@S@(Y,0),%,%CP) +"RTN","TMGXGSW",66,0) + . . S X=$S($D(L):L,1:L2-1) +"RTN","TMGXGSW",67,0) + . . ;W $$IOXY^TMGXGS(Y,X)_%S +"RTN","TMGXGSW",68,0) + . . DO CLIOXY^TMGXGS(Y,X,%S) +"RTN","TMGXGSW",69,0) + . . ;-------------------- put data, attributes and window stamps back +"RTN","TMGXGSW",70,0) + . . I S'="XGSCRN" F %=0,1 S $E(XGSCRN(Y,%),L2,R2)=$E(@S@(Y,%),L2,R2) +"RTN","TMGXGSW",71,0) + . S %RCOUNT=%RCOUNT+1 +"RTN","TMGXGSW",72,0) + W $$SET^XGSA(XGSAVATR) ;reset screen & XGCURATR to original +"RTN","TMGXGSW",73,0) + K XGFLAG("UPDATE") +"RTN","TMGXGSW",74,0) + ;S $Y=B,$X=R +"RTN","TMGXGSW",75,0) + Q +"RTN","TMGXGSW",76,0) + ; +"RTN","TMGXGSW",77,0) + ; +"RTN","TMGXGSW",78,0) +SAVE(T,L,B,R,S) ;save portion of screen +"RTN","TMGXGSW",79,0) + N %,Y +"RTN","TMGXGSW",80,0) + K @S ;clean out the root +"RTN","TMGXGSW",81,0) + D ADJUST(T,L,B,R,S) ;adjust and save the coordinates +"RTN","TMGXGSW",82,0) + S B=$P(@S@("COORDS"),U,3),R=$P(@S@("COORDS"),U,4) ;get new adj coords +"RTN","TMGXGSW",83,0) + F Y=T:1:B F %=0,1 S @S@(Y,%)=XGSCRN(Y,%) +"RTN","TMGXGSW",84,0) + Q +"RTN","TMGXGSW",85,0) + ; +"RTN","TMGXGSW",86,0) + ; +"RTN","TMGXGSW",87,0) +ADJUST(T,L,B,R,S) ;adjust the coordinates of screen region and if S +"RTN","TMGXGSW",88,0) + ;is passed, save the coordinates of a window into COORDS node +"RTN","TMGXGSW",89,0) + ;NOTE: T,L,B,R may be passed by reference +"RTN","TMGXGSW",90,0) + S:B'<IOSL B=IOSL-1 ;adjust if longer than screen +"RTN","TMGXGSW",91,0) + S:R'<IOM R=IOM-1 ;adjust if wider than screen +"RTN","TMGXGSW",92,0) + ;"//kt added 5/6/07 -- next line only +"RTN","TMGXGSW",93,0) + S:T<0 T=0 S:L<0 L=0 +"RTN","TMGXGSW",94,0) + S L=L+1 ;adjust for $E to work correctly +"RTN","TMGXGSW",95,0) + S R=R+1 ;adjust for $E to work correctly +"RTN","TMGXGSW",96,0) + S:$L($G(S)) @S@("COORDS")=T_U_L_U_B_U_R ;save +"RTN","TMGXGSW",97,0) + Q +"RTN","TMGXINST") +0^101^B16647 +"RTN","TMGXINST",1,0) +TMGXINST ;TMG/kst/XML Configuration Scripting System ;03/25/06 +"RTN","TMGXINST",2,0) + ;;1.0;TMG-LIB;**1**;07/12/04 +"RTN","TMGXINST",3,0) + +"RTN","TMGXINST",4,0) + ;" XML Configuration Scripting System +"RTN","TMGXINST",5,0) + ;" +"RTN","TMGXINST",6,0) + ;" K. Toppenberg, MD +"RTN","TMGXINST",7,0) + ;" 7-12-04 +"RTN","TMGXINST",8,0) + ;" +"RTN","TMGXINST",9,0) + ;"Purpose: Intrepret a specially-prepaired XML file, designed +"RTN","TMGXINST",10,0) + ;" for configuring VistA +"RTN","TMGXINST",11,0) + +"RTN","TMGXINST",12,0) + ;"Dependancy: Requires TMGXDLG.m, TMGSTUTL.m, TMGDEBUG.m +"RTN","TMGXINST",13,0) + +"RTN","TMGXINST",14,0) + ;"------------------------------------------------------------- +"RTN","TMGXINST",15,0) + ;"CHANGE LOG +"RTN","TMGXINST",16,0) + ;"10-17-04: Got WP fields to upload properly. Created FormatArray function. +"RTN","TMGXINST",17,0) + ;"10-15-04: Forgot to log several days. Created <FileUtility>. Ensured data substitution +"RTN","TMGXINST",18,0) + ;" more widely implemented. Worked more on script. Tracked down modal dialog +"RTN","TMGXINST",19,0) + ;" box bug (conflicting globals in two different modules). +"RTN","TMGXINST",20,0) + ;"10-5-04: Learned that WP fields must be treated differently, so worked on support. +"RTN","TMGXINST",21,0) + ;" Had trouble with a locked record after a crash. Learn about GTM lke utility. +"RTN","TMGXINST",22,0) + ;"10-4-04: Tracked down apparent bug in FILE^DIE that doesn't allow upload to a word +"RTN","TMGXINST",23,0) + ;" processor field. Also allowed redirection of debug output to a file or to +"RTN","TMGXINST",24,0) + ;" an X graphic tail box. +"RTN","TMGXINST",25,0) + ;"10-2-05: Changed record node divider character from "/" to "|" because I could not +"RTN","TMGXINST",26,0) + ;" ever remember to protect the / as // and I'm sure others wouldn't remember +"RTN","TMGXINST",27,0) + ;" either. Fixed bug that caused crash when showing error box before XML +"RTN","TMGXINST",28,0) + ;" parse was complete, and datanode contained valid data. Changed UploadFile +"RTN","TMGXINST",29,0) + ;" to UploadRecord with <Record></Record> syntax +"RTN","TMGXINST",30,0) + ;"10-1-04: Fixed bug with line wrapping disordering in dialog boxes. Fixed bug +"RTN","TMGXINST",31,0) + ;" preventing non-modal dialog boxes ("&"-->" &") NOTE: ??working? +"RTN","TMGXINST",32,0) + ;"9-30-04: Allowed data substitution {{...}} to be used in Show and message boxes. +"RTN","TMGXINST",33,0) + ;" Fixed bug to allow multiple data substitutions on one line. +"RTN","TMGXINST",34,0) + ;"9-27-04: +"RTN","TMGXINST",35,0) + ;" Ran a test menu upload and got Adam and TMG Text menu to upload +"RTN","TMGXINST",36,0) + ;" Cleaned up error reporting. Discovered that including the ` character +"RTN","TMGXINST",37,0) + ;" in upload data causes an error... haven't tracked down reason yet. +"RTN","TMGXINST",38,0) + ;"9-26-04: +"RTN","TMGXINST",39,0) + ;" Started this change log +"RTN","TMGXINST",40,0) + ;" Change parameter system so that unlimited number of params allowed +"RTN","TMGXINST",41,0) + ;" Cleaned up command execution and passing of parameters +"RTN","TMGXINST",42,0) + ;" Got X graphic dialogs working -- can call from XML script. +"RTN","TMGXINST",43,0) + ;" Added options for a variety of user interfaces: GUI,CHUI,Roll +"RTN","TMGXINST",44,0) + ;" Changed log in process so that user #1 is used (MGR,IRM on my system) +"RTN","TMGXINST",45,0) + ;"2/9/2008: Moved some functions out into TMGXMLT for reuse by other code. +"RTN","TMGXINST",46,0) + +"RTN","TMGXINST",47,0) + +"RTN","TMGXINST",48,0) + ;"------------------------------------------------------------- +"RTN","TMGXINST",49,0) + ;"Public Functions +"RTN","TMGXINST",50,0) + +"RTN","TMGXINST",51,0) + ;"Run(DispMode,DebugMode,UserPath,UserFName) +"RTN","TMGXINST",52,0) + +"RTN","TMGXINST",53,0) + ;"------------------------------------------------------------- +"RTN","TMGXINST",54,0) + ;"Private Functions +"RTN","TMGXINST",55,0) + ;" +"RTN","TMGXINST",56,0) + ;"ShowWelcome() +"RTN","TMGXINST",57,0) + ;"GetFName(Path,Filename) +"RTN","TMGXINST",58,0) + ;"LoadFile(Path,Filename) +"RTN","TMGXINST",59,0) + ;"ShutDown +"RTN","TMGXINST",60,0) + ;"InitVars() +"RTN","TMGXINST",61,0) + ;"CMDProcess(Command,Params) +"RTN","TMGXINST",62,0) + ;"DoComment(Params) +"RTN","TMGXINST",63,0) + ;"DoShow(Params) +"RTN","TMGXINST",64,0) + ;"DoM(Params) +"RTN","TMGXINST",65,0) + ;"DoMenu(Params) +"RTN","TMGXINST",66,0) + ;"DoLookup(Params) -- take data from XML file, and look up if it is already in database +"RTN","TMGXINST",67,0) + ;"DoValueLookup(Params) -- look for a value of a given value in a given record in given file. +"RTN","TMGXINST",68,0) + ;"DoFileUtility(Params) +"RTN","TMGXINST",69,0) + ;"DoSearchRec(Params) +"RTN","TMGXINST",70,0) + ;"DoUpload(Params) +"RTN","TMGXINST",71,0) + ;"GetRInfo(ID,Data) -- get record info from the <DATA> section and store it in the Data variable. +"RTN","TMGXINST",72,0) + ;"ProcessRNode(DataP,Field,Text,EntryNumber,FileNumber,DoingSubNodes,Flags) -- Allow for recursive calling when doing GetRInfo +"RTN","TMGXINST",73,0) + ;"WPHandle(DataP,EntryNumber,FieldNumber,Text) -- process word-processing fields for ProcessRNode() +"RTN","TMGXINST",74,0) + ;"CheckArraySubst(TextArray) +"RTN","TMGXINST",75,0) + ;"ParamSubstitute(Params) +"RTN","TMGXINST",76,0) + ;"CheckSubstituteData(Text) +"RTN","TMGXINST",77,0) + ;"DoJump(Params) +"RTN","TMGXINST",78,0) + ;"GetLabelNode(Label) +"RTN","TMGXINST",79,0) + ;"GetData(Ref) +"RTN","TMGXINST",80,0) + ;"ParseSeg(Ref,ID) +"RTN","TMGXINST",81,0) + ;"GetDescIDNode(ParentNode,Name,ID) +"RTN","TMGXINST",82,0) + ;"GetCMDLine(ExecNode,Command,Params) +"RTN","TMGXINST",83,0) + ;"GetNextCMD(ExecNode) +"RTN","TMGXINST",84,0) + ;"RunScript(ExecNode) +"RTN","TMGXINST",85,0) + ;"GetDispMode() +"RTN","TMGXINST",86,0) + ;"DoMsgBox(Params) +"RTN","TMGXINST",87,0) + ;"================================================================= +"RTN","TMGXINST",88,0) + ;"================================================================= +"RTN","TMGXINST",89,0) + +"RTN","TMGXINST",90,0) + +"RTN","TMGXINST",91,0) +Run(DispMode,DebugMode,UserPath,UserFName) +"RTN","TMGXINST",92,0) + ;"Purpose: To use given XML filename to process +"RTN","TMGXINST",93,0) + ;"Input: +"RTN","TMGXINST",94,0) + ;" DispMode: OPTIONAL -- If not given, will ask user. Should be +"RTN","TMGXINST",95,0) + ;" 1 for GUI +"RTN","TMGXINST",96,0) + ;" 2 for CHUI +"RTN","TMGXINST",97,0) + ;" 3 for Roll-n-Scroll +"RTN","TMGXINST",98,0) + ;" DebugMode: OPTIONAL -- If not given, will ask user. Should be: +"RTN","TMGXINST",99,0) + ;" 0 for none, +"RTN","TMGXINST",100,0) + ;" 1 for To Screen +"RTN","TMGXINST",101,0) + ;" 2 for To File +"RTN","TMGXINST",102,0) + ;" 3 for To Tail (only valid if DispMode="GUI") +"RTN","TMGXINST",103,0) + ;" UserPath: OPTIONAL --Directory to load from +"RTN","TMGXINST",104,0) + ;" UserFName: OPTIONAL --the full filename. If not given, will ask user +"RTN","TMGXINST",105,0) + +"RTN","TMGXINST",106,0) + ;"Set up some global variables. +"RTN","TMGXINST",107,0) + +"RTN","TMGXINST",108,0) + new TMGDEBUG set TMGDEBUG=0 ;"Note: user could change this at runtime... +"RTN","TMGXINST",109,0) + new DBIndent set DBIndent=0 +"RTN","TMGXINST",110,0) + new PriorErrorFound set PriorErrorFound=0 +"RTN","TMGXINST",111,0) + ;"new DispMode +"RTN","TMGXINST",112,0) + new cGUI set cGUI="GUI" +"RTN","TMGXINST",113,0) + new cCHUI set cCHUI="CHUI" +"RTN","TMGXINST",114,0) + new cRoll set cRoll="Roll-n-Scroll" +"RTN","TMGXINST",115,0) + new DModes +"RTN","TMGXINST",116,0) + new cDialog set cDialog="UseDialog" +"RTN","TMGXINST",117,0) + set DModes(0)="x" +"RTN","TMGXINST",118,0) + set DModes(1)=cGUI +"RTN","TMGXINST",119,0) + set DModes(2)=cCHUI +"RTN","TMGXINST",120,0) + set DModes(3)=cRoll +"RTN","TMGXINST",121,0) + set DModes(4)="x" +"RTN","TMGXINST",122,0) + +"RTN","TMGXINST",123,0) + new ExecNode ;"This is the execution point +"RTN","TMGXINST",124,0) + new DataNode ;"A handle to <Data> node +"RTN","TMGXINST",125,0) + new ScriptNode ;"A handle to <Script> node +"RTN","TMGXINST",126,0) + new TopNode ;"A handle to top level node <CONFIG_SCRIPT> +"RTN","TMGXINST",127,0) + new XMLHandle ;"Handle referring to current XML document +"RTN","TMGXINST",128,0) + +"RTN","TMGXINST",129,0) + new cNodeDiv set cNodeDiv="|" +"RTN","TMGXINST",130,0) + new c2NodeDiv set c2NodeDiv=cNodeDiv_cNodeDiv +"RTN","TMGXINST",131,0) + +"RTN","TMGXINST",132,0) + new cProtect set cProtect="~~" +"RTN","TMGXINST",133,0) + new cDataOpen set cDataOpen="{{" +"RTN","TMGXINST",134,0) + new cDataClose set cDataClose="}}" +"RTN","TMGXINST",135,0) + new cNewLn set cNewLn="\n" +"RTN","TMGXINST",136,0) + new cEntries set cEntries="Entries" +"RTN","TMGXINST",137,0) + new cGlobal set cGlobal="GLOBAL" +"RTN","TMGXINST",138,0) + new cOpen set cOpen="OPEN" +"RTN","TMGXINST",139,0) + new cParentIENS set cParentIENS="ParentIENS" +"RTN","TMGXINST",140,0) + new cTrue set cTrue=1 +"RTN","TMGXINST",141,0) + new cFalse set cFalse=0 +"RTN","TMGXINST",142,0) + new cdbNone set cdbNone=0 +"RTN","TMGXINST",143,0) + new cdbToScrn set cdbToScrn=1 ;"was 2 +"RTN","TMGXINST",144,0) + new cdbToFile set cdbToFile=2 ;"was 3 +"RTN","TMGXINST",145,0) + new cdbToTail set cdbToTail=3 ;"was 4 +"RTN","TMGXINST",146,0) + new cdbAbort set cdbAbort=-1 +"RTN","TMGXINST",147,0) + new cOKToCont set cOKToCont=1 +"RTN","TMGXINST",148,0) + new cAbort set cAbort=0 +"RTN","TMGXINST",149,0) + +"RTN","TMGXINST",150,0) + new cScript set cScript="SCRIPT" ;"Script" +"RTN","TMGXINST",151,0) + new cData set cData="DATA" ;"Data" +"RTN","TMGXINST",152,0) + new cMVar set cMVar="MVAR" ;"MVar" +"RTN","TMGXINST",153,0) + new cOption set cOption="OPTION" ;"option" +"RTN","TMGXINST",154,0) + new cCondition set cCondition="CONDITION" ;"condition" +"RTN","TMGXINST",155,0) + new cMatchThis set cMatchThis="MATCHTHIS" ;"MatchThis" +"RTN","TMGXINST",156,0) + new cMatchValue set cMatchValue="MATCHVALUE" ;"MatchValue +"RTN","TMGXINST",157,0) + new cField set cField="FIELD" ;"Field" +"RTN","TMGXINST",158,0) + new cFile set cFile="FILE" ;"File" +"RTN","TMGXINST",159,0) + new cRecNum set cRecNum="RECNUM" ;"RecNum +"RTN","TMGXINST",160,0) + new cRecord set cRecord="RECORD" ;"Record" +"RTN","TMGXINST",161,0) + new cId set cId="ID" ;"id" +"RTN","TMGXINST",162,0) + new cOutput set cOutput="OUTVAR" ;"OutVar" +"RTN","TMGXINST",163,0) + new cInput set cInput="INVAR" ;"InVar +"RTN","TMGXINST",164,0) + new cShow set cShow="SHOW" ;"Show" +"RTN","TMGXINST",165,0) + new cM set cM="M" ;"M" +"RTN","TMGXINST",166,0) + new cMenu set cMenu="DOMENUOPTION" ;"DoMenuOption" +"RTN","TMGXINST",167,0) + new cUpload set cUpload="UPLOADRECORD" ;"UploadRecord" +"RTN","TMGXINST",168,0) + new cLookup set cLookup="LOOKUPFILEINFO" ;"LookupFileInfo" +"RTN","TMGXINST",169,0) + new cValueLookup set cValueLookup="LOOKUPFIELDVALUE" ;"LookupFieldValue" +"RTN","TMGXINST",170,0) + new cSearchRec set cSearchRec="SEARCHREC" ;"SearchRec +"RTN","TMGXINST",171,0) + new cFileUtility set cFileUtility="FILEUTILITY" ;"FileUtility +"RTN","TMGXINST",172,0) + new cMsgBox set cMsgBox="MSGBOX" ;"MsgBox +"RTN","TMGXINST",173,0) + new cHeader set cHeader="HEADER" ;"Header +"RTN","TMGXINST",174,0) + new cText set cText="TEXT" ;"Text +"RTN","TMGXINST",175,0) + new cJump set cJump="JUMP" ;"Jump" +"RTN","TMGXINST",176,0) + new cRemark set cRemark="REM" ;"Rem" +"RTN","TMGXINST",177,0) + new cLabel set cLabel="LABEL" ;"Label" +"RTN","TMGXINST",178,0) + new cFlags set cFlags="FLAGS" ;"Flags" +"RTN","TMGXINST",179,0) + new cWidth set cWidth="WIDTH" ;"Width +"RTN","TMGXINST",180,0) + new cModal set cModal="MODAL" ;"Modal" +"RTN","TMGXINST",181,0) + new cFn set cFn="FN" ;"Fn +"RTN","TMGXINST",182,0) + new cInfo set cInfo="INFO" ;"Info +"RTN","TMGXINST",183,0) + new cDelete set cDelete="DELETE" ;"Delete +"RTN","TMGXINST",184,0) + new cNextRec set cNextRec="NEXTREC" +"RTN","TMGXINST",185,0) + new cPrev set cPrev="PREV" +"RTN","TMGXINST",186,0) + new cNumRecs set cNumRecs="NUMRECS" +"RTN","TMGXINST",187,0) + new cFirstRec set cFirstRec="FIRSTREC" +"RTN","TMGXINST",188,0) + new cLastRec set cLastRec="LASTREC" +"RTN","TMGXINST",189,0) + new cRef set cRef="Ref" +"RTN","TMGXINST",190,0) + new cNonModal set cNonModal="0" +"RTN","TMGXINST",191,0) + new cModalMode set cModalMode="1" +"RTN","TMGXINST",192,0) + ;"Field flags +"RTN","TMGXINST",193,0) + new cHack set cHack="H" +"RTN","TMGXINST",194,0) + new cNoOverwrite set cNoOverwrite="N" +"RTN","TMGXINST",195,0) + new cEncrypt set cEncrypt="E" +"RTN","TMGXINST",196,0) + ;"---------- +"RTN","TMGXINST",197,0) + new cUpperCase set cUpperCase="UpperCase" +"RTN","TMGXINST",198,0) + new cName set cName="Name" +"RTN","TMGXINST",199,0) + new cValue set cValue="VALUE" +"RTN","TMGXINST",200,0) + new cSet set cSet="SET" +"RTN","TMGXINST",201,0) + new cNull set cNull="(none)" +"RTN","TMGXINST",202,0) + new cMaxNode set cMaxNode="Max Node Num" +"RTN","TMGXINST",203,0) + new Filename +"RTN","TMGXINST",204,0) + new DebugFPath +"RTN","TMGXINST",205,0) + new DebugFName +"RTN","TMGXINST",206,0) + new DebugFile +"RTN","TMGXINST",207,0) + +"RTN","TMGXINST",208,0) + new result +"RTN","TMGXINST",209,0) + new FileSpec +"RTN","TMGXINST",210,0) + +"RTN","TMGXINST",211,0) + new ProcTable +"RTN","TMGXINST",212,0) + set ProcTable(cRemark)="DoComment" ;"a do-nothing function +"RTN","TMGXINST",213,0) + set ProcTable(cLabel)="DoComment" ;"a do-nothing function +"RTN","TMGXINST",214,0) + set ProcTable(cShow)="DoShow" +"RTN","TMGXINST",215,0) + set ProcTable(cM)="DoM" +"RTN","TMGXINST",216,0) + set ProcTable(cMenu)="DoMenu" +"RTN","TMGXINST",217,0) + set ProcTable(cUpload)="DoUpload" +"RTN","TMGXINST",218,0) + set ProcTable(cJump)="DoJump" +"RTN","TMGXINST",219,0) + set ProcTable(cLookup)="DoLookup" +"RTN","TMGXINST",220,0) + set ProcTable(cMsgBox)="DoMsgBox" +"RTN","TMGXINST",221,0) + set ProcTable(cValueLookup)="DoValueLookup" +"RTN","TMGXINST",222,0) + set ProcTable(cFileUtility)="DoFileUtility" +"RTN","TMGXINST",223,0) + set ProcTable(cSearchRec)="DoSearchRec" +"RTN","TMGXINST",224,0) + +"RTN","TMGXINST",225,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"Main Run") +"RTN","TMGXINST",226,0) + +"RTN","TMGXINST",227,0) + if $get(WelcomeShown)'=1 do ShowWelcome() +"RTN","TMGXINST",228,0) + +"RTN","TMGXINST",229,0) + ;"A local code login function. +"RTN","TMGXINST",230,0) + if $$XUP^TMGXUP()=0 do goto RunDone +"RTN","TMGXINST",231,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error setting up a user privilages for configuration.") +"RTN","TMGXINST",232,0) + +"RTN","TMGXINST",233,0) + if ($data(DispMode)#10=0)!($get(DispMode)>3)!($get(DispMode)<1) do +"RTN","TMGXINST",234,0) + . set DispMode=$$GetDispMode() +"RTN","TMGXINST",235,0) + set DispMode=DModes(DispMode) +"RTN","TMGXINST",236,0) + if DispMode="x" goto RunDone +"RTN","TMGXINST",237,0) + set DispMode(cDialog)=(DispMode'=cRoll) +"RTN","TMGXINST",238,0) + +"RTN","TMGXINST",239,0) + if ($data(DebugMode)#10=0)!($get(DebugMode)<0)!($get(DebugMode)>3)!(($get(DebugMode)=1)&(DispMode'=cGUI)) do +"RTN","TMGXINST",240,0) + . set TMGDEBUG=$$GetDebugMode^TMGDEBUG(2) ;"2=default to File output +"RTN","TMGXINST",241,0) + else set TMGDEBUG=DebugMode +"RTN","TMGXINST",242,0) + if TMGDEBUG=cdbAbort goto RunDone +"RTN","TMGXINST",243,0) + +"RTN","TMGXINST",244,0) + do +"RTN","TMGXINST",245,0) + . new DefPath set DefPath="/tmp/" +"RTN","TMGXINST",246,0) + . new DefName set DefName="XMLInst_DebugLog.tmp" +"RTN","TMGXINST",247,0) + . new DefFName set DefFName=DefPath_DefName +"RTN","TMGXINST",248,0) + . do OpenLogFile^TMGDEBUG(DefPath,DefName) +"RTN","TMGXINST",249,0) + . if TMGDEBUG=cdbToTail do +"RTN","TMGXINST",250,0) + . . set result=$$Tail^TMGXDLG(DefFName,0,0,0) +"RTN","TMGXINST",251,0) + +"RTN","TMGXINST",252,0) + if ($data(UserPath)#10=0)!($data(UserFName)#10=0) do +"RTN","TMGXINST",253,0) + . +"RTN","TMGXINST",254,0) + . set result=$$GetFName(.UserPath,.UserFName) +"RTN","TMGXINST",255,0) + . if result=cAbort do PopupBox^TMGUSRIF("<!> No script file selected.","Come back again soon!") +"RTN","TMGXINST",256,0) + else set result=cOKToCont +"RTN","TMGXINST",257,0) + if (result=cAbort)!($data(UserPath)=0)!($data(UserFName)=0) goto RunDone +"RTN","TMGXINST",258,0) + +"RTN","TMGXINST",259,0) + set Filename=UserPath_UserFName +"RTN","TMGXINST",260,0) + +"RTN","TMGXINST",261,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Let's go! Cranking up system!...") +"RTN","TMGXINST",262,0) + +"RTN","TMGXINST",263,0) + kill ^TMP("TMG",$J) +"RTN","TMGXINST",264,0) + set XML1Ref=$name(^TMP("TMG",$J,1)) ;"I have to use this to load file +"RTN","TMGXINST",265,0) + set XMLRef=$name(^TMP("TMG",$J)) ;"I have to pass this to XML parser +"RTN","TMGXINST",266,0) + +"RTN","TMGXINST",267,0) + set XMLHandle=$$LoadFile(UserPath,UserFName) +"RTN","TMGXINST",268,0) + +"RTN","TMGXINST",269,0) + if XMLHandle=0 do goto RunDone +"RTN","TMGXINST",270,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to load/parse file") +"RTN","TMGXINST",271,0) + +"RTN","TMGXINST",272,0) + if '$$InitVars do goto RunDone +"RTN","TMGXINST",273,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error setting up script system (InitVars procedure).") +"RTN","TMGXINST",274,0) + +"RTN","TMGXINST",275,0) + if TMGDEBUG do +"RTN","TMGXINST",276,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling ArrayDump") +"RTN","TMGXINST",277,0) + . do ArrayDump^TMGDEBUG("^TMP(""TMG"")",$J) +"RTN","TMGXINST",278,0) + +"RTN","TMGXINST",279,0) + new Text +"RTN","TMGXINST",280,0) + set Text(0)="[*] XML Script" +"RTN","TMGXINST",281,0) + set Text(1)="Beginning execution of user XML script:" +"RTN","TMGXINST",282,0) + set Text(2)=Filename +"RTN","TMGXINST",283,0) + set Text(2)=" " +"RTN","TMGXINST",284,0) + set Text(3)="This could be the beginning of " +"RTN","TMGXINST",285,0) + set Text(4)="something wonderful..." +"RTN","TMGXINST",286,0) + do PopupArray^TMGUSRIF(5,45,.Text) +"RTN","TMGXINST",287,0) + +"RTN","TMGXINST",288,0) + new RunResult +"RTN","TMGXINST",289,0) + set RunResult=$$RunScript(.ExecNode) +"RTN","TMGXINST",290,0) + +"RTN","TMGXINST",291,0) + new Text +"RTN","TMGXINST",292,0) + set Text(0)="[*] XML Script" +"RTN","TMGXINST",293,0) + set Text(1)="Done with execution of user XML script." +"RTN","TMGXINST",294,0) + set Text(2)=" " +"RTN","TMGXINST",295,0) + set Text(3)="See you later..." +"RTN","TMGXINST",296,0) + if RunResult=cAbort do +"RTN","TMGXINST",297,0) + . set Text(4)="Note: Script was not completed." +"RTN","TMGXINST",298,0) + do PopupArray^TMGUSRIF(5,45,.Text) +"RTN","TMGXINST",299,0) + +"RTN","TMGXINST",300,0) +RunDone +"RTN","TMGXINST",301,0) + do ShutDown +"RTN","TMGXINST",302,0) + +"RTN","TMGXINST",303,0) + write "Clean shutdown completed. Goodbye.",!,! +"RTN","TMGXINST",304,0) + +"RTN","TMGXINST",305,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"Main Run") +"RTN","TMGXINST",306,0) + +"RTN","TMGXINST",307,0) + quit +"RTN","TMGXINST",308,0) + +"RTN","TMGXINST",309,0) + +"RTN","TMGXINST",310,0) + ;"================================================================= +"RTN","TMGXINST",311,0) + ;" Subroutines +"RTN","TMGXINST",312,0) + ;"================================================================= +"RTN","TMGXINST",313,0) + +"RTN","TMGXINST",314,0) +ShowWelcome() +"RTN","TMGXINST",315,0) + ;"Purpose: To show a splash for program +"RTN","TMGXINST",316,0) + +"RTN","TMGXINST",317,0) + write !,! +"RTN","TMGXINST",318,0) + +"RTN","TMGXINST",319,0) + new Text +"RTN","TMGXINST",320,0) + set Text(0)="XML Configurator for VistA on GT.M" +"RTN","TMGXINST",321,0) + set Text(1)=" " +"RTN","TMGXINST",322,0) + set Text(2)="WELCOME..." +"RTN","TMGXINST",323,0) + set Text(3)=" " +"RTN","TMGXINST",324,0) + set Text(4)="Interpreter created by: Kevin Toppenberg, MD" +"RTN","TMGXINST",325,0) + set Text(5)="GNU General Public License, 7/2004" +"RTN","TMGXINST",326,0) + set Text(6)=" " +"RTN","TMGXINST",327,0) + do PopupArray^TMGUSRIF(5,55,.Text) +"RTN","TMGXINST",328,0) + +"RTN","TMGXINST",329,0) + quit +"RTN","TMGXINST",330,0) + +"RTN","TMGXINST",331,0) + +"RTN","TMGXINST",332,0) +GetFName(Path,Filename) +"RTN","TMGXINST",333,0) + ;"Purpose: Interact with user to get path and filename +"RTN","TMGXINST",334,0) + ;"Input: Path--should be passed by reference, used to pass back result +"RTN","TMGXINST",335,0) + ;" Filename--should be passed by reference, used to pass back result +"RTN","TMGXINST",336,0) + ;"Output: Results passed in Path and Filename +"RTN","TMGXINST",337,0) + ;" Function will result in 0 if user 'cancelled', 1 otherwise +"RTN","TMGXINST",338,0) + +"RTN","TMGXINST",339,0) + new result set result=cAbort +"RTN","TMGXINST",340,0) + new FullNamePath +"RTN","TMGXINST",341,0) + new PathNode +"RTN","TMGXINST",342,0) + set Path="/" +"RTN","TMGXINST",343,0) + set Filename="" +"RTN","TMGXINST",344,0) + +"RTN","TMGXINST",345,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetFName") +"RTN","TMGXINST",346,0) + +"RTN","TMGXINST",347,0) + if DispMode=cRoll goto GFNRoll +"RTN","TMGXINST",348,0) + +"RTN","TMGXINST",349,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling $$FileSel()") +"RTN","TMGXINST",350,0) + set FullNamePath=$$FileSel^TMGXDLG("Please select script to process . . .","~/XMLScript") +"RTN","TMGXINST",351,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Results=",FullNamePath) +"RTN","TMGXINST",352,0) + if FullNamePath="" goto GFNDone ;"result=cAbort still --> cancelled. +"RTN","TMGXINST",353,0) + +"RTN","TMGXINST",354,0) + ;"Separate path from filename +"RTN","TMGXINST",355,0) +GFNL1 +"RTN","TMGXINST",356,0) + if '(FullNamePath["/") set Filename=FullNamePath goto GFNL2 +"RTN","TMGXINST",357,0) + set PathNode=$piece(FullNamePath,"/",1) +"RTN","TMGXINST",358,0) + set Path=Path_PathNode_"/" +"RTN","TMGXINST",359,0) + set $piece(FullNamePath,"/",1)="" +"RTN","TMGXINST",360,0) + set FullNamePath=$extract(FullNamePath,2,255) +"RTN","TMGXINST",361,0) + goto GFNL1 +"RTN","TMGXINST",362,0) +GFNL2 +"RTN","TMGXINST",363,0) + set result=cOKToCont +"RTN","TMGXINST",364,0) + goto GFNDone +"RTN","TMGXINST",365,0) + +"RTN","TMGXINST",366,0) +GFNRoll +"RTN","TMGXINST",367,0) + new DefFName set DefFName="XMLScript" +"RTN","TMGXINST",368,0) + new DefPath set DefPath="/home/kdtop/OpenVistA_UserData/r" +"RTN","TMGXINST",369,0) + new Msg set Msg="Select script file:" +"RTN","TMGXINST",370,0) + new tempName +"RTN","TMGXINST",371,0) + +"RTN","TMGXINST",372,0) + ;"if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Will new file picker work?") +"RTN","TMGXINST",373,0) + +"RTN","TMGXINST",374,0) + set tempName=$$GetFName^TMGIOUTL(.Msg,.DefPath,.DefFName,"/",.Path,.Filename) +"RTN","TMGXINST",375,0) + write "Path=",$get(Path)," and Filename=",$get(Filename),! +"RTN","TMGXINST",376,0) + if tempName'="" set result=cOKToCont +"RTN","TMGXINST",377,0) + goto GFNDone +"RTN","TMGXINST",378,0) + +"RTN","TMGXINST",379,0) + ;"write !,"------------------------------------------",! +"RTN","TMGXINST",380,0) + write ! +"RTN","TMGXINST",381,0) + write "Enter script filename with path:",! +"RTN","TMGXINST",382,0) + write " ['^'] = Abort",! +"RTN","TMGXINST",383,0) + write " [Enter] = '",DefPath,"/",DefFName,"'",! +"RTN","TMGXINST",384,0) + write "> " +"RTN","TMGXINST",385,0) + read Filename:240 +"RTN","TMGXINST",386,0) + write ! +"RTN","TMGXINST",387,0) + if Filename="^" goto GFNDone +"RTN","TMGXINST",388,0) + if Filename="" do +"RTN","TMGXINST",389,0) + . set Filename=DefFName +"RTN","TMGXINST",390,0) + . set Path=DefPath +"RTN","TMGXINST",391,0) + . write "Using default: ",Path,"/",Filename,!,!,! +"RTN","TMGXINST",392,0) + set result=cOKToCont +"RTN","TMGXINST",393,0) + +"RTN","TMGXINST",394,0) +GFNDone +"RTN","TMGXINST",395,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetFName") +"RTN","TMGXINST",396,0) + quit result +"RTN","TMGXINST",397,0) + +"RTN","TMGXINST",398,0) + +"RTN","TMGXINST",399,0) + +"RTN","TMGXINST",400,0) +LoadFile(Path,Filename) +"RTN","TMGXINST",401,0) + ;"Purpose: To load the file and check for XML validity +"RTN","TMGXINST",402,0) + ;" Also check for DOCTYPE = 'CONFIG_SCRIPT' and other +"RTN","TMGXINST",403,0) + ;" possible validity tests. +"RTN","TMGXINST",404,0) + ;"Input: FullFile: full filename with path, ready to pass to Host file system. +"RTN","TMGXINST",405,0) + ;"NOTE: uses XML1Ref and XMLRef vars with global scope +"RTN","TMGXINST",406,0) + ;"Returns: 0 if fails, otherwise XML file handle. +"RTN","TMGXINST",407,0) + +"RTN","TMGXINST",408,0) + new FileHandle +"RTN","TMGXINST",409,0) + set XMLHandle=0 +"RTN","TMGXINST",410,0) + +"RTN","TMGXINST",411,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"LoadFile") +"RTN","TMGXINST",412,0) + set FileHandle=$$FTG^%ZISH(Path,Filename,XML1Ref,3) +"RTN","TMGXINST",413,0) + if FileHandle=0 do goto QLoad +"RTN","TMGXINST",414,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening file. Path="_Path_", Filename="_Filename) +"RTN","TMGXINST",415,0) + else do +"RTN","TMGXINST",416,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"File Loaded... Handle#="_FileHandle) +"RTN","TMGXINST",417,0) + +"RTN","TMGXINST",418,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling EN^MXMLDOM") +"RTN","TMGXINST",419,0) + write "Parsing XML File. Please wait . . .",! +"RTN","TMGXINST",420,0) + set XMLHandle=$$EN^MXMLDOM(XMLRef,"") +"RTN","TMGXINST",421,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Back from calling EN^MXMLDOM. XMLHandle="_XMLHandle) +"RTN","TMGXINST",422,0) + if XMLHandle=0 do +"RTN","TMGXINST",423,0) + . new ErrMsg +"RTN","TMGXINST",424,0) + . set ErrMsg="Error parsing XML document.\n\n" +"RTN","TMGXINST",425,0) + . set ErrMsg=ErrMsg_"Now analyzing XML file to determine problem...\n" +"RTN","TMGXINST",426,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,ErrMsg) +"RTN","TMGXINST",427,0) + . do DetailParse^TMGXMLP() +"RTN","TMGXINST",428,0) + +"RTN","TMGXINST",429,0) +QLoad +"RTN","TMGXINST",430,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"LoadFile") +"RTN","TMGXINST",431,0) + quit XMLHandle +"RTN","TMGXINST",432,0) + +"RTN","TMGXINST",433,0) +ShutDown +"RTN","TMGXINST",434,0) + ;"Purpose: to do any cleanup needed to exit system cleanly +"RTN","TMGXINST",435,0) + +"RTN","TMGXINST",436,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Freeing vars...") +"RTN","TMGXINST",437,0) + +"RTN","TMGXINST",438,0) + if $get(XMLHandle) do DELETE^MXMLDOM(XMLHandle) +"RTN","TMGXINST",439,0) + kill ^TMP("TMG",$J) +"RTN","TMGXINST",440,0) + +"RTN","TMGXINST",441,0) + ;"Kill a few variables. The others should be automatically freed +"RTN","TMGXINST",442,0) + ;" when they go out of scope as the program exits. +"RTN","TMGXINST",443,0) + kill TMGDEBUG +"RTN","TMGXINST",444,0) + kill LoggedUsr +"RTN","TMGXINST",445,0) + kill SubMarkNum +"RTN","TMGXINST",446,0) + +"RTN","TMGXINST",447,0) + if $data(DebugFile) close DebugFile +"RTN","TMGXINST",448,0) + +"RTN","TMGXINST",449,0) + write "Exiting XML Scripter.",!,! +"RTN","TMGXINST",450,0) + +"RTN","TMGXINST",451,0) + quit +"RTN","TMGXINST",452,0) + +"RTN","TMGXINST",453,0) + +"RTN","TMGXINST",454,0) +InitVars() +"RTN","TMGXINST",455,0) + ;"Purpose: Initialize variables +"RTN","TMGXINST",456,0) + ;"Input: None: +"RTN","TMGXINST",457,0) + ;"Output: Global (program-wide) variables are set up. +"RTN","TMGXINST",458,0) + ;" Return value is 0 if an error occurs. +"RTN","TMGXINST",459,0) + +"RTN","TMGXINST",460,0) + new result +"RTN","TMGXINST",461,0) + set result=cAbort +"RTN","TMGXINST",462,0) + set TopNode=1 +"RTN","TMGXINST",463,0) + +"RTN","TMGXINST",464,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Entry InitVars()",1) +"RTN","TMGXINST",465,0) + +"RTN","TMGXINST",466,0) + set ScriptNode=$$GetDescNode^TMGXMLT(XMLHandle,TopNode,cScript) +"RTN","TMGXINST",467,0) + if ScriptNode=0 do goto QInitVar +"RTN","TMGXINST",468,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find node: '"_cScript_"'.") +"RTN","TMGXINST",469,0) + +"RTN","TMGXINST",470,0) + set ExecNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode) +"RTN","TMGXINST",471,0) + if ExecNode=0 do goto QInitVar +"RTN","TMGXINST",472,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error finding first child of ScriptNode (#"_ScriptNode_").") +"RTN","TMGXINST",473,0) + +"RTN","TMGXINST",474,0) + set DataNode=$$GetDescNode^TMGXMLT(XMLHandle,TopNode,cData) +"RTN","TMGXINST",475,0) + if DataNode=0 do goto QInitVar +"RTN","TMGXINST",476,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to find node: '"_cData_"'") +"RTN","TMGXINST",477,0) + +"RTN","TMGXINST",478,0) + set result=cOKToCont +"RTN","TMGXINST",479,0) + +"RTN","TMGXINST",480,0) +QInitVar +"RTN","TMGXINST",481,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Exit InitVars()",1) +"RTN","TMGXINST",482,0) + quit result +"RTN","TMGXINST",483,0) + +"RTN","TMGXINST",484,0) + +"RTN","TMGXINST",485,0) +CMDProcess(Command,Params) +"RTN","TMGXINST",486,0) + ;"Purpose: Take allowed command, and carry out appropriate action +"RTN","TMGXINST",487,0) + ;"Input: Command: One of following allowed commands: +"RTN","TMGXINST",488,0) + ;" Show,M,DoMenuOption,UploadRecord,Jump +"RTN","TMGXINST",489,0) + ;" Params: An array holding parameters. See GetParams() for format. +"RTN","TMGXINST",490,0) + ;" Note: if node had no parameters, this array will be undefined. +"RTN","TMGXINST",491,0) + ;"Note: Not all commands will have valid data for all attribs. +"RTN","TMGXINST",492,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",493,0) + +"RTN","TMGXINST",494,0) + new OKToCont set OKToCont=1 +"RTN","TMGXINST",495,0) + +"RTN","TMGXINST",496,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"CMDProcess") +"RTN","TMGXINST",497,0) + +"RTN","TMGXINST",498,0) + if $data(ProcTable(Command)) do +"RTN","TMGXINST",499,0) + . new Cmd set Cmd=ProcTable(Command) +"RTN","TMGXINST",500,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CMD=",Cmd) +"RTN","TMGXINST",501,0) + . set @("OKToCont=$$"_Cmd_"(.Params)") +"RTN","TMGXINST",502,0) + +"RTN","TMGXINST",503,0) + goto CMDQuit +"RTN","TMGXINST",504,0) + +"RTN","TMGXINST",505,0) +CMDQuit +"RTN","TMGXINST",506,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"CMDProcess") +"RTN","TMGXINST",507,0) + quit OKToCont +"RTN","TMGXINST",508,0) + +"RTN","TMGXINST",509,0) + +"RTN","TMGXINST",510,0) +DoComment(Params) +"RTN","TMGXINST",511,0) + ;"Purpose: To provide a function for doing nothing.... for comments in the code. +"RTN","TMGXINST",512,0) + quit 1 +"RTN","TMGXINST",513,0) + +"RTN","TMGXINST",514,0) +DoShow(Params) +"RTN","TMGXINST",515,0) + ;"Purpose: execute Show command +"RTN","TMGXINST",516,0) + ;"Syntax: e.g. <Show>This is a test script system.</Show> +"RTN","TMGXINST",517,0) + ;"Input: Params -- an array that holds all parameters (or is undefined if there were none) +"RTN","TMGXINST",518,0) + ;" if there is text to be show, it should be in +"RTN","TMGXINST",519,0) + ;" Params(cText) +"RTN","TMGXINST",520,0) + ;"Input: TextArray: a reference to global array, holding the text found between tags +"RTN","TMGXINST",521,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",522,0) + +"RTN","TMGXINST",523,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoShow") +"RTN","TMGXINST",524,0) + +"RTN","TMGXINST",525,0) + new done +"RTN","TMGXINST",526,0) + new lineI +"RTN","TMGXINST",527,0) + new OneLine +"RTN","TMGXINST",528,0) + new result set result=cOKToCont +"RTN","TMGXINST",529,0) + +"RTN","TMGXINST",530,0) + new TextArray +"RTN","TMGXINST",531,0) + +"RTN","TMGXINST",532,0) + if $data(Params(cText))=0 do goto DSDone +"RTN","TMGXINST",533,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Asked to show text, but none found!") +"RTN","TMGXINST",534,0) + . ;"if TMGDEBUG do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*) +"RTN","TMGXINST",535,0) + merge TextArray=Params(cText) +"RTN","TMGXINST",536,0) + if TMGDEBUG do ArrayDump^TMGDEBUG("TextArray") ;"zwr TextArray(*) +"RTN","TMGXINST",537,0) + +"RTN","TMGXINST",538,0) + set result=$$CheckArraySubst(.TextArray) +"RTN","TMGXINST",539,0) + +"RTN","TMGXINST",540,0) + set lineI=$Order(TextArray("")) +"RTN","TMGXINST",541,0) + for do quit:(lineI="")!(result=cAbort) +"RTN","TMGXINST",542,0) + . set OneLine=TextArray(lineI) +"RTN","TMGXINST",543,0) + . write OneLine,! +"RTN","TMGXINST",544,0) + . set lineI=$Order(TextArray(lineI)) +"RTN","TMGXINST",545,0) + +"RTN","TMGXINST",546,0) +DSDone +"RTN","TMGXINST",547,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoShow") +"RTN","TMGXINST",548,0) + +"RTN","TMGXINST",549,0) + quit result +"RTN","TMGXINST",550,0) + +"RTN","TMGXINST",551,0) +DoM(Params) +"RTN","TMGXINST",552,0) + ;"Purpose: execute a single line of M code +"RTN","TMGXINST",553,0) + ;"Syntax: e.g. <M>write "This is a test of M code"</M> +"RTN","TMGXINST",554,0) + ;" e.g. <M>set XMLData={{Data.Site.Office[Kevin].Field[Doctor]}}</M> +"RTN","TMGXINST",555,0) + ;"Input: Params -- an array that holds all parameters (or is undefined if there were none) +"RTN","TMGXINST",556,0) + ;" if there is code to be executed, it should be in +"RTN","TMGXINST",557,0) + ;" Params(cText,1) +"RTN","TMGXINST",558,0) + ;"Note: If a {{...}} pair is found, then the contents between the braces will +"RTN","TMGXINST",559,0) + ;" be interpreted as a data reference, and the value will be looked up. +"RTN","TMGXINST",560,0) + ;" The references are read-only. Attempts to write to them will only +"RTN","TMGXINST",561,0) + ;" create an unused variable by the name of the data result. Will likely +"RTN","TMGXINST",562,0) + ;" cause an error. +"RTN","TMGXINST",563,0) + ;" Note: This code could be anything. Script execution will only continue +"RTN","TMGXINST",564,0) + ;" after M code execution is complete. +"RTN","TMGXINST",565,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",566,0) + +"RTN","TMGXINST",567,0) + new RefB +"RTN","TMGXINST",568,0) + new Abort +"RTN","TMGXINST",569,0) + new result set result=cOKToCont +"RTN","TMGXINST",570,0) + new OrigCode +"RTN","TMGXINST",571,0) + +"RTN","TMGXINST",572,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoM") +"RTN","TMGXINST",573,0) + +"RTN","TMGXINST",574,0) + new Code set Code=$get(Params(cText,1)) +"RTN","TMGXINST",575,0) + if Code="" do goto DMDone +"RTN","TMGXINST",576,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No M code found to execute!") +"RTN","TMGXINST",577,0) + +"RTN","TMGXINST",578,0) + ;"Check if Code contains a data reference. Replace with data if found +"RTN","TMGXINST",579,0) + set OrigCode=Code +"RTN","TMGXINST",580,0) + set result=$$CheckSubstituteData(.Code) +"RTN","TMGXINST",581,0) + if result=cAbort do goto DMDone +"RTN","TMGXINST",582,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"UNABLE to execute this code: "_OrigCode) +"RTN","TMGXINST",583,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"After lookup, code was:"_Code) +"RTN","TMGXINST",584,0) + +"RTN","TMGXINST",585,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"execute:> "_Code) +"RTN","TMGXINST",586,0) + +"RTN","TMGXINST",587,0) + ;"Note: Here I trap execution errors, and return 0 if error encountered +"RTN","TMGXINST",588,0) + do +"RTN","TMGXINST",589,0) + . new $etrap set $etrap="do DoMErrTrap^TMGXINST" +"RTN","TMGXINST",590,0) + . set ^TMP("TMG",$J,"trap")=cOKToCont +"RTN","TMGXINST",591,0) + . xecute Code +"RTN","TMGXINST",592,0) + . set result=^TMP("TMG",$J,"trap") +"RTN","TMGXINST",593,0) + . if result=cAbort do +"RTN","TMGXINST",594,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing code: \n"_Code) +"RTN","TMGXINST",595,0) + +"RTN","TMGXINST",596,0) +DMDone +"RTN","TMGXINST",597,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoM") +"RTN","TMGXINST",598,0) + quit result +"RTN","TMGXINST",599,0) + +"RTN","TMGXINST",600,0) + +"RTN","TMGXINST",601,0) + ;"========================================================= +"RTN","TMGXINST",602,0) + ;"DoM Error trap routine +"RTN","TMGXINST",603,0) + ;"========================================================= +"RTN","TMGXINST",604,0) +DoMErrTrap +"RTN","TMGXINST",605,0) + set $etrap="" +"RTN","TMGXINST",606,0) + set $ecode="" +"RTN","TMGXINST",607,0) + set ^TMP("TMG",$J,"trap")=cAbort +"RTN","TMGXINST",608,0) + quit +"RTN","TMGXINST",609,0) + ;"========================================================= +"RTN","TMGXINST",610,0) + ;"DoM End of Error trap routine +"RTN","TMGXINST",611,0) + ;"========================================================= +"RTN","TMGXINST",612,0) + +"RTN","TMGXINST",613,0) + +"RTN","TMGXINST",614,0) +DoMenu(Params) +"RTN","TMGXINST",615,0) + ;"Purpose: To execute a menu option inside the VistA system +"RTN","TMGXINST",616,0) + ;"Syntax: e.g. <DoMenuOption option="DIUSER"></DoMenuOption> +"RTN","TMGXINST",617,0) + ;"Input: Params -- an array that holds all parameters (or is undefined if there were none) +"RTN","TMGXINST",618,0) + ;" if there is code to be executed, it should be in +"RTN","TMGXINST",619,0) + ;" Params(cOption) +"RTN","TMGXINST",620,0) + ;" This should be a valid VistA menu option name. +"RTN","TMGXINST",621,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",622,0) + +"RTN","TMGXINST",623,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoMenu") +"RTN","TMGXINST",624,0) + +"RTN","TMGXINST",625,0) + set result=$$DoShow(.Params) ;"Show any associated text as a message +"RTN","TMGXINST",626,0) + +"RTN","TMGXINST",627,0) + new MenuOption +"RTN","TMGXINST",628,0) + set MenuOption=$get(Params(cOption)) ;"note use of attrib value with case UN-MODIFIED +"RTN","TMGXINST",629,0) + if MenuOption="" do goto DoMenuQ +"RTN","TMGXINST",630,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"No menu option found to execute!") +"RTN","TMGXINST",631,0) + +"RTN","TMGXINST",632,0) + new Text +"RTN","TMGXINST",633,0) + set Text(0)="<!> Notice:" +"RTN","TMGXINST",634,0) + set Text(1)=" " +"RTN","TMGXINST",635,0) + set Text(2)="Temporarily leaving XML Script Configurator" +"RTN","TMGXINST",636,0) + set Text(3)="to run VistA menu option system...." +"RTN","TMGXINST",637,0) + set Text(4)="This script will return to this point when" +"RTN","TMGXINST",638,0) + set Text(5)="VistA menu option exited." +"RTN","TMGXINST",639,0) + set Text(6)=" " +"RTN","TMGXINST",640,0) + do PopupArray^TMGUSRIF(5,55,.Text) +"RTN","TMGXINST",641,0) + +"RTN","TMGXINST",642,0) + new result +"RTN","TMGXINST",643,0) + set result=cOKToCont +"RTN","TMGXINST",644,0) + +"RTN","TMGXINST",645,0) + set DIC=19 ;"File 19 is the OPTION file +"RTN","TMGXINST",646,0) + set DIC(0)="M" ;"M=Multiple index lookup allowed +"RTN","TMGXINST",647,0) + set X=MenuOption +"RTN","TMGXINST",648,0) + do ^DIC ;"Do lookup for variable X. Result returns in Y +"RTN","TMGXINST",649,0) + if Y<0 do quit +"RTN","TMGXINST",650,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Menu option '"_MenuOption_"' wasn't found.\nTry specifying a more specific name, or check spelling.") +"RTN","TMGXINST",651,0) + +"RTN","TMGXINST",652,0) + ;"Note: DIC is already set to 19 +"RTN","TMGXINST",653,0) + set X=$piece(Y,"^",1) ;"X=Menu option IEN to execute +"RTN","TMGXINST",654,0) + +"RTN","TMGXINST",655,0) + ;Note: If the OPTION is a run routine, then this won't work. I could +"RTN","TMGXINST",656,0) + ; Get the run routine my self, but I would also need to do the +"RTN","TMGXINST",657,0) + ; entry and exit points etc. etc., so I am not now going to. +"RTN","TMGXINST",658,0) + +"RTN","TMGXINST",659,0) + do EN^XQOR ;"call standard entry point to run menu/option X +"RTN","TMGXINST",660,0) + +"RTN","TMGXINST",661,0) + new Text +"RTN","TMGXINST",662,0) + set Text(0)="<!> Notice:" +"RTN","TMGXINST",663,0) + set Text(1)=" " +"RTN","TMGXINST",664,0) + set Text(2)="Re-entering XML Script Configurator" +"RTN","TMGXINST",665,0) + set Text(3)="(Back from VistA menu option system)" +"RTN","TMGXINST",666,0) + set Text(4)="Script continuing..." +"RTN","TMGXINST",667,0) + set Text(5)=" " +"RTN","TMGXINST",668,0) + do PopupArray^TMGUSRIF(5,55,.Text) +"RTN","TMGXINST",669,0) + +"RTN","TMGXINST",670,0) + +"RTN","TMGXINST",671,0) + ;"Note: Here I could do some error checking, and return +"RTN","TMGXINST",672,0) + ;" result=cAbort if we need to abort. +"RTN","TMGXINST",673,0) +DoMenuQ +"RTN","TMGXINST",674,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoMenu") +"RTN","TMGXINST",675,0) + quit result +"RTN","TMGXINST",676,0) + +"RTN","TMGXINST",677,0) + +"RTN","TMGXINST",678,0) +DoLookup(Params) +"RTN","TMGXINST",679,0) + ;"Purpose: To take data from XML file, and look if it is already in database +"RTN","TMGXINST",680,0) + ;" -- if so, then put RecNum-IEN of record into variable pointed to by OutVarP +"RTN","TMGXINST",681,0) + ;"Syntax: e.g. <LookupFileInfo id="Kevin" OutVar="MyVar"></LookupFileInfo> +"RTN","TMGXINST",682,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGXINST",683,0) + ;" Params(cId): the ID of the <Record> data entry. +"RTN","TMGXINST",684,0) + ;" Params(cId)="Kevin" in our example +"RTN","TMGXINST",685,0) + ;" Params(cOutput)=the NAME of a variable to put RecNum-IEN into. +"RTN","TMGXINST",686,0) + ;" Params(cOutput)="MyVar" in example +"RTN","TMGXINST",687,0) + ;"Output: OutVarP is loaded with data, i.e.: +"RTN","TMGXINST",688,0) + ;" @OutVarP@(cRecNum)=81 +"RTN","TMGXINST",689,0) + ;" @OutVarP@(cFile)=200 +"RTN","TMGXINST",690,0) + ;" @OutVarP@(cGlobal)="^VA(200)" +"RTN","TMGXINST",691,0) + ;" @OutVarP@(cGlobal,cOpen)="^VA(200," +"RTN","TMGXINST",692,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",693,0) + ;"Note: Even if <Record> specifies a RecNum="2", this function will STILL do a +"RTN","TMGXINST",694,0) + ;" search and return THAT value, not the "2" in this example. +"RTN","TMGXINST",695,0) + +"RTN","TMGXINST",696,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoLookup") +"RTN","TMGXINST",697,0) + +"RTN","TMGXINST",698,0) + new Data +"RTN","TMGXINST",699,0) + new RecNumIEN +"RTN","TMGXINST",700,0) + new result set result=cOKToCont +"RTN","TMGXINST",701,0) + new ID set ID=$get(Params(cId)) +"RTN","TMGXINST",702,0) + new OutVarP set OutVarP=$get(Params(cOutput)) +"RTN","TMGXINST",703,0) + +"RTN","TMGXINST",704,0) + set result=$$DoShow(.Params) ;"Show any associated text as a message +"RTN","TMGXINST",705,0) + +"RTN","TMGXINST",706,0) + if OutVarP="" goto LkDone +"RTN","TMGXINST",707,0) + +"RTN","TMGXINST",708,0) + ;"Parse XML data into a usable form. Verification is done. +"RTN","TMGXINST",709,0) + if '$$GetRInfo(ID,.Data) do goto LkDone +"RTN","TMGXINST",710,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to process <Record> section with id='"_ID_"'.") +"RTN","TMGXINST",711,0) + . set result=cAbort ;"0=Abort +"RTN","TMGXINST",712,0) + +"RTN","TMGXINST",713,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Parsed data.") +"RTN","TMGXINST",714,0) + set @OutVarP@(cFile)=$get(Data(0,cFile)) +"RTN","TMGXINST",715,0) + set @OutVarP@(cGlobal)=$get(Data(0,cFile,cGlobal)) +"RTN","TMGXINST",716,0) + set @OutVarP@(cGlobal,cOpen)=$get(Data(0,cFile,cGlobal,cOpen)) +"RTN","TMGXINST",717,0) + +"RTN","TMGXINST",718,0) + set result=$$GetRecMatch^TMGDBAPI(.Data,.RecNumIEN) ;"if no prior record, returns 0 +"RTN","TMGXINST",719,0) + ;"set RecNumIEN=$$GetRecMatch^TMGDBAPI(.Data) ;"if no prior record, returns 0 +"RTN","TMGXINST",720,0) + set @OutVarP@(cRecNum)=RecNumIEN +"RTN","TMGXINST",721,0) + +"RTN","TMGXINST",722,0) +LkDone +"RTN","TMGXINST",723,0) + set result=(+result>0) ;"Change RecNum-IEN into boolean 1 or 0 +"RTN","TMGXINST",724,0) + if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Lookup command failed.") +"RTN","TMGXINST",725,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoLookup") +"RTN","TMGXINST",726,0) + quit result +"RTN","TMGXINST",727,0) + +"RTN","TMGXINST",728,0) + +"RTN","TMGXINST",729,0) +DoValueLookup(Params) +"RTN","TMGXINST",730,0) + ;"Purpose: To look for a value of a given value in a given record in given file. +"RTN","TMGXINST",731,0) + ;"Syntax: e.g. <LookupFieldValue File="NEW PERSON" RecNum="1" Field=".01" OutVar="MyVar"> +"RTN","TMGXINST",732,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGXINST",733,0) + ;" Params(cFile)="NEW PERSON" in our example +"RTN","TMGXINST",734,0) + ;" Params(cRecNum)="1" in example +"RTN","TMGXINST",735,0) + ;" Params(cField)=".01" in our example (could be Name of field) +"RTN","TMGXINST",736,0) + ;" Params(cOutput)="MyVar" +"RTN","TMGXINST",737,0) + ;"Output: MyVar is loaded with data, i.e.: +"RTN","TMGXINST",738,0) + ;" MyVar(cFile)=200 +"RTN","TMGXINST",739,0) + ;" MyVar(cGlobal)="^VA(200)" +"RTN","TMGXINST",740,0) + ;" MyVar(cGlobal,cOpen)="^VA(200," +"RTN","TMGXINST",741,0) + ;" MyVar(cRecNum)=1 +"RTN","TMGXINST",742,0) + ;" MyVar(cField)=.01 +"RTN","TMGXINST",743,0) + ;" MyVar(cValue)=xxx <-- the looked-up value +"RTN","TMGXINST",744,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=unsuccessful lookup +"RTN","TMGXINST",745,0) + ;"Note: I am getting values by directly looking into database, rather than use +"RTN","TMGXINST",746,0) + ;" the usual lookup commands. I am doing this so that there will be no +"RTN","TMGXINST",747,0) + ;" 'hidden' data, based on security etc. +"RTN","TMGXINST",748,0) + +"RTN","TMGXINST",749,0) + new result +"RTN","TMGXINST",750,0) + +"RTN","TMGXINST",751,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoValueLookup") +"RTN","TMGXINST",752,0) + +"RTN","TMGXINST",753,0) + set result=$$ParamSubstitute(.Params) +"RTN","TMGXINST",754,0) + if result=cAbort goto DVLDone +"RTN","TMGXINST",755,0) + +"RTN","TMGXINST",756,0) + set result=$$ValueLookup^TMGDBAPI(.Params) +"RTN","TMGXINST",757,0) + +"RTN","TMGXINST",758,0) +DVLDone +"RTN","TMGXINST",759,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoValueLookup") +"RTN","TMGXINST",760,0) + quit result +"RTN","TMGXINST",761,0) + +"RTN","TMGXINST",762,0) + +"RTN","TMGXINST",763,0) +DoFileUtility(Params) +"RTN","TMGXINST",764,0) + ;"Purpose: To provide file access/manipulation utilities to script user +"RTN","TMGXINST",765,0) + ;"syntax: +"RTN","TMGXINST",766,0) + ;" <FileUtility File="NEW PERSON" Fn="xxx" RecNum="1" Field=".01" OutVar"MyOutVar" Value="xx" > +"RTN","TMGXINST",767,0) + ;" File: The name of the file to act upon. +"RTN","TMGXINST",768,0) + ;" File may have subnodes (i.e. "NEW PERSON|ALIAS|TITLE") +"RTN","TMGXINST",769,0) + ;" **BUT**, any deletion or set values will only work on top level (i.e. "NEW PERSON") +"RTN","TMGXINST",770,0) + ;" Fn can be on of the following [OPTIONAL]. (Data substitution is allowed) +"RTN","TMGXINST",771,0) + ;" Fn="delete" If Field is not specified: +"RTN","TMGXINST",772,0) + ;" Will cause record RecNum to be deleted. +"RTN","TMGXINST",773,0) + ;" MyOutVar("DELETED")=RecNum of deleted record, or +"RTN","TMGXINST",774,0) + ;" 0 if not found. +"RTN","TMGXINST",775,0) + ;" If Field IS specified: +"RTN","TMGXINST",776,0) + ;" Will delete the value in field, in record RecNum +"RTN","TMGXINST",777,0) + ;" Note: delete is intended only for the highest-level records +"RTN","TMGXINST",778,0) + ;" (i.e. not subfiels, or multiple fields) +"RTN","TMGXINST",779,0) + ;" Note: delete method uses ^DIK to delete the record +"RTN","TMGXINST",780,0) + ;" Fn="info" Will just fill in info below. +"RTN","TMGXINST",781,0) + ;" If Fn not specified, this is default +"RTN","TMGXINST",782,0) + ;" Fn="set" Will put Value into Field, in RecNum, in File (all required) +"RTN","TMGXINST",783,0) + ;" RecNum: [OPTIONAL] Specifies which record to act on. If not +"RTN","TMGXINST",784,0) + ;" specified, then just file info is returned. Data substitution is allowed +"RTN","TMGXINST",785,0) + ;" Field: [OPTIONAL] Specifies which field to act on. Data substitution is allowed +"RTN","TMGXINST",786,0) + ;" OutVar: Needed to get information back from function (but still Optional) +"RTN","TMGXINST",787,0) + ;" Gives name of variable to put info into. +"RTN","TMGXINST",788,0) + ;" Data substitution is allowed. +"RTN","TMGXINST",789,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGXINST",790,0) + ;" Params(cFile)="NEW PERSON" in our example +"RTN","TMGXINST",791,0) + ;" Params(cFn)="info" or "delete", or "set" +"RTN","TMGXINST",792,0) + ;" Params(cRecNum)="1" in example +"RTN","TMGXINST",793,0) + ;" Params(cField)=".01" in our example (could be Name of field) +"RTN","TMGXINST",794,0) + ;" Params(cOutput)="MyVar" +"RTN","TMGXINST",795,0) + ;"Output: MyVar is loaded with data, i.e. +"RTN","TMGXINST",796,0) + ;" i.e. MyOutVar("FILE")=Filenumber +"RTN","TMGXINST",797,0) + ;" MyOutVar("FILE","FILE")=SubFilenumber <-- only if subnodes input in File name (e.g."ALIAS") +"RTN","TMGXINST",798,0) + ;" MyOutVar("FILE","FILE","FILE")=SubSubFilenumber <-- only if subnodes input in File name (e.g."TITLE") +"RTN","TMGXINST",799,0) + ;" MyOutVar("GLOBAL")="^VA(200)" +"RTN","TMGXINST",800,0) + ;" MyOutVar("GLOBAL, OPEN")="^VA(200," +"RTN","TMGXINST",801,0) + ;" MyOutVar("RECNUM")=record number +"RTN","TMGXINST",802,0) + ;" MyOutVar("FIELD")=Filenumber +"RTN","TMGXINST",803,0) + ;" MyOutVar("VALUE")=xxxx <=== value of field (PRIOR TO deletion, if deleted) +"RTN","TMGXINST",804,0) + ;" MyOutVar("NEXTREC")=record number after RecNum, or "" if none +"RTN","TMGXINST",805,0) + ;" MyOutVar("PREVREC")=record number before RecNum, or "" if none +"RTN","TMGXINST",806,0) + ;" MyOutVar("FN")=the function executed +"RTN","TMGXINST",807,0) + ;" MyOutVar("NUMRECS")=Number of records in file PRIOR to any deletions +"RTN","TMGXINST",808,0) + ;" MyOutVar("FIRSTREC")=Rec number of first record in file +"RTN","TMGXINST",809,0) + ;" MyOutVar("LASTREC")=Rec number of last record in file +"RTN","TMGXINST",810,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort +"RTN","TMGXINST",811,0) + ;"Note: I am getting values by directly looking into database, rather than use +"RTN","TMGXINST",812,0) + ;" the usual lookup commands. I am doing this so that there will be no +"RTN","TMGXINST",813,0) + ;" 'hidden' data, based on security etc. +"RTN","TMGXINST",814,0) + +"RTN","TMGXINST",815,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoFileUtility") +"RTN","TMGXINST",816,0) + +"RTN","TMGXINST",817,0) + new result +"RTN","TMGXINST",818,0) + +"RTN","TMGXINST",819,0) + set result=$$ParamSubstitute(.Params) +"RTN","TMGXINST",820,0) + if result=cAbort goto DFUTDone +"RTN","TMGXINST",821,0) + +"RTN","TMGXINST",822,0) + set result=$$FileUtility^TMGDBAPI(.Params) +"RTN","TMGXINST",823,0) + +"RTN","TMGXINST",824,0) +DFUTDone +"RTN","TMGXINST",825,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoFileUtility") +"RTN","TMGXINST",826,0) + quit result +"RTN","TMGXINST",827,0) + +"RTN","TMGXINST",828,0) + +"RTN","TMGXINST",829,0) +DoSearchRec(Params) +"RTN","TMGXINST",830,0) + ;"Purpose: To allow the user to search for a specif record number +"RTN","TMGXINST",831,0) + ;"Syntax: <SearchRec File="PERSON CLASS" InVar="MyInput" OutVar="MyOutput"></SearchRec> +"RTN","TMGXINST",832,0) + ;" File: The name of the file to act upon. +"RTN","TMGXINST",833,0) + ;" InVar: the name of a variable with global scope that will hold lookup info +"RTN","TMGXINST",834,0) + ;" OutVar: the name of variable to receive results +"RTN","TMGXINST",835,0) + ;"Input: Params -- an array loaded with expected parameters. I.e.: +"RTN","TMGXINST",836,0) + ;" Params(cFile)="NEW PERSON" in our example +"RTN","TMGXINST",837,0) + ;" Params(cOutput)="MyOutput" +"RTN","TMGXINST",838,0) + ;" Params(cInput)="MyInput" +"RTN","TMGXINST",839,0) + ;"Note: The format of the input params variable (e.g. 'MyInput') should be as follows: +"RTN","TMGXINST",840,0) + ;" MyInput(FieldNum)=ValueToSearchFor +"RTN","TMGXINST",841,0) + ;" MyInput(FieldNum)=ValueToSearchFor +"RTN","TMGXINST",842,0) + ;" MyInput(FieldNum)=ValueToSearchFor +"RTN","TMGXINST",843,0) + ;" ... etc. +"RTN","TMGXINST",844,0) + ;"Output: MyVar is loaded with data, i.e. +"RTN","TMGXINST",845,0) + ;" MyOutVar("RECNUM")=record number, or 0 if not found +"RTN","TMGXINST",846,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort +"RTN","TMGXINST",847,0) + +"RTN","TMGXINST",848,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoSearchRec") +"RTN","TMGXINST",849,0) + +"RTN","TMGXINST",850,0) + new result set result=cAbort +"RTN","TMGXINST",851,0) + new SrchParams,RecNum,OutVar +"RTN","TMGXINST",852,0) + new MyInput,MyOutput +"RTN","TMGXINST",853,0) + +"RTN","TMGXINST",854,0) + if $$DoShow(.Params)=0 goto DSRDone ;"Show any associated text as a message +"RTN","TMGXINST",855,0) + +"RTN","TMGXINST",856,0) + if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*) +"RTN","TMGXINST",857,0) + +"RTN","TMGXINST",858,0) + set MyInput=$get(Params(cInput)) +"RTN","TMGXINST",859,0) + set MyOutput=$get(Params(cOutput)) +"RTN","TMGXINST",860,0) + if (MyOutput="")!(MyInput="") goto DSRDone ;"result=cAbort be default +"RTN","TMGXINST",861,0) + +"RTN","TMGXINST",862,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MyInput=",MyInput) +"RTN","TMGXINST",863,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MyOutput=",MyOutput) +"RTN","TMGXINST",864,0) + merge SrchParams=@MyInput +"RTN","TMGXINST",865,0) + set SrchParams(0,cFile)=$get(Params(cFile)) +"RTN","TMGXINST",866,0) + set RecNum=$$RecFind^TMGDBAPI(.SrchParams) +"RTN","TMGXINST",867,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found record number: ",RecNum) +"RTN","TMGXINST",868,0) + set @MyOutput@(cRecNum)=RecNum +"RTN","TMGXINST",869,0) + if RecNum=0 goto DSRDone +"RTN","TMGXINST",870,0) + set result=cOKToCont +"RTN","TMGXINST",871,0) + +"RTN","TMGXINST",872,0) +DSRDone +"RTN","TMGXINST",873,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoSearchRec") +"RTN","TMGXINST",874,0) + quit result +"RTN","TMGXINST",875,0) + +"RTN","TMGXINST",876,0) + +"RTN","TMGXINST",877,0) +DoUpload(Params) +"RTN","TMGXINST",878,0) + ;"Purpose: To take data from XML file, and get it up into the VistA database +"RTN","TMGXINST",879,0) + ;"Syntax: e.g. <UploadRecord id="Kevin"></UploadRecord> +"RTN","TMGXINST",880,0) + ;"Note: ***See documentation in GetRInfo for expected formats +"RTN","TMGXINST",881,0) + ;"Input: Params -- an array that holds all parameters (or is undefined if there were none) +"RTN","TMGXINST",882,0) + ;" Params(cId,cUpperCase) -- the ID ofthe data to upload +"RTN","TMGXINST",883,0) + ;" Expected ID -- the ID of the <Record> data entry. e.g. "Kevin" in our example +"RTN","TMGXINST",884,0) + ;" Params(cOutput)=the NAME of a variable to put RecNum-IEN into. (Optional) +"RTN","TMGXINST",885,0) + ;" i.g. Params(cOutput)="MyVar" will cause MyVar=IEN +"RTN","TMGXINST",886,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",887,0) + +"RTN","TMGXINST",888,0) + new Data +"RTN","TMGXINST",889,0) + new result set result=cOKToCont +"RTN","TMGXINST",890,0) + new RecNumIEN +"RTN","TMGXINST",891,0) + +"RTN","TMGXINST",892,0) + new OutVarP set OutVarP=$get(Params(cOutput)) +"RTN","TMGXINST",893,0) + +"RTN","TMGXINST",894,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoUpload") +"RTN","TMGXINST",895,0) + +"RTN","TMGXINST",896,0) + set result=$$DoShow(.Params) ;"Show any associated text as a message +"RTN","TMGXINST",897,0) + +"RTN","TMGXINST",898,0) + new ID +"RTN","TMGXINST",899,0) + set ID=$get(Params(cId,cUpperCase)) +"RTN","TMGXINST",900,0) + if ID="" do goto ULDone +"RTN","TMGXINST",901,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get ID of file to upload!") +"RTN","TMGXINST",902,0) + +"RTN","TMGXINST",903,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Uploading file info -- id="_ID) +"RTN","TMGXINST",904,0) + +"RTN","TMGXINST",905,0) + ;"Parse XML data into a usable form. Verification is done. +"RTN","TMGXINST",906,0) + if '$$GetRInfo(ID,.Data) do goto ULDone +"RTN","TMGXINST",907,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to process <Record> section with id='"_ID_"'.") +"RTN","TMGXINST",908,0) + . set result=cAbort ;"0=Abort +"RTN","TMGXINST",909,0) + +"RTN","TMGXINST",910,0) + set RecNumIEN=$get(Data(0,cRecNum),0) ;"Get user-specified Record Num(IEN), or null +"RTN","TMGXINST",911,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"User-requested recordnum is (0=not requested): ",RecNumIEN) +"RTN","TMGXINST",912,0) + set result=$$UploadData^TMGDBAPI(.Data,.RecNumIEN) +"RTN","TMGXINST",913,0) + if OutVarP'="" do +"RTN","TMGXINST",914,0) + . set @OutVarP@(cRecNum)=RecNumIEN +"RTN","TMGXINST",915,0) + +"RTN","TMGXINST",916,0) +ULDone +"RTN","TMGXINST",917,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result = ",result) +"RTN","TMGXINST",918,0) + if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Error uploading data.") +"RTN","TMGXINST",919,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoUpload") +"RTN","TMGXINST",920,0) + quit result +"RTN","TMGXINST",921,0) + +"RTN","TMGXINST",922,0) + +"RTN","TMGXINST",923,0) + +"RTN","TMGXINST",924,0) +GetRInfo(ID,Data) +"RTN","TMGXINST",925,0) + ;"Purpose: To get record info from the <DATA> section of the XML file, +"RTN","TMGXINST",926,0) + ;" and to store it in the Data variable. +"RTN","TMGXINST",927,0) + ;"Input: ID: The name of the record info to get. +"RTN","TMGXINST",928,0) + ;" e.g. to get the info for this entry: +"RTN","TMGXINST",929,0) + ;" <Record id="Kevin" File="1234.1"> +"RTN","TMGXINST",930,0) + ;" Then ID should = "Kevin" (no extra quotes) +"RTN","TMGXINST",931,0) + ;" Data: This is to be an array that is passed by reference +"RTN","TMGXINST",932,0) + ;" Any preexisting contents will be deleted +"RTN","TMGXINST",933,0) + ;" See output below. +"RTN","TMGXINST",934,0) + ;"Note: The syntax of the <Record> block is as follows. Note, <Record> +"RTN","TMGXINST",935,0) + ;" should be a child (i.e. not a grandchild) of the <DATA> block. +"RTN","TMGXINST",936,0) + ;" example: +"RTN","TMGXINST",937,0) + ;" <Record id="InstFile" File="1234.1"> +"RTN","TMGXINST",938,0) + ;" or <Record id="InstFile" File="NEW PERSON"> +"RTN","TMGXINST",939,0) + ;" or <Record id="InstFile" File="NEW PERSON" RecNum="1"> +"RTN","TMGXINST",940,0) + ;" <Field id=".01" MatchThis="true">MyData1</Field> +"RTN","TMGXINST",941,0) + ;" <Field id=".02" MatchValue="John">Bill</Field> +"RTN","TMGXINST",942,0) + ;" <Field id=".03">MyData3</Field> +"RTN","TMGXINST",943,0) + ;" <Field id=".04">MyData4</Field> +"RTN","TMGXINST",944,0) + ;" <Field id="NAME">MyData5</Field> +"RTN","TMGXINST",945,0) + ;" <Field id="ITEM/.01">SubEntry1</Field> +"RTN","TMGXINST",946,0) + ;" <Field id="ITEM/SYNONYM">SE1</Field> ;"Note: SYNONYM here is field .02 +"RTN","TMGXINST",947,0) + ;" <Field id="ITEM/INFO">'Some Info'</Field> ;"Note: INFO here is field .03 +"RTN","TMGXINST",948,0) + ;" <Field id="ITEM/MENU">SubEntry2</Field> <-- start of 2nd subfile entry +"RTN","TMGXINST",949,0) + ;" <Field id="ITEM/TEXT/INITS">JD</Field> ;"TEXT=.4; INITS=.1 +"RTN","TMGXINST",950,0) + ;" <Field id="ITEM/TEXT/CREATOR">Doe,John</Field> ;"CREATOR is field .2 +"RTN","TMGXINST",951,0) + ;" </Record> +"RTN","TMGXINST",952,0) + ;" +"RTN","TMGXINST",953,0) + ;" 'id': specifies a name that is used in <UploadRecord> command +"RTN","TMGXINST",954,0) + ;" 'File': specifies the filenumber or formal file name to put info into +"RTN","TMGXINST",955,0) + ;" 'RecNum': an OPTIONAL parameter. If specified, data will be forced into the +"RTN","TMGXINST",956,0) + ;" specified record number. If not specified, then data matching is used +"RTN","TMGXINST",957,0) + ;" to determine where to put record. Data substitution is allowed. +"RTN","TMGXINST",958,0) + ;" A value of 0 will be treated as if no value specified. +"RTN","TMGXINST",959,0) + ;" +"RTN","TMGXINST",960,0) + ;" At least one (and likely many) <Field> entries must exist in the <Record> block +"RTN","TMGXINST",961,0) + ;" Syntax: +"RTN","TMGXINST",962,0) + ;" <Field id=".01">MyDataplacing</Field> +"RTN","TMGXINST",963,0) + ;" <Field id="NAME" MatchThis="true">MyDataplacing</Field> +"RTN","TMGXINST",964,0) + ;" <Field id="ITEM/SYNONYM">M1</Field> +"RTN","TMGXINST",965,0) + ;" +"RTN","TMGXINST",966,0) + ;" 'id' gives the field number or name +"RTN","TMGXINST",967,0) + ;" Multiple field names/numbers may be included here. +"RTN","TMGXINST",968,0) + ;" "ITEM/SYNONYM" means that SYNONYM is a field within +"RTN","TMGXINST",969,0) + ;" the ITEM subfile (a field with multiple entries). Thus +"RTN","TMGXINST",970,0) + ;" field ITEM would be located, then SYNONYM subfield. +"RTN","TMGXINST",971,0) + ;" To have a '/' character as part of the field name, and not +"RTN","TMGXINST",972,0) + ;" to be interpreted as a node divider, then use '//', this will +"RTN","TMGXINST",973,0) + ;" be replaced with '/'. +"RTN","TMGXINST",974,0) + ;" Note: When a field allows multiple entries (like "ITEM" above), +"RTN","TMGXINST",975,0) + ;" then there must be a way to determine group of the data into +"RTN","TMGXINST",976,0) + ;" one entry or another. The field ".01" (or a name that resolves +"RTN","TMGXINST",977,0) + ;" to ".01" will serve this purpose. For example: +"RTN","TMGXINST",978,0) + ;" ITEM|.01 <---- the beginning of one entry +"RTN","TMGXINST",979,0) + ;" ITEM|SYNONYM +"RTN","TMGXINST",980,0) + ;" ITEM|INFO +"RTN","TMGXINST",981,0) + ;" ITEM|MENU <---- beginning of the next entry. (MENU=.01) +"RTN","TMGXINST",982,0) + ;" ITEM|TEXT|INITS +"RTN","TMGXINST",983,0) + ;" ITEM|TEXT|CREATOR +"RTN","TMGXINST",984,0) + ;" 'MatchThis': if value="true", then this entry will be used to +"RTN","TMGXINST",985,0) + ;" search for preexisting record in file. Should only be +"RTN","TMGXINST",986,0) + ;" used for highest levels, i.e. match in subfields not supported +"RTN","TMGXINST",987,0) + ;" 'MatchValue': if specified, then value of entry will be used to +"RTN","TMGXINST",988,0) + ;" search for preexisting record in file. Should only be +"RTN","TMGXINST",989,0) + ;" used for highest levels, i.e. match in subfields not supported +"RTN","TMGXINST",990,0) + ;" +"RTN","TMGXINST",991,0) + ;" The data is found between the <Field></Field> tags. +"RTN","TMGXINST",992,0) + ;" Note: The data values may contain lookup codes. For example +"RTN","TMGXINST",993,0) + ;" <Field id="ITEM|CREATOR">{{Data.Site.Office[EastSide].Field[Doctor]}}</Field> +"RTN","TMGXINST",994,0) + ;" would cause the {{..}} value to be looked up in the corresponding +"RTN","TMGXINST",995,0) + ;" section in the XML file and replaced. Thus the line would be converted to: +"RTN","TMGXINST",996,0) + ;" <Field id="ITEM|CREATOR">Kevin</Field> +"RTN","TMGXINST",997,0) + ;" +"RTN","TMGXINST",998,0) + ;"Output: The Data array will be filed with data. Thus for above example: +"RTN","TMGXINST",999,0) + ;" Data(0,cFile)="1234.1" <-- "NEW PERSON" Note conversion +"RTN","TMGXINST",1000,0) + ;" Data(0,cFile,cGlobal)="^DIC(200)" <-- note, NOT "^DIC(200," +"RTN","TMGXINST",1001,0) + ;" Data(0,cRecNum)=2 <-- only if user-specified. +"RTN","TMGXINST",1002,0) + ;" Data(0,cEntries)=1 +"RTN","TMGXINST",1003,0) + ;" Data(1,".01")="MyData1" +"RTN","TMGXINST",1004,0) + ;" Data(1,".01",cMatchValue)="MyData1" +"RTN","TMGXINST",1005,0) + ;" Data(1,".02")="Bill" +"RTN","TMGXINST",1006,0) + ;" Data(1,".02",cMatchValue)="John" +"RTN","TMGXINST",1007,0) + ;" Data(1,".03")="MyData3" +"RTN","TMGXINST",1008,0) + ;" Data(1,".04")="MyData4" +"RTN","TMGXINST",1009,0) + ;" Data(1,".06")="MyData5" <-- note "NAME" was converted to ".06" +"RTN","TMGXINST",1010,0) + ;" Data(1,".07",0,cEntries)=2 <-- "ITEM" converted to ".07" +"RTN","TMGXINST",1011,0) + ;" Data(1,".07",1,".01")="SubEntry1" +"RTN","TMGXINST",1012,0) + ;" Data(1,".07",1,".02")="SE1" +"RTN","TMGXINST",1013,0) + ;" Data(1,".07",1,".03")="'Some Info'" +"RTN","TMGXINST",1014,0) + ;" Data(1,".07",2,".01")="SubEntry2" +"RTN","TMGXINST",1015,0) + ;" Data(1,".07",2,".02")="SE2" +"RTN","TMGXINST",1016,0) + ;" Data(1,".07",2,".04",0,cEntries)=1 ;"TEXT converted to .04 +"RTN","TMGXINST",1017,0) + ;" Data(1,".07",2,".04",1,".01")="JD" +"RTN","TMGXINST",1018,0) + ;" Data(1,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGXINST",1019,0) + ;" ADDENDUM +"RTN","TMGXINST",1020,0) + ;" Data(1,".01",cFlags)=any flags specified for given field. +"RTN","TMGXINST",1021,0) + ;" only present if user specified. +"RTN","TMGXINST",1022,0) + +"RTN","TMGXINST",1023,0) + +"RTN","TMGXINST",1024,0) + ;" Note: The output is somewhat validated, in that if file NAME is given +"RTN","TMGXINST",1025,0) + ;" instead of a number, the name will be converted. The same applies +"RTN","TMGXINST",1026,0) + ;" for field NUMBERS. This ensures that the file exists, and +"RTN","TMGXINST",1027,0) + ;" puts the global reference in the array +"RTN","TMGXINST",1028,0) + ;"Result: 1 if valid data in Data, 0 if data invalid +"RTN","TMGXINST",1029,0) + +"RTN","TMGXINST",1030,0) + new result +"RTN","TMGXINST",1031,0) + new ChildNode +"RTN","TMGXINST",1032,0) + new FileNode +"RTN","TMGXINST",1033,0) + new Text,TextArray +"RTN","TMGXINST",1034,0) + new NodeName,AtrN,AtrVal +"RTN","TMGXINST",1035,0) + new AtrMatch,MatchValue +"RTN","TMGXINST",1036,0) + new MatchThis +"RTN","TMGXINST",1037,0) + new Entries set Entries=0 +"RTN","TMGXINST",1038,0) + new Field,FieldNumber +"RTN","TMGXINST",1039,0) + new RecNum +"RTN","TMGXINST",1040,0) + new Flags +"RTN","TMGXINST",1041,0) + set result=cOKToCont +"RTN","TMGXINST",1042,0) + set ChildNode=0 +"RTN","TMGXINST",1043,0) + set Entries=0 +"RTN","TMGXINST",1044,0) + new FileNumber,FileName,File +"RTN","TMGXINST",1045,0) + new index +"RTN","TMGXINST",1046,0) + new DataP set DataP="Data" +"RTN","TMGXINST",1047,0) + new EntryNumber set EntryNumber=0 ;"was 1 +"RTN","TMGXINST",1048,0) + +"RTN","TMGXINST",1049,0) + new InitDebug set InitDebug=TMGDEBUG +"RTN","TMGXINST",1050,0) + ;"set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info. +"RTN","TMGXINST",1051,0) + +"RTN","TMGXINST",1052,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetRInfo") +"RTN","TMGXINST",1053,0) + +"RTN","TMGXINST",1054,0) + if $data(ID)'=0 do +"RTN","TMGXINST",1055,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"var ID=",ID) +"RTN","TMGXINST",1056,0) + else do +"RTN","TMGXINST",1057,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"var ID=(empty)") +"RTN","TMGXINST",1058,0) + +"RTN","TMGXINST",1059,0) + if $data(ID)'=0 do +"RTN","TMGXINST",1060,0) + . set FileNode=$$GetDescIDNode(DataNode,cRecord,ID) +"RTN","TMGXINST",1061,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Node with ",cRecord,"=",FileNode) +"RTN","TMGXINST",1062,0) + else do +"RTN","TMGXINST",1063,0) + . set FileNode=0 +"RTN","TMGXINST",1064,0) + if FileNode=0 do goto GInfPast +"RTN","TMGXINST",1065,0) + . set result=cAbort +"RTN","TMGXINST",1066,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"File entry named '"_ID_"' not found.") +"RTN","TMGXINST",1067,0) + +"RTN","TMGXINST",1068,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking for user-specified record number in node: ",FileNode) +"RTN","TMGXINST",1069,0) + set RecNum=$$GetAtrVal^TMGXMLT(XMLHandle,FileNode,cRecNum) ;"get user-specified RecNum IEN (optional) +"RTN","TMGXINST",1070,0) + set result=$$CheckSubstituteData(.RecNum) +"RTN","TMGXINST",1071,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Specified RecNum='",RecNum,"'") +"RTN","TMGXINST",1072,0) + if +RecNum>0 set Data(0,cRecNum)=RecNum +"RTN","TMGXINST",1073,0) + +"RTN","TMGXINST",1074,0) + set File=$$GetAtrVal^TMGXMLT(XMLHandle,FileNode,cFile) +"RTN","TMGXINST",1075,0) + set Data(0,cFile)=File +"RTN","TMGXINST",1076,0) + set result=$$SetupFileNum^TMGDBAPI(.Data) +"RTN","TMGXINST",1077,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setup file number result=",result) +"RTN","TMGXINST",1078,0) + if result=cAbort do goto GInfPast +"RTN","TMGXINST",1079,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to set up file '"_File_"'.") +"RTN","TMGXINST",1080,0) + set FileNumber=$get(Data(0,cFile),-1) +"RTN","TMGXINST",1081,0) + if FileNumber=-1 do goto GInfQuit +"RTN","TMGXINST",1082,0) + . set result=cAbort +"RTN","TMGXINST",1083,0) + +"RTN","TMGXINST",1084,0) +GInfLoop +"RTN","TMGXINST",1085,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Starting GInfLoop") +"RTN","TMGXINST",1086,0) + set ChildNode=$$CHILD^MXMLDOM(XMLHandle,FileNode,ChildNode) +"RTN","TMGXINST",1087,0) + if ChildNode=0 goto GInfPast +"RTN","TMGXINST",1088,0) + set NodeName=$$GetNName^TMGXMLT(XMLHandle,ChildNode) +"RTN","TMGXINST",1089,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Name="_NodeName) +"RTN","TMGXINST",1090,0) + if NodeName'=cField goto GInfLoop +"RTN","TMGXINST",1091,0) + set Text=$$Get1NText^TMGXMLT(XMLHandle,ChildNode,.TextArray) +"RTN","TMGXINST",1092,0) + if $data(TextArray(2)) do +"RTN","TMGXINST",1093,0) + . merge Text(cText)=TextArray +"RTN","TMGXINST",1094,0) + +"RTN","TMGXINST",1095,0) + if $$UP^XLFSTR($$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cMatchThis))=cTrue do +"RTN","TMGXINST",1096,0) + . set MatchValue=Text +"RTN","TMGXINST",1097,0) + set MatchValue=$get(MatchValue) +"RTN","TMGXINST",1098,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Attrib Match value='",MatchValue,"'") +"RTN","TMGXINST",1099,0) + set Entries=Entries+1 +"RTN","TMGXINST",1100,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Entries='",Entries,"'") +"RTN","TMGXINST",1101,0) + +"RTN","TMGXINST",1102,0) + set Field=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cId) ;"May get either a name or a number +"RTN","TMGXINST",1103,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Field='",Field,"'") +"RTN","TMGXINST",1104,0) + +"RTN","TMGXINST",1105,0) + ;"Protect any //'s by converting to ~~'s +"RTN","TMGXINST",1106,0) + set Field=$$Substitute^TMGSTUTL(.Field,c2NodeDiv,cProtect) +"RTN","TMGXINST",1107,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"After substitution, Field '",cId,"'=",Field) +"RTN","TMGXINST",1108,0) + +"RTN","TMGXINST",1109,0) + set Flags=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cFlags) ;"Get any flags that might exist. +"RTN","TMGXINST",1110,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags for node #",ChildNode," = '",Flags,"'") +"RTN","TMGXINST",1111,0) + +"RTN","TMGXINST",1112,0) + ;"Allow recursive calls via ProcessRNode +"RTN","TMGXINST",1113,0) + set result=$$ProcessRNode(DataP,Field,.Text,.EntryNumber,FileNumber,0,MatchValue,Flags) +"RTN","TMGXINST",1114,0) + if result=cAbort goto GInfQuit +"RTN","TMGXINST",1115,0) + ;"temp ... set EntryNumber=EntryNumber+1 +"RTN","TMGXINST",1116,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",EntryNumber) +"RTN","TMGXINST",1117,0) + +"RTN","TMGXINST",1118,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Completed loop cycle (maybe there will be more to come)") +"RTN","TMGXINST",1119,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"------------") +"RTN","TMGXINST",1120,0) + goto GInfLoop +"RTN","TMGXINST",1121,0) + +"RTN","TMGXINST",1122,0) +GInfPast +"RTN","TMGXINST",1123,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Done with loop") +"RTN","TMGXINST",1124,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"------------") +"RTN","TMGXINST",1125,0) + +"RTN","TMGXINST",1126,0) + if $data(Data(0,cEntries))=0 do goto GInfQuit +"RTN","TMGXINST",1127,0) + . set result=cAbort +"RTN","TMGXINST",1128,0) + +"RTN","TMGXINST",1129,0) + ;"Ensure that there is at least a .01 field. Required for every record +"RTN","TMGXINST",1130,0) + ;"Note: I think that other files have multiple KEY fields.... I am not checking +"RTN","TMGXINST",1131,0) + ;" for this (perhaps I should later??) +"RTN","TMGXINST",1132,0) + new bFound set bFound=0 +"RTN","TMGXINST",1133,0) + for index=1:1:Data(0,cEntries) do quit:bFound +"RTN","TMGXINST",1134,0) + . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Data(",index,",.01)='",$get(Data(index,".01")),"'") +"RTN","TMGXINST",1135,0) + . if $data(Data(index,".01")) set bFound=1 +"RTN","TMGXINST",1136,0) + +"RTN","TMGXINST",1137,0) + if bFound=0 do goto GInfQuit +"RTN","TMGXINST",1138,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Data entry did not specify any entry for field .01") +"RTN","TMGXINST",1139,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is data:") +"RTN","TMGXINST",1140,0) + . if TMGDEBUG do ArrayDump^TMGDEBUG("Data") ;"zwr Data(*) +"RTN","TMGXINST",1141,0) + . set result=cAbort +"RTN","TMGXINST",1142,0) + +"RTN","TMGXINST",1143,0) +GInfQuit +"RTN","TMGXINST",1144,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetRInfo") +"RTN","TMGXINST",1145,0) + set TMGDEBUG=InitDebug +"RTN","TMGXINST",1146,0) + quit result +"RTN","TMGXINST",1147,0) + +"RTN","TMGXINST",1148,0) + +"RTN","TMGXINST",1149,0) +ProcessRNode(DataP,Field,Text,EntryNumber,FileNumber,DoingSubNodes,MatchValue,Flags) +"RTN","TMGXINST",1150,0) + ;"Purpose: Allow for recursive calling when doing GetRInfo +"RTN","TMGXINST",1151,0) + ;" This takes one entry and processes it. +"RTN","TMGXINST",1152,0) + ;"Input: DataP: The 'name' of the data array -- like this: "Data(1)" +"RTN","TMGXINST",1153,0) + ;" Field: a field name with 0..n subnodes +"RTN","TMGXINST",1154,0) + ;" i.e. "ITEM", OR "ITEM|NUMBER", OR "ITEM|NUMBER|ID" +"RTN","TMGXINST",1155,0) + ;" Text: the value that should be put into field. should be passed by REFERENCE +"RTN","TMGXINST",1156,0) + ;" Text will have the following format: +"RTN","TMGXINST",1157,0) + ;" Text="First line of text" +"RTN","TMGXINST",1158,0) + ;" Text(cText,1)="First line of text" <-- only present if multiple +"RTN","TMGXINST",1159,0) + ;" Text(cText,2)="Second line of text" lines of text present. +"RTN","TMGXINST",1160,0) + ;" EntryNumber: The current entry number. Should be passed by REFERENCE +"RTN","TMGXINST",1161,0) + ;" FileNumber: the current file number, or sub-filenumber. DON'T PASS BY REFERENCE +"RTN","TMGXINST",1162,0) + ;" The first node (i.e. "ITEM") should be field in FileNumber +"RTN","TMGXINST",1163,0) + ;" DoingSubNodes: 1 if true (changes behavior or entry numbering for subnodes), 0 otherwise +"RTN","TMGXINST",1164,0) + ;" //AtrMatch: if this field should be matched for during DB lookup +"RTN","TMGXINST",1165,0) + ;" MatchValue: Value to looking in database when finding matching record. +"RTN","TMGXINST",1166,0) + ;" Flags: any user specified flags for field +"RTN","TMGXINST",1167,0) + ;"Result: Returns success 1=OK to continue. 0=Abort +"RTN","TMGXINST",1168,0) + +"RTN","TMGXINST",1169,0) + ;"Note: This entry--><Field id="ITEM|TEXT|CREATOR">Doe,John</Field> +"RTN","TMGXINST",1170,0) + ;"Should result it--> Data(6,".07",2,".04",1,".02")="DOE,JOHN" +"RTN","TMGXINST",1171,0) + ;"See data format description in GetRInfo +"RTN","TMGXINST",1172,0) + +"RTN","TMGXINST",1173,0) + new PartA,PartB +"RTN","TMGXINST",1174,0) + new tempA,tempB +"RTN","TMGXINST",1175,0) + new result set result=cOKToCont +"RTN","TMGXINST",1176,0) + new cFieldNumber set cFieldNumber="Field Number" +"RTN","TMGXINST",1177,0) + +"RTN","TMGXINST",1178,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ProcessRNode") +"RTN","TMGXINST",1179,0) + +"RTN","TMGXINST",1180,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DataP='",$get(DataP),"'") +"RTN","TMGXINST",1181,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"File number=",$get(FileNumber)) +"RTN","TMGXINST",1182,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Field=",$get(Field)) +"RTN","TMGXINST",1183,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",$get(EntryNumber)) +"RTN","TMGXINST",1184,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"MatchValue='",$get(MatchValue),"'") +"RTN","TMGXINST",1185,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags='",$get(Flags),"'") +"RTN","TMGXINST",1186,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DoingSubNodes=",$get(DoingSubNodes)) +"RTN","TMGXINST",1187,0) + +"RTN","TMGXINST",1188,0) + new SpliceArray +"RTN","TMGXINST",1189,0) + new temp +"RTN","TMGXINST",1190,0) + +"RTN","TMGXINST",1191,0) + if Field[cNodeDiv do ;"Parse 'ITEM|NUMBER|ID' into 'ITEM', 'NUMBER', 'ID' +"RTN","TMGXINST",1192,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Multiple nodes found for field. Processing...") +"RTN","TMGXINST",1193,0) + . do CleaveStr^TMGSTUTL(.Field,cNodeDiv,.PartB) +"RTN","TMGXINST",1194,0) + . set FieldNumber=$$GetNumField^TMGDBAPI(FileNumber,Field) +"RTN","TMGXINST",1195,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Parsed off first part of Field. Looking at only '",Field,"'") +"RTN","TMGXINST",1196,0) + . ;"Note: this does NOT handle processesing of more than 2 nodes. +"RTN","TMGXINST",1197,0) + . if PartB'=cNull do ;"If PartB has data, then PartB(cFieldNumber) will also have data +"RTN","TMGXINST",1198,0) + . . if PartB=".01" do +"RTN","TMGXINST",1199,0) + . . . set PartB(cFieldNumber)=".01" +"RTN","TMGXINST",1200,0) + . . else do +"RTN","TMGXINST",1201,0) + . . . new BFileNumber +"RTN","TMGXINST",1202,0) + . . . set BFileNumber=$$GetSubFileNumber^TMGDBAPI(FileNumber,FieldNumber) ;"get 'file number' of subfile +"RTN","TMGXINST",1203,0) + . . . if BFileNumber'=0 do +"RTN","TMGXINST",1204,0) + . . . . set PartB(cFieldNumber)=$$GetNumField^TMGDBAPI(BFileNumber,PartB) +"RTN","TMGXINST",1205,0) + . . . else set PartB(cFieldNumber)=0 +"RTN","TMGXINST",1206,0) + . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Will deal with '",PartB,"' later") +"RTN","TMGXINST",1207,0) + +"RTN","TMGXINST",1208,0) + set Field=$$Substitute^TMGSTUTL(.Field,cProtect,cNodeDiv) ;"convert protected ||'s back from }}'s to single | +"RTN","TMGXINST",1209,0) + if $data(PartB) set PartB=$$Substitute^TMGSTUTL(.PartB,cProtect,cNodeDiv) +"RTN","TMGXINST",1210,0) + +"RTN","TMGXINST",1211,0) + set FieldNumber=+Field +"RTN","TMGXINST",1212,0) + if FieldNumber=0 do +"RTN","TMGXINST",1213,0) + . set FieldNumber=$$GetNumField^TMGDBAPI(FileNumber,Field) +"RTN","TMGXINST",1214,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Converted '",Field,"' to field number ",FieldNumber) +"RTN","TMGXINST",1215,0) + else if $$VFIELD^DILFD(FileNumber,Field)=0 do goto PFNDone +"RTN","TMGXINST",1216,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,Field_" is not a valid field number in file "_FileNumber) +"RTN","TMGXINST",1217,0) + . set result=cAbort +"RTN","TMGXINST",1218,0) + if FieldNumber=0 do goto PFNDone +"RTN","TMGXINST",1219,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to convert field '"_Field_"' to a field number. (Hint: If this name is supposed to contain multiple nodes, did you use '"_cNodeDiv_"' as a divider?)") +"RTN","TMGXINST",1220,0) + . set result=cAbort +"RTN","TMGXINST",1221,0) + +"RTN","TMGXINST",1222,0) + if FieldNumber=.01 do +"RTN","TMGXINST",1223,0) + . set EntryNumber=EntryNumber+1 ;"Test this!! +"RTN","TMGXINST",1224,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found .01 field. Incrementing EntryNumber to "_EntryNumber) +"RTN","TMGXINST",1225,0) + +"RTN","TMGXINST",1226,0) + +"RTN","TMGXINST",1227,0) + if $data(PartB) do +"RTN","TMGXINST",1228,0) + . ;"If there are subnodes, then search if current entry should be under a prior entry +"RTN","TMGXINST",1229,0) + . if $data(@DataP@(EntryNumber-1,FieldNumber,0,cEntries)) do +"RTN","TMGXINST",1230,0) + . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"EntryNumber=",EntryNumber) +"RTN","TMGXINST",1231,0) + . . ;"set EntryNumber=EntryNumber-1 +"RTN","TMGXINST",1232,0) + . . set DoingSubNodes=1 +"RTN","TMGXINST",1233,0) + . . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Attaching current data as a subnode of prior entry.") +"RTN","TMGXINST",1234,0) + . . ;"if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Changing EntryNumber to ",EntryNumber) +"RTN","TMGXINST",1235,0) + +"RTN","TMGXINST",1236,0) + if DoingSubNodes=0 goto PFNPast +"RTN","TMGXINST",1237,0) + if (EntryNumber=0) do goto PFNDone +"RTN","TMGXINST",1238,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"No '.01' field found yet, so skipping processing.") +"RTN","TMGXINST",1239,0) + +"RTN","TMGXINST",1240,0) +PFNPast +"RTN","TMGXINST",1241,0) + if $data(PartB)=0 do +"RTN","TMGXINST",1242,0) + . set result=$$CheckSubstituteData(.Text) ;"Do any data lookup needed +"RTN","TMGXINST",1243,0) + . if result=cAbort do +"RTN","TMGXINST",1244,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to do data lookup: "_Text) +"RTN","TMGXINST",1245,0) + . else do +"RTN","TMGXINST",1246,0) + . . ;"HERE IS WHERE WE PUT THE INFO INTO THE DATA ARRAY. +"RTN","TMGXINST",1247,0) + . . set @DataP@(EntryNumber,FieldNumber)=Text +"RTN","TMGXINST",1248,0) + . . set @DataP@(EntryNumber,FieldNumber,"FieldName")=$get(Field) ;"mainly for debugging. +"RTN","TMGXINST",1249,0) + . . if Flags'=" " set @DataP@(EntryNumber,FieldNumber,cFlags)=Flags +"RTN","TMGXINST",1250,0) + . . new FieldInfo +"RTN","TMGXINST",1251,0) + . . do GetFieldInfo^TMGDBAPI(FileNumber,FieldNumber,"FieldInfo") +"RTN","TMGXINST",1252,0) + . . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do +"RTN","TMGXINST",1253,0) + . . . do WPHandle(DataP,EntryNumber,FieldNumber,.Text) +"RTN","TMGXINST",1254,0) + . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting ",DataP,"(",EntryNumber,",",FieldNumber,")=",Text) +"RTN","TMGXINST",1255,0) + . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Flags were: '",Flags,"'") +"RTN","TMGXINST",1256,0) + else do +"RTN","TMGXINST",1257,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"DoingSubNodes=",DoingSubNodes,", PartB='",$get(PartB),"'") +"RTN","TMGXINST",1258,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Doing subnodes, so did NOT set ",DataP,"(",EntryNumber,",",FieldNumber,")=",Text) +"RTN","TMGXINST",1259,0) + +"RTN","TMGXINST",1260,0) + if result=cAbort goto PFNDone +"RTN","TMGXINST",1261,0) + +"RTN","TMGXINST",1262,0) + if FieldNumber=.01 set MatchValue=Text +"RTN","TMGXINST",1263,0) + +"RTN","TMGXINST",1264,0) + if (MatchValue'="")!(FieldNumber=.01) do +"RTN","TMGXINST",1265,0) + . ;"set @DataP@(EntryNumber,FieldNumber,cMatchThis)=1 ;"i.e. true +"RTN","TMGXINST",1266,0) + . set @DataP@(EntryNumber,FieldNumber,cMatchValue)=MatchValue +"RTN","TMGXINST",1267,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting ",DataP,"(",EntryNumber,",",FieldNumber,",",cMatchValue,")=",MatchValue) +"RTN","TMGXINST",1268,0) + +"RTN","TMGXINST",1269,0) + set @DataP@(0,cEntries)=EntryNumber +"RTN","TMGXINST",1270,0) + set @DataP@(0,cFile)=FileNumber +"RTN","TMGXINST",1271,0) + +"RTN","TMGXINST",1272,0) + if $data(PartB) do ;"I.e. we have subnodes. -- process +"RTN","TMGXINST",1273,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Subnodes detected. Here is where we deal with that '",PartB,"'") +"RTN","TMGXINST",1274,0) + . new SubEntryNumber +"RTN","TMGXINST",1275,0) + . set SubEntryNumber=$get(@DataP@(EntryNumber,FieldNumber,0,cEntries),0) +"RTN","TMGXINST",1276,0) + . if (PartB(cFieldNumber)=".01")!(SubEntryNumber=0) do +"RTN","TMGXINST",1277,0) + . . ;"test ... set SubEntryNumber=SubEntryNumber+1 +"RTN","TMGXINST",1278,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"SubEntryNumber=",SubEntryNumber) +"RTN","TMGXINST",1279,0) + . set FileNumber=$$GetSubFileNumber^TMGDBAPI(FileNumber,FieldNumber) ;"get 'file number' of subfile +"RTN","TMGXINST",1280,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"file number=",FileNumber) +"RTN","TMGXINST",1281,0) + . if FileNumber=0 quit +"RTN","TMGXINST",1282,0) + . set DataP=$name(@DataP@(EntryNumber,FieldNumber)) +"RTN","TMGXINST",1283,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Calling self recursively") +"RTN","TMGXINST",1284,0) + . new SubFlags set SubFlags=Flags ;"SubFlags=" " +"RTN","TMGXINST",1285,0) + . new SubMatchValue set SubMatchValue="" +"RTN","TMGXINST",1286,0) + . set result=$$ProcessRNode(DataP,PartB,.Text,.SubEntryNumber,FileNumber,1,SubMatchValue,SubFlags) ;"Call self recursively +"RTN","TMGXINST",1287,0) + +"RTN","TMGXINST",1288,0) +PFNDone +"RTN","TMGXINST",1289,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ProcessRNode") +"RTN","TMGXINST",1290,0) + quit result +"RTN","TMGXINST",1291,0) + +"RTN","TMGXINST",1292,0) +WPHandle(DataP,EntryNumber,FieldNumber,Text) +"RTN","TMGXINST",1293,0) + ;"Purpose: to process word-processing fields for ProcessRNode() +"RTN","TMGXINST",1294,0) + ;" It will get text into form ready for use by FILE^DIE +"RTN","TMGXINST",1295,0) + ;"Input: DataP: The 'name' of the data array -- like this: "Data(1)" +"RTN","TMGXINST",1296,0) + ;" EntryNumber: The current entry number. Should be passed by REFERENCE +"RTN","TMGXINST",1297,0) + ;" FileNumber: the current file number, or sub-filenumber. DON'T PASS BY REFERENCE +"RTN","TMGXINST",1298,0) + ;" The first node (i.e. "ITEM") should be field in FileNumber +"RTN","TMGXINST",1299,0) + ;" Text: the value that should be put into field. should be passed by REFERENCE +"RTN","TMGXINST",1300,0) + ;" Text will have the following format: +"RTN","TMGXINST",1301,0) + ;" Text="First line of text" +"RTN","TMGXINST",1302,0) + ;" Text(cText,1)="First line of text" <-- only present if multiple +"RTN","TMGXINST",1303,0) + ;" Text(cText,2)="Second line of text" lines of text present. +"RTN","TMGXINST",1304,0) + ;"Result: none +"RTN","TMGXINST",1305,0) + +"RTN","TMGXINST",1306,0) + new Array,temp +"RTN","TMGXINST",1307,0) + new result +"RTN","TMGXINST",1308,0) + +"RTN","TMGXINST",1309,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"WPHandle") +"RTN","TMGXINST",1310,0) + +"RTN","TMGXINST",1311,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is Text to use to put into WP field:") +"RTN","TMGXINST",1312,0) + if TMGDEBUG do ArrayDump^TMGDEBUG("Text") +"RTN","TMGXINST",1313,0) + if $data(Text(cText)) do +"RTN","TMGXINST",1314,0) + . set result=$$FormatArray^TMGSTUTL(.Text,.Array,"\n") +"RTN","TMGXINST",1315,0) + else do +"RTN","TMGXINST",1316,0) + . do CleaveToArray^TMGSTUTL(Text,"\n",.Array,1) +"RTN","TMGXINST",1317,0) + +"RTN","TMGXINST",1318,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is array after processing, ready to put into WP field:") +"RTN","TMGXINST",1319,0) + if TMGDEBUG do ArrayDump^TMGDEBUG("Array") +"RTN","TMGXINST",1320,0) + +"RTN","TMGXINST",1321,0) + merge @DataP@(EntryNumber,FieldNumber,"WP")=Array +"RTN","TMGXINST",1322,0) + set @DataP@(EntryNumber,FieldNumber)=$name(@DataP@(EntryNumber,FieldNumber,"WP")) +"RTN","TMGXINST",1323,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Setting: ",DataP,"(",EntryNumber,",",FieldNumber,")=",$name(@DataP@(EntryNumber,FieldNumber,"WP"))) +"RTN","TMGXINST",1324,0) + +"RTN","TMGXINST",1325,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"WPHandle") +"RTN","TMGXINST",1326,0) + quit +"RTN","TMGXINST",1327,0) + +"RTN","TMGXINST",1328,0) + +"RTN","TMGXINST",1329,0) +CheckArraySubst(TextArray) +"RTN","TMGXINST",1330,0) + ;"Purpose: Accept a text array, and scan all lines for any needed data substitution +"RTN","TMGXINST",1331,0) + ;"Input: TextArray -- should be passed by reference. +"RTN","TMGXINST",1332,0) + ;" any number scheme of lines may be used. +"RTN","TMGXINST",1333,0) + ;"Output -- Text array is changed, if passed by reference +"RTN","TMGXINST",1334,0) + ;"Result: 1=OK to continue, 0=Error (data requested, but not found) +"RTN","TMGXINST",1335,0) + +"RTN","TMGXINST",1336,0) + new lineI,Count +"RTN","TMGXINST",1337,0) + new OneLine +"RTN","TMGXINST",1338,0) + new result set result=cOKToCont +"RTN","TMGXINST",1339,0) + +"RTN","TMGXINST",1340,0) + if $data(TextArray)'=10 goto CKASq +"RTN","TMGXINST",1341,0) + +"RTN","TMGXINST",1342,0) + set lineI=$Order(TextArray("")) +"RTN","TMGXINST",1343,0) + for do quit:(lineI="")!(result=cAbort) +"RTN","TMGXINST",1344,0) + . set OneLine=TextArray(lineI) +"RTN","TMGXINST",1345,0) + . set result=$$CheckSubstituteData(.OneLine) ;"Do any data lookup needed +"RTN","TMGXINST",1346,0) + . set TextArray(lineI)=OneLine +"RTN","TMGXINST",1347,0) + . set lineI=$Order(TextArray(lineI)) +"RTN","TMGXINST",1348,0) + +"RTN","TMGXINST",1349,0) +CKASq +"RTN","TMGXINST",1350,0) + quit result +"RTN","TMGXINST",1351,0) + +"RTN","TMGXINST",1352,0) +ParamSubstitute(Params) +"RTN","TMGXINST",1353,0) + ;"Purpose: To accept an array of parameters, and do data substitution on all entries +"RTN","TMGXINST",1354,0) + ;"Input: Params: an array of parameters +"RTN","TMGXINST",1355,0) + ;"Result: 1=OK to continue, 0=Error (data requested, but not found) +"RTN","TMGXINST",1356,0) + +"RTN","TMGXINST",1357,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ParamSubstitute") +"RTN","TMGXINST",1358,0) + +"RTN","TMGXINST",1359,0) + new result set result=cAbort +"RTN","TMGXINST",1360,0) + if $data(Params)=0 goto PStDone +"RTN","TMGXINST",1361,0) + new index +"RTN","TMGXINST",1362,0) + +"RTN","TMGXINST",1363,0) + set index=$order(Params("")) +"RTN","TMGXINST",1364,0) + for do quit:(index="")!(result=cAbort) +"RTN","TMGXINST",1365,0) + . if index="" quit +"RTN","TMGXINST",1366,0) + . new s +"RTN","TMGXINST",1367,0) + . if $data(Params(index))#10'=0 do +"RTN","TMGXINST",1368,0) + . . set s=Params(index) +"RTN","TMGXINST",1369,0) + . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at Param(",index,")=",s) +"RTN","TMGXINST",1370,0) + . . set result=$$CheckSubstituteData(.s) +"RTN","TMGXINST",1371,0) + . . if result=cAbort quit +"RTN","TMGXINST",1372,0) + . . set Params(index)=s +"RTN","TMGXINST",1373,0) + . else do +"RTN","TMGXINST",1374,0) + . . new subindex +"RTN","TMGXINST",1375,0) + . . set subindex=$order(Params(index,"")) +"RTN","TMGXINST",1376,0) + . . for do quit:(subindex="")!(result=cAbort) +"RTN","TMGXINST",1377,0) + . . . set s=Params(index,subindex) +"RTN","TMGXINST",1378,0) + . . . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at Param("_index_","_subindex_")=",s) +"RTN","TMGXINST",1379,0) + . . . set result=$$CheckSubstituteData(.s) +"RTN","TMGXINST",1380,0) + . . . if result=cAbort quit +"RTN","TMGXINST",1381,0) + . . . set Params(index)=s +"RTN","TMGXINST",1382,0) + . . . set subindex=$order(Params(index,subindex)) +"RTN","TMGXINST",1383,0) + . set index=$order(Params(index)) +"RTN","TMGXINST",1384,0) + +"RTN","TMGXINST",1385,0) +PStDone +"RTN","TMGXINST",1386,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ParamSubstitute") +"RTN","TMGXINST",1387,0) + quit result +"RTN","TMGXINST",1388,0) + +"RTN","TMGXINST",1389,0) +CheckSubstituteData(Text) +"RTN","TMGXINST",1390,0) + ;"Purpose: To look for data-substitution codes (i.e. {{...}}), and if +"RTN","TMGXINST",1391,0) + ;" found, to replace with data from XML file +"RTN","TMGXINST",1392,0) + ;"Input: A line of text that may or may not have codes. ** Should be passed by reference +"RTN","TMGXINST",1393,0) + ;"Output: Text is modified if passed by reference +"RTN","TMGXINST",1394,0) + ;"Result: 1=OK to continue, 0=Error (data requested, but not found, or error occured) +"RTN","TMGXINST",1395,0) + ;"Note: Nesting is allowed, and all instances of {{...}} will be substituted +"RTN","TMGXINST",1396,0) + +"RTN","TMGXINST",1397,0) + new PartA,PartB,PartC,RefB +"RTN","TMGXINST",1398,0) + new result set result=cOKToCont +"RTN","TMGXINST",1399,0) + +"RTN","TMGXINST",1400,0) + new InitDebug set InitDebug=TMGDEBUG +"RTN","TMGXINST",1401,0) + set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info. +"RTN","TMGXINST",1402,0) + +"RTN","TMGXINST",1403,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"CheckSubstituteData") +"RTN","TMGXINST",1404,0) + +"RTN","TMGXINST",1405,0) +CKSubL1 ;"Check if Code contains a data reference +"RTN","TMGXINST",1406,0) + if $$NestSplit^TMGSTUTL(.Text,cDataOpen,cDataClose,.PartA,.PartB,.PartC)=0 goto CkSubDone +"RTN","TMGXINST",1407,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Reference to data found... replacing now.") +"RTN","TMGXINST",1408,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Initline: '",Text,"'") +"RTN","TMGXINST",1409,0) + +"RTN","TMGXINST",1410,0) + set RefB=$$GetData(PartB) +"RTN","TMGXINST",1411,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looked up data: '",RefB,"'") +"RTN","TMGXINST",1412,0) + if RefB="" do goto CkSubDone +"RTN","TMGXINST",1413,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error. Unable to find data reference: "_PartB) +"RTN","TMGXINST",1414,0) + . set result=cAbort +"RTN","TMGXINST",1415,0) + set Text=PartA_RefB_PartC ;"reassemble new code line +"RTN","TMGXINST",1416,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"After replacement, line='",Text,"'") +"RTN","TMGXINST",1417,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"---------------------") +"RTN","TMGXINST",1418,0) + goto CKSubL1 +"RTN","TMGXINST",1419,0) + +"RTN","TMGXINST",1420,0) +CkSubDone +"RTN","TMGXINST",1421,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"CheckSubstituteData") +"RTN","TMGXINST",1422,0) + set TMGDEBUG=InitDebug +"RTN","TMGXINST",1423,0) + quit result +"RTN","TMGXINST",1424,0) + +"RTN","TMGXINST",1425,0) + +"RTN","TMGXINST",1426,0) +DoJump(Params) +"RTN","TMGXINST",1427,0) + ;"Purpose: To allow limited program flow control +"RTN","TMGXINST",1428,0) + ;"Syntax: e.g. <Jump condition="if State=1" label="C"></Jump> +"RTN","TMGXINST",1429,0) + ;"Input: Params -- an array containg parameters to run +"RTN","TMGXINST",1430,0) + ;" Params(cCondition): M code executed to determine whether to jump +"RTN","TMGXINST",1431,0) + ;" e.g. Params(cCondition)="if State=2" +"RTN","TMGXINST",1432,0) + ;" Params(cLabel): The name of the block to jump to. +"RTN","TMGXINST",1433,0) + ;" Params(cLabel)="TargetLabel" +"RTN","TMGXINST",1434,0) + ;"Note: The expected syntax of the label is: <Label>B</Label> +"RTN","TMGXINST",1435,0) + ;" In this example, the label name is "B" +"RTN","TMGXINST",1436,0) + ;"Returns: If should continue execution: 1=OK to continue. 0=abort. +"RTN","TMGXINST",1437,0) + +"RTN","TMGXINST",1438,0) + new result +"RTN","TMGXINST",1439,0) + set result=cOKToCont +"RTN","TMGXINST",1440,0) + new CondBool set CondBool=1 +"RTN","TMGXINST",1441,0) + +"RTN","TMGXINST",1442,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoJump") +"RTN","TMGXINST",1443,0) + +"RTN","TMGXINST",1444,0) + new CondCode set CondCode=$get(Params(cCondition)) +"RTN","TMGXINST",1445,0) + set result=$$CheckSubstituteData(.CondCode) +"RTN","TMGXINST",1446,0) + if result=cAbort goto DJDone +"RTN","TMGXINST",1447,0) + new Label set Label=$get(Params(cLabel)) +"RTN","TMGXINST",1448,0) + set result=$$CheckSubstituteData(.Label) +"RTN","TMGXINST",1449,0) + if result=cAbort goto DJDone +"RTN","TMGXINST",1450,0) + +"RTN","TMGXINST",1451,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Condition code='"_CondCode_"'") +"RTN","TMGXINST",1452,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Label="_Label) +"RTN","TMGXINST",1453,0) + +"RTN","TMGXINST",1454,0) + ;"Note: Here I trap errors that might be returned from xecute, +"RTN","TMGXINST",1455,0) + ;" and set result=cAbort to cause script abort +"RTN","TMGXINST",1456,0) + if CondCode'="" do +"RTN","TMGXINST",1457,0) + . new $etrap set $etrap="do DoJErrTrap^TMGXINST" +"RTN","TMGXINST",1458,0) + . set ^TMP("TMG",$J,"trap")=cOKToCont +"RTN","TMGXINST",1459,0) + . xecute CondCode +"RTN","TMGXINST",1460,0) + . set CondBool=$TEST +"RTN","TMGXINST",1461,0) + . set result=^TMP("TMG",$J,"trap") +"RTN","TMGXINST",1462,0) + . if result=cAbort do +"RTN","TMGXINST",1463,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing Jump conditional code: \n"_CondCode) +"RTN","TMGXINST",1464,0) + else do +"RTN","TMGXINST",1465,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"No condition code given, so should already have set bool") +"RTN","TMGXINST",1466,0) + +"RTN","TMGXINST",1467,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CondBool",CondBool) +"RTN","TMGXINST",1468,0) + +"RTN","TMGXINST",1469,0) + if (CondBool)&(Label'="")&(result=cOKToCont) do +"RTN","TMGXINST",1470,0) + . set result=$$DoShow(.Params) ;"Show any associated text as a message +"RTN","TMGXINST",1471,0) + . new OldNode set OldNode=ExecNode +"RTN","TMGXINST",1472,0) + . set ExecNode=$$GetLabelNode(Label) +"RTN","TMGXINST",1473,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Changed point of execution from ",OldNode," to ",ExecNode) +"RTN","TMGXINST",1474,0) + . if ExecNode=0 do +"RTN","TMGXINST",1475,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"In Jump instruction, label '"_Label_"' not found.") +"RTN","TMGXINST",1476,0) + . . set result=cAbort ;"i.e. abort +"RTN","TMGXINST",1477,0) + else do +"RTN","TMGXINST",1478,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Jump not done.") +"RTN","TMGXINST",1479,0) + +"RTN","TMGXINST",1480,0) +DJDone +"RTN","TMGXINST",1481,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoJump") +"RTN","TMGXINST",1482,0) + if result=cAbort do ShowError^TMGDEBUG(.PriorErrorFound,"Jump command failed.") +"RTN","TMGXINST",1483,0) + +"RTN","TMGXINST",1484,0) + quit result +"RTN","TMGXINST",1485,0) + +"RTN","TMGXINST",1486,0) + +"RTN","TMGXINST",1487,0) + ;"========================================================= +"RTN","TMGXINST",1488,0) + ;"DoJump Error trap routine +"RTN","TMGXINST",1489,0) + ;"========================================================= +"RTN","TMGXINST",1490,0) +DoJErrTrap +"RTN","TMGXINST",1491,0) + set $etrap="" +"RTN","TMGXINST",1492,0) + set $ecode="" +"RTN","TMGXINST",1493,0) + set ^TMP("TMG",$J,"trap")=cAbort +"RTN","TMGXINST",1494,0) + quit +"RTN","TMGXINST",1495,0) + ;"========================================================= +"RTN","TMGXINST",1496,0) + ;"DoJump End of Error trap routine +"RTN","TMGXINST",1497,0) + ;"========================================================= +"RTN","TMGXINST",1498,0) + +"RTN","TMGXINST",1499,0) + +"RTN","TMGXINST",1500,0) + +"RTN","TMGXINST",1501,0) +GetLabelNode(Label) +"RTN","TMGXINST",1502,0) + ;"Purpose: Scan through <Script> section for a <Label> that matches +"RTN","TMGXINST",1503,0) + ;"Input: Label: the name to search for (case insensitive) +"RTN","TMGXINST",1504,0) + ;"Results: the handle of the node sought, or 0 if not found +"RTN","TMGXINST",1505,0) + +"RTN","TMGXINST",1506,0) + new ChildNode +"RTN","TMGXINST",1507,0) + set ChildNode=0 +"RTN","TMGXINST",1508,0) + +"RTN","TMGXINST",1509,0) +GLNLoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode,ChildNode) +"RTN","TMGXINST",1510,0) + if ChildNode=0 goto GLNQuit +"RTN","TMGXINST",1511,0) + if $$UP^XLFSTR($$Get1NText^TMGXMLT(XMLHandle,ChildNode))=$$UP^XLFSTR(Label) goto GLNQuit +"RTN","TMGXINST",1512,0) + goto GLNLoop +"RTN","TMGXINST",1513,0) + +"RTN","TMGXINST",1514,0) +GLNQuit quit ChildNode +"RTN","TMGXINST",1515,0) + +"RTN","TMGXINST",1516,0) + +"RTN","TMGXINST",1517,0) +GetData(Ref) +"RTN","TMGXINST",1518,0) + ;"Purpose: To get data from the <DATA> section of the XML file +"RTN","TMGXINST",1519,0) + ;"Input: Ref: the refrence path. +"RTN","TMGXINST",1520,0) + ;" e.g. Data.Site.Office[EastSide].Field[OpenDate], +"RTN","TMGXINST",1521,0) + ;" when used with the following data section... +"RTN","TMGXINST",1522,0) + ;" <Data> +"RTN","TMGXINST",1523,0) + ;" <Site> +"RTN","TMGXINST",1524,0) + ;" <Office id="EastSide"> +"RTN","TMGXINST",1525,0) + ;" <Field id="Doctor">Kevin</Field> +"RTN","TMGXINST",1526,0) + ;" <Field id="OpenDate">12/1/04</Field> +"RTN","TMGXINST",1527,0) + ;" </Office> +"RTN","TMGXINST",1528,0) + ;" </Site> +"RTN","TMGXINST",1529,0) + ;" </Data> +"RTN","TMGXINST",1530,0) + ;" will return the value of '12/1/04' +"RTN","TMGXINST",1531,0) + ;" +"RTN","TMGXINST",1532,0) + ;" Alternative acceptible input: +"RTN","TMGXINST",1533,0) + ;" e.g. MVar.SomeVar +"RTN","TMGXINST",1534,0) + ;" This will retrieve the value of variable 'SomeVar' +"RTN","TMGXINST",1535,0) + ;" that is defined in the M language, i.e. a local variable +"RTN","TMGXINST",1536,0) + ;" that might have been set in some M code. +"RTN","TMGXINST",1537,0) + ;" The name for SomeVar is case-specific. +"RTN","TMGXINST",1538,0) + ;" +"RTN","TMGXINST",1539,0) + ;"Note: The first node must be 'Data' or 'MVar' +"RTN","TMGXINST",1540,0) + ;"Returns: the value requested, or "" if not found. +"RTN","TMGXINST",1541,0) + +"RTN","TMGXINST",1542,0) + new result set result="" +"RTN","TMGXINST",1543,0) + +"RTN","TMGXINST",1544,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetData") +"RTN","TMGXINST",1545,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref to search for="_Ref) +"RTN","TMGXINST",1546,0) + +"RTN","TMGXINST",1547,0) + if $data(Ref)=0 goto QGetDat +"RTN","TMGXINST",1548,0) + +"RTN","TMGXINST",1549,0) + new Segment +"RTN","TMGXINST",1550,0) + new SegNode +"RTN","TMGXINST",1551,0) + new ID +"RTN","TMGXINST",1552,0) + +"RTN","TMGXINST",1553,0) + set Segment=$$ParseSeg(.Ref,.ID) +"RTN","TMGXINST",1554,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Segment="_Segment) +"RTN","TMGXINST",1555,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"ID=["_ID_"]") +"RTN","TMGXINST",1556,0) + if $$UP^XLFSTR(Segment)=cData goto GetData1 +"RTN","TMGXINST",1557,0) + if $$UP^XLFSTR(Segment)='cMVar goto QGetDat +"RTN","TMGXINST",1558,0) + +"RTN","TMGXINST",1559,0) + ;"Here we are dealing with {{MVar.SomeVar}} pattern +"RTN","TMGXINST",1560,0) + ;"Get name of variable to access. +"RTN","TMGXINST",1561,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Found request to access M variable: ",ID) +"RTN","TMGXINST",1562,0) + set Segment=$$ParseSeg(.Ref,.ID) ;"ID to be ignored. +"RTN","TMGXINST",1563,0) + set result=$get(@Segment) +"RTN","TMGXINST",1564,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Requested variable: ",Segment,"= '",result,"'") +"RTN","TMGXINST",1565,0) + goto QGetDat +"RTN","TMGXINST",1566,0) + +"RTN","TMGXINST",1567,0) +GetData1 +"RTN","TMGXINST",1568,0) + if $data(DataNode)=0 goto QGetDat ;"Occurs if error box occurs before full XML parse +"RTN","TMGXINST",1569,0) + set SegNode=DataNode +"RTN","TMGXINST",1570,0) +GetData2 +"RTN","TMGXINST",1571,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Getting ready to parse segment....") +"RTN","TMGXINST",1572,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref="_Ref) +"RTN","TMGXINST",1573,0) + set Segment=$$ParseSeg(.Ref,.ID) +"RTN","TMGXINST",1574,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Segment="_Segment) +"RTN","TMGXINST",1575,0) + set SegNode=$$GetDescIDNode(SegNode,Segment,ID) +"RTN","TMGXINST",1576,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"SegNode=#"_SegNode) +"RTN","TMGXINST",1577,0) + if SegNode=0 goto QGetDat +"RTN","TMGXINST",1578,0) + +"RTN","TMGXINST",1579,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"?ready to loop? Ref='"_Ref_"'") +"RTN","TMGXINST",1580,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Ref='' is "_Ref="") +"RTN","TMGXINST",1581,0) + if Ref="" goto QGetDat1 +"RTN","TMGXINST",1582,0) + +"RTN","TMGXINST",1583,0) + goto GetData2 +"RTN","TMGXINST",1584,0) + +"RTN","TMGXINST",1585,0) +QGetDat1 +"RTN","TMGXINST",1586,0) + ;"If we get here, must have found correct node +"RTN","TMGXINST",1587,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Success. data node found. SegNode="_SegNode) +"RTN","TMGXINST",1588,0) + set result=$$Get1NText^TMGXMLT(XMLHandle,SegNode) +"RTN","TMGXINST",1589,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result="_result) +"RTN","TMGXINST",1590,0) + +"RTN","TMGXINST",1591,0) +QGetDat +"RTN","TMGXINST",1592,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetData") +"RTN","TMGXINST",1593,0) + quit result +"RTN","TMGXINST",1594,0) + +"RTN","TMGXINST",1595,0) + +"RTN","TMGXINST",1596,0) +ParseSeg(Ref,ID) +"RTN","TMGXINST",1597,0) + ;"Purpose: to parse a line in the following format +"RTN","TMGXINST",1598,0) + ;" Data.Site.Office[EastSide].Field[OpenDate] +"RTN","TMGXINST",1599,0) + ;" Function will return the next segment (divided +"RTN","TMGXINST",1600,0) + ;" by '.', left-to-right +"RTN","TMGXINST",1601,0) + ;"Input: Ref: Should be passed by reference . text of line, as described above +"RTN","TMGXINST",1602,0) + ;" ID: Should be passed by reference. An OUT parameter (not used for input) +"RTN","TMGXINST",1603,0) + ;"Output: Ref is changed (shortened). When all done, Ref will equal " " +"RTN","TMGXINST",1604,0) + ;" If an ID is found (i.e. 'EastSide' in above example), then ID will +"RTN","TMGXINST",1605,0) + ;" will be set, otherwise " " +"RTN","TMGXINST",1606,0) + ;"Result: The leftmost section, or " " if none found +"RTN","TMGXINST",1607,0) + +"RTN","TMGXINST",1608,0) + new result +"RTN","TMGXINST",1609,0) + set result=" " +"RTN","TMGXINST",1610,0) + set ID=" " +"RTN","TMGXINST",1611,0) + new PartA,PartB,PartC +"RTN","TMGXINST",1612,0) + +"RTN","TMGXINST",1613,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"ParseSeg") +"RTN","TMGXINST",1614,0) + +"RTN","TMGXINST",1615,0) + ;"If no more pieces, just return input +"RTN","TMGXINST",1616,0) + if 'Ref["." do goto Parse2 +"RTN","TMGXINST",1617,0) + . set result=Ref +"RTN","TMGXINST",1618,0) + . set Ref=" " +"RTN","TMGXINST",1619,0) + +"RTN","TMGXINST",1620,0) + set result=$piece(Ref,".",1) +"RTN","TMGXINST",1621,0) + set result=$get(result," ") +"RTN","TMGXINST",1622,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result="_result) +"RTN","TMGXINST",1623,0) + set PartB=$piece(Ref,".",2,100) +"RTN","TMGXINST",1624,0) + set PartB=$get(PartB," ") +"RTN","TMGXINST",1625,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"PartB="_PartB) +"RTN","TMGXINST",1626,0) + set Ref=PartB +"RTN","TMGXINST",1627,0) + +"RTN","TMGXINST",1628,0) +Parse2 ;"If Office[EastSide] pattern found, separate parts +"RTN","TMGXINST",1629,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is result: "_result_" Will now look for '['") +"RTN","TMGXINST",1630,0) + if (result["[")&(result["]") do +"RTN","TMGXINST",1631,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"... found.") +"RTN","TMGXINST",1632,0) + . set PartA=$piece(result,"[",1) +"RTN","TMGXINST",1633,0) + . set PartB=$piece(result,"[",2) +"RTN","TMGXINST",1634,0) + . set PartC=$piece(PartB,"]",1) +"RTN","TMGXINST",1635,0) + . set result=PartA +"RTN","TMGXINST",1636,0) + . set ID=PartC +"RTN","TMGXINST",1637,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Result now ="_result_" ID="_ID) +"RTN","TMGXINST",1638,0) + +"RTN","TMGXINST",1639,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"ParseSeg") +"RTN","TMGXINST",1640,0) + quit result +"RTN","TMGXINST",1641,0) + +"RTN","TMGXINST",1642,0) + +"RTN","TMGXINST",1643,0) +GetDescIDNode(ParentNode,Name,ID) +"RTN","TMGXINST",1644,0) + ;"Purpose: get a descendant node that matches Name and ID +"RTN","TMGXINST",1645,0) + ;"Input: ParentNode node handle of parent +"RTN","TMGXINST",1646,0) + ;" Name is name of node +"RTN","TMGXINST",1647,0) + ;" ID, the ID to match against. ID is an attrib of "id" +"RTN","TMGXINST",1648,0) + ;"e.g. Look for <Field id="Doctor">Kevin</Field> type pattern. +"RTN","TMGXINST",1649,0) + ;" Here, Name='Field', ID='Doctor' +"RTN","TMGXINST",1650,0) + ;"Note: only immediate children (not grandchildren) are searched. +"RTN","TMGXINST",1651,0) + ;"Returns: the handle of the sought node, or 0 if not found. +"RTN","TMGXINST",1652,0) + +"RTN","TMGXINST",1653,0) + new ChildNode +"RTN","TMGXINST",1654,0) + set ChildNode=0 +"RTN","TMGXINST",1655,0) + new NodeName,AtrVal +"RTN","TMGXINST",1656,0) + +"RTN","TMGXINST",1657,0) + new InitDebug set InitDebug=TMGDEBUG +"RTN","TMGXINST",1658,0) + set TMGDEBUG=0 ;"Force this function to not put out TMGDEBUG info. +"RTN","TMGXINST",1659,0) + +"RTN","TMGXINST",1660,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDescIDNode") +"RTN","TMGXINST",1661,0) + +"RTN","TMGXINST",1662,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking for children of node="_ParentNode) +"RTN","TMGXINST",1663,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"with name="_Name_" ID="_ID) +"RTN","TMGXINST",1664,0) + ;"if ID=" " write "ID=space (null)",! +"RTN","TMGXINST",1665,0) + ;"else write "ID is something other than space. ",! +"RTN","TMGXINST",1666,0) + +"RTN","TMGXINST",1667,0) +GDILoop set ChildNode=$$CHILD^MXMLDOM(XMLHandle,ParentNode,ChildNode) +"RTN","TMGXINST",1668,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Looking at child node #"_ChildNode) +"RTN","TMGXINST",1669,0) + ;"if TMGDEBUG>0 do ShowXMLNode(ChildNode) +"RTN","TMGXINST",1670,0) + if ChildNode=0 goto GDIQuit +"RTN","TMGXINST",1671,0) + set NodeName=$$GetNName^TMGXMLT(XMLHandle,ChildNode) ;"Returns result in UPPERCASE +"RTN","TMGXINST",1672,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Name="_NodeName) +"RTN","TMGXINST",1673,0) + if NodeName'=$$UP^XLFSTR(Name) goto GDILoop +"RTN","TMGXINST",1674,0) + if ID=" " goto GDIQuit ;"if no ID specified, then match based on Name only. +"RTN","TMGXINST",1675,0) + set AtrVal=$$GetAtrVal^TMGXMLT(XMLHandle,ChildNode,cId) +"RTN","TMGXINST",1676,0) + set AtrVal=$$UP^XLFSTR(AtrVal) +"RTN","TMGXINST",1677,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Value: ",AtrVal) +"RTN","TMGXINST",1678,0) + if AtrVal'=$$UP^XLFSTR(ID) goto GDILoop +"RTN","TMGXINST",1679,0) + ;"If we get here, we have a match +"RTN","TMGXINST",1680,0) + +"RTN","TMGXINST",1681,0) +GDIQuit +"RTN","TMGXINST",1682,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Success! Node: ",ChildNode) +"RTN","TMGXINST",1683,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDescIDNode") +"RTN","TMGXINST",1684,0) + +"RTN","TMGXINST",1685,0) + set TMGDEBUG=InitDebug +"RTN","TMGXINST",1686,0) + quit ChildNode +"RTN","TMGXINST",1687,0) + +"RTN","TMGXINST",1688,0) + +"RTN","TMGXINST",1689,0) +GetCMDLine(ExecNode,Command,Params) +"RTN","TMGXINST",1690,0) + ;"Purpose: Load elements needed to execute line +"RTN","TMGXINST",1691,0) + ;"Input: ExecNode, the node to be executed... +"RTN","TMGXINST",1692,0) + ;" Other parameters are OUT params... should be passed by reference +"RTN","TMGXINST",1693,0) + ;"Output: Command -- the command of the line +"RTN","TMGXINST",1694,0) + ;" Params -- PASS BY REFERENCE-- to accept back the parameters +"RTN","TMGXINST",1695,0) + ;"Results: 1=if valid info; 0=should NOT be executed (i.e. abort) +"RTN","TMGXINST",1696,0) + +"RTN","TMGXINST",1697,0) + new result set result=cOKToCont +"RTN","TMGXINST",1698,0) + +"RTN","TMGXINST",1699,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetCMDLine") +"RTN","TMGXINST",1700,0) + +"RTN","TMGXINST",1701,0) + set Command=$$GetNName^TMGXMLT(XMLHandle,ExecNode) +"RTN","TMGXINST",1702,0) + set Command=$$UP^XLFSTR(Command) ;"convert to uppercase +"RTN","TMGXINST",1703,0) + +"RTN","TMGXINST",1704,0) + if $data(ProcTable(Command)) goto GCOK +"RTN","TMGXINST",1705,0) + else do goto GCDone +"RTN","TMGXINST",1706,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Command '"_Command_"' is invalid.") +"RTN","TMGXINST",1707,0) + . set result=cAbort +"RTN","TMGXINST",1708,0) + +"RTN","TMGXINST",1709,0) +GCOK +"RTN","TMGXINST",1710,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"CMD Command=",Command) +"RTN","TMGXINST",1711,0) + +"RTN","TMGXINST",1712,0) + new TextArray,ValidText +"RTN","TMGXINST",1713,0) + set ValidText=$$GetNText^TMGXMLT(XMLHandle,ExecNode,.TextArray) +"RTN","TMGXINST",1714,0) + ;"if result=cAbort do goto GCDone +"RTN","TMGXINST",1715,0) + ;". do ShowError^TMGDEBUG(.PriorErrorFound,"Error retrieving text into array.") +"RTN","TMGXINST",1716,0) + if ValidText merge Params(cText)=TextArray +"RTN","TMGXINST",1717,0) + +"RTN","TMGXINST",1718,0) + set result=$$GetParams^TMGXMLT(XMLHandle,ExecNode,.Params) +"RTN","TMGXINST",1719,0) + if result=cAbort do +"RTN","TMGXINST",1720,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error getting parameters") +"RTN","TMGXINST",1721,0) + +"RTN","TMGXINST",1722,0) +GCDone +"RTN","TMGXINST",1723,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetCMDLine") +"RTN","TMGXINST",1724,0) + quit result +"RTN","TMGXINST",1725,0) + +"RTN","TMGXINST",1726,0) + +"RTN","TMGXINST",1727,0) +GetNextCMD(ExecNode) +"RTN","TMGXINST",1728,0) + ;"Purpose: Advance execution point +"RTN","TMGXINST",1729,0) + ;"Input: ExecNode: the current execution point, should be passed by reference +"RTN","TMGXINST",1730,0) + ;"Output: ExecNode is changed +"RTN","TMGXINST",1731,0) + ;" returns 0 if end of program, otherwise positive number (i.e. ExecNode) +"RTN","TMGXINST",1732,0) + +"RTN","TMGXINST",1733,0) + set ExecNode=$$CHILD^MXMLDOM(XMLHandle,ScriptNode,ExecNode) +"RTN","TMGXINST",1734,0) + +"RTN","TMGXINST",1735,0) + quit ExecNode +"RTN","TMGXINST",1736,0) + +"RTN","TMGXINST",1737,0) + +"RTN","TMGXINST",1738,0) +RunScript(ExecNode) +"RTN","TMGXINST",1739,0) + ;"Purpose: To run the entire script +"RTN","TMGXINST",1740,0) + ;"Input: ExecNode, should be passed by reference +"RTN","TMGXINST",1741,0) + ;"Assumptions: That ExecNode points to first line of script. +"RTN","TMGXINST",1742,0) + ;"Result: 1: quit normally. 0=error exit. +"RTN","TMGXINST",1743,0) + +"RTN","TMGXINST",1744,0) + new Command +"RTN","TMGXINST",1745,0) + new Params +"RTN","TMGXINST",1746,0) + new OKToCont set OKToCont=1 ;"1=OK to continue 0=should abort +"RTN","TMGXINST",1747,0) + +"RTN","TMGXINST",1748,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"RunScript") +"RTN","TMGXINST",1749,0) +RunLoop +"RTN","TMGXINST",1750,0) + if ExecNode=0 goto RSDone +"RTN","TMGXINST",1751,0) + +"RTN","TMGXINST",1752,0) + ;"Get current command line information +"RTN","TMGXINST",1753,0) + ;"if TMGDEBUG>0 do ShowXMLNode(ExecNode) +"RTN","TMGXINST",1754,0) + kill Params +"RTN","TMGXINST",1755,0) + +"RTN","TMGXINST",1756,0) + set OKToCont=$$GetCMDLine(ExecNode,.Command,.Params) +"RTN","TMGXINST",1757,0) + if OKToCont=0 do goto RSDone ;"If error, then quit execution. +"RTN","TMGXINST",1758,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error parsing command line.") +"RTN","TMGXINST",1759,0) + . if TMGDEBUG>0 do ShowXMLNode^TMGXMLT(ExecNode) +"RTN","TMGXINST",1760,0) + +"RTN","TMGXINST",1761,0) + set OKToCont=$$CMDProcess(Command,.Params) +"RTN","TMGXINST",1762,0) + if OKToCont=0 do goto RSDone ;"If error, then quit execution. +"RTN","TMGXINST",1763,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error executing command.") +"RTN","TMGXINST",1764,0) + . if TMGDEBUG>0 do ShowXMLNode^TMGXMLT(ExecNode) +"RTN","TMGXINST",1765,0) + +"RTN","TMGXINST",1766,0) + ;"Look for ESC that will cause loop abort +"RTN","TMGXINST",1767,0) + ;"write "#" +"RTN","TMGXINST",1768,0) + read *CheckKey:0 +"RTN","TMGXINST",1769,0) + if CheckKey=27 do goto RSDone +"RTN","TMGXINST",1770,0) + . write !,!,"Escape key pressed. Aborting script.",!,! +"RTN","TMGXINST",1771,0) + +"RTN","TMGXINST",1772,0) + ;"Advance to next command line +"RTN","TMGXINST",1773,0) + set OKToCont=$$GetNextCMD(.ExecNode) +"RTN","TMGXINST",1774,0) + if OKToCont'=0 goto RunLoop +"RTN","TMGXINST",1775,0) + set OKToCont=1 ;"At this point, exit is normal. +"RTN","TMGXINST",1776,0) + +"RTN","TMGXINST",1777,0) +RSDone +"RTN","TMGXINST",1778,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"RunScript") +"RTN","TMGXINST",1779,0) + quit OKToCont +"RTN","TMGXINST",1780,0) + +"RTN","TMGXINST",1781,0) + ;"------------------------------------------------------------------------ +"RTN","TMGXINST",1782,0) + ;"======================================================================== +"RTN","TMGXINST",1783,0) + ;"------------------------------------------------------------------------ +"RTN","TMGXINST",1784,0) +GetDispMode() +"RTN","TMGXINST",1785,0) + ;"Purpose: To determine with form of input user wants +"RTN","TMGXINST",1786,0) + ;"Results: 1=GUI,2=CHUI,3=RollNScroll,0=abort +"RTN","TMGXINST",1787,0) + new Input +"RTN","TMGXINST",1788,0) + new result set result=cAbort +"RTN","TMGXINST",1789,0) + new Default set Default=3 ;"If changed, change(1) below +"RTN","TMGXINST",1790,0) + +"RTN","TMGXINST",1791,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetDispMode") +"RTN","TMGXINST",1792,0) + +"RTN","TMGXINST",1793,0) + write "Select interface option:",! +"RTN","TMGXINST",1794,0) + write " 0. Quit. (Goodbye!)",! +"RTN","TMGXINST",1795,0) + write " 1. Linux X graphics/ 'GUI' (Recommended)",! +"RTN","TMGXINST",1796,0) + write " 2. Text graphics / 'CHUI' (Incomplete)",! +"RTN","TMGXINST",1797,0) + write " 3. Line-by-Line / 'Roll-and-scroll'",! +"RTN","TMGXINST",1798,0) + +"RTN","TMGXINST",1799,0) + write "Enter option number ("_Default_"): " +"RTN","TMGXINST",1800,0) + read Input,! +"RTN","TMGXINST",1801,0) + if Input="" do +"RTN","TMGXINST",1802,0) + . ;"write "Defaulting to: ",Default,! +"RTN","TMGXINST",1803,0) + . set Input=Default +"RTN","TMGXINST",1804,0) + else if +Input>4 do +"RTN","TMGXINST",1805,0) + . set Input=Default +"RTN","TMGXINST",1806,0) + +"RTN","TMGXINST",1807,0) + set result=+Input +"RTN","TMGXINST",1808,0) + if (Input=1)!(Input=2) do +"RTN","TMGXINST",1809,0) + . do SetupConsts^TMGXDLG() +"RTN","TMGXINST",1810,0) + . do SetGUI^TMGXDLG(Input=1) +"RTN","TMGXINST",1811,0) + ;"if Input=2 do goto GIMDone +"RTN","TMGXINST",1812,0) + ;". do SetupConsts^TMGXDLG() +"RTN","TMGXINST",1813,0) + ;". do SetGUI^TMGXDLG(0) +"RTN","TMGXINST",1814,0) + +"RTN","TMGXINST",1815,0) +GIMDone +"RTN","TMGXINST",1816,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Display mode set at: ",result) +"RTN","TMGXINST",1817,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetDispMode") +"RTN","TMGXINST",1818,0) + quit result +"RTN","TMGXINST",1819,0) + +"RTN","TMGXINST",1820,0) + +"RTN","TMGXINST",1821,0) + +"RTN","TMGXINST",1822,0) +DoMsgBox(Params) +"RTN","TMGXINST",1823,0) + ;"Purpose: To provide a method for script users to +"RTN","TMGXINST",1824,0) + ;" show a message box +"RTN","TMGXINST",1825,0) + ;"Input: Params -- an array loaded with needed values: +"RTN","TMGXINST",1826,0) + ;" Params(cHeader): Header text +"RTN","TMGXINST",1827,0) + ;" Params(cText,*): Array containing text +"RTN","TMGXINST",1828,0) + ;" i.e. Params(cText,1)="text of line 1" +"RTN","TMGXINST",1829,0) + ;" i.e. Params(cText,2)="text of line 2" +"RTN","TMGXINST",1830,0) + ;" i.e. Params(cText,3)="text of line 3" +"RTN","TMGXINST",1831,0) + ;" i.e. Params(cText,4)="text of line 4" +"RTN","TMGXINST",1832,0) + ;"Result: 1=ok to continue, 0=abort +"RTN","TMGXINST",1833,0) + +"RTN","TMGXINST",1834,0) + if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"DoMsgBox") +"RTN","TMGXINST",1835,0) + +"RTN","TMGXINST",1836,0) + new Width +"RTN","TMGXINST",1837,0) + new Text,S,PartB,PartB1 +"RTN","TMGXINST",1838,0) + new index,j +"RTN","TMGXINST",1839,0) + new Modal +"RTN","TMGXINST",1840,0) + new result set result=cOKToCont +"RTN","TMGXINST",1841,0) + +"RTN","TMGXINST",1842,0) + if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is a dump of the params") +"RTN","TMGXINST",1843,0) + if TMGDEBUG do ArrayDump^TMGDEBUG("Params") ;"zwr Params(*) +"RTN","TMGXINST",1844,0) + +"RTN","TMGXINST",1845,0) + set Text(0)=$get(Params(cHeader),"Message:") +"RTN","TMGXINST",1846,0) + set Width=$get(Params(cWidth,cUpperCase),0) +"RTN","TMGXINST",1847,0) + set Modal=$get(Params(cModal),cModalMode) +"RTN","TMGXINST",1848,0) + set index=$order(Params(cText,"")) +"RTN","TMGXINST",1849,0) + set j=1 +"RTN","TMGXINST",1850,0) +DMSGLoop +"RTN","TMGXINST",1851,0) + if index="" goto DMSGPast +"RTN","TMGXINST",1852,0) + set S=$get(Params(cText,index)) +"RTN","TMGXINST",1853,0) + set result=$$CheckSubstituteData(.S) +"RTN","TMGXINST",1854,0) + if result=cAbort goto DMSGQuit +"RTN","TMGXINST",1855,0) +DMSG2Loop ;"Load string up into Text array, to pass to PopupArray +"RTN","TMGXINST",1856,0) + if S[cNewLn do +"RTN","TMGXINST",1857,0) + . do CleaveStr^TMGSTUTL(.S,cNewLn,.PartB1) +"RTN","TMGXINST",1858,0) + do SplitStr^TMGSTUTL(.S,(Width-4),.PartB) +"RTN","TMGXINST",1859,0) + set PartB=PartB_PartB1 set PartB1="" +"RTN","TMGXINST",1860,0) + set Text(j)=S +"RTN","TMGXINST",1861,0) + set j=j+1 +"RTN","TMGXINST",1862,0) + if $length(PartB)>0 do goto DMSG2Loop +"RTN","TMGXINST",1863,0) + . set S=PartB +"RTN","TMGXINST",1864,0) + . set PartB="" +"RTN","TMGXINST",1865,0) + +"RTN","TMGXINST",1866,0) + set index=$order(Params(cText,index)) +"RTN","TMGXINST",1867,0) + goto DMSGLoop +"RTN","TMGXINST",1868,0) + +"RTN","TMGXINST",1869,0) +DMSGPast +"RTN","TMGXINST",1870,0) + if TMGDEBUG do +"RTN","TMGXINST",1871,0) + . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(DBIndent,"Here is Text array to send to PopupArray:") +"RTN","TMGXINST",1872,0) + . do ArrayDump^TMGDEBUG("Text") ;"zwr Text(*) +"RTN","TMGXINST",1873,0) + +"RTN","TMGXINST",1874,0) + do PopupArray^TMGUSRIF(2,Width,.Text,Modal) +"RTN","TMGXINST",1875,0) +DMSGQuit +"RTN","TMGXINST",1876,0) + if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"DoMsgBox") +"RTN","TMGXINST",1877,0) + quit result +"RTN","TMGXINST",1878,0) + +"RTN","TMGXINST",1879,0) + +"RTN","TMGXML1") +0^102^B7775128 +"RTN","TMGXML1",1,0) +TMGXML1 ;TMG/kst/XML Exporter -- Testing code ;03/25/06 +"RTN","TMGXML1",2,0) + ;;1.0;TMG-LIB;**1**;07/09/05 +"RTN","TMGXML1",3,0) + +"RTN","TMGXML1",4,0) + ;"This is a test file for working with XML Documents +"RTN","TMGXML1",5,0) +Start ; +"RTN","TMGXML1",6,0) + +"RTN","TMGXML1",7,0) + ;"Kevin Toppenberg, MD 7-9-04 +"RTN","TMGXML1",8,0) + ;"This is a test file for working with XML Documents +"RTN","TMGXML1",9,0) + +"RTN","TMGXML1",10,0) + new Y,PATH,FILE,GBLREF +"RTN","TMGXML1",11,0) + kill ^TMP("KT",$J) +"RTN","TMGXML1",12,0) + +"RTN","TMGXML1",13,0) + set PATH="/home/kdtop" +"RTN","TMGXML1",14,0) + +"RTN","TMGXML1",15,0) + write "-----------------------",! +"RTN","TMGXML1",16,0) + read "Enter Filename:",FILE +"RTN","TMGXML1",17,0) + write ! +"RTN","TMGXML1",18,0) + if FILE="^" quit +"RTN","TMGXML1",19,0) + if FILE="" set FILE="XMLSample#2.xml" write "Using default: ",FILE,! +"RTN","TMGXML1",20,0) + +"RTN","TMGXML1",21,0) + set GBLREF="^TMP(""KT"","_$J_",0)" +"RTN","TMGXML1",22,0) + set Y=$$FTG^%ZISH(PATH,FILE,GBLREF,3) +"RTN","TMGXML1",23,0) + if 'Y write "error opening file.",! quit +"RTN","TMGXML1",24,0) + +"RTN","TMGXML1",25,0) + ;zwr ^TMP("KT",$JOB,*) +"RTN","TMGXML1",26,0) + +"RTN","TMGXML1",27,0) + ;"do EN^MXMLTEST($NAME(^TMP("KT",$J)),"V") +"RTN","TMGXML1",28,0) + +"RTN","TMGXML1",29,0) + write "---------------------------",! +"RTN","TMGXML1",30,0) + write "Part #2",!,! +"RTN","TMGXML1",31,0) + +"RTN","TMGXML1",32,0) + new FileName +"RTN","TMGXML1",33,0) + set FileName=PATH_"/"_FILE +"RTN","TMGXML1",34,0) + ;write "FileName=",FileName,! +"RTN","TMGXML1",35,0) + +"RTN","TMGXML1",36,0) + new FnArray +"RTN","TMGXML1",37,0) + set FnArray="Array of Callback Functions" +"RTN","TMGXML1",38,0) + set FnArray("STARTDOCUMENT")="StartDoc^TMGXML1" +"RTN","TMGXML1",39,0) + set FnArray("ENDDOCUMENT")="EndDoc^TMGXML1" +"RTN","TMGXML1",40,0) + set FnArray("DOCTYPE")="DocType^TMGXML1" +"RTN","TMGXML1",41,0) + set FnArray("STARTELEMENT")="StartElement^TMGXML1" +"RTN","TMGXML1",42,0) + set FnArray("ENDELEMENT")="EndElement^TMGXML1" +"RTN","TMGXML1",43,0) + set FnArray("CHARACTERS")="Chars^TMGXML1" +"RTN","TMGXML1",44,0) + +"RTN","TMGXML1",45,0) + ;write "Here is FnArray",! +"RTN","TMGXML1",46,0) + ;zwr FnArray(*) +"RTN","TMGXML1",47,0) + +"RTN","TMGXML1",48,0) + write "Calling EN^MXMLPRSE",! +"RTN","TMGXML1",49,0) + do EN^MXMLPRSE($NAME(^TMP("KT",$J)),.FnArray) +"RTN","TMGXML1",50,0) + ;do EN^MXMLPRSE(FileName,.FnArray) +"RTN","TMGXML1",51,0) + write "Done calling EN^MXMLPRSE",! +"RTN","TMGXML1",52,0) + +"RTN","TMGXML1",53,0) + write "---------------------------",! +"RTN","TMGXML1",54,0) + write "Part #3",!,! +"RTN","TMGXML1",55,0) + +"RTN","TMGXML1",56,0) + new ParseHandle +"RTN","TMGXML1",57,0) + write "Calling EN^MXMLDOM",! +"RTN","TMGXML1",58,0) + set ParseHandle=$$EN^MXMLDOM($NAME(^TMP("KT",$J)),"V") +"RTN","TMGXML1",59,0) + write "Done calling EN^MXMLDOM",! +"RTN","TMGXML1",60,0) + write "Handle=",ParseHandle,! +"RTN","TMGXML1",61,0) + +"RTN","TMGXML1",62,0) + do ShowNode(1,0) +"RTN","TMGXML1",63,0) + do ListChildren(1,1) +"RTN","TMGXML1",64,0) + +"RTN","TMGXML1",65,0) + +"RTN","TMGXML1",66,0) + do DELETE^MXMLDOM(ParseHandle) +"RTN","TMGXML1",67,0) + +"RTN","TMGXML1",68,0) + kill ^TMP("KT",$J) +"RTN","TMGXML1",69,0) + write "********************",! +"RTN","TMGXML1",70,0) + write "Quiting normally",! +"RTN","TMGXML1",71,0) + +"RTN","TMGXML1",72,0) +QuitLabel quit +"RTN","TMGXML1",73,0) + +"RTN","TMGXML1",74,0) + +"RTN","TMGXML1",75,0) + ;"------------------------------------------------------------- +"RTN","TMGXML1",76,0) + +"RTN","TMGXML1",77,0) +StartDoc +"RTN","TMGXML1",78,0) + write "##Starting Document Processing##",! +"RTN","TMGXML1",79,0) + quit +"RTN","TMGXML1",80,0) + +"RTN","TMGXML1",81,0) +EndDoc +"RTN","TMGXML1",82,0) + write "##End of Document Processing##",! +"RTN","TMGXML1",83,0) + quit +"RTN","TMGXML1",84,0) + +"RTN","TMGXML1",85,0) + +"RTN","TMGXML1",86,0) +DocType(ROOT,PUBID,SYSID) +"RTN","TMGXML1",87,0) + write "Doctype encountered.",! +"RTN","TMGXML1",88,0) + write "ROOT=",ROOT,! +"RTN","TMGXML1",89,0) + write "PUBID=",PUBID,! +"RTN","TMGXML1",90,0) + write "SYSID=",SYSID,! +"RTN","TMGXML1",91,0) + quit +"RTN","TMGXML1",92,0) + +"RTN","TMGXML1",93,0) + +"RTN","TMGXML1",94,0) +StartElement(NAME,ATTRLIST) +"RTN","TMGXML1",95,0) + write "Attrib:" +"RTN","TMGXML1",96,0) + write "Name=",NAME,! +"RTN","TMGXML1",97,0) + if $data(ATTRLIST) do +"RTN","TMGXML1",98,0) + . write "AttrList:" +"RTN","TMGXML1",99,0) + . zwr ATTRLIST +"RTN","TMGXML1",100,0) + quit +"RTN","TMGXML1",101,0) + +"RTN","TMGXML1",102,0) +EndElement(NAME) +"RTN","TMGXML1",103,0) + write "End Attrib:" +"RTN","TMGXML1",104,0) + write NAME,! +"RTN","TMGXML1",105,0) + quit +"RTN","TMGXML1",106,0) + +"RTN","TMGXML1",107,0) +Chars(TEXT) +"RTN","TMGXML1",108,0) + write "TEXT:",TEXT,! +"RTN","TMGXML1",109,0) + quit +"RTN","TMGXML1",110,0) + +"RTN","TMGXML1",111,0) + +"RTN","TMGXML1",112,0) + ;"------------------------------------------------------------- +"RTN","TMGXML1",113,0) + +"RTN","TMGXML1",114,0) +ListChildren(Node,IndentN) +"RTN","TMGXML1",115,0) + new ChildNode +"RTN","TMGXML1",116,0) + set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,0) +"RTN","TMGXML1",117,0) + if ChildNode=0 quit +"RTN","TMGXML1",118,0) + +"RTN","TMGXML1",119,0) + new loop +"RTN","TMGXML1",120,0) + for loop=1:1 do if ChildNode=0 quit +"RTN","TMGXML1",121,0) + . do ShowNode(ChildNode,IndentN) +"RTN","TMGXML1",122,0) + . do ListChildren(ChildNode,IndentN+1) +"RTN","TMGXML1",123,0) + . set ChildNode=$$CHILD^MXMLDOM(ParseHandle,Node,ChildNode) +"RTN","TMGXML1",124,0) + +"RTN","TMGXML1",125,0) + quit +"RTN","TMGXML1",126,0) + +"RTN","TMGXML1",127,0) +ShowNode(Node,IndentN) +"RTN","TMGXML1",128,0) + new NodeText +"RTN","TMGXML1",129,0) + new AttribText +"RTN","TMGXML1",130,0) + +"RTN","TMGXML1",131,0) + do Indent(IndentN) +"RTN","TMGXML1",132,0) + write $$NAME^MXMLDOM(ParseHandle,Node),! +"RTN","TMGXML1",133,0) + if $$CMNT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do +"RTN","TMGXML1",134,0) + . do Indent(IndentN) +"RTN","TMGXML1",135,0) + . write " Comment: ",NodeText(1),! +"RTN","TMGXML1",136,0) + if $$TEXT^MXMLDOM(ParseHandle,Node,$NAME(NodeText)) do +"RTN","TMGXML1",137,0) + . do Indent(IndentN) +"RTN","TMGXML1",138,0) + . write " '",NodeText(1),"'",! +"RTN","TMGXML1",139,0) + set AttribText=$$ATTRIB^MXMLDOM(ParseHandle,Node) +"RTN","TMGXML1",140,0) + if $data(AttribText),AttribText'="" do +"RTN","TMGXML1",141,0) + . do Indent(IndentN) +"RTN","TMGXML1",142,0) + . write " Attrib: ",AttribText,"=" +"RTN","TMGXML1",143,0) + . write $$VALUE^MXMLDOM(ParseHandle,Node,AttribText),! +"RTN","TMGXML1",144,0) + +"RTN","TMGXML1",145,0) + quit +"RTN","TMGXML1",146,0) + +"RTN","TMGXML1",147,0) + +"RTN","TMGXML1",148,0) +Indent(IndentN) +"RTN","TMGXML1",149,0) + for i=1:1:IndentN write " " +"RTN","TMGXML1",150,0) + +"RTN","TMGXMLE2") +0^103^B27375 +"RTN","TMGXMLE2",1,0) +TMGXMLE2 ;TMG/kst/XML Exporter -- Core functionality ;03/25/06 +"RTN","TMGXMLE2",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGXMLE2",3,0) + +"RTN","TMGXMLE2",4,0) + ;"TMG XML EXPORT FUNCTIONS (CORE FUNCTIONALITY) +"RTN","TMGXMLE2",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGXMLE2",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGXMLE2",7,0) + ;"7-12-2005 +"RTN","TMGXMLE2",8,0) + ;"======================================================================= +"RTN","TMGXMLE2",9,0) + ;" API -- Public Functions. +"RTN","TMGXMLE2",10,0) + ;"======================================================================= +"RTN","TMGXMLE2",11,0) + ;"WriteXMLData(pArray,Flags,IndentS) +"RTN","TMGXMLE2",12,0) + ;"Write1File(File,Recs,Flags,IndentS,SavFieldInfo) +"RTN","TMGXMLE2",13,0) + ;"Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo) +"RTN","TMGXMLE2",14,0) + ;"Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo) +"RTN","TMGXMLE2",15,0) + +"RTN","TMGXMLE2",16,0) + ;"======================================================================= +"RTN","TMGXMLE2",17,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGXMLE2",18,0) + ;"======================================================================= +"RTN","TMGXMLE2",19,0) + +"RTN","TMGXMLE2",20,0) + +"RTN","TMGXMLE2",21,0) + ;"======================================================================= +"RTN","TMGXMLE2",22,0) + ;"DEPENDENCIES +"RTN","TMGXMLE2",23,0) + ;" TMGDBAPI,TMGDEBUG,TMGMISC,TMGUSRIF +"RTN","TMGXMLE2",24,0) + ;"======================================================================= +"RTN","TMGXMLE2",25,0) + ;"======================================================================= +"RTN","TMGXMLE2",26,0) + +"RTN","TMGXMLE2",27,0) + ;"The basic format is to be as follows: +"RTN","TMGXMLE2",28,0) + +"RTN","TMGXMLE2",29,0) + ;"Array(File,Record,Field,subRec,SubField...)="" <--- means export this entry to XML +"RTN","TMGXMLE2",30,0) + ;"Array(File,"TEMPLATE",Field) +"RTN","TMGXMLE2",31,0) + ;"Array(File,"TEMPLATE","ORDER",OrderNum)=Field +"RTN","TMGXMLE2",32,0) + ;"Array(File,"TEMPLATE","TAG NAME",FieldNumber)="Custom field name to put in XML file" +"RTN","TMGXMLE2",33,0) + ;"Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data +"RTN","TMGXMLE2",34,0) + ;"Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",35,0) + ;"Array("FLAGS","I")="" I -- output INTERNAL values +"RTN","TMGXMLE2",36,0) + ;"Array("FLAGS","D")="" D -- output the data dictionary +"RTN","TMGXMLE2",37,0) + ;"Array("!DOCTYPE")=MyLabel +"RTN","TMGXMLE2",38,0) + ;"Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL +"RTN","TMGXMLE2",39,0) + ;" +"RTN","TMGXMLE2",40,0) + ;"----------------------------------------------------------------------------------------------- +"RTN","TMGXMLE2",41,0) + ;"Note: File numbers can be replaces with full FILE NAMES, e.g. +"RTN","TMGXMLE2",42,0) + ;" Array("NEW PERSON",1234,.01)="" +"RTN","TMGXMLE2",43,0) + ;" +"RTN","TMGXMLE2",44,0) + ;"Example: For ALL records, output ALL fields, and ALL subfields +"RTN","TMGXMLE2",45,0) + ;" Array(8925,"*")="" <--- this is default if Recs is not specified/passed +"RTN","TMGXMLE2",46,0) + ;" +"RTN","TMGXMLE2",47,0) + ;"Example: to print from: +"RTN","TMGXMLE2",48,0) + ;" file 8925, records 1234,1235,1236,1237 +"RTN","TMGXMLE2",49,0) + ;" file 200, ALL records +"RTN","TMGXMLE2",50,0) + ;" file 22705, records 3,5 +"RTN","TMGXMLE2",51,0) + ;" file 2, ALL records +"RTN","TMGXMLE2",52,0) + ;" +"RTN","TMGXMLE2",53,0) + ;" Array(8925,1234)="" +"RTN","TMGXMLE2",54,0) + ;" Array(8925,1235)="" +"RTN","TMGXMLE2",55,0) + ;" Array(8925,1236)="" +"RTN","TMGXMLE2",56,0) + ;" Array(8925,1237)="" +"RTN","TMGXMLE2",57,0) + ;" Array(200,"*")="" +"RTN","TMGXMLE2",58,0) + ;" Array(22705,3)="" +"RTN","TMGXMLE2",59,0) + ;" Array(22705,5)="" +"RTN","TMGXMLE2",60,0) + ;" Array(2,"*")="" +"RTN","TMGXMLE2",61,0) + ;" +"RTN","TMGXMLE2",62,0) + ;"Example: Output extra info in record node +"RTN","TMGXMLE2",63,0) + ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record +"RTN","TMGXMLE2",64,0) + ;" e.g. --> <Record id=1232 tag="value" tag2="value2"> +"RTN","TMGXMLE2",65,0) + ;" +"RTN","TMGXMLE2",66,0) + ;"Example: For record 1231, output fields .01 and .02 +"RTN","TMGXMLE2",67,0) + ;" For record 1232, output field .01 only +"RTN","TMGXMLE2",68,0) + ;" For record 1234, output field "NAME" only +"RTN","TMGXMLE2",69,0) + ;" For record 1235, output ALL fields +"RTN","TMGXMLE2",70,0) + ;" Array(8925,1231,.01)="" +"RTN","TMGXMLE2",71,0) + ;" Array(8925,1231,.02)="" +"RTN","TMGXMLE2",72,0) + ;" Array(8925,1232,.01)="" +"RTN","TMGXMLE2",73,0) + ;" Array(8925,1234,"NAME")="" +"RTN","TMGXMLE2",74,0) + ;" Array(8925,1235,"*")="" +"RTN","TMGXMLE2",75,0) + ;" +"RTN","TMGXMLE2",76,0) + ;"Example: +"RTN","TMGXMLE2",77,0) + ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925, with fields .01,.02,.03 +"RTN","TMGXMLE2",78,0) + ;" Array(8925,"TEMPLATE",.02)="" +"RTN","TMGXMLE2",79,0) + ;" Array(8925,"TEMPLATE",.03)="" +"RTN","TMGXMLE2",80,0) + ;" Array(8925,1234) <-- print record 1234 (will use the template) +"RTN","TMGXMLE2",81,0) + ;" Array(8925,1235) <-- print record 1235 +"RTN","TMGXMLE2",82,0) + ;" +"RTN","TMGXMLE2",83,0) + ;"Example: +"RTN","TMGXMLE2",84,0) + ;" Array(8925,"TEMPLATE","*"))="" <-- include all fields in template +"RTN","TMGXMLE2",85,0) + ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- but exclude field .04 +"RTN","TMGXMLE2",86,0) + ;" Array(8925,1235) <-- print record 1235, all fields but .04 +"RTN","TMGXMLE2",87,0) + ;" +"RTN","TMGXMLE2",88,0) + ;"Example: For all records, output fields .01 and .02 and "NAME" +"RTN","TMGXMLE2",89,0) + ;" Array(8925,"*",.01)="" +"RTN","TMGXMLE2",90,0) + ;" Array(8925,"*",.02)="" +"RTN","TMGXMLE2",91,0) + ;" Array(8925,"*","NAME")="" +"RTN","TMGXMLE2",92,0) + ;" +"RTN","TMGXMLE2",93,0) + ;"Example: +"RTN","TMGXMLE2",94,0) + ;" Array(8925,1231,"*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted +"RTN","TMGXMLE2",95,0) + ;" +"RTN","TMGXMLE2",96,0) + ;"Example: For all records, output field "ENTRY", which is a multiple. In +"RTN","TMGXMLE2",97,0) + ;" subfile, output all records, fields .01, and .02 +"RTN","TMGXMLE2",98,0) + ;" Array(8925,"*","ENTRY","*",.01)="" +"RTN","TMGXMLE2",99,0) + ;" Array(8925,"*","ENTRY","*",.02)="" +"RTN","TMGXMLE2",100,0) + ;" +"RTN","TMGXMLE2",101,0) + ;"Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions +"RTN","TMGXMLE2",102,0) + ;" Array(8925,"Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output +"RTN","TMGXMLE2",103,0) + ;" Array(8925,"Rec Exclude",1235)="" +"RTN","TMGXMLE2",104,0) + ;" Array(8925,"*")="" +"RTN","TMGXMLE2",105,0) + ;" +"RTN","TMGXMLE2",106,0) + ;"Example: +"RTN","TMGXMLE2",107,0) + ;" Array(8925,"TEMPLATE","Field Exclude",.04)="" <-- don't show field .04 +"RTN","TMGXMLE2",108,0) + ;" Array(8925,"TEMPLATE","Field Exclude","STATE")="" <-- don't show field "STATE" +"RTN","TMGXMLE2",109,0) + ;" Array(8925,1231,"*")="" <-- in record 1231, show all fields but .04 and "STATE" +"RTN","TMGXMLE2",110,0) + ;" +"RTN","TMGXMLE2",111,0) + ;"Example: Field .04 is multiple. ALL sub records and ALL subfields to be written +"RTN","TMGXMLE2",112,0) + ;" Array(8925,1231,.04,"*","*")="" +"RTN","TMGXMLE2",113,0) + ;" Array(8925,1231,.04,"*")="" <--- "*" assumed for subfields +"RTN","TMGXMLE2",114,0) + ;" Array(8925,1231,.04)="" <-- "*" assumed for subrecords and subfields. +"RTN","TMGXMLE2",115,0) + ;" +"RTN","TMGXMLE2",116,0) + ;"Example: Field .03 is multiple. All sub records to be written (except for #5) , and .01 and .02 fields to be written +"RTN","TMGXMLE2",117,0) + ;" Array(8925,1231,.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written +"RTN","TMGXMLE2",118,0) + ;" Array(8925,1231,.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written +"RTN","TMGXMLE2",119,0) + ;" Array(8925,1231,.03,"Rec Exclude",5)="" <-- Exclude subrec 5 +"RTN","TMGXMLE2",120,0) + ;" +"RTN","TMGXMLE2",121,0) + ;"Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written +"RTN","TMGXMLE2",122,0) + ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.01)="" <-- In all sub recs, sub field .01 is to be written +"RTN","TMGXMLE2",123,0) + ;" Array(8925,1231,"TEMPLATE",.03,"*","TEMPLATE",.02)="" <-- In all sub recs, sub field .02 is to be written +"RTN","TMGXMLE2",124,0) + +"RTN","TMGXMLE2",125,0) + ;"Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below +"RTN","TMGXMLE2",126,0) + ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written +"RTN","TMGXMLE2",127,0) + ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written +"RTN","TMGXMLE2",128,0) + ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written +"RTN","TMGXMLE2",129,0) + ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written +"RTN","TMGXMLE2",130,0) + ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt) +"RTN","TMGXMLE2",131,0) + ;" Array(8925,1231,.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception +"RTN","TMGXMLE2",132,0) + ;" Array(8925,1231,.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written. +"RTN","TMGXMLE2",133,0) + ;" +"RTN","TMGXMLE2",134,0) + ;"Example: Shows optional substitution of a new tag name for a given field +"RTN","TMGXMLE2",135,0) + ;" Array(8925,"TEMPLATE","TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field +"RTN","TMGXMLE2",136,0) + ;" Array(8925,"TEMPLATE","TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field +"RTN","TMGXMLE2",137,0) + ;" +"RTN","TMGXMLE2",138,0) + ;"Note: pattern continues for sub-sub-multiples etc. +"RTN","TMGXMLE2",139,0) + ;" +"RTN","TMGXMLE2",140,0) + ;"Example: +"RTN","TMGXMLE2",141,0) + ;" Array(8925,1231,.01)="" +"RTN","TMGXMLE2",142,0) + ;" Array(8925,1231,.02)="" +"RTN","TMGXMLE2",143,0) + ;" Array(8925,1231,"NAME")="" <--- note that field name is allowed in place of number +"RTN","TMGXMLE2",144,0) + ;" Array(8925,1231,.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written +"RTN","TMGXMLE2",145,0) + ;" Array(8925,1231,.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written +"RTN","TMGXMLE2",146,0) + ;" Array(8925,1231,.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written +"RTN","TMGXMLE2",147,0) + ;" Array(8925,1231,.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written +"RTN","TMGXMLE2",148,0) + ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt) +"RTN","TMGXMLE2",149,0) + ;" +"RTN","TMGXMLE2",150,0) + ;"Example: Field .03 is a multiple +"RTN","TMGXMLE2",151,0) + ;" Array(8925,1231,.03,"TEMPLATE",.01)="" +"RTN","TMGXMLE2",152,0) + ;" Array(8925,1231,.03,"TEMPLATE",.02)="" +"RTN","TMGXMLE2",153,0) + ;" Array(8925,1231,.03,1)="" <-- In sub rec 1, export fields .01,.02 from template +"RTN","TMGXMLE2",154,0) + ;" Array(8925,1231,.03,2)="" <-- In sub rec 2, export fields .01,.02 from template +"RTN","TMGXMLE2",155,0) + ;" Array(8925,1231,.03,4)="" <-- In sub rec 4, export fields .01,.02 from template +"RTN","TMGXMLE2",156,0) + ;" +"RTN","TMGXMLE2",157,0) + ;"Example: +"RTN","TMGXMLE2",158,0) + ;" Array(8925,"TEMPLATE","ORDER",1)=.03 <-- 1st field to output +"RTN","TMGXMLE2",159,0) + ;" Array(8925,"TEMPLATE","ORDER",2)=.02 <-- 2nd field to output +"RTN","TMGXMLE2",160,0) + ;" Array(8925,"TEMPLATE","ORDER",3)="NAME" <-- 3rd field to output +"RTN","TMGXMLE2",161,0) + ;" Array(8925,"TEMPLATE","ORDER",4)=.01 <-- 4th field to output +"RTN","TMGXMLE2",162,0) + ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields +"RTN","TMGXMLE2",163,0) + ;" If "ORDER" is specified, only fields with a given order will be output +"RTN","TMGXMLE2",164,0) + ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined +"RTN","TMGXMLE2",165,0) + ;" This will be primarily important for fields that are multiples, with sub recs. +"RTN","TMGXMLE2",166,0) + ;" +"RTN","TMGXMLE2",167,0) + ;"Example: +"RTN","TMGXMLE2",168,0) + ;" Array(8925,"TEMPLATE","TRANSFORM",.01)="write ""Custom .01 output transform M code here...""" +"RTN","TMGXMLE2",169,0) + ;" Array(8925,"TEMPLATE","TRANSFORM",.02)="write ""Custom .02 output transform M code here...""" +"RTN","TMGXMLE2",170,0) + +"RTN","TMGXMLE2",171,0) + +"RTN","TMGXMLE2",172,0) + +"RTN","TMGXMLE2",173,0) +WriteXMLData(pArray,Flags,IndentS,ShowProgress) +"RTN","TMGXMLE2",174,0) + ;"Scope: PUBLIC +"RTN","TMGXMLE2",175,0) + ;"Purpose: to dump out a specified set of files and records in XML Format +"RTN","TMGXMLE2",176,0) + ;"Input: pArray -- pointer to (i.e. name of) array containting formatting/output info. +"RTN","TMGXMLE2",177,0) + ;" REQUIRED An array specifying which files and records to display +"RTN","TMGXMLE2",178,0) + ;" Format as follows: +"RTN","TMGXMLE2",179,0) + ;" ;"----------------------------------------- +"RTN","TMGXMLE2",180,0) + ;" Array(File,IEN,FieldInfo) ; For FieldInfo, see Write1File, and Write1Rec +"RTN","TMGXMLE2",181,0) + ;" Array(File,["TEMPLATE"],...) ;For Template info see function Write1File +"RTN","TMGXMLE2",182,0) + ;" Array("FLAGS","b")="" b -- show tags for ALL fields, even if field has no data +"RTN","TMGXMLE2",183,0) + ;" Array("FLAGS","i")="" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",184,0) + ;" Array("FLAGS","I")="" I -- output INTERNAL values +"RTN","TMGXMLE2",185,0) + ;" Array("FLAGS","D")="" D -- output the data dictionary +"RTN","TMGXMLE2",186,0) + ;" Array("FLAGS","S")="" S -- output export settings. +"RTN","TMGXMLE2",187,0) + ;" Array("!DOCTYPE")=MyLabel +"RTN","TMGXMLE2",188,0) + ;" Array("EXPORT_SYSTEM_NAME")=LabelForExportingSystem -- OPTIONAL +"RTN","TMGXMLE2",189,0) + ;" ;"----------------------------------------- +"RTN","TMGXMLE2",190,0) + ;" +"RTN","TMGXMLE2",191,0) + ;" e.g. Array(8925,1234)="" +"RTN","TMGXMLE2",192,0) + ;" Array(8925,1235)="" +"RTN","TMGXMLE2",193,0) + ;" Array(8925,1236)="" +"RTN","TMGXMLE2",194,0) + ;" Array(8925,1237)="" +"RTN","TMGXMLE2",195,0) + ;" Array(8925,1232)="tag=value^tag2=value2" <-- optional extra info for record +"RTN","TMGXMLE2",196,0) + ;" e.g. --> <Record id=1232 tag="value" tag2="value2"> +"RTN","TMGXMLE2",197,0) + ;" Array(200,"*")="" +"RTN","TMGXMLE2",198,0) + ;" Array(22705,3)="" +"RTN","TMGXMLE2",199,0) + ;" Array(22705,5)="" +"RTN","TMGXMLE2",200,0) + ;" Array(2,"*")="" +"RTN","TMGXMLE2",201,0) + ;" +"RTN","TMGXMLE2",202,0) + ;" This would print from: +"RTN","TMGXMLE2",203,0) + ;" file 8925, records 1234,1235,1236,1237 +"RTN","TMGXMLE2",204,0) + ;" file 200, ALL records +"RTN","TMGXMLE2",205,0) + ;" file 22705, records 3,5 +"RTN","TMGXMLE2",206,0) + ;" file 2, ALL records +"RTN","TMGXMLE2",207,0) + ;" +"RTN","TMGXMLE2",208,0) + ;" Example: +"RTN","TMGXMLE2",209,0) + ;" Array(8925,"TEMPLATE",.01)="" <-- define a template for file 8925 +"RTN","TMGXMLE2",210,0) + ;" Array(8925,"TEMPLATE",.02)="" +"RTN","TMGXMLE2",211,0) + ;" Array(8925,"TEMPLATE",.02)="" +"RTN","TMGXMLE2",212,0) + ;" Array(8925,1234) <-- print record 1234 +"RTN","TMGXMLE2",213,0) + ;" Array(8925,1235) <-- print record 1235 +"RTN","TMGXMLE2",214,0) + ;" +"RTN","TMGXMLE2",215,0) + ;" Example: +"RTN","TMGXMLE2",216,0) + ;" Array(8925,1234) <-- print record 1234 +"RTN","TMGXMLE2",217,0) + ;" Array(8925,1235) <-- print record 1235 +"RTN","TMGXMLE2",218,0) + ;" +"RTN","TMGXMLE2",219,0) + ;" Example: +"RTN","TMGXMLE2",220,0) + ;" Array(8925,1234,.01) <-- print record 1234, only field .01 +"RTN","TMGXMLE2",221,0) + ;" Array(8925,1235,.04) <-- print record 1235, only field .04 +"RTN","TMGXMLE2",222,0) + ;" +"RTN","TMGXMLE2",223,0) + ;" Note: File numbers can be replaces with full FILE NAMES, e.g. +"RTN","TMGXMLE2",224,0) + ;" Array("NEW PERSON","*")="" +"RTN","TMGXMLE2",225,0) + ;" +"RTN","TMGXMLE2",226,0) + ;" Note: All File numbers and field numbers can be replaced with NAMES +"RTN","TMGXMLE2",227,0) + ;" +"RTN","TMGXMLE2",228,0) + ;" Flags -- OPTIONAL (Note Flags can also be specified with a "FLAGS" node) +"RTN","TMGXMLE2",229,0) + ;" b -- show tags for ALL fields, even if field has no data +"RTN","TMGXMLE2",230,0) + ;" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",231,0) + ;" I -- output INTERNAL values +"RTN","TMGXMLE2",232,0) + ;" D -- output Data dictionary +"RTN","TMGXMLE2",233,0) + ;" e.g. Flags="b" or "bi" or "ib" or "iI" etc. +"RTN","TMGXMLE2",234,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",235,0) + ;" IndentS("IncIndent")=IncIndent +"RTN","TMGXMLE2",236,0) + ;" ShowProgress -- OPTIONAL -- if =1, then a progress bar will be shown. +"RTN","TMGXMLE2",237,0) + ;"Output: results are written to the current device. +"RTN","TMGXMLE2",238,0) + ;"result : none +"RTN","TMGXMLE2",239,0) + +"RTN","TMGXMLE2",240,0) + new File,tArray,SavFieldInfo +"RTN","TMGXMLE2",241,0) + merge tArray=@pArray +"RTN","TMGXMLE2",242,0) + set Flags=$get(Flags) +"RTN","TMGXMLE2",243,0) + new IncIndent set IncIndent=$get(IndentS("IncIndent")," ") +"RTN","TMGXMLE2",244,0) + +"RTN","TMGXMLE2",245,0) + if ($data(tArray("FLAGS","b"))>0)&(Flags'["b") set Flags=Flags_"b" +"RTN","TMGXMLE2",246,0) + if ($data(tArray("FLAGS","i"))>0)&(Flags'["i") set Flags=Flags_"i" +"RTN","TMGXMLE2",247,0) + if ($data(tArray("FLAGS","I"))>0)&(Flags'["I") set Flags=Flags_"I" +"RTN","TMGXMLE2",248,0) + if ($data(tArray("FLAGS","D"))>0)&(Flags'["D") set Flags=Flags_"D" +"RTN","TMGXMLE2",249,0) + if ($data(tArray("FLAGS","S"))>0)&(Flags'["S") set Flags=Flags_"S" +"RTN","TMGXMLE2",250,0) + +"RTN","TMGXMLE2",251,0) + do WriteHeader +"RTN","TMGXMLE2",252,0) + write "<!DOCTYPE "_$get(tArray("!DOCTYPE"),"UNDEFINED"),">",! +"RTN","TMGXMLE2",253,0) + new SrcName set SrcName=$get(tArray("EXPORT_SYSTEM_NAME"),"?Unnamed?") +"RTN","TMGXMLE2",254,0) + write "<EXPORT source=""",$$SYMENC^MXMLUTL(SrcName),""">",! +"RTN","TMGXMLE2",255,0) + set IndentS=$get(IndentS)_IncIndent +"RTN","TMGXMLE2",256,0) + if Flags["S" do WriteSettings(.Flags,.IndentS) ;"output writing settings +"RTN","TMGXMLE2",257,0) + +"RTN","TMGXMLE2",258,0) + set File="" +"RTN","TMGXMLE2",259,0) + for set File=$order(tArray(File)) quit:(+File'>0) do +"RTN","TMGXMLE2",260,0) + . new IEN,Template,Recs +"RTN","TMGXMLE2",261,0) + . merge Template=tArray(File,"TEMPLATE") +"RTN","TMGXMLE2",262,0) + . kill tArray(File,"TEMPLATE") +"RTN","TMGXMLE2",263,0) + . merge Recs=tArray(File) +"RTN","TMGXMLE2",264,0) + . set IEN=$order(tArray(File,"")) +"RTN","TMGXMLE2",265,0) + . if IEN'="" do +"RTN","TMGXMLE2",266,0) + . . if $data(TMGXDEBUG) do +"RTN","TMGXMLE2",267,0) + . . . use $P write "Writing file: ",File,! use IO +"RTN","TMGXMLE2",268,0) + . . if IEN="*" do +"RTN","TMGXMLE2",269,0) + . . . do Write1File(File,.Recs,.Flags,.IndentS,.Template,.ShowProgress,,,,,.SavFieldInfo) +"RTN","TMGXMLE2",270,0) + . . else do +"RTN","TMGXMLE2",271,0) + . . . new Recs merge Recs=tArray(File) +"RTN","TMGXMLE2",272,0) + . . . do Write1File(File,.Recs,.Flags,.IndentS,,.ShowProgress,,,,,.SavFieldInfo) +"RTN","TMGXMLE2",273,0) + +"RTN","TMGXMLE2",274,0) + write "</EXPORT>",! +"RTN","TMGXMLE2",275,0) + +"RTN","TMGXMLE2",276,0) + quit +"RTN","TMGXMLE2",277,0) + +"RTN","TMGXMLE2",278,0) + +"RTN","TMGXMLE2",279,0) +WriteHeader +"RTN","TMGXMLE2",280,0) + ;"Scope: PUBLIC +"RTN","TMGXMLE2",281,0) + ;"Purpose: A shell to write out a proper XML header. This should be done prior +"RTN","TMGXMLE2",282,0) + ;" to writing out XML formatted data to a device +"RTN","TMGXMLE2",283,0) + ;"Output: Header is output to current device +"RTN","TMGXMLE2",284,0) + ;"Results: none +"RTN","TMGXMLE2",285,0) + +"RTN","TMGXMLE2",286,0) + new s +"RTN","TMGXMLE2",287,0) + set s=$$XMLHDR^MXMLUTL +"RTN","TMGXMLE2",288,0) + write s,! +"RTN","TMGXMLE2",289,0) + quit +"RTN","TMGXMLE2",290,0) + +"RTN","TMGXMLE2",291,0) + +"RTN","TMGXMLE2",292,0) +Write1File(File,Recs,Flags,IndentS,Template,ShowProgress,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo) +"RTN","TMGXMLE2",293,0) + ;"Scope: PUBLIC +"RTN","TMGXMLE2",294,0) + ;"Purpose: to dump out (in XML) one file, for specified records +"RTN","TMGXMLE2",295,0) + ;"Input: File -- name or number of file to dump +"RTN","TMGXMLE2",296,0) + ;" Recs -- OPTIONAL. PASS BY REFERENCE (default is to write ALL records) +"RTN","TMGXMLE2",297,0) + ;" To specify records to write out, use Recs array with following format: +"RTN","TMGXMLE2",298,0) + ;" ------------------------------------------------------------------- +"RTN","TMGXMLE2",299,0) + ;" Recs(IEN,Field,FieldInfo); (Default for all is "*") +"RTN","TMGXMLE2",300,0) + ;" For format of FieldInfo, see function Write1Rec +"RTN","TMGXMLE2",301,0) + ;" Recs("Rec Exclude",IEN) <-- exclude IEN from output +"RTN","TMGXMLE2",302,0) + ;" ------------------------------------------------------------------- +"RTN","TMGXMLE2",303,0) + ;" Example: +"RTN","TMGXMLE2",304,0) + ;" Recs(1231)="" +"RTN","TMGXMLE2",305,0) + ;" Recs(1232)="" +"RTN","TMGXMLE2",306,0) + ;" Recs(1234)="" this would be used to print records 1231,1232,1234 +"RTN","TMGXMLE2",307,0) + ;" Recs(1232)="tag=value^tag2=value2" <-- optional extra info for record +"RTN","TMGXMLE2",308,0) + ;" e.g. <Record id=1232 tag="value" tag2="value2"> +"RTN","TMGXMLE2",309,0) + ;" +"RTN","TMGXMLE2",310,0) + ;" Example: For ALL records, output ALL fields, and ALL subfields +"RTN","TMGXMLE2",311,0) + ;" Recs("*")="" <--- this is default if Recs is not specified/passed +"RTN","TMGXMLE2",312,0) + ;" Example: For all records, output fields .01 and .02 and "NAME" +"RTN","TMGXMLE2",313,0) + ;" Recs("*",.01)="" +"RTN","TMGXMLE2",314,0) + ;" Recs("*",.02)="" +"RTN","TMGXMLE2",315,0) + ;" Recs("*","NAME")="" +"RTN","TMGXMLE2",316,0) + ;" Example: For record 1231, output fields .01 and .02 +"RTN","TMGXMLE2",317,0) + ;" For record 1232, output field .01 only +"RTN","TMGXMLE2",318,0) + ;" For record 1234, output field "NAME" only +"RTN","TMGXMLE2",319,0) + ;" For record 1235, output ALL fields +"RTN","TMGXMLE2",320,0) + ;" Recs(1231,.01)="" +"RTN","TMGXMLE2",321,0) + ;" Recs(1231,.02)="" +"RTN","TMGXMLE2",322,0) + ;" Recs(1232,.01)="" +"RTN","TMGXMLE2",323,0) + ;" Recs(1234,"NAME")="" +"RTN","TMGXMLE2",324,0) + ;" Recs(1235,"*")="" +"RTN","TMGXMLE2",325,0) + ;" Example: For all records, output field "ENTRY", which is a multiple. In +"RTN","TMGXMLE2",326,0) + ;" subfile, output records .01, and .02 +"RTN","TMGXMLE2",327,0) + ;" Recs("*","ENTRY",.01)="" +"RTN","TMGXMLE2",328,0) + ;" Recs("*","ENTRY",.02)="" +"RTN","TMGXMLE2",329,0) + ;" Example: For ALL records, output ALL fields, and ALL subfields, with 2 exceptions +"RTN","TMGXMLE2",330,0) + ;" Recs("*")="" +"RTN","TMGXMLE2",331,0) + ;" Recs("Rec Exclude",1234)="" <-- All records except 1234 & 1235 will be output +"RTN","TMGXMLE2",332,0) + ;" Recs("Rec Exclude",1235)="" +"RTN","TMGXMLE2",333,0) + ;" Flags -- OPTIONAL +"RTN","TMGXMLE2",334,0) + ;" b -- show tags for ALL fields, even if field has no data +"RTN","TMGXMLE2",335,0) + ;" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",336,0) + ;" I -- output INTERNAL values +"RTN","TMGXMLE2",337,0) + ;" D -- include data dictionary for file. +"RTN","TMGXMLE2",338,0) + ;" S -- output export settings +"RTN","TMGXMLE2",339,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",340,0) + ;" IndentS("IncIndent")=IncIndent +"RTN","TMGXMLE2",341,0) + ;" Template -- OPTIONAL. PASS BY REFERENCE +"RTN","TMGXMLE2",342,0) + ;" This can be used for instances where the same set of fields are desired for +"RTN","TMGXMLE2",343,0) + ;" multiple records. +"RTN","TMGXMLE2",344,0) + ;" Example: +"RTN","TMGXMLE2",345,0) + ;" Recs(1231)="" +"RTN","TMGXMLE2",346,0) + ;" Recs(1232)="" +"RTN","TMGXMLE2",347,0) + ;" Recs(1234)="" +"RTN","TMGXMLE2",348,0) + ;" with Template(.01)="" +"RTN","TMGXMLE2",349,0) + ;" Template(.02)="" +"RTN","TMGXMLE2",350,0) + ;" Is the same as specifying: +"RTN","TMGXMLE2",351,0) + ;" Recs(1231,.01)="" +"RTN","TMGXMLE2",352,0) + ;" Recs(1231,.02)="" +"RTN","TMGXMLE2",353,0) + ;" Recs(1232,.01)="" +"RTN","TMGXMLE2",354,0) + ;" Recs(1232,.02)="" +"RTN","TMGXMLE2",355,0) + ;" Recs(1234,.01)="" +"RTN","TMGXMLE2",356,0) + ;" Recs(1234,.02)="" +"RTN","TMGXMLE2",357,0) + ;" ShowProgress -- OPTIONAL -- if >0, then a progress bar will be shown. +"RTN","TMGXMLE2",358,0) + ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",359,0) + ;" actual starting and ending <record> </record>. e.g. +"RTN","TMGXMLE2",360,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",361,0) + ;" as custom function must accept same parameters as WriteRLabel +"RTN","TMGXMLE2",362,0) + ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",363,0) + ;" actual line of text out. e.g. "WriteFLabel" or +"RTN","TMGXMLE2",364,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",365,0) + ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",366,0) + ;" actual line of text out for WP fields. e.g. "WriteLine" or +"RTN","TMGXMLE2",367,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",368,0) + ;" as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",369,0) + ;" as custom function must accept same parameters as WriteFLabel +"RTN","TMGXMLE2",370,0) + ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",371,0) + ;" actual line of text out for WP fields. If not provided, then +"RTN","TMGXMLE2",372,0) + ;" LWriter will be used instead. +"RTN","TMGXMLE2",373,0) + ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters. +"RTN","TMGXMLE2",374,0) + ;" Function named as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",375,0) + ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about +"RTN","TMGXMLE2",376,0) + ;" fields, so it doesn't have to be done each time (faster) +"RTN","TMGXMLE2",377,0) + ;"Output: results are written to the current device. +"RTN","TMGXMLE2",378,0) + ;"result : none +"RTN","TMGXMLE2",379,0) + +"RTN","TMGXMLE2",380,0) + new ORoot,GRef +"RTN","TMGXMLE2",381,0) + new FileNum,FName +"RTN","TMGXMLE2",382,0) + new prgsCt set prgsCt=0 +"RTN","TMGXMLE2",383,0) + new prgsMax +"RTN","TMGXMLE2",384,0) + +"RTN","TMGXMLE2",385,0) + new IncIndent set IncIndent=$get(IndentS("IncIndent")," ") +"RTN","TMGXMLE2",386,0) + if $data(Template)=0 set Template("*")="" +"RTN","TMGXMLE2",387,0) + new RecsSpecified set RecsSpecified=(($data(Recs)>1)&($data(Recs("*"))=0)) +"RTN","TMGXMLE2",388,0) + new keyin set keyin=32 +"RTN","TMGXMLE2",389,0) + new startTime set startTime=$H +"RTN","TMGXMLE2",390,0) + set RWriter=$get(RWriter,"WriteRLabel") +"RTN","TMGXMLE2",391,0) + set IndentS=$get(IndentS) +"RTN","TMGXMLE2",392,0) + +"RTN","TMGXMLE2",393,0) + set FileNum=+$get(File) +"RTN","TMGXMLE2",394,0) + if FileNum=0 do +"RTN","TMGXMLE2",395,0) + . set FileNum=$$GetFileNum^TMGDBAPI(.File) +"RTN","TMGXMLE2",396,0) + . set FName=File +"RTN","TMGXMLE2",397,0) + else do +"RTN","TMGXMLE2",398,0) + . set FName=$order(^DD(FileNum,0,"NM","")) +"RTN","TMGXMLE2",399,0) + if FileNum=0 do goto WFDone +"RTN","TMGXMLE2",400,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.") +"RTN","TMGXMLE2",401,0) + +"RTN","TMGXMLE2",402,0) + set ORoot=$$GET1^DID(FileNum,"","","GLOBAL NAME") ;" Get global root (Thanks, Don Donati...) +"RTN","TMGXMLE2",403,0) + set GRef=$$CREF^DILF(ORoot) ;" Convert open to closed root +"RTN","TMGXMLE2",404,0) + +"RTN","TMGXMLE2",405,0) + if $get(ShowProgress) do +"RTN","TMGXMLE2",406,0) + . if RecsSpecified do +"RTN","TMGXMLE2",407,0) + . . set prgsMax=$$ListCt^TMGMISC("Recs") +"RTN","TMGXMLE2",408,0) + . else do +"RTN","TMGXMLE2",409,0) + . . set prgsMax=0 +"RTN","TMGXMLE2",410,0) + . . set IEN=$order(@GRef@("")) ;"count ALL records in file. +"RTN","TMGXMLE2",411,0) + . . for do quit:(IEN'>0) +"RTN","TMGXMLE2",412,0) + . . . set IEN=$order(@GRef@(IEN)) +"RTN","TMGXMLE2",413,0) + . . . if +IEN>0 set prgsMax=prgsMax+1 +"RTN","TMGXMLE2",414,0) + +"RTN","TMGXMLE2",415,0) + set Flags=$get(Flags) +"RTN","TMGXMLE2",416,0) + if Flags["i" write IndentS +"RTN","TMGXMLE2",417,0) + write "<FILE id=""",FileNum,""" label=""",$$SYMENC^MXMLUTL(FName),""">",! +"RTN","TMGXMLE2",418,0) + +"RTN","TMGXMLE2",419,0) + if Flags["D" do WriteDD(FileNum,Flags,IndentS_IncIndent) ;"write out data dictionary file +"RTN","TMGXMLE2",420,0) + +"RTN","TMGXMLE2",421,0) + new IndS2 set IndS2=IndentS_IncIndent +"RTN","TMGXMLE2",422,0) + new IEN set IEN=0 +"RTN","TMGXMLE2",423,0) + for do quit:(IEN'>0) +"RTN","TMGXMLE2",424,0) + . if $data(Fields)'>1 set Fields("*")="" +"RTN","TMGXMLE2",425,0) + . if RecsSpecified do +"RTN","TMGXMLE2",426,0) + . . set IEN=$order(Recs(IEN)) ;"Cycle through specified records +"RTN","TMGXMLE2",427,0) + . . new Extra set Extra=$get(Recs(IEN)) +"RTN","TMGXMLE2",428,0) + . . if Extra'="" do ;"parse extra info into IEN array for output +"RTN","TMGXMLE2",429,0) + . . . new s,n,tag,value +"RTN","TMGXMLE2",430,0) + . . . for n=1:1:$length(Extra,"^") do +"RTN","TMGXMLE2",431,0) + . . . . set s=$piece(Extra,"^",n) +"RTN","TMGXMLE2",432,0) + . . . . if s'["=" quit +"RTN","TMGXMLE2",433,0) + . . . . set tag=$piece(s,"=",1) +"RTN","TMGXMLE2",434,0) + . . . . set value=$piece(s,"=",2) +"RTN","TMGXMLE2",435,0) + . . . . set IEN(tag)=value +"RTN","TMGXMLE2",436,0) + . else do +"RTN","TMGXMLE2",437,0) + . . set IEN=$order(@GRef@(IEN)) ;"Cycle through ALL records in file. +"RTN","TMGXMLE2",438,0) + . if (IEN'>0) quit +"RTN","TMGXMLE2",439,0) + . if $data(Recs("Rec Exclude",IEN)) quit ;"skip excluded records +"RTN","TMGXMLE2",440,0) + . new Fields merge Fields=Recs(IEN) +"RTN","TMGXMLE2",441,0) + . if $data(Fields)'>1 merge Fields=Template +"RTN","TMGXMLE2",442,0) + . if $get(Flags)["i" write $get(IndS2) +"RTN","TMGXMLE2",443,0) + . new exFn set exFn="do "_RWriter_"(.IEN,0)" +"RTN","TMGXMLE2",444,0) + . xecute exFn +"RTN","TMGXMLE2",445,0) + . if $data(TMGXDEBUG) do +"RTN","TMGXMLE2",446,0) + . . use $P +"RTN","TMGXMLE2",447,0) + . . write "Writing record: ",IEN," prgsCt=",prgsCt," prgsMax=",prgsMax,! +"RTN","TMGXMLE2",448,0) + . . use IO +"RTN","TMGXMLE2",449,0) + . do Write1Rec(FileNum,IEN,.Fields,.Flags,"","",IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo) +"RTN","TMGXMLE2",450,0) + . if $get(Flags)["i" write $get(IndS2) +"RTN","TMGXMLE2",451,0) + . set exFn="do "_RWriter_"(.IEN,1)" +"RTN","TMGXMLE2",452,0) + . xecute exFn +"RTN","TMGXMLE2",453,0) + . set prgsCt=prgsCt+1 +"RTN","TMGXMLE2",454,0) + . if $get(ShowProgress)&(prgsCt#2=1) do +"RTN","TMGXMLE2",455,0) + . . use $P +"RTN","TMGXMLE2",456,0) + . . do ProgressBar^TMGUSRIF(prgsCt,"Writing "_FName,1,prgsMax,,startTime) +"RTN","TMGXMLE2",457,0) + . . use IO +"RTN","TMGXMLE2",458,0) + . ;"use $P read *keyin use IO +"RTN","TMGXMLE2",459,0) + . if keyin=27 do +"RTN","TMGXMLE2",460,0) + . . new Abort +"RTN","TMGXMLE2",461,0) + . . use $P +"RTN","TMGXMLE2",462,0) + . . write prgsCt," records written so far...",! +"RTN","TMGXMLE2",463,0) + . . write !,"Do you want to abort XML export? NO// " +"RTN","TMGXMLE2",464,0) + . . read Abort:$get(DTIME,3600),! +"RTN","TMGXMLE2",465,0) + . . if Abort="" set Abort="NO" +"RTN","TMGXMLE2",466,0) + . . if "YESyesYes"[Abort set IEN=0 ;"abort signal +"RTN","TMGXMLE2",467,0) + . . write "OK. Continuing...",! +"RTN","TMGXMLE2",468,0) + . . use IO +"RTN","TMGXMLE2",469,0) + +"RTN","TMGXMLE2",470,0) + if $get(Flags)["i" write IndentS +"RTN","TMGXMLE2",471,0) + write "</FILE>",! +"RTN","TMGXMLE2",472,0) + +"RTN","TMGXMLE2",473,0) + if $get(ShowProgress) do +"RTN","TMGXMLE2",474,0) + . use $P +"RTN","TMGXMLE2",475,0) + . do ProgressBar^TMGUSRIF(100,"Writing "_FName,1,100) +"RTN","TMGXMLE2",476,0) + . use IO +"RTN","TMGXMLE2",477,0) + +"RTN","TMGXMLE2",478,0) +WFDone +"RTN","TMGXMLE2",479,0) + quit +"RTN","TMGXMLE2",480,0) + +"RTN","TMGXMLE2",481,0) +WriteSettings(Flags,IndentS) +"RTN","TMGXMLE2",482,0) + ;"Scope: PRIVATE +"RTN","TMGXMLE2",483,0) + ;"Purpose: to output XML output settings. +"RTN","TMGXMLE2",484,0) + ;"Input: Flags -- flags as declared above. Only "i" used here +"RTN","TMGXMLE2",485,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",486,0) + ;" IndentS("IncIndent")=IncIndent +"RTN","TMGXMLE2",487,0) + +"RTN","TMGXMLE2",488,0) + ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL. +"RTN","TMGXMLE2",489,0) + ;"Results: none +"RTN","TMGXMLE2",490,0) + +"RTN","TMGXMLE2",491,0) + set IndentS=$get(IndentS) +"RTN","TMGXMLE2",492,0) + set Flags=$get(Flags) +"RTN","TMGXMLE2",493,0) + new IncIndent set IncIndent=$get(IndentS("IncIndent")," ") +"RTN","TMGXMLE2",494,0) + +"RTN","TMGXMLE2",495,0) + if Flags["i" write IndentS +"RTN","TMGXMLE2",496,0) + write "<ExportSettings>",! +"RTN","TMGXMLE2",497,0) + +"RTN","TMGXMLE2",498,0) + new fArray,fl +"RTN","TMGXMLE2",499,0) + set fArray("i")="Indent_Output" +"RTN","TMGXMLE2",500,0) + set fArray("b")="Output_Blanks" +"RTN","TMGXMLE2",501,0) + set fArray("I")="Output_Internal_Values" +"RTN","TMGXMLE2",502,0) + set fArray("D")="Output_Data_Dictionary" +"RTN","TMGXMLE2",503,0) + +"RTN","TMGXMLE2",504,0) + set fl="" +"RTN","TMGXMLE2",505,0) + for set fl=$order(fArray(fl)) quit:(fl="") do +"RTN","TMGXMLE2",506,0) + . if Flags["i" write IndentS_IncIndent +"RTN","TMGXMLE2",507,0) + . write "<Setting id=""",$$SYMENC^MXMLUTL($get(fArray(fl))),""">" +"RTN","TMGXMLE2",508,0) + . write $select((Flags[fl):"TRUE",1:"FALSE") +"RTN","TMGXMLE2",509,0) + . write "</Setting>",! +"RTN","TMGXMLE2",510,0) + +"RTN","TMGXMLE2",511,0) + if Flags["i" write IndentS +"RTN","TMGXMLE2",512,0) + write "</ExportSettings>",! +"RTN","TMGXMLE2",513,0) + +"RTN","TMGXMLE2",514,0) + quit +"RTN","TMGXMLE2",515,0) + +"RTN","TMGXMLE2",516,0) +WriteDD(FileNum,Flags,IndentS) +"RTN","TMGXMLE2",517,0) + ;"Scope: PRIVATE +"RTN","TMGXMLE2",518,0) + ;"Purpose: to write out data dictionary file, ^DIC,and file Header in XML format +"RTN","TMGXMLE2",519,0) + ;"Input: FileNum -- the file number (not name) of the data dictionary to export +"RTN","TMGXMLE2",520,0) + ;" Flags -- flags as declared above. Only "i" used here +"RTN","TMGXMLE2",521,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",522,0) + ;"NOTE: Uses GLOBAL SCOPED IncIndent variable. But setting this is OPTIONAL. +"RTN","TMGXMLE2",523,0) + ;"Results: none +"RTN","TMGXMLE2",524,0) + +"RTN","TMGXMLE2",525,0) + new ProgressFn +"RTN","TMGXMLE2",526,0) + use $P write ! use IO +"RTN","TMGXMLE2",527,0) + set IncIndent=$get(IncIndent," ") +"RTN","TMGXMLE2",528,0) + +"RTN","TMGXMLE2",529,0) + set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^DD("_FileNum_")"",0,100000,,"""_$H_""") use IO" +"RTN","TMGXMLE2",530,0) + do WriteArray^TMGXMLT($name(^DD(FileNum)),"DataDictionary",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn) +"RTN","TMGXMLE2",531,0) + +"RTN","TMGXMLE2",532,0) + set ProgressFn="use $P do ProgressBar^TMGUSRIF(IncVar,""^(DIC("_FileNum_")"",0,1000000,,"""_$H_""") use IO" +"RTN","TMGXMLE2",533,0) + new DIC ;"Pull just the fileman nodes. ^DIC also contains some full files... +"RTN","TMGXMLE2",534,0) + merge DIC(FileNum,0)=^DIC(FileNum,0) +"RTN","TMGXMLE2",535,0) + merge DIC(FileNum,"%")=^DIC(FileNum,"%") +"RTN","TMGXMLE2",536,0) + merge DIC(FileNum,"%A")=^DIC(FileNum,"%A") +"RTN","TMGXMLE2",537,0) + merge DIC(FileNum,"%D")=^DIC(FileNum,"%D") +"RTN","TMGXMLE2",538,0) + do WriteArray^TMGXMLT("DIC("_FileNum_")","DIC_File",FileNum,.Flags,.IndentS,.IncIndent,.ProgressFn) +"RTN","TMGXMLE2",539,0) + +"RTN","TMGXMLE2",540,0) + do +"RTN","TMGXMLE2",541,0) + . new Ref set Ref=$get(^DIC(FileNum,0,"GL")) +"RTN","TMGXMLE2",542,0) + . set Ref=$$CREF^DILF(Ref) ;" Convert open to closed root +"RTN","TMGXMLE2",543,0) + . if $get(Flags)["i" write IndentS +"RTN","TMGXMLE2",544,0) + . write "<FILE_HEADER id=""",FileNum,""">",! +"RTN","TMGXMLE2",545,0) + . if $get(Flags)["i" write IndentS +"RTN","TMGXMLE2",546,0) + . write $get(@Ref@(0)),! +"RTN","TMGXMLE2",547,0) + . if $get(Flags)["i" write IndentS +"RTN","TMGXMLE2",548,0) + . write "</FILE_HEADER>",! +"RTN","TMGXMLE2",549,0) + +"RTN","TMGXMLE2",550,0) + ;"use $P write ! use IO +"RTN","TMGXMLE2",551,0) + quit +"RTN","TMGXMLE2",552,0) + +"RTN","TMGXMLE2",553,0) + +"RTN","TMGXMLE2",554,0) +Write1Rec(File,IEN,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo) +"RTN","TMGXMLE2",555,0) + ;"Scope: PUBLIC +"RTN","TMGXMLE2",556,0) + ;"Purpose: To dump one record out in XML format +"RTN","TMGXMLE2",557,0) + ;"Input: File -- name or number of file to dump +"RTN","TMGXMLE2",558,0) + ;" IEN -- Record number (IEN) to dump (see also IENS below) +"RTN","TMGXMLE2",559,0) + ;" Fields -- OPTIONAL. PASS BY REFERENCE. Array of fields to write, format at follows +"RTN","TMGXMLE2",560,0) + ;" Fields(Field,[SubRecNums,[SubFields,...]])="" +"RTN","TMGXMLE2",561,0) + ;" Fields(Field,["Rec Exclude",Excluded IEN])="" +"RTN","TMGXMLE2",562,0) + ;" Fields("Field Exclude",ExcludedField)="" <-- OPTIONAL +"RTN","TMGXMLE2",563,0) + ;" Fields("ORDER",OrderNum)=Field <-- OPTIONAL +"RTN","TMGXMLE2",564,0) + ;" Fields("TAG NAME",FieldNumber)="Custom field name to put in XML file" <-- OPTIONAL +"RTN","TMGXMLE2",565,0) + ;" +"RTN","TMGXMLE2",566,0) + ;" Example: +"RTN","TMGXMLE2",567,0) + ;" Fields(.01)="" +"RTN","TMGXMLE2",568,0) + ;" Fields(.02)="" +"RTN","TMGXMLE2",569,0) + ;" Fields("NAME")="" <--- note that field name is allowed in place of number +"RTN","TMGXMLE2",570,0) + ;" Fields(.03)="" +"RTN","TMGXMLE2",571,0) + ;" +"RTN","TMGXMLE2",572,0) + ;" Example: +"RTN","TMGXMLE2",573,0) + ;" Fields("*")="" <--- indicates that ALL fields, ALL subrecs,and ALL subfields are wanted +"RTN","TMGXMLE2",574,0) + ;" +"RTN","TMGXMLE2",575,0) + ;" Example: +"RTN","TMGXMLE2",576,0) + ;" Fields("*")="" +"RTN","TMGXMLE2",577,0) + ;" Fields("Field Exclude",.04)="" <-- don't show field .04 +"RTN","TMGXMLE2",578,0) + ;" Fields("Field Exclude","STATE")="" <-- don't show field "STATE" +"RTN","TMGXMLE2",579,0) + ;" +"RTN","TMGXMLE2",580,0) + ;" Example: Field .04 is multiple. ALL sub records and ALL subfields to be written +"RTN","TMGXMLE2",581,0) + ;" Fields(.04,"*","*")="" +"RTN","TMGXMLE2",582,0) + ;" Fields(.04,"*")="" <--- "*" assumed for subfields +"RTN","TMGXMLE2",583,0) + ;" Fields(.04)="" <-- "*" assumed for subrecords and subfields. +"RTN","TMGXMLE2",584,0) + ;" +"RTN","TMGXMLE2",585,0) + ;" Example: Field .03 is multiple. All sub records to be written, and .01 and .02 fields to be written +"RTN","TMGXMLE2",586,0) + ;" Fields(.03,"*",.01)="" <-- In all sub recs, sub field .01 is to be written +"RTN","TMGXMLE2",587,0) + ;" Fields(.03,"*",.02)="" <-- In all sub recs, sub field .02 is to be written +"RTN","TMGXMLE2",588,0) + ;" Fields(.03,"Rec Exclude",5)="" <-- Exclude subrec 5 +"RTN","TMGXMLE2",589,0) + ;" +"RTN","TMGXMLE2",590,0) + ;" Example: Field .03 is multiple. Sub records 1,2,3 to be written, fields as below +"RTN","TMGXMLE2",591,0) + ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written +"RTN","TMGXMLE2",592,0) + ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written +"RTN","TMGXMLE2",593,0) + ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written +"RTN","TMGXMLE2",594,0) + ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written +"RTN","TMGXMLE2",595,0) + ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt) +"RTN","TMGXMLE2",596,0) + ;" Fields(.03,5,"*")="" <-- In sub rec 5, all sub fields are to be written, with one exception +"RTN","TMGXMLE2",597,0) + ;" Fields(.03,5,"Field Exclude",.01)="" <-- In sub rec 5, sub fields .01 is not to be written. +"RTN","TMGXMLE2",598,0) + ;" +"RTN","TMGXMLE2",599,0) + ;" Example: Shows optional substitution of a new tag name for a given field +"RTN","TMGXMLE2",600,0) + ;" Fields("TAG NAME",.01)="Patent Name" <-- use "Patient Name" instead of field name for .01 field +"RTN","TMGXMLE2",601,0) + ;" Fields("TAG NAME",.02)="City" <-- use "City" instead of field name for .02 field +"RTN","TMGXMLE2",602,0) + ;" +"RTN","TMGXMLE2",603,0) + ;" Example: +"RTN","TMGXMLE2",604,0) + ;" Array("TRANSFORM",.01)="write ""Custom .01 output transform M code here...""" +"RTN","TMGXMLE2",605,0) + ;" Array("TRANSFORM",.02)="write ""Custom .02 output transform M code here...""" +"RTN","TMGXMLE2",606,0) + ;" +"RTN","TMGXMLE2",607,0) + ;" Note: pattern continues for sub-sub-multiples etc. +"RTN","TMGXMLE2",608,0) + ;" +"RTN","TMGXMLE2",609,0) + ;" Example: +"RTN","TMGXMLE2",610,0) + ;" Fields(.01)="" +"RTN","TMGXMLE2",611,0) + ;" Fields(.02)="" +"RTN","TMGXMLE2",612,0) + ;" Fields("NAME")="" <--- note that field name is allowed in place of number +"RTN","TMGXMLE2",613,0) + ;" Fields(.03,1,.01)="" <-- In sub rec 1, sub field .01 is to be written +"RTN","TMGXMLE2",614,0) + ;" Fields(.03,1,.02)="" <-- In sub rec 1, sub field .02 is to be written +"RTN","TMGXMLE2",615,0) + ;" Fields(.03,2,.01)="" <-- In sub rec 2, sub field .01 is to be written +"RTN","TMGXMLE2",616,0) + ;" Fields(.03,3,"*")="" <-- In sub rec 3, all sub fields are to be written +"RTN","TMGXMLE2",617,0) + ;" Fields(.03,4)="" <-- In sub rec 4, all sub fields are to be written (defalt) +"RTN","TMGXMLE2",618,0) + ;" Fields("ORDER",1)=.03 <-- 1st field to output +"RTN","TMGXMLE2",619,0) + ;" Fields("ORDER",2)=.02 <-- 2nd field to output +"RTN","TMGXMLE2",620,0) + ;" Fields("ORDER",3)="NAME" <-- 3rd field to output +"RTN","TMGXMLE2",621,0) + ;" Fields("ORDER",4)=.01 <-- 4th field to output +"RTN","TMGXMLE2",622,0) + ;" Note: Specifying an 'ORDER' is not compatible with specifying "*" fields +"RTN","TMGXMLE2",623,0) + ;" If "ORDER" is specified, only fields with a given order will be output +"RTN","TMGXMLE2",624,0) + ;" Both Field("ORDER",x)=FieldNum *AND* Field(FieldNum)="" should be defined +"RTN","TMGXMLE2",625,0) + ;" This will be primarily important for fields that are multiples, with sub recs. +"RTN","TMGXMLE2",626,0) + ;" +"RTN","TMGXMLE2",627,0) + ;" Flags -- OPTIONAL +"RTN","TMGXMLE2",628,0) + ;" b -- show tags for fields, even if field has no data +"RTN","TMGXMLE2",629,0) + ;" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",630,0) + ;" I -- output INTERNAL values +"RTN","TMGXMLE2",631,0) + ;" SRef -- OPTIONAL (Used only when calling self recursively) +"RTN","TMGXMLE2",632,0) + ;" IENS -- OPTIONAL a standard IENS string +"RTN","TMGXMLE2",633,0) + ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc. +"RTN","TMGXMLE2",634,0) + ;" This is used when calling self recursively, to handle subfiles +"RTN","TMGXMLE2",635,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",636,0) + ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",637,0) + ;" actual starting and ending <record> </record>. e.g. +"RTN","TMGXMLE2",638,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",639,0) + ;" as custom function must accept same parameters as WriteRLabel +"RTN","TMGXMLE2",640,0) + ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",641,0) + ;" actual line of text out. e.g. "WriteFLabel" or +"RTN","TMGXMLE2",642,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",643,0) + ;" as custom function must accept same parameters as WriteFLabel +"RTN","TMGXMLE2",644,0) + ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",645,0) + ;" actual line of text out for fields. e.g. "WriteLine" or +"RTN","TMGXMLE2",646,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",647,0) + ;" as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",648,0) + ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",649,0) + ;" actual line of text out for WP fields. If not provided, then +"RTN","TMGXMLE2",650,0) + ;" LWriter will be used instead. +"RTN","TMGXMLE2",651,0) + ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters. +"RTN","TMGXMLE2",652,0) + ;" Function named as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",653,0) + ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about +"RTN","TMGXMLE2",654,0) + ;" fields, so it doesn't have to be done each time (faster) +"RTN","TMGXMLE2",655,0) + +"RTN","TMGXMLE2",656,0) + ;"Output: Values are written to the current device +"RTN","TMGXMLE2",657,0) + ;"Results: None +"RTN","TMGXMLE2",658,0) + ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!) +"RTN","TMGXMLE2",659,0) + +"RTN","TMGXMLE2",660,0) + new Field,FldType,FieldInfo +"RTN","TMGXMLE2",661,0) + new StoreLoc,Node,Pos +"RTN","TMGXMLE2",662,0) + new IntValue,ORoot,GRef +"RTN","TMGXMLE2",663,0) + new Range,FIRST,LAST +"RTN","TMGXMLE2",664,0) + new SubFile,SRoot,CRoot +"RTN","TMGXMLE2",665,0) + new SubRec,VAL2,Label +"RTN","TMGXMLE2",666,0) + new FileNum +"RTN","TMGXMLE2",667,0) + new IncIndent set IncIndent=" " +"RTN","TMGXMLE2",668,0) + if $data(Fields)<10 set Fields("*")="" +"RTN","TMGXMLE2",669,0) + new AllFields set AllFields=($data(Fields("*"))>0) +"RTN","TMGXMLE2",670,0) + new OrdFields,OrdIndex set OrdFields=0,OrdIndex=0 +"RTN","TMGXMLE2",671,0) + if $order(Fields("ORDER"))>1 set AllFields=0,OrdFields=1 +"RTN","TMGXMLE2",672,0) + +"RTN","TMGXMLE2",673,0) + new LastFileName +"RTN","TMGXMLE2",674,0) + +"RTN","TMGXMLE2",675,0) + set FileNum=+$get(File) +"RTN","TMGXMLE2",676,0) + if FileNum=0 set FileNum=$$GetFileNum^TMGDBAPI(.File) +"RTN","TMGXMLE2",677,0) + if FileNum=0 do goto WRDone +"RTN","TMGXMLE2",678,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Can't convert file '"_$get(File)_", to a number.") +"RTN","TMGXMLE2",679,0) + +"RTN","TMGXMLE2",680,0) + if $get(IENS)="" set IENS=IEN_"," +"RTN","TMGXMLE2",681,0) + +"RTN","TMGXMLE2",682,0) + set Field=0 +"RTN","TMGXMLE2",683,0) + set LastFileName=Field +"RTN","TMGXMLE2",684,0) + +"RTN","TMGXMLE2",685,0) + ;"Ensure all text exclusion fields are converted to numeric ones. +"RTN","TMGXMLE2",686,0) + if $data(Fields("Field Exclude"))>0 do +"RTN","TMGXMLE2",687,0) + . new field +"RTN","TMGXMLE2",688,0) + . set field=$order(Fields("Field Exclude","")) +"RTN","TMGXMLE2",689,0) + . if field'="" for do quit:(field="") +"RTN","TMGXMLE2",690,0) + . . if +field'=field do +"RTN","TMGXMLE2",691,0) + . . . new tempField +"RTN","TMGXMLE2",692,0) + . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field) +"RTN","TMGXMLE2",693,0) + . . . set Fields("Field Exclude",tempField)="" +"RTN","TMGXMLE2",694,0) + . . set field=$order(Fields("Field Exclude",field)) +"RTN","TMGXMLE2",695,0) + +"RTN","TMGXMLE2",696,0) + ;"Ensure all custom tag field names are converted to numeric ones. +"RTN","TMGXMLE2",697,0) + if $data(Fields("TAG NAME"))>0 do +"RTN","TMGXMLE2",698,0) + . new field +"RTN","TMGXMLE2",699,0) + . set field=$order(Fields("TAG NAME","")) +"RTN","TMGXMLE2",700,0) + . if field'="" for do quit:(field="") +"RTN","TMGXMLE2",701,0) + . . if +field'=field do +"RTN","TMGXMLE2",702,0) + . . . new tempField +"RTN","TMGXMLE2",703,0) + . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field) +"RTN","TMGXMLE2",704,0) + . . . set Fields("TAG NAME",tempField)=Fields("TAG NAME",field) +"RTN","TMGXMLE2",705,0) + . . set field=$order(Fields("TAG NAME",field)) +"RTN","TMGXMLE2",706,0) + +"RTN","TMGXMLE2",707,0) + ;"Ensure all custom TRANSFORM field names are converted to numeric ones. +"RTN","TMGXMLE2",708,0) + if $data(Fields("TRANSFORM"))>0 do +"RTN","TMGXMLE2",709,0) + . new field +"RTN","TMGXMLE2",710,0) + . set field=$order(Fields("TRANSFORM","")) +"RTN","TMGXMLE2",711,0) + . if field'="" for do quit:(field="") +"RTN","TMGXMLE2",712,0) + . . if +field'=field do +"RTN","TMGXMLE2",713,0) + . . . new tempField +"RTN","TMGXMLE2",714,0) + . . . set tempField=$$GetNumField^TMGDBAPI(FileNum,field) +"RTN","TMGXMLE2",715,0) + . . . set Fields("TRANSFORM",tempField)=Fields("TRANSFORM",field) +"RTN","TMGXMLE2",716,0) + . . set field=$order(Fields("TRANSFORM",field)) +"RTN","TMGXMLE2",717,0) + +"RTN","TMGXMLE2",718,0) + ;"NOTE: It is ineffecient to call a function for each field. That requires +"RTN","TMGXMLE2",719,0) + ;" the field function to call $$GET1^DIQ. A more effecient way would +"RTN","TMGXMLE2",720,0) + ;" be to call GETS^DIQ to get ALL the field's values at once, and then +"RTN","TMGXMLE2",721,0) + ;" pass the value to the field function. FIX LATER... +"RTN","TMGXMLE2",722,0) + +"RTN","TMGXMLE2",723,0) + for do quit:(+Field'>0) +"RTN","TMGXMLE2",724,0) + . if AllFields do +"RTN","TMGXMLE2",725,0) + . . set Field=$order(^DD(FileNum,Field)) +"RTN","TMGXMLE2",726,0) + . else if OrdFields do quit:(Field="") +"RTN","TMGXMLE2",727,0) + . . set OrdIndex=$order(Fields("ORDER",OrdIndex)) +"RTN","TMGXMLE2",728,0) + . . set Field=$get(Fields("ORDER",OrdIndex)) +"RTN","TMGXMLE2",729,0) + . else do quit:(+Field'>0) +"RTN","TMGXMLE2",730,0) + . . set Field=$order(Fields(LastFileName)) +"RTN","TMGXMLE2",731,0) + . set LastFileName=Field +"RTN","TMGXMLE2",732,0) + . if +Field=0 set Field=$$GetNumField^TMGDBAPI(FileNum,Field) +"RTN","TMGXMLE2",733,0) + . if $data(Fields("Field Exclude",Field))>0 quit +"RTN","TMGXMLE2",734,0) + . if +Field=0 quit +"RTN","TMGXMLE2",735,0) + . do Write1Fld(FileNum,IEN,Field,.Fields,.Flags,.SRef,.IENS,.IndentS,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo) +"RTN","TMGXMLE2",736,0) + +"RTN","TMGXMLE2",737,0) +WRDone +"RTN","TMGXMLE2",738,0) + quit +"RTN","TMGXMLE2",739,0) + +"RTN","TMGXMLE2",740,0) + +"RTN","TMGXMLE2",741,0) +Write1Fld(FileNum,IEN,Field,Fields,Flags,SRef,IENS,IndentS,RWriter,FWriter,LWriter,WPLWriter,SavFieldInfo) +"RTN","TMGXMLE2",742,0) + ;"Scope: PUBLIC +"RTN","TMGXMLE2",743,0) + ;"Purpose: To dump one field out in XML format +"RTN","TMGXMLE2",744,0) + ;"Input: FileNum -- number of file containing field +"RTN","TMGXMLE2",745,0) + ;" IEN -- Record number (IEN) to dump (see also IENS below). Ignored if IENS supplied +"RTN","TMGXMLE2",746,0) + ;" Field -- The field number to write from array below. +"RTN","TMGXMLE2",747,0) + ;" Fields -- The field to write. +"RTN","TMGXMLE2",748,0) + ;" Flags -- OPTIONAL +"RTN","TMGXMLE2",749,0) + ;" b -- show tags for fields, even if field has no data +"RTN","TMGXMLE2",750,0) + ;" i -- indent tags for pretty, but technically useless, file formating. +"RTN","TMGXMLE2",751,0) + ;" I -- output INTERNAL values +"RTN","TMGXMLE2",752,0) + ;" SRef -- OPTIONAL (Used only when calling self recursively) +"RTN","TMGXMLE2",753,0) + ;" IENS -- OPTIONAL a standard IENS string +"RTN","TMGXMLE2",754,0) + ;" e.g. "IEN,parent-IEN,grandparent-IEN," etc. +"RTN","TMGXMLE2",755,0) + ;" This is used when calling self recursively, to handle subfiles +"RTN","TMGXMLE2",756,0) + ;" Late Note: if IENS is supplied, then IEN is ignored +"RTN","TMGXMLE2",757,0) + ;" IndentS -- OPTIONAL -- current string to write to indent line. +"RTN","TMGXMLE2",758,0) + ;" RWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",759,0) + ;" actual starting and ending <record> </record>. e.g. +"RTN","TMGXMLE2",760,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",761,0) + ;" as custom function must accept same parameters as WriteRLabel +"RTN","TMGXMLE2",762,0) + ;" FWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",763,0) + ;" actual line of text out. e.g. "WriteFLabel" or +"RTN","TMGXMLE2",764,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",765,0) + ;" as custom function must accept same parameters as WriteFLabel +"RTN","TMGXMLE2",766,0) + ;" LWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",767,0) + ;" actual line of text out for WP fields. e.g. "WriteLine" or +"RTN","TMGXMLE2",768,0) + ;" "MyCustomFn". Note do NOT include parameters. Function named +"RTN","TMGXMLE2",769,0) + ;" as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",770,0) + ;" WPLWriter -- OPTIONAL -- the name of a custom function to use for writing +"RTN","TMGXMLE2",771,0) + ;" actual line of text out for WP fields. If not provided, then +"RTN","TMGXMLE2",772,0) + ;" LWriter will be used instead. +"RTN","TMGXMLE2",773,0) + ;" e.g. "WriteWPLine" or "MyWPCustomFn". Note do NOT include parameters. +"RTN","TMGXMLE2",774,0) + ;" Function named as custom function must accept same parameters as WriteLine +"RTN","TMGXMLE2",775,0) + ;" SavFieldInfo -- OPTIONAL -- PASS BY REFERENCE. An array to hold lookup values about +"RTN","TMGXMLE2",776,0) + ;" fields, so it doesn't have to be done each time (faster) +"RTN","TMGXMLE2",777,0) + ;"Output: Values are written to the current device +"RTN","TMGXMLE2",778,0) + ;"Results: None +"RTN","TMGXMLE2",779,0) + ;"Note: this code began its life as a function written by Greg Woodhouse (thanks Greg!) +"RTN","TMGXMLE2",780,0) + +"RTN","TMGXMLE2",781,0) + new FldType,Label +"RTN","TMGXMLE2",782,0) + new FieldInfo +"RTN","TMGXMLE2",783,0) + +"RTN","TMGXMLE2",784,0) + if $get(IENS)="" set IENS=IEN_"," +"RTN","TMGXMLE2",785,0) + if +$get(Field)=0 goto W1FDone +"RTN","TMGXMLE2",786,0) + set FWriter=$get(FWriter,"WriteFLabel") +"RTN","TMGXMLE2",787,0) + set RWriter=$get(RWriter,"WriteRLabel") +"RTN","TMGXMLE2",788,0) + set LWriter=$get(LWriter,"WriteLine") +"RTN","TMGXMLE2",789,0) + set WPLWriter=$get(WPLWriter,LWriter) +"RTN","TMGXMLE2",790,0) + set Flags=$get(Flags) +"RTN","TMGXMLE2",791,0) + +"RTN","TMGXMLE2",792,0) + if 1=1 do +"RTN","TMGXMLE2",793,0) + . if $data(SavFieldInfo(FileNum,Field))>0 do +"RTN","TMGXMLE2",794,0) + . . merge FieldInfo=SavFieldInfo(FileNum,Field) +"RTN","TMGXMLE2",795,0) + . else do +"RTN","TMGXMLE2",796,0) + . . do GetFieldInfo^TMGDBAPI(FileNum,Field,"FieldInfo","LABEL") +"RTN","TMGXMLE2",797,0) + . . merge SavFieldInfo(FileNum,Field)=FieldInfo +"RTN","TMGXMLE2",798,0) + else if 1=0 do +"RTN","TMGXMLE2",799,0) + . ;"try to get info directly to speed things up.... FINISH LATER +"RTN","TMGXMLE2",800,0) + . new node set node=$get(^DD(FileNum,Field,0)) +"RTN","TMGXMLE2",801,0) + . set FieldInfo("SPECIFIER")=$piece(node,"^",2) +"RTN","TMGXMLE2",802,0) + . set FieldInfo("LABEL")=$piece(node,"^",1) +"RTN","TMGXMLE2",803,0) + . set FieldInfo("MULTIPLE-VALUED")=(+FieldInfo("SPECIFIER")>0) +"RTN","TMGXMLE2",804,0) + . if FieldInfo("SPECIFIER")["W" set FieldInfo("TYPE")="WORD-PROCESSING" +"RTN","TMGXMLE2",805,0) + . else if FieldInfo("SPECIFIER")["D" set FieldInfo("TYPE")="DATE" +"RTN","TMGXMLE2",806,0) + . else if FieldInfo("SPECIFIER")["F" set FieldInfo("TYPE")="FREE TEXT" +"RTN","TMGXMLE2",807,0) + . else if FieldInfo("SPECIFIER")["P" set FieldInfo("TYPE")="POINTER" +"RTN","TMGXMLE2",808,0) + . else if FieldInfo("SPECIFIER")["N" set FieldInfo("TYPE")="NUMERIC" +"RTN","TMGXMLE2",809,0) + . else if FieldInfo("SPECIFIER")["S" set FieldInfo("TYPE")="SET" +"RTN","TMGXMLE2",810,0) + . else set FieldInfo("TYPE")=FieldInfo("SPECIFIER") +"RTN","TMGXMLE2",811,0) + +"RTN","TMGXMLE2",812,0) + set FldType=FieldInfo("SPECIFIER") +"RTN","TMGXMLE2",813,0) + if $data(Fields("TAG NAME",Field))#10>1 set Label=Fields("TAG NAME",Field) +"RTN","TMGXMLE2",814,0) + else set Label=FieldInfo("LABEL") +"RTN","TMGXMLE2",815,0) + +"RTN","TMGXMLE2",816,0) + if $get(FieldInfo("MULTIPLE-VALUED"))=1 do +"RTN","TMGXMLE2",817,0) + . if $get(FieldInfo("TYPE"))="WORD-PROCESSING" do +"RTN","TMGXMLE2",818,0) + . . new TMGWP,TMGMsg,result +"RTN","TMGXMLE2",819,0) + . . set result=$$ReadWP^TMGDBAPI(FileNum,IENS,Field,.TMGWP) +"RTN","TMGXMLE2",820,0) + . . if result=1 do +"RTN","TMGXMLE2",821,0) + . . . new i set i=$order(TMGWP("")) +"RTN","TMGXMLE2",822,0) + . . . if i="" quit +"RTN","TMGXMLE2",823,0) + . . . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",824,0) + . . . new exFn set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)" +"RTN","TMGXMLE2",825,0) + . . . xecute exFn +"RTN","TMGXMLE2",826,0) + . . . write ! ;"so first <LINE> will be on a separate line +"RTN","TMGXMLE2",827,0) + . . . for do quit:(i="") +"RTN","TMGXMLE2",828,0) + . . . . new line set line=$get(TMGWP(i)) +"RTN","TMGXMLE2",829,0) + . . . . if Flags["i" write $get(IndentS)_IncIndent +"RTN","TMGXMLE2",830,0) + . . . . if +"RTN","TMGXMLE2",831,0) + . . . . set exFn="do "_WPLWriter_"("""_$$QtProtect^TMGSTUTL(line)_""")" +"RTN","TMGXMLE2",832,0) + . . . . xecute exFn +"RTN","TMGXMLE2",833,0) + . . . . set i=$order(TMGWP(i)) +"RTN","TMGXMLE2",834,0) + . . . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",835,0) + . . . set exFn="do "_FWriter_"(Label,"""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)" +"RTN","TMGXMLE2",836,0) + . . . xecute exFn +"RTN","TMGXMLE2",837,0) + . else do ;"Other multiple (subfile) +"RTN","TMGXMLE2",838,0) + . . set SubFile=+FldType +"RTN","TMGXMLE2",839,0) + . . new AllSubRecs,tempField +"RTN","TMGXMLE2",840,0) + . . new ORoot,Node +"RTN","TMGXMLE2",841,0) + . . if $get(SRef)'="" set ORoot=SRef +"RTN","TMGXMLE2",842,0) + . . else set ORoot=$get(^DIC(FileNum,0,"GL")) +"RTN","TMGXMLE2",843,0) + . . if ORoot="" quit +"RTN","TMGXMLE2",844,0) + . . if AllFields set tempField="*" +"RTN","TMGXMLE2",845,0) + . . else set tempField=LastFileName +"RTN","TMGXMLE2",846,0) + . . set AllSubRecs=($data(Fields(tempField,"*"))>0)!($order(Fields(tempField,""))="") +"RTN","TMGXMLE2",847,0) + . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1) +"RTN","TMGXMLE2",848,0) + . . if Node="" quit ;"skip computed fields +"RTN","TMGXMLE2",849,0) + . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes +"RTN","TMGXMLE2",850,0) + . . set SRoot=ORoot_IEN_","_Node_"," ;"open root +"RTN","TMGXMLE2",851,0) + . . set CRoot=ORoot_IEN_","_Node_")" ;"closed root +"RTN","TMGXMLE2",852,0) + . . set SubRec=$order(@CRoot@(0)) +"RTN","TMGXMLE2",853,0) + . . if (SubRec'="")!(Flags["b") do +"RTN","TMGXMLE2",854,0) + . . . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",855,0) + . . . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)" +"RTN","TMGXMLE2",856,0) + . . . xecute exFn +"RTN","TMGXMLE2",857,0) + . . . write ! +"RTN","TMGXMLE2",858,0) + . . . new IndS2 set IndS2=$get(IndentS)_IncIndent +"RTN","TMGXMLE2",859,0) + . . . if +SubRec>0 for do quit:+SubRec'>0 +"RTN","TMGXMLE2",860,0) + . . . . ;"descend into subfile (if allowed subrecord #) +"RTN","TMGXMLE2",861,0) + . . . . if (AllSubRecs)!($data(Fields(tempField,SubRec))>0) do +"RTN","TMGXMLE2",862,0) + . . . . . if $data(Fields(tempField,"Rec Exclude",SubRec))>0 quit +"RTN","TMGXMLE2",863,0) + . . . . . new SubIENS,SubFields,tempSR +"RTN","TMGXMLE2",864,0) + . . . . . if AllSubRecs set tempSR="*" +"RTN","TMGXMLE2",865,0) + . . . . . else set tempSR=SubRec +"RTN","TMGXMLE2",866,0) + . . . . . set SubIENS=SubRec_","_IENS +"RTN","TMGXMLE2",867,0) + . . . . . merge SubFields=Fields(tempField,tempSR) +"RTN","TMGXMLE2",868,0) + . . . . . if (AllFields)!($data(SubFields)=0) set SubFields("*")="" +"RTN","TMGXMLE2",869,0) + . . . . . if Flags["i" write $get(IndS2) +"RTN","TMGXMLE2",870,0) + . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",0)" +"RTN","TMGXMLE2",871,0) + . . . . . xecute exFn +"RTN","TMGXMLE2",872,0) + . . . . . do Write1Rec(SubFile,SubRec,.SubFields,Flags,SRoot,SubIENS,IndS2_IncIndent,.RWriter,.FWriter,.LWriter,.WPLWriter,.SavFieldInfo) +"RTN","TMGXMLE2",873,0) + . . . . . if Flags["i" write $get(IndS2) +"RTN","TMGXMLE2",874,0) + . . . . . new exFn set exFn="do "_RWriter_"("_$$QtProtect^TMGSTUTL(SubRec)_",1)" +"RTN","TMGXMLE2",875,0) + . . . . . xecute exFn +"RTN","TMGXMLE2",876,0) + . . . . set SubRec=$order(@CRoot@(SubRec)) +"RTN","TMGXMLE2",877,0) + . . . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",878,0) + . . . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)" +"RTN","TMGXMLE2",879,0) + . . . xecute exFn +"RTN","TMGXMLE2",880,0) + else do ;"the usual case here... +"RTN","TMGXMLE2",881,0) + . new line set line="" +"RTN","TMGXMLE2",882,0) + . new CustXForm set CustXForm=$get(Fields("TRANSFORM",Field)) +"RTN","TMGXMLE2",883,0) + . if CustXForm'="" do +"RTN","TMGXMLE2",884,0) + . . new Pos,GRef,Node +"RTN","TMGXMLE2",885,0) + . . new FILE,FIELD,X,Y +"RTN","TMGXMLE2",886,0) + . . new IntValue set IntValue="" +"RTN","TMGXMLE2",887,0) + . . if $get(SRef)'="" set ORoot=SRef +"RTN","TMGXMLE2",888,0) + . . else set ORoot=$get(^DIC(FileNum,0,"GL")) +"RTN","TMGXMLE2",889,0) + . . if ORoot="" quit +"RTN","TMGXMLE2",890,0) + . . set Node=$piece($get(FieldInfo("StoreLoc")),";",1) +"RTN","TMGXMLE2",891,0) + . . if Node="" quit ;"skip computed fields +"RTN","TMGXMLE2",892,0) + . . if (+Node'=Node) set Node=""""_Node_"""" ;" enclose text indices with quotes +"RTN","TMGXMLE2",893,0) + . . set Pos=$piece($get(FieldInfo("StoreLoc")),";",2) +"RTN","TMGXMLE2",894,0) + . . set GRef=ORoot_IEN_","_Node_")" +"RTN","TMGXMLE2",895,0) + . . if +Pos>0 set IntValue=$piece($get(@GRef),"^",Pos) +"RTN","TMGXMLE2",896,0) + . . ;"Set up variables for use by transform code +"RTN","TMGXMLE2",897,0) + . . set FILE=FileNum +"RTN","TMGXMLE2",898,0) + . . set FIELD=+Field +"RTN","TMGXMLE2",899,0) + . . set X=IntValue +"RTN","TMGXMLE2",900,0) + . . set Y="" +"RTN","TMGXMLE2",901,0) + . . new $etrap set $etrap="set Y=""(Invalid custom transform M code!. Error Trapped.)"" set $etrap="""",$ecode=""""" +"RTN","TMGXMLE2",902,0) + . . xecute CustXForm +"RTN","TMGXMLE2",903,0) + . . set line=Y +"RTN","TMGXMLE2",904,0) + . else do +"RTN","TMGXMLE2",905,0) + . . new GetFlag set GetFlag="" +"RTN","TMGXMLE2",906,0) + . . if Flags["I" set GetFlag="I" +"RTN","TMGXMLE2",907,0) + . . set line=$$GET1^DIQ(FileNum,IENS,Field,GetFlag) +"RTN","TMGXMLE2",908,0) + . if (line="")&(Flags'["b") quit +"RTN","TMGXMLE2",909,0) + . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",910,0) + . new exFn set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",0)" +"RTN","TMGXMLE2",911,0) + . xecute exFn +"RTN","TMGXMLE2",912,0) + . set exFn="do "_LWriter_"(.line)" +"RTN","TMGXMLE2",913,0) + . xecute exFn ;"write line +"RTN","TMGXMLE2",914,0) + . if Flags["i" write $get(IndentS) +"RTN","TMGXMLE2",915,0) + . set exFn="do "_FWriter_"("""_$$QtProtect^TMGSTUTL(Label)_""","""_$$QtProtect^TMGSTUTL(Field)_""","""_FieldInfo("TYPE")_""",1)" +"RTN","TMGXMLE2",916,0) + . xecute exFn +"RTN","TMGXMLE2",917,0) + +"RTN","TMGXMLE2",918,0) +W1FDone +"RTN","TMGXMLE2",919,0) + quit +"RTN","TMGXMLE2",920,0) + +"RTN","TMGXMLE2",921,0) + +"RTN","TMGXMLE2",922,0) + +"RTN","TMGXMLE2",923,0) +WriteRLabel(IEN,Ender) +"RTN","TMGXMLE2",924,0) + ;"Purpose: To actually write out labels for record starting and ending. +"RTN","TMGXMLE2",925,0) + ;" IEN -- the IEN (record number) of the record +"RTN","TMGXMLE2",926,0) + ;" Optional extra informat: +"RTN","TMGXMLE2",927,0) + ;" IEN(tag)=value +"RTN","TMGXMLE2",928,0) + ;" IEN(tag2)=value2 +"RTN","TMGXMLE2",929,0) + ;" If provided, will be added to output as follows: +"RTN","TMGXMLE2",930,0) + ;" <Record id="IEN" tag="value" tag2="value2"> +"RTN","TMGXMLE2",931,0) + ;" Ender -- OPTIONAL if 1, then ends field. +"RTN","TMGXMLE2",932,0) + ;"Results: none. +"RTN","TMGXMLE2",933,0) + ;"Note: This is a separate function so that a different callback function can replace it +"RTN","TMGXMLE2",934,0) + +"RTN","TMGXMLE2",935,0) + if +$get(Ender)>0 write "</Record>",! +"RTN","TMGXMLE2",936,0) + else do +"RTN","TMGXMLE2",937,0) + . write "<Record id=""",IEN,""" " +"RTN","TMGXMLE2",938,0) + . new tag set tag="" +"RTN","TMGXMLE2",939,0) + . for set tag=$order(IEN(tag)) quit:(tag="") do +"RTN","TMGXMLE2",940,0) + . . write tag,"=""",$get(IEN(tag)),""" " +"RTN","TMGXMLE2",941,0) + . write ">",! +"RTN","TMGXMLE2",942,0) + +"RTN","TMGXMLE2",943,0) + quit +"RTN","TMGXMLE2",944,0) + +"RTN","TMGXMLE2",945,0) +WriteFLabel(Label,Field,Type,Ender) +"RTN","TMGXMLE2",946,0) + ;"Purpose: This is the code that actually does writing of labels etc for output +"RTN","TMGXMLE2",947,0) + ;"Input: Label -- OPTIONAL -- Name of label, to write after 'label=' +"RTN","TMGXMLE2",948,0) + ;" Field -- OPTIONAL -- Name of field, to write after 'id=' +"RTN","TMGXMLE2",949,0) + ;" Type -- OPTIONAL -- Typeof field, to write after 'type=' +"RTN","TMGXMLE2",950,0) + ;" Ender -- OPTIONAL if 1, then ends field. +"RTN","TMGXMLE2",951,0) + ;"Results: none. +"RTN","TMGXMLE2",952,0) + ;"Note: This is a separate function so that a different callback function can replace it +"RTN","TMGXMLE2",953,0) + +"RTN","TMGXMLE2",954,0) + ;"To write out <Field label="NAME" id=".01" type="FREE TEXT"> or </Field> +"RTN","TMGXMLE2",955,0) + +"RTN","TMGXMLE2",956,0) + if +$get(Ender)>0 do +"RTN","TMGXMLE2",957,0) + . write "</Field>",! +"RTN","TMGXMLE2",958,0) + else do +"RTN","TMGXMLE2",959,0) + . write "<Field " +"RTN","TMGXMLE2",960,0) + . if $get(Field)'="" write "id=""",$$SYMENC^MXMLUTL(Field),""" " +"RTN","TMGXMLE2",961,0) + . if $get(Label)'="" write "label=""",$$SYMENC^MXMLUTL(Label),""" " +"RTN","TMGXMLE2",962,0) + . if $get(Type)'="" write "type=""",$$SYMENC^MXMLUTL(Type),""" " +"RTN","TMGXMLE2",963,0) + . write ">" +"RTN","TMGXMLE2",964,0) + +"RTN","TMGXMLE2",965,0) + quit +"RTN","TMGXMLE2",966,0) + +"RTN","TMGXMLE2",967,0) +WriteLine(Line) +"RTN","TMGXMLE2",968,0) + ;"Purpose: This is the code that actually does writing of labels etc for output +"RTN","TMGXMLE2",969,0) + ;"Input: Line -- the line of text to write out. +"RTN","TMGXMLE2",970,0) + ;"Results: none +"RTN","TMGXMLE2",971,0) + ;"Note: This is a separate function so that a different callback function can replace it +"RTN","TMGXMLE2",972,0) + +"RTN","TMGXMLE2",973,0) + set Line=$$SYMENC^MXMLUTL(Line) +"RTN","TMGXMLE2",974,0) + write "<LINE>",Line,"</LINE>",! +"RTN","TMGXMLE2",975,0) + quit +"RTN","TMGXMLE2",976,0) + +"RTN","TMGXMLE2",977,0) + +"RTN","TMGXMLE2",978,0) +ConvertLabel(Label) +"RTN","TMGXMLE2",979,0) + ;"Note: This function is no longer being used... +"RTN","TMGXMLE2",980,0) + +"RTN","TMGXMLE2",981,0) + ;"To convert the XML tag into an acceptible format for XML +"RTN","TMGXMLE2",982,0) + ;" +"RTN","TMGXMLE2",983,0) + new i +"RTN","TMGXMLE2",984,0) + new result set result="" +"RTN","TMGXMLE2",985,0) + +"RTN","TMGXMLE2",986,0) + for i=1:1:$length(Label) do +"RTN","TMGXMLE2",987,0) + . new ch set ch=$ascii($extract(Label,i)) +"RTN","TMGXMLE2",988,0) + . if ((ch>64)&(ch<91))!((ch>96)&(ch<123)) do quit +"RTN","TMGXMLE2",989,0) + . . set result=result_$char(ch) +"RTN","TMGXMLE2",990,0) + . if (ch=32) set result=result_"_" +"RTN","TMGXMLE2",991,0) + . else do +"RTN","TMGXMLE2",992,0) + . . set result=result_"x" +"RTN","TMGXMLE2",993,0) + +"RTN","TMGXMLE2",994,0) + quit result +"RTN","TMGXMLE2",995,0) + +"RTN","TMGXMLEX") +0^104^B11237 +"RTN","TMGXMLEX",1,0) +TMGXMLEX ;TMG/kst/XML Exporter ;03/25/06 +"RTN","TMGXMLEX",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGXMLEX",3,0) + +"RTN","TMGXMLEX",4,0) + ;"TMG XML EXPORT FUNCTION +"RTN","TMGXMLEX",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGXMLEX",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGXMLEX",7,0) + ;"7-12-2005 +"RTN","TMGXMLEX",8,0) + +"RTN","TMGXMLEX",9,0) + ;"======================================================================= +"RTN","TMGXMLEX",10,0) + ;" API -- Public Functions. +"RTN","TMGXMLEX",11,0) + ;"======================================================================= +"RTN","TMGXMLEX",12,0) + +"RTN","TMGXMLEX",13,0) + ;"======================================================================= +"RTN","TMGXMLEX",14,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGXMLEX",15,0) + ;"======================================================================= +"RTN","TMGXMLEX",16,0) + +"RTN","TMGXMLEX",17,0) + ;"======================================================================= +"RTN","TMGXMLEX",18,0) + ;"Dependencies (duplicates shown in parenthesies) +"RTN","TMGXMLEX",19,0) + ;"TMGXMLUI +"RTN","TMGXMLEX",20,0) + ;"--XLFSTR +"RTN","TMGXMLEX",21,0) + ;"--TMGDBAPI +"RTN","TMGXMLEX",22,0) + ;"----TMGDEBUG +"RTN","TMGXMLEX",23,0) + ;"------TMGUSRIF +"RTN","TMGXMLEX",24,0) + ;"--------(TMGDEBUG) +"RTN","TMGXMLEX",25,0) + ;"--------TMGSTUTL +"RTN","TMGXMLEX",26,0) + ;"----------(TMGDEBUG) +"RTN","TMGXMLEX",27,0) + ;"--------TMGXDLG +"RTN","TMGXMLEX",28,0) + ;"----(TMGUSRIF) +"RTN","TMGXMLEX",29,0) + ;"----(TMGSTUTL) +"RTN","TMGXMLEX",30,0) + ;"--(TMGDEBUG) +"RTN","TMGXMLEX",31,0) + ;"-- TMGMISC +"RTN","TMGXMLEX",32,0) + ;"----(TMGDBAPI) +"RTN","TMGXMLEX",33,0) + ;"----TMGIOUTL +"RTN","TMGXMLEX",34,0) + ;"----(TMGDEBUG) +"RTN","TMGXMLEX",35,0) + ;"----(TMGSTUTL) +"RTN","TMGXMLEX",36,0) + ;"TMGXMLE2 +"RTN","TMGXMLEX",37,0) + ;"--(TMGDBAPI) +"RTN","TMGXMLEX",38,0) + ;"--(TMGDEBUG) +"RTN","TMGXMLEX",39,0) + ;"--(TMGMISC) +"RTN","TMGXMLEX",40,0) + ;"--(TMGUSRIF) +"RTN","TMGXMLEX",41,0) + ;"TMGIOUTL +"RTN","TMGXMLEX",42,0) + ;"--(TMGUSRIF) +"RTN","TMGXMLEX",43,0) + ;"--(TMGDEBUG) +"RTN","TMGXMLEX",44,0) + ;"--(TMGSTUTL) +"RTN","TMGXMLEX",45,0) + ;"--(TMGMISC) +"RTN","TMGXMLEX",46,0) + +"RTN","TMGXMLEX",47,0) + +"RTN","TMGXMLEX",48,0) + ;"TMGDEBUG +"RTN","TMGXMLEX",49,0) + ;"======================================================================= +"RTN","TMGXMLEX",50,0) + ;"======================================================================= +"RTN","TMGXMLEX",51,0) + +"RTN","TMGXMLEX",52,0) + +"RTN","TMGXMLEX",53,0) +EXPORT +"RTN","TMGXMLEX",54,0) + ;"Purpose: To ask for parameters, select output, and do actual export +"RTN","TMGXMLEX",55,0) + +"RTN","TMGXMLEX",56,0) + new XMLarray +"RTN","TMGXMLEX",57,0) + new pArray set pArray=$name(XMLarray) +"RTN","TMGXMLEX",58,0) + new fileName,PriorErrorFound +"RTN","TMGXMLEX",59,0) + +"RTN","TMGXMLEX",60,0) + if $$UI^TMGXMLUI(pArray)=0 goto ExDone +"RTN","TMGXMLEX",61,0) + +"RTN","TMGXMLEX",62,0) + if (1=0) do if fileName="" do goto ExDone +"RTN","TMGXMLEX",63,0) + . write "Please select an output file for the XML export",! +"RTN","TMGXMLEX",64,0) + . set fileName=$$GetFName^TMGIOUTL() +"RTN","TMGXMLEX",65,0) + . ;"Here I need to select IO channel +"RTN","TMGXMLEX",66,0) + . if fileName="" quit +"RTN","TMGXMLEX",67,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"No file selected, so aborting.") +"RTN","TMGXMLEX",68,0) + . set %ZIS("HFSNAME")=fileName +"RTN","TMGXMLEX",69,0) + . set %ZIS="Q" ;"queing allowed +"RTN","TMGXMLEX",70,0) + . set %ZIS("HFSMODE")="W" ;"write mode +"RTN","TMGXMLEX",71,0) + . set IOP="HFS" +"RTN","TMGXMLEX",72,0) + else do +"RTN","TMGXMLEX",73,0) + . write "Select device to output XML data to.",! +"RTN","TMGXMLEX",74,0) + . write "HFS (i.e. Host File System) will allow output to a file.",! +"RTN","TMGXMLEX",75,0) + . write "(A file name will be asked after HFS is chosen)." +"RTN","TMGXMLEX",76,0) + . set %ZIS("A")="Enter Output Device: " +"RTN","TMGXMLEX",77,0) + . set %ZIS("B")="HFS" +"RTN","TMGXMLEX",78,0) + +"RTN","TMGXMLEX",79,0) + do ^%ZIS ;"standard device call +"RTN","TMGXMLEX",80,0) + if POP do goto ExDone +"RTN","TMGXMLEX",81,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error opening output file. Aborting.") +"RTN","TMGXMLEX",82,0) + use IO +"RTN","TMGXMLEX",83,0) + +"RTN","TMGXMLEX",84,0) + do WriteXMLData^TMGXMLE2(pArray,,,1) +"RTN","TMGXMLEX",85,0) + do ^%ZISC ;" Close the output device +"RTN","TMGXMLEX",86,0) + +"RTN","TMGXMLEX",87,0) + write !,"(Data written to ouput file)",! +"RTN","TMGXMLEX",88,0) + +"RTN","TMGXMLEX",89,0) +ExDone +"RTN","TMGXMLEX",90,0) + kill TMGXDEBUG +"RTN","TMGXMLEX",91,0) + write !,"Leaving XML Exporter. Goodbye.",! +"RTN","TMGXMLEX",92,0) + quit +"RTN","TMGXMLUI") +0^105^B8350 +"RTN","TMGXMLUI",1,0) +TMGXMLUI ;TMG/kst/XML Exporter -- User Interface ;03/25/06 +"RTN","TMGXMLUI",2,0) + ;;1.0;TMG-LIB;**1**;07/12/05 +"RTN","TMGXMLUI",3,0) + +"RTN","TMGXMLUI",4,0) + ;"TMG XML EXPORT -- USER INTERFACE FUNCTIONS +"RTN","TMGXMLUI",5,0) + ;"Kevin Toppenberg MD +"RTN","TMGXMLUI",6,0) + ;"GNU General Public License (GPL) applies +"RTN","TMGXMLUI",7,0) + ;"7-12-2005 +"RTN","TMGXMLUI",8,0) + +"RTN","TMGXMLUI",9,0) + ;"======================================================================= +"RTN","TMGXMLUI",10,0) + ;" API -- Public Functions. +"RTN","TMGXMLUI",11,0) + ;"======================================================================= +"RTN","TMGXMLUI",12,0) + ;"UI +"RTN","TMGXMLUI",13,0) + +"RTN","TMGXMLUI",14,0) + ;"======================================================================= +"RTN","TMGXMLUI",15,0) + ;"PRIVATE API FUNCTIONS +"RTN","TMGXMLUI",16,0) + ;"======================================================================= +"RTN","TMGXMLUI",17,0) + ;"Welcome() +"RTN","TMGXMLUI",18,0) + ;"ProcessFile(pArray,indent) +"RTN","TMGXMLUI",19,0) + ;"GetRecs(File,pRecs,indent) +"RTN","TMGXMLUI",20,0) + ;"GetTemplateRecs(File,pRecs,s) +"RTN","TMGXMLUI",21,0) + ;"GetManualRecs(File,pRecs,s) +"RTN","TMGXMLUI",22,0) + ;"GetFields(File,pArray,indent) +"RTN","TMGXMLUI",23,0) + ;"GetManFields(File,pArray,s) +"RTN","TMGXMLUI",24,0) + ;"AskCustomTag(File,field,pArray,indent) +"RTN","TMGXMLUI",25,0) + ;"AskCustTransform(File,field,pArray,indent) +"RTN","TMGXMLUI",26,0) + ;"$$FMGetField(FileNumber) +"RTN","TMGXMLUI",27,0) + ;"$$AskGetField(FileNumber,indent) +"RTN","TMGXMLUI",28,0) + ;"$$PickUnselField(FileNumber,pArray,indent) +"RTN","TMGXMLUI",29,0) + ;"CfgOrderFields(File,pArray) +"RTN","TMGXMLUI",30,0) + ;"ShowArray(indent) +"RTN","TMGXMLUI",31,0) + ;"Pause +"RTN","TMGXMLUI",32,0) + ;"WriteHeader(pHeader) +"RTN","TMGXMLUI",33,0) + ;"HdrAddLine(pHeader,Line) +"RTN","TMGXMLUI",34,0) + ;"HdrDelLine(pHeader,index) +"RTN","TMGXMLUI",35,0) + ;"Spaces(Num) +"RTN","TMGXMLUI",36,0) + +"RTN","TMGXMLUI",37,0) + ;"======================================================================= +"RTN","TMGXMLUI",38,0) + ;"Dependencies +"RTN","TMGXMLUI",39,0) + ;"XLFSTR +"RTN","TMGXMLUI",40,0) + ;"TMGDBAPI, TMGDEBUG, TMGMISC +"RTN","TMGXMLUI",41,0) + ;"======================================================================= +"RTN","TMGXMLUI",42,0) + ;"======================================================================= +"RTN","TMGXMLUI",43,0) + +"RTN","TMGXMLUI",44,0) + +"RTN","TMGXMLUI",45,0) +UI(pArray) +"RTN","TMGXMLUI",46,0) + ;"Purpose: To create a User Interface (UI) for creating array needed to +"RTN","TMGXMLUI",47,0) + ;" export XML data from Fileman. +"RTN","TMGXMLUI",48,0) + ;"Input: pArray -- pointer to (i.e. name of) array to put data into +"RTN","TMGXMLUI",49,0) + ;"Output: values will be put into pArray. See TMGXMLEX for format +"RTN","TMGXMLUI",50,0) + ;"Result: 1 if OK to continue, 0 if error or abort +"RTN","TMGXMLUI",51,0) + +"RTN","TMGXMLUI",52,0) + new result set result=1 +"RTN","TMGXMLUI",53,0) + +"RTN","TMGXMLUI",54,0) + if $data(IOF)=0 do goto UIDone +"RTN","TMGXMLUI",55,0) + . write "This function requires the VistA environment to be setup first.",! +"RTN","TMGXMLUI",56,0) + . write "Terminating. This may be achieved via DO ^XUP, then dropping",! +"RTN","TMGXMLUI",57,0) + . write "back to the command line and trying to run this again.",! +"RTN","TMGXMLUI",58,0) + . set result=0 +"RTN","TMGXMLUI",59,0) + +"RTN","TMGXMLUI",60,0) + new done set done=0 +"RTN","TMGXMLUI",61,0) + new HeaderArray +"RTN","TMGXMLUI",62,0) + new pHeader set pHeader="HeaderArray" +"RTN","TMGXMLUI",63,0) + set pArray=$get(pArray,"TMGArray") +"RTN","TMGXMLUI",64,0) + new TMGxmlArray set TMGxmlArray=pArray +"RTN","TMGXMLUI",65,0) + new indent set indent=0 +"RTN","TMGXMLUI",66,0) + new TabInc set TabInc=5 +"RTN","TMGXMLUI",67,0) + +"RTN","TMGXMLUI",68,0) + do HdrAddLine(pHeader," XML Export Assistant.") +"RTN","TMGXMLUI",69,0) + do HdrAddLine(pHeader,"=========================") +"RTN","TMGXMLUI",70,0) + +"RTN","TMGXMLUI",71,0) + set result=$$Welcome +"RTN","TMGXMLUI",72,0) + if result=0 goto UIDone +"RTN","TMGXMLUI",73,0) + set result=$$ProcessFile(pArray,indent+TabInc) +"RTN","TMGXMLUI",74,0) + if result=0 goto UIDone +"RTN","TMGXMLUI",75,0) + +"RTN","TMGXMLUI",76,0) +UIDone +"RTN","TMGXMLUI",77,0) + quit result +"RTN","TMGXMLUI",78,0) + +"RTN","TMGXMLUI",79,0) + +"RTN","TMGXMLUI",80,0) +Welcome() +"RTN","TMGXMLUI",81,0) + ;"Purpose: Decribe the wizard +"RTN","TMGXMLUI",82,0) + ;"Input: none +"RTN","TMGXMLUI",83,0) + ;"Result: 1 if OK to continue. 0 if user abort requested. +"RTN","TMGXMLUI",84,0) + ;"Note: uses global pHeader +"RTN","TMGXMLUI",85,0) + +"RTN","TMGXMLUI",86,0) + new result set result=1 +"RTN","TMGXMLUI",87,0) + do WriteHeader(pHeader) +"RTN","TMGXMLUI",88,0) + write "Welcome. I'll walk you through the process",! +"RTN","TMGXMLUI",89,0) + write "of choosing the data you wish to export to an ",! +"RTN","TMGXMLUI",90,0) + write "XML file.",!! +"RTN","TMGXMLUI",91,0) + write "Overview of planned steps:",! +"RTN","TMGXMLUI",92,0) + write "Step 1. Pick 1st Fileman file to export.",! +"RTN","TMGXMLUI",93,0) + write "Step 2. Pick records in file to export.",! +"RTN","TMGXMLUI",94,0) + write "Step 3. Pick fields in records to export.",! +"RTN","TMGXMLUI",95,0) + write "Step 4. Pick 2nd Fileman file to export.",! +"RTN","TMGXMLUI",96,0) + write " ... repeat cycle until done.",!! +"RTN","TMGXMLUI",97,0) + write "To back out, enter '^' at any prompt.",!! +"RTN","TMGXMLUI",98,0) +WcLoop +"RTN","TMGXMLUI",99,0) + write "Are you ready to begin? (Y/N/^) YES//" +"RTN","TMGXMLUI",100,0) + new input +"RTN","TMGXMLUI",101,0) + read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",102,0) + if $TEST=0 set input="N" +"RTN","TMGXMLUI",103,0) + if input="" set input="Y" +"RTN","TMGXMLUI",104,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGXMLUI",105,0) + if (input'["Y")!(input["^") do goto WcmDone +"RTN","TMGXMLUI",106,0) + . ;"write "Goodbye.",! +"RTN","TMGXMLUI",107,0) + . set result=0 +"RTN","TMGXMLUI",108,0) + if (input["?") do goto WcLoop +"RTN","TMGXMLUI",109,0) + . write " Enter Y or YES to continue.",! +"RTN","TMGXMLUI",110,0) + . write " Enter N or No or ^ to exit.",!! +"RTN","TMGXMLUI",111,0) + . do Pause() +"RTN","TMGXMLUI",112,0) + +"RTN","TMGXMLUI",113,0) +WcmDone +"RTN","TMGXMLUI",114,0) + quit result +"RTN","TMGXMLUI",115,0) + +"RTN","TMGXMLUI",116,0) + +"RTN","TMGXMLUI",117,0) +ProcessFile(pArray,indent) +"RTN","TMGXMLUI",118,0) + ;"Purpose: To add export options for one file, or edit previous choices +"RTN","TMGXMLUI",119,0) + ;"Input: pArray -- pointer to (i.e. name of) array to fill with info. +"RTN","TMGXMLUI",120,0) + ;" indent -- amount to indent from left margin +"RTN","TMGXMLUI",121,0) + ;"Output: Array will be filled with data in appropriate format (See docs in TMGXMLEX.m) +"RTN","TMGXMLUI",122,0) + ;"Result: 1 if OK to continue, 0 if aborted +"RTN","TMGXMLUI",123,0) + ;"note: uses global variable pHeader,TabInc +"RTN","TMGXMLUI",124,0) + +"RTN","TMGXMLUI",125,0) + new DIC,File +"RTN","TMGXMLUI",126,0) + new Y set Y=0 +"RTN","TMGXMLUI",127,0) + new ref +"RTN","TMGXMLUI",128,0) + new result set result=1 +"RTN","TMGXMLUI",129,0) + new Records +"RTN","TMGXMLUI",130,0) + if $get(pArray)="" set result=0 goto SUFDone +"RTN","TMGXMLUI",131,0) + +"RTN","TMGXMLUI",132,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Step 1. Pick a FILE for export to XML.") +"RTN","TMGXMLUI",133,0) + +"RTN","TMGXMLUI",134,0) + new Another set Another=0 +"RTN","TMGXMLUI",135,0) + for do quit:(+Y'>0)!(result=0) +"RTN","TMGXMLUI",136,0) + . do WriteHeader(pHeader,1) +"RTN","TMGXMLUI",137,0) + . if Another do quit:(result=0)!(Y'>0) +"RTN","TMGXMLUI",138,0) + . . write !,?indent,"Add another file for export? (Y/N/^) NO//" +"RTN","TMGXMLUI",139,0) + . . new input read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",140,0) + . . if input="^" set Y=0,result=0 quit +"RTN","TMGXMLUI",141,0) + . . if input="" set input="N" +"RTN","TMGXMLUI",142,0) + . . set input=$$UP^XLFSTR(input) +"RTN","TMGXMLUI",143,0) + . . if input'["Y" set Y=0 quit ;"signal to quit +"RTN","TMGXMLUI",144,0) + . . set Y=1 +"RTN","TMGXMLUI",145,0) + . set DIC=1 +"RTN","TMGXMLUI",146,0) + . set DIC(0)="AEQ" +"RTN","TMGXMLUI",147,0) + . set DIC("A")=$$Spaces(indent)_"Enter Fileman file for XML export (^ to quit): ^// " +"RTN","TMGXMLUI",148,0) + . do ^DIC +"RTN","TMGXMLUI",149,0) + . write ! +"RTN","TMGXMLUI",150,0) + . set File=+Y +"RTN","TMGXMLUI",151,0) + . if File'>0 set result=0 quit +"RTN","TMGXMLUI",152,0) + . set ref=$name(@pArray@(File)) +"RTN","TMGXMLUI",153,0) + . if $$GetRecs(File,ref,indent)=0 set Y=0,result=0 quit +"RTN","TMGXMLUI",154,0) + . set Another=1 +"RTN","TMGXMLUI",155,0) + +"RTN","TMGXMLUI",156,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",157,0) + +"RTN","TMGXMLUI",158,0) + if result=0 goto SUFDone +"RTN","TMGXMLUI",159,0) + +"RTN","TMGXMLUI",160,0) + write !,?indent,"Also export pointed-to records (Y/N/^) YES// " +"RTN","TMGXMLUI",161,0) + new input read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",162,0) + if input="^" set result=0 goto SUFDone +"RTN","TMGXMLUI",163,0) + if input="" set input="Y" +"RTN","TMGXMLUI",164,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGXMLUI",165,0) + if input["Y" do +"RTN","TMGXMLUI",166,0) + . do ExpandPtrs(pArray) +"RTN","TMGXMLUI",167,0) + +"RTN","TMGXMLUI",168,0) + set result=$$AskFlags(pArray,indent) +"RTN","TMGXMLUI",169,0) +SUFDone +"RTN","TMGXMLUI",170,0) + quit result +"RTN","TMGXMLUI",171,0) + +"RTN","TMGXMLUI",172,0) + +"RTN","TMGXMLUI",173,0) +AskFlags(pArray,indent) +"RTN","TMGXMLUI",174,0) + ;"Purpose: To ask user if various flags are desired +"RTN","TMGXMLUI",175,0) + ;"Input: pArray -- pointer to (i.e. name of) array to put data into +"RTN","TMGXMLUI",176,0) + ;" indent -- amount to indent from left margin +"RTN","TMGXMLUI",177,0) + ;"Note: uses global variable pHeader +"RTN","TMGXMLUI",178,0) + ;"Result: 1 if OK to continue, 0 if aborted +"RTN","TMGXMLUI",179,0) + +"RTN","TMGXMLUI",180,0) + new input +"RTN","TMGXMLUI",181,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",182,0) + new result set result=1 +"RTN","TMGXMLUI",183,0) + if $get(pArray)="" set result=0 goto AFlgDone +"RTN","TMGXMLUI",184,0) + new defLabel set defLabel="TMG_VISTA_XML_EXPORT" +"RTN","TMGXMLUI",185,0) + +"RTN","TMGXMLUI",186,0) + new SysName,Y +"RTN","TMGXMLUI",187,0) + set SysName=$get(^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")) +"RTN","TMGXMLUI",188,0) + if SysName="" do +"RTN","TMGXMLUI",189,0) + . do GETENV^%ZOSV +"RTN","TMGXMLUI",190,0) + . set SysName=$piece(Y,"^",4) +"RTN","TMGXMLUI",191,0) + set @pArray@("EXPORT_SYSTEM_NAME")=SysName +"RTN","TMGXMLUI",192,0) + +"RTN","TMGXMLUI",193,0) + do WriteHeader(pHeader) +"RTN","TMGXMLUI",194,0) + +"RTN","TMGXMLUI",195,0) + write ?indent,"Formatting Options:",! +"RTN","TMGXMLUI",196,0) + write ?indent,"----------------------",!! +"RTN","TMGXMLUI",197,0) + +"RTN","TMGXMLUI",198,0) + write ?indent,"Use Default export settings? (Y/N,^) YES// " +"RTN","TMGXMLUI",199,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",200,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",201,0) + if input="" set input="Y" +"RTN","TMGXMLUI",202,0) + if "YesyesYES"[input do goto AFlgDone +"RTN","TMGXMLUI",203,0) + . set @pArray@("FLAGS","i")="" ;"<-- default value of indenting +"RTN","TMGXMLUI",204,0) + . set @pArray@("!DOCTYPE")=defLabel +"RTN","TMGXMLUI",205,0) + . new SysName,Y +"RTN","TMGXMLUI",206,0) + . set SysName=$get(^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")) +"RTN","TMGXMLUI",207,0) + +"RTN","TMGXMLUI",208,0) + write ?indent,"During export to XML file, do you want empty fields to be",! +"RTN","TMGXMLUI",209,0) + write ?indent,"reported (vs. no data --> tag not written)? (Y/N,^) NO// " +"RTN","TMGXMLUI",210,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",211,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",212,0) + if input="" set input="N" +"RTN","TMGXMLUI",213,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",214,0) + . set @pArray@("FLAGS","b")="" +"RTN","TMGXMLUI",215,0) + +"RTN","TMGXMLUI",216,0) + write ?indent,"Do you want the XML file to have entries indented for visual",! +"RTN","TMGXMLUI",217,0) + write ?indent,"organization? This will have no meaning to another program",! +"RTN","TMGXMLUI",218,0) + write ?indent,"importing the XML file, but is easier for humans to read it ",! +"RTN","TMGXMLUI",219,0) + write ?indent,"this way. Indent entries? (Y/N,^) YES// " +"RTN","TMGXMLUI",220,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",221,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",222,0) + if input="" set input="Y" +"RTN","TMGXMLUI",223,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",224,0) + . set @pArray@("FLAGS","i")="" +"RTN","TMGXMLUI",225,0) + +"RTN","TMGXMLUI",226,0) + write ?indent,"Do you want the exported entries to be INTERNAL Fileman values?",! +"RTN","TMGXMLUI",227,0) + write ?indent,"Export INTERNAL entries? (Y/N,^) NO// " +"RTN","TMGXMLUI",228,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",229,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",230,0) + if input="" set input="N" +"RTN","TMGXMLUI",231,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",232,0) + . set @pArray@("FLAGS","I")="" +"RTN","TMGXMLUI",233,0) + +"RTN","TMGXMLUI",234,0) + write ?indent,"Do you want the export the Fileman data dictionary? (Y/N,^) NO// " +"RTN","TMGXMLUI",235,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",236,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",237,0) + if input="" set input="N" +"RTN","TMGXMLUI",238,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",239,0) + . set @pArray@("FLAGS","D")="" +"RTN","TMGXMLUI",240,0) + +"RTN","TMGXMLUI",241,0) + write ?indent,"Output export settings? (Y/N,^) YES// " +"RTN","TMGXMLUI",242,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",243,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",244,0) + if input="" set input="Y" +"RTN","TMGXMLUI",245,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",246,0) + . set @pArray@("FLAGS","S")="" +"RTN","TMGXMLUI",247,0) + +"RTN","TMGXMLUI",248,0) + new defLabel set defLabel="TMG_VISTA_XML_EXPORT" +"RTN","TMGXMLUI",249,0) + write ?indent,"Use default XML !DOCTYPE '"_defLabel_"' label? (Y/N,^) YES// " +"RTN","TMGXMLUI",250,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",251,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",252,0) + if input="" set input="Y" +"RTN","TMGXMLUI",253,0) + if "YesyesYES"[input do +"RTN","TMGXMLUI",254,0) + . set @pArray@("!DOCTYPE")=defLabel +"RTN","TMGXMLUI",255,0) + else do goto:(result=0) AFlgDone +"RTN","TMGXMLUI",256,0) + . write ?indent,"Specify a *custom* XML !DOCTYPE label? (Y/N,^) NO// " +"RTN","TMGXMLUI",257,0) + . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",258,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",259,0) + . if input="" set input="Y" +"RTN","TMGXMLUI",260,0) + . if "YesyesYES"[input do +"RTN","TMGXMLUI",261,0) + . . write "Enter label for <!DOCTYPE YourInputGoesHere>",! +"RTN","TMGXMLUI",262,0) + . . write "Enter Label: //" +"RTN","TMGXMLUI",263,0) + . . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",264,0) + . . if input="^" set result=0 quit +"RTN","TMGXMLUI",265,0) + . . if input'="" set @pArray@("!DOCTYPE")=input +"RTN","TMGXMLUI",266,0) + +"RTN","TMGXMLUI",267,0) + write ?indent,"Enter a name for this VistA installation. ",SysName,"// " +"RTN","TMGXMLUI",268,0) + read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",269,0) + if input="^" set result=0 goto AFlgDone +"RTN","TMGXMLUI",270,0) + if input="" set input=SysName +"RTN","TMGXMLUI",271,0) + set SysName=input +"RTN","TMGXMLUI",272,0) + set ^TMG("XML EXPORTER","EXPORT_SYSTEM_NAME")=SysName +"RTN","TMGXMLUI",273,0) + set @pArray@("EXPORT_SYSTEM_NAME")=SysName +"RTN","TMGXMLUI",274,0) + +"RTN","TMGXMLUI",275,0) +AFlgDone +"RTN","TMGXMLUI",276,0) + quit result +"RTN","TMGXMLUI",277,0) + +"RTN","TMGXMLUI",278,0) + +"RTN","TMGXMLUI",279,0) + ;"NOTE: I need to notice if File has already been set (i.e. user choosing file a second time +"RTN","TMGXMLUI",280,0) + ;" If so give option to erase old choices and choose again +"RTN","TMGXMLUI",281,0) +GetRecs(File,pRecs,indent) +"RTN","TMGXMLUI",282,0) + ;"Purpose: For a given file, allow selection of records to export. +"RTN","TMGXMLUI",283,0) + ;"Input: File -- the File (name or number) to select from. +"RTN","TMGXMLUI",284,0) + ;" pRec -- Pointer to (i.e. name of) array to fill with records nums +"RTN","TMGXMLUI",285,0) + ;" indent -- a value to indent from left margin +"RTN","TMGXMLUI",286,0) + ;"Result: 1 if OK to continue, 0 if user aborted. +"RTN","TMGXMLUI",287,0) + ;"Note: uses global variable pHeader,TabInc +"RTN","TMGXMLUI",288,0) + +"RTN","TMGXMLUI",289,0) + new result set result=1 +"RTN","TMGXMLUI",290,0) + new input set input="" +"RTN","TMGXMLUI",291,0) + new FileNumber,FileName +"RTN","TMGXMLUI",292,0) + if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone +"RTN","TMGXMLUI",293,0) + new defValue set defValue="X" +"RTN","TMGXMLUI",294,0) + +"RTN","TMGXMLUI",295,0) + if +File=File do +"RTN","TMGXMLUI",296,0) + . set FileNumber=File +"RTN","TMGXMLUI",297,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",298,0) + else do +"RTN","TMGXMLUI",299,0) + . set FileName=File +"RTN","TMGXMLUI",300,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",301,0) + +"RTN","TMGXMLUI",302,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Step 2. Which RECORDS to export from file "_FileName_"?") +"RTN","TMGXMLUI",303,0) + +"RTN","TMGXMLUI",304,0) + for do quit:(input="^")!(result=0) +"RTN","TMGXMLUI",305,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",306,0) + . write ?indent,"1. Export ALL records (exclusions allowed).",! +"RTN","TMGXMLUI",307,0) + . write ?indent,"2. Select a Search/Sort TEMPLATE to specify records.",! +"RTN","TMGXMLUI",308,0) + . write ?indent,"3. Select SPECIFIC records",! +"RTN","TMGXMLUI",309,0) + . write ?indent,"4. Select records to EXCLUDE",! +"RTN","TMGXMLUI",310,0) + . write ?indent,"5. View selections so far.",! +"RTN","TMGXMLUI",311,0) + . write ?indent,"X. Done here.",!! +"RTN","TMGXMLUI",312,0) + . write ?indent,"Select option (1-5 or X or ? or ^): "_defValue_"// " +"RTN","TMGXMLUI",313,0) + . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",314,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",315,0) + . if input="" set input=defValue +"RTN","TMGXMLUI",316,0) + . if ("Xx"[input) do quit +"RTN","TMGXMLUI",317,0) + . . if $data(@pRecs)'>1 do quit:(input="") +"RTN","TMGXMLUI",318,0) + . . . write ?indent,"NOTE: No records were chosen for export in file: ",FileName,! +"RTN","TMGXMLUI",319,0) + . . . write ?indent,"This means that nothing will be exported to the XML file.",!! +"RTN","TMGXMLUI",320,0) + . . . write ?indent,"Do you still want to stop selecting records? (Y,N,^) NO// " +"RTN","TMGXMLUI",321,0) + . . . new Done read Done:$get(DTIME,3600),! +"RTN","TMGXMLUI",322,0) + . . . if $TEST=0 set Done="^" +"RTN","TMGXMLUI",323,0) + . . . if (Done="")!("NOnoNo"[Done) set input="" +"RTN","TMGXMLUI",324,0) + . . set input="^" +"RTN","TMGXMLUI",325,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",326,0) + . if (input>0)&(input<6) set defValue=input +"RTN","TMGXMLUI",327,0) + . if input="?" do quit +"RTN","TMGXMLUI",328,0) + . . write ! +"RTN","TMGXMLUI",329,0) + . . write ?indent," Enter '1' if you wish to export ALL records in this file.",! +"RTN","TMGXMLUI",330,0) + . . write ?indent," You can still specify records to exclude after this option.",! +"RTN","TMGXMLUI",331,0) + . . write ?indent," Enter '2' if you wish to use a pre-existing Search/Sort TEMPLATE",! +"RTN","TMGXMLUI",332,0) + . . write ?indent," to select files. A Search/Sort TEMPLATE can be generated",! +"RTN","TMGXMLUI",333,0) + . . write ?indent," through the Fileman Search function.",! +"RTN","TMGXMLUI",334,0) + . . write ?indent," Enter '3' if you know the record nubmers (IEN values) for the",! +"RTN","TMGXMLUI",335,0) + . . write ?indent," records you wish to export, and want to enter them",! +"RTN","TMGXMLUI",336,0) + . . write ?indent," manually.",! +"RTN","TMGXMLUI",337,0) + . . write ?indent," Enter '4' if you have records to EXCLUDE. If a record is excluded,",! +"RTN","TMGXMLUI",338,0) + . . write ?indent," then it will NOT be output, even if it was specified ",! +"RTN","TMGXMLUI",339,0) + . . write ?indent," manually or was included from a Search/Sort TEMPLATE.",! +"RTN","TMGXMLUI",340,0) + . . write ?indent," Enter '5' to view array containing settings so far.",! +"RTN","TMGXMLUI",341,0) + . . write ?indent," Enter 'X' to exit..",! +"RTN","TMGXMLUI",342,0) + . . write ?indent," Enter '^' to abort entire process.",! +"RTN","TMGXMLUI",343,0) + . . do Pause(indent) +"RTN","TMGXMLUI",344,0) + . if input=1 do +"RTN","TMGXMLUI",345,0) + . . set @pRecs@("*")="" +"RTN","TMGXMLUI",346,0) + . . write ?indent,"OK. Will export all records in file: ",FileName,".",! +"RTN","TMGXMLUI",347,0) + . . set defValue="X" +"RTN","TMGXMLUI",348,0) + . . do Pause(indent) +"RTN","TMGXMLUI",349,0) + . if input=2 set result=$$GetTemplateRecs(File,pRecs,"for INCLUSION ",indent+TabInc) set defValue="X" +"RTN","TMGXMLUI",350,0) + . if input=3 set result=$$GetManualRecs(File,pRecs,"for INCLUSION ",indent+TabInc) set defValue="X" +"RTN","TMGXMLUI",351,0) + . if input=4 set result=$$GetExclRecs(File,pRecs,indent+TabInc) set defValue="X" +"RTN","TMGXMLUI",352,0) + . if input=5 do ShowArray(indent) +"RTN","TMGXMLUI",353,0) + +"RTN","TMGXMLUI",354,0) +GRDone +"RTN","TMGXMLUI",355,0) + if $data(@pRecs)'>1 do +"RTN","TMGXMLUI",356,0) + . write ?indent,"NOTE: No records were chosen. Aborting.",! +"RTN","TMGXMLUI",357,0) + . set result=0 +"RTN","TMGXMLUI",358,0) + else do +"RTN","TMGXMLUI",359,0) + . write ?indent,"Done chosing records...",! +"RTN","TMGXMLUI",360,0) + +"RTN","TMGXMLUI",361,0) + write ?indent,"Now on to picking FIELDS to export.",! +"RTN","TMGXMLUI",362,0) + do Pause(indent) +"RTN","TMGXMLUI",363,0) + if $$GetFields(File,ref,indent)=0 set Y=0,result=0 +"RTN","TMGXMLUI",364,0) + write ! +"RTN","TMGXMLUI",365,0) + +"RTN","TMGXMLUI",366,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",367,0) + +"RTN","TMGXMLUI",368,0) + quit result +"RTN","TMGXMLUI",369,0) + +"RTN","TMGXMLUI",370,0) + +"RTN","TMGXMLUI",371,0) +GetExclRecs(File,pRecs,indent) +"RTN","TMGXMLUI",372,0) + ;"Purpose: to allow user to enter records to exclude +"RTN","TMGXMLUI",373,0) + ;"Input: File -- the File (name or number) to select from. +"RTN","TMGXMLUI",374,0) + ;" pRec -- Pointer to (i.e. name of) array to fill with records nums +"RTN","TMGXMLUI",375,0) + ;" indent -- a value to indent from left margin +"RTN","TMGXMLUI",376,0) + ;"Result: 1 if OK to continue, 0 if user aborted. +"RTN","TMGXMLUI",377,0) + ;"Note: uses global variable pHeader,TabInc +"RTN","TMGXMLUI",378,0) + +"RTN","TMGXMLUI",379,0) + new result set result=1 +"RTN","TMGXMLUI",380,0) + new FileNumber,FileName +"RTN","TMGXMLUI",381,0) + new input set input="" +"RTN","TMGXMLUI",382,0) + if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone +"RTN","TMGXMLUI",383,0) + new defValue set defValue="X" +"RTN","TMGXMLUI",384,0) + +"RTN","TMGXMLUI",385,0) + if +File=File do +"RTN","TMGXMLUI",386,0) + . set FileNumber=File +"RTN","TMGXMLUI",387,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",388,0) + else do +"RTN","TMGXMLUI",389,0) + . set FileName=File +"RTN","TMGXMLUI",390,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",391,0) + set indent=+$get(indent,0) +"RTN","TMGXMLUI",392,0) + +"RTN","TMGXMLUI",393,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"To EXCLUDE records in file "_FileName_", choose:") +"RTN","TMGXMLUI",394,0) + +"RTN","TMGXMLUI",395,0) + for do quit:(input="")!(result=0) +"RTN","TMGXMLUI",396,0) + . new ExRecs,i +"RTN","TMGXMLUI",397,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",398,0) + . write ?indent,"1. Select a Search/Sort TEMPLATE to specify records to EXCLUDE.",! +"RTN","TMGXMLUI",399,0) + . write ?indent,"2. Select SPECIFIC record numbers to EXCLUDE.",! +"RTN","TMGXMLUI",400,0) + . write ?indent,"3. View all the records excluded so far.",! +"RTN","TMGXMLUI",401,0) + . write ?indent,"X. Done here.",!! +"RTN","TMGXMLUI",402,0) + . write ?indent,"Select option (1-3 or X or ? or ^) "_defValue_"// " +"RTN","TMGXMLUI",403,0) + . read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",404,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",405,0) + . if input="" set input=defValue +"RTN","TMGXMLUI",406,0) + . if ("Xx"[input) set input="" +"RTN","TMGXMLUI",407,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",408,0) + . if (input>0)&(input<4) set defValue=input +"RTN","TMGXMLUI",409,0) + . if input="?" do +"RTN","TMGXMLUI",410,0) + . . write !,?indent," By excluding just certain records, you can export every record",! +"RTN","TMGXMLUI",411,0) + . . write ?indent," EXCEPT those you specify.",! +"RTN","TMGXMLUI",412,0) + . . do Pause(indent) +"RTN","TMGXMLUI",413,0) + . if input=1 do +"RTN","TMGXMLUI",414,0) + . . new pArray set pArray=$name(@pRecs@("Rec Exclude")) +"RTN","TMGXMLUI",415,0) + . . set result=$$GetTemplateRecs(File,pArray,"for EXCLUSION ",indent+TabInc) +"RTN","TMGXMLUI",416,0) + . if input=2 do +"RTN","TMGXMLUI",417,0) + . . new pArray set pArray=$name(@pRecs@("Rec Exclude")) +"RTN","TMGXMLUI",418,0) + . . set result=$$GetManualRecs(File,pArray,"for EXCLUSION ",indent+TabInc) +"RTN","TMGXMLUI",419,0) + . if input=3 do ShowArray(indent) +"RTN","TMGXMLUI",420,0) + +"RTN","TMGXMLUI",421,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",422,0) + +"RTN","TMGXMLUI",423,0) +GERDone +"RTN","TMGXMLUI",424,0) + quit result +"RTN","TMGXMLUI",425,0) + +"RTN","TMGXMLUI",426,0) + +"RTN","TMGXMLUI",427,0) +GetTemplateRecs(File,pRecs,s,indent) +"RTN","TMGXMLUI",428,0) + ;"Purpose: to ask user for a search/sort template to inport records from +"RTN","TMGXMLUI",429,0) + ;"Input -- File -- the file name or number to work with +"RTN","TMGXMLUI",430,0) + ;" pRecs -- pointer to (i.e. name of) array to fill +"RTN","TMGXMLUI",431,0) + ;" will probably be passed with "Array(12345)" +"RTN","TMGXMLUI",432,0) + ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. +"RTN","TMGXMLUI",433,0) + ;" indent -- OPTIONAL -- a value to indent from left margin +"RTN","TMGXMLUI",434,0) + ;"Output: Data is put into pRecs like this: +"RTN","TMGXMLUI",435,0) + ;" @pRecs@(IEN1)="" +"RTN","TMGXMLUI",436,0) + ;" @pRecs@(IEN2)="" +"RTN","TMGXMLUI",437,0) + ;" @pRecs@(IEN3)="" +"RTN","TMGXMLUI",438,0) + ;"Result: 1 if OK to continue, 0 if user aborted. +"RTN","TMGXMLUI",439,0) + ;"Note: uses global variable pHeader (if available) +"RTN","TMGXMLUI",440,0) + +"RTN","TMGXMLUI",441,0) + new FileNumber,FileName,Y +"RTN","TMGXMLUI",442,0) + if ($get(File)="")!($get(pRecs)="") goto GTRDone +"RTN","TMGXMLUI",443,0) + new tempH set pHeader=$get(pHeader,"tempH") +"RTN","TMGXMLUI",444,0) + new result set result=1 +"RTN","TMGXMLUI",445,0) + +"RTN","TMGXMLUI",446,0) + if +File=File do +"RTN","TMGXMLUI",447,0) + . set FileNumber=File +"RTN","TMGXMLUI",448,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",449,0) + else do +"RTN","TMGXMLUI",450,0) + . set FileName=File +"RTN","TMGXMLUI",451,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",452,0) + if FileNumber'>0 do goto GTRDone +"RTN","TMGXMLUI",453,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGXMLUI",454,0) + . set result=0 +"RTN","TMGXMLUI",455,0) + +"RTN","TMGXMLUI",456,0) + set indent=+$get(indent,0) +"RTN","TMGXMLUI",457,0) + +"RTN","TMGXMLUI",458,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Select records for export from a Template") +"RTN","TMGXMLUI",459,0) + +"RTN","TMGXMLUI",460,0) + for do quit:((+Y>0)!(+Y=-1)) +"RTN","TMGXMLUI",461,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",462,0) + . new DIC +"RTN","TMGXMLUI",463,0) + . set DIC=.401 +"RTN","TMGXMLUI",464,0) + . set DIC(0)="AEQ" +"RTN","TMGXMLUI",465,0) + . write $$Spaces(indent)_"Select a Template containing records for import. ",! +"RTN","TMGXMLUI",466,0) + . write $$Spaces(indent)_"(? for list, ^ to quit) " +"RTN","TMGXMLUI",467,0) + . set DIC("A")=$$Spaces(indent)_"Enter Template: " +"RTN","TMGXMLUI",468,0) + . set DIC("S")="IF $P($G(^DIBT(+Y,0)),""^"",4)="_FileNumber ;"screen for Templates by file +"RTN","TMGXMLUI",469,0) + . do ^DIC +"RTN","TMGXMLUI",470,0) + . write ! +"RTN","TMGXMLUI",471,0) + . if +Y'>0 quit ;"set result=0 +"RTN","TMGXMLUI",472,0) + . new node set node=$get(^DIBT(+Y,0)) +"RTN","TMGXMLUI",473,0) + . if $piece(node,"^",4)'=FileNumber do quit +"RTN","TMGXMLUI",474,0) + . . set Y=0 ;"signal to try again +"RTN","TMGXMLUI",475,0) + . . new PriorErrorFound +"RTN","TMGXMLUI",476,0) + . . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: That template doesn't contain records from "_File_". Please select another.") +"RTN","TMGXMLUI",477,0) + . . do Pause(indent) +"RTN","TMGXMLUI",478,0) + +"RTN","TMGXMLUI",479,0) + if result=0 goto GTRL1 +"RTN","TMGXMLUI",480,0) + +"RTN","TMGXMLUI",481,0) + new count set count=0 +"RTN","TMGXMLUI",482,0) + if (+Y>0)&($data(^DIBT(+Y,1))>1) do +"RTN","TMGXMLUI",483,0) + . new index set index=$order(^DIBT(+Y,1,0)) +"RTN","TMGXMLUI",484,0) + . if index'="" for do quit:(index="") +"RTN","TMGXMLUI",485,0) + . . set @pRecs@(index)="" +"RTN","TMGXMLUI",486,0) + . . set count=count+1 +"RTN","TMGXMLUI",487,0) + . . set index=$order(^DIBT(+Y,1,index)) +"RTN","TMGXMLUI",488,0) + +"RTN","TMGXMLUI",489,0) + write ?indent,count," Records imported.",! +"RTN","TMGXMLUI",490,0) + do Pause(indent) +"RTN","TMGXMLUI",491,0) + +"RTN","TMGXMLUI",492,0) +GTRL1 +"RTN","TMGXMLUI",493,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",494,0) + +"RTN","TMGXMLUI",495,0) +GTRDone +"RTN","TMGXMLUI",496,0) + quit result +"RTN","TMGXMLUI",497,0) + +"RTN","TMGXMLUI",498,0) + +"RTN","TMGXMLUI",499,0) +GetManualRecs(File,pRecs,s,indent) +"RTN","TMGXMLUI",500,0) + ;"Purpose: to ask user for a series of IEN values +"RTN","TMGXMLUI",501,0) + ;"Input: File -- name or number, file to get IENS's for +"RTN","TMGXMLUI",502,0) + ;" pRecs -- a pointer to (i.e. Name of) array to put IEN's into +"RTN","TMGXMLUI",503,0) + ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. +"RTN","TMGXMLUI",504,0) + ;"Output: Data is put into pRecs like this: +"RTN","TMGXMLUI",505,0) + ;" @pRecs@(IEN1)="" +"RTN","TMGXMLUI",506,0) + ;" @pRecs@(IEN2)="" +"RTN","TMGXMLUI",507,0) + ;" @pRecs@(IEN3)="" +"RTN","TMGXMLUI",508,0) + ;"Result: 1 if OK to continue, 0 if user aborted. +"RTN","TMGXMLUI",509,0) + ;"Note: uses global variable pHeader +"RTN","TMGXMLUI",510,0) + +"RTN","TMGXMLUI",511,0) + new PriorErrorFound +"RTN","TMGXMLUI",512,0) + new FileNumber,FileName +"RTN","TMGXMLUI",513,0) + new result set result=1 +"RTN","TMGXMLUI",514,0) + if ($get(File)="")!($get(pRecs)="") set result=0 goto GRDone +"RTN","TMGXMLUI",515,0) + +"RTN","TMGXMLUI",516,0) + if +File=File do +"RTN","TMGXMLUI",517,0) + . set FileNumber=File +"RTN","TMGXMLUI",518,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",519,0) + else do +"RTN","TMGXMLUI",520,0) + . set FileName=File +"RTN","TMGXMLUI",521,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",522,0) + if FileNumber'>0 do goto GMRDone +"RTN","TMGXMLUI",523,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGXMLUI",524,0) + . do Pause(indent) +"RTN","TMGXMLUI",525,0) + . set result=0 +"RTN","TMGXMLUI",526,0) + +"RTN","TMGXMLUI",527,0) + new ORef +"RTN","TMGXMLUI",528,0) + set ORef=$get(^DIC(FileNumber,0,"GL")) +"RTN","TMGXMLUI",529,0) + if ORef="" do goto GRDone +"RTN","TMGXMLUI",530,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Can't find global reference for file: "_FileNumber_".") +"RTN","TMGXMLUI",531,0) + . do Pause(indent) +"RTN","TMGXMLUI",532,0) + . set result=0 +"RTN","TMGXMLUI",533,0) + +"RTN","TMGXMLUI",534,0) + new defValue set defValue="X" +"RTN","TMGXMLUI",535,0) + +"RTN","TMGXMLUI",536,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Select specific record "_$get(s)_"in file "_FileName) +"RTN","TMGXMLUI",537,0) + +"RTN","TMGXMLUI",538,0) + new input +"RTN","TMGXMLUI",539,0) + for do quit:(input="")!(result=0) +"RTN","TMGXMLUI",540,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",541,0) + . write ?indent,"1. Use Fileman to find record.",! +"RTN","TMGXMLUI",542,0) + . write ?indent,"2. Enter record number by hand.",! +"RTN","TMGXMLUI",543,0) + . write ?indent,"3. View all the records selected so far.",! +"RTN","TMGXMLUI",544,0) + . write ?indent,"X. Done here.",! +"RTN","TMGXMLUI",545,0) + . write !,?indent,"Select Option (1-3 or X or ^) "_defValue_"//" +"RTN","TMGXMLUI",546,0) + . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",547,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",548,0) + . if input="" set input=defValue +"RTN","TMGXMLUI",549,0) + . if "Xx"[input set input="" quit +"RTN","TMGXMLUI",550,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",551,0) + . if (input>0)&(input<4) set defValue=input +"RTN","TMGXMLUI",552,0) + . if input=1 do +"RTN","TMGXMLUI",553,0) + . . new DIC +"RTN","TMGXMLUI",554,0) + . . set DIC=File +"RTN","TMGXMLUI",555,0) + . . set DIC(0)="AEQ" +"RTN","TMGXMLUI",556,0) + . . set DIC("A")=$$Spaces(indent)_"Select record in "_FileName_" (? for list, ^ to quit): " +"RTN","TMGXMLUI",557,0) + . . do ^DIC +"RTN","TMGXMLUI",558,0) + . . write ! +"RTN","TMGXMLUI",559,0) + . . if +Y>0 do +"RTN","TMGXMLUI",560,0) + . . . write !,?indent,"O.K. You selected record number (IEN): ",+Y,! +"RTN","TMGXMLUI",561,0) + . . . set @pRecs@(+Y)="" +"RTN","TMGXMLUI",562,0) + . . . do Pause(indent) +"RTN","TMGXMLUI",563,0) + . . ;" else set result=0 quit +"RTN","TMGXMLUI",564,0) + . if input=2 do +"RTN","TMGXMLUI",565,0) + . . new IEN +"RTN","TMGXMLUI",566,0) + . . read ?indent,"Enter record number (a.k.a. IEN) (^ to abort): ",IEN:$get(DTIME,3600),! +"RTN","TMGXMLUI",567,0) + . . if $TEST=0 set EIN="^" +"RTN","TMGXMLUI",568,0) + . . if IEN="^" set result=0 quit +"RTN","TMGXMLUI",569,0) + . . if +IEN>0 do +"RTN","TMGXMLUI",570,0) + . . . new ref set ref=ORef_IEN_")" +"RTN","TMGXMLUI",571,0) + . . . if $data(@ref)'>0 do quit +"RTN","TMGXMLUI",572,0) + . . . . write ?indent,"Sorry. That record number (IEN) doesn't exist.",! +"RTN","TMGXMLUI",573,0) + . . . . do Pause(indent) +"RTN","TMGXMLUI",574,0) + . . . set @pRecs@(IEN)="" +"RTN","TMGXMLUI",575,0) + . . . write ?indent,"O.K. You selected record number (IEN): ",IEN,! +"RTN","TMGXMLUI",576,0) + . . . do Pause(indent) +"RTN","TMGXMLUI",577,0) + . if input=3 do ShowArray(indent) +"RTN","TMGXMLUI",578,0) + +"RTN","TMGXMLUI",579,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",580,0) + +"RTN","TMGXMLUI",581,0) +GMRDone +"RTN","TMGXMLUI",582,0) + quit result +"RTN","TMGXMLUI",583,0) + +"RTN","TMGXMLUI",584,0) + +"RTN","TMGXMLUI",585,0) +GetFields(File,pArray,indent) +"RTN","TMGXMLUI",586,0) + ;"Purpose: To query the user as to which fields to export for records +"RTN","TMGXMLUI",587,0) + ;"Input: File -- the File number or name to work with. +"RTN","TMGXMLUI",588,0) + ;" pArray -- point to (i.e. name of) Array to work with. Format discussed in TMGXMLEX.m +"RTN","TMGXMLUI",589,0) + ;" will likely be equal to "Array(FileNumber)" +"RTN","TMGXMLUI",590,0) + ;" indent -- a value to indent from left margin +"RTN","TMGXMLUI",591,0) + ;"Result: 1 if OK to continue. 0 if user aborted. +"RTN","TMGXMLUI",592,0) + ;"Note: uses global variable pHeader,TabInc +"RTN","TMGXMLUI",593,0) + +"RTN","TMGXMLUI",594,0) + new result set result=1 +"RTN","TMGXMLUI",595,0) + new FileNumber,FileName +"RTN","TMGXMLUI",596,0) + if ($get(File)="")!($get(pArray)="") set result=0 goto GRDone +"RTN","TMGXMLUI",597,0) + +"RTN","TMGXMLUI",598,0) + if +File=File do +"RTN","TMGXMLUI",599,0) + . set FileNumber=File +"RTN","TMGXMLUI",600,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",601,0) + else do +"RTN","TMGXMLUI",602,0) + . set FileName=File +"RTN","TMGXMLUI",603,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",604,0) + if FileNumber'>0 do +"RTN","TMGXMLUI",605,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGXMLUI",606,0) + +"RTN","TMGXMLUI",607,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Step 3. Which FIELDS to export from file "_FileName_"?") +"RTN","TMGXMLUI",608,0) + +"RTN","TMGXMLUI",609,0) + new defValue set defValue=1 +"RTN","TMGXMLUI",610,0) + new input +"RTN","TMGXMLUI",611,0) + for do quit:(input="")!(result=0) +"RTN","TMGXMLUI",612,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",613,0) + . write ?indent,"1. Export ALL fields (exclusions allowed).",! +"RTN","TMGXMLUI",614,0) + . write ?indent,"2. Select SPECIFIC field numbers.",! +"RTN","TMGXMLUI",615,0) + . write ?indent,"3. Select fields to EXCLUDE",! +"RTN","TMGXMLUI",616,0) + . write ?indent,"4. View selections so far.",! +"RTN","TMGXMLUI",617,0) + . write ?indent,"X. Done here.",!! +"RTN","TMGXMLUI",618,0) + . write ?indent,"Select option (1-4 or X or ? or ^): "_defValue_"// " +"RTN","TMGXMLUI",619,0) + . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",620,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",621,0) + . if input="" set input=defValue +"RTN","TMGXMLUI",622,0) + . if ("Xx"[input) set input="" +"RTN","TMGXMLUI",623,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",624,0) + . if (input>0)&(input<5) set defValue=input +"RTN","TMGXMLUI",625,0) + . if input="?" do quit +"RTN","TMGXMLUI",626,0) + . . write ! +"RTN","TMGXMLUI",627,0) + . . write ?indent," Enter '1' if you wish to export ALL fields for this file.",! +"RTN","TMGXMLUI",628,0) + . . write ?indent," You can still specify fields to exclude after this option.",! +"RTN","TMGXMLUI",629,0) + . . write ?indent," Enter '2' if you know the field numbers you wish to export,",! +"RTN","TMGXMLUI",630,0) + . . write ?indent," and want to enter them manually.",! +"RTN","TMGXMLUI",631,0) + . . write ?indent," Enter '3' if you have fields to EXCLUDE. If a field is excluded,",! +"RTN","TMGXMLUI",632,0) + . . write ?indent," then it will NOT be output, even if it was specified manually.",! +"RTN","TMGXMLUI",633,0) + . . write ?indent," Enter '4' to view array containing settings so far.",! +"RTN","TMGXMLUI",634,0) + . . write ?indent," Enter 'X' to exit..",! +"RTN","TMGXMLUI",635,0) + . . write ?indent," Enter '^' to abort entire process.",! +"RTN","TMGXMLUI",636,0) + . . do Pause(indent) +"RTN","TMGXMLUI",637,0) + . if input=1 do quit +"RTN","TMGXMLUI",638,0) + . . set @pArray@("TEMPLATE","*")="" +"RTN","TMGXMLUI",639,0) + . . write ?indent,"OK. Will export all fields (and any sub-fields) in file ",FileName,".",! +"RTN","TMGXMLUI",640,0) + . . do Pause(indent) +"RTN","TMGXMLUI",641,0) + . . set defValue="X" +"RTN","TMGXMLUI",642,0) + . if input=2 do quit +"RTN","TMGXMLUI",643,0) + . . new temp set temp=$name(@pArray@("TEMPLATE")) +"RTN","TMGXMLUI",644,0) + . . set result=$$GetManFields(File,temp,"for INCLUSION ",indent+TabInc) +"RTN","TMGXMLUI",645,0) + . if input=3 do quit +"RTN","TMGXMLUI",646,0) + . . new temp set temp=$name(@pArray@("TEMPLATE","Field Exclude")) +"RTN","TMGXMLUI",647,0) + . . set result=$$GetManFields(File,temp,"for EXCLUSION ",indent+TabInc) +"RTN","TMGXMLUI",648,0) + . if input=4 do ShowArray(indent) +"RTN","TMGXMLUI",649,0) + +"RTN","TMGXMLUI",650,0) + write ?indent,"Done choosing FIELDS.",! +"RTN","TMGXMLUI",651,0) + +"RTN","TMGXMLUI",652,0) + new ref +"RTN","TMGXMLUI",653,0) + ;"set ref=$name(@pArray@(File,"TEMPLATE")) +"RTN","TMGXMLUI",654,0) + set ref=$name(@pArray@("TEMPLATE")) +"RTN","TMGXMLUI",655,0) + set result=$$CfgOrderFields(File,ref,indent) +"RTN","TMGXMLUI",656,0) + if result=0 set Y=0 quit +"RTN","TMGXMLUI",657,0) + +"RTN","TMGXMLUI",658,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",659,0) + quit result +"RTN","TMGXMLUI",660,0) + +"RTN","TMGXMLUI",661,0) + +"RTN","TMGXMLUI",662,0) +GetManFields(File,pArray,s,indent) +"RTN","TMGXMLUI",663,0) + ;"Purpose: to ask user for a series of field values +"RTN","TMGXMLUI",664,0) + ;"Input: File -- name or number, file to get field numbers for +"RTN","TMGXMLUI",665,0) + ;" pArray -- a pointer to (i.e. Name of) array to put field numbers into +"RTN","TMGXMLUI",666,0) + ;" will probably be something one of the following: +"RTN","TMGXMLUI",667,0) + ;" "Array(FileNumber,"TEMPLATE")" +"RTN","TMGXMLUI",668,0) + ;" "Array(FileNumber,"TEMPLATE","Field Exclude")" +"RTN","TMGXMLUI",669,0) + ;" "Array(FileNumber,RecNumber)" +"RTN","TMGXMLUI",670,0) + ;" s -- OPTIONAL -- e.g. "for INCLUSION " or "for EXCLUSION " -- part of title. +"RTN","TMGXMLUI",671,0) + ;" indend -- optional -- a value to indent from left margin +"RTN","TMGXMLUI",672,0) + ;"Output: Data is put into pArray +"RTN","TMGXMLUI",673,0) + ;"Result: 1 if OK to continue. 0 if user aborted. +"RTN","TMGXMLUI",674,0) + ;"Note: uses global variable pHeader,TabInc +"RTN","TMGXMLUI",675,0) + +"RTN","TMGXMLUI",676,0) + new PriorErrorFound +"RTN","TMGXMLUI",677,0) + new FileNumber,FileName +"RTN","TMGXMLUI",678,0) + new result set result=1 +"RTN","TMGXMLUI",679,0) + if ($get(File)="")!($get(pArray)="") set result=0 goto GRDone +"RTN","TMGXMLUI",680,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",681,0) + new defValue set defValue="X" +"RTN","TMGXMLUI",682,0) + +"RTN","TMGXMLUI",683,0) + if +File=File do +"RTN","TMGXMLUI",684,0) + . set FileNumber=File +"RTN","TMGXMLUI",685,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",686,0) + else do +"RTN","TMGXMLUI",687,0) + . set FileName=File +"RTN","TMGXMLUI",688,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",689,0) + if FileNumber'>0 do goto GRDone +"RTN","TMGXMLUI",690,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGXMLUI",691,0) + . set result=0 +"RTN","TMGXMLUI",692,0) + +"RTN","TMGXMLUI",693,0) + do HdrAddLine(pHeader,$$Spaces(indent)_"Which SPECIFIC FIELDS "_$get(s)_"to export?") +"RTN","TMGXMLUI",694,0) + +"RTN","TMGXMLUI",695,0) + new input +"RTN","TMGXMLUI",696,0) + for do quit:(input="")!(result=0) +"RTN","TMGXMLUI",697,0) + . new field set field=0 +"RTN","TMGXMLUI",698,0) + . do WriteHeader(pHeader) +"RTN","TMGXMLUI",699,0) + . write ?indent,"1. Select ALL fields.",! +"RTN","TMGXMLUI",700,0) + . write ?indent,"2. Use Fileman to find FIELD number.",! +"RTN","TMGXMLUI",701,0) + . write ?indent,"3. Enter FIELD by hand.",! +"RTN","TMGXMLUI",702,0) + . write ?indent,"4. Pick an UNSELECTED field.",! +"RTN","TMGXMLUI",703,0) + . write ?indent,"5. View all the FIELDS selected so far.",! +"RTN","TMGXMLUI",704,0) + . write ?indent,"X. Done here.",! +"RTN","TMGXMLUI",705,0) + . write !,?indent,"Select Option (1-5 or X or ^) ",defValue,"//" +"RTN","TMGXMLUI",706,0) + . read input:$get(DTIME,3600),!! +"RTN","TMGXMLUI",707,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",708,0) + . if input="" set input=defValue +"RTN","TMGXMLUI",709,0) + . if "Xx"[input set input="" quit +"RTN","TMGXMLUI",710,0) + . if input="^" set result=0 quit +"RTN","TMGXMLUI",711,0) + . if (input>0)&(input<6) set defValue=input +"RTN","TMGXMLUI",712,0) + . if input="5" do quit +"RTN","TMGXMLUI",713,0) + . . do ShowArray(indent) +"RTN","TMGXMLUI",714,0) + . if input="1" do +"RTN","TMGXMLUI",715,0) + . . write "OK All fields selected.",! +"RTN","TMGXMLUI",716,0) + . . set @pArray@("*")="" +"RTN","TMGXMLUI",717,0) + . if input="2" set field=$$FMGetField(FileNumber,indent) +"RTN","TMGXMLUI",718,0) + . if input="3" set field=$$AskGetField(FileNumber,indent) +"RTN","TMGXMLUI",719,0) + . if input="4" set field=$$PickUnselField(FileNumber,pArray,indent) +"RTN","TMGXMLUI",720,0) + . if field=-1 set result=0 quit +"RTN","TMGXMLUI",721,0) + . if field>0 do +"RTN","TMGXMLUI",722,0) + . . set @pArray@(field)="" +"RTN","TMGXMLUI",723,0) + . . if $get(s)'="for EXCLUSION " do quit:(result=0) +"RTN","TMGXMLUI",724,0) + . . . set result=$$AskCustomTag(FileNumber,field,pArray,indent) +"RTN","TMGXMLUI",725,0) + . . . if result=0 quit +"RTN","TMGXMLUI",726,0) + . . . set result=$$AskCustTransform(FileNumber,field,pArray,indent) +"RTN","TMGXMLUI",727,0) + . . . if result=0 quit +"RTN","TMGXMLUI",728,0) + . . ;"Now, determine if we need to do sub-fields +"RTN","TMGXMLUI",729,0) + . . new fieldInfo +"RTN","TMGXMLUI",730,0) + . . do GetFieldInfo^TMGDBAPI(FileNumber,field,"fieldInfo","LABEL") +"RTN","TMGXMLUI",731,0) + . . if $get(fieldInfo("MULTIPLE-VALUED"))>0 do +"RTN","TMGXMLUI",732,0) + . . . if $get(fieldInfo("TYPE"))="WORD PROCESSING" quit +"RTN","TMGXMLUI",733,0) + . . . new subFile set subFile=+$get(fieldInfo("SPECIFIER")) +"RTN","TMGXMLUI",734,0) + . . . if subFile=0 quit +"RTN","TMGXMLUI",735,0) + . . . new fieldLst if $$GetFldList^TMGDBAPI(subFile,"fieldLst")=0 quit +"RTN","TMGXMLUI",736,0) + . . . new subArray set subArray=$name(@pArray@(field,"TEMPLATE")) +"RTN","TMGXMLUI",737,0) + . . . if $$ListCt^TMGMISC("fieldLst")=1 do quit +"RTN","TMGXMLUI",738,0) + . . . . new subField set subField=$order(fieldLst("")) +"RTN","TMGXMLUI",739,0) + . . . . new subFName set subFName=$$GetFldName^TMGDBAPI(subFile,subField) +"RTN","TMGXMLUI",740,0) + . . . . write ?indent,"Field ",$get(fieldInfo("LABEL"))," (#",field,") has exactly 1 sub-field (",subFName,")",! +"RTN","TMGXMLUI",741,0) + . . . . write ?indent,"It has been automatically selected for you.",! +"RTN","TMGXMLUI",742,0) + . . . . set @subArray@(subField)="" +"RTN","TMGXMLUI",743,0) + . . . . if $get(s)'="for EXCLUSION " do quit:(result=0) +"RTN","TMGXMLUI",744,0) + . . . . . set result=$$AskCustomTag(subFile,subField,subArray,indent) +"RTN","TMGXMLUI",745,0) + . . . . . if result=0 quit +"RTN","TMGXMLUI",746,0) + . . . . . set result=$$AskCustTransform(subFile,subField,subArray,indent) +"RTN","TMGXMLUI",747,0) + . . . . . if result=0 quit +"RTN","TMGXMLUI",748,0) + . . . write ?indent,"Field ",$get(fieldInfo("LABEL"))," (#",field,") has sub-fields. We'll select those next.",! +"RTN","TMGXMLUI",749,0) + . . . do Pause(indent) +"RTN","TMGXMLUI",750,0) + . . . set result=$$GetManFields(subFile,subArray,s,indent+TabInc) +"RTN","TMGXMLUI",751,0) + . do Pause(indent) +"RTN","TMGXMLUI",752,0) + +"RTN","TMGXMLUI",753,0) + do HdrDelLine(pHeader) +"RTN","TMGXMLUI",754,0) + +"RTN","TMGXMLUI",755,0) +GMFDone +"RTN","TMGXMLUI",756,0) + quit result +"RTN","TMGXMLUI",757,0) + +"RTN","TMGXMLUI",758,0) + +"RTN","TMGXMLUI",759,0) +AskCustomTag(File,field,pArray,indent) +"RTN","TMGXMLUI",760,0) + ;"Purpose: Ask user if they want a custom output tag for a field +"RTN","TMGXMLUI",761,0) + ;"Input: FileNumber -- the name or number of the file to work with +"RTN","TMGXMLUI",762,0) + ;" field -- the number of the field to work with +"RTN","TMGXMLUI",763,0) + ;" pArray -- the array to put answer in. +"RTN","TMGXMLUI",764,0) + ;" value passed will probably be like this: +"RTN","TMGXMLUI",765,0) + ;" e.g. array(22704,"TEMPLATE") or +"RTN","TMGXMLUI",766,0) + ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE") +"RTN","TMGXMLUI",767,0) + ;" indent -- the indent value from left margin +"RTN","TMGXMLUI",768,0) + ;"Output: value is put in, if user wants, like this +"RTN","TMGXMLUI",769,0) + ;" e.g. array(22704,"TEMPLATE","TAG NAME",.01)="Custom name" +"RTN","TMGXMLUI",770,0) + ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE","TRANSFORM",.01)="Custom name" +"RTN","TMGXMLUI",771,0) + ;"Result: 1 if OK to continue. 0 if user aborted. +"RTN","TMGXMLUI",772,0) + +"RTN","TMGXMLUI",773,0) + new result set result=1 +"RTN","TMGXMLUI",774,0) + if (+$get(File)=0)!($get(field)="")!($get(pArray)="") set result=0 goto ACTDone +"RTN","TMGXMLUI",775,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",776,0) + +"RTN","TMGXMLUI",777,0) + new defTag set defTag=$get(@pArray@("TAG NAME",field)) +"RTN","TMGXMLUI",778,0) + if defTag="" set defTag=$$GetFldName^TMGDBAPI(File,field) +"RTN","TMGXMLUI",779,0) + write ?indent,"Tag name to use in XML file? ",defTag,"// " +"RTN","TMGXMLUI",780,0) + new tagName read tagName:$get(DTIME,3600),! +"RTN","TMGXMLUI",781,0) + if tagName="^" set result=0 +"RTN","TMGXMLUI",782,0) + if (tagName'="")&(tagName'="^") set @pArray@("TAG NAME",field)=tagName +"RTN","TMGXMLUI",783,0) + +"RTN","TMGXMLUI",784,0) +ACTDone +"RTN","TMGXMLUI",785,0) + quit result +"RTN","TMGXMLUI",786,0) + +"RTN","TMGXMLUI",787,0) + +"RTN","TMGXMLUI",788,0) +AskCustTransform(File,field,pArray,indent) +"RTN","TMGXMLUI",789,0) + ;"Purpose: Ask user if they want a custom output transform +"RTN","TMGXMLUI",790,0) + ;"Input: FileNumber -- the name or number of the file to work with +"RTN","TMGXMLUI",791,0) + ;" field -- the number of the field to work with +"RTN","TMGXMLUI",792,0) + ;" pArray -- the array to put answer in. +"RTN","TMGXMLUI",793,0) + ;" value passed will probably be like this: +"RTN","TMGXMLUI",794,0) + ;" e.g. array(22704,"TEMPLATE") or +"RTN","TMGXMLUI",795,0) + ;" e.g. array(22704,"TEMPLATE",2,"TEMPLATE") +"RTN","TMGXMLUI",796,0) + ;" indent -- the indent value from left margin +"RTN","TMGXMLUI",797,0) + ;"Output: value is put in, if user wants, like this +"RTN","TMGXMLUI",798,0) + ;" e.g. array(22704,"TEMPLATE","TRANSFORM",.01)="Custom name" +"RTN","TMGXMLUI",799,0) + ;" e.g. array(22704,"TEMPLATE",2,"TRANSFORM","TAG NAME",.01)="Custom name" +"RTN","TMGXMLUI",800,0) + ;"Result: 1 if OK to continue. 0 if user aborted. +"RTN","TMGXMLUI",801,0) + +"RTN","TMGXMLUI",802,0) + new result set result=1 +"RTN","TMGXMLUI",803,0) + if (+$get(File)=0)!($get(field)="")!($get(pArray)="") set result=0 goto ACXDone +"RTN","TMGXMLUI",804,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",805,0) + +"RTN","TMGXMLUI",806,0) + new defXForm +"RTN","TMGXMLUI",807,0) + new XForm set XForm="" +"RTN","TMGXMLUI",808,0) + +"RTN","TMGXMLUI",809,0) + set defXForm=$get(@pArray@("TRANSFORM",field)) +"RTN","TMGXMLUI",810,0) + for do quit:(XForm'="")!(result=0) +"RTN","TMGXMLUI",811,0) + . if defXForm'="" write ?indent,defXForm,! +"RTN","TMGXMLUI",812,0) + . write ?indent,"Custom output transform for field? (?,^) ^//" +"RTN","TMGXMLUI",813,0) + . read XForm:$get(DTIME,3600),! +"RTN","TMGXMLUI",814,0) + . if XForm="" set XForm="^" +"RTN","TMGXMLUI",815,0) + . if XForm="^" set result=0 quit +"RTN","TMGXMLUI",816,0) + . if XForm="?" do quit +"RTN","TMGXMLUI",817,0) + . . write ! +"RTN","TMGXMLUI",818,0) + . . write ?indent,"OPTION FOR ADVANCED USERS ONLY",! +"RTN","TMGXMLUI",819,0) + . . write ?indent,"An output transform is custom Mumps code that converts",! +"RTN","TMGXMLUI",820,0) + . . write ?indent,"internally stored database values into information readable",! +"RTN","TMGXMLUI",821,0) + . . write ?indent,"by end users. If you don't understand this, just leave this",! +"RTN","TMGXMLUI",822,0) + . . write ?indent,"option blank (i.e., just hit [ENTER])",! +"RTN","TMGXMLUI",823,0) + . . write ?indent,"The following variables will be set up:",! +"RTN","TMGXMLUI",824,0) + . . write ?indent," X -- the value stored in the database",! +"RTN","TMGXMLUI",825,0) + . . write ?indent," IENS -- a standard Fileman IENS",! +"RTN","TMGXMLUI",826,0) + . . write ?indent," FILENUM -- the number of the current file or subfile",! +"RTN","TMGXMLUI",827,0) + . . write ?indent," FIELD -- the number of the current file",! +"RTN","TMGXMLUI",828,0) + . . write ?indent,"The resulting value (that should be written to the XML",! +"RTN","TMGXMLUI",829,0) + . . write ?indent,"file) should be put into Y",!! +"RTN","TMGXMLUI",830,0) + . . do Pause(indent) +"RTN","TMGXMLUI",831,0) + . . set XForm="" +"RTN","TMGXMLUI",832,0) + . ;"Note I should run some check here for valid code. +"RTN","TMGXMLUI",833,0) + . set @pArray@("TRANSFORM",field)=XForm +"RTN","TMGXMLUI",834,0) + +"RTN","TMGXMLUI",835,0) +ACXDone +"RTN","TMGXMLUI",836,0) + quit result +"RTN","TMGXMLUI",837,0) + +"RTN","TMGXMLUI",838,0) + +"RTN","TMGXMLUI",839,0) +FMGetField(FileNumber,indent) +"RTN","TMGXMLUI",840,0) + ;"Purpose: To use Fileman to pick a field +"RTN","TMGXMLUI",841,0) + ;"Input: File -- Number of file to get field numbers for +"RTN","TMGXMLUI",842,0) + ;"Result -- The file number selected, or 0 if none or abort +"RTN","TMGXMLUI",843,0) + +"RTN","TMGXMLUI",844,0) + new result set result=0 +"RTN","TMGXMLUI",845,0) + if +$get(FileNumber)'>0 goto FMGFDone +"RTN","TMGXMLUI",846,0) + new DIC +"RTN","TMGXMLUI",847,0) + set DIC="^DD("_FileNumber_"," +"RTN","TMGXMLUI",848,0) + set DIC(0)="AEQ" +"RTN","TMGXMLUI",849,0) + set DIC("A")=$$Spaces(.indent)_"Select field (? for list, ^ to abort): " +"RTN","TMGXMLUI",850,0) + do ^DIC +"RTN","TMGXMLUI",851,0) + write ! +"RTN","TMGXMLUI",852,0) + if +Y>0 set result=+Y +"RTN","TMGXMLUI",853,0) + +"RTN","TMGXMLUI",854,0) +FMGFDone +"RTN","TMGXMLUI",855,0) + quit result +"RTN","TMGXMLUI",856,0) + +"RTN","TMGXMLUI",857,0) + +"RTN","TMGXMLUI",858,0) +AskGetField(FileNumber,indent) +"RTN","TMGXMLUI",859,0) + ;"Purpose: To ask user for a field number, then verify it exists. +"RTN","TMGXMLUI",860,0) + ;"Input: File -- Number of file to get field numbers for +"RTN","TMGXMLUI",861,0) + ;" indent -- OPTIONAL -- a number of spaces to indent. +"RTN","TMGXMLUI",862,0) + ;"Result -- The file number selected, or 0 if none, or -1 if abort +"RTN","TMGXMLUI",863,0) + +"RTN","TMGXMLUI",864,0) + new result set result=0 +"RTN","TMGXMLUI",865,0) + new fieldName,field +"RTN","TMGXMLUI",866,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",867,0) + if +$get(FileNumber)'>0 goto AGFDone +"RTN","TMGXMLUI",868,0) + +"RTN","TMGXMLUI",869,0) + write ?indent +"RTN","TMGXMLUI",870,0) + read "Enter field number or name: ",field:$get(DTIME,3600) +"RTN","TMGXMLUI",871,0) + if field="^" set result=-1 goto AGFDone +"RTN","TMGXMLUI",872,0) + if +field=0 do quit:(+field=0) +"RTN","TMGXMLUI",873,0) + . set fieldName=field +"RTN","TMGXMLUI",874,0) + . set field=$$GetNumField^TMGDBAPI(FileNumber,field) ;"Convert Field Name to Field Number +"RTN","TMGXMLUI",875,0) + . write " (# ",field,")",! +"RTN","TMGXMLUI",876,0) + else do +"RTN","TMGXMLUI",877,0) + . set fieldName=$$GetFldName^TMGDBAPI(FileNumber,field) ;"Convert Field Number to Field Name +"RTN","TMGXMLUI",878,0) + . write " (",fieldName,")",! +"RTN","TMGXMLUI",879,0) + if +field>0 do +"RTN","TMGXMLUI",880,0) + . new ref set ref="^DD("_FileNumber_","_field_",0)" +"RTN","TMGXMLUI",881,0) + . if $data(@ref)'>0 do +"RTN","TMGXMLUI",882,0) + . . write ?indent,"Sorry. That field number doesn't exist.",! +"RTN","TMGXMLUI",883,0) + . . set field=0 +"RTN","TMGXMLUI",884,0) + . else do +"RTN","TMGXMLUI",885,0) + . . set result=field +"RTN","TMGXMLUI",886,0) + +"RTN","TMGXMLUI",887,0) +AGFDone +"RTN","TMGXMLUI",888,0) + quit result +"RTN","TMGXMLUI",889,0) + +"RTN","TMGXMLUI",890,0) + +"RTN","TMGXMLUI",891,0) +PickUnselField(FileNumber,pArray,indent) +"RTN","TMGXMLUI",892,0) + ;"Purpose: To allow the user to pick those fields not already selected. +"RTN","TMGXMLUI",893,0) + ;"Input: FileNumber -- the file number to work from +"RTN","TMGXMLUI",894,0) + ;" pArray -- a pointer to (i.e. name of) array to work from. Format same as other functions in this module +"RTN","TMGXMLUI",895,0) + ;" indent -- OPTIONAL -- a number of spaces to indent. +"RTN","TMGXMLUI",896,0) + ;"Result -- The file number selected, or 0 if none, or -1 if abort +"RTN","TMGXMLUI",897,0) + +"RTN","TMGXMLUI",898,0) + new result set result=0 +"RTN","TMGXMLUI",899,0) + new fieldName,field,index +"RTN","TMGXMLUI",900,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",901,0) + if (+$get(FileNumber)'>0)!($get(pArray)="") goto AGFDone +"RTN","TMGXMLUI",902,0) + +"RTN","TMGXMLUI",903,0) + ;"Get list of available fields. +"RTN","TMGXMLUI",904,0) + new allFields +"RTN","TMGXMLUI",905,0) + new pickArray +"RTN","TMGXMLUI",906,0) + new pickCt set pickCt=0 +"RTN","TMGXMLUI",907,0) + if $$GetFldList^TMGDBAPI(FileNumber,"allFields")=0 goto PUFDone +"RTN","TMGXMLUI",908,0) + set field=0 +"RTN","TMGXMLUI",909,0) + for do quit:(+field'>0) +"RTN","TMGXMLUI",910,0) + . new fieldName +"RTN","TMGXMLUI",911,0) + . set field=$order(allFields(field)) +"RTN","TMGXMLUI",912,0) + . if (+field>0)&($data(@pArray@(field))=0) do +"RTN","TMGXMLUI",913,0) + . . set pickCt=pickCt+1 +"RTN","TMGXMLUI",914,0) + . . set pickArray(pickCt)=field +"RTN","TMGXMLUI",915,0) + . . set fieldName=$$GetFldName^TMGDBAPI(FileNumber,field) ;"Convert Field Number to Field Name +"RTN","TMGXMLUI",916,0) + . . write ?indent,pickCt,". ",fieldName," (",field,")",! +"RTN","TMGXMLUI",917,0) + . if (pickCt>0)&(((pickCt\10)=(pickCt/10))!(+field'>0)) do +"RTN","TMGXMLUI",918,0) + . . new input +"RTN","TMGXMLUI",919,0) + . . write !,?indent,"Select entry (NOT field number) (1-",pickCt,",^), ",! +"RTN","TMGXMLUI",920,0) + . . write ?indent,"or ENTER to continue: // " +"RTN","TMGXMLUI",921,0) + . . read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",922,0) + . . if $TEST=0 set input="^" +"RTN","TMGXMLUI",923,0) + . . if input="^" set field=-1 quit +"RTN","TMGXMLUI",924,0) + . . if (+input>0)&(+input<(pickCt+1)) do +"RTN","TMGXMLUI",925,0) + . . . set result=pickArray(+input) +"RTN","TMGXMLUI",926,0) + . . . set field=0 ;"signal Done +"RTN","TMGXMLUI",927,0) + +"RTN","TMGXMLUI",928,0) + if pickCt=0 write ?indent,"(All fields have already been selected.)",! +"RTN","TMGXMLUI",929,0) +PUFDone +"RTN","TMGXMLUI",930,0) + quit result +"RTN","TMGXMLUI",931,0) + +"RTN","TMGXMLUI",932,0) + +"RTN","TMGXMLUI",933,0) +CfgOrderFields(File,pArray,indent) +"RTN","TMGXMLUI",934,0) + ;"Purpose: To allow customization of fields ORDER +"RTN","TMGXMLUI",935,0) + ;"Input: File -- name or number, file to get field numbers for +"RTN","TMGXMLUI",936,0) + ;" pArray -- a pointer to (i.e. Name of) array to put field numbers into +"RTN","TMGXMLUI",937,0) + ;" will probably be something one of the following: +"RTN","TMGXMLUI",938,0) + ;" "Array(FileNumber,"TEMPLATE")" +"RTN","TMGXMLUI",939,0) + ;" "Array(FileNumber,RecNumber)" +"RTN","TMGXMLUI",940,0) + ;" indent -- a value to indent from the left margin +"RTN","TMGXMLUI",941,0) + ;"Output: Data is put into pArray +"RTN","TMGXMLUI",942,0) + ;"Result: 1 if OK to continue. 0 if user aborted. +"RTN","TMGXMLUI",943,0) + +"RTN","TMGXMLUI",944,0) + new PriorErrorFound +"RTN","TMGXMLUI",945,0) + new FileNumber,FileName +"RTN","TMGXMLUI",946,0) + new field,count,index +"RTN","TMGXMLUI",947,0) + new input +"RTN","TMGXMLUI",948,0) + new DoneArray set DoneArray="" +"RTN","TMGXMLUI",949,0) + new result set result=1 +"RTN","TMGXMLUI",950,0) + if ($get(File)="")!($get(pArray)="") set result=0 goto COFDone +"RTN","TMGXMLUI",951,0) + +"RTN","TMGXMLUI",952,0) + +"RTN","TMGXMLUI",953,0) + if +File=File do +"RTN","TMGXMLUI",954,0) + . set FileNumber=File +"RTN","TMGXMLUI",955,0) + . set FileName=$$GetFName^TMGDBAPI(File) +"RTN","TMGXMLUI",956,0) + else do +"RTN","TMGXMLUI",957,0) + . set FileName=File +"RTN","TMGXMLUI",958,0) + . set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",959,0) + if FileNumber'>0 do goto COFDone +"RTN","TMGXMLUI",960,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Error: Requested file, "_File_", doesn't exist.") +"RTN","TMGXMLUI",961,0) + set indent=+$get(indent,0) +"RTN","TMGXMLUI",962,0) + +"RTN","TMGXMLUI",963,0) + if $data(@pArray)'>1 set @pArray@("*")="" +"RTN","TMGXMLUI",964,0) + ;"if $data(@pArray@("*"))>0 do goto COFDone ;"ORDER not allowed if all records requested. +"RTN","TMGXMLUI",965,0) + ;". write ?indent,"Note: skipping option for field ordering because ALL fields",! +"RTN","TMGXMLUI",966,0) + ;". write ?indent,"were selected for export.",! +"RTN","TMGXMLUI",967,0) + ;". write ?indent,"(This is a technical limitation of this routine.)",!! +"RTN","TMGXMLUI",968,0) + +"RTN","TMGXMLUI",969,0) +COFLoop +"RTN","TMGXMLUI",970,0) + write ?indent,"Do you wish to customize the ORDER that ",! +"RTN","TMGXMLUI",971,0) + write ?indent,"fields will appear in the XML file? (Y/N,^) NO// " +"RTN","TMGXMLUI",972,0) + new input read input:$get(DTIME,3600),! +"RTN","TMGXMLUI",973,0) + if $TEST=0 set input="^" +"RTN","TMGXMLUI",974,0) + if input="^" set result=0 goto COFDone +"RTN","TMGXMLUI",975,0) + if input="" set input="N" +"RTN","TMGXMLUI",976,0) + set input=$$UP^XLFSTR(input) +"RTN","TMGXMLUI",977,0) + if input'["Y" goto COFDone +"RTN","TMGXMLUI",978,0) + if input="?" do goto COFLoop +"RTN","TMGXMLUI",979,0) + . write ?indent,"If you want to specify the order that the fields will be exported, enter YES.",! +"RTN","TMGXMLUI",980,0) + +"RTN","TMGXMLUI",981,0) +COFL1 +"RTN","TMGXMLUI",982,0) + new maxNum set maxNum=0 +"RTN","TMGXMLUI",983,0) + set index=$order(@pArray@("ORDER","")) +"RTN","TMGXMLUI",984,0) + if index'="" for do quit:(index="") +"RTN","TMGXMLUI",985,0) + . new n set n=@pArray@("ORDER",index) +"RTN","TMGXMLUI",986,0) + . if index>maxNum set maxNum=index +"RTN","TMGXMLUI",987,0) + . set index=$order(@pArray@("ORDER",index)) +"RTN","TMGXMLUI",988,0) + +"RTN","TMGXMLUI",989,0) + set field=$order(@pArray@("")) +"RTN","TMGXMLUI",990,0) + set count=0 +"RTN","TMGXMLUI",991,0) + new CountArray +"RTN","TMGXMLUI",992,0) + if field'="" do +"RTN","TMGXMLUI",993,0) + . write ?indent,"Choose one of the following fields:",! +"RTN","TMGXMLUI",994,0) + if field'="" for do quit:(+field'>0) +"RTN","TMGXMLUI",995,0) + . if $data(DoneArray(field))=0 do +"RTN","TMGXMLUI",996,0) + . . set count=count+1 +"RTN","TMGXMLUI",997,0) + . . set CountArray(count)=field +"RTN","TMGXMLUI",998,0) + . . write ?indent,count,". Field: ",field +"RTN","TMGXMLUI",999,0) + . . if +field=field do +"RTN","TMGXMLUI",1000,0) + . . . write " (",$$GetFldName^TMGDBAPI(File,field),")",! +"RTN","TMGXMLUI",1001,0) + . . else write ! +"RTN","TMGXMLUI",1002,0) + . set field=$order(@pArray@(field)) +"RTN","TMGXMLUI",1003,0) + if count=0 do goto COFDone +"RTN","TMGXMLUI",1004,0) + . write ?indent,"All done specifying field order.",!! +"RTN","TMGXMLUI",1005,0) + . do Pause() +"RTN","TMGXMLUI",1006,0) + +"RTN","TMGXMLUI",1007,0) +COFL2 +"RTN","TMGXMLUI",1008,0) + if count>1 do +"RTN","TMGXMLUI",1009,0) + . write ?indent,"Note: Don't enter actual field number.",! +"RTN","TMGXMLUI",1010,0) + . write ?indent,"Which field should come " +"RTN","TMGXMLUI",1011,0) + . if maxNum=0 write "first." +"RTN","TMGXMLUI",1012,0) + . else write "next." +"RTN","TMGXMLUI",1013,0) + . write "? (1-"_count_",^ to abort) " +"RTN","TMGXMLUI",1014,0) + . read input,!! +"RTN","TMGXMLUI",1015,0) + . if $TEST=0 set input="^" +"RTN","TMGXMLUI",1016,0) + else do +"RTN","TMGXMLUI",1017,0) + . write ?indent,"Only one option left, so I'll enter it for you...",! +"RTN","TMGXMLUI",1018,0) + . set input=1 +"RTN","TMGXMLUI",1019,0) + if ((input<1)!(input>count))&(input'="^") goto COFL2 +"RTN","TMGXMLUI",1020,0) + if input="^" do set result=0 goto COFDone +"RTN","TMGXMLUI",1021,0) + . kill @pArray@("ORDER") +"RTN","TMGXMLUI",1022,0) + . write ?indent,"Because the process of specifying an order",! +"RTN","TMGXMLUI",1023,0) + . write ?indent,"for the fields wasn't completed, the partial ",! +"RTN","TMGXMLUI",1024,0) + . write ?indent,"order information was deleted.",! +"RTN","TMGXMLUI",1025,0) + . do Pause(indent) +"RTN","TMGXMLUI",1026,0) + set maxNum=maxNum+1 +"RTN","TMGXMLUI",1027,0) + new tempField set tempField=$get(CountArray(input)) +"RTN","TMGXMLUI",1028,0) + set @pArray@("ORDER",maxNum)=tempField +"RTN","TMGXMLUI",1029,0) + set DoneArray(tempField)="" +"RTN","TMGXMLUI",1030,0) + goto COFL1 +"RTN","TMGXMLUI",1031,0) + +"RTN","TMGXMLUI",1032,0) +COFDone +"RTN","TMGXMLUI",1033,0) + quit result +"RTN","TMGXMLUI",1034,0) + +"RTN","TMGXMLUI",1035,0) + +"RTN","TMGXMLUI",1036,0) +ShowArray(indent) +"RTN","TMGXMLUI",1037,0) + ;"Purpose: To show the array that composes the XML export request +"RTN","TMGXMLUI",1038,0) + if ($data(TMGxmlArray)>0)&($data(@TMGxmlArray)) do +"RTN","TMGXMLUI",1039,0) + . write ! +"RTN","TMGXMLUI",1040,0) + . new i for i=1:1:indent set indent(i)=0 +"RTN","TMGXMLUI",1041,0) + . do ArrayDump^TMGDEBUG(TMGxmlArray,,.indent) +"RTN","TMGXMLUI",1042,0) + . ;"zwr @TMGxmlArray +"RTN","TMGXMLUI",1043,0) + . write ! +"RTN","TMGXMLUI",1044,0) + do Pause(.indent) +"RTN","TMGXMLUI",1045,0) + quit +"RTN","TMGXMLUI",1046,0) + +"RTN","TMGXMLUI",1047,0) + +"RTN","TMGXMLUI",1048,0) +Pause(indent) +"RTN","TMGXMLUI",1049,0) + ;"Purpose: To prompt user to hit enter to continue +"RTN","TMGXMLUI",1050,0) + ;"Input: indent -- OPTIONAL -- number of spaces to indent from left margin. +"RTN","TMGXMLUI",1051,0) + ;" Note: to call with no value for indent, use "do Pause()" +"RTN","TMGXMLUI",1052,0) + +"RTN","TMGXMLUI",1053,0) + new temp +"RTN","TMGXMLUI",1054,0) + set indent=$get(indent,0) +"RTN","TMGXMLUI",1055,0) + write ?indent +"RTN","TMGXMLUI",1056,0) + read "Press [Enter] to continue...",temp:$get(DTIME,3600),! +"RTN","TMGXMLUI",1057,0) + quit +"RTN","TMGXMLUI",1058,0) + +"RTN","TMGXMLUI",1059,0) +WriteHeader(pHeader,SuppressLF) +"RTN","TMGXMLUI",1060,0) + ;"Purpose: to put a header at the top of the screen +"RTN","TMGXMLUI",1061,0) + ;" The screen will be cleared +"RTN","TMGXMLUI",1062,0) + ;"Note: because global variable IOF is used, the VistA environement must be setup first. +"RTN","TMGXMLUI",1063,0) + ;"Input: pHeader -- expected format: +"RTN","TMGXMLUI",1064,0) + ;" pHeader(1)="First Line" +"RTN","TMGXMLUI",1065,0) + ;" pHeader(2)="Second Line" +"RTN","TMGXMLUI",1066,0) + ;" pHeader("MAX LINE")=2 +"RTN","TMGXMLUI",1067,0) + ;" SuppressLF -- OPTIONAL if =1, then extra LF suppressed +"RTN","TMGXMLUI",1068,0) + ;"Result: none +"RTN","TMGXMLUI",1069,0) + +"RTN","TMGXMLUI",1070,0) + write @IOF +"RTN","TMGXMLUI",1071,0) + if $get(pHeader)="" goto WHDone +"RTN","TMGXMLUI",1072,0) + new max set max=+$get(@pHeader@("MAX LINE")) +"RTN","TMGXMLUI",1073,0) + if max=0 goto WHDone +"RTN","TMGXMLUI",1074,0) + for index=1:1:max do +"RTN","TMGXMLUI",1075,0) + . if $data(@pHeader@(index))=0 quit +"RTN","TMGXMLUI",1076,0) + . new line set line=$get(@pHeader@(index)) +"RTN","TMGXMLUI",1077,0) + . if (line[" Step") do +"RTN","TMGXMLUI",1078,0) + . . if (index<max) do +"RTN","TMGXMLUI",1079,0) + . . . set line=$$Substitute^TMGSTUTL(line," Step","(X) Step") +"RTN","TMGXMLUI",1080,0) + . . else do +"RTN","TMGXMLUI",1081,0) + . . . set line=$$Substitute^TMGSTUTL(line," Step","(_) Step") +"RTN","TMGXMLUI",1082,0) + . write line,! +"RTN","TMGXMLUI",1083,0) + +"RTN","TMGXMLUI",1084,0) + if $get(SuppressLF)'=0 write ! +"RTN","TMGXMLUI",1085,0) + +"RTN","TMGXMLUI",1086,0) +WHDone +"RTN","TMGXMLUI",1087,0) + quit +"RTN","TMGXMLUI",1088,0) + +"RTN","TMGXMLUI",1089,0) +HdrAddLine(pHeader,Line) +"RTN","TMGXMLUI",1090,0) + ;"Purpose: To add Line to end of header array +"RTN","TMGXMLUI",1091,0) + ;"Input: pHeader -- expected format: (it is OK to pass an empty array to be filled) +"RTN","TMGXMLUI",1092,0) + ;" pHeader(1)="First Line" +"RTN","TMGXMLUI",1093,0) + ;" pHeader(2)="Second Line" +"RTN","TMGXMLUI",1094,0) + ;" pHeader("MAX LINE")=2 +"RTN","TMGXMLUI",1095,0) + ;" Line -- a string to be added. +"RTN","TMGXMLUI",1096,0) + ;"result: none +"RTN","TMGXMLUI",1097,0) + +"RTN","TMGXMLUI",1098,0) + if $get(pHeader)="" goto HALDone +"RTN","TMGXMLUI",1099,0) + if $get(Line)="" goto HALDone +"RTN","TMGXMLUI",1100,0) + new max set max=+$get(@pHeader@("MAX LINE")) +"RTN","TMGXMLUI",1101,0) + +"RTN","TMGXMLUI",1102,0) + set max=max+1 +"RTN","TMGXMLUI",1103,0) + set @pHeader@(max)=Line +"RTN","TMGXMLUI",1104,0) + set @pHeader@("MAX LINE")=max +"RTN","TMGXMLUI",1105,0) + +"RTN","TMGXMLUI",1106,0) +HALDone +"RTN","TMGXMLUI",1107,0) + quit +"RTN","TMGXMLUI",1108,0) + +"RTN","TMGXMLUI",1109,0) + +"RTN","TMGXMLUI",1110,0) +HdrDelLine(pHeader,index) +"RTN","TMGXMLUI",1111,0) + ;"Purpose: To delete a line from the header +"RTN","TMGXMLUI",1112,0) + ;"Input: pHeader -- expected format: (it is OK to pass an empty array to be filled) +"RTN","TMGXMLUI",1113,0) + ;" pHeader(1)="First Line" +"RTN","TMGXMLUI",1114,0) + ;" pHeader(2)="Second Line" +"RTN","TMGXMLUI",1115,0) + ;" pHeader("MAX LINE")=2 +"RTN","TMGXMLUI",1116,0) + ;" index -- OPTIONAL -- default is to be the last line +"RTN","TMGXMLUI",1117,0) + +"RTN","TMGXMLUI",1118,0) + if $get(pHeader)="" goto HDLDone +"RTN","TMGXMLUI",1119,0) + new max set max=+$get(@pHeader@("MAX LINE")) +"RTN","TMGXMLUI",1120,0) + if max=0 goto HDLDone +"RTN","TMGXMLUI",1121,0) + set index=$get(index,0) +"RTN","TMGXMLUI",1122,0) + if index=0 set index=max +"RTN","TMGXMLUI",1123,0) + kill @pHeader@(index) +"RTN","TMGXMLUI",1124,0) + if index<max for index=index:1:(max-1) do +"RTN","TMGXMLUI",1125,0) + . set @pHeader@(index)=$get(@pHeader@(index+1)) +"RTN","TMGXMLUI",1126,0) + . kill @pHeader@(index+1) +"RTN","TMGXMLUI",1127,0) + +"RTN","TMGXMLUI",1128,0) + set @pHeader@("MAX LINE")=max-1 +"RTN","TMGXMLUI",1129,0) + +"RTN","TMGXMLUI",1130,0) +HDLDone +"RTN","TMGXMLUI",1131,0) + quit +"RTN","TMGXMLUI",1132,0) + +"RTN","TMGXMLUI",1133,0) +Spaces(Num) +"RTN","TMGXMLUI",1134,0) + ;"purpose to return Num number of spaces +"RTN","TMGXMLUI",1135,0) + new result set result="" +"RTN","TMGXMLUI",1136,0) + set Num=+$get(Num,0) +"RTN","TMGXMLUI",1137,0) + if Num=0 goto SPCDone +"RTN","TMGXMLUI",1138,0) + new i +"RTN","TMGXMLUI",1139,0) + for i=1:1:Num set result=result_" " +"RTN","TMGXMLUI",1140,0) + +"RTN","TMGXMLUI",1141,0) +SPCDone +"RTN","TMGXMLUI",1142,0) + quit result +"RTN","TMGXMLUI",1143,0) + +"RTN","TMGXMLUI",1144,0) + +"RTN","TMGXMLUI",1145,0) + +"RTN","TMGXMLUI",1146,0) + ;"=================================================== +"RTN","TMGXMLUI",1147,0) + +"RTN","TMGXMLUI",1148,0) +GetPtrsOut(File,Array) +"RTN","TMGXMLUI",1149,0) + ;"Purpose: to return a list of all possible pointers out, for a given file +"RTN","TMGXMLUI",1150,0) + ;"Input: File -- name or number of file to investigate +"RTN","TMGXMLUI",1151,0) + ;" Array -- PASS BY REFERENCE. Output format: +"RTN","TMGXMLUI",1152,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1153,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1154,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1155,0) + ;"Results: 1 if some found, 0 if no pointers out. +"RTN","TMGXMLUI",1156,0) + +"RTN","TMGXMLUI",1157,0) + new FileNumber +"RTN","TMGXMLUI",1158,0) + kill Array +"RTN","TMGXMLUI",1159,0) + new found set found=0 +"RTN","TMGXMLUI",1160,0) + +"RTN","TMGXMLUI",1161,0) + if +File=File set FileNumber=File +"RTN","TMGXMLUI",1162,0) + else set FileNumber=$$GetFileNum^TMGDBAPI(File) +"RTN","TMGXMLUI",1163,0) + +"RTN","TMGXMLUI",1164,0) + new field set field=0 +"RTN","TMGXMLUI",1165,0) + for set field=$order(^DD(FileNumber,field)) quit:(field'>0) do +"RTN","TMGXMLUI",1166,0) + . new fldInfo set fldInfo=$piece($get(^DD(FileNumber,field,0)),"^",2) +"RTN","TMGXMLUI",1167,0) + . if fldInfo'["P" quit +"RTN","TMGXMLUI",1168,0) + . new otherFile set otherFile=+$piece(fldInfo,"P",2) +"RTN","TMGXMLUI",1169,0) + . if $$GetFName^TMGDBAPI(otherFile)="" do quit +"RTN","TMGXMLUI",1170,0) + . set Array(FileNumber,"POINTERS OUT",field,otherFile)="" +"RTN","TMGXMLUI",1171,0) + . set found=1 +"RTN","TMGXMLUI",1172,0) + +"RTN","TMGXMLUI",1173,0) + quit found +"RTN","TMGXMLUI",1174,0) + +"RTN","TMGXMLUI",1175,0) + +"RTN","TMGXMLUI",1176,0) +CustPtrOuts(Array,RecsArray) +"RTN","TMGXMLUI",1177,0) + ;"Purpose: Given an array of pointers out (as created by GetPtrsOut), look at the +"RTN","TMGXMLUI",1178,0) + ;" specific group of records (provided in RecsArray) and trim out theoretical +"RTN","TMGXMLUI",1179,0) + ;" pointers, and only leave actual pointers in the list. +"RTN","TMGXMLUI",1180,0) + ;"Input: Array PASS BY REFERENCE. Format: +"RTN","TMGXMLUI",1181,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1182,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1183,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1184,0) + ;" RecsArray +"RTN","TMGXMLUI",1185,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1186,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1187,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1188,0) + ;" Note: Array may well have other information in it. +"RTN","TMGXMLUI",1189,0) + ;"Output: Array pointer will be trimmed such that every pointer listed exists +"RTN","TMGXMLUI",1190,0) + ;" in at least of the records in RecsArray +"RTN","TMGXMLUI",1191,0) + +"RTN","TMGXMLUI",1192,0) + new fileNum,fieldNum,IEN +"RTN","TMGXMLUI",1193,0) + set fileNum="" +"RTN","TMGXMLUI",1194,0) + for set fileNum=$order(Array(fileNum)) quit:(+fileNum'>0) do +"RTN","TMGXMLUI",1195,0) + . set fieldNum="" +"RTN","TMGXMLUI",1196,0) + . for set fieldNum=$order(Array(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do +"RTN","TMGXMLUI",1197,0) + . . ;"Now, for given file:field, do any records in RecsArray contain a value? +"RTN","TMGXMLUI",1198,0) + . . new ref set ref=$get(^DIC(fileNum,0,"GL")) ;"record global ref string (open ended) +"RTN","TMGXMLUI",1199,0) + . . new node set node=$get(^DD(fileNum,fieldNum,0)) ;"node=entire 0 node +"RTN","TMGXMLUI",1200,0) + . . new np set np=$piece(node,"^",4) ;"get node;piece +"RTN","TMGXMLUI",1201,0) + . . new n set n=$piece(np,";",1) ;"n=node +"RTN","TMGXMLUI",1202,0) + . . new p set p=$piece(np,";",2) ;"p=piece +"RTN","TMGXMLUI",1203,0) + . . set IEN="" +"RTN","TMGXMLUI",1204,0) + . . new found set found=0 +"RTN","TMGXMLUI",1205,0) + . . for set IEN=$order(RecsArray(fileNum,IEN)) quit:(+IEN'>0)!(found=1) do +"RTN","TMGXMLUI",1206,0) + . . . new tempRef set tempRef=ref_IEN_","""_n_""")" +"RTN","TMGXMLUI",1207,0) + . . . new line set line=$get(@tempRef) +"RTN","TMGXMLUI",1208,0) + . . . new ptr set ptr=+$piece(line,"^",p) ;"get data from database +"RTN","TMGXMLUI",1209,0) + . . . if ptr>0 set found=1 quit ;"found at least one record in group has an actual pointer +"RTN","TMGXMLUI",1210,0) + . . if found=1 quit ;"don't cut out the theoritical pointers (but no actual data) +"RTN","TMGXMLUI",1211,0) + . . kill Array(fileNum,"POINTERS OUT",fieldNum) +"RTN","TMGXMLUI",1212,0) + +"RTN","TMGXMLUI",1213,0) + quit +"RTN","TMGXMLUI",1214,0) + +"RTN","TMGXMLUI",1215,0) + +"RTN","TMGXMLUI",1216,0) +TrimPtrOut(Array) +"RTN","TMGXMLUI",1217,0) + ;"Purpose: Given array of pointers out (as created by GetPtrsOut, or CustPtrsOut), ask which +"RTN","TMGXMLUI",1218,0) + ;" other files should be ignored. +"RTN","TMGXMLUI",1219,0) + ;"Input: Array. PASS BY REFERENCE. Format: +"RTN","TMGXMLUI",1220,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1221,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1222,0) + ;"Output: for those pointers out that can be ignored, entries will be changed: +"RTN","TMGXMLUI",1223,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="-" <-- Ignore flag +"RTN","TMGXMLUI",1224,0) + ;" Array(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="+" <-- Confirmed flag +"RTN","TMGXMLUI",1225,0) + +"RTN","TMGXMLUI",1226,0) + ;"first, make a temp array that groups pointers out. +"RTN","TMGXMLUI",1227,0) + +"RTN","TMGXMLUI",1228,0) + new Array2 +"RTN","TMGXMLUI",1229,0) + new fileNum set fileNum=0 +"RTN","TMGXMLUI",1230,0) + for set fileNum=$order(Array(fileNum)) quit:(+fileNum'>0) do +"RTN","TMGXMLUI",1231,0) + . new fieldNum set fieldNum=0 +"RTN","TMGXMLUI",1232,0) + . new ref +"RTN","TMGXMLUI",1233,0) + . for set fieldNum=$order(Array(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do +"RTN","TMGXMLUI",1234,0) + . . new otherFileNum set otherFileNum=$order(Array(fileNum,"POINTERS OUT",fieldNum,"")) +"RTN","TMGXMLUI",1235,0) + . . if +otherFileNum'>0 quit +"RTN","TMGXMLUI",1236,0) + . . new ref set ref=$name(Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)) +"RTN","TMGXMLUI",1237,0) + . . new IEN set IEN=$order(^TMG(22708,"B",otherFileNum,"")) +"RTN","TMGXMLUI",1238,0) + . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=0 do quit +"RTN","TMGXMLUI",1239,0) + . . . set Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)="-" +"RTN","TMGXMLUI",1240,0) + . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=1 do quit +"RTN","TMGXMLUI",1241,0) + . . . set Array(fileNum,"POINTERS OUT",fieldNum,otherFileNum)="+" +"RTN","TMGXMLUI",1242,0) + . . set Array2(otherFileNum,ref)="" +"RTN","TMGXMLUI",1243,0) + +"RTN","TMGXMLUI",1244,0) + new menu,count +"RTN","TMGXMLUI",1245,0) + new UsrInput,IEN +"RTN","TMGXMLUI",1246,0) + new TMGFDA,TMGMSG,TMGIEN +"RTN","TMGXMLUI",1247,0) + new ref,%,otherFileNum +"RTN","TMGXMLUI",1248,0) + new otherFileNum +"RTN","TMGXMLUI",1249,0) + +"RTN","TMGXMLUI",1250,0) + if $data(Array2)=0 goto TPODone +"RTN","TMGXMLUI",1251,0) + +"RTN","TMGXMLUI",1252,0) + set menu(0)="Pick Which Pointers are NOT to User Data" +"RTN","TMGXMLUI",1253,0) + set count=1 +"RTN","TMGXMLUI",1254,0) + set otherFileNum=0 +"RTN","TMGXMLUI",1255,0) + for set otherFileNum=$order(Array2(otherFileNum)) quit:(otherFileNum="") do +"RTN","TMGXMLUI",1256,0) + . set menu(count)=$$GetFName^TMGDBAPI(otherFileNum)_$char(9)_otherFileNum_"^"_count +"RTN","TMGXMLUI",1257,0) + . set count=count+1 +"RTN","TMGXMLUI",1258,0) + +"RTN","TMGXMLUI",1259,0) +TPO set UsrInput=$$Menu^TMGUSRIF(.menu) +"RTN","TMGXMLUI",1260,0) + if "x^"[UsrInput goto TPODone +"RTN","TMGXMLUI",1261,0) + if UsrInput["?" do goto TPO +"RTN","TMGXMLUI",1262,0) + . write "Explore which entry above? //" +"RTN","TMGXMLUI",1263,0) + . new temp read temp:$get(DTIME,3600),! +"RTN","TMGXMLUI",1264,0) + . set temp=$piece($get(menu(temp)),$char(9),2) +"RTN","TMGXMLUI",1265,0) + . set temp=$piece(temp,"^",1) +"RTN","TMGXMLUI",1266,0) + . if temp="" quit +"RTN","TMGXMLUI",1267,0) + . new DIC,X,Y +"RTN","TMGXMLUI",1268,0) + . set DIC(0)="MAEQ" +"RTN","TMGXMLUI",1269,0) + . set DIC=+temp +"RTN","TMGXMLUI",1270,0) + . write "Here you can use Fileman to look at entries in file #",temp +"RTN","TMGXMLUI",1271,0) + . do ^DIC write ! +"RTN","TMGXMLUI",1272,0) + set ref="" +"RTN","TMGXMLUI",1273,0) + set count=$piece(UsrInput,"^",2) +"RTN","TMGXMLUI",1274,0) + set UsrInput=$piece(UsrInput,"^",1) +"RTN","TMGXMLUI",1275,0) + for set ref=$order(Array2(UsrInput,ref)) quit:(ref="") do +"RTN","TMGXMLUI",1276,0) + . set @ref="-" +"RTN","TMGXMLUI",1277,0) + . kill menu(count) +"RTN","TMGXMLUI",1278,0) + . set otherFileNum=+$piece(ref,",",4) +"RTN","TMGXMLUI",1279,0) + set %=1 +"RTN","TMGXMLUI",1280,0) + set IEN=$order(^TMG(22708,"B",otherFileNum,"")) +"RTN","TMGXMLUI",1281,0) + if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=0 goto TPO +"RTN","TMGXMLUI",1282,0) + write "Remember that ",$$GetFName^TMGDBAPI(otherFileNum)," DOESN'T contain ",! +"RTN","TMGXMLUI",1283,0) + WRITE " site-specific data (stored in File #22708)" +"RTN","TMGXMLUI",1284,0) + do YN^DICN write ! +"RTN","TMGXMLUI",1285,0) + if %'=1 goto TPO +"RTN","TMGXMLUI",1286,0) + kill TMGMSG,TMGFDA,TMGIEN +"RTN","TMGXMLUI",1287,0) + if +IEN>0 do +"RTN","TMGXMLUI",1288,0) + . set TMGFDA(22708,IEN_",",1)=0 +"RTN","TMGXMLUI",1289,0) + . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGXMLUI",1290,0) + else do +"RTN","TMGXMLUI",1291,0) + . set TMGFDA(22708,"+1,",.01)=otherFileNum +"RTN","TMGXMLUI",1292,0) + . set TMGFDA(22708,"+1,",1)=0 +"RTN","TMGXMLUI",1293,0) + . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGXMLUI",1294,0) + do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGXMLUI",1295,0) + goto TPO +"RTN","TMGXMLUI",1296,0) + +"RTN","TMGXMLUI",1297,0) +TPODone +"RTN","TMGXMLUI",1298,0) + if $data(menu)=0 goto TPOQ +"RTN","TMGXMLUI",1299,0) + if $order(menu(0))="" goto TPOQ +"RTN","TMGXMLUI",1300,0) + new Entry set Entry=0 +"RTN","TMGXMLUI",1301,0) + for set Entry=$order(menu(Entry)) quit:(Entry="") do +"RTN","TMGXMLUI",1302,0) + . write " -- ",$piece(menu(Entry),$char(9),1),! +"RTN","TMGXMLUI",1303,0) + write "Perminantly mark these files as CONTAINING site specific data" +"RTN","TMGXMLUI",1304,0) + set %=1 +"RTN","TMGXMLUI",1305,0) + do YN^DICN write ! +"RTN","TMGXMLUI",1306,0) + if %=1 do +"RTN","TMGXMLUI",1307,0) + . set Entry=0 +"RTN","TMGXMLUI",1308,0) + . for set Entry=$order(menu(Entry)) quit:(Entry="") do +"RTN","TMGXMLUI",1309,0) + . . set UsrInput=$piece(menu(Entry),$char(9),2) +"RTN","TMGXMLUI",1310,0) + . . set otherFileNum=$piece(UsrInput,"^",1) +"RTN","TMGXMLUI",1311,0) + . . set ref="" +"RTN","TMGXMLUI",1312,0) + . . for set ref=$order(Array2(otherFileNum,ref)) quit:(ref="") do +"RTN","TMGXMLUI",1313,0) + . . . set @ref="+" +"RTN","TMGXMLUI",1314,0) + . . set IEN=$order(^TMG(22708,"B",otherFileNum,"")) +"RTN","TMGXMLUI",1315,0) + . . if (IEN'=""),$piece($get(^TMG(22708,IEN,0)),"^",2)=1 quit +"RTN","TMGXMLUI",1316,0) + . . if +IEN>0 do +"RTN","TMGXMLUI",1317,0) + . . . set TMGFDA(22708,IEN_",",1)=1 +"RTN","TMGXMLUI",1318,0) + . . . do FILE^DIE("","TMGFDA","TMGMSG") +"RTN","TMGXMLUI",1319,0) + . . else do +"RTN","TMGXMLUI",1320,0) + . . . kill TMGIEN +"RTN","TMGXMLUI",1321,0) + . . . set TMGFDA(22708,"+1,",.01)=otherFileNum +"RTN","TMGXMLUI",1322,0) + . . . set TMGFDA(22708,"+1,",1)=1 +"RTN","TMGXMLUI",1323,0) + . . . do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") +"RTN","TMGXMLUI",1324,0) + . . do ShowIfDIERR^TMGDEBUG(.TMGMSG) +"RTN","TMGXMLUI",1325,0) + +"RTN","TMGXMLUI",1326,0) +TPOQ +"RTN","TMGXMLUI",1327,0) + quit +"RTN","TMGXMLUI",1328,0) + +"RTN","TMGXMLUI",1329,0) + +"RTN","TMGXMLUI",1330,0) +GetRecsOut(RecsArray,PtrsArray,Array) +"RTN","TMGXMLUI",1331,0) + ;"Purpose: For a given set of records in a file, determine the linked-to record #'s +"RTN","TMGXMLUI",1332,0) + ;" in other files through pointers out. This will return the actual IEN's +"RTN","TMGXMLUI",1333,0) + ;" in other files that are being pointed to. +"RTN","TMGXMLUI",1334,0) + ;"Input -- PtrsArray. PASS BY REFERENCE. Format: +"RTN","TMGXMLUI",1335,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1336,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1337,0) + ;" RecsArray(FileNumber,IENinFile)="" +"RTN","TMGXMLUI",1338,0) + ;" Note: Array may well have other information in it. +"RTN","TMGXMLUI",1339,0) + ;" RecsArray. PASS BY REFERENCE. Format: +"RTN","TMGXMLUI",1340,0) + ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1341,0) + ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="-" <-- flag to ignore +"RTN","TMGXMLUI",1342,0) + ;" PtrsArray(FileNumber,"POINTERS OUT",FieldNum,OtherFileNum)="" +"RTN","TMGXMLUI",1343,0) + ;" Array. PASS BY REFERENCE. An OUT PARAMETER. Format: +"RTN","TMGXMLUI",1344,0) + ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" +"RTN","TMGXMLUI",1345,0) + ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" +"RTN","TMGXMLUI",1346,0) + ;" Array(FileNumber,IEN,FieldNum,"LINKED TO",OtherFileNum,OtherIEN)="" +"RTN","TMGXMLUI",1347,0) + ;" Array("X1",OtherFileNum,OtherIEN)="" +"RTN","TMGXMLUI",1348,0) + ;" Array("X1",OtherFileNum,OtherIEN)="" +"RTN","TMGXMLUI",1349,0) + ;"Output: Array is filled as above. +"RTN","TMGXMLUI",1350,0) + ;"Results: None +"RTN","TMGXMLUI",1351,0) + +"RTN","TMGXMLUI",1352,0) + new fileNum set fileNum=0 +"RTN","TMGXMLUI",1353,0) + for set fileNum=$order(PtrsArray(fileNum)) quit:(+fileNum'>0) do +"RTN","TMGXMLUI",1354,0) + . new IEN set IEN=0 +"RTN","TMGXMLUI",1355,0) + . for set IEN=$order(RecsArray(fileNum,IEN)) quit:(+IEN'>0) do +"RTN","TMGXMLUI",1356,0) + . . new fieldNum set fieldNum=0 +"RTN","TMGXMLUI",1357,0) + . . for set fieldNum=$order(PtrsArray(fileNum,"POINTERS OUT",fieldNum)) quit:(+fieldNum'>0) do +"RTN","TMGXMLUI",1358,0) + . . . new otherFileNum set otherFileNum=$order(PtrsArray(fileNum,"POINTERS OUT",fieldNum,"")) +"RTN","TMGXMLUI",1359,0) + . . . if +otherFileNum'>0 quit +"RTN","TMGXMLUI",1360,0) + . . . new flag set flag=$get(PtrsArray(fileNum,"POINTERS OUT",fieldNum,otherFileNum)) +"RTN","TMGXMLUI",1361,0) + . . . if flag="-" quit +"RTN","TMGXMLUI",1362,0) + . . . new otherIEN set otherIEN=$$GET1^DIQ(fileNum,IEN_",",fieldNum,"I") +"RTN","TMGXMLUI",1363,0) + . . . if +otherIEN'>0 quit +"RTN","TMGXMLUI",1364,0) + . . . set Array(fileNum,IEN,fieldNum,"LINKED TO",otherFileNum,otherIEN)="" +"RTN","TMGXMLUI",1365,0) + . . . if $data(RecsArray(otherFileNum,otherIEN))=0 do +"RTN","TMGXMLUI",1366,0) + . . . . set Array("X1",otherFileNum,otherIEN)="tag=POINTED_TO_RECORD" +"RTN","TMGXMLUI",1367,0) + +"RTN","TMGXMLUI",1368,0) + quit +"RTN","TMGXMLUI",1369,0) + +"RTN","TMGXMLUI",1370,0) + +"RTN","TMGXMLUI",1371,0) + +"RTN","TMGXMLUI",1372,0) +ExpandPtrs(pRecsArray) +"RTN","TMGXMLUI",1373,0) + ;"Purpose: To take selected record set and include records from other files that +"RTN","TMGXMLUI",1374,0) + ;" the selected records point to. Only records in files that marked as holding +"RTN","TMGXMLUI",1375,0) + ;" site-specific data will be added +"RTN","TMGXMLUI",1376,0) + ;" +"RTN","TMGXMLUI",1377,0) + new changed +"RTN","TMGXMLUI",1378,0) + new RecsArray +"RTN","TMGXMLUI",1379,0) + new PtrsArray,Array +"RTN","TMGXMLUI",1380,0) + merge RecsArray=@pRecsArray +"RTN","TMGXMLUI",1381,0) +T1 +"RTN","TMGXMLUI",1382,0) + set changed=0 +"RTN","TMGXMLUI",1383,0) + set fileNum=0 +"RTN","TMGXMLUI",1384,0) + for set fileNum=$order(RecsArray(fileNum)) quit:(fileNum="") do +"RTN","TMGXMLUI",1385,0) + . if $$GetPtrsOut(fileNum,.PtrsArray)=0 goto TQuit +"RTN","TMGXMLUI",1386,0) + . do CustPtrOuts(.PtrsArray,.RecsArray) +"RTN","TMGXMLUI",1387,0) + . do TrimPtrOut(.PtrsArray) +"RTN","TMGXMLUI",1388,0) + . do GetRecsOut(.RecsArray,.PtrsArray,.Array) +"RTN","TMGXMLUI",1389,0) + . if $data(Array("X1")) do +"RTN","TMGXMLUI",1390,0) + . . merge RecsArray=Array("X1") +"RTN","TMGXMLUI",1391,0) + . . set changed=1 +"RTN","TMGXMLUI",1392,0) + . . kill Array("X1") +"RTN","TMGXMLUI",1393,0) + if changed=1 goto T1 +"RTN","TMGXMLUI",1394,0) + +"RTN","TMGXMLUI",1395,0) +TQuit +"RTN","TMGXMLUI",1396,0) + merge @pRecsArray=RecsArray +"RTN","TMGXMLUI",1397,0) + quit +"RTN","TMGXMLUI",1398,0) + +"RTN","TMGXMLUI",1399,0) + +"RTN","TMGXMLUI",1400,0) +Test +"RTN","TMGXMLUI",1401,0) + new Recs,fileNum +"RTN","TMGXMLUI",1402,0) + +"RTN","TMGXMLUI",1403,0) + if $data(^TMG("TMP","KILLTHIS"))=0 do +"RTN","TMGXMLUI",1404,0) + . if $$UI^TMGXMLUI("RecsArray")=0 quit +"RTN","TMGXMLUI",1405,0) + . merge ^TMG("TMP","KILLTHIS")=Recs +"RTN","TMGXMLUI",1406,0) + else do +"RTN","TMGXMLUI",1407,0) + . merge Recs=^TMG("TMP","KILLTHIS") +"RTN","TMGXMLUI",1408,0) + +"RTN","TMGXMLUI",1409,0) + do ExpandPtrs("Recs") +"RTN","TMGXMLUI",1410,0) + +"RTN","TMGXMLUI",1411,0) + quit +"RTN","TMGXMLUI",1412,0) + +"RTN","TMGXMLUI",1413,0) + +"RTN","TMGXPDR") +0^106^B20281682 +"RTN","TMGXPDR",1,0) +TMGXPDR ;TMG/kst/Altered version of XPDR ;03/25/06 +"RTN","TMGXPDR",2,0) + ;;1.0;TMG-LIB;**1**;7/25/05 +"RTN","TMGXPDR",3,0) + +"RTN","TMGXPDR",4,0) + ;"TMGXPDR -- a custom version of XPDR +"RTN","TMGXPDR",5,0) + ;"K. Toppenberg, MD 7-25-05 +"RTN","TMGXPDR",6,0) + +"RTN","TMGXPDR",7,0) +XPDR ;SFISC/RSD - Routine File Edit ;09/17/96 10:05 +"RTN","TMGXPDR",8,0) + ;;8.0;KERNEL;**1,2,44**;Jul 10, 1995 +"RTN","TMGXPDR",9,0) + Q +"RTN","TMGXPDR",10,0) + +"RTN","TMGXPDR",11,0) +UPDT ;update routine file +"RTN","TMGXPDR",12,0) + new DIR,DIRUT,XPD,XPDI,XPDJ +"RTN","TMGXPDR",13,0) + new XPDN ;"array of included (1 node) and excluded (0 node) namespaces +"RTN","TMGXPDR",14,0) + new X,X1,Y,Y1,% +"RTN","TMGXPDR",15,0) + new addCount set addCount=0 +"RTN","TMGXPDR",16,0) + +"RTN","TMGXPDR",17,0) + write !! +"RTN","TMGXPDR",18,0) + write "** ROUTINE File Updater **",! +"RTN","TMGXPDR",19,0) + write "(Allows addition of selected routines to ROUTINE file)",! +"RTN","TMGXPDR",20,0) + write "-----------------------------------------------------------",! +"RTN","TMGXPDR",21,0) + write ! +"RTN","TMGXPDR",22,0) + write "Enter namespace of routines to add (e.g. TIU), or",! +"RTN","TMGXPDR",23,0) + write "routines to exclude from addition (e.g. -TIU)",!! +"RTN","TMGXPDR",24,0) + +"RTN","TMGXPDR",25,0) + set DIR(0)="FO^1:9^K:X'?.1""-""1U.7UNP X" +"RTN","TMGXPDR",26,0) + set DIR("A")="Routine Namespace ([ENTER] if done)" +"RTN","TMGXPDR",27,0) + set DIR("?")="Enter 1 to 8 characters, preceed with ""-"" to exclude namespace" +"RTN","TMGXPDR",28,0) + +"RTN","TMGXPDR",29,0) + ;"XPDN(0=excluded names or 1=include names, namespace)="" +"RTN","TMGXPDR",30,0) + for do quit:$data(DIRUT) +"RTN","TMGXPDR",31,0) + . do ^DIR +"RTN","TMGXPDR",32,0) + . quit:$data(DIRUT) +"RTN","TMGXPDR",33,0) + . set X=($extract(Y,$L(Y))="*") +"RTN","TMGXPDR",34,0) + . set %=($extract(Y)="-") +"RTN","TMGXPDR",35,0) + . set XPDN('%,$extract(Y,%+1,$length(Y)-X))="" +"RTN","TMGXPDR",36,0) + +"RTN","TMGXPDR",37,0) + if ('$data(XPDN))!($data(DTOUT))!($data(DUOUT)) write ! goto UPDTQ +"RTN","TMGXPDR",38,0) + ;"quit:'$data(XPDN)!$data(DTOUT)!$data(DUOUT) +"RTN","TMGXPDR",39,0) + write !!,"NAMESPACE INCLUDE",?35,"EXCLUDE",!,?11,"-------",?35,"-------" +"RTN","TMGXPDR",40,0) + set (X,Y)="" +"RTN","TMGXPDR",41,0) + set (X1,Y1)=1 +"RTN","TMGXPDR",42,0) + for do write !?11,X,?35,Y quit:'X1&'Y1 +"RTN","TMGXPDR",43,0) + . set:X1 X=$O(XPDN(1,X)),X1=X]"" +"RTN","TMGXPDR",44,0) + . set:Y1 Y=$O(XPDN(0,Y)),Y1=Y]"" +"RTN","TMGXPDR",45,0) + +"RTN","TMGXPDR",46,0) + kill DIR +"RTN","TMGXPDR",47,0) + set DIR(0)="Y" +"RTN","TMGXPDR",48,0) + set DIR("A")="OK to continue" +"RTN","TMGXPDR",49,0) + set DIR("B")="YES" +"RTN","TMGXPDR",50,0) + do ^DIR +"RTN","TMGXPDR",51,0) + +"RTN","TMGXPDR",52,0) + quit:'Y!$data(DIRUT) +"RTN","TMGXPDR",53,0) + write ! +"RTN","TMGXPDR",54,0) + set DIR(0)="Y" +"RTN","TMGXPDR",55,0) + set DIR("A")="Want me to clean up the Routine File before updating" +"RTN","TMGXPDR",56,0) + set DIR("?")="YES means you want to go throught the Routine file and delete any routine name that no longer exists on the system." +"RTN","TMGXPDR",57,0) + do ^DIR +"RTN","TMGXPDR",58,0) + +"RTN","TMGXPDR",59,0) + quit:$data(DIRUT) +"RTN","TMGXPDR",60,0) + do WAIT^DICD +"RTN","TMGXPDR",61,0) + write ! +"RTN","TMGXPDR",62,0) + do DELRTN:Y +"RTN","TMGXPDR",63,0) + +"RTN","TMGXPDR",64,0) + ;"---------------------------------------------------------------------------- +"RTN","TMGXPDR",65,0) + ;"Replacement code for below... +"RTN","TMGXPDR",66,0) + new XPDArray +"RTN","TMGXPDR",67,0) + merge XPDArray=XPDN(1) ;"node 1=>included namespaces +"RTN","TMGXPDR",68,0) + ;"ensure that all entries end with "*" (e.g. "TMG*" not "TMG") +"RTN","TMGXPDR",69,0) + set XPDI=$order(XPDArray("")) +"RTN","TMGXPDR",70,0) + if XPDI'="" for do quit:XPDI="" +"RTN","TMGXPDR",71,0) + . new node set node=XPDI +"RTN","TMGXPDR",72,0) + . set XPDI=$order(XPDArray(node)) +"RTN","TMGXPDR",73,0) + . if ($extract(node,$length(node))'="*") do +"RTN","TMGXPDR",74,0) + . . kill XPDArray(node) +"RTN","TMGXPDR",75,0) + . . set XPDArray(node_"*")="" +"RTN","TMGXPDR",76,0) + +"RTN","TMGXPDR",77,0) + do NOINT^%RSEL("XPDArray") ;"creates %ZR - an array of existing routines matching input request +"RTN","TMGXPDR",78,0) + set XPDJ="" +"RTN","TMGXPDR",79,0) + for do quit:XPDJ="" +"RTN","TMGXPDR",80,0) + . set XPDJ=$order(%ZR(XPDJ)) +"RTN","TMGXPDR",81,0) + . if XPDJ="" quit +"RTN","TMGXPDR",82,0) + . if $data(XPDN(0,XPDJ)) quit ;"if name XPDJ is in the exclude list, skip +"RTN","TMGXPDR",83,0) + . if $order(^DIC(9.8,"B",XPDJ,0)) quit ;"if name XPDJ is already in Routine file, skip +"RTN","TMGXPDR",84,0) + . ;"check if XPDJ is refered in the EXCLUDED namespace by checking the subscript before XPDJ +"RTN","TMGXPDR",85,0) + . set %=$order(XPDN(0,XPDJ),-1) +"RTN","TMGXPDR",86,0) + . ;"if sub exist and $piece(XPDJ,sub)="" then it is part of the namespace, quit +"RTN","TMGXPDR",87,0) + . if ($length(%)>0)&($piece(XPDJ,%)="") quit +"RTN","TMGXPDR",88,0) + . ;"Add routine to ROUTINE file +"RTN","TMGXPDR",89,0) + . new XPD +"RTN","TMGXPDR",90,0) + . set XPD(9.8,"+1,",.01)=XPDJ +"RTN","TMGXPDR",91,0) + . set XPD(9.8,"+1,",1)="R" +"RTN","TMGXPDR",92,0) + . do ADD^DICA("","XPD") +"RTN","TMGXPDR",93,0) + . write "Added: ",XPDJ,! +"RTN","TMGXPDR",94,0) + . set addCount=addCount+1 +"RTN","TMGXPDR",95,0) +UPDTQ +"RTN","TMGXPDR",96,0) + write " ...Done.",! +"RTN","TMGXPDR",97,0) + if addCount=0 write "ROUTINE file already up to date. No additions needed.",! +"RTN","TMGXPDR",98,0) + else write addCount," entries added to ROUTINE file.",! +"RTN","TMGXPDR",99,0) + write "Leaving ROUTINE File Updater.",! +"RTN","TMGXPDR",100,0) + quit +"RTN","TMGXPDR",101,0) + +"RTN","TMGXPDR",102,0) + ;"---------------------------------------------------------------------------- +"RTN","TMGXPDR",103,0) + +"RTN","TMGXPDR",104,0) + ;"loop thru include list XPDN(1,*), i.e. included nodes-->requested namespaces +"RTN","TMGXPDR",105,0) + ;"Goal: to consider each requested namespace... +"RTN","TMGXPDR",106,0) + +"RTN","TMGXPDR",107,0) + ;"Pseudocode: +"RTN","TMGXPDR",108,0) + ;" loop (through all requested namespaces) +"RTN","TMGXPDR",109,0) + ;" XPDI = currently considered namespace +"RTN","TMGXPDR",110,0) + ;" loop (through all available routines--starting at XPDI) +"RTN","TMGXPDR",111,0) + ;" XPDJ is current routine name being considered -- from all available routines +"RTN","TMGXPDR",112,0) + ;" if current routine name (XPDJ) is in exclude list, skip +"RTN","TMGXPDR",113,0) + ;" if current routine name (XPDJ) is already in the ROUTINE file, then skip +"RTN","TMGXPDR",114,0) + ;" ... (to be completed) +"RTN","TMGXPDR",115,0) + +"RTN","TMGXPDR",116,0) + ;set XPDI="" +"RTN","TMGXPDR",117,0) + ;for do quit:XPDI="" +"RTN","TMGXPDR",118,0) + ;. set XPDI=$order(XPDN(1,XPDI)) +"RTN","TMGXPDR",119,0) + ;. quit:XPDI="" +"RTN","TMGXPDR",120,0) + ;. set XPDJ=XPDI +"RTN","TMGXPDR",121,0) + ;. if '$data(^$routine(XPDJ)) quit +"RTN","TMGXPDR",122,0) + ;. for set XPDJ=$order(^$routine(XPDJ)) quit:(XPDJ="")!($piece(XPDJ,XPDI)]"") do +"RTN","TMGXPDR",123,0) + ;. . if $data(XPDN(0,XPDJ)) quit ;"if name XPDJ is in the exclude list, XPDN(0,XPDJ) quit +"RTN","TMGXPDR",124,0) + ;. . if $order(^DIC(9.8,"B",XPDJ,0)) quit ;"if name XPDJ is in Routine file, quit +"RTN","TMGXPDR",125,0) + ;. . ;"check if XPDJ is refered in the EXCLUDED namespace by checking the subscript before XPDJ +"RTN","TMGXPDR",126,0) + ;. . set %=$order(XPDN(0,XPDJ),-1) +"RTN","TMGXPDR",127,0) + ;. . ;"if sub exist and $piece(XPDJ,sub)="" then it is part of the namespace, quit +"RTN","TMGXPDR",128,0) + ;. . if ($length(%)>0)&($piece(XPDJ,%)="") quit ;"e.g $piece("TMGTEST", +"RTN","TMGXPDR",129,0) + ;. . new XPD +"RTN","TMGXPDR",130,0) + ;. . set XPD(9.8,"+1,",.01)=XPDJ +"RTN","TMGXPDR",131,0) + ;. . set XPD(9.8,"+1,",1)="R" +"RTN","TMGXPDR",132,0) + ;. . do ADD^DICA("","XPD") +"RTN","TMGXPDR",133,0) + ;write " ...Done.",! +"RTN","TMGXPDR",134,0) + ;quit +"RTN","TMGXPDR",135,0) + +"RTN","TMGXPDR",136,0) +VER ;verify Routine file +"RTN","TMGXPDR",137,0) + N DIR,DIRUT,X,Y +"RTN","TMGXPDR",138,0) + W !,"I will delete all entries in the ROUTINE file in which",!,"the Routine no longer exist on this system!",! +"RTN","TMGXPDR",139,0) + S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="YES" D ^DIR +"RTN","TMGXPDR",140,0) + Q:'Y!$D(DIRUT) D DELRTN +"RTN","TMGXPDR",141,0) + W " ...Done.",! +"RTN","TMGXPDR",142,0) + Q +"RTN","TMGXPDR",143,0) +DELRTN ;delete routine file entries +"RTN","TMGXPDR",144,0) + N DA,DIK,Y,count,max,delNum +"RTN","TMGXPDR",145,0) + S DIK="^DIC(9.8,",DA=0,count=0,max=0,delNum=0 +"RTN","TMGXPDR",146,0) + ;" F S DA=$O(^DIC(9.8,DA)) Q:'DA S Y=$G(^(DA,0)) I $P(Y,U,2)="R",$T(^@$P(Y,U))="" D ^DIK +"RTN","TMGXPDR",147,0) + do INIT^XPDID +"RTN","TMGXPDR",148,0) + for set DA=$order(^DIC(9.8,DA)) quit:'DA set max=max+1 +"RTN","TMGXPDR",149,0) + if max=0 set max=1 +"RTN","TMGXPDR",150,0) + set XPDIDTOT=max +"RTN","TMGXPDR",151,0) + do TITLE^XPDID("Scanning for Entries to Remove...") +"RTN","TMGXPDR",152,0) + set DA=0 +"RTN","TMGXPDR",153,0) + write !,"Starting search...",! +"RTN","TMGXPDR",154,0) + for set DA=$order(^DIC(9.8,DA)) quit:'DA do +"RTN","TMGXPDR",155,0) + . set count=count+1 +"RTN","TMGXPDR",156,0) + . if count#50=0 do UPDATE^XPDID(count) +"RTN","TMGXPDR",157,0) + . set Y=$G(^(DA,0)) +"RTN","TMGXPDR",158,0) + . if ($piece(Y,U,2)="R")&($text(^@$piece(Y,U))="") do +"RTN","TMGXPDR",159,0) + . . write "Removing: ",$piece(Y,U),! +"RTN","TMGXPDR",160,0) + . . set delNum=delNum+1 +"RTN","TMGXPDR",161,0) + . . do ^DIK +"RTN","TMGXPDR",162,0) + write ! +"RTN","TMGXPDR",163,0) + if delNum>0 do +"RTN","TMGXPDR",164,0) + . new temp +"RTN","TMGXPDR",165,0) + . write "Done scanning. ",delNum," Entries removed.",! +"RTN","TMGXPDR",166,0) + . read "Please press [ENTER] to continue.",temp:$get(DTIME,3600),! +"RTN","TMGXPDR",167,0) + do EXIT^XPDID() +"RTN","TMGXPDR",168,0) + quit +"RTN","TMGXPDR",169,0) +PURGE ;purge file +"RTN","TMGXPDR",170,0) + N DA,DIK,DIR,DIRUT,X,XPD,XPDF,XPDI,XPDJ,XPDL,XPDN,XPDPG,XPDS,XPDUL,Y,Z +"RTN","TMGXPDR",171,0) + S DIR("?")="Enter the file you want to purge the data from.",DIR(0)="SM^B:Build;I:Install;ALL:Build & Install",DIR("A")="Purge from what file(s)" +"RTN","TMGXPDR",172,0) + D ^DIR Q:$D(DIRUT) +"RTN","TMGXPDR",173,0) + S XPDF=$S(Y="I":9.7,1:9.6) S:Y="ALL" XPDF(1)=9.7 +"RTN","TMGXPDR",174,0) + K DIR S DIR("?")="Enter the number of Versions to keep in the file, for each package",DIR(0)="N^0:100:0",DIR("A")="Versions to Retain",DIR("B")=1 +"RTN","TMGXPDR",175,0) + D ^DIR Q:$D(DIRUT) S XPDN=Y +"RTN","TMGXPDR",176,0) + K DIR +"RTN","TMGXPDR",177,0) + S DIR(0)="FO^3:30",DIR("?")="^D PURGEH^XPDR",DIR("A")="Package Name",DIR("B")="ALL" +"RTN","TMGXPDR",178,0) + F D ^DIR Q:$D(DIRUT) S XPD(X)="" Q:X="ALL" K DIR("B") S DIR("A")="Another Package Name" +"RTN","TMGXPDR",179,0) + Q:'$D(XPD) +"RTN","TMGXPDR",180,0) + ;if they want all, make sure all is the only one +"RTN","TMGXPDR",181,0) + I $D(XPD("ALL")) K XPD S XPD("ALL")="" +"RTN","TMGXPDR",182,0) + ;XPDF(1) is defined if doing both files, do purge twice +"RTN","TMGXPDR",183,0) + K ^TMP($J) D PURGE1(XPDF),PURGE1($G(XPDF(1))):$D(XPDF(1)) +"RTN","TMGXPDR",184,0) + I '$D(^TMP($J)) W !!,"No match found" Q +"RTN","TMGXPDR",185,0) + K XPD,DIR +"RTN","TMGXPDR",186,0) + S DIR(0)="E",$P(XPDUL,"-",IOM)="" +"RTN","TMGXPDR",187,0) + ;if ALL, reset XPDF to next file and Do, then reset back to 9.6 +"RTN","TMGXPDR",188,0) + D I $D(XPDF(1)) D ^DIR I Y S XPDF=XPDF(1) D S XPDF=9.6 +"RTN","TMGXPDR",189,0) + .S XPD="^TMP("_$J_","_XPDF,XPDS=XPD_",",XPD=XPD_")",XPDL=$L(XPDS),XPDPG=1,Y=1 +"RTN","TMGXPDR",190,0) + .W @IOF D HDR +"RTN","TMGXPDR",191,0) + .;loop thru ^TMP($J,file,package) & show list, quit if user "^" +"RTN","TMGXPDR",192,0) + .F S XPD=$Q(@XPD) Q:XPD=""!($E(XPD,1,XPDL)'=XPDS) D Q:'Y +"RTN","TMGXPDR",193,0) + ..S Z=@XPD W $P(Z,"^"),$S($P(Z,"^",3):" (duplicates)",1:""),! Q:$Y<(IOSL-4) +"RTN","TMGXPDR",194,0) + ..D ^DIR Q:'Y +"RTN","TMGXPDR",195,0) + ..S XPDPG=XPDPG+1 W @IOF D HDR +"RTN","TMGXPDR",196,0) + S DIR(0)="Y",DIR("A")="OK to DELETE these entries",DIR("B")="NO" +"RTN","TMGXPDR",197,0) + W !! D ^DIR +"RTN","TMGXPDR",198,0) + I $D(DIRUT)!'Y W !!,"Nothing Purged" Q +"RTN","TMGXPDR",199,0) + ;loop thru and delete +"RTN","TMGXPDR",200,0) + D I $D(XPDF(1)) S XPDF=XPDF(1) D +"RTN","TMGXPDR",201,0) + .S DIK="^XPD("_XPDF_",",XPD="^TMP("_$J_","_XPDF,XPDS=XPD_",",XPD=XPD_")",XPDL=$L(XPDS) +"RTN","TMGXPDR",202,0) + .F S XPD=$Q(@XPD) Q:XPD=""!($E(XPD,1,XPDL)'=XPDS) D +"RTN","TMGXPDR",203,0) + ..S XPDI=@XPD F XPDJ=2:1 S DA=$P(XPDI,"^",XPDJ) Q:'DA D ^DIK +"RTN","TMGXPDR",204,0) + Q +"RTN","TMGXPDR",205,0) + ; +"RTN","TMGXPDR",206,0) +PURGE1(XPDF) ;XPDF=file # +"RTN","TMGXPDR",207,0) + N XPDFL,XPDI,XPDJ,XPDP,XPDV,Y,Z +"RTN","TMGXPDR",208,0) + W "." +"RTN","TMGXPDR",209,0) + ;if All, loop thru B x-ref +"RTN","TMGXPDR",210,0) + I $D(XPD("ALL")) D +"RTN","TMGXPDR",211,0) + .S XPDI="" +"RTN","TMGXPDR",212,0) + .F S XPDI=$O(^XPD(XPDF,"B",XPDI)) Q:XPDI="" D +"RTN","TMGXPDR",213,0) + ..S X=$$PKG^XPDUTL(XPDI) D PURGE2(X) +"RTN","TMGXPDR",214,0) + ..W "." +"RTN","TMGXPDR",215,0) + E S XPDI="" F S XPDI=$O(XPD(XPDI)) Q:XPDI="" D +"RTN","TMGXPDR",216,0) + .D PURGE2(XPDI) +"RTN","TMGXPDR",217,0) + .W "." +"RTN","TMGXPDR",218,0) + ;loop thru each package, XPDP=package name +"RTN","TMGXPDR",219,0) + S XPDP="" F S XPDP=$O(^TMP($J,XPDF,XPDP)) Q:XPDP="" D +"RTN","TMGXPDR",220,0) + .S XPDV="",XPDL=XPDN +"RTN","TMGXPDR",221,0) + .;the last is the most recent, XPDN = number to retain, XPDV=version +"RTN","TMGXPDR",222,0) + .;XPDS=type (T/V/Z) +"RTN","TMGXPDR",223,0) + .F S XPDV=$O(^TMP($J,XPDF,XPDP,XPDV),-1),XPDS="" Q:'XPDV!'XPDL F S XPDS=$O(^TMP($J,XPDF,XPDP,XPDV,XPDS),-1) Q:XPDS=""!'XPDL D +"RTN","TMGXPDR",224,0) + ..S Y="" F S Y=$O(^TMP($J,XPDF,XPDP,XPDV,XPDS,Y),-1) Q:Y=""!'XPDL D +"RTN","TMGXPDR",225,0) + ...I $D(^TMP($J,XPDF,XPDP,XPDV,XPDS,Y))#2 K ^(Y) S XPDL=XPDL-1 Q +"RTN","TMGXPDR",226,0) + ...S Z="" F S Z=$O(^TMP($J,XPDF,XPDP,XPDV,XPDS,Y,Z),-1) Q:Z=""!'XPDL K ^(Z) S XPDL=XPDL-1 +"RTN","TMGXPDR",227,0) + Q +"RTN","TMGXPDR",228,0) + ; +"RTN","TMGXPDR",229,0) +PURGE2(XPDX) ;XPDX=package name +"RTN","TMGXPDR",230,0) + ;XPDFL=1 this is not a patch, quit when we find a patch during loop +"RTN","TMGXPDR",231,0) + S XPDS=XPDX,XPDL=$L(XPDX),XPDFL=XPDX'["*" +"RTN","TMGXPDR",232,0) + ;loop and find matches +"RTN","TMGXPDR",233,0) + D F S XPDS=$O(^XPD(XPDF,"B",XPDS)) Q:XPDS=""!($E(XPDS,1,XPDL)'=XPDX)!($S(XPDFL:XPDS["*",1:0)) D +"RTN","TMGXPDR",234,0) + .S Y=$O(^XPD(XPDF,"B",XPDS,0)) Q:'Y +"RTN","TMGXPDR",235,0) + .Q:'$D(^XPD(XPDF,Y,0)) S Z=^(0),Y=XPDS_"^"_Y +"RTN","TMGXPDR",236,0) + .;can't delete Installs that status isn't 'Install Completed' +"RTN","TMGXPDR",237,0) + .I XPDF=9.7 Q:$P(Z,U,9)<3 +"RTN","TMGXPDR",238,0) + .S XPDV=$$VER^XPDUTL(XPDS) +"RTN","TMGXPDR",239,0) + .;TMP($J,file,package name,version,"*","T/V/Z",num,patch)=NAME^DA^duplicat DAs +"RTN","TMGXPDR",240,0) + .I XPDS["*" D Q +"RTN","TMGXPDR",241,0) + ..I XPDV?1.2N1"."1.2N S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"*Z",0,+$P(XPDS,"*",3))=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",242,0) + ..I XPDV["T" S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"*T",+$P(XPDV,"T",2),+$P(XPDS,"*",3))=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",243,0) + ..I XPDV["V" S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"*V",+$P(XPDV,"V",2),+$P(XPDS,"*",3))=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",244,0) + ..S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"*",+$P(XPDS,"*",3))=Y_$$DUP(XPDS,$P(Y,"^",2)) +"RTN","TMGXPDR",245,0) + .;TMP($J,file,package name,version,"Z",0)=NAME^DA^duplicate DAs +"RTN","TMGXPDR",246,0) + .I XPDV?1.2N1"."1.2N S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"Z",0)=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",247,0) + .;TMP($J,file,package name,version,"T/V",num)=NAME^DA^dup DAs +"RTN","TMGXPDR",248,0) + .I XPDV["T" S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"T",+$P(XPDV,"T",2))=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",249,0) + .I XPDV["V" S ^TMP($J,XPDF,$$PKG^XPDUTL(XPDS),+XPDV,"V",+$P(XPDV,"V",2))=Y_$$DUP(XPDS,$P(Y,"^",2)) Q +"RTN","TMGXPDR",250,0) + Q +"RTN","TMGXPDR",251,0) +PURGEH ;executable help from DIR call at PURGE+8 +"RTN","TMGXPDR",252,0) + W:$E(DIR("A"),1)="P" !,"Enter 'ALL' to purge all packages, or" +"RTN","TMGXPDR",253,0) + W !,"Enter the name of the Package you want to Purge.",!," i.e. KERNEL 8.0 will purge version 8.0Tx and 8.0Vx",!," XU*8.0 will purge all patches for 8.0",! +"RTN","TMGXPDR",254,0) + N DIR,X,Y +"RTN","TMGXPDR",255,0) + S DIR(0)="Y",DIR("A")="Want to see the "_$S(XPDF=9.7:"Install File",$D(XPDF(1)):"Build & Install Files",1:"Build File")_" List",DIR("B")="Y" +"RTN","TMGXPDR",256,0) + D ^DIR Q:'Y!$D(DIRUT) +"RTN","TMGXPDR",257,0) + D PURGEH1("^XPD(9.6,"):XPDF=9.6,PURGEH1("^XPD(9.7,"):XPDF=9.7!$D(XPDF(1)) +"RTN","TMGXPDR",258,0) + Q +"RTN","TMGXPDR",259,0) + ; +"RTN","TMGXPDR",260,0) +DUP(Z,Z1) ;find duplicate, Z=NAME, Z1=last ien +"RTN","TMGXPDR",261,0) + ;returns Y=DA^dup DA^dup DA... +"RTN","TMGXPDR",262,0) + N Y S Y="" +"RTN","TMGXPDR",263,0) + F S Z1=$O(^XPD(XPDF,"B",Z,Z1)) Q:'Z1 S Y=Y_"^"_Z1 +"RTN","TMGXPDR",264,0) + Q Y +"RTN","TMGXPDR",265,0) + ; +"RTN","TMGXPDR",266,0) +PURGEH1(DIC) ; +"RTN","TMGXPDR",267,0) + W !!,$S(DIC[9.6:"BUILD ",1:"INSTALL ")_"File" +"RTN","TMGXPDR",268,0) + S DIC(0)="QE",X="??" D ^DIC +"RTN","TMGXPDR",269,0) + Q +"RTN","TMGXPDR",270,0) + ; +"RTN","TMGXPDR",271,0) +HDR W !,"Package(s) in ",$S(XPDF=9.7:"INSTALL",1:"BUILD")," File, " +"RTN","TMGXPDR",272,0) + I XPDN W "Retain last ",$S(XPDN=1:"version",1:XPDN_" versions") +"RTN","TMGXPDR",273,0) + E W "Don't retain any versions" +"RTN","TMGXPDR",274,0) + W ?70,"PAGE ",XPDPG,!,XPDUL,! +"RTN","TMGXPDR",275,0) + Q +"RTN","TMGXSBOX") +0^107^B6893011 +"RTN","TMGXSBOX",1,0) +TMGXGSBOX ;SFISC/VYD - screen rectengular region primitives ;10/31/94 15:38 +"RTN","TMGXSBOX",2,0) + ;;8.0;KERNEL;;5/5/2007 by //kt +"RTN","TMGXSBOX",3,0) + ; +"RTN","TMGXSBOX",4,0) +FRAME(T,L,B,R,A,C) ;draw a border +"RTN","TMGXSBOX",5,0) + ;TOP,LEFT,BOTTOM,RIGHT,ATTRIBUTE,frame character +"RTN","TMGXSBOX",6,0) + N %,%L2,%R2,M,S,X,Y ;M=middle S=string +"RTN","TMGXSBOX",7,0) + N XGSAVATR +"RTN","TMGXSBOX",8,0) + I B'>T N IOBLC,IOBRC S (IOBLC,IOBRC)=IOHL ;to draw horizontal line +"RTN","TMGXSBOX",9,0) + I R'>L N IOTRC,IOBRC S (IOTRC,IOBRC)=IOVL ;to draw vertical line +"RTN","TMGXSBOX",10,0) + S M=R-L-1 +"RTN","TMGXSBOX",11,0) + S %L2=L+1,%R2=R+1 +"RTN","TMGXSBOX",12,0) + ;if frame character passed set frame parts to it, disable graphics +"RTN","TMGXSBOX",13,0) + S:$L($G(C)) (IOBLC,IOBRC,IOHL,IOTLC,IOTRC,IOVL)=C +"RTN","TMGXSBOX",14,0) + S XGSAVATR=XGCURATR ;save current screen attributes +"RTN","TMGXSBOX",15,0) + W $$CHG^XGSA($G(A)_$S($L($G(C)):"",1:"G1")) ;turn on gr attr & leave on +"RTN","TMGXSBOX",16,0) + S S=IOTLC_$TR($J("",M)," ",IOHL)_IOTRC +"RTN","TMGXSBOX",17,0) + S $E(XGSCRN(T,0),%L2,%R2)=S +"RTN","TMGXSBOX",18,0) + S $E(XGSCRN(T,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR) +"RTN","TMGXSBOX",19,0) + ;W $$IOXY^TMGXGS(T,L)_S ;top line with corners ;"//kt +"RTN","TMGXSBOX",20,0) + DO CLIOXY^TMGXGS(T,L,S) ;top line with corners ;"//kt +"RTN","TMGXSBOX",21,0) + F Y=T+1:1:B-1 D +"RTN","TMGXSBOX",22,0) + . F X=%L2,%R2 S $E(XGSCRN(Y,0),X)=IOVL,$E(XGSCRN(Y,1),X)=XGCURATR +"RTN","TMGXSBOX",23,0) + . ;W $$IOXY^TMGXGS(Y,L)_IOVL_$$IOXY^TMGXGS(Y,R)_IOVL ;"//kt +"RTN","TMGXSBOX",24,0) + . DO CLIOXY^TMGXGS(Y,L,IOVL) DO CLIOXY^TMGXGS(Y,R,IOVL) ;"//kt +"RTN","TMGXSBOX",25,0) + S S=IOBLC_$TR($J("",M)," ",IOHL)_IOBRC +"RTN","TMGXSBOX",26,0) + S $E(XGSCRN(B,0),%L2,%R2)=S +"RTN","TMGXSBOX",27,0) + S $E(XGSCRN(B,1),%L2,%R2)=$TR($J("",(R-L+1))," ",XGCURATR) +"RTN","TMGXSBOX",28,0) + ;W $$IOXY^TMGXGS(B,L)_S ;bottom line with corners ;"//kt +"RTN","TMGXSBOX",29,0) + DO CLIOXY^TMGXGS(B,L,S) ;bottom line with corners ;"//kt +"RTN","TMGXSBOX",30,0) + W $$SET^XGSA(XGSAVATR) ;restore previous attributes +"RTN","TMGXSBOX",31,0) + D:$L($G(C)) GSET^%ZISS ;restore line drawing characters +"RTN","TMGXSBOX",32,0) + S $Y=B,$X=R +"RTN","TMGXSBOX",33,0) + Q +"RTN","TMGXSBOX",34,0) + ; +"RTN","TMGXSBOX",35,0) +CLEAR(T,L,B,R) ;clear a portion of the screen +"RTN","TMGXSBOX",36,0) + N %L2,%R2,I,M ;M=length of middle +"RTN","TMGXSBOX",37,0) + S %L2=L+1,%R2=R+1,M=R-L+1 +"RTN","TMGXSBOX",38,0) + F I=T:1:B D +"RTN","TMGXSBOX",39,0) + . S $E(XGSCRN(I,0),%L2,%R2)=$J("",M) +"RTN","TMGXSBOX",40,0) + . S $E(XGSCRN(I,1),%L2,%R2)=$TR($J("",M)," ",XGCURATR) +"RTN","TMGXSBOX",41,0) + . ;W $$IOXY^TMGXGS(I,L)_$J("",M) ;"//kt +"RTN","TMGXSBOX",42,0) + . DO CLIOXY^TMGXGS(I,L,$J("",M)) ;"//kt +"RTN","TMGXSBOX",43,0) + S $Y=B,$X=R +"RTN","TMGXSBOX",44,0) + Q +"RTN","TMGXUP") +0^108^B98358 +"RTN","TMGXUP",1,0) +TMGXUP ;TMG/kst/Altered version of XUP ;03/25/06 +"RTN","TMGXUP",2,0) + ;;1.0;TMG-LIB;**1**;12/23/05 +"RTN","TMGXUP",3,0) + +"RTN","TMGXUP",4,0) + ;"Customized version of Vista XUP module +"RTN","TMGXUP",5,0) + ;"=================================================================================== +"RTN","TMGXUP",6,0) + ;"The following section started as essentially a copy of ^XUP code, to allow me to +"RTN","TMGXUP",7,0) + ;" use just part of it to set up the programmers environment +"RTN","TMGXUP",8,0) + ;"...As time has gone on, though, I have added more tweaks... +"RTN","TMGXUP",9,0) + ;"=================================================================================== +"RTN","TMGXUP",10,0) +XUP() +"RTN","TMGXUP",11,0) + ;"Purpose: Because this configurator will be working with the database, +"RTN","TMGXUP",12,0) + ;" it must have a proper environment setup. And user must have +"RTN","TMGXUP",13,0) + ;" proper access. So this function will set up everything needed. +"RTN","TMGXUP",14,0) + ;"Output: Environmental variables are setup. +"RTN","TMGXUP",15,0) + ;"Result: 1=OK to continue. 0=Abort +"RTN","TMGXUP",16,0) + +"RTN","TMGXUP",17,0) + ;"Consider: +"RTN","TMGXUP",18,0) + ;"DT^DICRW: Required Variables +"RTN","TMGXUP",19,0) + ;"Sets up the required variables of VA FileMan. There are no input variables; +"RTN","TMGXUP",20,0) + ;"simply call the routine at this entry point. +"RTN","TMGXUP",21,0) + ;"NOTE: This entry point kills the variables DIC and DIK. +"RTN","TMGXUP",22,0) + +"RTN","TMGXUP",23,0) + new result set result=cOKToCont +"RTN","TMGXUP",24,0) + if $get(TMGDEBUG)>0 do DebugEntry^TMGDEBUG(.DBIndent,"^XUP") +"RTN","TMGXUP",25,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Inside XML Scripter, setting up programmer environment.") +"RTN","TMGXUP",26,0) + +"RTN","TMGXUP",27,0) + ;"MSC/SGS: added to allow processes to be interrupted +"RTN","TMGXUP",28,0) + set $ZINT="X ^%ZOSF(""INTERRUPT"")" +"RTN","TMGXUP",29,0) + Set U="^" +"RTN","TMGXUP",30,0) + +"RTN","TMGXUP",31,0) + goto XLp2 ;"bypass next section +"RTN","TMGXUP",32,0) + ;"-------------------------------------------------------------------- +"RTN","TMGXUP",33,0) + ;"Set up user info. +"RTN","TMGXUP",34,0) + set DIC=200 ;"file 200 = ^VA(200,*) +"RTN","TMGXUP",35,0) + set DIC(0)="MZ" ;" "AEQMZ" +"RTN","TMGXUP",36,0) + set X="TMGXINST,BOT" +"RTN","TMGXUP",37,0) + ;"set X="Dodd,Norman" ;"Note: came pre-installed in OpenVistA +"RTN","TMGXUP",38,0) + do ^DIC +"RTN","TMGXUP",39,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Y=",Y) +"RTN","TMGXUP",40,0) + if Y<0 set result=cAbort goto XUPDone +"RTN","TMGXUP",41,0) + kill DIC +"RTN","TMGXUP",42,0) + set DUZ=+Y +"RTN","TMGXUP",43,0) + set DUZ(0)=$piece(Y(0),U,4) +"RTN","TMGXUP",44,0) + set DTIME=600 +"RTN","TMGXUP",45,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0)) +"RTN","TMGXUP",46,0) + if DUZ(0)'="@" do goto XUPAbort +"RTN","TMGXUP",47,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to setup a user with programmer's access privilages.") +"RTN","TMGXUP",48,0) + ;"-------------------------------------------------------------------- +"RTN","TMGXUP",49,0) + +"RTN","TMGXUP",50,0) +XLp2 +"RTN","TMGXUP",51,0) + new User,UName +"RTN","TMGXUP",52,0) + set User=$get(^VA(200,1,0)) +"RTN","TMGXUP",53,0) + if User="" do goto XUPAbort +"RTN","TMGXUP",54,0) + . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to access user #1 (expected to be IRM,MGR). The installer should be modified to log in as another user. Sorry. Quiting.") +"RTN","TMGXUP",55,0) + set UName=$piece(User,"^",1) +"RTN","TMGXUP",56,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Logging in as user: ",UName) +"RTN","TMGXUP",57,0) + set LoggedUsr=UName ;" setup global-scope variable that script can access +"RTN","TMGXUP",58,0) + set UName=$piece(User,"^",1) +"RTN","TMGXUP",59,0) + kill DIC +"RTN","TMGXUP",60,0) + set DUZ=1 +"RTN","TMGXUP",61,0) + set DUZ(0)=$piece(User,"^",4) +"RTN","TMGXUP",62,0) + set DTIME=600 +"RTN","TMGXUP",63,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"DUZ(0)=",DUZ(0)) +"RTN","TMGXUP",64,0) + if DUZ(0)'="@" do +"RTN","TMGXUP",65,0) + . if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Temporarily giving install-user '@' privilages.") +"RTN","TMGXUP",66,0) + . set DUZ(0)="@" +"RTN","TMGXUP",67,0) + +"RTN","TMGXUP",68,0) +XLp3 +"RTN","TMGXUP",69,0) + do HOME^%ZIS ;"Reset Home Device IO Variables +"RTN","TMGXUP",70,0) + +"RTN","TMGXUP",71,0) + new $ESTACK,$ETRAP +"RTN","TMGXUP",72,0) + set $ECODE="",$ETRAP="" ;"Clear and error trap +"RTN","TMGXUP",73,0) + xecute ^%ZOSF("TYPE-AHEAD") +"RTN","TMGXUP",74,0) + +"RTN","TMGXUP",75,0) + kill ^UTILITY($J) +"RTN","TMGXUP",76,0) + kill ^XUTL("XQ",$J) +"RTN","TMGXUP",77,0) + do KILL1 ;"do KILL1^XUSCLEAN +"RTN","TMGXUP",78,0) + +"RTN","TMGXUP",79,0) + set DT=$$DT^XLFDT ;"DT is a system=wide date variable +"RTN","TMGXUP",80,0) + +"RTN","TMGXUP",81,0) + set XUEOFF=^%ZOSF("EOFF") +"RTN","TMGXUP",82,0) + set XUEON=^%ZOSF("EON") +"RTN","TMGXUP",83,0) + set U="^" +"RTN","TMGXUP",84,0) + set XUTT=0 +"RTN","TMGXUP",85,0) + set XUIOP="" +"RTN","TMGXUP",86,0) + do GETENV^%ZOSV +"RTN","TMGXUP",87,0) + set XUENV=Y +"RTN","TMGXUP",88,0) + set XUVOL=$piece(Y,U,2) +"RTN","TMGXUP",89,0) + set XUCI=$piece(Y,U,1) +"RTN","TMGXUP",90,0) + +"RTN","TMGXUP",91,0) + ;"Get user info +"RTN","TMGXUP",92,0) + if $get(DUZ)>0 do +"RTN","TMGXUP",93,0) + . kill XUDUZ +"RTN","TMGXUP",94,0) + . if $data(DUZ(0)) set XUDUZ=DUZ(0) +"RTN","TMGXUP",95,0) + . do DUZ^XUP(DUZ) +"RTN","TMGXUP",96,0) + . if $data(XUDUZ) set DUZ(0)=XUDUZ +"RTN","TMGXUP",97,0) + . kill XUDUZ +"RTN","TMGXUP",98,0) + +"RTN","TMGXUP",99,0) + if ($get(DUZ)'>0)!(('$data(DUZ(0)))) do ASKDUZ^XUP goto:Y'>0 XUPAbort +"RTN","TMGXUP",100,0) + +"RTN","TMGXUP",101,0) + if '$data(XQUSER) set XQUSER=$S($data(^VA(200,DUZ,20)):$piece(^(20),"^",2),1:"Unk") +"RTN","TMGXUP",102,0) + set DTIME=600 ;Set a temp DTIME +"RTN","TMGXUP",103,0) + +"RTN","TMGXUP",104,0) + ;"Getting Terminal Type +"RTN","TMGXUP",105,0) + ;"if XUTT do ENQ^XUS1 G:$D(XUIOP(1)) ZIS2 S Y=0 D TT^XUS3 I Y>0 S XUIOP(1)=$P(XUIOP,";",2) G ZIS2 +"RTN","TMGXUP",106,0) + if 'XUTT goto ZIS2a +"RTN","TMGXUP",107,0) + do ENQ^XUS1 +"RTN","TMGXUP",108,0) + if $data(XUIOP(1)) goto ZIS2 +"RTN","TMGXUP",109,0) + set Y=0 +"RTN","TMGXUP",110,0) + do TT^XUS3 +"RTN","TMGXUP",111,0) + if Y>0 set XUIOP(1)=$P(XUIOP,";",2) +"RTN","TMGXUP",112,0) + goto ZIS2 +"RTN","TMGXUP",113,0) +ZIS2a +"RTN","TMGXUP",114,0) + set X="`"_+$G(^VA(200,DUZ,1.2)) +"RTN","TMGXUP",115,0) + set DIC="^%ZIS(2," +"RTN","TMGXUP",116,0) + set DIC(0)="MQ"_$S(X]"`0":"",1:"AE") +"RTN","TMGXUP",117,0) + do ^DIC +"RTN","TMGXUP",118,0) + if Y'>0 goto XUPAbort +"RTN","TMGXUP",119,0) + set XUIOP(1)=$P(Y,U,2) +"RTN","TMGXUP",120,0) + if DIC(0)["A",$get(^VA(200,+DUZ,0))]"" set $piece(^VA(200,DUZ,1.2),U,1)=+Y +"RTN","TMGXUP",121,0) + +"RTN","TMGXUP",122,0) +ZIS2 +"RTN","TMGXUP",123,0) + set %ZIS="L" ;"will cause IO("ZIO") to contain static physical port name +"RTN","TMGXUP",124,0) + set IOP="HOME;"_XUIOP(1) +"RTN","TMGXUP",125,0) + do ^%ZIS ;"Set up device handler +"RTN","TMGXUP",126,0) + if POP goto XUPAbort ;"POP has error from ^%ZIS +"RTN","TMGXUP",127,0) + if $get(TMGDEBUG)>0 do DebugMsg^TMGDEBUG(DBIndent,"Using terminal type: ",IOST) +"RTN","TMGXUP",128,0) + set DTIME=$$DTIME^XUP(DUZ,IOS) +"RTN","TMGXUP",129,0) + set DUZ("BUF")=1 +"RTN","TMGXUP",130,0) + set XUDEV=IOS +"RTN","TMGXUP",131,0) + +"RTN","TMGXUP",132,0) + ;"Save info, Set last sign-on +"RTN","TMGXUP",133,0) + do SAVE^XUS1 +"RTN","TMGXUP",134,0) + set $piece(^VA(200,DUZ,1.1),"^",1)=$$NOW^XLFDT ;DT +"RTN","TMGXUP",135,0) + +"RTN","TMGXUP",136,0) + ;"Setup error trap +"RTN","TMGXUP",137,0) + if $$GET^XPAR("USR^SYS","XUS-XUP SET ERROR TRAP",1,"Q") set $ETRAP="D ERR^XUP" +"RTN","TMGXUP",138,0) + ;do KILL1 ;"do KILL1^XUSCLEAN +"RTN","TMGXUP",139,0) + set $piece(XQXFLG,U,3)="XUP" +"RTN","TMGXUP",140,0) + +"RTN","TMGXUP",141,0) + ;"D ^XQ1 ;<----- one major change made to this code... +"RTN","TMGXUP",142,0) + +"RTN","TMGXUP",143,0) +XUPDone +"RTN","TMGXUP",144,0) + if $get(TMGDEBUG)>0 do DebugExit^TMGDEBUG(.DBIndent,"^XUP") +"RTN","TMGXUP",145,0) + quit result +"RTN","TMGXUP",146,0) + +"RTN","TMGXUP",147,0) +XUPAbort +"RTN","TMGXUP",148,0) + do KILL1 ;"do KILL1^XUSCLEAN +"RTN","TMGXUP",149,0) + kill XQY,XQY0 +"RTN","TMGXUP",150,0) + if $$GET^XPAR("USR^SYS","XUS-XUP VPE",1,"Q"),$data(^%ZVEMS) xecute ^%ZVEMS ;"Run VPE +"RTN","TMGXUP",151,0) + +"RTN","TMGXUP",152,0) + set result=cAbort +"RTN","TMGXUP",153,0) + goto XUPDone +"RTN","TMGXUP",154,0) + +"RTN","TMGXUP",155,0) +KILL1 +"RTN","TMGXUP",156,0) + ;"-------------------------------- +"RTN","TMGXUP",157,0) + ;"KILL1^XUSCLEAN is included and modified below. +"RTN","TMGXUP",158,0) + ;"Purpose: To clean up ALL but kernel variables. +"RTN","TMGXUP",159,0) + ;"------------------------------- +"RTN","TMGXUP",160,0) + If $$BROKER^XWBLIB do +"RTN","TMGXUP",161,0) + . set %2=$piece($text(VARLST^XWBLIB),";;",2) +"RTN","TMGXUP",162,0) + . if %2]"" new @%2 ;"Protect Broker variables. +"RTN","TMGXUP",163,0) + +"RTN","TMGXUP",164,0) + new KWAPI,XGWIN,XGDI,XGEVENT +"RTN","TMGXUP",165,0) + new XQAEXIT,XQAUSER,XQX1,XQAKILL,XQAID +"RTN","TMGXUP",166,0) + +"RTN","TMGXUP",167,0) + kill IO("C"),IO("Q") +"RTN","TMGXUP",168,0) + +"RTN","TMGXUP",169,0) + ;"Note: kill (x) mean kill everything EXCEPT x +"RTN","TMGXUP",170,0) + ;"I can't kill everthing because it will crash my script--so I'll just not do it. +"RTN","TMGXUP",171,0) + ;"kill (DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,XRTL,%ZH0,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ,U,DUZ,DUZ,DTIME,DT) +"RTN","TMGXUP",172,0) + +"RTN","TMGXUP",173,0) + quit +"RTN","TMGXUP",174,0) + +"RTN","TMGXUP",175,0) + ;"=================================================================================== +"RTN","TMGXUS2") +0^109^B55991259 +"RTN","TMGXUS2",1,0) +TMGXUS2 ;TMG/kst/Altered version of XUS2 ;03/25/06 +"RTN","TMGXUS2",2,0) + ;;1.0;TMG-LIB;**1**;12/23/05 +"RTN","TMGXUS2",3,0) + +"RTN","TMGXUS2",4,0) +XUS2 ;SF/RWF - TO CHECK OR RETURN USER ATTRIBUTES ;07/15/2003 12:20 +"RTN","TMGXUS2",5,0) + ;;8.0;KERNEL;**59,180,313**;Jul 10, 1995 +"RTN","TMGXUS2",6,0) + G XUS2^XUVERIFY ;All check or return user attributes moved to XUVERIFY +"RTN","TMGXUS2",7,0) +USER G USER^XUVERIFY +"RTN","TMGXUS2",8,0) +EDIT G EDIT^XUVERIFY +"RTN","TMGXUS2",9,0) + Q +"RTN","TMGXUS2",10,0) + ; +"RTN","TMGXUS2",11,0) +ACCED ; ACCESS CODE EDIT from DD +"RTN","TMGXUS2",12,0) + N DIR,DIR0,XUAUTO I "Nn"[$E(X,1) S X="" Q +"RTN","TMGXUS2",13,0) + I "Yy"'[$E(X,1) K X Q +"RTN","TMGXUS2",14,0) + S XUAUTO=($P($G(^XTV(8989.3,1,3)),U,1)="y"),XUH="" +"RTN","TMGXUS2",15,0) +AC1 D CLR,AUTO:XUAUTO,AASK:'XUAUTO G OUT:$D(DIRUT) D REASK G OUT:$D(DIRUT),AC1:'XUK D CLR,AST(XUH) +"RTN","TMGXUS2",16,0) + G OUT +"RTN","TMGXUS2",17,0) + ; +"RTN","TMGXUS2",18,0) +AASK N X,XUU X ^%ZOSF("EOFF") +"RTN","TMGXUS2",19,0) +AASK1 W "Enter a new ACCESS CODE <Hidden>: " D GET Q:$D(DIRUT) +"RTN","TMGXUS2",20,0) + I X="@" D DEL G:Y'=1 DIRUT S XUH="" Q +"RTN","TMGXUS2",21,0) + ;"K. Toppenberg modified 11-19-04 to relax requirements +"RTN","TMGXUS2",22,0) + I X[$C(34)!(X[";")!(X["^")!(X[":")!($L(X)>20)!($L(X)<5)!(X="MAIL-BOX") D CLR W *7,$$AVHLPTXT(1) D AHELP G AASK1 +"RTN","TMGXUS2",23,0) + ;"//kt I X[$C(34)!(X[";")!(X["^")!(X[":")!(X'?.UNP)!($L(X)>20)!($L(X)<6)!(X="MAIL-BOX") D CLR W *7,$$AVHLPTXT(1) D AHELP G AASK1 +"RTN","TMGXUS2",24,0) + ;"//kt I 'XUAUTO,((X?6.20A)!(X?6.20N)) D CLR W *7,"ACCESS CODE must be a mix of alpha and numerics.",! G AASK1 +"RTN","TMGXUS2",25,0) + S XUU=X,X=$$EN^XUSHSH(X),XUH=X,XMB(1)=$O(^VA(200,"A",XUH,0)) +"RTN","TMGXUS2",26,0) + I XMB(1),XMB(1)'=DA S XMB="XUS ACCESS CODE VIOLATION",XMB(1)=$P(^VA(200,XMB(1),0),"^"),XMDUN="Security" D ^XMB +"RTN","TMGXUS2",27,0) + I $D(^VA(200,"AOLD",XUH))!$D(^VA(200,"A",XUH)) D CLR W *7,"This has been used previously as an ACCESS CODE.",! G AASK1 +"RTN","TMGXUS2",28,0) + Q +"RTN","TMGXUS2",29,0) + ; +"RTN","TMGXUS2",30,0) +REASK S XUK=1 Q:XUH="" D CLR X ^%ZOSF("EOFF") +"RTN","TMGXUS2",31,0) + F XUK=3:-1:1 W "Please re-type the new code to show that I have it right: " D GET G:$D(DIRUT) DIRUT D ^XUSHSH Q:(XUH=X) D CLR W "This doesn't match. Try again!",!,*7 +"RTN","TMGXUS2",32,0) + S:XUH'=X XUK=0 +"RTN","TMGXUS2",33,0) + Q +"RTN","TMGXUS2",34,0) + ; +"RTN","TMGXUS2",35,0) +AST(XUH) ;Change ACCESS CODE and index. +"RTN","TMGXUS2",36,0) + W "OK, Access code has been changed!" +"RTN","TMGXUS2",37,0) + ;S XUU=$P(^VA(200,DA,0),"^",3),$P(^VA(200,DA,0),"^",3)=XUH +"RTN","TMGXUS2",38,0) + ;I XUU]"" F XUI=0:0 S X=XUU S XUI=$O(^DD(200,2,1,XUI)) Q:XUI'>0 X ^(XUI,2) +"RTN","TMGXUS2",39,0) + ;I XUH]"" F XUI=0:0 S X=XUH S XUI=$O(^DD(200,2,1,XUI)) Q:XUI'>0 X ^(XUI,1) +"RTN","TMGXUS2",40,0) + N FDA,IEN,ERR +"RTN","TMGXUS2",41,0) + S IEN=DA_"," +"RTN","TMGXUS2",42,0) + S FDA(200,IEN,2)=XUH D FILE^DIE("","FDA","ERR") +"RTN","TMGXUS2",43,0) + W !,"The VERIFY CODE has been deleted as a security measure.",!,"The user will have to enter a new one the next time they sign-on.",*7 D VST("",1) +"RTN","TMGXUS2",44,0) + I $D(^XMB(3.7,DA,0))[0 S Y=DA D NEW^XM ;Make sure has a Mailbox +"RTN","TMGXUS2",45,0) + Q +"RTN","TMGXUS2",46,0) + ; +"RTN","TMGXUS2",47,0) +GET ;Get the user input and convert case. +"RTN","TMGXUS2",48,0) + S X=$$ACCEPT^XUS Q:X="@" G:(X["^")!('$L(X)) DIRUT +"RTN","TMGXUS2",49,0) + S X=$$UP^XLFSTR(X) +"RTN","TMGXUS2",50,0) + Q +"RTN","TMGXUS2",51,0) + ; +"RTN","TMGXUS2",52,0) +DIRUT S DIRUT=1 +"RTN","TMGXUS2",53,0) + Q +"RTN","TMGXUS2",54,0) + ; +"RTN","TMGXUS2",55,0) +CLR I '$D(DDS) W ! Q +"RTN","TMGXUS2",56,0) + N DX,DY +"RTN","TMGXUS2",57,0) + D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X IOXY +"RTN","TMGXUS2",58,0) + Q +"RTN","TMGXUS2",59,0) + ; +"RTN","TMGXUS2",60,0) +NEWCODE D REASK I XUK W !,"OK, remember this code for next time!" +"RTN","TMGXUS2",61,0) + G OUT +"RTN","TMGXUS2",62,0) + ; +"RTN","TMGXUS2",63,0) +CVC ;From XUS1 +"RTN","TMGXUS2",64,0) + W !,"You must change your VERIFY CODE at this time." S DA=DUZ,X="Y" +"RTN","TMGXUS2",65,0) +VERED ; VERIFY CODE EDIT From DD +"RTN","TMGXUS2",66,0) + N DIR,DIR0 I "Nn"[$E(X,1) S X="" Q +"RTN","TMGXUS2",67,0) + I "Yy"'[$E(X,1) K X Q +"RTN","TMGXUS2",68,0) + S XUH="" +"RTN","TMGXUS2",69,0) +VC1 D CLR,VASK G OUT:$D(DIRUT) D REASK G OUT:$D(DIRUT),VC1:'XUK D CLR,VST(XUH,1) +"RTN","TMGXUS2",70,0) + D CALL^XUSERP(DA,2) +"RTN","TMGXUS2",71,0) + G OUT +"RTN","TMGXUS2",72,0) + ; +"RTN","TMGXUS2",73,0) +VASK N X,XUU X ^%ZOSF("EOFF") G:'$$CHKCUR() DIRUT D CLR +"RTN","TMGXUS2",74,0) +VASK1 W "Enter a new VERIFY CODE: " D GET Q:$D(DIRUT) +"RTN","TMGXUS2",75,0) + I '$D(XUNC),(X="@") D DEL G:Y'=1 DIRUT S XUH="" Q +"RTN","TMGXUS2",76,0) + D CLR S XUU=X,X=$$EN^XUSHSH(X),XUH=X,Y=$$VCHK(XUU,XUH) I +Y W *7,$P(Y,U,2,9),! D:+Y=1 VHELP G VASK1 +"RTN","TMGXUS2",77,0) + Q +"RTN","TMGXUS2",78,0) + ; +"RTN","TMGXUS2",79,0) +VCHK(S,EC) ;Call with String and Encripted versions +"RTN","TMGXUS2",80,0) + ;Updated per VHA directive 6210 Strong Passwords +"RTN","TMGXUS2",81,0) + ;"Kevin Toppenberg modified this 11-19-04 to relax password ("verify code") requirements. +"RTN","TMGXUS2",82,0) + ;" .. now it must just be length 8-20 +"RTN","TMGXUS2",83,0) + N PUNC,NA S PUNC="~`!@#$%&*()_-+=|\{}[]'<>,.?/" +"RTN","TMGXUS2",84,0) + S NA("FILE")=200,NA("FIELD")=.01,NA("IENS")=DA_",",NA=$$HLNAME^XLFNAME(.NA) +"RTN","TMGXUS2",85,0) + I ($L(S)<5)!($L(S)>20)!(S[";")!(S["^")!(S[":") Q "1^"_$$AVHLPTXT +"RTN","TMGXUS2",86,0) + ;"//I ($L(S)<8)!($L(S)>20)!(S'?.UNP)!(S[";")!(S["^")!(S[":") Q "1^"_$$AVHLPTXT +"RTN","TMGXUS2",87,0) + ;"//kt I (S?8.20A)!(S?8.20N)!(S?8.20P)!(S?8.20AN)!(S?8.20AP)!(S?8.20NP) Q "2^VERIFY CODE must be a mix of alpha and numerics and punctuation." +"RTN","TMGXUS2",88,0) + ;"//kt I $D(^VA(200,DA,.1)),EC=$P(^(.1),U,2) Q "3^This code is the same as the current one." +"RTN","TMGXUS2",89,0) + ;"//kt I $D(^VA(200,DA,"VOLD",EC)) Q "4^This has been used previously as the VERIFY CODE." +"RTN","TMGXUS2",90,0) + ;"//kt I EC=$P(^VA(200,DA,0),U,3) Q "5^VERIFY CODE must be different than the ACCESS CODE." +"RTN","TMGXUS2",91,0) + ;"//kt I S[$P(NA,"^")!(S[$P(NA,"^",2)) Q "6^Name cannot be part of code." +"RTN","TMGXUS2",92,0) + Q 0 +"RTN","TMGXUS2",93,0) + ; +"RTN","TMGXUS2",94,0) +VST(XUH,%) W:$L(XUH)&% !,"OK, Verify code has been changed!" +"RTN","TMGXUS2",95,0) + ;S XUU=$P($G(^VA(200,DA,.1)),U,2) S $P(^VA(200,DA,.1),"^",1,2)=$H_"^"_XUH +"RTN","TMGXUS2",96,0) + ;I XUU]"" F XUI=0:0 S X=XUU S XUI=$O(^DD(200,11,1,XUI)) Q:XUI'>0 X ^(XUI,2) +"RTN","TMGXUS2",97,0) + ;I XUH]"" F XUI=0:0 S X=XUH S XUI=$O(^DD(200,11,1,XUI)) Q:XUI'>0 X ^(XUI,1) +"RTN","TMGXUS2",98,0) + N FDA,IEN,ERR S IEN=DA_"," +"RTN","TMGXUS2",99,0) + S:XUH="" XUH="@" ;11.2 get triggerd +"RTN","TMGXUS2",100,0) + S FDA(200,IEN,11)=XUH D FILE^DIE("","FDA","ERR") +"RTN","TMGXUS2",101,0) + I $D(ERR) D ^%ZTER +"RTN","TMGXUS2",102,0) + S:DA=DUZ DUZ("NEWCODE")=XUH Q +"RTN","TMGXUS2",103,0) + ; +"RTN","TMGXUS2",104,0) +DEL ; +"RTN","TMGXUS2",105,0) + X ^%ZOSF("EON") W "@",*7 S DIR(0)="Y",DIR("A")="Sure you want to delete" D ^DIR I Y'=1 W:$X>55 !?9 W *7," <Nothing Deleted>" +"RTN","TMGXUS2",106,0) + Q +"RTN","TMGXUS2",107,0) + ; +"RTN","TMGXUS2",108,0) +AUTO ; +"RTN","TMGXUS2",109,0) + X ^%ZOSF("EON") F XUK=1:1:3 D GEN Q:(Y=1)!($D(DIRUT)) +"RTN","TMGXUS2",110,0) + K DIR +"RTN","TMGXUS2",111,0) + Q +"RTN","TMGXUS2",112,0) + ; +"RTN","TMGXUS2",113,0) +GEN ;Generate a ACCESS code +"RTN","TMGXUS2",114,0) + S XUU=$$AC^XUS4 S X=$$EN^XUSHSH(XUU),XUH=X I $D(^VA(200,"A",X))!$D(^VA(200,"AOLD",X)) G GEN +"RTN","TMGXUS2",115,0) + D CLR W "The new ACCESS CODE is: ",XUU," This is ",XUK," of 3 tries." +"RTN","TMGXUS2",116,0) +YN S Y=1 Q:XUK=3 S DIR(0)="YA",DIR("A")=" Do you want to keep this one? ",DIR("B")="YES",DIR("?",1)="If you don't like this code, we can auto-generate another.",DIR("?")="Remember you only get 3 tries!" +"RTN","TMGXUS2",117,0) + D ^DIR Q:(Y=1)!$D(DIRUT) D CLR W:XUK=2 "O.K. You'll have to keep the next one!",! +"RTN","TMGXUS2",118,0) + Q +"RTN","TMGXUS2",119,0) + ; +"RTN","TMGXUS2",120,0) +AHELP S XUU=$$AC^XUS4 S X=$$EN^XUSHSH(XUU) I $D(^VA(200,"A",X))!$D(^VA(200,"AOLD",X)) G AHELP +"RTN","TMGXUS2",121,0) + W !,"Here is an example of an acceptable Access Code: ",XUU,! +"RTN","TMGXUS2",122,0) + Q +"RTN","TMGXUS2",123,0) + ; +"RTN","TMGXUS2",124,0) +VHELP S XUU=$$VC^XUS4 S X=$$EN^XUSHSH(XUU) I ($P($G(^VA(200,DA,0)),U,3)=X)!$D(^VA(200,DA,"VOLD",X)) G VHELP +"RTN","TMGXUS2",125,0) + W !,"Here is an example of an acceptable Verify Code: ",XUU,! +"RTN","TMGXUS2",126,0) + Q +"RTN","TMGXUS2",127,0) + ; +"RTN","TMGXUS2",128,0) +OUT ; +"RTN","TMGXUS2",129,0) + K DUOUT S:$D(DIRUT) DUOUT=1 +"RTN","TMGXUS2",130,0) + X ^%ZOSF("EON") W ! +"RTN","TMGXUS2",131,0) + K DIR,DIRUT,XUKO,XUAUTO,XUU,XUH,XUK,XUI S X="" +"RTN","TMGXUS2",132,0) + Q +"RTN","TMGXUS2",133,0) + ; +"RTN","TMGXUS2",134,0) +CHKCUR() ;Check user knows current code, Return 1 if OK to continue +"RTN","TMGXUS2",135,0) + Q:DA'=DUZ 1 ;Only ask user +"RTN","TMGXUS2",136,0) + Q:$P($G(^VA(200,DA,.1)),U,2)="" 1 ;Must have an old one +"RTN","TMGXUS2",137,0) + S XUK=0 D CLR +"RTN","TMGXUS2",138,0) +CHK1 W "Please enter your CURRENT verify code: " D GET Q:$D(DIRUT) 0 +"RTN","TMGXUS2",139,0) + I $P(^VA(200,DA,.1),U,2)=$$EN^XUSHSH(X) Q 1 +"RTN","TMGXUS2",140,0) + D CLR W "Sorry that is not correct!",! +"RTN","TMGXUS2",141,0) + S XUK=XUK+1 G:XUK<3 CHK1 +"RTN","TMGXUS2",142,0) + Q 0 +"RTN","TMGXUS2",143,0) + ; +"RTN","TMGXUS2",144,0) +BRCVC(XV1,XV2) ;Broker change VC, return 0 if good, '1^msg' if bad. +"RTN","TMGXUS2",145,0) + N XUU,XUH +"RTN","TMGXUS2",146,0) + Q:$G(DUZ)'>0 "1^Bad DUZ" S DA=DUZ,XUH=$$EN^XUSHSH(XV2) +"RTN","TMGXUS2",147,0) + I $P($G(^VA(200,DUZ,.1)),"^",2)'=$$EN^XUSHSH(XV1) Q "1^Sorry that isn't the correct current code" +"RTN","TMGXUS2",148,0) + S Y=$$VCHK(XV2,XUH) Q:Y Y +"RTN","TMGXUS2",149,0) + D VST(XUH,0),CALL^XUSERP(DA,2) +"RTN","TMGXUS2",150,0) + Q 0 +"RTN","TMGXUS2",151,0) + ; +"RTN","TMGXUS2",152,0) +AVHLPTXT(%) ; +"RTN","TMGXUS2",153,0) + Q "Enter "_$S($G(%):"6-20",1:"8-20")_" characters mixed alphanumeric and punctuation (except '^', ';', ':')." +"RTN","TMGXUS2",154,0) + ; +"SEC","^DIC",22706.1,22706.1,0,"AUDIT") +@ +"SEC","^DIC",22706.1,22706.1,0,"DD") +@ +"SEC","^DIC",22706.1,22706.1,0,"DEL") +@ +"SEC","^DIC",22706.1,22706.1,0,"LAYGO") +@ +"SEC","^DIC",22706.1,22706.1,0,"RD") +@ +"SEC","^DIC",22706.1,22706.1,0,"WR") +@ +"SEC","^DIC",22706.2,22706.2,0,"AUDIT") +@ +"SEC","^DIC",22706.2,22706.2,0,"DD") +@ +"SEC","^DIC",22706.2,22706.2,0,"DEL") +@ +"SEC","^DIC",22706.2,22706.2,0,"LAYGO") +@ +"SEC","^DIC",22706.2,22706.2,0,"RD") +@ +"SEC","^DIC",22706.2,22706.2,0,"WR") +@ +"SEC","^DIC",22706.3,22706.3,0,"AUDIT") +@ +"SEC","^DIC",22706.3,22706.3,0,"DD") +@ +"SEC","^DIC",22706.3,22706.3,0,"DEL") +@ +"SEC","^DIC",22706.3,22706.3,0,"LAYGO") +@ +"SEC","^DIC",22706.3,22706.3,0,"RD") +@ +"SEC","^DIC",22706.3,22706.3,0,"WR") +@ +"SEC","^DIC",22706.4,22706.4,0,"AUDIT") +@ +"SEC","^DIC",22706.4,22706.4,0,"DD") +@ +"SEC","^DIC",22706.4,22706.4,0,"DEL") +@ +"SEC","^DIC",22706.4,22706.4,0,"LAYGO") +@ +"SEC","^DIC",22706.4,22706.4,0,"RD") +@ +"SEC","^DIC",22706.4,22706.4,0,"WR") +@ +"SEC","^DIC",22706.5,22706.5,0,"AUDIT") +@ +"SEC","^DIC",22706.5,22706.5,0,"DD") +@ +"SEC","^DIC",22706.5,22706.5,0,"DEL") +@ +"SEC","^DIC",22706.5,22706.5,0,"LAYGO") +@ +"SEC","^DIC",22706.5,22706.5,0,"RD") +@ +"SEC","^DIC",22706.5,22706.5,0,"WR") +@ +"SEC","^DIC",22706.6,22706.6,0,"AUDIT") +@ +"SEC","^DIC",22706.6,22706.6,0,"DD") +@ +"SEC","^DIC",22706.6,22706.6,0,"DEL") +@ +"SEC","^DIC",22706.6,22706.6,0,"LAYGO") +@ +"SEC","^DIC",22706.6,22706.6,0,"RD") +@ +"SEC","^DIC",22706.6,22706.6,0,"WR") +@ +"SEC","^DIC",22706.7,22706.7,0,"AUDIT") +@ +"SEC","^DIC",22706.7,22706.7,0,"DD") +@ +"SEC","^DIC",22706.7,22706.7,0,"DEL") +@ +"SEC","^DIC",22706.7,22706.7,0,"LAYGO") +@ +"SEC","^DIC",22706.7,22706.7,0,"RD") +@ +"SEC","^DIC",22706.7,22706.7,0,"WR") +@ +"SEC","^DIC",22706.8,22706.8,0,"AUDIT") +@ +"SEC","^DIC",22706.8,22706.8,0,"DD") +@ +"SEC","^DIC",22706.8,22706.8,0,"DEL") +@ +"SEC","^DIC",22706.8,22706.8,0,"LAYGO") +@ +"SEC","^DIC",22706.8,22706.8,0,"RD") +@ +"SEC","^DIC",22706.8,22706.8,0,"WR") +@ +"SEC","^DIC",22706.82,22706.82,0,"AUDIT") +@ +"SEC","^DIC",22706.82,22706.82,0,"DD") +@ +"SEC","^DIC",22706.82,22706.82,0,"DEL") +@ +"SEC","^DIC",22706.82,22706.82,0,"LAYGO") +@ +"SEC","^DIC",22706.82,22706.82,0,"RD") +@ +"SEC","^DIC",22706.82,22706.82,0,"WR") +@ +"SEC","^DIC",22706.9,22706.9,0,"AUDIT") +@ +"SEC","^DIC",22706.9,22706.9,0,"DD") +@ +"SEC","^DIC",22706.9,22706.9,0,"DEL") +@ +"SEC","^DIC",22706.9,22706.9,0,"LAYGO") +@ +"SEC","^DIC",22706.9,22706.9,0,"RD") +@ +"SEC","^DIC",22706.9,22706.9,0,"WR") +@ +"VER") +8.0^22.0 +"^DD",2005.2,2005.2,22700,0) +TMG PRIVATE PHYSICAL REFERENCE^F^^22700;1^K:$L(X)>250!($L(X)<1) X +"^DD",2005.2,2005.2,22700,3) +Answer must be 1-250 characters in length +"^DD",2005.2,2005.2,22700,21,0) +^^4^4^3080131^^ +"^DD",2005.2,2005.2,22700,21,1,0) +This field was added by TMG site to allow for a private network location +"^DD",2005.2,2005.2,22700,21,2,0) +that is different from the physical location specified by field#1. +"^DD",2005.2,2005.2,22700,21,3,0) + +"^DD",2005.2,2005.2,22700,21,4,0) +Enter ??? for more information. +"^DD",2005.2,2005.2,22700,23,0) +^^45^45^3080131^^ +"^DD",2005.2,2005.2,22700,23,1,0) +This field allows for a private network address that may be different from +"^DD",2005.2,2005.2,22700,23,2,0) +the public physical location store in field #1 (PHYSICAL REFERENCE). +"^DD",2005.2,2005.2,22700,23,3,0) + +"^DD",2005.2,2005.2,22700,23,4,0) +For example, if field #1 is specified to be \\imageserver\images\ , then +"^DD",2005.2,2005.2,22700,23,5,0) +when images are stored (using data from this NETWORK LOCATION file), the +"^DD",2005.2,2005.2,22700,23,6,0) +location name passed to the client might be as follows: +"^DD",2005.2,2005.2,22700,23,7,0) + +"^DD",2005.2,2005.2,22700,23,8,0) +\\imageserver\images\IMAGE0001.JPG +"^DD",2005.2,2005.2,22700,23,9,0) + +"^DD",2005.2,2005.2,22700,23,10,0) +But if, instead, one wanted to keep the actual location of the files stored +"^DD",2005.2,2005.2,22700,23,11,0) +private, then one could put "\" into field #1, and then the actual location +"^DD",2005.2,2005.2,22700,23,12,0) +into this field (TMG PRIVATE PHYSICAL REFERENCE). This is dependent on using +"^DD",2005.2,2005.2,22700,23,13,0) +TMG UPLOAD and DOWNLOAD RPC calls that utilize this field. +"^DD",2005.2,2005.2,22700,23,14,0) + +"^DD",2005.2,2005.2,22700,23,15,0) +This field was developed by the TMG site during customization of the VistA +"^DD",2005.2,2005.2,22700,23,16,0) +Imaging system into a document-imaging system. The prior method used by +"^DD",2005.2,2005.2,22700,23,17,0) +VistA was to pass the filepath and filename that had been set up on a +"^DD",2005.2,2005.2,22700,23,18,0) +Windows server. The client was required to be part of this same filesystem. +"^DD",2005.2,2005.2,22700,23,19,0) +And the client would then store files directly. +"^DD",2005.2,2005.2,22700,23,20,0) + +"^DD",2005.2,2005.2,22700,23,21,0) +The TMG site, however, wanted to use a linux server that did not setup +"^DD",2005.2,2005.2,22700,23,22,0) +directory shares, and thus were not accessible to windows clients. Transfer +"^DD",2005.2,2005.2,22700,23,23,0) +code was created to pass binary files through the RPC Broker (using BASE64 +"^DD",2005.2,2005.2,22700,23,24,0) +ascii armour encoding). Thus when the client asks to save a file, it would +"^DD",2005.2,2005.2,22700,23,25,0) +be a security violation to allow any arbitrary directory (including +"^DD",2005.2,2005.2,22700,23,26,0) +sensitive locations.) +"^DD",2005.2,2005.2,22700,23,27,0) + +"^DD",2005.2,2005.2,22700,23,28,0) +Thus at the TMG site, RPC routines such as MAGGADDIMAGE (client asks to upload a file, and +"^DD",2005.2,2005.2,22700,23,29,0) +server prepares an appropriate filename for it) would use field #1 (PHYSICAL +"^DD",2005.2,2005.2,22700,23,30,0) +REFERENCE... SET TO "/") and pass back a file name like this: +"^DD",2005.2,2005.2,22700,23,31,0) + /FILE0001.JPG +"^DD",2005.2,2005.2,22700,23,32,0) +The server upload code (UPLOAD^TMGRPC1) would use TMG PRIVATE PHYSICAL +"^DD",2005.2,2005.2,22700,23,33,0) +REFERENCE (of '/var/local/images/') to actually store the file to: +"^DD",2005.2,2005.2,22700,23,34,0) + e.g. /var/local/images/FILE0001.JPG +"^DD",2005.2,2005.2,22700,23,35,0) + +"^DD",2005.2,2005.2,22700,23,36,0) +The actual file location is then a concatenation of: +"^DD",2005.2,2005.2,22700,23,37,0) + TMG PRIVATE PHYSICAL REFERENCE + PHYSICAL REFERENCE +"^DD",2005.2,2005.2,22700,23,38,0) + +"^DD",2005.2,2005.2,22700,23,39,0) +During use, UPLOAD^TMGRPC1 will make sure that //'s don't occur. I.e. if: +"^DD",2005.2,2005.2,22700,23,40,0) + TMG PRIVATE PHYSICAL REFERENCE = "/var/local/server/" and +"^DD",2005.2,2005.2,22700,23,41,0) + PHYSICAL REFERENCE = "/images/" +"^DD",2005.2,2005.2,22700,23,42,0) +then final result would be +"^DD",2005.2,2005.2,22700,23,43,0) + "/var/local/server/images/" +"^DD",2005.2,2005.2,22700,23,44,0) +not +"^DD",2005.2,2005.2,22700,23,45,0) + "/var/local/server//images/" +"^DD",2005.2,2005.2,22700,"DT") +3050927 +"^DD",2005.2,2005.2,22701,0) +TMG NODE DIVIDER SYMBOL^F^^22701;1^K:$L(X)>1!($L(X)<1)!'((X="\")!(X="/")) X +"^DD",2005.2,2005.2,22701,3) +Answer must be 1 character in length. +"^DD",2005.2,2005.2,22701,21,0) +^^7^7^3050927^^ +"^DD",2005.2,2005.2,22701,21,1,0) +Enter the symbol used by the file system to used directories. +"^DD",2005.2,2005.2,22701,21,2,0) + +"^DD",2005.2,2005.2,22701,21,3,0) +i.e. for Windows, would be \ +"^DD",2005.2,2005.2,22701,21,4,0) + and for Unix, would be / +"^DD",2005.2,2005.2,22701,21,5,0) + +"^DD",2005.2,2005.2,22701,21,6,0) +e.g. Windows: c:\dir1\dir2 +"^DD",2005.2,2005.2,22701,21,7,0) + Unix /dir1/dir2 +"^DD",2005.2,2005.2,22701,"DT") +3050927 +"^DD",2005.2,2005.2,22702,0) +TMG DROPBOX PHYSICAL REFERENCE^F^^22702;1^K:$L(X)>250!($L(X)<1) X +"^DD",2005.2,2005.2,22702,3) +Answer must be 1-250 characters in length. +"^DD",2005.2,2005.2,22702,21,0) +^^2^2^3080131^^ +"^DD",2005.2,2005.2,22702,21,1,0) +This should be the path that the server may use to obtain +"^DD",2005.2,2005.2,22702,21,2,0) +a file from the dropbox. ?? for more help. +"^DD",2005.2,2005.2,22702,23,0) +^^41^41^3080131^^ +"^DD",2005.2,2005.2,22702,23,1,0) +Enter the name of the folder that the server will use as a drop +"^DD",2005.2,2005.2,22702,23,2,0) +box location. +"^DD",2005.2,2005.2,22702,23,3,0) + e.g.: +"^DD",2005.2,2005.2,22702,23,4,0) + /mnt/Winserver/dropbox/ +"^DD",2005.2,2005.2,22702,23,5,0) + +"^DD",2005.2,2005.2,22702,23,6,0) +This custom field was added at the TMG site to allow uploading +"^DD",2005.2,2005.2,22702,23,7,0) +of files via a 'drop box' method. +"^DD",2005.2,2005.2,22702,23,8,0) + +"^DD",2005.2,2005.2,22702,23,9,0) +Background: The original VistA setup was to have the client and +"^DD",2005.2,2005.2,22702,23,10,0) +server to share a custom filesystem. During requests to upload +"^DD",2005.2,2005.2,22702,23,11,0) +a file from CPRS, the server would pass a file path+name to CPRS +"^DD",2005.2,2005.2,22702,23,12,0) +and the client would directly write to the location. TMG felt +"^DD",2005.2,2005.2,22702,23,13,0) +this to represent poor security, as anyone on a client machine +"^DD",2005.2,2005.2,22702,23,14,0) +could browse the image directory directly (with a file browser) +"^DD",2005.2,2005.2,22702,23,15,0) +and see private images. +"^DD",2005.2,2005.2,22702,23,16,0) + +"^DD",2005.2,2005.2,22702,23,17,0) +So a RPC call was created to upload the file to the server through +"^DD",2005.2,2005.2,22702,23,18,0) +the RPC broker, using ASCII Armour Encoding to pass binary files. +"^DD",2005.2,2005.2,22702,23,19,0) +This was OK, but each file transfer took 1-10 seconds, and was too +"^DD",2005.2,2005.2,22702,23,20,0) +slow for higher volume settings. +"^DD",2005.2,2005.2,22702,23,21,0) + +"^DD",2005.2,2005.2,22702,23,22,0) +So this method now uses a secure 'drop box' method. It does require +"^DD",2005.2,2005.2,22702,23,23,0) +a shared filesystem between server and client, but ensures that the +"^DD",2005.2,2005.2,22702,23,24,0) +client can not browse files on the server after uploading them. +"^DD",2005.2,2005.2,22702,23,25,0) +The client does a file copy to the drop box drive location, and then +"^DD",2005.2,2005.2,22702,23,26,0) +notifies the server. The server then moves the file to a secure +"^DD",2005.2,2005.2,22702,23,27,0) +private location. Later, when the client needs the file back, the +"^DD",2005.2,2005.2,22702,23,28,0) +process is reversed: the server is asked for the file, the file is +"^DD",2005.2,2005.2,22702,23,29,0) +moved to the drop box, and the client moves it to its needed location. +"^DD",2005.2,2005.2,22702,23,30,0) + +"^DD",2005.2,2005.2,22702,23,31,0) +This will still be slightly slower than direct access, but provides +"^DD",2005.2,2005.2,22702,23,32,0) +more security. It depends on the client to delete the file from the +"^DD",2005.2,2005.2,22702,23,33,0) +dropbox, and from its local client location after finishing use. +"^DD",2005.2,2005.2,22702,23,34,0) + +"^DD",2005.2,2005.2,22702,23,35,0) +Note: the client will probably have a different name for the drop box +"^DD",2005.2,2005.2,22702,23,36,0) +location, and client configuration will be required as well. +"^DD",2005.2,2005.2,22702,23,37,0) +E.g. +"^DD",2005.2,2005.2,22702,23,38,0) + Linux server has dropbox at /mnt/Winserver/dropbox/ +"^DD",2005.2,2005.2,22702,23,39,0) + Windows Client has access to dropbox at V:\Dropbox\ +"^DD",2005.2,2005.2,22702,23,40,0) + +"^DD",2005.2,2005.2,22702,23,41,0) +This field stores only the server dropbox location. +"^DD",2005.2,2005.2,22702,"DT") +3080131 +"^DD",8925.1,8925.1,0) +FIELD^^99^48 +"^DD",8925.1,8925.1,0,"DDA") +N +"^DD",8925.1,8925.1,0,"DT") +2970227 +"^DD",8925.1,8925.1,0,"ID","W.04") +W " ",@("$P($P($C(59)_$S($D(^DD(8925.1,.04,0)):$P(^(0),U,3),1:0)_$E("_DIC_"Y,0),0),$C(59)_$P(^(0),U,4)_"":"",2),$C(59),1)") +"^DD",8925.1,8925.1,0,"IX","AC",8925.1,.06) + +"^DD",8925.1,8925.1,0,"IX","ACL",8925.1,.01) + +"^DD",8925.1,8925.1,0,"IX","ACL02",8925.1,.02) + +"^DD",8925.1,8925.1,0,"IX","ACL03",8925.1,.03) + +"^DD",8925.1,8925.1,0,"IX","ACL07",8925.1,.07) + +"^DD",8925.1,8925.1,0,"IX","ACL1001",8925.14,.01) + +"^DD",8925.1,8925.1,0,"IX","AD",8925.14,.01) + +"^DD",8925.1,8925.1,0,"IX","AM",8925.1,99) + +"^DD",8925.1,8925.1,0,"IX","AM1",8925.1,.03) + +"^DD",8925.1,8925.1,0,"IX","AMM",8925.14,.01) + +"^DD",8925.1,8925.1,0,"IX","AMM2",8925.14,2) + +"^DD",8925.1,8925.1,0,"IX","AMM3",8925.14,3) + +"^DD",8925.1,8925.1,0,"IX","AMM4",8925.14,4) + +"^DD",8925.1,8925.1,0,"IX","AP",8925.1,.05) + +"^DD",8925.1,8925.1,0,"IX","APOST",8925.1,.14) + +"^DD",8925.1,8925.1,0,"IX","AS",8925.1,.07) + +"^DD",8925.1,8925.1,0,"IX","AT",8925.1,.04) + +"^DD",8925.1,8925.1,0,"IX","B",8925.1,.01) + +"^DD",8925.1,8925.1,0,"IX","C",8925.1,.02) + +"^DD",8925.1,8925.1,0,"IX","D",8925.1,.03) + +"^DD",8925.1,8925.1,0,"IX","E",8925.1,.01) + +"^DD",8925.1,8925.1,0,"NM","TIU DOCUMENT DEFINITION") + +"^DD",8925.1,8925.1,0,"PT",142.14,.01) + +"^DD",8925.1,8925.1,0,"PT",783.9,.04) + +"^DD",8925.1,8925.1,0,"PT",783.9,.05) + +"^DD",8925.1,8925.1,0,"PT",783.9,.06) + +"^DD",8925.1,8925.1,0,"PT",8925,.01) + +"^DD",8925.1,8925.1,0,"PT",8925,.04) + +"^DD",8925.1,8925.1,0,"PT",8925.14,.01) + +"^DD",8925.1,8925.1,0,"PT",8925.95,.01) + +"^DD",8925.1,8925.1,0,"PT",8925.98,.02) + +"^DD",8925.1,8925.1,0,"PT",8925.98,.03) + +"^DD",8925.1,8925.1,0,"PT",8925.9801,.01) + +"^DD",8925.1,8925.1,0,"PT",8927,.19) + +"^DD",8925.1,8925.1,0,"PT",8930.1,.01) + +"^DD",8925.1,8925.1,0,"VRPK") +TEXT INTEGRATION UTILITIES +"^DD",8925.1,8925.1,.01,0) +NAME^RFX^^0;1^S:$L($T(^TIULS)) X=$$UPPER^TIULS(X) K:$L(X)>60!($L(X)<3)!'(X'?1P.E) X I $D(X),+$G(DA) K:$$BADNAP^TIUFLF1(X,+$G(DA)) X +"^DD",8925.1,8925.1,.01,.1) + +"^DD",8925.1,8925.1,.01,1,0) +^.1 +"^DD",8925.1,8925.1,.01,1,1,0) +8925.1^B +"^DD",8925.1,8925.1,.01,1,1,1) +S ^TIU(8925.1,"B",$E(X,1,60),DA)="" +"^DD",8925.1,8925.1,.01,1,1,2) +K ^TIU(8925.1,"B",$E(X,1,60),DA) +"^DD",8925.1,8925.1,.01,1,2,0) +8925.1^E^KWIC +"^DD",8925.1,8925.1,.01,1,2,1) +S %1=1 F %=1:1:$L(X)+1 S I=$E(X,%) I "(,.?! '-/&:;)"[I S I=$E($E(X,%1,%-1),1,30),%1=%+1 I $L(I)>2,^DD("KWIC")'[I S ^TIU(8925.1,"E",I,DA)="" +"^DD",8925.1,8925.1,.01,1,2,2) +S %1=1 F %=1:1:$L(X)+1 S I=$E(X,%) I "(,.?! '-/&:;)"[I S I=$E($E(X,%1,%-1),1,30),%1=%+1 I $L(I)>2 K ^TIU(8925.1,"E",I,DA) +"^DD",8925.1,8925.1,.01,1,2,"%D",0) +^^2^2^2960302^ +"^DD",8925.1,8925.1,.01,1,2,"%D",1,0) +This KWIK cross-reference on document name will allow look-up based on +"^DD",8925.1,8925.1,.01,1,2,"%D",2,0) +sub-names, etc. +"^DD",8925.1,8925.1,.01,1,2,"DT") +2960302 +"^DD",8925.1,8925.1,.01,1,3,0) +8925.1^ACL^MUMPS +"^DD",8925.1,8925.1,.01,1,3,1) +D SACL^TIUDD1(X,.01) +"^DD",8925.1,8925.1,.01,1,3,2) +D KACL^TIUDD1(X,.01) +"^DD",8925.1,8925.1,.01,1,3,"%D",0) +^^2^2^2971016^ +"^DD",8925.1,8925.1,.01,1,3,"%D",1,0) +This complex cross-reference by class and name will help optimize the +"^DD",8925.1,8925.1,.01,1,3,"%D",2,0) +title look-up for the GUI. +"^DD",8925.1,8925.1,.01,1,3,"DT") +2971016 +"^DD",8925.1,8925.1,.01,3) +This is the technical name, 3-60 characters, not starting with punctuation. If OBJECT, Name must be unique among all object Names, Abbreviations, and Print Names. +"^DD",8925.1,8925.1,.01,4) +D NAME^TIUFXHLX:$G(TIUFXNOD)["Add/Create"&($G(TIUFSTMP)="T") +"^DD",8925.1,8925.1,.01,21,0) +^.001^51^51^3030625^^^^ +"^DD",8925.1,8925.1,.01,21,1,0) +The name of a Document Definition entry (.01 field) must be between 3 +"^DD",8925.1,8925.1,.01,21,2,0) +and 60 characters long and may not begin with a punctuation character. +"^DD",8925.1,8925.1,.01,21,3,0) +Although names can be entered in any case, they are transformed to +"^DD",8925.1,8925.1,.01,21,4,0) +upper case before being stored. +"^DD",8925.1,8925.1,.01,21,5,0) + +"^DD",8925.1,8925.1,.01,21,6,0) +It functions as the Technical Name of the entry. Some sites have put KWIC +"^DD",8925.1,8925.1,.01,21,7,0) +cross references on it to get, say, all Titles from a given Service. +"^DD",8925.1,8925.1,.01,21,8,0) + +"^DD",8925.1,8925.1,.01,21,9,0) +Name can be used when entering documents as the name of the Title being +"^DD",8925.1,8925.1,.01,21,10,0) +entered. Print Name and Abbreviation will also be accepted. +"^DD",8925.1,8925.1,.01,21,11,0) + +"^DD",8925.1,8925.1,.01,21,12,0) +Since it is the Technical, .01 Name, the Document Definition Utility +"^DD",8925.1,8925.1,.01,21,13,0) +(TIUF) uses this name throughout. +"^DD",8925.1,8925.1,.01,21,14,0) + +"^DD",8925.1,8925.1,.01,21,15,0) +The .01 name differs from the Print Name, which appears in lists of +"^DD",8925.1,8925.1,.01,21,16,0) +documents and functions as the Title of the document. +"^DD",8925.1,8925.1,.01,21,17,0) + +"^DD",8925.1,8925.1,.01,21,18,0) +It also differs from Item Menu Text (1-20 characters), which is used when +"^DD",8925.1,8925.1,.01,21,19,0) +selecting documents from 3-COLUMN MENUS. +"^DD",8925.1,8925.1,.01,21,20,0) + +"^DD",8925.1,8925.1,.01,21,21,0) +The ORDER of names in TIUF options Edit Document Definitions and Create +"^DD",8925.1,8925.1,.01,21,22,0) +Document Definitions is by Item Sequence under the parent. Order is +"^DD",8925.1,8925.1,.01,21,23,0) +alphabetic by Menu Text if an Item has no Item Sequence. +"^DD",8925.1,8925.1,.01,21,24,0) + +"^DD",8925.1,8925.1,.01,21,25,0) +When a new entry is added to file 8925.1, the Document Definition Utility +"^DD",8925.1,8925.1,.01,21,26,0) +(TIUF) enters the Name as the default Print Name. The Print Name can be +"^DD",8925.1,8925.1,.01,21,27,0) +edited if a different Print Name is desired. +"^DD",8925.1,8925.1,.01,21,28,0) + +"^DD",8925.1,8925.1,.01,21,29,0) +File 8925.1 permits more than 1 entry with the same name as long as they +"^DD",8925.1,8925.1,.01,21,30,0) +don't have the same Type. In that sense, NAMES are reusable. However, +"^DD",8925.1,8925.1,.01,21,31,0) +ENTRIES are NOT reusable (except specially marked Components): an entry is +"^DD",8925.1,8925.1,.01,21,32,0) +NOT allowed to be an item under more than one parent unless it is a Shared +"^DD",8925.1,8925.1,.01,21,33,0) +Component. (See Type Component.) +"^DD",8925.1,8925.1,.01,21,34,0) + +"^DD",8925.1,8925.1,.01,21,35,0) +Name is a BASIC Field. +"^DD",8925.1,8925.1,.01,21,36,0) + +"^DD",8925.1,8925.1,.01,21,37,0) + OBJECT Name +"^DD",8925.1,8925.1,.01,21,38,0) +Object Names, like any other names are 3-60 characters, not starting with +"^DD",8925.1,8925.1,.01,21,39,0) +punctuation. Sites may want to namespace object names, use the object +"^DD",8925.1,8925.1,.01,21,40,0) +Print Name as a more familiar name, and use object Abbreviation as a short +"^DD",8925.1,8925.1,.01,21,41,0) +name to embed in boilerplate text. Unlike other Types, Object +"^DD",8925.1,8925.1,.01,21,42,0) +Abbreviation and Print Name as well as Name must be uppercase. +"^DD",8925.1,8925.1,.01,21,43,0) + +"^DD",8925.1,8925.1,.01,21,44,0) +Object Name, Abbreviation, or Print Name can be embedded in boilerplate +"^DD",8925.1,8925.1,.01,21,45,0) +text. Since TIU must be able to determine from this which object is +"^DD",8925.1,8925.1,.01,21,46,0) +intended, object Names, Abbreviations, and Print Names must be unique. In +"^DD",8925.1,8925.1,.01,21,47,0) +fact, an object Name must differ not only from every other object name, +"^DD",8925.1,8925.1,.01,21,48,0) +but also from every other object Abbreviation and from every other object +"^DD",8925.1,8925.1,.01,21,49,0) +Print Name. Same for Abbreviations and Print Names. For example, if some +"^DD",8925.1,8925.1,.01,21,50,0) +object has abbreviation 'CND', then 'CND' cannot be used for any other +"^DD",8925.1,8925.1,.01,21,51,0) +object Name, Abbreviation, or Print Name. +"^DD",8925.1,8925.1,.01,"AUDIT") + +"^DD",8925.1,8925.1,.01,"DEL",.01,0) +I 1 +"^DD",8925.1,8925.1,.01,"DT") +3030527 +"^DD",8925.1,8925.1,.02,0) +ABBREVIATION^FX^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>4!($L(X)<2)!'(X?2.4A) X I $D(X),+$G(DA) K:($P(^TIU(8925.1,DA,0),U,4)="O")&('(X?2.4U)!'$D(TIUFPRIV)) X I $D(X),+$G(DA) K:$$BADNAP^TIUFLF1(X,DA) X +"^DD",8925.1,8925.1,.02,1,0) +^.1 +"^DD",8925.1,8925.1,.02,1,1,0) +8925.1^C +"^DD",8925.1,8925.1,.02,1,1,1) +S ^TIU(8925.1,"C",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.02,1,1,2) +K ^TIU(8925.1,"C",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.02,1,1,"%D",0) +^^2^2^2940711^ +"^DD",8925.1,8925.1,.02,1,1,"%D",1,0) +This cross reference will be used by the router/filer to identify a given +"^DD",8925.1,8925.1,.02,1,1,"%D",2,0) +report type. +"^DD",8925.1,8925.1,.02,1,1,"DT") +2921020 +"^DD",8925.1,8925.1,.02,1,2,0) +8925.1^ACL02^MUMPS +"^DD",8925.1,8925.1,.02,1,2,1) +D SACL^TIUDD1(X,.02) +"^DD",8925.1,8925.1,.02,1,2,2) +D KACL^TIUDD1(X,.02) +"^DD",8925.1,8925.1,.02,1,2,"%D",0) +^^2^2^3010417^ +"^DD",8925.1,8925.1,.02,1,2,"%D",1,0) +This complex cross-reference by class and name will help optimize the +"^DD",8925.1,8925.1,.02,1,2,"%D",2,0) +title look-up for the GUI. +"^DD",8925.1,8925.1,.02,1,2,"DT") +3010417 +"^DD",8925.1,8925.1,.02,3) +Enter from 2 to 4 letters. If OBJECT, Abbreviation must be unique among all object Names, Abbreviations, and Print Names, and must be uppercase. +"^DD",8925.1,8925.1,.02,21,0) +^^3^3^2990504^^^^ +"^DD",8925.1,8925.1,.02,21,1,0) +Abbreviation can be entered at the Title: prompt when entering a document. +"^DD",8925.1,8925.1,.02,21,2,0) +Since all Titles with that abbreviation will then be listed, Abbreviation +"^DD",8925.1,8925.1,.02,21,3,0) +can serve to group Titles. BASIC Field. For Objects, see NAME. +"^DD",8925.1,8925.1,.02,"DT") +3020107 +"^DD",8925.1,8925.1,.03,0) +PRINT NAME^FX^^0;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>60!($L(X)<3) X I $D(X),+$G(DA) K:($P(^TIU(8925.1,DA,0),U,4)="O")&('(X?3.60UPN)!'$D(TIUFPRIV)) X I $D(X),+$G(DA) K:$$BADNAP^TIUFLF1(X,DA) X +"^DD",8925.1,8925.1,.03,1,0) +^.1 +"^DD",8925.1,8925.1,.03,1,1,0) +8925.1^AM1^MUMPS +"^DD",8925.1,8925.1,.03,1,1,1) +D REDO^TIUDD +"^DD",8925.1,8925.1,.03,1,1,2) +D REDO^TIUDD +"^DD",8925.1,8925.1,.03,1,1,"%D",0) +^^2^2^2950911^^^ +"^DD",8925.1,8925.1,.03,1,1,"%D",1,0) +This MUMPS-type cross-reference is used to update the TIMESTAMP on both +"^DD",8925.1,8925.1,.03,1,1,"%D",2,0) +the current document, and its parents, when its PRINT NAME changes. +"^DD",8925.1,8925.1,.03,1,1,"DT") +2940720 +"^DD",8925.1,8925.1,.03,1,2,0) +8925.1^D +"^DD",8925.1,8925.1,.03,1,2,1) +S ^TIU(8925.1,"D",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.03,1,2,2) +K ^TIU(8925.1,"D",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.03,1,2,"%D",0) +^^1^1^2950126^ +"^DD",8925.1,8925.1,.03,1,2,"%D",1,0) +This REGULAR FileMan cross-reference by PRINT NAME will facilitate look-up. +"^DD",8925.1,8925.1,.03,1,2,"DT") +2950126 +"^DD",8925.1,8925.1,.03,1,3,0) +8925.1^ACL03^MUMPS +"^DD",8925.1,8925.1,.03,1,3,1) +D SACL^TIUDD1(X,.03) +"^DD",8925.1,8925.1,.03,1,3,2) +D KACL^TIUDD1(X,.03) +"^DD",8925.1,8925.1,.03,1,3,"%D",0) +^^2^2^3010417^ +"^DD",8925.1,8925.1,.03,1,3,"%D",1,0) +This complex cross-reference by class and name will help optimize the +"^DD",8925.1,8925.1,.03,1,3,"%D",2,0) +title look-up for the GUI. +"^DD",8925.1,8925.1,.03,1,3,"DT") +3010417 +"^DD",8925.1,8925.1,.03,3) +Print Name is used in lists of documents and as document Title in the Patient Chart. 3-60 Characters. If OBJECT, Print Name must be unique among object Names/Abbreviations/PrintNames, and uppercase. +"^DD",8925.1,8925.1,.03,21,0) +^^3^3^2990504^^^^ +"^DD",8925.1,8925.1,.03,21,1,0) +Print Name is the name used in lists of documents. For entries of Type +"^DD",8925.1,8925.1,.03,21,2,0) +Title, Print Name is used as the document Title in the Patient Chart. +"^DD",8925.1,8925.1,.03,21,3,0) +BASIC field. For Objects, see NAME. +"^DD",8925.1,8925.1,.03,"DT") +3020107 +"^DD",8925.1,8925.1,.04,0) +TYPE^RSX^CL:CLASS;DC:DOCUMENT CLASS;DOC:TITLE;CO:COMPONENT;O:OBJECT;^0;4^K:'$G(TIUFPRIV) X +"^DD",8925.1,8925.1,.04,1,0) +^.1 +"^DD",8925.1,8925.1,.04,1,1,0) +8925.1^AT +"^DD",8925.1,8925.1,.04,1,1,1) +S ^TIU(8925.1,"AT",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.04,1,1,2) +K ^TIU(8925.1,"AT",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.04,1,1,3) +Please don't delete! +"^DD",8925.1,8925.1,.04,1,1,"%D",0) +^^2^2^2950615^ +"^DD",8925.1,8925.1,.04,1,1,"%D",1,0) +This regular cross reference is used for listing Document Definitions by +"^DD",8925.1,8925.1,.04,1,1,"%D",2,0) +Type. +"^DD",8925.1,8925.1,.04,1,1,"DT") +2950615 +"^DD",8925.1,8925.1,.04,3) +Types Class and Document Class group documents. Titles are used to enter documents. Components are sections of documents. Objects are M code for use in Boilerplate Text. +"^DD",8925.1,8925.1,.04,4) + +"^DD",8925.1,8925.1,.04,21,0) +^^99^99^2970521^^ +"^DD",8925.1,8925.1,.04,21,1,0) +Type determines the nature of the entry and what sort of items the entry +"^DD",8925.1,8925.1,.04,21,2,0) +may have. There are 5 possible types: +"^DD",8925.1,8925.1,.04,21,3,0) + +"^DD",8925.1,8925.1,.04,21,4,0) +CL CLASS: Classes group documents. +"^DD",8925.1,8925.1,.04,21,5,0) + +"^DD",8925.1,8925.1,.04,21,6,0) +Example: "Progress Notes" is a class with many kinds of progress notes +"^DD",8925.1,8925.1,.04,21,7,0) +under it. +"^DD",8925.1,8925.1,.04,21,8,0) + +"^DD",8925.1,8925.1,.04,21,9,0) +Classes may themselves be subdivided into items of Type Class or may have +"^DD",8925.1,8925.1,.04,21,10,0) +items of Type Document Class if no further Class subdivisions are desired. +"^DD",8925.1,8925.1,.04,21,11,0) + +"^DD",8925.1,8925.1,.04,21,12,0) +If a hierarchy deeper than Class-Document Class-Title is desired, Class is +"^DD",8925.1,8925.1,.04,21,13,0) +the place to insert another level into the hierarchy: Class-Class-Document +"^DD",8925.1,8925.1,.04,21,14,0) +Class-Title. +"^DD",8925.1,8925.1,.04,21,15,0) + +"^DD",8925.1,8925.1,.04,21,16,0) +Besides grouping documents, Classes also store behavior which is then +"^DD",8925.1,8925.1,.04,21,17,0) +inherited by lower level entries. +"^DD",8925.1,8925.1,.04,21,18,0) + +"^DD",8925.1,8925.1,.04,21,19,0) +DC DOCUMENT CLASS: Document Classes group documents. Document Class is +"^DD",8925.1,8925.1,.04,21,20,0) +the lowest level of class, and has items of Type Title under it. +"^DD",8925.1,8925.1,.04,21,21,0) + +"^DD",8925.1,8925.1,.04,21,22,0) +Example: "Day Pass Note" could be a Document Class under class Progress +"^DD",8925.1,8925.1,.04,21,23,0) +Note. +"^DD",8925.1,8925.1,.04,21,24,0) + +"^DD",8925.1,8925.1,.04,21,25,0) +Document Classes also store behavior which is then inherited by lower +"^DD",8925.1,8925.1,.04,21,26,0) +entries. +"^DD",8925.1,8925.1,.04,21,27,0) + +"^DD",8925.1,8925.1,.04,21,28,0) +TL TITLE: Titles are used to enter documents. They store the behavior +"^DD",8925.1,8925.1,.04,21,29,0) +of the documents which use them. +"^DD",8925.1,8925.1,.04,21,30,0) + +"^DD",8925.1,8925.1,.04,21,31,0) +Titles may have predefined boilerplate ("Overprint") text. They may have +"^DD",8925.1,8925.1,.04,21,32,0) +Components as items. Boilerplate Text can have objects in it. +"^DD",8925.1,8925.1,.04,21,33,0) + +"^DD",8925.1,8925.1,.04,21,34,0) +Examples: "Routine Day Pass Note" could be a Title under document class +"^DD",8925.1,8925.1,.04,21,35,0) +Day Pass Note. Another example might be "Exceptional Circumstances Day +"^DD",8925.1,8925.1,.04,21,36,0) +Pass Note." +"^DD",8925.1,8925.1,.04,21,37,0) + +"^DD",8925.1,8925.1,.04,21,38,0) +Titles store their own behavior. They also inherit behavior from higher +"^DD",8925.1,8925.1,.04,21,39,0) +levels of the hierarchy. However, behavior stored in the Title itself +"^DD",8925.1,8925.1,.04,21,40,0) +overrides inherited behavior. +"^DD",8925.1,8925.1,.04,21,41,0) + +"^DD",8925.1,8925.1,.04,21,42,0) +CO COMPONENT: Components are "sections" or "pieces" of documents. +"^DD",8925.1,8925.1,.04,21,43,0) +In the Hierarchy, Components are hung as items from Titles. +"^DD",8925.1,8925.1,.04,21,44,0) + +"^DD",8925.1,8925.1,.04,21,45,0) +Examples: "Reason for Pass" could be a component of Routine Day Pass Note. +"^DD",8925.1,8925.1,.04,21,46,0) +Subjective is a component of a SOAP Note. +"^DD",8925.1,8925.1,.04,21,47,0) + +"^DD",8925.1,8925.1,.04,21,48,0) +Components may have (sub)Components as items. They may have Boilerplate +"^DD",8925.1,8925.1,.04,21,49,0) +Text. Components may be designated Shared (see Field Description for +"^DD",8925.1,8925.1,.04,21,50,0) +Shared). Shared Components are shown in Document Definition Utility +"^DD",8925.1,8925.1,.04,21,51,0) +Displays as Type: 'CO S'. +"^DD",8925.1,8925.1,.04,21,52,0) + +"^DD",8925.1,8925.1,.04,21,53,0) +There are advantages and disadvantages in splitting a document up into +"^DD",8925.1,8925.1,.04,21,54,0) +separate components (rather than writing sections into the Boilerplate +"^DD",8925.1,8925.1,.04,21,55,0) +Text of the Title): Since Components are stored as separate file entries, +"^DD",8925.1,8925.1,.04,21,56,0) +they are inherently accessable and even 'moveable'. Using Fileman, sites +"^DD",8925.1,8925.1,.04,21,57,0) +can access components of documents the same way they can access documents +"^DD",8925.1,8925.1,.04,21,58,0) +for reports, etc.. Also, in the future, TIU may have options to move/copy +"^DD",8925.1,8925.1,.04,21,59,0) +certain components from one document into another. The disadvantage is +"^DD",8925.1,8925.1,.04,21,60,0) +speed: Components make the structure more complex and therefore slow down +"^DD",8925.1,8925.1,.04,21,61,0) +processing. +"^DD",8925.1,8925.1,.04,21,62,0) + +"^DD",8925.1,8925.1,.04,21,63,0) +O OBJECT: Objects are names which may be embedded in the predefined +"^DD",8925.1,8925.1,.04,21,64,0) +boilerplate text of Titles. Example: 'PATIENT AGE'. Objects are typed +"^DD",8925.1,8925.1,.04,21,65,0) +into the boilerplate text of a Title, enclosed by '|'s. For example, +"^DD",8925.1,8925.1,.04,21,66,0) +suppose a Title has boilerplate text: +"^DD",8925.1,8925.1,.04,21,67,0) + +"^DD",8925.1,8925.1,.04,21,68,0) + Patient is a healthy |PATIENT AGE| year old male ... +"^DD",8925.1,8925.1,.04,21,69,0) + +"^DD",8925.1,8925.1,.04,21,70,0) +Then a user who enters such a note for a patient known by the system to be +"^DD",8925.1,8925.1,.04,21,71,0) +56 years old would be presented with the text: +"^DD",8925.1,8925.1,.04,21,72,0) + +"^DD",8925.1,8925.1,.04,21,73,0) + Patient is a healthy 56 year old male ... +"^DD",8925.1,8925.1,.04,21,74,0) + +"^DD",8925.1,8925.1,.04,21,75,0) +The user can then add to the text and or edit the text, including the age +"^DD",8925.1,8925.1,.04,21,76,0) +(56) of the patient. From this point on, the patient age (56) is regular +"^DD",8925.1,8925.1,.04,21,77,0) +text and is not updated in this note. +"^DD",8925.1,8925.1,.04,21,78,0) + +"^DD",8925.1,8925.1,.04,21,79,0) +Objects must always have uppercase names, abbreviations, and print names. +"^DD",8925.1,8925.1,.04,21,80,0) +When embedding objects in boilerplate text, users may embed any of these +"^DD",8925.1,8925.1,.04,21,81,0) +three (name, abbreviation, print name) in boilerplate text, enclosed by +"^DD",8925.1,8925.1,.04,21,82,0) +'|'s. Objects must always be embedded in uppercase. +"^DD",8925.1,8925.1,.04,21,83,0) + +"^DD",8925.1,8925.1,.04,21,84,0) +Objects are stored in the Document Definition File, but are not part of +"^DD",8925.1,8925.1,.04,21,85,0) +the Hierarchy. They are accessible through the Option Create Objects. +"^DD",8925.1,8925.1,.04,21,86,0) +(They are also accessible through the Option Sort Document Definitions, by +"^DD",8925.1,8925.1,.04,21,87,0) +selecting Sort by Type and selecting Type Object.) +"^DD",8925.1,8925.1,.04,21,88,0) + +"^DD",8925.1,8925.1,.04,21,89,0) +TIU exports a small library of objects. Sites can also create their own. +"^DD",8925.1,8925.1,.04,21,90,0) + +"^DD",8925.1,8925.1,.04,21,91,0) +Only an owner can edit an object and should do so only after consulting +"^DD",8925.1,8925.1,.04,21,92,0) +with others who use it. The object must be inactive for editing. It +"^DD",8925.1,8925.1,.04,21,93,0) +should be thoroughly tested. See Object Status, under Status. +"^DD",8925.1,8925.1,.04,21,94,0) + +"^DD",8925.1,8925.1,.04,21,95,0) +Entries of type Object cannot be changed to any other type. Entries of +"^DD",8925.1,8925.1,.04,21,96,0) +type Class, Document Class, Title, or Component cannot be changed to type +"^DD",8925.1,8925.1,.04,21,97,0) +Object. +"^DD",8925.1,8925.1,.04,21,98,0) + +"^DD",8925.1,8925.1,.04,21,99,0) +Type is a BASIC field. +"^DD",8925.1,8925.1,.04,"DT") +2970114 +"^DD",8925.1,8925.1,.05,0) +PERSONAL OWNER^P200'X^VA(200,^0;5^Q +"^DD",8925.1,8925.1,.05,1,0) +^.1 +"^DD",8925.1,8925.1,.05,1,1,0) +8925.1^AP +"^DD",8925.1,8925.1,.05,1,1,1) +S ^TIU(8925.1,"AP",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.05,1,1,2) +K ^TIU(8925.1,"AP",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.05,1,1,3) +Please don't delete! +"^DD",8925.1,8925.1,.05,1,1,"%D",0) +^^2^2^2950615^ +"^DD",8925.1,8925.1,.05,1,1,"%D",1,0) +This regular cross reference is used for listing Document Definitions by +"^DD",8925.1,8925.1,.05,1,1,"%D",2,0) +Personal Owner. +"^DD",8925.1,8925.1,.05,1,1,"DT") +2950615 +"^DD",8925.1,8925.1,.05,3) +Enter Person who can edit entry. If owned by Class rather than Person, delete Personal Owner by typing '@' at Personal Owner prompt, and then enter Class Owner. +"^DD",8925.1,8925.1,.05,4) + +"^DD",8925.1,8925.1,.05,21,0) +^^41^41^2970520^ +"^DD",8925.1,8925.1,.05,21,1,0) +Document Definition Ownership has nothing to do with who can USE the entry +"^DD",8925.1,8925.1,.05,21,2,0) +to enter a document. It determines responsibilty for the Document +"^DD",8925.1,8925.1,.05,21,3,0) +Definition itself. +"^DD",8925.1,8925.1,.05,21,4,0) + +"^DD",8925.1,8925.1,.05,21,5,0) +An entry can be EDITED by its owner. (The Manager menu permits override of +"^DD",8925.1,8925.1,.05,21,6,0) +ownership so that Ownership can be assigned to a clinician who can then +"^DD",8925.1,8925.1,.05,21,7,0) +fill in boilerplate text with the Clinician menu, while the Manager can +"^DD",8925.1,8925.1,.05,21,8,0) +still edit the entry, since there are many fields the clinician does not +"^DD",8925.1,8925.1,.05,21,9,0) +have access to.) Exception: the Manager menu does NOT override ownership +"^DD",8925.1,8925.1,.05,21,10,0) +of Objects or of Shared Components. Only owners can edit Objects and +"^DD",8925.1,8925.1,.05,21,11,0) +Shared Components, regardless of menu. +"^DD",8925.1,8925.1,.05,21,12,0) + +"^DD",8925.1,8925.1,.05,21,13,0) +If Title owner edits the boilerplate text of the Title, that person can +"^DD",8925.1,8925.1,.05,21,14,0) +edit the boilerplate text of all components of the Title as well, without +"^DD",8925.1,8925.1,.05,21,15,0) +regard to component ownership. In order to edit components individually, +"^DD",8925.1,8925.1,.05,21,16,0) +however, the user must own the component. This allows users to assign +"^DD",8925.1,8925.1,.05,21,17,0) +ownership of components to different people, for example, for (future) +"^DD",8925.1,8925.1,.05,21,18,0) +multidisciplinary documents. +"^DD",8925.1,8925.1,.05,21,19,0) + +"^DD",8925.1,8925.1,.05,21,20,0) +A PERSONAL OWNER is a person who uniquely owns the entry. An entry may +"^DD",8925.1,8925.1,.05,21,21,0) +have a Personal Owner OR a Class Owner but not both. When entering a +"^DD",8925.1,8925.1,.05,21,22,0) +Personal Owner, be sure to delete any existing Class Owner. +"^DD",8925.1,8925.1,.05,21,23,0) + +"^DD",8925.1,8925.1,.05,21,24,0) +The Document Definition Utility TIUF uses the term 'Individual Owner'. +"^DD",8925.1,8925.1,.05,21,25,0) +Someone is an Individual Owner of an entry if s/he is the personal owner +"^DD",8925.1,8925.1,.05,21,26,0) +OR, if the entry is CLASS Owned, if s/he belongs to the Owner Class. +"^DD",8925.1,8925.1,.05,21,27,0) + +"^DD",8925.1,8925.1,.05,21,28,0) +The Document Definition Utility TIUF enters the user as the Personal Owner +"^DD",8925.1,8925.1,.05,21,29,0) +if a user enters a new entry without assigning ownership. This person can +"^DD",8925.1,8925.1,.05,21,30,0) +then reassign ownership if they choose. +"^DD",8925.1,8925.1,.05,21,31,0) + +"^DD",8925.1,8925.1,.05,21,32,0) +If the person responsible for an entry plays a role corresponding to a +"^DD",8925.1,8925.1,.05,21,33,0) +User Class, e.g. Clinical Coordinator, it may be more efficient to assign +"^DD",8925.1,8925.1,.05,21,34,0) +ownership to the class rather than to the person. Owners are then +"^DD",8925.1,8925.1,.05,21,35,0) +automatically updated as the class is updated. +"^DD",8925.1,8925.1,.05,21,36,0) + +"^DD",8925.1,8925.1,.05,21,37,0) +Editing privilege is affected not only by Owner but also by Status, by +"^DD",8925.1,8925.1,.05,21,38,0) +Shared, by In Use, and by menu. Manager menus, for example, provide +"^DD",8925.1,8925.1,.05,21,39,0) +fuller editing capabilities than Clinician menus. +"^DD",8925.1,8925.1,.05,21,40,0) + +"^DD",8925.1,8925.1,.05,21,41,0) +Personal Owner is a BASIC field. +"^DD",8925.1,8925.1,.05,"DT") +2961022 +"^DD",8925.1,8925.1,.06,0) +CLASS OWNER^P8930'X^USR(8930,^0;6^Q +"^DD",8925.1,8925.1,.06,1,0) +^.1 +"^DD",8925.1,8925.1,.06,1,1,0) +8925.1^AC +"^DD",8925.1,8925.1,.06,1,1,1) +S ^TIU(8925.1,"AC",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.06,1,1,2) +K ^TIU(8925.1,"AC",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.06,1,1,3) +Please don't delete! +"^DD",8925.1,8925.1,.06,1,1,"%D",0) +^^2^2^2950615^ +"^DD",8925.1,8925.1,.06,1,1,"%D",1,0) +This regular cross reference is used to list Document Definitions by Class +"^DD",8925.1,8925.1,.06,1,1,"%D",2,0) +Owner. +"^DD",8925.1,8925.1,.06,1,1,"DT") +2950615 +"^DD",8925.1,8925.1,.06,3) +If owned by Class rather than by Person enter User Class whose members may edit entry. If owned by Person, delete Class Owner by entering '@' at Class Owner prompt. +"^DD",8925.1,8925.1,.06,4) + +"^DD",8925.1,8925.1,.06,21,0) +^^31^31^2970227^ +"^DD",8925.1,8925.1,.06,21,1,0) +Document Definition Ownership has nothing to do with who can USE the entry +"^DD",8925.1,8925.1,.06,21,2,0) +to enter a document. It determines responsibility for the Document +"^DD",8925.1,8925.1,.06,21,3,0) +Definition itself. +"^DD",8925.1,8925.1,.06,21,4,0) + +"^DD",8925.1,8925.1,.06,21,5,0) +An entry can be EDITED by its owner. (The Manager menu permits override +"^DD",8925.1,8925.1,.06,21,6,0) +of ownership so that ownership can be assigned to a clinician (person with +"^DD",8925.1,8925.1,.06,21,7,0) +Clinician Menu) who can then fill in boilerplate text, while the manager +"^DD",8925.1,8925.1,.06,21,8,0) +can still edit the entry, since there are many fields the clinician does +"^DD",8925.1,8925.1,.06,21,9,0) +not have access to.) Exception: the Manager menu does NOT override +"^DD",8925.1,8925.1,.06,21,10,0) +ownership of Objects or of Shared Components. These can ONLY be edited by +"^DD",8925.1,8925.1,.06,21,11,0) +an owner, regardless of menu. +"^DD",8925.1,8925.1,.06,21,12,0) + +"^DD",8925.1,8925.1,.06,21,13,0) +If a Title owner edits the boilerplate text of the Title, that person can +"^DD",8925.1,8925.1,.06,21,14,0) +edit the boilerplate text of all components of the title as well, without +"^DD",8925.1,8925.1,.06,21,15,0) +regard to component ownership. However, the user must own the component +"^DD",8925.1,8925.1,.06,21,16,0) +in order to edit it individually, permitting separate ownership of +"^DD",8925.1,8925.1,.06,21,17,0) +components. +"^DD",8925.1,8925.1,.06,21,18,0) + +"^DD",8925.1,8925.1,.06,21,19,0) +A Class Owner is a User Class from the USR CLASS file whose members may +"^DD",8925.1,8925.1,.06,21,20,0) +edit the entry. An entry may have a Personal OR a Class Owner (not both). +"^DD",8925.1,8925.1,.06,21,21,0) +The Document Definition Utility TIUF does not prompt for Class Owner if +"^DD",8925.1,8925.1,.06,21,22,0) +the entry has a Personal Owner. To change to Class Owner, first delete +"^DD",8925.1,8925.1,.06,21,23,0) +the Personal Owner by entering '@' at the Personal Owner prompt. +"^DD",8925.1,8925.1,.06,21,24,0) + +"^DD",8925.1,8925.1,.06,21,25,0) +For new entries, users are prompted to enter the Class Owner Clinical +"^DD",8925.1,8925.1,.06,21,26,0) +Coordinator as the default. To enter a different Class Owner, enter the +"^DD",8925.1,8925.1,.06,21,27,0) +appropriate class after the //'s. If there are no //'s and the +"^DD",8925.1,8925.1,.06,21,28,0) +Replace...with editor is being used, enter ... to replace the whole +"^DD",8925.1,8925.1,.06,21,29,0) +class and then enter the appropriate class. +"^DD",8925.1,8925.1,.06,21,30,0) + +"^DD",8925.1,8925.1,.06,21,31,0) +Class Owner is a BASIC field. +"^DD",8925.1,8925.1,.06,"DT") +2961022 +"^DD",8925.1,8925.1,.07,0) +STATUS^*P8925.6'X^TIU(8925.6,^0;7^K:'$G(TIUFPRIV) X Q:'$D(X) S DIC("S")="I 1 X $$STATSCRN^TIUFLF5" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X +"^DD",8925.1,8925.1,.07,1,0) +^.1 +"^DD",8925.1,8925.1,.07,1,1,0) +8925.1^AS +"^DD",8925.1,8925.1,.07,1,1,1) +S ^TIU(8925.1,"AS",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.07,1,1,2) +K ^TIU(8925.1,"AS",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.07,1,1,3) +Please don't delete! +"^DD",8925.1,8925.1,.07,1,1,"%D",0) +^^2^2^2950615^ +"^DD",8925.1,8925.1,.07,1,1,"%D",1,0) +This regular cross reference is used to list Document Definitions by +"^DD",8925.1,8925.1,.07,1,1,"%D",2,0) +Status. +"^DD",8925.1,8925.1,.07,1,1,"DT") +2950615 +"^DD",8925.1,8925.1,.07,1,2,0) +8925.1^ACL07^MUMPS +"^DD",8925.1,8925.1,.07,1,2,1) +D SACL^TIUDD1(X,.07) +"^DD",8925.1,8925.1,.07,1,2,2) +D KACL^TIUDD1(X,.07) +"^DD",8925.1,8925.1,.07,1,2,"%D",0) +^^2^2^2971016^ +"^DD",8925.1,8925.1,.07,1,2,"%D",1,0) +This MUMPS-type cross-reference on STATUS support the identification of +"^DD",8925.1,8925.1,.07,1,2,"%D",2,0) +Active and TEST Titles within a given class. +"^DD",8925.1,8925.1,.07,1,2,"DT") +2971016 +"^DD",8925.1,8925.1,.07,3) + Documents can be entered on ACTIVE Titles. Only the Owner can enter a document on TEST Titles. Only INACTIVE Document Definitions can be edited. +"^DD",8925.1,8925.1,.07,4) + +"^DD",8925.1,8925.1,.07,12) +STATSCRN limits Status to Status file entries that are appropriate for Document Definitions: Active, Inactive, and Test. +"^DD",8925.1,8925.1,.07,12.1) +S DIC("S")="I 1 X $$STATSCRN^TIUFLF5" +"^DD",8925.1,8925.1,.07,21,0) +^^183^183^2990225^^^ +"^DD",8925.1,8925.1,.07,21,1,0) +Status provides a way of making Document Definitions 'Offline' to +"^DD",8925.1,8925.1,.07,21,2,0) +documents. Document Definitions need to be 'Offline' if they are new and +"^DD",8925.1,8925.1,.07,21,3,0) +not ready for use, if they are being edited, or if they are retired from +"^DD",8925.1,8925.1,.07,21,4,0) +further use. +"^DD",8925.1,8925.1,.07,21,5,0) + +"^DD",8925.1,8925.1,.07,21,6,0) +Status is limited to those Statuses in the Status File which apply to +"^DD",8925.1,8925.1,.07,21,7,0) +Document Definitions: Inactive, Test, and Active. The Document Definition +"^DD",8925.1,8925.1,.07,21,8,0) +Utility TIUF further limits Statuses to those appropriate for the entry +"^DD",8925.1,8925.1,.07,21,9,0) +Type (see below), limits the Status of entries with Inactive ancestors to +"^DD",8925.1,8925.1,.07,21,10,0) +Inactive, and limits the Status of faulty entries to Inactive. +"^DD",8925.1,8925.1,.07,21,11,0) + +"^DD",8925.1,8925.1,.07,21,12,0) +Status applies to all Document Definitions, but its meaning and possible +"^DD",8925.1,8925.1,.07,21,13,0) +values vary somewhat with the Document Definition Type. Exception: Shared +"^DD",8925.1,8925.1,.07,21,14,0) +Components: See COMPONENT STATUS, below. +"^DD",8925.1,8925.1,.07,21,15,0) + +"^DD",8925.1,8925.1,.07,21,16,0) +Status is a BASIC field. +"^DD",8925.1,8925.1,.07,21,17,0) + +"^DD",8925.1,8925.1,.07,21,18,0) + TITLE STATUS +"^DD",8925.1,8925.1,.07,21,19,0) + +"^DD",8925.1,8925.1,.07,21,20,0) +Status has its most basic meaning for Titles [Document Definitions of Type +"^DD",8925.1,8925.1,.07,21,21,0) +Title]: +"^DD",8925.1,8925.1,.07,21,22,0) + +"^DD",8925.1,8925.1,.07,21,23,0) +A Title can have Status Inactive, Test, or Active. If it has Status +"^DD",8925.1,8925.1,.07,21,24,0) +Inactive, it cannot be used to enter documents (EXCEPT through the +"^DD",8925.1,8925.1,.07,21,25,0) +Try Action, which deletes the document when done). If it has Status +"^DD",8925.1,8925.1,.07,21,26,0) +Test, it can be used to enter documents only by its Owner. Titles should +"^DD",8925.1,8925.1,.07,21,27,0) +be tested (and Tried) using TEST PATIENTS ONLY. If a Title has Status +"^DD",8925.1,8925.1,.07,21,28,0) +Active, it can be used to enter documents by any one with access and +"^DD",8925.1,8925.1,.07,21,29,0) +authorization. +"^DD",8925.1,8925.1,.07,21,30,0) + +"^DD",8925.1,8925.1,.07,21,31,0) + *************** +"^DD",8925.1,8925.1,.07,21,32,0) +NOTE on Availability of Titles for entering documents: +"^DD",8925.1,8925.1,.07,21,33,0) +Although Status affects availability for entering documents, there are +"^DD",8925.1,8925.1,.07,21,34,0) +other factors which also affect availability: A Document Definition is not +"^DD",8925.1,8925.1,.07,21,35,0) +available to a given user for entering documents (excepting the Document +"^DD",8925.1,8925.1,.07,21,36,0) +Definition Utility Try Action) unless all of the following 3 criteria are +"^DD",8925.1,8925.1,.07,21,37,0) +met: +"^DD",8925.1,8925.1,.07,21,38,0) + +"^DD",8925.1,8925.1,.07,21,39,0) + 1) It is a Document Definition of Type Title. +"^DD",8925.1,8925.1,.07,21,40,0) + +"^DD",8925.1,8925.1,.07,21,41,0) + 2) It has Status Active or Test. If it has Status Test, the user +"^DD",8925.1,8925.1,.07,21,42,0) +entering a document must own the Title. +"^DD",8925.1,8925.1,.07,21,43,0) + +"^DD",8925.1,8925.1,.07,21,44,0) + 3) If authorization for using the Title to enter documents is restricted +"^DD",8925.1,8925.1,.07,21,45,0) +by Business Rules, the user must be a member of the authorized user +"^DD",8925.1,8925.1,.07,21,46,0) +class. +"^DD",8925.1,8925.1,.07,21,47,0) + +"^DD",8925.1,8925.1,.07,21,48,0) +Unless these criteria are all met, users trying to enter documents will +"^DD",8925.1,8925.1,.07,21,49,0) +not SEE the Document Definition. Therefore it is wise to warn users when +"^DD",8925.1,8925.1,.07,21,50,0) +taking definitions offline for edit, and/or to do so at nonpeak hours for +"^DD",8925.1,8925.1,.07,21,51,0) +entering documents. +"^DD",8925.1,8925.1,.07,21,52,0) + +"^DD",8925.1,8925.1,.07,21,53,0) +The above description applies to document entry BOTH manually through +"^DD",8925.1,8925.1,.07,21,54,0) +menu options AND via upload. It does NOT apply to autoentry of documents +"^DD",8925.1,8925.1,.07,21,55,0) +via the TIU application interface. Adverse Reaction/Allergy notes entered +"^DD",8925.1,8925.1,.07,21,56,0) +by the Allergy package are an example of such autoentry. The TIU +"^DD",8925.1,8925.1,.07,21,57,0) +application interface for autoentering documents disregards Title status +"^DD",8925.1,8925.1,.07,21,58,0) +and Business Rules. +"^DD",8925.1,8925.1,.07,21,59,0) + ******************* +"^DD",8925.1,8925.1,.07,21,60,0) + +"^DD",8925.1,8925.1,.07,21,61,0) +When being upgraded to Status Active or Test, a Title is examined for +"^DD",8925.1,8925.1,.07,21,62,0) +rudimentary completeness and must be judged OK before the upgrade takes +"^DD",8925.1,8925.1,.07,21,63,0) +place. If desired, users can perform the same examination themselves by +"^DD",8925.1,8925.1,.07,21,64,0) +selecting action TRY. For Titles, Action TRY also permits the user to +"^DD",8925.1,8925.1,.07,21,65,0) +enter a document on the entry. The document is deleted immediately after +"^DD",8925.1,8925.1,.07,21,66,0) +the trial. +"^DD",8925.1,8925.1,.07,21,67,0) + +"^DD",8925.1,8925.1,.07,21,68,0) +Availability for entering documents is the central meaning of Status. +"^DD",8925.1,8925.1,.07,21,69,0) +However, Status also controls edit/deletion of Document Definitions: A +"^DD",8925.1,8925.1,.07,21,70,0) +Title can be edited ONLY if it has Status Inactive, ensuring that no one +"^DD",8925.1,8925.1,.07,21,71,0) +is using it to enter a document while its behavior is changing. Titles +"^DD",8925.1,8925.1,.07,21,72,0) +can be deleted only with Status Inactive. +"^DD",8925.1,8925.1,.07,21,73,0) + +"^DD",8925.1,8925.1,.07,21,74,0) +NOTE: Although Status affects Editing ability, it is not the only factor +"^DD",8925.1,8925.1,.07,21,75,0) +affecting editing: If an entry is already IN USE by documents, +"^DD",8925.1,8925.1,.07,21,76,0) +editing/deletion is restricted to aspects which will not harm existing +"^DD",8925.1,8925.1,.07,21,77,0) +TIU documents. +"^DD",8925.1,8925.1,.07,21,78,0) + +"^DD",8925.1,8925.1,.07,21,79,0) +Components under a Title have the same status as the Title: When a Title's +"^DD",8925.1,8925.1,.07,21,80,0) +status is changed, the statuses of its descendant Components are +"^DD",8925.1,8925.1,.07,21,81,0) +automatically changed with it. (Shared Components are an exception: see +"^DD",8925.1,8925.1,.07,21,82,0) +COMPONENT STATUS, below.) +"^DD",8925.1,8925.1,.07,21,83,0) + +"^DD",8925.1,8925.1,.07,21,84,0) + CLASS/DOCUMENT CLASS STATUS +"^DD",8925.1,8925.1,.07,21,85,0) + +"^DD",8925.1,8925.1,.07,21,86,0) +A Document Definition of Type Class or Document Class can have Status +"^DD",8925.1,8925.1,.07,21,87,0) +Inactive or Active. +"^DD",8925.1,8925.1,.07,21,88,0) + +"^DD",8925.1,8925.1,.07,21,89,0) +Basics for a Class or Document Class cannot be edited (except for Owner +"^DD",8925.1,8925.1,.07,21,90,0) +and Status) unless it is Inactive. Since Inactivating a Class/Document +"^DD",8925.1,8925.1,.07,21,91,0) +Class automatically inactivates its descendants, this ensures that all +"^DD",8925.1,8925.1,.07,21,92,0) +Titles which inherit behavior from it are neither Active nor Test, and are +"^DD",8925.1,8925.1,.07,21,93,0) +thus 'Offline' while inherited behavior is edited. +"^DD",8925.1,8925.1,.07,21,94,0) + +"^DD",8925.1,8925.1,.07,21,95,0) +In contrast to Basics, the ability to add/edit ITEMS of a Class/Document +"^DD",8925.1,8925.1,.07,21,96,0) +Class depends on the Status of the item, not the parent: it is NOT +"^DD",8925.1,8925.1,.07,21,97,0) +necessary to Inactivate a Class such as Progress Notes in order to +"^DD",8925.1,8925.1,.07,21,98,0) +edit/add items. +"^DD",8925.1,8925.1,.07,21,99,0) + +"^DD",8925.1,8925.1,.07,21,100,0) +Activating a Class/Document Class differs from Inactivating the +"^DD",8925.1,8925.1,.07,21,101,0) +Class/Document Class: When a Class/Document Class is ACTIVATED, its +"^DD",8925.1,8925.1,.07,21,102,0) +descendants may have any Status which their Type permits: they are not +"^DD",8925.1,8925.1,.07,21,103,0) +REQUIRED to be Active. Hence, they are not automatically Activated when +"^DD",8925.1,8925.1,.07,21,104,0) +the parent is Activated. +"^DD",8925.1,8925.1,.07,21,105,0) + +"^DD",8925.1,8925.1,.07,21,106,0) + COMPONENT STATUS +"^DD",8925.1,8925.1,.07,21,107,0) + +"^DD",8925.1,8925.1,.07,21,108,0) +A Document Definition of Type Component has the same status as its parent: +"^DD",8925.1,8925.1,.07,21,109,0) +Its status can be changed only by changing the Status of its Parent, if it +"^DD",8925.1,8925.1,.07,21,110,0) +has one. Components without parents are always Inactive. +"^DD",8925.1,8925.1,.07,21,111,0) + +"^DD",8925.1,8925.1,.07,21,112,0) +NOTE: The above implies that Test or Active Titles cannot have Inactive +"^DD",8925.1,8925.1,.07,21,113,0) +Components. In other words, Inactivating a Component is NOT a way of +"^DD",8925.1,8925.1,.07,21,114,0) +retiring it. If a Component is no longer a useful section of a Title, it +"^DD",8925.1,8925.1,.07,21,115,0) +should be edited so as to make it useful, or it should be deleted AS AN +"^DD",8925.1,8925.1,.07,21,116,0) +ITEM from the Title of which it is a part. As with all retired Document +"^DD",8925.1,8925.1,.07,21,117,0) +Definitions, it should NOT be deleted FROM THE FILE if it has been used by +"^DD",8925.1,8925.1,.07,21,118,0) +documents. +"^DD",8925.1,8925.1,.07,21,119,0) + +"^DD",8925.1,8925.1,.07,21,120,0) +Components can be edited only if they have status Inactive. This ensures +"^DD",8925.1,8925.1,.07,21,121,0) +that all Titles using them are offline while the components are being +"^DD",8925.1,8925.1,.07,21,122,0) +edited. +"^DD",8925.1,8925.1,.07,21,123,0) + +"^DD",8925.1,8925.1,.07,21,124,0) +Shared Components are a special case since they can have multiple parents. +"^DD",8925.1,8925.1,.07,21,125,0) +They DO NOT HAVE A STATUS. They can be edited only when all parent Titles +"^DD",8925.1,8925.1,.07,21,126,0) +have Status Inactive. (The Detailed Display screen shows parents.) This +"^DD",8925.1,8925.1,.07,21,127,0) +ensures that all parent Titles of Shared Components are offline while the +"^DD",8925.1,8925.1,.07,21,128,0) +component is being edited. Edit of Shared Components is permitted only +"^DD",8925.1,8925.1,.07,21,129,0) +through the Option Sort Document Definitions. +"^DD",8925.1,8925.1,.07,21,130,0) + +"^DD",8925.1,8925.1,.07,21,131,0) +Edit of Shared Components is severely restricted by Ownership, since they +"^DD",8925.1,8925.1,.07,21,132,0) +may be used multiple times and across the site. Even an Inactive Status +"^DD",8925.1,8925.1,.07,21,133,0) +does not permit a manager (person with Manager menu) to override ownership +"^DD",8925.1,8925.1,.07,21,134,0) +and edit a Shared Component they don't own. See Shared Components, under +"^DD",8925.1,8925.1,.07,21,135,0) +Description of Type. See Description of Shared. +"^DD",8925.1,8925.1,.07,21,136,0) + +"^DD",8925.1,8925.1,.07,21,137,0) + OBJECT STATUS +"^DD",8925.1,8925.1,.07,21,138,0) + +"^DD",8925.1,8925.1,.07,21,139,0) +Document Definitions of Type Object have Status Inactive or Active. +"^DD",8925.1,8925.1,.07,21,140,0) + +"^DD",8925.1,8925.1,.07,21,141,0) +Only ACTIVE objects function. That is, if a user enters a document on a +"^DD",8925.1,8925.1,.07,21,142,0) +Title with boilerplate text containing an inactive object, the object +"^DD",8925.1,8925.1,.07,21,143,0) +doesn't do anything; the user sees the name of the object and an error +"^DD",8925.1,8925.1,.07,21,144,0) +message in place of the object data. +"^DD",8925.1,8925.1,.07,21,145,0) + +"^DD",8925.1,8925.1,.07,21,146,0) +Only ACTIVE objects should be embedded in boilerplate text. Exception: +"^DD",8925.1,8925.1,.07,21,147,0) +owners who are creating/editing objects. Others should NOT embed inactive +"^DD",8925.1,8925.1,.07,21,148,0) +objects in boilerplate text since they may not be ready for use and since +"^DD",8925.1,8925.1,.07,21,149,0) +they do not function when users enter documents against them. Titles whose +"^DD",8925.1,8925.1,.07,21,150,0) +boilerplate text contains inactive objects cannot be activated. (This +"^DD",8925.1,8925.1,.07,21,151,0) +does NOT imply that active titles never have inactive objects embedded in +"^DD",8925.1,8925.1,.07,21,152,0) +them since users can, after a warning, inactivate objects even when they +"^DD",8925.1,8925.1,.07,21,153,0) +are embedded in active titles.) +"^DD",8925.1,8925.1,.07,21,154,0) + +"^DD",8925.1,8925.1,.07,21,155,0) +Only INACTIVE objects can be edited (and only by an owner). Only an owner +"^DD",8925.1,8925.1,.07,21,156,0) +can activate/inactivate an object. (Exception: if a user owns an object +"^DD",8925.1,8925.1,.07,21,157,0) +and edits the owner to someone else, the user is not prevented from going +"^DD",8925.1,8925.1,.07,21,158,0) +on to edit the status in the same edit session since they WERE the owner a +"^DD",8925.1,8925.1,.07,21,159,0) +few seconds ago.) Active objects are assumed to be ready for use in any +"^DD",8925.1,8925.1,.07,21,160,0) +boilerplate text. +"^DD",8925.1,8925.1,.07,21,161,0) + +"^DD",8925.1,8925.1,.07,21,162,0) +Since the owner is essentially caretaker of the object for the entire +"^DD",8925.1,8925.1,.07,21,163,0) +site, the owner should consult with all who use it before editing it. An +"^DD",8925.1,8925.1,.07,21,164,0) +object can be tested by embedding it in the boilerplate text of a Title +"^DD",8925.1,8925.1,.07,21,165,0) +and selecting action Try for the Title. It need not have status Active +"^DD",8925.1,8925.1,.07,21,166,0) +for this testing (and SHOULD not have status Active until testing is +"^DD",8925.1,8925.1,.07,21,167,0) +complete). Owners who inactivate objects for editing should make SURE to +"^DD",8925.1,8925.1,.07,21,168,0) +reactivate them if they are being used. +"^DD",8925.1,8925.1,.07,21,169,0) + +"^DD",8925.1,8925.1,.07,21,170,0) +Sites should either inactivate relevant Titles before editing objects or +"^DD",8925.1,8925.1,.07,21,171,0) +edit objects only when users are not likely to be ENTERING documents since +"^DD",8925.1,8925.1,.07,21,172,0) +Inactive objects do not function. +"^DD",8925.1,8925.1,.07,21,173,0) + +"^DD",8925.1,8925.1,.07,21,174,0) +If a site changes the name or behavior of an Object, it is up to the SITE +"^DD",8925.1,8925.1,.07,21,175,0) +to change the name wherever it has already been embedded in Boilerplate +"^DD",8925.1,8925.1,.07,21,176,0) +Text, and to inform users of the change. +"^DD",8925.1,8925.1,.07,21,177,0) + +"^DD",8925.1,8925.1,.07,21,178,0) +An object which is no longer wanted for future documents can be removed +"^DD",8925.1,8925.1,.07,21,179,0) +from the boilerplate text of all Titles and Components and then deleted +"^DD",8925.1,8925.1,.07,21,180,0) +from file 8925.1. Only an owner can delete it. All of the documents that +"^DD",8925.1,8925.1,.07,21,181,0) +used it have already got it in hard words so there is no need to keep it +"^DD",8925.1,8925.1,.07,21,182,0) +for their sake. Old Objects should be edited so they are useful or +"^DD",8925.1,8925.1,.07,21,183,0) +deleted, not kept around forever as Inactive. +"^DD",8925.1,8925.1,.07,"DT") +2971016 +"^DD",8925.1,8925.1,.08,0) +IN USE^CJ6^^ ; ^S X=$S($L($T(^TIUFLF)):$$DDEFUSED^TIUFLF(D0),1:"?") +"^DD",8925.1,8925.1,.08,.1) + +"^DD",8925.1,8925.1,.08,9) +^ +"^DD",8925.1,8925.1,.08,9.01) + +"^DD",8925.1,8925.1,.08,9.1) +S X=$S($L($T(^TIUFLF)):$$DDEFUSED^TIUFLF(D0),1:"?") +"^DD",8925.1,8925.1,.08,21,0) +^^55^55^2970125^ +"^DD",8925.1,8925.1,.08,21,1,0) +IN USE applies to all entries except those of Type Object. It cannot be +"^DD",8925.1,8925.1,.08,21,2,0) +edited since it gets its value automatically. +"^DD",8925.1,8925.1,.08,21,3,0) + +"^DD",8925.1,8925.1,.08,21,4,0) +IN USE may have values 'Yes', 'No', or '?'. +"^DD",8925.1,8925.1,.08,21,5,0) + +"^DD",8925.1,8925.1,.08,21,6,0) +A Document Definition of Type Title or Component is In Use (Yes) if there +"^DD",8925.1,8925.1,.08,21,7,0) +are entries IN THE TIU DOCUMENT file which store it as their Document +"^DD",8925.1,8925.1,.08,21,8,0) +Definition. If not, it is NOT used (No). +"^DD",8925.1,8925.1,.08,21,9,0) + +"^DD",8925.1,8925.1,.08,21,10,0) +NOTE: It is possible for Document Definitions to be used by documents in +"^DD",8925.1,8925.1,.08,21,11,0) +files other than the TIU Document file and still be NOT In Use since In +"^DD",8925.1,8925.1,.08,21,12,0) +Use means in use by documents in the TIU Document Definition file. See +"^DD",8925.1,8925.1,.08,21,13,0) +Warning, below. +"^DD",8925.1,8925.1,.08,21,14,0) + +"^DD",8925.1,8925.1,.08,21,15,0) +A Document Definition of Type Class or Document Class is In Use (Yes) if +"^DD",8925.1,8925.1,.08,21,16,0) +it has children of Type Title which are In Use. That is, it is Used by +"^DD",8925.1,8925.1,.08,21,17,0) +Documents (Yes) if there are entries in the TIU Document file which +"^DD",8925.1,8925.1,.08,21,18,0) +inherit behavior from it. If not, it is NOT used (No). +"^DD",8925.1,8925.1,.08,21,19,0) + +"^DD",8925.1,8925.1,.08,21,20,0) +IN USE has value '?' for a Document Definition File entry if routine +"^DD",8925.1,8925.1,.08,21,21,0) +TIUFLF is missing or if the program encounters a nonexistent item and the +"^DD",8925.1,8925.1,.08,21,22,0) +entry is not In Use so far as the check has been able to go. +"^DD",8925.1,8925.1,.08,21,23,0) + +"^DD",8925.1,8925.1,.08,21,24,0) +Note: Since Shared Components can be items of more than one Title, a +"^DD",8925.1,8925.1,.08,21,25,0) +Shared Component may be In Use even when a particular parent Title is +"^DD",8925.1,8925.1,.08,21,26,0) +NOT In Use. This simply means that it is also a Component of another +"^DD",8925.1,8925.1,.08,21,27,0) +Title which IS In Use. +"^DD",8925.1,8925.1,.08,21,28,0) + +"^DD",8925.1,8925.1,.08,21,29,0) +If IN USE has the explicit value 'No' for a particular Document Definition +"^DD",8925.1,8925.1,.08,21,30,0) +entry, the entry can be deleted by the Owner without harming documents IN +"^DD",8925.1,8925.1,.08,21,31,0) +TIU DOCUMENT FILE 8925. Deleting it will, however, orphan any descendant +"^DD",8925.1,8925.1,.08,21,32,0) +Document Definitions. +"^DD",8925.1,8925.1,.08,21,33,0) + +"^DD",8925.1,8925.1,.08,21,34,0) +WARNING: If a site is using TIU to upload documents into a file other than +"^DD",8925.1,8925.1,.08,21,35,0) +the TIU Document file, it may create Document Definition entries to store +"^DD",8925.1,8925.1,.08,21,36,0) +upload information. For example, it may create an Operative Reports title +"^DD",8925.1,8925.1,.08,21,37,0) +containing instructions for uploading documents into the Surgery file. +"^DD",8925.1,8925.1,.08,21,38,0) +These document definitions will be orphans and will be NOT In Use, since +"^DD",8925.1,8925.1,.08,21,39,0) +documents using them are not stored in the TIU Document file. They must +"^DD",8925.1,8925.1,.08,21,40,0) +NOT be deleted from the Document Definition file. +"^DD",8925.1,8925.1,.08,21,41,0) + +"^DD",8925.1,8925.1,.08,21,42,0) +Note: Deleting Objects will not harm existing documents, but WILL HARM +"^DD",8925.1,8925.1,.08,21,43,0) +future documents if the Object is embedded in existing Document Definition +"^DD",8925.1,8925.1,.08,21,44,0) +Boilerplate Text. +"^DD",8925.1,8925.1,.08,21,45,0) + +"^DD",8925.1,8925.1,.08,21,46,0) +If IN USE has value 'Yes' or '?', the Document Definition Utility TIUF +"^DD",8925.1,8925.1,.08,21,47,0) +does not permit the entry to be deleted. Deleting the entry would cause +"^DD",8925.1,8925.1,.08,21,48,0) +documents in file 8925 not to function. This is true even if the entry +"^DD",8925.1,8925.1,.08,21,49,0) +has status 'Inactive' and documents are no longer being written on the +"^DD",8925.1,8925.1,.08,21,50,0) +entry. +"^DD",8925.1,8925.1,.08,21,51,0) + +"^DD",8925.1,8925.1,.08,21,52,0) +Technical Note: A Document Definition of Type Title or Component is IN +"^DD",8925.1,8925.1,.08,21,53,0) +USE if and only if it appears in file 8925's 'B' Cross Reference. +"^DD",8925.1,8925.1,.08,21,54,0) + +"^DD",8925.1,8925.1,.08,21,55,0) +In Use is a BASIC field. +"^DD",8925.1,8925.1,.08,"DT") +2960618 +"^DD",8925.1,8925.1,.1,0) +SHARED^SX^1:YES;0:NO;^0;10^K:'$G(TIUFPRIV) X +"^DD",8925.1,8925.1,.1,.1) +SHARED COMPONENT +"^DD",8925.1,8925.1,.1,3) +Enter Y for YES if this Component is intended for broad use across the site, i.e., it can be used more than once, and need not be owned by the user. +"^DD",8925.1,8925.1,.1,21,0) +^^48^48^2970220^ +"^DD",8925.1,8925.1,.1,21,1,0) +Applies to entries of Type Component only. +"^DD",8925.1,8925.1,.1,21,2,0) + +"^DD",8925.1,8925.1,.1,21,3,0) +Document Definitions of Type Component may be designated SHARED by Owners +"^DD",8925.1,8925.1,.1,21,4,0) +who have the Manager menu. This means the Component can be an item under +"^DD",8925.1,8925.1,.1,21,5,0) +multiple parents, and any user who owns a Title can add it as an item. +"^DD",8925.1,8925.1,.1,21,6,0) + +"^DD",8925.1,8925.1,.1,21,7,0) +Shared Components are the ONLY members of the Document Definition +"^DD",8925.1,8925.1,.1,21,8,0) +hierarchy which can appear in more than one place in the hierarchy. +"^DD",8925.1,8925.1,.1,21,9,0) +(Objects can be used in multiple entries, but are not members of the +"^DD",8925.1,8925.1,.1,21,10,0) +hierarchy.) +"^DD",8925.1,8925.1,.1,21,11,0) + +"^DD",8925.1,8925.1,.1,21,12,0) +Shared Components are intended for broad use across the site. An example +"^DD",8925.1,8925.1,.1,21,13,0) +might be a Privacy Act Component. Since a Shared Component may be used in +"^DD",8925.1,8925.1,.1,21,14,0) +many different Document Definitions, its Owner is essentially caretaker +"^DD",8925.1,8925.1,.1,21,15,0) +for it, hospital wide, and must take into account all users before editing +"^DD",8925.1,8925.1,.1,21,16,0) +it. Users who disagree with a proposed change can opt to create and use +"^DD",8925.1,8925.1,.1,21,17,0) +their own copy instead of using the Shared Component. +"^DD",8925.1,8925.1,.1,21,18,0) + +"^DD",8925.1,8925.1,.1,21,19,0) +Parents of a Shared Component are listed in the Detailed Display Screen. +"^DD",8925.1,8925.1,.1,21,20,0) + +"^DD",8925.1,8925.1,.1,21,21,0) +Shared Field values are 1 for YES and 0 for NO, with a default value of +"^DD",8925.1,8925.1,.1,21,22,0) +0 for NO if the field is empty. +"^DD",8925.1,8925.1,.1,21,23,0) + +"^DD",8925.1,8925.1,.1,21,24,0) +An entry may not be designated Shared unless it is of Type Component. Only +"^DD",8925.1,8925.1,.1,21,25,0) +a Manager (person with Manager menu) and only an Owner can designate a +"^DD",8925.1,8925.1,.1,21,26,0) +Component as Shared. Only an OWNER can edit it. (Normally Managers can +"^DD",8925.1,8925.1,.1,21,27,0) +override ownership and edit entries. Manager Options do NOT override +"^DD",8925.1,8925.1,.1,21,28,0) +Ownership for editing Shared Components). Shared Components can only be +"^DD",8925.1,8925.1,.1,21,29,0) +edited from the Sort Document Definitions Option. +"^DD",8925.1,8925.1,.1,21,30,0) + +"^DD",8925.1,8925.1,.1,21,31,0) +Shared Components cannot be deleted. If they do not have multiple +"^DD",8925.1,8925.1,.1,21,32,0) +parents, they can, however, be edited to NOT shared and THEN deleted, +"^DD",8925.1,8925.1,.1,21,33,0) +assuming they are not In Use by documents and the parent is Inactive. +"^DD",8925.1,8925.1,.1,21,34,0) + +"^DD",8925.1,8925.1,.1,21,35,0) +Shared Components do NOT HAVE a Status. They can be edited only if all +"^DD",8925.1,8925.1,.1,21,36,0) +parent Titles are Inactive. This ensures that parent Titles are offline +"^DD",8925.1,8925.1,.1,21,37,0) +for entering documents while their components are being edited. Parents +"^DD",8925.1,8925.1,.1,21,38,0) +are listed on the Detailed Display Screen. +"^DD",8925.1,8925.1,.1,21,39,0) + +"^DD",8925.1,8925.1,.1,21,40,0) +If a Shared Component has subcomponents, they are automatically Shared, +"^DD",8925.1,8925.1,.1,21,41,0) +since they, with their parents, can be used in more than one place in the +"^DD",8925.1,8925.1,.1,21,42,0) +hierarchy. +"^DD",8925.1,8925.1,.1,21,43,0) + +"^DD",8925.1,8925.1,.1,21,44,0) +Sharing of Document Definitions other than Components is not permitted +"^DD",8925.1,8925.1,.1,21,45,0) +because it unduly restricts the owner's right to edit/delete the Document +"^DD",8925.1,8925.1,.1,21,46,0) +Definition and adds undue complexity to the Hierarchy. +"^DD",8925.1,8925.1,.1,21,47,0) + +"^DD",8925.1,8925.1,.1,21,48,0) +Shared is a BASIC field. +"^DD",8925.1,8925.1,.1,"DT") +2961022 +"^DD",8925.1,8925.1,.11,0) +ORPHAN^CJ8^^ ; ^S X=$S($L($T(^TIUFLF4)):$$ORPHAN^TIUFLF4(D0,^TIU(8925.1,D0,0)),1:"?") +"^DD",8925.1,8925.1,.11,9) +^ +"^DD",8925.1,8925.1,.11,9.01) + +"^DD",8925.1,8925.1,.11,9.1) +S X=$S($L($T(^TIUFLF4)):$$ORPHAN^TIUFLF4(D0,^TIU(8925.1,D0,0)),1:"?") +"^DD",8925.1,8925.1,.11,21,0) +^^57^57^2970220^ +"^DD",8925.1,8925.1,.11,21,1,0) +Orphan applies to Document Definitions of all Types except Objects +"^DD",8925.1,8925.1,.11,21,2,0) +and Shared Components. +"^DD",8925.1,8925.1,.11,21,3,0) + +"^DD",8925.1,8925.1,.11,21,4,0) +Orphan is not editable since it gets its value automatically. +"^DD",8925.1,8925.1,.11,21,5,0) + +"^DD",8925.1,8925.1,.11,21,6,0) +Document Definitions are Orphans if they do not belong to the Clinical +"^DD",8925.1,8925.1,.11,21,7,0) +Documents Hierarchy, i.e., they cannot trace their ancestry all the way +"^DD",8925.1,8925.1,.11,21,8,0) +back to the Class Clinical Documents. If an Orphan is not In Use, it +"^DD",8925.1,8925.1,.11,21,9,0) +may be "dead wood" which should be deleted from the file. Orphans not In +"^DD",8925.1,8925.1,.11,21,10,0) +Use which SHOULD NOT BE DELETED include those being kept for later +"^DD",8925.1,8925.1,.11,21,11,0) +possible use, those temporarily orphaned in order to move them around in +"^DD",8925.1,8925.1,.11,21,12,0) +the hierarchy, and those used for uploading documents into files other +"^DD",8925.1,8925.1,.11,21,13,0) +than the TIU Document file. +"^DD",8925.1,8925.1,.11,21,14,0) + +"^DD",8925.1,8925.1,.11,21,15,0) +(Orphan does not apply to Objects since they don't ever belong to the +"^DD",8925.1,8925.1,.11,21,16,0) +hierarchy. Orphan does not apply to Shared Components since they may +"^DD",8925.1,8925.1,.11,21,17,0) +have more than one line of ancestry.) +"^DD",8925.1,8925.1,.11,21,18,0) + +"^DD",8925.1,8925.1,.11,21,19,0) +Warning: The DOCUMENT DEFINITION file may contain orphan entries which +"^DD",8925.1,8925.1,.11,21,20,0) +are not used by documents in the TIU Document file but which contain +"^DD",8925.1,8925.1,.11,21,21,0) +upload instructions for storing documents somewhere else. For example, if +"^DD",8925.1,8925.1,.11,21,22,0) +a site is uploading Operative Reports into the Surgery file, there may be +"^DD",8925.1,8925.1,.11,21,23,0) +an orphan Operative Report Document Definition in the DOCUMENT DEFINITION +"^DD",8925.1,8925.1,.11,21,24,0) +file. These should NOT be deleted just because they are orphans. Such +"^DD",8925.1,8925.1,.11,21,25,0) +entries can be identified by edit/viewing them through the Sort Option +"^DD",8925.1,8925.1,.11,21,26,0) +and looking for Upload fields. +"^DD",8925.1,8925.1,.11,21,27,0) + +"^DD",8925.1,8925.1,.11,21,28,0) +NOTE: Orphan as used in the Document Definition Utility TIUF does NOT mean +"^DD",8925.1,8925.1,.11,21,29,0) +having no parents. For example, suppose Exceptional Day Pass Note has +"^DD",8925.1,8925.1,.11,21,30,0) +parent Day Pass Note. If Day Pass Note has no parent, then Exceptional +"^DD",8925.1,8925.1,.11,21,31,0) +Day Pass Note cannot trace its ancestry back to Clinical Documents and is +"^DD",8925.1,8925.1,.11,21,32,0) +an Orphan even though it has a parent. +"^DD",8925.1,8925.1,.11,21,33,0) + +"^DD",8925.1,8925.1,.11,21,34,0) +Orphans are invisible to TIU users and cannot be used to enter documents. +"^DD",8925.1,8925.1,.11,21,35,0) + +"^DD",8925.1,8925.1,.11,21,36,0) +When an item under a non-orphan is deleted as an item, it becomes an +"^DD",8925.1,8925.1,.11,21,37,0) +orphan along with all of its descendants. TIUF, the Document Definition +"^DD",8925.1,8925.1,.11,21,38,0) +Utility, does not permit non-orphan Titles to become orphaned if they are +"^DD",8925.1,8925.1,.11,21,39,0) +In Use. Titles already used but being retired from further use should +"^DD",8925.1,8925.1,.11,21,40,0) +be Inactivated, NOT orphaned. Components are a different story; +"^DD",8925.1,8925.1,.11,21,41,0) +components being retired from further use can and should be orphaned +"^DD",8925.1,8925.1,.11,21,42,0) +(deleted as items from the Title). +"^DD",8925.1,8925.1,.11,21,43,0) + +"^DD",8925.1,8925.1,.11,21,44,0) +Reason: Titles inherit attributes and therefore require a complete +"^DD",8925.1,8925.1,.11,21,45,0) +ancestry in order to process existing documents. Since components, on the +"^DD",8925.1,8925.1,.11,21,46,0) +other hand, do not inherit attributes, they do NOT require a complete +"^DD",8925.1,8925.1,.11,21,47,0) +ancestry to process existing documents (although they must remain in the +"^DD",8925.1,8925.1,.11,21,48,0) +file.) +"^DD",8925.1,8925.1,.11,21,49,0) + +"^DD",8925.1,8925.1,.11,21,50,0) +Since Orphans do not belong to the Hierarchy, they do NOT appear on the +"^DD",8925.1,8925.1,.11,21,51,0) +Edit Document Definitions Option. They can be accessed through the Sort +"^DD",8925.1,8925.1,.11,21,52,0) +Document Definitions Option. +"^DD",8925.1,8925.1,.11,21,53,0) + +"^DD",8925.1,8925.1,.11,21,54,0) +The field Orphan may have values 'Yes', 'No', or '?'. Orphan has value '?' +"^DD",8925.1,8925.1,.11,21,55,0) +if there are technical errors making its value unknown. +"^DD",8925.1,8925.1,.11,21,56,0) + +"^DD",8925.1,8925.1,.11,21,57,0) +Orphan is a BASIC field. +"^DD",8925.1,8925.1,.11,"DT") +2960201 +"^DD",8925.1,8925.1,.12,0) +HAS BOILTXT^CJ7^^ ; ^S TIUFBTXT=$S($L($T(^TIUFLF)):$$HASBOIL^TIUFLF(D0,^TIU(8925.1,D0,0)),1:"UNKNOWN"),X=$S(TIUFBTXT:"YES",TIUFBTXT=0:"NO",1:TIUFBTXT) K TIUFBTXT +"^DD",8925.1,8925.1,.12,.1) +HAS BOILERPLATE TEXT +"^DD",8925.1,8925.1,.12,9) +^ +"^DD",8925.1,8925.1,.12,9.01) + +"^DD",8925.1,8925.1,.12,9.1) +S TIUFBTXT=$S($L($T(^TIUFLF)):$$HASBOIL^TIUFLF(D0,^TIU(8925.1,D0,0)),1:"UNKNOWN"),X=$S(TIUFBTXT:"YES",TIUFBTXT=0:"NO",1:TIUFBTXT) K TIUFBTXT +"^DD",8925.1,8925.1,.12,21,0) +^^3^3^2970128^ +"^DD",8925.1,8925.1,.12,21,1,0) +Applies to Types Title and Component only. Cannot be edited since value +"^DD",8925.1,8925.1,.12,21,2,0) +is automatic. A Document Definition Has Boiltxt if it or its descendant +"^DD",8925.1,8925.1,.12,21,3,0) +Components have Boilerplate Text (Field 3). BASIC field. +"^DD",8925.1,8925.1,.12,"DT") +2960118 +"^DD",8925.1,8925.1,.13,0) +NATIONAL STANDARD^SX^1:YES;0:NO;^0;13^K:'$G(TIUFPRIV) X +"^DD",8925.1,8925.1,.13,3) +Enter YES if entry is Standard across the nation, i.e. sites mustn't edit +"^DD",8925.1,8925.1,.13,4) + +"^DD",8925.1,8925.1,.13,21,0) +^^47^47^2990223^ +"^DD",8925.1,8925.1,.13,21,1,0) +Some Document Definitions, for example, CWAD's, are developed nationally +"^DD",8925.1,8925.1,.13,21,2,0) +and sent out as standardized entries across the nation. TIU and other +"^DD",8925.1,8925.1,.13,21,3,0) +packages depend on their standard definition, and they must not be edited +"^DD",8925.1,8925.1,.13,21,4,0) +by sites but only by the persons who are nationally responsible for them. +"^DD",8925.1,8925.1,.13,21,5,0) + +"^DD",8925.1,8925.1,.13,21,6,0) +Such entries are marked NATIONAL STANDARD (field has value 1 for YES), +"^DD",8925.1,8925.1,.13,21,7,0) +which generally prevents sites from editing the entry. +"^DD",8925.1,8925.1,.13,21,8,0) + +"^DD",8925.1,8925.1,.13,21,9,0) +In two cases, sites are permitted to edit National Standard entries. The +"^DD",8925.1,8925.1,.13,21,10,0) +first case concerns Titles. Sites can edit Status and Abbreviation for +"^DD",8925.1,8925.1,.13,21,11,0) +National Titles. Status INACTIVE for a National Title prevents manual and +"^DD",8925.1,8925.1,.13,21,12,0) +upload entry of documents for the Title, while continuing to permit +"^DD",8925.1,8925.1,.13,21,13,0) +automatic entry for the Title via the TIU application interface for new +"^DD",8925.1,8925.1,.13,21,14,0) +notes. (Example: Adverse Reaction/Allergy notes are automatically +"^DD",8925.1,8925.1,.13,21,15,0) +entered by the Allergy package.) Editing Abbreviation gives sites a means +"^DD",8925.1,8925.1,.13,21,16,0) +of grouping national titles with other National and non-National Titles as +"^DD",8925.1,8925.1,.13,21,17,0) +they please. +"^DD",8925.1,8925.1,.13,21,18,0) + +"^DD",8925.1,8925.1,.13,21,19,0) +The second case where edit of National entries is permitted concerns the +"^DD",8925.1,8925.1,.13,21,20,0) +Item Multiple: +"^DD",8925.1,8925.1,.13,21,21,0) + +"^DD",8925.1,8925.1,.13,21,22,0) +If a National Standard entry has Type Class or Document Class, sites can +"^DD",8925.1,8925.1,.13,21,23,0) +add/delete Nonnational items as they please, and can edit ALL items AS +"^DD",8925.1,8925.1,.13,21,24,0) +ITEMS (e.g. Item Sequence, etc.). Sites CANNOT add/delete National items. +"^DD",8925.1,8925.1,.13,21,25,0) + +"^DD",8925.1,8925.1,.13,21,26,0) +If a National Standard entry has Type Title or Component, sites +"^DD",8925.1,8925.1,.13,21,27,0) +cannot add or delete items, but can still edit items AS ITEMS. +"^DD",8925.1,8925.1,.13,21,28,0) + +"^DD",8925.1,8925.1,.13,21,29,0) +Sites cannot add National Standard entries as Items to parents. There is +"^DD",8925.1,8925.1,.13,21,30,0) +one exception: Sites can add National Shared Components to (nonnational) +"^DD",8925.1,8925.1,.13,21,31,0) +Titles if they wish. Sites can delete National Standard Items from +"^DD",8925.1,8925.1,.13,21,32,0) +nonnational parents. (Unless there has been a mistake, such items will be +"^DD",8925.1,8925.1,.13,21,33,0) +limited to Shared Components only.) +"^DD",8925.1,8925.1,.13,21,34,0) + +"^DD",8925.1,8925.1,.13,21,35,0) +Field is NOT heritable. If field has no value for an entry, value is 0 by +"^DD",8925.1,8925.1,.13,21,36,0) +default. This means that entries created by sites are NOT National +"^DD",8925.1,8925.1,.13,21,37,0) +Standard. +"^DD",8925.1,8925.1,.13,21,38,0) + +"^DD",8925.1,8925.1,.13,21,39,0) +Technical Note: +"^DD",8925.1,8925.1,.13,21,40,0) + +"^DD",8925.1,8925.1,.13,21,41,0) +National entries (except for Shared Components) must have National +"^DD",8925.1,8925.1,.13,21,42,0) +ancestors: if a National entry has a nonNational ancestor, the +"^DD",8925.1,8925.1,.13,21,43,0) +Document Definition Utility TIUF does not permit it to be activated. +"^DD",8925.1,8925.1,.13,21,44,0) +(Shared Components need not have National ancestors, and do not have a +"^DD",8925.1,8925.1,.13,21,45,0) +Status.) +"^DD",8925.1,8925.1,.13,21,46,0) + +"^DD",8925.1,8925.1,.13,21,47,0) +National Standard is a BASIC field. +"^DD",8925.1,8925.1,.13,"DT") +2970128 +"^DD",8925.1,8925.1,.14,0) +POSTING INDICATOR^S^C:crisis note;W:warning;A:allergy/ADR;D:directive;^0;14^Q +"^DD",8925.1,8925.1,.14,1,0) +^.1 +"^DD",8925.1,8925.1,.14,1,1,0) +8925.1^APOST +"^DD",8925.1,8925.1,.14,1,1,1) +S ^TIU(8925.1,"APOST",$E(X,1,30),DA)="" +"^DD",8925.1,8925.1,.14,1,1,2) +K ^TIU(8925.1,"APOST",$E(X,1,30),DA) +"^DD",8925.1,8925.1,.14,1,1,"%D",0) +^^3^3^2970227^ +"^DD",8925.1,8925.1,.14,1,1,"%D",1,0) +This REGULAR FileMan Cross-reference by Posting Indicator will help to +"^DD",8925.1,8925.1,.14,1,1,"%D",2,0) +identify which Document Classes are associated with each of the currently +"^DD",8925.1,8925.1,.14,1,1,"%D",3,0) +supported Posting Types. +"^DD",8925.1,8925.1,.14,1,1,"DT") +2970227 +"^DD",8925.1,8925.1,.14,3) +Please choose an indicator corresponding to the Posting Type +"^DD",8925.1,8925.1,.14,21,0) +^^2^2^2970515^ +"^DD",8925.1,8925.1,.14,21,1,0) +This field is used to help identify indicators of the Patient Posting Type +"^DD",8925.1,8925.1,.14,21,2,0) +to which the Document Definition should be ascribed. +"^DD",8925.1,8925.1,.14,"DT") +2970227 +"^DD",8925.1,8925.1,1,0) +UPLOAD DELIMITED ASCII HEADER^8925.11I^^ITEM;0 +"^DD",8925.1,8925.1,1,21,0) +^^7^7^2970108^^ +"^DD",8925.1,8925.1,1,21,1,0) +This multiple contains the upload record header format of the Document +"^DD",8925.1,8925.1,1,21,2,0) +Definition, to be used by the upload/router/filer when the preferred +"^DD",8925.1,8925.1,1,21,3,0) +header format is Delimited string (as opposed to captioned). +"^DD",8925.1,8925.1,1,21,4,0) + +"^DD",8925.1,8925.1,1,21,5,0) +Delimited string is useful only if the site has a way of automating +"^DD",8925.1,8925.1,1,21,6,0) +creation of upload record headers. If they are being created by a human +"^DD",8925.1,8925.1,1,21,7,0) +transcriber, use Captioned Record Headers instead. +"^DD",8925.1,8925.1,1,"DT") +2960729 +"^DD",8925.1,8925.1,1.01,0) +UPLOAD TARGET FILE^*P1'^DIC(^1;1^S DIC("S")="I $D(^DIC(+Y,""%"",""B"",""TIU""))" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X +"^DD",8925.1,8925.1,1.01,3) +Select the DHCP file in which the document will be stored. +"^DD",8925.1,8925.1,1.01,12) +Only files with the "TIU" application group may be selected. +"^DD",8925.1,8925.1,1.01,12.1) +S DIC("S")="I $D(^DIC(+Y,""%"",""B"",""TIU""))" +"^DD",8925.1,8925.1,1.01,21,0) +^^20^20^2970506^ +"^DD",8925.1,8925.1,1.01,21,1,0) + ------------- +"^DD",8925.1,8925.1,1.01,21,2,0) +NOTE ON UPLOAD: +"^DD",8925.1,8925.1,1.01,21,3,0) +Upload fields (Upload Target File, Laygo Allowed, Target Text Field +"^DD",8925.1,8925.1,1.01,21,4,0) +Subscript, Upload Look-Up Method, Upload Post-Filing Code, Upload Filing +"^DD",8925.1,8925.1,1.01,21,5,0) +Error Code, and multiple fields Upload Delimited ASCII Header and Upload +"^DD",8925.1,8925.1,1.01,21,6,0) +Captioned ASCII Header) apply to Document Definitions of Type Class, +"^DD",8925.1,8925.1,1.01,21,7,0) +Document Class, and Title. Multiple fields Upload Delimited ASCII Header +"^DD",8925.1,8925.1,1.01,21,8,0) +and Upload Captioned ASCII Header are heritable AS A GROUP. Do NOT set +"^DD",8925.1,8925.1,1.01,21,9,0) +partial information at a lower level; if you set ANY information at a +"^DD",8925.1,8925.1,1.01,21,10,0) +lower level, it should be COMPLETE. For information on editing heritable +"^DD",8925.1,8925.1,1.01,21,11,0) +fields, see Technical field: Edit Template. +"^DD",8925.1,8925.1,1.01,21,12,0) + +"^DD",8925.1,8925.1,1.01,21,13,0) +TIUF, the Document Definition Utility does NOT display inherited Upload +"^DD",8925.1,8925.1,1.01,21,14,0) +information. To see/edit existing upload information, edit/view at the +"^DD",8925.1,8925.1,1.01,21,15,0) +level it is set. +"^DD",8925.1,8925.1,1.01,21,16,0) + +"^DD",8925.1,8925.1,1.01,21,17,0) + -------------- +"^DD",8925.1,8925.1,1.01,21,18,0) +The UPLOAD TARGET FILE is the VA FileMan file in which fixed-field header +"^DD",8925.1,8925.1,1.01,21,19,0) +information and associated text will be stored. Only files which include +"^DD",8925.1,8925.1,1.01,21,20,0) +the TIU Application Group may be selected. +"^DD",8925.1,8925.1,1.01,"DT") +2960729 +"^DD",8925.1,8925.1,1.02,0) +LAYGO ALLOWED^S^0:NO;1:YES;^1;2^Q +"^DD",8925.1,8925.1,1.02,3) +Please indicate whether new entries may be added to the TARGET FILE. +"^DD",8925.1,8925.1,1.02,21,0) +^^2^2^2970128^ +"^DD",8925.1,8925.1,1.02,21,1,0) +This field indicates whether or not a new entry can be created in +"^DD",8925.1,8925.1,1.02,21,2,0) +the TARGET FILE for documents defined by this Document Definition. +"^DD",8925.1,8925.1,1.02,"DT") +2970128 +"^DD",8925.1,8925.1,1.03,0) +TARGET TEXT FIELD SUBSCRIPT^F^^1;3^K:$L(X)>15!($L(X)<1) X +"^DD",8925.1,8925.1,1.03,3) +Select the Word-processing field in the target file. +"^DD",8925.1,8925.1,1.03,21,0) +^^2^2^2970620^^ +"^DD",8925.1,8925.1,1.03,21,1,0) +This is the subscript of the word-processing field in the TARGET FILE, in +"^DD",8925.1,8925.1,1.03,21,2,0) +which the body of the narrative report will be stored. +"^DD",8925.1,8925.1,1.03,"DT") +2940331 +"^DD",8925.1,8925.1,1.04,0) +BOILERPLATE ON UPLOAD ENABLED^S^0:NO;1:YES;^1;4^Q +"^DD",8925.1,8925.1,1.04,3) +Indicate whether boilerplate logic will be executed on upload +"^DD",8925.1,8925.1,1.04,21,0) +^^2^2^2961210^ +"^DD",8925.1,8925.1,1.04,21,1,0) +This field determines whether the filer will attempt to execute +"^DD",8925.1,8925.1,1.04,21,2,0) +boilerplate logic for uploaded documents. Not used in version 1. +"^DD",8925.1,8925.1,1.04,"DT") +2951016 +"^DD",8925.1,8925.1,2,0) +UPLOAD CAPTIONED ASCII HEADER^8925.12A^^HEAD;0 +"^DD",8925.1,8925.1,2,21,0) +^^11^11^2970506^^ +"^DD",8925.1,8925.1,2,21,1,0) +This multiple contains the upload record header format of the Document +"^DD",8925.1,8925.1,2,21,2,0) +Definition, to be used by the upload/router/filer when the preferred +"^DD",8925.1,8925.1,2,21,3,0) +header format is captioned (as opposed to delimited string). +"^DD",8925.1,8925.1,2,21,4,0) + +"^DD",8925.1,8925.1,2,21,5,0) +Under captioned header format, header items are distinguished from each +"^DD",8925.1,8925.1,2,21,6,0) +other by captions such as SSN which are entered by the transcriber, +"^DD",8925.1,8925.1,2,21,7,0) +followed by the data. +"^DD",8925.1,8925.1,2,21,8,0) + +"^DD",8925.1,8925.1,2,21,9,0) +Use the captioned header format if documents are transcribed by a human +"^DD",8925.1,8925.1,2,21,10,0) +transcriber. Delimited format is useful only if the site has some way of +"^DD",8925.1,8925.1,2,21,11,0) +automatically generating upload record headers. +"^DD",8925.1,8925.1,2,"DT") +2960729 +"^DD",8925.1,8925.1,3,0) +BOILERPLATE TEXT^8925.13^^DFLT;0 +"^DD",8925.1,8925.1,3,"DT") +2950421 +"^DD",8925.1,8925.1,3.02,0) +OK TO DISTRIBUTE^S^1:YES;0:NO;^3;2^Q +"^DD",8925.1,8925.1,3.02,3) +Enter 1 for YES if entry should be included when this file is exported with data. Enter 0 for NO or leave blank if entry is for local use only. +"^DD",8925.1,8925.1,3.02,21,0) +^^13^13^2970224^^ +"^DD",8925.1,8925.1,3.02,21,1,0) +Presently applies only to National Programmers; does not appear on +"^DD",8925.1,8925.1,3.02,21,2,0) +Manager or Clinician Menus. +"^DD",8925.1,8925.1,3.02,21,3,0) + +"^DD",8925.1,8925.1,3.02,21,4,0) +If field is 1 for YES, then entry should be included for export. If field +"^DD",8925.1,8925.1,3.02,21,5,0) +has no value or has value 0, entry should not be included for export. +"^DD",8925.1,8925.1,3.02,21,6,0) + +"^DD",8925.1,8925.1,3.02,21,7,0) +Since TIU is hierarchical, the entry's behavior depends on entries above +"^DD",8925.1,8925.1,3.02,21,8,0) +it in the hierarchy. It is the responsibility of the exporter to make +"^DD",8925.1,8925.1,3.02,21,9,0) +sure all ancestors which are necessary for the proper behavior of an +"^DD",8925.1,8925.1,3.02,21,10,0) +exported entry are also exported with it (or are already present at sites +"^DD",8925.1,8925.1,3.02,21,11,0) +receiving the exported entries). +"^DD",8925.1,8925.1,3.02,21,12,0) + +"^DD",8925.1,8925.1,3.02,21,13,0) +Field is NOT heritable. BASIC field. +"^DD",8925.1,8925.1,3.02,"DT") +2970128 +"^DD",8925.1,8925.1,3.03,0) +SUPPRESS VISIT SELECTION^S^1:YES;0:NO;^3;3^Q +"^DD",8925.1,8925.1,3.03,3) +Enter 1 for YES ONLY IF this is an administrative note which creates its own historical visit. You will NOT receive workload credit for such visits. +"^DD",8925.1,8925.1,3.03,21,0) +^^17^17^2970220^ +"^DD",8925.1,8925.1,3.03,21,1,0) +Applies to entries of Type Class, Document Class, and Title. +"^DD",8925.1,8925.1,3.03,21,2,0) + +"^DD",8925.1,8925.1,3.03,21,3,0) +For most documents it is very important that the user entering a document +"^DD",8925.1,8925.1,3.03,21,4,0) +select the appropriate visit to link the document with. However, +"^DD",8925.1,8925.1,3.03,21,5,0) +certain administrative documents for outpatients have no particular visit +"^DD",8925.1,8925.1,3.03,21,6,0) +that they should be linked with. For example, a clinician could have a +"^DD",8925.1,8925.1,3.03,21,7,0) +chance encounter with a patient in the corridor and want to document the +"^DD",8925.1,8925.1,3.03,21,8,0) +discussion, or a clinician could simply want to remind him/herself of +"^DD",8925.1,8925.1,3.03,21,9,0) +something for a given patient. Documents for such purposes can be set to +"^DD",8925.1,8925.1,3.03,21,10,0) +automatically create their own historical visit when they are entered, so +"^DD",8925.1,8925.1,3.03,21,11,0) +that the user is not asked to select a visit. +"^DD",8925.1,8925.1,3.03,21,12,0) + +"^DD",8925.1,8925.1,3.03,21,13,0) +Warning: Such documents DO NOT GIVE WORKLOAD CREDIT. +"^DD",8925.1,8925.1,3.03,21,14,0) + +"^DD",8925.1,8925.1,3.03,21,15,0) +Heritable. BASIC field. If field has no value and there is no value +"^DD",8925.1,8925.1,3.03,21,16,0) +to inherit, default value is NO. For information on editing heritable +"^DD",8925.1,8925.1,3.03,21,17,0) +fields, see Technical Field Edit Template. +"^DD",8925.1,8925.1,3.03,"DT") +2970124 +"^DD",8925.1,8925.1,4,0) +UPLOAD LOOK-UP METHOD^K^^4;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4,3) +Please enter the MUMPS code to be executed for record location. +"^DD",8925.1,8925.1,4,9) +@ +"^DD",8925.1,8925.1,4,21,0) +^^12^12^2970107^^ +"^DD",8925.1,8925.1,4,21,1,0) +Sometimes when an entry is uploaded into the target file, a new entry is +"^DD",8925.1,8925.1,4,21,2,0) +created for it. However, in other cases such as for Operative Reports, or +"^DD",8925.1,8925.1,4,21,3,0) +for an addendum, the file entry already exists and must be looked-up and +"^DD",8925.1,8925.1,4,21,4,0) +edited. +"^DD",8925.1,8925.1,4,21,5,0) + +"^DD",8925.1,8925.1,4,21,6,0) +Look-Up Method is the MUMPS code invoked to perform such a look-up on the +"^DD",8925.1,8925.1,4,21,7,0) +target file. If a look-up is necessary and this field is blank, a regular +"^DD",8925.1,8925.1,4,21,8,0) +DIC lookup is performed. If the regular DIC lookup is not sufficient to +"^DD",8925.1,8925.1,4,21,9,0) +locate the appropriate entry, this field should contain the lookup. It +"^DD",8925.1,8925.1,4,21,10,0) +should expect any look-up special variables named in the header fields as +"^DD",8925.1,8925.1,4,21,11,0) +input variables, and should return the variable Y in DIC-compatible format +"^DD",8925.1,8925.1,4,21,12,0) +(i.e., IEN^EXTERNAL VALUE[^1]). +"^DD",8925.1,8925.1,4,"DT") +2960729 +"^DD",8925.1,8925.1,4.1,0) +COMMIT ACTION^K^^4.1;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.1,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.1,9) +@ +"^DD",8925.1,8925.1,4.1,21,0) +^^3^3^2980122^ +"^DD",8925.1,8925.1,4.1,21,1,0) +This M-Code is executed when the TIU document is "committed" to the +"^DD",8925.1,8925.1,4.1,21,2,0) +database (i.e., when the document is saved, and prior to release, +"^DD",8925.1,8925.1,4.1,21,3,0) +verification, or signature). Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,4.1,"DT") +2971126 +"^DD",8925.1,8925.1,4.2,0) +RELEASE ACTION^K^^4.2;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.2,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.2,9) +@ +"^DD",8925.1,8925.1,4.2,21,0) +^^2^2^2980126^^ +"^DD",8925.1,8925.1,4.2,21,1,0) +This M-Code is executed upon Release of the document. Heritable. +"^DD",8925.1,8925.1,4.2,21,2,0) +TECHNICAL field. +"^DD",8925.1,8925.1,4.2,"DT") +2971126 +"^DD",8925.1,8925.1,4.3,0) +VERIFICATION ACTION^K^^4.3;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.3,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.3,9) +@ +"^DD",8925.1,8925.1,4.3,21,0) +^^2^2^2980122^ +"^DD",8925.1,8925.1,4.3,21,1,0) +This M-Code is executed upon Verification of the document. Heritable. +"^DD",8925.1,8925.1,4.3,21,2,0) +TECHNICAL field. +"^DD",8925.1,8925.1,4.3,"DT") +2971126 +"^DD",8925.1,8925.1,4.4,0) +DELETE ACTION^K^^4.4;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.4,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.4,9) +@ +"^DD",8925.1,8925.1,4.4,21,0) +^^2^2^2980122^ +"^DD",8925.1,8925.1,4.4,21,1,0) +This M-Code is executed upon Deletion of the document. Heritable. +"^DD",8925.1,8925.1,4.4,21,2,0) +TECHNICAL field. +"^DD",8925.1,8925.1,4.4,"DT") +2971126 +"^DD",8925.1,8925.1,4.45,0) +PACKAGE REASSIGNMENT ACTION^K^^4.45;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.45,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.45,9) +@ +"^DD",8925.1,8925.1,4.45,21,0) +^^2^2^2980122^ +"^DD",8925.1,8925.1,4.45,21,1,0) +This M-Code is executed when a document with a link to a client +"^DD",8925.1,8925.1,4.45,21,2,0) +application is Reassigned. Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,4.45,"DT") +2971202 +"^DD",8925.1,8925.1,4.5,0) +UPLOAD POST-FILING CODE^K^^4.5;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.5,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.5,9) +@ +"^DD",8925.1,8925.1,4.5,21,0) +^^4^4^2970522^ +"^DD",8925.1,8925.1,4.5,21,1,0) +This field specifies code to be executed following the successful filing +"^DD",8925.1,8925.1,4.5,21,2,0) +of an uploaded record. It may be used to send bulletins or alerts, +"^DD",8925.1,8925.1,4.5,21,3,0) +evaluate expected signers/cosigners, trigger events, update statuses, or +"^DD",8925.1,8925.1,4.5,21,4,0) +whatever the designer of the application deems appropriate. +"^DD",8925.1,8925.1,4.5,"DT") +2960729 +"^DD",8925.1,8925.1,4.6,0) +ENTRY ACTION^KX^^4.6;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.6,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.6,9) +@ +"^DD",8925.1,8925.1,4.6,21,0) +^^3^3^2980126^^ +"^DD",8925.1,8925.1,4.6,21,1,0) +This M-Code is executed during the Entry/Editing of a document, after +"^DD",8925.1,8925.1,4.6,21,2,0) +selection of the Title, and prior to selection of the Patient. It may be +"^DD",8925.1,8925.1,4.6,21,3,0) +used to set up environmental variables, etc. Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,4.6,"DT") +2961022 +"^DD",8925.1,8925.1,4.7,0) +EXIT ACTION^KX^^4.7;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.7,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.7,9) +@ +"^DD",8925.1,8925.1,4.7,21,0) +^^3^3^2980126^^ +"^DD",8925.1,8925.1,4.7,21,1,0) +This M-Code is executed just prior to Exit from the entry/edit process +"^DD",8925.1,8925.1,4.7,21,2,0) +for a document. It may be used to send alerts or bulletins, clean up +"^DD",8925.1,8925.1,4.7,21,3,0) +temporary global variables, etc. Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,4.7,"DT") +2961022 +"^DD",8925.1,8925.1,4.8,0) +UPLOAD FILING ERROR CODE^K^^4.8;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.8,.1) +UPLOAD FILING ERROR RESOLUTION CODE +"^DD",8925.1,8925.1,4.8,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.8,9) +@ +"^DD",8925.1,8925.1,4.8,21,0) +^^6^6^2970106^ +"^DD",8925.1,8925.1,4.8,21,1,0) +This MUMPS-type field specifies the code to be executed when the user +"^DD",8925.1,8925.1,4.8,21,2,0) +attempts to resolve a filing error. Filing Errors may be resolved either +"^DD",8925.1,8925.1,4.8,21,3,0) +by responding to a Filing Error Alert or through the option to Review +"^DD",8925.1,8925.1,4.8,21,4,0) +Upload Events. Typically, the code will offer the user an opportunity to +"^DD",8925.1,8925.1,4.8,21,5,0) +look up online information necessary to resolve the error (e.g., +"^DD",8925.1,8925.1,4.8,21,6,0) +demographic, or case-related information). +"^DD",8925.1,8925.1,4.8,"DT") +2960729 +"^DD",8925.1,8925.1,4.9,0) +POST-SIGNATURE CODE^K^^4.9;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,4.9,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,4.9,9) +@ +"^DD",8925.1,8925.1,4.9,21,0) +^^2^2^2980126^^ +"^DD",8925.1,8925.1,4.9,21,1,0) +This M-Code is executed following Signature (or Cosignature) of a TIU +"^DD",8925.1,8925.1,4.9,21,2,0) +document. Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,4.9,"DT") +2971001 +"^DD",8925.1,8925.1,5,0) +EDIT TEMPLATE^FX^^5;E1,245^K:$L(X)>60!($L(X)<2) X +"^DD",8925.1,8925.1,5,3) +Enter the name of the Input Template for documents defined by this entry. +"^DD",8925.1,8925.1,5,4) +D HELP1^TIUFXHLX(5) +"^DD",8925.1,8925.1,5,9) +@ +"^DD",8925.1,8925.1,5,21,0) +^^19^19^2980126^^ +"^DD",8925.1,8925.1,5,21,1,0) +Applies to Classes, Document Classes, Titles. This is the Input Template +"^DD",8925.1,8925.1,5,21,2,0) +for Entering/Editing documents defined by this entry. Template +"^DD",8925.1,8925.1,5,21,3,0) +includes fixed field information such as Patient, etc. Enter Edit +"^DD",8925.1,8925.1,5,21,4,0) +Template in Format [TEMPLATE NAME], or as a "field-string" (e.g., +"^DD",8925.1,8925.1,5,21,5,0) +.01;1;3;5). Heritable. TECHNICAL field. +"^DD",8925.1,8925.1,5,21,6,0) + +"^DD",8925.1,8925.1,5,21,7,0) +NOTE on editing heritable fields: +"^DD",8925.1,8925.1,5,21,8,0) + +"^DD",8925.1,8925.1,5,21,9,0) +When editing heritable fields, the user is presented with the EFFECTIVE +"^DD",8925.1,8925.1,5,21,10,0) +value of the field as the default (e.g. NO//). This is the same as the +"^DD",8925.1,8925.1,5,21,11,0) +value shown in the display and is the field's own value if it has one, the +"^DD",8925.1,8925.1,5,21,12,0) +inherited value if the field does not have its own value, or the default +"^DD",8925.1,8925.1,5,21,13,0) +for the field if the field has neither its own nor an inherited value. If +"^DD",8925.1,8925.1,5,21,14,0) +the user accepts this default by pressing return, the value is made +"^DD",8925.1,8925.1,5,21,15,0) +explicit, i.e., entered into the field. If a user does NOT want to make +"^DD",8925.1,8925.1,5,21,16,0) +the value explicit, the user should enter @, which leaves a blank field +"^DD",8925.1,8925.1,5,21,17,0) +blank. If the user want to delete an explicit value, the user should +"^DD",8925.1,8925.1,5,21,18,0) +enter @, which deletes the field value, leaving TIU to use the effective +"^DD",8925.1,8925.1,5,21,19,0) +value for the field. +"^DD",8925.1,8925.1,5,"DT") +2961022 +"^DD",8925.1,8925.1,6,0) +PRINT METHOD^KX^^6;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,6,3) +Please enter the MUMPS code to be executed to print a record. +"^DD",8925.1,8925.1,6,4) +D HELP1^TIUFXHLX(6) +"^DD",8925.1,8925.1,6,9) +@ +"^DD",8925.1,8925.1,6,21,0) +^^5^5^2980126^^ +"^DD",8925.1,8925.1,6,21,1,0) +Applies to Types Class, Document Class, Title. This M-Code is executed +"^DD",8925.1,8925.1,6,21,2,0) +when a document is Printed from the TIU List Manager screen (as opposed to +"^DD",8925.1,8925.1,6,21,3,0) +a separate print option which may have its own code.) Heritable. TECHNICAL +"^DD",8925.1,8925.1,6,21,4,0) +field. For more information on editing heritable fields, see Technical +"^DD",8925.1,8925.1,6,21,5,0) +field Edit Template. +"^DD",8925.1,8925.1,6,"DT") +2961022 +"^DD",8925.1,8925.1,6.1,0) +PRINT FORM HEADER^FX^^6.1;1^K:$L(X)>40!($L(X)<3) X +"^DD",8925.1,8925.1,6.1,3) +Answer must be 3-40 characters in length. +"^DD",8925.1,8925.1,6.1,4) +D HELP1^TIUFXHLX(6.1) +"^DD",8925.1,8925.1,6.1,21,0) +^^12^12^2970108^^ +"^DD",8925.1,8925.1,6.1,21,1,0) +For basic information on Print Form Header see Technical field Allow +"^DD",8925.1,8925.1,6.1,21,2,0) +Custom Form Headers. +"^DD",8925.1,8925.1,6.1,21,3,0) + +"^DD",8925.1,8925.1,6.1,21,4,0) +The Print Form Header is the official medical record title of the document +"^DD",8925.1,8925.1,6.1,21,5,0) +which has been approved by the Medical Record Committee based on national +"^DD",8925.1,8925.1,6.1,21,6,0) +guidelines. +"^DD",8925.1,8925.1,6.1,21,7,0) + +"^DD",8925.1,8925.1,6.1,21,8,0) +Examples: Progress Notes, Physical Examination, History - Part 1, etc. +"^DD",8925.1,8925.1,6.1,21,9,0) + +"^DD",8925.1,8925.1,6.1,21,10,0) +This field is heritable with lower level values overriding higher ones AS +"^DD",8925.1,8925.1,6.1,21,11,0) +LONG AS the field is applicable. See Allow Custom Form Headers. Print +"^DD",8925.1,8925.1,6.1,21,12,0) +Form Header is a TECHNICAL field. +"^DD",8925.1,8925.1,6.1,23,0) +^^6^6^2970108^^^^ +"^DD",8925.1,8925.1,6.1,23,1,0) +The narrative stored in this field will display as the form header of a +"^DD",8925.1,8925.1,6.1,23,2,0) +document. If entered at a CLASS level such as FORMS, all forms documents +"^DD",8925.1,8925.1,6.1,23,3,0) +will display entered header as the form header of the document. If +"^DD",8925.1,8925.1,6.1,23,4,0) +the free text is entered at a lower level (i.e., TITLE), this form header +"^DD",8925.1,8925.1,6.1,23,5,0) +will override the one entered at the higher level and will be displayed on +"^DD",8925.1,8925.1,6.1,23,6,0) +the form. +"^DD",8925.1,8925.1,6.1,"DT") +2961022 +"^DD",8925.1,8925.1,6.12,0) +PRINT FORM NUMBER^FX^^6.1;2^K:$L(X)>20!($L(X)<3) X +"^DD",8925.1,8925.1,6.12,3) +Answer must be 3-20 characters in length. +"^DD",8925.1,8925.1,6.12,4) +D HELP1^TIUFXHLX(6.12) +"^DD",8925.1,8925.1,6.12,21,0) +^^13^13^2970106^ +"^DD",8925.1,8925.1,6.12,21,1,0) +For basic information on Print Form Number see Technical field Allow +"^DD",8925.1,8925.1,6.12,21,2,0) +Custom Form Headers. +"^DD",8925.1,8925.1,6.12,21,3,0) + +"^DD",8925.1,8925.1,6.12,21,4,0) +The Print Form Number is the official medical record form number of the +"^DD",8925.1,8925.1,6.12,21,5,0) +document which has been approved by the Medical Record Committee based +"^DD",8925.1,8925.1,6.12,21,6,0) +on national guidelines. +"^DD",8925.1,8925.1,6.12,21,7,0) + +"^DD",8925.1,8925.1,6.12,21,8,0) +Example: Progress Note - Vice SF 509, Consult - SF 513, Physicial +"^DD",8925.1,8925.1,6.12,21,9,0) +Examination - SF 506. +"^DD",8925.1,8925.1,6.12,21,10,0) + +"^DD",8925.1,8925.1,6.12,21,11,0) +Field is heritable with lower level values overriding higher ones AS LONG +"^DD",8925.1,8925.1,6.12,21,12,0) +AS the field is applicable. See field Allow Custom Form Headers. Print +"^DD",8925.1,8925.1,6.12,21,13,0) +Form Header is a TECHNICAL field. +"^DD",8925.1,8925.1,6.12,23,0) +^^6^6^2970106^^^^ +"^DD",8925.1,8925.1,6.12,23,1,0) +The free text stored in this field will be displayed as the form number of +"^DD",8925.1,8925.1,6.12,23,2,0) +a document. If entered at a CLASS level such as Forms, all Forms +"^DD",8925.1,8925.1,6.12,23,3,0) +documents will display the entered value as the form number of the +"^DD",8925.1,8925.1,6.12,23,4,0) +document. If the free text is entered at a lower level (i.e., TITLE), +"^DD",8925.1,8925.1,6.12,23,5,0) +this value will override the one entered at the higher level and will be +"^DD",8925.1,8925.1,6.12,23,6,0) +displayed on the form. +"^DD",8925.1,8925.1,6.12,"DT") +2961022 +"^DD",8925.1,8925.1,6.13,0) +PRINT GROUP^NJ2,0X^^6.1;3^K:+X'=X!(X>10)!(X<1)!(X?.E1"."1N.N) X +"^DD",8925.1,8925.1,6.13,3) +Type a Number between 1 and 10, 0 Decimal Digits. Enter ?? for help. +"^DD",8925.1,8925.1,6.13,4) +D HELP1^TIUFXHLX(6.13) +"^DD",8925.1,8925.1,6.13,21,0) +^^19^19^2970106^ +"^DD",8925.1,8925.1,6.13,21,1,0) +For basic information on Print Group see Technical field Allow Custom Form +"^DD",8925.1,8925.1,6.13,21,2,0) +Headers. +"^DD",8925.1,8925.1,6.13,21,3,0) + +"^DD",8925.1,8925.1,6.13,21,4,0) +Print Group is an integer number which serves to group by print form +"^DD",8925.1,8925.1,6.13,21,5,0) +headers/numbers related documents that share a common print method; e.g., +"^DD",8925.1,8925.1,6.13,21,6,0) +Progress Notes, H&P's, and other documents may share a common print +"^DD",8925.1,8925.1,6.13,21,7,0) +method, but have differing form headers/numbers and should each print in +"^DD",8925.1,8925.1,6.13,21,8,0) +their own, separate collation. Specifying a common print group for +"^DD",8925.1,8925.1,6.13,21,9,0) +documents with the same headers/numbers (for example, Progress Notes have +"^DD",8925.1,8925.1,6.13,21,10,0) +Print Group 2, H&P's might have Print Group 7) causes such documents +"^DD",8925.1,8925.1,6.13,21,11,0) +from each print group to collate together when a mixed print is called +"^DD",8925.1,8925.1,6.13,21,12,0) +for. +"^DD",8925.1,8925.1,6.13,21,13,0) + +"^DD",8925.1,8925.1,6.13,21,14,0) +Since documents collate first by print method, then by print group, print +"^DD",8925.1,8925.1,6.13,21,15,0) +group is not necessary unless documents share a common print method. +"^DD",8925.1,8925.1,6.13,21,16,0) + +"^DD",8925.1,8925.1,6.13,21,17,0) +Print Group is heritable with lower level values overriding higher ones AS +"^DD",8925.1,8925.1,6.13,21,18,0) +LONG AS the field is applicable. See Allow Custom Form Headers. Print +"^DD",8925.1,8925.1,6.13,21,19,0) +Group is a TECHNICAL field. +"^DD",8925.1,8925.1,6.13,"DT") +2961022 +"^DD",8925.1,8925.1,6.14,0) +ALLOW CUSTOM FORM HEADERS^SX^1:YES;0:NO;^6.1;4^Q +"^DD",8925.1,8925.1,6.14,.1) +ALLOW CUSTOM FORM HEADERS/NUMBERS AT LOWER LEVELS +"^DD",8925.1,8925.1,6.14,3) +May be set for Types CL and DC only. Enter 1 for YES if descendent Titles can have individual (Custom) Form Headers/Numbers within their Document Class. Otherwise enter 0. +"^DD",8925.1,8925.1,6.14,4) +D CUSTOM^TIUFXHLX +"^DD",8925.1,8925.1,6.14,21,0) +^^69^69^2980122^ +"^DD",8925.1,8925.1,6.14,21,1,0) +Allow Custom Form Headers may be set for entries of Type Class or Document +"^DD",8925.1,8925.1,6.14,21,2,0) +Class and affects DESCENDANTS of the entry for which it is set. +"^DD",8925.1,8925.1,6.14,21,3,0) + +"^DD",8925.1,8925.1,6.14,21,4,0) +Information on Form Headers, Form Numbers, Print Group, and Allow Custom +"^DD",8925.1,8925.1,6.14,21,5,0) +Form Headers: +"^DD",8925.1,8925.1,6.14,21,6,0) + +"^DD",8925.1,8925.1,6.14,21,7,0) +Some clinical documents use Forms with Form Headers and Form Numbers, for +"^DD",8925.1,8925.1,6.14,21,8,0) +example, Progress Note Forms have Header 'Progress Notes' and Number 'Vice +"^DD",8925.1,8925.1,6.14,21,9,0) +SF 509.' +"^DD",8925.1,8925.1,6.14,21,10,0) + +"^DD",8925.1,8925.1,6.14,21,11,0) +The Owner of a Document Definition must decide whether all documents +"^DD",8925.1,8925.1,6.14,21,12,0) +descending from the entry will have the SAME Header/Number, or whether to +"^DD",8925.1,8925.1,6.14,21,13,0) +allow CUSTOM (varying) Headers/Numbers at lower levels. +"^DD",8925.1,8925.1,6.14,21,14,0) + +"^DD",8925.1,8925.1,6.14,21,15,0) +Allow Custom Headers holds the decision: If the field has value 0 for NO, +"^DD",8925.1,8925.1,6.14,21,16,0) +then ALL descendant documents use a COMMON Header/Number (or perhaps they +"^DD",8925.1,8925.1,6.14,21,17,0) +all use NO Header/Number); they also collate together in printouts. +"^DD",8925.1,8925.1,6.14,21,18,0) + +"^DD",8925.1,8925.1,6.14,21,19,0) +For example, Class Progress Notes does NOT Allow Custom Form Headers. This +"^DD",8925.1,8925.1,6.14,21,20,0) +means that ALL Progress Note Titles have the same header and the same form +"^DD",8925.1,8925.1,6.14,21,21,0) +number. For Class Progress Notes, Field Print Form Header holds the +"^DD",8925.1,8925.1,6.14,21,22,0) +header 'Progress Notes', Field Print Form Number holds Form Number 'Vice +"^DD",8925.1,8925.1,6.14,21,23,0) +SF 509', and Field Print Group holds '2'. Since Class Progress Notes does +"^DD",8925.1,8925.1,6.14,21,24,0) +not Allow Custom Form Headers, these field values apply for ALL Progress +"^DD",8925.1,8925.1,6.14,21,25,0) +Note Titles. That is, all Progress Notes have header 'Progress Notes', +"^DD",8925.1,8925.1,6.14,21,26,0) +Form Number 'Vice SF 509', and collate together in printouts. +"^DD",8925.1,8925.1,6.14,21,27,0) + +"^DD",8925.1,8925.1,6.14,21,28,0) +Field Allow Custom Field Headers also determines whether or not related +"^DD",8925.1,8925.1,6.14,21,29,0) +Fields Print Form Header, Print Form Number, Print Group, (and even Allow +"^DD",8925.1,8925.1,6.14,21,30,0) +Custom Field Headers) are applicable at lower levels. If an entry at a +"^DD",8925.1,8925.1,6.14,21,31,0) +particular level DOES allow Custom Form Headers, then these related fields +"^DD",8925.1,8925.1,6.14,21,32,0) +DO APPLY to descendants at the next lower level. If an entry at a +"^DD",8925.1,8925.1,6.14,21,33,0) +particular level DOES NOT allow Custom Form Headers, then ALL LOWER LEVELS +"^DD",8925.1,8925.1,6.14,21,34,0) +inherit the the prohibition, and the related fields DO NOT APPLY at ANY +"^DD",8925.1,8925.1,6.14,21,35,0) +lower levels. +"^DD",8925.1,8925.1,6.14,21,36,0) + +"^DD",8925.1,8925.1,6.14,21,37,0) +Example: Since Class Progress Notes does NOT Allow Custom Form Headers, +"^DD",8925.1,8925.1,6.14,21,38,0) +fields Print Form Header, Print Form Number, Print Group, and Allow Custom +"^DD",8925.1,8925.1,6.14,21,39,0) +Field Headers DO NOT APPLY to Document Classes or Titles under Progress +"^DD",8925.1,8925.1,6.14,21,40,0) +Notes. This means that Document Definitions for documents requiring +"^DD",8925.1,8925.1,6.14,21,41,0) +different Form Headers/Numbers must be placed under a separate line of +"^DD",8925.1,8925.1,6.14,21,42,0) +descent in the hierarchy; they cannot be under Progress Notes. +"^DD",8925.1,8925.1,6.14,21,43,0) + +"^DD",8925.1,8925.1,6.14,21,44,0) +Example: Class Clinical Documents, the Mother of all Document Definitions, +"^DD",8925.1,8925.1,6.14,21,45,0) +does not want to REQUIRE all Document Definitions under it to use one +"^DD",8925.1,8925.1,6.14,21,46,0) +common Header. So Clinical Documents DOES Allow Custom Form Headers. +"^DD",8925.1,8925.1,6.14,21,47,0) +Classes/Document Classes UNDER CLinical Documents can decide for +"^DD",8925.1,8925.1,6.14,21,48,0) +themselves whether or not to Allow Custom Headers for their own Items. +"^DD",8925.1,8925.1,6.14,21,49,0) + +"^DD",8925.1,8925.1,6.14,21,50,0) +Example: Class DISCHARGE SUMMARY has only one Form Header and Number which +"^DD",8925.1,8925.1,6.14,21,51,0) +is used by all Discharge Summary documents. So Class Discharge Summary +"^DD",8925.1,8925.1,6.14,21,52,0) +does NOT Allow Custom Headers. +"^DD",8925.1,8925.1,6.14,21,53,0) + +"^DD",8925.1,8925.1,6.14,21,54,0) +Example: Class FORMS might contain miscellaneous documents, each using +"^DD",8925.1,8925.1,6.14,21,55,0) +a different Form with its own Form Header and Form Number. So Class Forms +"^DD",8925.1,8925.1,6.14,21,56,0) +would Allow Custom Headers. +"^DD",8925.1,8925.1,6.14,21,57,0) + +"^DD",8925.1,8925.1,6.14,21,58,0) +Field Allow Custom Form Headers may be set for Document Definitions of +"^DD",8925.1,8925.1,6.14,21,59,0) +Type Class or Document Class only, and affects the DESCENDANTS of the +"^DD",8925.1,8925.1,6.14,21,60,0) +entry for which it is set. +"^DD",8925.1,8925.1,6.14,21,61,0) + +"^DD",8925.1,8925.1,6.14,21,62,0) +If a DOCUMENT CLASS Allows Custom Form Headers, then TIUF, the Document +"^DD",8925.1,8925.1,6.14,21,63,0) +Definition Utility, does not permit a descendant Title to be activated +"^DD",8925.1,8925.1,6.14,21,64,0) +unless fields Print Form Header, Print Form Number, and Print Group have a +"^DD",8925.1,8925.1,6.14,21,65,0) +value (of their own or inherited). If NO Header, or Number is desired, +"^DD",8925.1,8925.1,6.14,21,66,0) +enter 'NONE'. If NO Print Group is desired, enter '0'. +"^DD",8925.1,8925.1,6.14,21,67,0) + +"^DD",8925.1,8925.1,6.14,21,68,0) +For information on editing heritable fields, see Technical field Edit +"^DD",8925.1,8925.1,6.14,21,69,0) +Template. +"^DD",8925.1,8925.1,6.14,"DT") +2970128 +"^DD",8925.1,8925.1,7,0) +VISIT LINKAGE METHOD^KX^^7;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,7,3) +Please enter the MUMPS code to be executed to establish Visit Linkage. +"^DD",8925.1,8925.1,7,4) +D HELP1^TIUFXHLX(7) +"^DD",8925.1,8925.1,7,9) +@ +"^DD",8925.1,8925.1,7,21,0) +^^6^6^2980122^ +"^DD",8925.1,8925.1,7,21,1,0) +Applies to Types Class, Document Class, Title. This M-Code is executed to +"^DD",8925.1,8925.1,7,21,2,0) +establish Visit Linkage, usually displaying appropriate visits and +"^DD",8925.1,8925.1,7,21,3,0) +prompting the user to select the correct one. +"^DD",8925.1,8925.1,7,21,4,0) + +"^DD",8925.1,8925.1,7,21,5,0) +Heritable. TECHNICAL Field. For information on editing heritable fields, +"^DD",8925.1,8925.1,7,21,6,0) +see Technical Field Edit Template. +"^DD",8925.1,8925.1,7,"DT") +2961022 +"^DD",8925.1,8925.1,8,0) +VALIDATION METHOD^KX^^8;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,8,3) +Please enter the MUMPS code to be executed to validate the selection of patient and Visit/Admission. +"^DD",8925.1,8925.1,8,4) +D HELP1^TIUFXHLX(8) +"^DD",8925.1,8925.1,8,9) +@ +"^DD",8925.1,8925.1,8,21,0) +^^7^7^2980126^^ +"^DD",8925.1,8925.1,8,21,1,0) +Applies to Types Class, Document Class, Title. This is the M-Code to be +"^DD",8925.1,8925.1,8,21,2,0) +invoked when Validating the visit and other fixed field information on a +"^DD",8925.1,8925.1,8,21,3,0) +record during entry/edit. User is asked to OK or to correct the +"^DD",8925.1,8925.1,8,21,4,0) +information. +"^DD",8925.1,8925.1,8,21,5,0) + +"^DD",8925.1,8925.1,8,21,6,0) +Heritable. TECHNICAL field. For information on editing heritable fields, +"^DD",8925.1,8925.1,8,21,7,0) +see Technical field Edit Template. +"^DD",8925.1,8925.1,8,"DT") +2961022 +"^DD",8925.1,8925.1,9,0) +OBJECT METHOD^KX^^9;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.1,9,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.1,9,9) +@ +"^DD",8925.1,8925.1,9,21,0) +^^3^3^2980122^ +"^DD",8925.1,8925.1,9,21,1,0) +Applies to Objects. This M-Code is invoked when a document is entered +"^DD",8925.1,8925.1,9,21,2,0) +whose boilerplate text contains the object. Extracted data are inserted +"^DD",8925.1,8925.1,9,21,3,0) +into document text. Author then edits/adds to text. TECHNICAL field. +"^DD",8925.1,8925.1,9,"DT") +2961022 +"^DD",8925.1,8925.1,10,0) +ITEM^8925.14P^^10;0 +"^DD",8925.1,8925.1,11,0) +STAT AUTO PRINT EVENT^8925.111SA^^11;0 +"^DD",8925.1,8925.1,11,21,0) +^^35^35^2970220^ +"^DD",8925.1,8925.1,11,21,1,0) +This parameter applies only to stat documents. +"^DD",8925.1,8925.1,11,21,2,0) + +"^DD",8925.1,8925.1,11,21,3,0) +This parameter determines at what stage(s) a document should be +"^DD",8925.1,8925.1,11,21,4,0) +automatically printed for chart, either singly when document is ready, or +"^DD",8925.1,8925.1,11,21,5,0) +in batch mode. +"^DD",8925.1,8925.1,11,21,6,0) + +"^DD",8925.1,8925.1,11,21,7,0) +Some documents will need to be printed for chart only when they are +"^DD",8925.1,8925.1,11,21,8,0) +complete, ie have obtained all expected signatures and cosignatures. +"^DD",8925.1,8925.1,11,21,9,0) +Others should perhaps be printed for chart at an earlier stage, allowing +"^DD",8925.1,8925.1,11,21,10,0) +earlier chart access, and then be reprinted when complete. Documents may +"^DD",8925.1,8925.1,11,21,11,0) +also need to be reprinted AFTER completion for certain events such as +"^DD",8925.1,8925.1,11,21,12,0) +amendment. +"^DD",8925.1,8925.1,11,21,13,0) + +"^DD",8925.1,8925.1,11,21,14,0) +Any event which should trigger auto printing of the document should be +"^DD",8925.1,8925.1,11,21,15,0) +entered as an auto print event. +"^DD",8925.1,8925.1,11,21,16,0) + +"^DD",8925.1,8925.1,11,21,17,0) +- SIGNED means firstline signature, as opposed to secondline cosignature. +"^DD",8925.1,8925.1,11,21,18,0) +- COSIGNED, OPTIONAL, INCOMPLETE means when an incomplete document obtains +"^DD",8925.1,8925.1,11,21,19,0) +an optional cosignature. +"^DD",8925.1,8925.1,11,21,20,0) +- COSIGNED, OPTIONAL, COMPLETED means when a previously completed +"^DD",8925.1,8925.1,11,21,21,0) +document obtains an optional cosignature, namely, a walkup. +"^DD",8925.1,8925.1,11,21,22,0) +- COMPLETED means when some event occurs that completes the document, for +"^DD",8925.1,8925.1,11,21,23,0) +example the document obtains its last expected optional cosignature. +"^DD",8925.1,8925.1,11,21,24,0) + +"^DD",8925.1,8925.1,11,21,25,0) +If one event occurs to a document and corresponds to two selected print +"^DD",8925.1,8925.1,11,21,26,0) +events (such as COMPLETED and COSIGNED OPTIONAL INCOMPLETE), the document +"^DD",8925.1,8925.1,11,21,27,0) +will only print once. +"^DD",8925.1,8925.1,11,21,28,0) + +"^DD",8925.1,8925.1,11,21,29,0) +If parameter is not entered and Document Definition has no ancestor to +"^DD",8925.1,8925.1,11,21,30,0) +inherit from, parameter assumes default value N for NONE. If parameter is +"^DD",8925.1,8925.1,11,21,31,0) +not entered and Document Definition has a parent to inherit from, then +"^DD",8925.1,8925.1,11,21,32,0) +parameter assumes value (assumed or explicit) of parent print events. If +"^DD",8925.1,8925.1,11,21,33,0) +parameter is non applicable because Document Definition does not allow +"^DD",8925.1,8925.1,11,21,34,0) +stat documents, or because Document Definition does not allow auto +"^DD",8925.1,8925.1,11,21,35,0) +printing, enter N for NONE. +"^DD",8925.1,8925.1,11,"DT") +2940621 +"^DD",8925.1,8925.1,12,0) +ROUTINE AUTO PRINT EVENT^8925.112SA^^12;0 +"^DD",8925.1,8925.1,12,21,0) +^^5^5^2970220^ +"^DD",8925.1,8925.1,12,21,1,0) +This parameter applies to routine (non-stat) documents only. Documents +"^DD",8925.1,8925.1,12,21,2,0) +whose Document Definitions do not allow stat documents are considered +"^DD",8925.1,8925.1,12,21,3,0) +routine. +"^DD",8925.1,8925.1,12,21,4,0) + +"^DD",8925.1,8925.1,12,21,5,0) +See parameter STAT AUTO PRINT EVENT for description. +"^DD",8925.1,8925.1,13,0) +PROCESSING STEPS^8925.113P^^13;0 +"^DD",8925.1,8925.1,13,21,0) +^^3^3^2950216^^ +"^DD",8925.1,8925.1,13,21,1,0) +This sub-file contains the optional and required steps for processing any +"^DD",8925.1,8925.1,13,21,2,0) +document, along with the states (e.g., unverified -> unsigned) that a given +"^DD",8925.1,8925.1,13,21,3,0) +step (e.g., verification) moves the document between. +"^DD",8925.1,8925.1,14,0) +DIALOG^8925.114^^DIALOG;0 +"^DD",8925.1,8925.1,14,21,0) +^^2^2^2950606^ +"^DD",8925.1,8925.1,14,21,1,0) +This sub-file contains the data necessary to handle server-based definition +"^DD",8925.1,8925.1,14,21,2,0) +for fixed-field data capture in TIU. +"^DD",8925.1,8925.1,99,0) +TIMESTAMP^F^^99;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>15!($L(X)<1) X +"^DD",8925.1,8925.1,99,1,0) +^.1 +"^DD",8925.1,8925.1,99,1,1,0) +8925.1^AM^MUMPS +"^DD",8925.1,8925.1,99,1,1,1) +D SET^TIUDD +"^DD",8925.1,8925.1,99,1,1,2) +D KILL^TIUDD +"^DD",8925.1,8925.1,99,1,1,"%D",0) +^^2^2^2950911^^^ +"^DD",8925.1,8925.1,99,1,1,"%D",1,0) +This cross-reference invokes menu compilation in ^XUTL("XQORM", +"^DD",8925.1,8925.1,99,1,1,"%D",2,0) +DA;TIU(8925.1, when the TIMESTAMP field is modified. +"^DD",8925.1,8925.1,99,1,1,"DT") +2940720 +"^DD",8925.1,8925.1,99,3) +Answer must be 1-15 characters in length. +"^DD",8925.1,8925.1,99,"DT") +2940720 +"^DD",8925.1,8925.11,0) +UPLOAD DELIMITED ASCII HEADER SUB-FIELD^^1^8 +"^DD",8925.1,8925.11,0,"DT") +2951004 +"^DD",8925.1,8925.11,0,"ID",.02) +W " ",$P(^(0),U,2) +"^DD",8925.1,8925.11,0,"IX","B",8925.11,.01) + +"^DD",8925.1,8925.11,0,"IX","C",8925.11,.02) + +"^DD",8925.1,8925.11,0,"IX","D",8925.11,.03) + +"^DD",8925.1,8925.11,0,"IX","E",8925.11,.04) + +"^DD",8925.1,8925.11,0,"NM","UPLOAD DELIMITED ASCII HEADER") + +"^DD",8925.1,8925.11,0,"UP") +8925.1 +"^DD",8925.1,8925.11,.01,0) +HEADER PIECE^MNJ2,0X^^0;1^K:+X'=X!(X>30)!(X<1)!(X?.E1"."1N.N) X S:$D(X) DINUM=X +"^DD",8925.1,8925.11,.01,1,0) +^.1 +"^DD",8925.1,8925.11,.01,1,1,0) +8925.11^B +"^DD",8925.1,8925.11,.01,1,1,1) +S ^TIU(8925.1,DA(1),"ITEM","B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.11,.01,1,1,2) +K ^TIU(8925.1,DA(1),"ITEM","B",$E(X,1,30),DA) +"^DD",8925.1,8925.11,.01,3) +Enter the delimiter-piece for the next header item. +"^DD",8925.1,8925.11,.01,21,0) +^^2^2^2970107^ +"^DD",8925.1,8925.11,.01,21,1,0) +This is the number for this piece (item) of the header. Start with +"^DD",8925.1,8925.11,.01,21,2,0) +number 1 for the first piece. +"^DD",8925.1,8925.11,.01,"DT") +2921021 +"^DD",8925.1,8925.11,.02,0) +ITEM NAME^F^^0;2^K:$L(X)>30!($L(X)<2) X +"^DD",8925.1,8925.11,.02,1,0) +^.1 +"^DD",8925.1,8925.11,.02,1,1,0) +8925.11^C +"^DD",8925.1,8925.11,.02,1,1,1) +S ^TIU(8925.1,DA(1),"ITEM","C",$E(X,1,30),DA)="" +"^DD",8925.1,8925.11,.02,1,1,2) +K ^TIU(8925.1,DA(1),"ITEM","C",$E(X,1,30),DA) +"^DD",8925.1,8925.11,.02,1,1,"%D",0) +^^2^2^2921021^ +"^DD",8925.1,8925.11,.02,1,1,"%D",1,0) +This REGULAR FileMan cross-reference on the ITEM NAME is used in the +"^DD",8925.1,8925.11,.02,1,1,"%D",2,0) +look-up and edit process. +"^DD",8925.1,8925.11,.02,1,1,"DT") +2920605 +"^DD",8925.1,8925.11,.02,3) +Enter the name of the header item. +"^DD",8925.1,8925.11,.02,21,0) +^^2^2^2970107^ +"^DD",8925.1,8925.11,.02,21,1,0) +This is the name of the item in the ASCII message header. Item Name is +"^DD",8925.1,8925.11,.02,21,2,0) +used in help messages for the person dictating a document. +"^DD",8925.1,8925.11,.02,"DT") +2921021 +"^DD",8925.1,8925.11,.03,0) +FIELD NUMBER^F^^0;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<1) X +"^DD",8925.1,8925.11,.03,1,0) +^.1 +"^DD",8925.1,8925.11,.03,1,1,0) +8925.11^D +"^DD",8925.1,8925.11,.03,1,1,1) +S ^TIU(8925.1,DA(1),"ITEM","D",$E(X,1,30),DA)="" +"^DD",8925.1,8925.11,.03,1,1,2) +K ^TIU(8925.1,DA(1),"ITEM","D",$E(X,1,30),DA) +"^DD",8925.1,8925.11,.03,1,1,"%D",0) +^^3^3^2921021^ +"^DD",8925.1,8925.11,.03,1,1,"%D",1,0) +This REGULAR FileMan cross-reference by field number is used by the +"^DD",8925.1,8925.11,.03,1,1,"%D",2,0) +filer/router to identify header-pieces with field numbers in the target +"^DD",8925.1,8925.11,.03,1,1,"%D",3,0) +file. +"^DD",8925.1,8925.11,.03,1,1,"DT") +2921021 +"^DD",8925.1,8925.11,.03,3) +Enter the FIELD # of the item in the target file. +"^DD",8925.1,8925.11,.03,21,0) +^^2^2^2970107^ +"^DD",8925.1,8925.11,.03,21,1,0) +This is the field number in the target file which corresponds to this +"^DD",8925.1,8925.11,.03,21,2,0) +header item. +"^DD",8925.1,8925.11,.03,"DT") +2921021 +"^DD",8925.1,8925.11,.04,0) +LOOKUP LOCAL VARIABLE NAME^F^^0;4^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>8!($L(X)<1)!'(X?1A1.7E) X +"^DD",8925.1,8925.11,.04,1,0) +^.1 +"^DD",8925.1,8925.11,.04,1,1,0) +8925.11^E +"^DD",8925.1,8925.11,.04,1,1,1) +S ^TIU(8925.1,DA(1),"ITEM","E",$E(X,1,30),DA)="" +"^DD",8925.1,8925.11,.04,1,1,2) +K ^TIU(8925.1,DA(1),"ITEM","E",$E(X,1,30),DA) +"^DD",8925.1,8925.11,.04,1,1,"%D",0) +^^3^3^2921109^ +"^DD",8925.1,8925.11,.04,1,1,"%D",1,0) +This cross-reference is used by the router/filer to determine which pieces +"^DD",8925.1,8925.11,.04,1,1,"%D",2,0) +of the header should be set into special variables which may be required by +"^DD",8925.1,8925.11,.04,1,1,"%D",3,0) +the lookup routine. +"^DD",8925.1,8925.11,.04,1,1,"DT") +2921109 +"^DD",8925.1,8925.11,.04,3) +Enter the required local variable into which this piece will be set. +"^DD",8925.1,8925.11,.04,21,0) +^^11^11^2970107^ +"^DD",8925.1,8925.11,.04,21,1,0) +This field specifies the local variable name into which this piece of the +"^DD",8925.1,8925.11,.04,21,2,0) +message header will be set. The local variable is used by the Look-Up +"^DD",8925.1,8925.11,.04,21,3,0) +Method. For example, if this piece of the header is the patient social +"^DD",8925.1,8925.11,.04,21,4,0) +security number, the Lookup Local Variable Name might be TIUSSN. The +"^DD",8925.1,8925.11,.04,21,5,0) +social security number as written by the transcriptionist is first +"^DD",8925.1,8925.11,.04,21,6,0) +transformed by any existing Transform Code, and then set into this +"^DD",8925.1,8925.11,.04,21,7,0) +variable (e.g. TIUSSN) for use in Look-Up Method code. +"^DD",8925.1,8925.11,.04,21,8,0) + +"^DD",8925.1,8925.11,.04,21,9,0) +Lookup Local Variable Name is necessary only if the information in this +"^DD",8925.1,8925.11,.04,21,10,0) +piece is required in order to look up the appropriate entry in the target +"^DD",8925.1,8925.11,.04,21,11,0) +file. +"^DD",8925.1,8925.11,.04,"DT") +2921109 +"^DD",8925.1,8925.11,.05,0) +EXAMPLE ENTRY^F^^0;5^K:$L(X)>39!($L(X)<2) X +"^DD",8925.1,8925.11,.05,3) +Answer must be 2-39 characters in length. +"^DD",8925.1,8925.11,.05,21,0) +^^10^10^2970108^^ +"^DD",8925.1,8925.11,.05,21,1,0) +This field is used to store sample data for this item in the form the +"^DD",8925.1,8925.11,.05,21,2,0) +transcriptionist is expected to use when transcribing it. For example, if +"^DD",8925.1,8925.11,.05,21,3,0) +a patient has Social Security Number 555-12-1212, and the transcriptionist +"^DD",8925.1,8925.11,.05,21,4,0) +is expected to write 555-12-1212, then an Example Entry should have the +"^DD",8925.1,8925.11,.05,21,5,0) +form 555-12-1212. +"^DD",8925.1,8925.11,.05,21,6,0) + +"^DD",8925.1,8925.11,.05,21,7,0) +The Transform Code, if it exists, then transforms the transcribed Social +"^DD",8925.1,8925.11,.05,21,8,0) +Security Number 555-12-1212 into the appropriate format for the target +"^DD",8925.1,8925.11,.05,21,9,0) +file before using the Social Security Number to look-up the appropriate +"^DD",8925.1,8925.11,.05,21,10,0) +target file entry and/or before entering it in the target file. +"^DD",8925.1,8925.11,.05,"DT") +2930224 +"^DD",8925.1,8925.11,.06,0) +CLINICIAN MUST DICTATE^S^1:YES;0:NO;^0;6^Q +"^DD",8925.1,8925.11,.06,3) +Answer yes if this field needs to be dictated by the clinician +"^DD",8925.1,8925.11,.06,21,0) +^^5^5^2970108^ +"^DD",8925.1,8925.11,.06,21,1,0) +States whether or not this piece of the header should be dictated by the +"^DD",8925.1,8925.11,.06,21,2,0) +Clinician. Will be used by the Clinician Help routine to determine if +"^DD",8925.1,8925.11,.06,21,3,0) +this field should be shown as data that should be dictated. (Some pieces +"^DD",8925.1,8925.11,.06,21,4,0) +can be entered by the transcriber without being dictated, such as the +"^DD",8925.1,8925.11,.06,21,5,0) +transcriber identification). +"^DD",8925.1,8925.11,.06,"DT") +2930423 +"^DD",8925.1,8925.11,.07,0) +REQUIRED FIELD?^S^1:YES;0:NO;^0;7^Q +"^DD",8925.1,8925.11,.07,3) +Please indicate whether the field is required. +"^DD",8925.1,8925.11,.07,21,0) +^^5^5^2970108^ +"^DD",8925.1,8925.11,.07,21,1,0) +This field is used to determine whether a given header piece is required +"^DD",8925.1,8925.11,.07,21,2,0) +by the application (e.g., Author and Attending Physician may be required +"^DD",8925.1,8925.11,.07,21,3,0) +for the ongoing processing of a Discharge Summary). Records lacking +"^DD",8925.1,8925.11,.07,21,4,0) +required fields WILL be entered if possible into the target file but will +"^DD",8925.1,8925.11,.07,21,5,0) +generate Missing Field Error Alerts. +"^DD",8925.1,8925.11,.07,"DT") +2951004 +"^DD",8925.1,8925.11,1,0) +TRANSFORM CODE^K^^1;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.11,1,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.11,1,9) +@ +"^DD",8925.1,8925.11,1,21,0) +^^11^11^2970108^ +"^DD",8925.1,8925.11,1,21,1,0) +This standard MUMPS code transforms the transcribed value of the header +"^DD",8925.1,8925.11,1,21,2,0) +piece into a format acceptable to FileMan (e.g., patient social security +"^DD",8925.1,8925.11,1,21,3,0) +number 555-12-1212 must be transformed to 555121212 or to whatever +"^DD",8925.1,8925.11,1,21,4,0) +(external) format FileMan accepts when a user edits the social security +"^DD",8925.1,8925.11,1,21,5,0) +number field in the target file). +"^DD",8925.1,8925.11,1,21,6,0) + +"^DD",8925.1,8925.11,1,21,7,0) +Field values are transformed before being set into Special Lookup +"^DD",8925.1,8925.11,1,21,8,0) +Variables and before being set into Target Text File Fields. +"^DD",8925.1,8925.11,1,21,9,0) + +"^DD",8925.1,8925.11,1,21,10,0) +Field is necessary only if transcribed piece is not in the format Fileman +"^DD",8925.1,8925.11,1,21,11,0) +accepts for the target file. +"^DD",8925.1,8925.11,1,"DT") +2930219 +"^DD",8925.1,8925.111,0) +STAT AUTO PRINT EVENT SUB-FIELD^^.01^1 +"^DD",8925.1,8925.111,0,"DT") +2940621 +"^DD",8925.1,8925.111,0,"IX","B",8925.111,.01) + +"^DD",8925.1,8925.111,0,"NM","STAT AUTO PRINT EVENT") + +"^DD",8925.1,8925.111,0,"UP") +8925.1 +"^DD",8925.1,8925.111,.01,0) +STAT AUTO PRINT EVENT^MS^N:NONE;T:TRANSCRIBED;R:RELEASED;V:VERIFIED;S:SIGNED;CSR:COSIGNED, REQUIRED;CSOINC:COSIGNED, OPTIONAL, INCOMPLETE;CSOCP:COSIGNED, OPTIONAL, COMPLETED;CP:COMLETED;AD:ADDENDUM ADDED;AM:AMENDED;^0;1^Q +"^DD",8925.1,8925.111,.01,1,0) +^.1 +"^DD",8925.1,8925.111,.01,1,1,0) +8925.111^B +"^DD",8925.1,8925.111,.01,1,1,1) +S ^TIU(8925.1,DA(1),11,"B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.111,.01,1,1,2) +K ^TIU(8925.1,DA(1),11,"B",$E(X,1,30),DA) +"^DD",8925.1,8925.111,.01,3) +Enter every event which should trigger auto printing of document whenever the event occurs. +"^DD",8925.1,8925.111,.01,"DT") +2941027 +"^DD",8925.1,8925.112,0) +ROUTINE AUTO PRINT EVENT SUB-FIELD^^.01^1 +"^DD",8925.1,8925.112,0,"DT") +2940621 +"^DD",8925.1,8925.112,0,"IX","B",8925.112,.01) + +"^DD",8925.1,8925.112,0,"NM","ROUTINE AUTO PRINT EVENT") + +"^DD",8925.1,8925.112,0,"UP") +8925.1 +"^DD",8925.1,8925.112,.01,0) +ROUTINE AUTO PRINT EVENT^MS^N:NONE;T:TRANSCRIBED;R:RELEASED;V:VERIFIED;S:SIGNED;CSR:COSIGNED, REQUIRED;CSOINC:COSIGNED, OPTIONAL, INCOMPLETE;CP:COMPLETED;CSOCP:CONSIGNED, OPTIONAL, COMPLETED;AD:ADDENDUM ADDED;AM:AMENDED;^0;1^Q +"^DD",8925.1,8925.112,.01,1,0) +^.1 +"^DD",8925.1,8925.112,.01,1,1,0) +8925.112^B +"^DD",8925.1,8925.112,.01,1,1,1) +S ^TIU(8925.1,DA(1),12,"B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.112,.01,1,1,2) +K ^TIU(8925.1,DA(1),12,"B",$E(X,1,30),DA) +"^DD",8925.1,8925.112,.01,3) +Enter an event which should trigger auto printing of routine documents. +"^DD",8925.1,8925.112,.01,"DT") +2940621 +"^DD",8925.1,8925.113,0) +PROCESSING STEPS SUB-FIELD^^.05^5 +"^DD",8925.1,8925.113,0,"DT") +2950216 +"^DD",8925.1,8925.113,0,"IX","B",8925.113,.01) + +"^DD",8925.1,8925.113,0,"NM","PROCESSING STEPS") + +"^DD",8925.1,8925.113,0,"UP") +8925.1 +"^DD",8925.1,8925.113,.01,0) +PROCESSING STEP^MP8930.8'^USR(8930.8,^0;1^Q +"^DD",8925.1,8925.113,.01,1,0) +^.1 +"^DD",8925.1,8925.113,.01,1,1,0) +8925.113^B +"^DD",8925.1,8925.113,.01,1,1,1) +S ^TIU(8925.1,DA(1),13,"B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.113,.01,1,1,2) +K ^TIU(8925.1,DA(1),13,"B",$E(X,1,30),DA) +"^DD",8925.1,8925.113,.01,3) +Please indicate a step involved in processing this document. +"^DD",8925.1,8925.113,.01,21,0) +^^2^2^2950216^ +"^DD",8925.1,8925.113,.01,21,1,0) +This is a step or action (e.g., verification) in the processing of a document +"^DD",8925.1,8925.113,.01,21,2,0) +that moves it from one state (e.g., unverified) to another (e.g., unsigned). +"^DD",8925.1,8925.113,.01,"DT") +2950216 +"^DD",8925.1,8925.113,.02,0) +SEQUENCE^NJ3,0^^0;2^K:+X'=X!(X>999)!(X<0)!(X?.E1"."1N.N) X +"^DD",8925.1,8925.113,.02,3) +Indicate the order in processing this document where this step should occur. +"^DD",8925.1,8925.113,.02,21,0) +^^4^4^2950216^ +"^DD",8925.1,8925.113,.02,21,1,0) +This is the serial sequence in the processing of the document in which the +"^DD",8925.1,8925.113,.02,21,2,0) +current step should ordinarily occur. This field is only necessary when the +"^DD",8925.1,8925.113,.02,21,3,0) +process in question must occur in a particular sequence (e.g., to insure +"^DD",8925.1,8925.113,.02,21,4,0) +that a document is always released from draft before it is verified). +"^DD",8925.1,8925.113,.02,"DT") +2950216 +"^DD",8925.1,8925.113,.03,0) +REQUIRED?^S^1:REQUIRED;0:OPTIONAL;^0;3^Q +"^DD",8925.1,8925.113,.03,3) +Indicate whether the step is required or optional +"^DD",8925.1,8925.113,.03,21,0) +^^4^4^2950216^ +"^DD",8925.1,8925.113,.03,21,1,0) +This field specifies whether the step is required or optional for completion +"^DD",8925.1,8925.113,.03,21,2,0) +of the document (e.g., Dictation and transcription is the typical means by +"^DD",8925.1,8925.113,.03,21,3,0) +which Discharge Summaries are acquired, but they may be entered directly by +"^DD",8925.1,8925.113,.03,21,4,0) +the provider, if preferred). +"^DD",8925.1,8925.113,.03,"DT") +2950216 +"^DD",8925.1,8925.113,.04,0) +RESULTING STATUS^P8930.6'^USR(8930.6,^0;4^Q +"^DD",8925.1,8925.113,.04,3) +Indicate the status resulting from the step being taken. +"^DD",8925.1,8925.113,.04,21,0) +^^4^4^2950216^ +"^DD",8925.1,8925.113,.04,21,1,0) +This is the status of the document following completion of the step in +"^DD",8925.1,8925.113,.04,21,2,0) +question. For instance, if a discharge summary is to be registered as +"^DD",8925.1,8925.113,.04,21,3,0) +unsigned following verification, this would be indicated in the RESULTING +"^DD",8925.1,8925.113,.04,21,4,0) +STATUS field. +"^DD",8925.1,8925.113,.04,"DT") +2950216 +"^DD",8925.1,8925.113,.05,0) +CONDITION TEXT^F^^0;5^K:$L(X)>40!($L(X)<3) X +"^DD",8925.1,8925.113,.05,3) +Condition under which the step will result in the status as indicated. +"^DD",8925.1,8925.113,.05,"DT") +2950216 +"^DD",8925.1,8925.114,0) +DIALOG SUB-FIELD^^117^12 +"^DD",8925.1,8925.114,0,"DT") +2951002 +"^DD",8925.1,8925.114,0,"IX","AS",8925.114,.03) + +"^DD",8925.1,8925.114,0,"IX","B",8925.114,.01) + +"^DD",8925.1,8925.114,0,"NM","DIALOG") + +"^DD",8925.1,8925.114,0,"UP") +8925.1 +"^DD",8925.1,8925.114,.01,0) +PROMPT^MF^^0;1^K:$L(X)>30!($L(X)<2) X +"^DD",8925.1,8925.114,.01,1,0) +^.1 +"^DD",8925.1,8925.114,.01,1,1,0) +8925.114^B +"^DD",8925.1,8925.114,.01,1,1,1) +S ^TIU(8925.1,DA(1),"DIALOG","B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.114,.01,1,1,2) +K ^TIU(8925.1,DA(1),"DIALOG","B",$E(X,1,30),DA) +"^DD",8925.1,8925.114,.01,3) +Enter the caption with which the user will be prompted. +"^DD",8925.1,8925.114,.01,21,0) +^^2^2^2950606^^^ +"^DD",8925.1,8925.114,.01,21,1,0) +This is the prompt with which the user will be presented during interactive +"^DD",8925.1,8925.114,.01,21,2,0) +entry of the document. +"^DD",8925.1,8925.114,.01,"DT") +2950606 +"^DD",8925.1,8925.114,.02,0) +ITEM NAME^F^^0;2^K:$L(X)>50!($L(X)<2) X +"^DD",8925.1,8925.114,.02,3) +Answer must be 2-50 characters in length. +"^DD",8925.1,8925.114,.02,21,0) +^^2^2^2950606^^ +"^DD",8925.1,8925.114,.02,21,1,0) +This is a descriptive name for the datum which will help descibe the prompt +"^DD",8925.1,8925.114,.02,21,2,0) +for the user. +"^DD",8925.1,8925.114,.02,"DT") +2950606 +"^DD",8925.1,8925.114,.03,0) +SEQUENCE^NJ3,0^^0;3^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1N.N) X +"^DD",8925.1,8925.114,.03,1,0) +^.1 +"^DD",8925.1,8925.114,.03,1,1,0) +8925.114^AS +"^DD",8925.1,8925.114,.03,1,1,1) +S ^TIU(8925.1,DA(1),"DIALOG","AS",$E(X,1,30),DA)="" +"^DD",8925.1,8925.114,.03,1,1,2) +K ^TIU(8925.1,DA(1),"DIALOG","AS",$E(X,1,30),DA) +"^DD",8925.1,8925.114,.03,1,1,"%D",0) +^^2^2^2950606^ +"^DD",8925.1,8925.114,.03,1,1,"%D",1,0) +This REGULAR FileMan Cross-reference on the sequence sub-field of the +"^DD",8925.1,8925.114,.03,1,1,"%D",2,0) +Dialog Multiple will facilitate appropriate serialization of prompts. +"^DD",8925.1,8925.114,.03,1,1,"DT") +2950606 +"^DD",8925.1,8925.114,.03,3) +Type a Number between 1 and 999, 0 Decimal Digits +"^DD",8925.1,8925.114,.03,21,0) +^^2^2^2950606^ +"^DD",8925.1,8925.114,.03,21,1,0) +This is the sequence of the prompt within the dialog. On the Windows Client +"^DD",8925.1,8925.114,.03,21,2,0) +this will correspond with the Tab Order Property of the prompt. +"^DD",8925.1,8925.114,.03,"DT") +2950606 +"^DD",8925.1,8925.114,.04,0) +FIELD^FX^^0;4^K:$L(X)>10!($L(X)<1)!(+X<0) X +"^DD",8925.1,8925.114,.04,3) +Enter the field in the TARGET FILE in which the response is to be stored. +"^DD",8925.1,8925.114,.04,4) + +"^DD",8925.1,8925.114,.04,21,0) +^^2^2^2970116^^ +"^DD",8925.1,8925.114,.04,21,1,0) +This is the field in the target file in which the user's response will be +"^DD",8925.1,8925.114,.04,21,2,0) +stored. +"^DD",8925.1,8925.114,.04,"DT") +2970116 +"^DD",8925.1,8925.114,.05,0) +REQUIRED^S^1:YES;0:NO;^0;5^Q +"^DD",8925.1,8925.114,.05,3) +Indicate whether a response is required. +"^DD",8925.1,8925.114,.05,21,0) +^^2^2^2950607^ +"^DD",8925.1,8925.114,.05,21,1,0) +Please indicate whether a response to this prompt is required, in order to +"^DD",8925.1,8925.114,.05,21,2,0) +complete the dialog. +"^DD",8925.1,8925.114,.05,"DT") +2950607 +"^DD",8925.1,8925.114,.06,0) +VISIBLE^S^0:NO;1:YES;^0;6^Q +"^DD",8925.1,8925.114,.06,3) +Indicate wheter the prompt will be visible to the user. +"^DD",8925.1,8925.114,.06,21,0) +^^2^2^2950607^ +"^DD",8925.1,8925.114,.06,21,1,0) +This field specifies whether a given datum will be prompted for, or +"^DD",8925.1,8925.114,.06,21,2,0) +"stuffed," based on execution of the SET METHOD for a given prompt. +"^DD",8925.1,8925.114,.06,"DT") +2950607 +"^DD",8925.1,8925.114,1,0) +SET METHOD^K^^1;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.114,1,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.114,1,9) +@ +"^DD",8925.1,8925.114,1,21,0) +^^5^5^2950607^^^ +"^DD",8925.1,8925.114,1,21,1,0) +This is the mumps code for determining the default value of an interactive +"^DD",8925.1,8925.114,1,21,2,0) +("visible") prompt, and for setting the value to be non-interactively +"^DD",8925.1,8925.114,1,21,3,0) +"stuffed" on invokation of an "invisible" prompt. Regardless of the +"^DD",8925.1,8925.114,1,21,4,0) +syntactic approach (e.g., subroutine or extrinsic function, the return +"^DD",8925.1,8925.114,1,21,5,0) +value of the method should be placed in the local varible X. +"^DD",8925.1,8925.114,1,"DT") +2950607 +"^DD",8925.1,8925.114,101,0) +WINDOWS CONTROL^S^1:LongList;2:SimpleList;3:Edit;4:Memo;^W;1^Q +"^DD",8925.1,8925.114,101,3) +Enter the Windows control appropriate for this prompt +"^DD",8925.1,8925.114,101,21,0) +^^2^2^2950907^ +"^DD",8925.1,8925.114,101,21,1,0) +Stores the type of Windows control necessary to get the data for this +"^DD",8925.1,8925.114,101,21,2,0) +prompt. +"^DD",8925.1,8925.114,101,"DT") +2950907 +"^DD",8925.1,8925.114,102,0) +API NAME^F^^W;2^K:$L(X)>30!($L(X)<3) X +"^DD",8925.1,8925.114,102,3) +Answer must be 3-30 characters in length. +"^DD",8925.1,8925.114,102,21,0) +^^3^3^2950907^ +"^DD",8925.1,8925.114,102,21,1,0) +This is the API that should be called by the broker when the control is +"^DD",8925.1,8925.114,102,21,2,0) +used. How the API is used varies with the control. Examples are: +"^DD",8925.1,8925.114,102,21,3,0) +filling list boxes, getting boilerplate text, etc. +"^DD",8925.1,8925.114,102,"DT") +2951002 +"^DD",8925.1,8925.114,103,0) +API PARAMETER #1^F^^W;3^K:$L(X)>30!($L(X)<1) X +"^DD",8925.1,8925.114,103,3) +Answer must be 1-30 characters in length. +"^DD",8925.1,8925.114,103,21,0) +^^1^1^2950907^ +"^DD",8925.1,8925.114,103,21,1,0) +A parameter that is used by the API may be stored here. +"^DD",8925.1,8925.114,103,"DT") +2950907 +"^DD",8925.1,8925.114,113,0) +WINDOWS CONDITION^K^^W3;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.114,113,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.114,113,9) +@ +"^DD",8925.1,8925.114,113,21,0) +^^3^3^2950907^ +"^DD",8925.1,8925.114,113,21,1,0) +This is silent code which is executed when building the dialog for +"^DD",8925.1,8925.114,113,21,2,0) +Windows. It identifies which prompts should be included in the dialog. +"^DD",8925.1,8925.114,113,21,3,0) +The condition should leave $T failse if the prompt should not be asked. +"^DD",8925.1,8925.114,113,"DT") +2950907 +"^DD",8925.1,8925.114,117,0) +WINDOWS DEFAULT^K^^W7;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.114,117,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.114,117,9) +@ +"^DD",8925.1,8925.114,117,21,0) +^^2^2^2950907^ +"^DD",8925.1,8925.114,117,21,1,0) +This code should silently set the default value of a prompt when it is +"^DD",8925.1,8925.114,117,21,2,0) +selected. +"^DD",8925.1,8925.114,117,"DT") +2950907 +"^DD",8925.1,8925.12,0) +UPLOAD CAPTIONED ASCII HEADER SUB-FIELD^^1^8 +"^DD",8925.1,8925.12,0,"DT") +2951004 +"^DD",8925.1,8925.12,0,"IX","B",8925.12,.01) + +"^DD",8925.1,8925.12,0,"IX","C",8925.12,.02) + +"^DD",8925.1,8925.12,0,"IX","D",8925.12,.03) + +"^DD",8925.1,8925.12,0,"IX","E",8925.12,.04) + +"^DD",8925.1,8925.12,0,"NM","UPLOAD CAPTIONED ASCII HEADER") + +"^DD",8925.1,8925.12,0,"UP") +8925.1 +"^DD",8925.1,8925.12,.01,0) +CAPTION^MF^^0;1^K:$L(X)>40!($L(X)<2) X +"^DD",8925.1,8925.12,.01,1,0) +^.1 +"^DD",8925.1,8925.12,.01,1,1,0) +8925.12^B +"^DD",8925.1,8925.12,.01,1,1,1) +S ^TIU(8925.1,DA(1),"HEAD","B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.12,.01,1,1,2) +K ^TIU(8925.1,DA(1),"HEAD","B",$E(X,1,30),DA) +"^DD",8925.1,8925.12,.01,3) +Answer must be 2-40 characters in length. +"^DD",8925.1,8925.12,.01,21,0) +^^7^7^2970108^ +"^DD",8925.1,8925.12,.01,21,1,0) +NOTE: Users can choose between two possible kinds of Upload Record +"^DD",8925.1,8925.12,.01,21,2,0) +Headers: Captioned or Delimited. Captioned headers should be used UNLESS +"^DD",8925.1,8925.12,.01,21,3,0) +the site has a way to generate upload headers automatically. +"^DD",8925.1,8925.12,.01,21,4,0) + +"^DD",8925.1,8925.12,.01,21,5,0) +CAPTION is the caption which the transcriber enters into the captioned +"^DD",8925.1,8925.12,.01,21,6,0) +upload record header immediately preceeding the item data. It serves to +"^DD",8925.1,8925.12,.01,21,7,0) +distinguish one item of data from the next. Example: PATIENT NAME +"^DD",8925.1,8925.12,.01,"DT") +2930218 +"^DD",8925.1,8925.12,.02,0) +ITEM NAME^F^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>20!($L(X)<2) X +"^DD",8925.1,8925.12,.02,1,0) +^.1 +"^DD",8925.1,8925.12,.02,1,1,0) +8925.12^C +"^DD",8925.1,8925.12,.02,1,1,1) +S ^TIU(8925.1,DA(1),"HEAD","C",$E(X,1,30),DA)="" +"^DD",8925.1,8925.12,.02,1,1,2) +K ^TIU(8925.1,DA(1),"HEAD","C",$E(X,1,30),DA) +"^DD",8925.1,8925.12,.02,1,1,"%D",0) +^^2^2^2930122^ +"^DD",8925.1,8925.12,.02,1,1,"%D",1,0) +This REGULAR FileMan cross-reference on the ITEM NAME is used in the look-up +"^DD",8925.1,8925.12,.02,1,1,"%D",2,0) +and filing processes. +"^DD",8925.1,8925.12,.02,1,1,"DT") +2930122 +"^DD",8925.1,8925.12,.02,3) +Enter the name of the header item. +"^DD",8925.1,8925.12,.02,21,0) +^^2^2^2970108^ +"^DD",8925.1,8925.12,.02,21,1,0) +This is the name of the item in the ASCII message header. Item Name is +"^DD",8925.1,8925.12,.02,21,2,0) +used in help messages for the person dictating a document. +"^DD",8925.1,8925.12,.02,"DT") +2930122 +"^DD",8925.1,8925.12,.03,0) +FIELD NUMBER^F^^0;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<1) X +"^DD",8925.1,8925.12,.03,1,0) +^.1 +"^DD",8925.1,8925.12,.03,1,1,0) +8925.12^D +"^DD",8925.1,8925.12,.03,1,1,1) +S ^TIU(8925.1,DA(1),"HEAD","D",$E(X,1,30),DA)="" +"^DD",8925.1,8925.12,.03,1,1,2) +K ^TIU(8925.1,DA(1),"HEAD","D",$E(X,1,30),DA) +"^DD",8925.1,8925.12,.03,1,1,"%D",0) +^^2^2^2930122^ +"^DD",8925.1,8925.12,.03,1,1,"%D",1,0) +This REGULAR FileMan cross-reference is used by the filer router to identify +"^DD",8925.1,8925.12,.03,1,1,"%D",2,0) +header fields with field numbers in the target file. +"^DD",8925.1,8925.12,.03,1,1,"DT") +2930122 +"^DD",8925.1,8925.12,.03,3) +Enter the FIELD # of the item in the target file. +"^DD",8925.1,8925.12,.03,21,0) +^^2^2^2970108^ +"^DD",8925.1,8925.12,.03,21,1,0) +This is the FIELD # in the target file which corresponds to this header +"^DD",8925.1,8925.12,.03,21,2,0) +item and where this item of data will be stored. +"^DD",8925.1,8925.12,.03,"DT") +2930122 +"^DD",8925.1,8925.12,.04,0) +LOOKUP LOCAL VARIABLE NAME^F^^0;4^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>8!($L(X)<1)!'(X?1A1.7E) X +"^DD",8925.1,8925.12,.04,1,0) +^.1 +"^DD",8925.1,8925.12,.04,1,1,0) +8925.12^E +"^DD",8925.1,8925.12,.04,1,1,1) +S ^TIU(8925.1,DA(1),"HEAD","E",$E(X,1,30),DA)="" +"^DD",8925.1,8925.12,.04,1,1,2) +K ^TIU(8925.1,DA(1),"HEAD","E",$E(X,1,30),DA) +"^DD",8925.1,8925.12,.04,1,1,"%D",0) +^^3^3^2930122^ +"^DD",8925.1,8925.12,.04,1,1,"%D",1,0) +This REGULAR FileMan cross-reference is used by the router/filer to determine +"^DD",8925.1,8925.12,.04,1,1,"%D",2,0) +which fields of the header should be set into special variables which may be +"^DD",8925.1,8925.12,.04,1,1,"%D",3,0) +required by the lookup routine. +"^DD",8925.1,8925.12,.04,1,1,"DT") +2930122 +"^DD",8925.1,8925.12,.04,3) +Enter the required local variable into which this item will be set. +"^DD",8925.1,8925.12,.04,21,0) +^^11^11^2970108^ +"^DD",8925.1,8925.12,.04,21,1,0) +This field specifies the local variable name into which this item of the +"^DD",8925.1,8925.12,.04,21,2,0) +upload header will be set. The local variable is used by the Look-Up +"^DD",8925.1,8925.12,.04,21,3,0) +Method. For example, if this item of the header is the patient social +"^DD",8925.1,8925.12,.04,21,4,0) +security number, the Lookup Local Variable Name might be TIUSSN. The +"^DD",8925.1,8925.12,.04,21,5,0) +social security number as written by the transcriptionist is first +"^DD",8925.1,8925.12,.04,21,6,0) +transformed by any existing Transform Code, and then set into this +"^DD",8925.1,8925.12,.04,21,7,0) +variable (e.g. TIUSSN) for use in Look-Up Method code. +"^DD",8925.1,8925.12,.04,21,8,0) + +"^DD",8925.1,8925.12,.04,21,9,0) +Lookup Local Variable Name is necessary only if the information in this +"^DD",8925.1,8925.12,.04,21,10,0) +piece is required in order to look up the appropriate entry in the target +"^DD",8925.1,8925.12,.04,21,11,0) +file. +"^DD",8925.1,8925.12,.04,"DT") +2930122 +"^DD",8925.1,8925.12,.05,0) +EXAMPLE ENTRY^F^^0;5^K:$L(X)>80!($L(X)<2) X +"^DD",8925.1,8925.12,.05,3) +Answer must be 2-80 characters in length. +"^DD",8925.1,8925.12,.05,21,0) +^^9^9^2970108^ +"^DD",8925.1,8925.12,.05,21,1,0) +This field is used to store sample data for this item in the form the +"^DD",8925.1,8925.12,.05,21,2,0) +transcriptionist is expected to use when transcribing it. For example, if +"^DD",8925.1,8925.12,.05,21,3,0) +a patient has social security number 555-12-1212, and the transcriptionist +"^DD",8925.1,8925.12,.05,21,4,0) +is expected to write 555-12-1212, than an Example Entry should have the +"^DD",8925.1,8925.12,.05,21,5,0) +form 555-12-1212. +"^DD",8925.1,8925.12,.05,21,6,0) + +"^DD",8925.1,8925.12,.05,21,7,0) +The Upload needs to know the exact form the transcriptionist is expected +"^DD",8925.1,8925.12,.05,21,8,0) +to use in case it needs to transform it to make it acceptable to FileMan. +"^DD",8925.1,8925.12,.05,21,9,0) +In this case, the transcriptionist also needs to know the exact form. +"^DD",8925.1,8925.12,.05,"DT") +2930224 +"^DD",8925.1,8925.12,.06,0) +CLINICIAN MUST DICTATE^S^1:YES;0:NO;^0;6^Q +"^DD",8925.1,8925.12,.06,3) +Answer yes if this field needs to be dictated by the clinician. +"^DD",8925.1,8925.12,.06,21,0) +^^5^5^2970108^ +"^DD",8925.1,8925.12,.06,21,1,0) +States whether or not this item should be dictated by the Clinician. Will +"^DD",8925.1,8925.12,.06,21,2,0) +be used by the Clinician Help routine to determine if this field should be +"^DD",8925.1,8925.12,.06,21,3,0) +shown as data that should be dictated. (Some items can be entered by the +"^DD",8925.1,8925.12,.06,21,4,0) +transcriber without being dictated, such as the transcriber +"^DD",8925.1,8925.12,.06,21,5,0) +identification). +"^DD",8925.1,8925.12,.06,"DT") +2930423 +"^DD",8925.1,8925.12,.07,0) +REQUIRED FIELD?^S^1:YES;0:NO;^0;7^Q +"^DD",8925.1,8925.12,.07,3) +Please indicate whether field is required by application. +"^DD",8925.1,8925.12,.07,21,0) +^^5^5^2970108^ +"^DD",8925.1,8925.12,.07,21,1,0) +This field is used to determine whether a given header item is required +"^DD",8925.1,8925.12,.07,21,2,0) +by the application (e.g., Author and Attending Physician may be required +"^DD",8925.1,8925.12,.07,21,3,0) +for the ongoing processing of a Discharge Summary). Records lacking +"^DD",8925.1,8925.12,.07,21,4,0) +required fields WILL be entered into the target file, if possible, but +"^DD",8925.1,8925.12,.07,21,5,0) +will generate Missing Field Error Alerts. +"^DD",8925.1,8925.12,.07,"DT") +2951004 +"^DD",8925.1,8925.12,1,0) +TRANSFORM CODE^K^^1;E1,245^K:$L(X)>245 X D:$D(X) ^DIM +"^DD",8925.1,8925.12,1,3) +This is Standard MUMPS code. +"^DD",8925.1,8925.12,1,9) +@ +"^DD",8925.1,8925.12,1,21,0) +^^11^11^2970108^ +"^DD",8925.1,8925.12,1,21,1,0) +This standard MUMPS code transforms the transcribed value of the header +"^DD",8925.1,8925.12,1,21,2,0) +item into a format acceptable to FileMan (e.g., patient social security +"^DD",8925.1,8925.12,1,21,3,0) +number 555-12-1212 must be transformed to 555121212 or to whatever +"^DD",8925.1,8925.12,1,21,4,0) +(external) format FileMan accepts when a user edits the social security +"^DD",8925.1,8925.12,1,21,5,0) +number field in the target file). +"^DD",8925.1,8925.12,1,21,6,0) + +"^DD",8925.1,8925.12,1,21,7,0) +Field values are transformed before being set into Special Lookup +"^DD",8925.1,8925.12,1,21,8,0) +Variables and before being set into target file fields. +"^DD",8925.1,8925.12,1,21,9,0) + +"^DD",8925.1,8925.12,1,21,10,0) +Field is necessary only if transcribed item is not in the format Fileman +"^DD",8925.1,8925.12,1,21,11,0) +accepts for the target file. +"^DD",8925.1,8925.12,1,"DT") +2930219 +"^DD",8925.1,8925.13,0) +BOILERPLATE TEXT SUB-FIELD^^.01^1 +"^DD",8925.1,8925.13,0,"NM","BOILERPLATE TEXT") + +"^DD",8925.1,8925.13,0,"UP") +8925.1 +"^DD",8925.1,8925.13,.01,0) +BOILERPLATE TEXT^WL^^0;1^Q +"^DD",8925.1,8925.13,.01,3) +Enter default Report Format +"^DD",8925.1,8925.13,.01,21,0) +^^51^51^2970506^ +"^DD",8925.1,8925.13,.01,21,1,0) +Applies to Titles and Components. +"^DD",8925.1,8925.13,.01,21,2,0) + +"^DD",8925.1,8925.13,.01,21,3,0) +Site can preload the text field of a document with default text/default +"^DD",8925.1,8925.13,.01,21,4,0) +format/overprint data which is presented to the user when entering the +"^DD",8925.1,8925.13,.01,21,5,0) +document. User can then edit and/or add to the boilerplate text. +"^DD",8925.1,8925.13,.01,21,6,0) + +"^DD",8925.1,8925.13,.01,21,7,0) +If document is formatted into columns, users entering documents should use +"^DD",8925.1,8925.13,.01,21,8,0) +replace mode rather than insert mode (or Find/RePlace Text) to preserve +"^DD",8925.1,8925.13,.01,21,9,0) +the columns. +"^DD",8925.1,8925.13,.01,21,10,0) + +"^DD",8925.1,8925.13,.01,21,11,0) +Boilerplate Text may be used as an alternative to components to split a +"^DD",8925.1,8925.13,.01,21,12,0) +document up into sections, but such sections are stored together and +"^DD",8925.1,8925.13,.01,21,13,0) +cannot be separately accessed the way components can. See Type Component, +"^DD",8925.1,8925.13,.01,21,14,0) +under Basic field Type. +"^DD",8925.1,8925.13,.01,21,15,0) + +"^DD",8925.1,8925.13,.01,21,16,0) +Titles/Components must be inactive in order to edit boilerplate text. +"^DD",8925.1,8925.13,.01,21,17,0) + +"^DD",8925.1,8925.13,.01,21,18,0) +Boilerplate Text is the place to embed objects which go fetch data. For +"^DD",8925.1,8925.13,.01,21,19,0) +example, suppose a Title has boilerplate text: +"^DD",8925.1,8925.13,.01,21,20,0) + +"^DD",8925.1,8925.13,.01,21,21,0) + Patient is a healthy |PATIENT AGE| year old male... +"^DD",8925.1,8925.13,.01,21,22,0) + +"^DD",8925.1,8925.13,.01,21,23,0) +Then a user who enters such a note for a patient known by the system to be +"^DD",8925.1,8925.13,.01,21,24,0) +56 years old would be presented with the text: +"^DD",8925.1,8925.13,.01,21,25,0) + +"^DD",8925.1,8925.13,.01,21,26,0) + Patient is a healthy 56 year old male... +"^DD",8925.1,8925.13,.01,21,27,0) + +"^DD",8925.1,8925.13,.01,21,28,0) +The user can then add to the text and/or edit the text, including the age +"^DD",8925.1,8925.13,.01,21,29,0) +(56) of the patient. From this point on, the patient age (56) is regular +"^DD",8925.1,8925.13,.01,21,30,0) +text and is not updated in this note. +"^DD",8925.1,8925.13,.01,21,31,0) + +"^DD",8925.1,8925.13,.01,21,32,0) +If a user enters a document when an embedded object is Inactive, the +"^DD",8925.1,8925.13,.01,21,33,0) +object does not function; the user sees the object name and an error +"^DD",8925.1,8925.13,.01,21,34,0) +message. Similarly, if an object has been misspelled in the boilerplate +"^DD",8925.1,8925.13,.01,21,35,0) +text, or deleted from the file, or if the object name in the boilerplate +"^DD",8925.1,8925.13,.01,21,36,0) +text is not unique among objects, the object does not function. +"^DD",8925.1,8925.13,.01,21,37,0) + +"^DD",8925.1,8925.13,.01,21,38,0) +When embedding objects in boilerplate text, users should make sure the +"^DD",8925.1,8925.13,.01,21,39,0) +entire object name is on one line rather than split between two lines. +"^DD",8925.1,8925.13,.01,21,40,0) +Split names generate "NOT found" error messages. Users must also allow +"^DD",8925.1,8925.13,.01,21,41,0) +enough white space in the boilerplate text for whatever data the object +"^DD",8925.1,8925.13,.01,21,42,0) +imports. Users can check boilerplate text using action TRY. +"^DD",8925.1,8925.13,.01,21,43,0) + +"^DD",8925.1,8925.13,.01,21,44,0) +Any user who can edit boilerplate text can embed any object in it. +"^DD",8925.1,8925.13,.01,21,45,0) +However, except for object owners who are testing an object, USERS SHOULD +"^DD",8925.1,8925.13,.01,21,46,0) +EMBED ONLY ACTIVE OBJECTS in boilerplate text. An object can be embedded +"^DD",8925.1,8925.13,.01,21,47,0) +in as many different Document Definitions as desired. +"^DD",8925.1,8925.13,.01,21,48,0) + +"^DD",8925.1,8925.13,.01,21,49,0) +A document with multiple components can have boilerplate text in the entry +"^DD",8925.1,8925.13,.01,21,50,0) +itself and/or in any component. Boilerplate text in the entry itself +"^DD",8925.1,8925.13,.01,21,51,0) +appears first. +"^DD",8925.1,8925.13,.01,"DT") +2930305 +"^DD",8925.1,8925.14,0) +ITEM SUB-FIELD^^4^4 +"^DD",8925.1,8925.14,0,"DT") +2970212 +"^DD",8925.1,8925.14,0,"IX","AC",8925.14,3) + +"^DD",8925.1,8925.14,0,"IX","B",8925.14,.01) + +"^DD",8925.1,8925.14,0,"IX","C",8925.14,4) + +"^DD",8925.1,8925.14,0,"NM","ITEM") + +"^DD",8925.1,8925.14,0,"UP") +8925.1 +"^DD",8925.1,8925.14,.01,0) +ITEM^M*P8925.1'X^TIU(8925.1,^0;1^S DIC("S")="I $G(TIUFPRIV) X:$D(TIUFISCR) ""I Y=TIUFISCR""" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X +"^DD",8925.1,8925.14,.01,1,0) +^.1 +"^DD",8925.1,8925.14,.01,1,1,0) +8925.14^B +"^DD",8925.1,8925.14,.01,1,1,1) +S ^TIU(8925.1,DA(1),10,"B",$E(X,1,30),DA)="" +"^DD",8925.1,8925.14,.01,1,1,2) +K ^TIU(8925.1,DA(1),10,"B",$E(X,1,30),DA) +"^DD",8925.1,8925.14,.01,1,2,0) +8925.1^AD +"^DD",8925.1,8925.14,.01,1,2,1) +S ^TIU(8925.1,"AD",$E(X,1,30),DA(1),DA)="" +"^DD",8925.1,8925.14,.01,1,2,2) +K ^TIU(8925.1,"AD",$E(X,1,30),DA(1),DA) +"^DD",8925.1,8925.14,.01,1,2,"%D",0) +^^2^2^2940719^ +"^DD",8925.1,8925.14,.01,1,2,"%D",1,0) +This cross-reference facilitates traversal from child to parent, up the +"^DD",8925.1,8925.14,.01,1,2,"%D",2,0) +class hierarchy. +"^DD",8925.1,8925.14,.01,1,2,"DT") +2940719 +"^DD",8925.1,8925.14,.01,1,3,0) +8925.1^AMM^MUMPS +"^DD",8925.1,8925.14,.01,1,3,1) +D REDOX^TIUDD +"^DD",8925.1,8925.14,.01,1,3,2) +D REDOX^TIUDD +"^DD",8925.1,8925.14,.01,1,3,"%D",0) +^^2^2^2940720^^ +"^DD",8925.1,8925.14,.01,1,3,"%D",1,0) +This MUMPS-type cross-reference will update the timestamp on the parent +"^DD",8925.1,8925.14,.01,1,3,"%D",2,0) +document when the ITEM, MNEMONIC, or SEQUENCE changes. +"^DD",8925.1,8925.14,.01,1,3,"DT") +2940720 +"^DD",8925.1,8925.14,.01,1,4,0) +8925.1^ACL1001^MUMPS +"^DD",8925.1,8925.14,.01,1,4,1) +D SACL^TIUDD1(X,10.01) +"^DD",8925.1,8925.14,.01,1,4,2) +D KACL^TIUDD1(X,10.01) +"^DD",8925.1,8925.14,.01,1,4,"%D",0) +^^2^2^2971016^ +"^DD",8925.1,8925.14,.01,1,4,"%D",1,0) +This MUMPS-type cross-reference by class and name will help to identify +"^DD",8925.1,8925.14,.01,1,4,"%D",2,0) +the titles within a given class. +"^DD",8925.1,8925.14,.01,1,4,"DT") +2971016 +"^DD",8925.1,8925.14,.01,3) +ITEM must be a new or pre-existing Document Definition with appropriate Type which you own, which is not already an Item elsewhere. +"^DD",8925.1,8925.14,.01,4) +D NAME^TIUFXHLX +"^DD",8925.1,8925.14,.01,12) +See Technical Description. +"^DD",8925.1,8925.14,.01,12.1) +S DIC("S")="I $G(TIUFPRIV) X:$D(TIUFISCR) ""I Y=TIUFISCR""" +"^DD",8925.1,8925.14,.01,21,0) +^^6^6^2970304^^^^ +"^DD",8925.1,8925.14,.01,21,1,0) +Items are themselves Document Definitions. The Type of the parent entry +"^DD",8925.1,8925.14,.01,21,2,0) +determines what Types of items it has. A parent entry of type Class has +"^DD",8925.1,8925.14,.01,21,3,0) +items of type Class or Document Class. A Document Class entry has items +"^DD",8925.1,8925.14,.01,21,4,0) +of type Title. If a Title entry has more than a single section, it has +"^DD",8925.1,8925.14,.01,21,5,0) +items of type Component. Components may also be multi-section with items +"^DD",8925.1,8925.14,.01,21,6,0) +of type Component. Objects do not have items. +"^DD",8925.1,8925.14,.01,23,0) +^^8^8^2970304^^^^ +"^DD",8925.1,8925.14,.01,23,1,0) +The Item subfield of Item Field 10 in File 8925.1 is screened when using +"^DD",8925.1,8925.14,.01,23,2,0) +the TIUF Document Definition Utility to add items (i.e. when variable +"^DD",8925.1,8925.14,.01,23,3,0) +TIUFISCR is defined. +"^DD",8925.1,8925.14,.01,23,4,0) + +"^DD",8925.1,8925.14,.01,23,5,0) +This screen is needed in ADDTEN^TIUFLF4, which noninteractively adds an +"^DD",8925.1,8925.14,.01,23,6,0) +item to the Item multiple. The screen limits the lookup to the 8925.1 IFN +"^DD",8925.1,8925.14,.01,23,7,0) +of the item being added to the Item multiple. Without the screen, the +"^DD",8925.1,8925.14,.01,23,8,0) +lookup fails when there are multiple 8925.1 entries of the same name. +"^DD",8925.1,8925.14,.01,"DEL",.01,0) +I 1 +"^DD",8925.1,8925.14,.01,"DT") +2971016 +"^DD",8925.1,8925.14,2,0) +MNEMONIC^F^^0;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>4!($L(X)<1) X +"^DD",8925.1,8925.14,2,1,0) +^.1 +"^DD",8925.1,8925.14,2,1,1,0) +8925.1^AMM2^MUMPS +"^DD",8925.1,8925.14,2,1,1,1) +D REDOX^TIUDD +"^DD",8925.1,8925.14,2,1,1,2) +D REDOX^TIUDD +"^DD",8925.1,8925.14,2,1,1,"%D",0) +^^2^2^2961210^^^^ +"^DD",8925.1,8925.14,2,1,1,"%D",1,0) +This MUMPS-type cross-reference will update the TIMESTAMP on the parent +"^DD",8925.1,8925.14,2,1,1,"%D",2,0) +document when either the ITEM, MNEMONIC, or SEQUENCE changes. +"^DD",8925.1,8925.14,2,1,1,"DT") +2940720 +"^DD",8925.1,8925.14,2,3) +Mnemonic is a handle by which to select Classes/Document Classes from a menu. Enter the Sequence number, or 1-4 letters, or nothing if you don't want mnemonics. +"^DD",8925.1,8925.14,2,21,0) +^^3^3^2970127^ +"^DD",8925.1,8925.14,2,21,1,0) +Item Mnemonic is a handle by which to select Classes/Document Classes from +"^DD",8925.1,8925.14,2,21,2,0) +a menu. 1-4 characters long. Mnemonic is usually numeric with the same +"^DD",8925.1,8925.14,2,21,3,0) +value as the Sequence. Alpha mnemonics are permitted if preferred. +"^DD",8925.1,8925.14,2,"DT") +2940720 +"^DD",8925.1,8925.14,3,0) +SEQUENCE^NJ6,2^^0;3^K:+X'=X!(X>999)!(X<.01)!(X?.E1"."3N.N) X +"^DD",8925.1,8925.14,3,1,0) +^.1 +"^DD",8925.1,8925.14,3,1,1,0) +8925.1^AMM3^MUMPS +"^DD",8925.1,8925.14,3,1,1,1) +D REDOX^TIUDD +"^DD",8925.1,8925.14,3,1,1,2) +D REDOX^TIUDD +"^DD",8925.1,8925.14,3,1,1,"%D",0) +^^2^2^2940720^^ +"^DD",8925.1,8925.14,3,1,1,"%D",1,0) +This MUMPS-type cross-reference will update the TIMESTAMP of the parent +"^DD",8925.1,8925.14,3,1,1,"%D",2,0) +document when the ITEM, MNEMONIC, or SEQUENCE change. +"^DD",8925.1,8925.14,3,1,1,"DT") +2940720 +"^DD",8925.1,8925.14,3,1,2,0) +8925.14^AC +"^DD",8925.1,8925.14,3,1,2,1) +S ^TIU(8925.1,DA(1),10,"AC",$E(X,1,30),DA)="" +"^DD",8925.1,8925.14,3,1,2,2) +K ^TIU(8925.1,DA(1),10,"AC",$E(X,1,30),DA) +"^DD",8925.1,8925.14,3,1,2,3) +Please don't delete! +"^DD",8925.1,8925.14,3,1,2,"%D",0) +^^2^2^2950412^^^ +"^DD",8925.1,8925.14,3,1,2,"%D",1,0) +This REGULAR Fileman cross reference is used to list items by sequence +"^DD",8925.1,8925.14,3,1,2,"%D",2,0) +number. +"^DD",8925.1,8925.14,3,1,2,"DT") +2950410 +"^DD",8925.1,8925.14,3,3) +Item Sequence determines display order under the parent. For alphabetic order, do not enter sequences. Sequence is between .01 and 999, 2 Decimal Digits. +"^DD",8925.1,8925.14,3,21,0) +^^3^3^2970102^^^ +"^DD",8925.1,8925.14,3,21,1,0) +Item Sequence, if entered, determines item's order under its parent. If +"^DD",8925.1,8925.14,3,21,2,0) +items have no sequence, item order is alphabetic by item Menu Text. +"^DD",8925.1,8925.14,3,21,3,0) +Sequence must be between .01 and 999. +"^DD",8925.1,8925.14,3,"DT") +2961021 +"^DD",8925.1,8925.14,4,0) +MENU TEXT^RFX^^0;4^K:X[""""!($A(X)=45)!($A(X)=32) X I $D(X) K:$L(X)>20!($L(X)<1) X I $D(X) K:$$UPPER^TIULS($E(X,1,3))="ALL" X +"^DD",8925.1,8925.14,4,1,0) +^.1 +"^DD",8925.1,8925.14,4,1,1,0) +8925.1^AMM4^MUMPS +"^DD",8925.1,8925.14,4,1,1,1) +D REDOX^TIUDD +"^DD",8925.1,8925.14,4,1,1,2) +D REDOX^TIUDD +"^DD",8925.1,8925.14,4,1,1,"%D",0) +^^2^2^2940720^ +"^DD",8925.1,8925.14,4,1,1,"%D",1,0) +This MUMPS-type cross-reference updates the TIMESTAMP on the parent +"^DD",8925.1,8925.14,4,1,1,"%D",2,0) +document when the DISPLAY NAME changes. +"^DD",8925.1,8925.14,4,1,1,"DT") +2940720 +"^DD",8925.1,8925.14,4,1,2,0) +8925.14^C^MUMPS +"^DD",8925.1,8925.14,4,1,2,1) +S ^TIU(8925.1,DA(1),10,"C",$E(X,1,30),DA)="" +"^DD",8925.1,8925.14,4,1,2,2) +K ^TIU(8925.1,DA(1),10,"C",$E(X,1,30),DA) +"^DD",8925.1,8925.14,4,1,2,"%D",0) +^^3^3^2961210^^ +"^DD",8925.1,8925.14,4,1,2,"%D",1,0) +This M cross reference could have been regular. It is used to display +"^DD",8925.1,8925.14,4,1,2,"%D",2,0) +items with no sequence in alpha order by Menu Text. +"^DD",8925.1,8925.14,4,1,2,"DT") +2961210 +"^DD",8925.1,8925.14,4,3) +This is the short name of the entry, used in 3 column menus. 1 to 20 characters. Must not begin with 'All', or with a space. +"^DD",8925.1,8925.14,4,4) + +"^DD",8925.1,8925.14,4,21,0) +^^20^20^2990114^^ +"^DD",8925.1,8925.14,4,21,1,0) +Item Menu Text is the short name users will see for Classes and Document +"^DD",8925.1,8925.14,4,21,2,0) +Classes when selecting them from 3-COLUMN MENUS. Document Definitions are +"^DD",8925.1,8925.14,4,21,3,0) +selected from 3-column menus when viewing documents across many patients +"^DD",8925.1,8925.14,4,21,4,0) +and when viewing many kinds of documents at the same time (e.g. Progress +"^DD",8925.1,8925.14,4,21,5,0) +Notes and Discharge Summaries). +"^DD",8925.1,8925.14,4,21,6,0) + +"^DD",8925.1,8925.14,4,21,7,0) +To edit the Menu Text of a Document Definition, you must be viewing the +"^DD",8925.1,8925.14,4,21,8,0) +Document Definition as an ITEM of its PARENT. Select 'Detailed Display' +"^DD",8925.1,8925.14,4,21,9,0) +for the PARENT and then 'Items'. +"^DD",8925.1,8925.14,4,21,10,0) + +"^DD",8925.1,8925.14,4,21,11,0) +Menu Text has 1 - 20 characters. Menu Text must not begin with a space or +"^DD",8925.1,8925.14,4,21,12,0) +with 'All'. The Document Definition Utility TIUF automatically sets the +"^DD",8925.1,8925.14,4,21,13,0) +Item Menu Text to the first 20 characters of the Item's Name when an entry +"^DD",8925.1,8925.14,4,21,14,0) +is first added as an item. (If an entry's Name begins with 'All' its Menu +"^DD",8925.1,8925.14,4,21,15,0) +Text is given 'AlX' as its first 3 characters.) The utility does NOT +"^DD",8925.1,8925.14,4,21,16,0) +update Menu Text if the entry Name is later changed, since this would +"^DD",8925.1,8925.14,4,21,17,0) +overwrite what a site may have carefully set up. Menu Text is required. +"^DD",8925.1,8925.14,4,21,18,0) + +"^DD",8925.1,8925.14,4,21,19,0) +Menu Text can affect item order under a parent since order is alphabetic +"^DD",8925.1,8925.14,4,21,20,0) +by menu text if items do not have sequence numbers. +"^DD",8925.1,8925.14,4,23,0) +^^10^10^2990114^^^^ +"^DD",8925.1,8925.14,4,23,1,0) +Menu Text cannot begin with 'All' because XQOR, the Unwinder Utility, +"^DD",8925.1,8925.14,4,23,2,0) +misinterprets it. The result (for titles) is that when a user selects a +"^DD",8925.1,8925.14,4,23,3,0) +Document Class of titles to view from a three column menu, and one of the +"^DD",8925.1,8925.14,4,23,4,0) +titles has menu text starting with 'All,' then no documents are found for +"^DD",8925.1,8925.14,4,23,5,0) +titles AFTER the title starting with 'All', even though such documents may +"^DD",8925.1,8925.14,4,23,6,0) +exist. Similar problems occur with types other than titles. +"^DD",8925.1,8925.14,4,23,7,0) + +"^DD",8925.1,8925.14,4,23,8,0) +Menu Text cannot begin with a space because such Menu Text cannot be used +"^DD",8925.1,8925.14,4,23,9,0) +to select the entry from a menu: if the space is left off, it is +"^DD",8925.1,8925.14,4,23,10,0) +questioned, and if the space is left in, it is still questioned. +"^DD",8925.1,8925.14,4,"DT") +2990121 +"^DD",22706.1,22706.1,0) +FIELD^^2^3 +"^DD",22706.1,22706.1,0,"DT") +3051125 +"^DD",22706.1,22706.1,0,"IX","B",22706.1,.01) + +"^DD",22706.1,22706.1,0,"NM","TMG FDA APPLICATION") + +"^DD",22706.1,22706.1,.01,0) +LISTING^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.1,22706.1,.01,1,0) +^.1 +"^DD",22706.1,22706.1,.01,1,1,0) +22706.1^B +"^DD",22706.1,22706.1,.01,1,1,1) +S ^TMG(22706.1,"B",$E(X,1,30),DA)="" +"^DD",22706.1,22706.1,.01,1,1,2) +K ^TMG(22706.1,"B",$E(X,1,30),DA) +"^DD",22706.1,22706.1,.01,3) +NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION +"^DD",22706.1,22706.1,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.1,22706.1,.01,21,1,0) +Linking field to LISTINGS. +"^DD",22706.1,22706.1,.01,"DT") +3051125 +"^DD",22706.1,22706.1,1,0) +APPLICATION^F^^0;2^K:$L(X)>8!($L(X)<1) X +"^DD",22706.1,22706.1,1,3) +Answer must be 1-8 characters in length +"^DD",22706.1,22706.1,1,21,0) +^^1^1^3051125^^ +"^DD",22706.1,22706.1,1,21,1,0) +Number of New Drug Application if applicable. +"^DD",22706.1,22706.1,1,"DT") +3051125 +"^DD",22706.1,22706.1,2,0) +PRODUCT NUMBER^NJ3,0^^0;3^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1.N) X +"^DD",22706.1,22706.1,2,3) +Type a number between 1 and 999, 0 Decimal Digits +"^DD",22706.1,22706.1,2,21,0) +^^1^1^3051125^^ +"^DD",22706.1,22706.1,2,21,1,0) +Number used to identify the products of a New Drug Application. +"^DD",22706.1,22706.1,2,"DT") +3051125 +"^DD",22706.2,22706.2,0) +FIELD^^3^4 +"^DD",22706.2,22706.2,0,"DT") +3060427 +"^DD",22706.2,22706.2,0,"IX","B",22706.2,.01) + +"^DD",22706.2,22706.2,0,"IX","C",22706.2,2) + +"^DD",22706.2,22706.2,0,"NM","TMG FDA DOSAGE FORM") + +"^DD",22706.2,22706.2,.01,0) +LISTING^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.2,22706.2,.01,1,0) +^.1 +"^DD",22706.2,22706.2,.01,1,1,0) +22706.2^B +"^DD",22706.2,22706.2,.01,1,1,1) +S ^TMG(22706.2,"B",$E(X,1,30),DA)="" +"^DD",22706.2,22706.2,.01,1,1,2) +K ^TMG(22706.2,"B",$E(X,1,30),DA) +"^DD",22706.2,22706.2,.01,1,1,"DT") +3060430 +"^DD",22706.2,22706.2,.01,3) +NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION +"^DD",22706.2,22706.2,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.2,22706.2,.01,21,1,0) +Linking field to LISTINGS. +"^DD",22706.2,22706.2,.01,"DT") +3060430 +"^DD",22706.2,22706.2,1,0) +DOSE FORM^F^^0;2^K:$L(X)>32!($L(X)<1) X +"^DD",22706.2,22706.2,1,3) +Answer must be 1-32 characters in length +"^DD",22706.2,22706.2,1,"DT") +3051125 +"^DD",22706.2,22706.2,2,0) +DOSAGE NAME^F^^1;1^K:$L(X)>239!($L(X)<1) X +"^DD",22706.2,22706.2,2,1,0) +^.1 +"^DD",22706.2,22706.2,2,1,1,0) +22706.2^C +"^DD",22706.2,22706.2,2,1,1,1) +S ^TMG(22706.2,"C",$E(X,1,30),DA)="" +"^DD",22706.2,22706.2,2,1,1,2) +K ^TMG(22706.2,"C",$E(X,1,30),DA) +"^DD",22706.2,22706.2,2,1,1,"DT") +3060427 +"^DD",22706.2,22706.2,2,3) +Answer must be 1-239 characters in length +"^DD",22706.2,22706.2,2,"DT") +3060427 +"^DD",22706.2,22706.2,3,0) +VA DOSAGE FORM^P50.606'^PS(50.606,^1;2^Q +"^DD",22706.2,22706.2,3,"DT") +3060427 +"^DD",22706.3,22706.3,0) +FIELD^^10^11 +"^DD",22706.3,22706.3,0,"DT") +3051125 +"^DD",22706.3,22706.3,0,"IX","B",22706.3,.01) + +"^DD",22706.3,22706.3,0,"IX","C",22706.3,1) + +"^DD",22706.3,22706.3,0,"NM","TMG FDA FIRMS") + +"^DD",22706.3,22706.3,0,"PT",22706.5,6) + +"^DD",22706.3,22706.3,.01,0) +NAME^RF^^0;1^K:$L(X)>65!($L(X)<1) X +"^DD",22706.3,22706.3,.01,1,0) +^.1 +"^DD",22706.3,22706.3,.01,1,1,0) +22706.3^B +"^DD",22706.3,22706.3,.01,1,1,1) +S ^TMG(22706.3,"B",$E(X,1,30),DA)="" +"^DD",22706.3,22706.3,.01,1,1,2) +K ^TMG(22706.3,"B",$E(X,1,30),DA) +"^DD",22706.3,22706.3,.01,3) +Answer must be 1-65 characters in length +"^DD",22706.3,22706.3,.01,"DT") +3051125 +"^DD",22706.3,22706.3,1,0) +LABEL CODE^RNJ6,0^^0;2^K:+X'=X!(X>999999)!(X<0)!(X?.E1"."1.N) X +"^DD",22706.3,22706.3,1,1,0) +^.1 +"^DD",22706.3,22706.3,1,1,1,0) +22706.3^C +"^DD",22706.3,22706.3,1,1,1,1) +S ^TMG(22706.3,"C",$E(X,1,30),DA)="" +"^DD",22706.3,22706.3,1,1,1,2) +K ^TMG(22706.3,"C",$E(X,1,30),DA) +"^DD",22706.3,22706.3,1,1,1,"%D",0) +^^2^2^3070116^^ +"^DD",22706.3,22706.3,1,1,1,"%D",1,0) +This is an index of the records based on label code. +"^DD",22706.3,22706.3,1,1,1,"%D",2,0) +This is the primary key used by the FDA to index firms +"^DD",22706.3,22706.3,1,1,1,"DT") +3070116 +"^DD",22706.3,22706.3,1,3) +Type a number between 0 and 999999, 0 Decimal Digits +"^DD",22706.3,22706.3,1,"DT") +3070116 +"^DD",22706.3,22706.3,2,0) +ADDRESS HEADER^F^^0;3^K:$L(X)>45!($L(X)<1) X +"^DD",22706.3,22706.3,2,3) +Answer must be 1-45 characters in length +"^DD",22706.3,22706.3,2,"DT") +3051125 +"^DD",22706.3,22706.3,3,0) +STREET^F^^0;4^K:$L(X)>45!($L(X)<1) X +"^DD",22706.3,22706.3,3,3) +Answer must be 1-45 characters in length +"^DD",22706.3,22706.3,3,"DT") +3051125 +"^DD",22706.3,22706.3,4,0) +PO BOX^F^^0;5^K:$L(X)>8!($L(X)<1) X +"^DD",22706.3,22706.3,4,3) +Answer must be 1-8 characters in length +"^DD",22706.3,22706.3,4,"DT") +3051125 +"^DD",22706.3,22706.3,5,0) +FOREIGN ADDRESS^F^^0;6^K:$L(X)>40!($L(X)<1) X +"^DD",22706.3,22706.3,5,3) +Answer must be 1-40 characters in length +"^DD",22706.3,22706.3,5,"DT") +3051125 +"^DD",22706.3,22706.3,6,0) +CITY^F^^0;7^K:$L(X)>30!($L(X)<1) X +"^DD",22706.3,22706.3,6,3) +Answer must be 1-30 characters in length +"^DD",22706.3,22706.3,6,"DT") +3051125 +"^DD",22706.3,22706.3,7,0) +STATE^F^^0;8^K:$L(X)>2!($L(X)<1) X +"^DD",22706.3,22706.3,7,3) +Answer must be 1-2 characters in length +"^DD",22706.3,22706.3,7,"DT") +3051125 +"^DD",22706.3,22706.3,8,0) +ZIP^F^^1;1^K:$L(X)>9!($L(X)<1) X +"^DD",22706.3,22706.3,8,3) +Answer must be 1-9 characters in length +"^DD",22706.3,22706.3,8,"DT") +3051125 +"^DD",22706.3,22706.3,9,0) +PROVINCE^F^^1;2^K:$L(X)>30!($L(X)<1) X +"^DD",22706.3,22706.3,9,3) +Answer must be 1-30 characters in length +"^DD",22706.3,22706.3,9,"DT") +3051125 +"^DD",22706.3,22706.3,10,0) +COUNTRY^F^^1;3^K:$L(X)>40!($L(X)<1) X +"^DD",22706.3,22706.3,10,3) +Answer must be 1-40 characters in length +"^DD",22706.3,22706.3,10,"DT") +3051125 +"^DD",22706.4,22706.4,0) +FIELD^^3^4 +"^DD",22706.4,22706.4,0,"DDA") +N +"^DD",22706.4,22706.4,0,"DT") +3051125 +"^DD",22706.4,22706.4,0,"IX","B",22706.4,.01) + +"^DD",22706.4,22706.4,0,"IX","ING",22706.4,3) + +"^DD",22706.4,22706.4,0,"NM","TMG FDA FORMULATION") + +"^DD",22706.4,22706.4,.01,0) +LISTING^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.4,22706.4,.01,1,0) +^.1 +"^DD",22706.4,22706.4,.01,1,1,0) +22706.4^B +"^DD",22706.4,22706.4,.01,1,1,1) +S ^TMG(22706.4,"B",$E(X,1,30),DA)="" +"^DD",22706.4,22706.4,.01,1,1,2) +K ^TMG(22706.4,"B",$E(X,1,30),DA) +"^DD",22706.4,22706.4,.01,3) +Answer must be 1-30 characters in length +"^DD",22706.4,22706.4,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.4,22706.4,.01,21,1,0) +Linking field to LISTINGS. +"^DD",22706.4,22706.4,.01,"DT") +3051125 +"^DD",22706.4,22706.4,1,0) +STRENGTH^F^^0;2^K:$L(X)>10!($L(X)<1) X +"^DD",22706.4,22706.4,1,3) +Answer must be 1-10 characters in length +"^DD",22706.4,22706.4,1,21,0) +^^1^1^3051125^^ +"^DD",22706.4,22706.4,1,21,1,0) +This is the potency of the active ingredient. +"^DD",22706.4,22706.4,1,"DT") +3051125 +"^DD",22706.4,22706.4,2,0) +UNIT^F^^0;3^K:$L(X)>8!($L(X)<1) X +"^DD",22706.4,22706.4,2,3) +Answer must be 1-8 characters in length +"^DD",22706.4,22706.4,2,21,0) +^^1^1^3051125^^ +"^DD",22706.4,22706.4,2,21,1,0) +Unit of measure corresponding to strength. +"^DD",22706.4,22706.4,2,"DT") +3051125 +"^DD",22706.4,22706.4,3,0) +INGREDIENT NAME^F^^0;4^K:$L(X)>100!($L(X)<1) X +"^DD",22706.4,22706.4,3,1,0) +^.1 +"^DD",22706.4,22706.4,3,1,1,0) +22706.4^ING +"^DD",22706.4,22706.4,3,1,1,1) +S ^TMG(22706.4,"ING",$E(X,1,64),DA)="" +"^DD",22706.4,22706.4,3,1,1,2) +K ^TMG(22706.4,"ING",$E(X,1,64),DA) +"^DD",22706.4,22706.4,3,1,1,"%D",0) +^^1^1^3071024^^ +"^DD",22706.4,22706.4,3,1,1,"%D",1,0) +This is a cross reference on the text name of the ingredient used. +"^DD",22706.4,22706.4,3,1,1,"DT") +3071024 +"^DD",22706.4,22706.4,3,3) +Answer must be 1-100 characters in length +"^DD",22706.4,22706.4,3,21,0) +^^1^1^3051125^^ +"^DD",22706.4,22706.4,3,21,1,0) +Truncated preferred term for the active ingredient. +"^DD",22706.4,22706.4,3,"DT") +3071024 +"^DD",22706.5,22706.5,0) +FIELD^^8^9 +"^DD",22706.5,22706.5,0,"DT") +3070119 +"^DD",22706.5,22706.5,0,"IX","B",22706.5,.01) + +"^DD",22706.5,22706.5,0,"IX","C",22706.5,8) + +"^DD",22706.5,22706.5,0,"NM","TMG FDA LISTING") + +"^DD",22706.5,22706.5,0,"PT",22706.1,.01) + +"^DD",22706.5,22706.5,0,"PT",22706.2,.01) + +"^DD",22706.5,22706.5,0,"PT",22706.4,.01) + +"^DD",22706.5,22706.5,0,"PT",22706.6,.01) + +"^DD",22706.5,22706.5,0,"PT",22706.7,.01) + +"^DD",22706.5,22706.5,0,"PT",22706.9,.01) + +"^DD",22706.5,22706.5,.01,0) +LISTING NUMBER^RNJ7,0^^0;1^K:+X'=X!(X>9999999)!(X<1)!(X?.E1"."1.N) X +"^DD",22706.5,22706.5,.01,1,0) +^.1 +"^DD",22706.5,22706.5,.01,1,1,0) +22706.5^B +"^DD",22706.5,22706.5,.01,1,1,1) +S ^TMG(22706.5,"B",$E(X,1,30),DA)="" +"^DD",22706.5,22706.5,.01,1,1,2) +K ^TMG(22706.5,"B",$E(X,1,30),DA) +"^DD",22706.5,22706.5,.01,3) +Type a number between 1 and 9999999, 0 Decimal Digits +"^DD",22706.5,22706.5,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.5,22706.5,.01,21,1,0) +FDA generated unique identification number for each product. +"^DD",22706.5,22706.5,.01,"DT") +3051125 +"^DD",22706.5,22706.5,1,0) +LABEL CODE^F^^0;2^K:$L(X)>6!($L(X)<1) X +"^DD",22706.5,22706.5,1,3) +Answer must be 1-6 characters in length +"^DD",22706.5,22706.5,1,21,0) +^^4^4^3051125^^ +"^DD",22706.5,22706.5,1,21,1,0) +Labeler code portion of NDC; assigned by FDA to firm. The labeler code is +"^DD",22706.5,22706.5,1,21,2,0) +the first segment of the National Drug Code (NDC). For labeler codes 2 +"^DD",22706.5,22706.5,1,21,3,0) +through 9999, it is 4 digits; for labeler codes 10,000 through 99,999 it is +"^DD",22706.5,22706.5,1,21,4,0) +5 digits. +"^DD",22706.5,22706.5,1,"DT") +3051125 +"^DD",22706.5,22706.5,2,0) +PRODUCT CODE^F^^0;3^K:$L(X)>4!($L(X)<1) X +"^DD",22706.5,22706.5,2,3) +Answer must be 1-4 characters in length +"^DD",22706.5,22706.5,2,21,0) +^^3^3^3051125^^ +"^DD",22706.5,22706.5,2,21,1,0) +Product code assigned by firm. The prodcode is the second segment of the +"^DD",22706.5,22706.5,2,21,2,0) +National Drug Code (NDC). It may be a 3-digit or 4-digit code depending upon +"^DD",22706.5,22706.5,2,21,3,0) +the NDC configuration selected by the firm. +"^DD",22706.5,22706.5,2,"DT") +3051125 +"^DD",22706.5,22706.5,3,0) +STRENGTH^F^^0;4^K:$L(X)>10!($L(X)<1) X +"^DD",22706.5,22706.5,3,3) +Answer must be 1-10 characters in length +"^DD",22706.5,22706.5,3,21,0) +^^3^3^3051125^^ +"^DD",22706.5,22706.5,3,21,1,0) +For single entity products, this is the potency of the active ingredient. +"^DD",22706.5,22706.5,3,21,2,0) +For combination products, it may be null or a number or combination of +"^DD",22706.5,22706.5,3,21,3,0) +numbers, e.g., Inderide 40/25. +"^DD",22706.5,22706.5,3,"DT") +3051125 +"^DD",22706.5,22706.5,4,0) +UNIT^F^^0;5^K:$L(X)>10!($L(X)<1) X +"^DD",22706.5,22706.5,4,3) +Answer must be 1-10 characters in length +"^DD",22706.5,22706.5,4,21,0) +^^2^2^3051125^^ +"^DD",22706.5,22706.5,4,21,1,0) +Unit of measure corresponding to strength. This non-mandatory field +"^DD",22706.5,22706.5,4,21,2,0) +contains the unit code for a single entity product, e.g., MG, %VV. +"^DD",22706.5,22706.5,4,"DT") +3051125 +"^DD",22706.5,22706.5,5,0) +RX OR OTC^S^R:PRESCRIPTION (R);O:OVER THE COUNTER / OTC (0);^0;6^Q +"^DD",22706.5,22706.5,5,21,0) +^^1^1^3051125^^ +"^DD",22706.5,22706.5,5,21,1,0) +Indicates whether product is labeled for rx or OTC use +"^DD",22706.5,22706.5,5,"DT") +3051125 +"^DD",22706.5,22706.5,6,0) +FIRM^RP22706.3'^TMG(22706.3,^0;7^Q +"^DD",22706.5,22706.5,6,21,0) +^^1^1^3051125^^ +"^DD",22706.5,22706.5,6,21,1,0) +FDA generated unique identification number for each firm +"^DD",22706.5,22706.5,6,"DT") +3051125 +"^DD",22706.5,22706.5,7,0) +TRADENAME^RF^^0;8^K:$L(X)>100!($L(X)<1) X +"^DD",22706.5,22706.5,7,3) +Answer must be 1-100 characters in length +"^DD",22706.5,22706.5,7,21,0) +^^1^1^3051125^^ +"^DD",22706.5,22706.5,7,21,1,0) +Product's name as it appears on the labeling +"^DD",22706.5,22706.5,7,"DT") +3051125 +"^DD",22706.5,22706.5,8,0) +COMPILED^P22706.9'^TMG(22706.9,^0;9^Q +"^DD",22706.5,22706.5,8,1,0) +^.1 +"^DD",22706.5,22706.5,8,1,1,0) +22706.5^C +"^DD",22706.5,22706.5,8,1,1,1) +S ^TMG(22706.5,"C",$E(X,1,30),DA)="" +"^DD",22706.5,22706.5,8,1,1,2) +K ^TMG(22706.5,"C",$E(X,1,30),DA) +"^DD",22706.5,22706.5,8,1,1,"DT") +3070119 +"^DD",22706.5,22706.5,8,21,0) +^^1^1^3070119^^ +"^DD",22706.5,22706.5,8,21,1,0) +This will be a pointer to the resulting, compiled entry in TMG FDA IMPORT COMPILED +"^DD",22706.5,22706.5,8,"DT") +3070119 +"^DD",22706.6,22706.6,0) +FIELD^^3^4 +"^DD",22706.6,22706.6,0,"DT") +3051125 +"^DD",22706.6,22706.6,0,"IX","B",22706.6,.01) + +"^DD",22706.6,22706.6,0,"NM","TMG FDA PACKAGES") + +"^DD",22706.6,22706.6,.01,0) +LISTING^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.6,22706.6,.01,1,0) +^.1 +"^DD",22706.6,22706.6,.01,1,1,0) +22706.6^B +"^DD",22706.6,22706.6,.01,1,1,1) +S ^TMG(22706.6,"B",$E(X,1,30),DA)="" +"^DD",22706.6,22706.6,.01,1,1,2) +K ^TMG(22706.6,"B",$E(X,1,30),DA) +"^DD",22706.6,22706.6,.01,3) +NAME MUST BE 3-30 CHARACTERS, NOT NUMERIC OR STARTING WITH PUNCTUATION +"^DD",22706.6,22706.6,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.6,22706.6,.01,21,1,0) +Linking field to LISTINGS. +"^DD",22706.6,22706.6,.01,"DT") +3051125 +"^DD",22706.6,22706.6,1,0) +CODE^F^^0;2^K:$L(X)>2!($L(X)<1) X +"^DD",22706.6,22706.6,1,3) +Answer must be 1-2 characters in length +"^DD",22706.6,22706.6,1,21,0) +^^2^2^3051125^^ +"^DD",22706.6,22706.6,1,21,1,0) +The package code portion of NDC code. The package code is the last segment +"^DD",22706.6,22706.6,1,21,2,0) +of the NDC. +"^DD",22706.6,22706.6,1,"DT") +3051125 +"^DD",22706.6,22706.6,2,0) +SIZE^RF^^0;3^K:$L(X)>25!($L(X)<1) X +"^DD",22706.6,22706.6,2,3) +Answer must be 1-25 characters in length +"^DD",22706.6,22706.6,2,21,0) +^^1^1^3051125^^ +"^DD",22706.6,22706.6,2,21,1,0) +The unit or number of units which make up a package. +"^DD",22706.6,22706.6,2,"DT") +3051125 +"^DD",22706.6,22706.6,3,0) +TYPE^RF^^0;4^K:$L(X)>25!($L(X)<1) X +"^DD",22706.6,22706.6,3,3) +Answer must be 1-25 characters in length +"^DD",22706.6,22706.6,3,21,0) +^^1^1^3051125^^ +"^DD",22706.6,22706.6,3,21,1,0) +Package type, i.e., box, bottle, vial, plastic, or glass. +"^DD",22706.6,22706.6,3,"DT") +3051125 +"^DD",22706.7,22706.7,0) +FIELD^^2^3 +"^DD",22706.7,22706.7,0,"DT") +3051125 +"^DD",22706.7,22706.7,0,"IX","B",22706.7,.01) + +"^DD",22706.7,22706.7,0,"NM","TMG FDA ROUTES") + +"^DD",22706.7,22706.7,.01,0) +LISTING^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.7,22706.7,.01,1,0) +^.1 +"^DD",22706.7,22706.7,.01,1,1,0) +22706.7^B +"^DD",22706.7,22706.7,.01,1,1,1) +S ^TMG(22706.7,"B",$E(X,1,30),DA)="" +"^DD",22706.7,22706.7,.01,1,1,2) +K ^TMG(22706.7,"B",$E(X,1,30),DA) +"^DD",22706.7,22706.7,.01,3) +Type a number between 1 and 9999999, 0 Decimal Digits +"^DD",22706.7,22706.7,.01,21,0) +^^1^1^3051125^^ +"^DD",22706.7,22706.7,.01,21,1,0) +Linking field to LISTINGS. +"^DD",22706.7,22706.7,.01,"DT") +3051125 +"^DD",22706.7,22706.7,1,0) +CODE^NJ3,0^^0;2^K:+X'=X!(X>999)!(X<1)!(X?.E1"."1.N) X +"^DD",22706.7,22706.7,1,3) +Type a number between 1 and 999, 0 Decimal Digits +"^DD",22706.7,22706.7,1,21,0) +^^2^2^3051125^^ +"^DD",22706.7,22706.7,1,21,1,0) +The code for the route of administration. File will allow all assigned +"^DD",22706.7,22706.7,1,21,2,0) +values for this element. +"^DD",22706.7,22706.7,1,"DT") +3051125 +"^DD",22706.7,22706.7,2,0) +NAME^F^^1;1^K:$L(X)>240!($L(X)<1) X +"^DD",22706.7,22706.7,2,3) +Answer must be 1-240 characters in length +"^DD",22706.7,22706.7,2,21,0) +^^1^1^3051125^^ +"^DD",22706.7,22706.7,2,21,1,0) +The translation for the route of administration code. +"^DD",22706.7,22706.7,2,"DT") +3051125 +"^DD",22706.8,22706.8,0) +FIELD^^2^3 +"^DD",22706.8,22706.8,0,"DDA") +N +"^DD",22706.8,22706.8,0,"DT") +3070226 +"^DD",22706.8,22706.8,0,"IX","B",22706.8,.01) + +"^DD",22706.8,22706.8,0,"NM","TMG FDA FORMS VISTA EQUIVALENTS") + +"^DD",22706.8,22706.8,.01,0) +FDA FORM^RF^^0;1^K:$L(X)>64!($L(X)<1) X +"^DD",22706.8,22706.8,.01,1,0) +^.1 +"^DD",22706.8,22706.8,.01,1,1,0) +22706.8^B +"^DD",22706.8,22706.8,.01,1,1,1) +S ^TMG(22706.8,"B",$E(X,1,30),DA)="" +"^DD",22706.8,22706.8,.01,1,1,2) +K ^TMG(22706.8,"B",$E(X,1,30),DA) +"^DD",22706.8,22706.8,.01,3) +Answer must be 1-64 characters in length +"^DD",22706.8,22706.8,.01,21,0) +^^1^1^3070121^^ +"^DD",22706.8,22706.8,.01,21,1,0) +This field will hold the FDA name for the Unit. +"^DD",22706.8,22706.8,.01,"DT") +3070127 +"^DD",22706.8,22706.8,1,0) +VISTA FORM^P50.606^PS(50.606,^0;2^Q +"^DD",22706.8,22706.8,1,3) +Answer must be 1-128 characters in length +"^DD",22706.8,22706.8,1,21,0) +^^2^2^3070121^^ +"^DD",22706.8,22706.8,1,21,1,0) +This field will hold a pointer to the entry in file 50.607 (DRUG UNITS) +"^DD",22706.8,22706.8,1,21,2,0) +which is the equivalent the the name in the .01 field. +"^DD",22706.8,22706.8,1,"DT") +3070126 +"^DD",22706.8,22706.8,2,0) +VISTA ROUTE^P51.2'^PS(51.2,^0;3^Q +"^DD",22706.8,22706.8,2,10) +0 +"^DD",22706.8,22706.8,2,21,0) +^^5^5^3070226^^ +"^DD",22706.8,22706.8,2,21,1,0) +This field will hold an associated ROUTE +"^DD",22706.8,22706.8,2,21,2,0) +that is appropriate for a given drug FORM. +"^DD",22706.8,22706.8,2,21,3,0) +E.g. +"^DD",22706.8,22706.8,2,21,4,0) +TAB --> PO +"^DD",22706.8,22706.8,2,21,5,0) +SUPP--> PR etc. +"^DD",22706.8,22706.8,2,"DT") +3070226 +"^DD",22706.82,22706.82,0) +FIELD^^1^2 +"^DD",22706.82,22706.82,0,"DT") +3070227 +"^DD",22706.82,22706.82,0,"IX","B",22706.82,.01) + +"^DD",22706.82,22706.82,0,"NM","TMG FDA ROUTES VISTA EQUIVALENTS") + +"^DD",22706.82,22706.82,.01,0) +FDA ROUTE^RF^^0;1^K:$L(X)>64!($L(X)<3) X +"^DD",22706.82,22706.82,.01,1,0) +^.1 +"^DD",22706.82,22706.82,.01,1,1,0) +22706.82^B +"^DD",22706.82,22706.82,.01,1,1,1) +S ^TMG(22706.82,"B",$E(X,1,30),DA)="" +"^DD",22706.82,22706.82,.01,1,1,2) +K ^TMG(22706.82,"B",$E(X,1,30),DA) +"^DD",22706.82,22706.82,.01,3) +Answer must be 3-64 characters in length +"^DD",22706.82,22706.82,.01,10) +1 +"^DD",22706.82,22706.82,.01,21,0) +^^1^1^3070227^^ +"^DD",22706.82,22706.82,.01,21,1,0) +This will store the ROUTE, as provided in the FDA database +"^DD",22706.82,22706.82,.01,"DT") +3070227 +"^DD",22706.82,22706.82,1,0) +VISTA ROUTE^P51.2'^PS(51.2,^0;2^Q +"^DD",22706.82,22706.82,1,10) +1 +"^DD",22706.82,22706.82,1,21,0) +^^2^2^3070227^^ +"^DD",22706.82,22706.82,1,21,1,0) +This will contain a pointer to the VA record containing +"^DD",22706.82,22706.82,1,21,2,0) +the equivalence for the FDA ROUTE. +"^DD",22706.82,22706.82,1,"DT") +3070227 +"^DD",22706.9,22706.9,0) +FIELD^^5.711^31 +"^DD",22706.9,22706.9,0,"DDA") +N +"^DD",22706.9,22706.9,0,"DT") +3071117 +"^DD",22706.9,22706.9,0,"IX","B",22706.9,.01) + +"^DD",22706.9,22706.9,0,"IX","C",22706.9,.05) + +"^DD",22706.9,22706.9,0,"IX","D",22706.9,.07) + +"^DD",22706.9,22706.9,0,"IX","DRUG",22706.9,5.7) + +"^DD",22706.9,22706.9,0,"IX","DRUGT",22706.9,5.6) + +"^DD",22706.9,22706.9,0,"IX","E",22706.9,.08) + +"^DD",22706.9,22706.9,0,"IX","LN",22706.9,.04) + +"^DD",22706.9,22706.9,0,"IX","NDC",22706.9,4) + +"^DD",22706.9,22706.9,0,"IX","NDC12",22706.9,5) + +"^DD",22706.9,22706.9,0,"IX","NDC2",22706.9,4) + +"^DD",22706.9,22706.9,0,"IX","OIG",22706.9,5.711) + +"^DD",22706.9,22706.9,0,"IX","OIT",22706.9,5.611) + +"^DD",22706.9,22706.9,0,"IX","POIG",22706.9,5.71) + +"^DD",22706.9,22706.9,0,"IX","POIT",22706.9,5.61) + +"^DD",22706.9,22706.9,0,"IX","ROUTE",22706.9,3) + +"^DD",22706.9,22706.9,0,"IX","SKIP",22706.9,6) + +"^DD",22706.9,22706.9,0,"IX","TMG",22706.916,.01) + +"^DD",22706.9,22706.9,0,"IX","VAP",22706.914,.01) + +"^DD",22706.9,22706.9,0,"IX","VAP1",22706.9,5.5) + +"^DD",22706.9,22706.9,0,"NM","TMG FDA IMPORT COMPILED") + +"^DD",22706.9,22706.9,0,"PT",22706.5,8) + +"^DD",22706.9,22706.9,.01,0) +TMG FDA LISTING ENTRY^RP22706.5'^TMG(22706.5,^0;1^Q +"^DD",22706.9,22706.9,.01,1,0) +^.1 +"^DD",22706.9,22706.9,.01,1,1,0) +22706.9^B +"^DD",22706.9,22706.9,.01,1,1,1) +S ^TMG(22706.9,"B",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,.01,1,1,2) +K ^TMG(22706.9,"B",$E(X,1,30),DA) +"^DD",22706.9,22706.9,.01,3) +Answer must be 3-60 characters in length +"^DD",22706.9,22706.9,.01,10) +1 +"^DD",22706.9,22706.9,.01,"DT") +3060318 +"^DD",22706.9,22706.9,.04,0) +LONG NAME^F^^7;6^K:$L(X)>63!($L(X)<3) X +"^DD",22706.9,22706.9,.04,1,0) +^.1 +"^DD",22706.9,22706.9,.04,1,1,0) +22706.9^LN +"^DD",22706.9,22706.9,.04,1,1,1) +S ^TMG(22706.9,"LN",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,.04,1,1,2) +K ^TMG(22706.9,"LN",$E(X,1,30),DA) +"^DD",22706.9,22706.9,.04,1,1,"DT") +3071015 +"^DD",22706.9,22706.9,.04,3) +Answer must be 3-63 characters in length +"^DD",22706.9,22706.9,.04,10) +7 +"^DD",22706.9,22706.9,.04,21,0) +^^2^2^3070225^^ +"^DD",22706.9,22706.9,.04,21,1,0) +This will be a full name in this format: +"^DD",22706.9,22706.9,.04,21,2,0) + Generic Name (Trade Name) Strength Units +"^DD",22706.9,22706.9,.04,"DT") +3071015 +"^DD",22706.9,22706.9,.05,0) +TRADENAME^F^^0;4^K:$L(X)>64!($L(X)<2) X +"^DD",22706.9,22706.9,.05,1,0) +^.1^^-1 +"^DD",22706.9,22706.9,.05,1,1,0) +22706.9^C +"^DD",22706.9,22706.9,.05,1,1,1) +S ^TMG(22706.9,"C",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,.05,1,1,2) +K ^TMG(22706.9,"C",$E(X,1,30),DA) +"^DD",22706.9,22706.9,.05,1,1,"DT") +3060325 +"^DD",22706.9,22706.9,.05,3) +Answer must be 2-64 characters in length +"^DD",22706.9,22706.9,.05,"DT") +3070114 +"^DD",22706.9,22706.9,.055,0) +TRADE NAME & FORM - 40^F^^7;3^K:$L(X)>40!($L(X)<3) X +"^DD",22706.9,22706.9,.055,3) +Answer must be 3-40 characters in length +"^DD",22706.9,22706.9,.055,10) +7 +"^DD",22706.9,22706.9,.055,21,0) +^^21^21^3070224^^ +"^DD",22706.9,22706.9,.055,21,1,0) +The tradename stored in field .05 has a length limit of 64 characters. +"^DD",22706.9,22706.9,.055,21,2,0) +However, this name must ultimately be used in other files that have +"^DD",22706.9,22706.9,.055,21,3,0) +shorter field lengths. For example, here are the field lengths +"^DD",22706.9,22706.9,.055,21,4,0) +of other fields that this tradename will be used to populate: +"^DD",22706.9,22706.9,.055,21,5,0) + +"^DD",22706.9,22706.9,.055,21,6,0) +DRUG file 50, .01 -- GENERIC NAME field length=1-40 +"^DD",22706.9,22706.9,.055,21,7,0) +DRUG file 50, 21 -- VA PRODUCT NAME field length=1-70 +"^DD",22706.9,22706.9,.055,21,8,0) +DRUG file 50, 9:.01 -- SYNONYM field length=1-40 +"^DD",22706.9,22706.9,.055,21,9,0) +VA PRODUCT file 50.68, .01 -- NAME field length=3-64 +"^DD",22706.9,22706.9,.055,21,10,0) +VA PRODUCT file 50.68, 5 -- VA PRINT NAME field length=1-40 +"^DD",22706.9,22706.9,.055,21,11,0) +PHARMACY ORDERABLE ITEM file 50.7, .01 -- NAME field length=3-40 +"^DD",22706.9,22706.9,.055,21,12,0) +ORDERABLE ITEM file 101.43, .01 -- NAME field length=3-63 +"^DD",22706.9,22706.9,.055,21,13,0) + +"^DD",22706.9,22706.9,.055,21,14,0) +So it is helpful to prepare a shorter version of the name and store it for +"^DD",22706.9,22706.9,.055,21,15,0) +future use. +"^DD",22706.9,22706.9,.055,21,16,0) + +"^DD",22706.9,22706.9,.055,21,17,0) +This field will store a version of the name that is 40 characters in length. +"^DD",22706.9,22706.9,.055,21,18,0) + +"^DD",22706.9,22706.9,.055,21,19,0) +NOTE: This name will be comprised of Tradename, Strength, and Units. +"^DD",22706.9,22706.9,.055,21,20,0) + This is different from field .05 TRADENAME, which is supposed +"^DD",22706.9,22706.9,.055,21,21,0) + to contain just the name. +"^DD",22706.9,22706.9,.055,"DT") +3070306 +"^DD",22706.9,22706.9,.056,0) +TRADENAME FORM DOSE UNIT - 40^F^^8;1^K:$L(X)>40!($L(X)<3) X +"^DD",22706.9,22706.9,.056,3) +Answer must be 3-40 characters in length. +"^DD",22706.9,22706.9,.056,21,0) +^^2^2^3071105^^ +"^DD",22706.9,22706.9,.056,21,1,0) +This name will be used to populate the .01 field of DRUG file entries. +"^DD",22706.9,22706.9,.056,21,2,0) +It should consist of TradeName Dose Units Form, and be 3-40 chars long. +"^DD",22706.9,22706.9,.056,"DT") +3071106 +"^DD",22706.9,22706.9,.07,0) +GENERIC NAME^F^^0;6^K:$L(X)>64!($L(X)<3) X +"^DD",22706.9,22706.9,.07,1,0) +^.1 +"^DD",22706.9,22706.9,.07,1,1,0) +22706.9^D +"^DD",22706.9,22706.9,.07,1,1,1) +S ^TMG(22706.9,"D",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,.07,1,1,2) +K ^TMG(22706.9,"D",$E(X,1,30),DA) +"^DD",22706.9,22706.9,.07,1,1,"DT") +3060530 +"^DD",22706.9,22706.9,.07,3) +Answer must be 3-64 characters in length +"^DD",22706.9,22706.9,.07,"DT") +3070224 +"^DD",22706.9,22706.9,.075,0) +GENERIC NAME & FORM - 40^F^^7;4^K:$L(X)>40!($L(X)<3) X +"^DD",22706.9,22706.9,.075,3) +Answer must be 3-40 characters in length +"^DD",22706.9,22706.9,.075,10) +7 +"^DD",22706.9,22706.9,.075,21,0) +^^22^22^3070224^^ +"^DD",22706.9,22706.9,.075,21,1,0) +The GENERIC NAME stored in field .07 has a length limit of 64 characters. +"^DD",22706.9,22706.9,.075,21,2,0) +However, this name must ultimately be used in other files that have +"^DD",22706.9,22706.9,.075,21,3,0) +shorter field lengths. For example, here are the field lengths +"^DD",22706.9,22706.9,.075,21,4,0) +of other fields that this tradename will be used to populate: +"^DD",22706.9,22706.9,.075,21,5,0) + +"^DD",22706.9,22706.9,.075,21,6,0) +DRUG file 50, .01 -- GENERIC NAME field length=1-40 +"^DD",22706.9,22706.9,.075,21,7,0) +DRUG file 50, 21 -- VA PRODUCT NAME field length=1-70 +"^DD",22706.9,22706.9,.075,21,8,0) +DRUG file 50, 9:.01 -- SYNONYM field length=1-40 +"^DD",22706.9,22706.9,.075,21,9,0) +VA PRODUCT file 50.68, .01 -- NAME field length=3-64 +"^DD",22706.9,22706.9,.075,21,10,0) +VA PRODUCT file 50.68, 5 -- VA PRINT NAME field length=1-40 +"^DD",22706.9,22706.9,.075,21,11,0) +PHARMACY ORDERABLE ITEM file 50.7, .01 -- NAME field length=3-40 +"^DD",22706.9,22706.9,.075,21,12,0) +ORDERABLE ITEM file 101.43, .01 -- NAME field length=3-63 +"^DD",22706.9,22706.9,.075,21,13,0) + +"^DD",22706.9,22706.9,.075,21,14,0) +So it is helpful to prepare a shorter version of the name and store it for +"^DD",22706.9,22706.9,.075,21,15,0) +future use. +"^DD",22706.9,22706.9,.075,21,16,0) + +"^DD",22706.9,22706.9,.075,21,17,0) +This field will store a version of the name that is 40 characters in length. +"^DD",22706.9,22706.9,.075,21,18,0) + +"^DD",22706.9,22706.9,.075,21,19,0) +NOTE: This name will be comprised of Generic name, Strength, and Units. +"^DD",22706.9,22706.9,.075,21,20,0) + This is different from field .07 GENERIC NAME, which is supposed +"^DD",22706.9,22706.9,.075,21,21,0) + to contain just the name. +"^DD",22706.9,22706.9,.075,21,22,0) + +"^DD",22706.9,22706.9,.075,"DT") +3070306 +"^DD",22706.9,22706.9,.076,0) +GENERICNAME FORM DOSE UNT - 40^F^^8;2^K:$L(X)>40!($L(X)<3) X +"^DD",22706.9,22706.9,.076,3) +Answer must be 3-40 characters in length. +"^DD",22706.9,22706.9,.076,21,0) +^^3^3^3071105^^ +"^DD",22706.9,22706.9,.076,21,1,0) +This will be used to fill the .01 field of DRUG file entries. +"^DD",22706.9,22706.9,.076,21,2,0) +It should consist of the Generic Name, dose strengh, units, form. +"^DD",22706.9,22706.9,.076,21,3,0) +It should be 3-40 characters in length. +"^DD",22706.9,22706.9,.076,"DT") +3071105 +"^DD",22706.9,22706.9,.08,0) +VA GENERIC^P50.6'^PSNDF(50.6,^1;3^Q +"^DD",22706.9,22706.9,.08,1,0) +^.1 +"^DD",22706.9,22706.9,.08,1,1,0) +22706.9^E +"^DD",22706.9,22706.9,.08,1,1,1) +S ^TMG(22706.9,"E",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,.08,1,1,2) +K ^TMG(22706.9,"E",$E(X,1,30),DA) +"^DD",22706.9,22706.9,.08,1,1,"DT") +3060530 +"^DD",22706.9,22706.9,.08,"DT") +3060530 +"^DD",22706.9,22706.9,.09,0) +VA DRUG CLASS^P50.605'^PS(50.605,^1;5^Q +"^DD",22706.9,22706.9,.09,"DT") +3060416 +"^DD",22706.9,22706.9,1,0) +STRENGTH^F^^0;2^K:$L(X)>32!($L(X)<1) X +"^DD",22706.9,22706.9,1,3) +Answer must be 1-32 characters in length +"^DD",22706.9,22706.9,1,"DT") +3060318 +"^DD",22706.9,22706.9,2,0) +UNIT^F^^0;3^K:$L(X)>32!($L(X)<1) X +"^DD",22706.9,22706.9,2,3) +Answer must be 1-32 characters in length +"^DD",22706.9,22706.9,2,"DT") +3060322 +"^DD",22706.9,22706.9,3,0) +FDA ROUTE^F^^0;5^K:$L(X)>16!($L(X)<2) X +"^DD",22706.9,22706.9,3,1,0) +^.1 +"^DD",22706.9,22706.9,3,1,1,0) +22706.9^ROUTE +"^DD",22706.9,22706.9,3,1,1,1) +S ^TMG(22706.9,"ROUTE",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,3,1,1,2) +K ^TMG(22706.9,"ROUTE",$E(X,1,30),DA) +"^DD",22706.9,22706.9,3,1,1,"DT") +3070227 +"^DD",22706.9,22706.9,3,3) +Answer must be 2-16 characters in length +"^DD",22706.9,22706.9,3,"DT") +3070227 +"^DD",22706.9,22706.9,3.1,0) +VA ROUTE^P51.2'^PS(51.2,^7;7^Q +"^DD",22706.9,22706.9,3.1,21,0) +^^1^1^3070227^^ +"^DD",22706.9,22706.9,3.1,21,1,0) +This will contain a pointer to the equivalent ROUTE in the VA system. +"^DD",22706.9,22706.9,3.1,"DT") +3070227 +"^DD",22706.9,22706.9,3.4,0) +FDA DOSAGE FORM^F^^6;1^K:$L(X)>240!($L(X)<1) X +"^DD",22706.9,22706.9,3.4,3) +Answer must be 1-240 characters in length +"^DD",22706.9,22706.9,3.4,21,0) +^^1^1^3070127^^ +"^DD",22706.9,22706.9,3.4,21,1,0) +This will be the text for the dosage form, as provided by the FDA database. +"^DD",22706.9,22706.9,3.4,"DT") +3070127 +"^DD",22706.9,22706.9,3.5,0) +VA DOSAGE FORM^P50.606^PS(50.606,^0;7^Q +"^DD",22706.9,22706.9,3.5,"DT") +3070227 +"^DD",22706.9,22706.9,4,0) +NDC^F^^1;1^K:$L(X)>14!($L(X)<12) X +"^DD",22706.9,22706.9,4,1,0) +^.1 +"^DD",22706.9,22706.9,4,1,1,0) +22706.9^NDC +"^DD",22706.9,22706.9,4,1,1,1) +S ^TMG(22706.9,"NDC",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,4,1,1,2) +K ^TMG(22706.9,"NDC",$E(X,1,30),DA) +"^DD",22706.9,22706.9,4,1,1,"%D",0) +^^3^3^3060318^^ +"^DD",22706.9,22706.9,4,1,1,"%D",1,0) +This is an index based on NDC (National drug code), with format like this: +"^DD",22706.9,22706.9,4,1,1,"%D",2,0) + +"^DD",22706.9,22706.9,4,1,1,"%D",3,0) +Producer/Packager-Product Code-Package Code +"^DD",22706.9,22706.9,4,1,1,"DT") +3060318 +"^DD",22706.9,22706.9,4,1,2,0) +22706.9^NDC2 +"^DD",22706.9,22706.9,4,1,2,1) +S X=$TR(X,"-","") S ^TMG(22706.9,"NDC2",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,4,1,2,2) +K ^TMG(22706.9,"NDC2",$E(X,1,30),DA) +"^DD",22706.9,22706.9,4,1,2,"%D",0) +^^1^1^3061207^^ +"^DD",22706.9,22706.9,4,1,2,"%D",1,0) +This index is of the NDC (national drug code) with hyphens removed. +"^DD",22706.9,22706.9,4,1,2,"DT") +3061207 +"^DD",22706.9,22706.9,4,3) +Answer must be 12-14 characters in length +"^DD",22706.9,22706.9,4,"DT") +3061207 +"^DD",22706.9,22706.9,5,0) +NDC 12-DIGIT^F^^1;2^K:$L(X)>12!($L(X)<12) X +"^DD",22706.9,22706.9,5,1,0) +^.1 +"^DD",22706.9,22706.9,5,1,1,0) +22706.9^NDC12 +"^DD",22706.9,22706.9,5,1,1,1) +S ^TMG(22706.9,"NDC12",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5,1,1,2) +K ^TMG(22706.9,"NDC12",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5,1,1,"%D",0) +^^1^1^3060318^^ +"^DD",22706.9,22706.9,5,1,1,"%D",1,0) +This is an index on the 12digit format of the National Drug Code +"^DD",22706.9,22706.9,5,1,1,"DT") +3060318 +"^DD",22706.9,22706.9,5,3) +Answer must be 12 characters in length +"^DD",22706.9,22706.9,5,"DT") +3060318 +"^DD",22706.9,22706.9,5.5,0) +VA PRODUCT LINK^P50.68'^PSNDF(50.68,^6;2^Q +"^DD",22706.9,22706.9,5.5,1,0) +^.1 +"^DD",22706.9,22706.9,5.5,1,1,0) +22706.9^VAP1 +"^DD",22706.9,22706.9,5.5,1,1,1) +S ^TMG(22706.9,"VAP1",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.5,1,1,2) +K ^TMG(22706.9,"VAP1",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.5,1,1,"DT") +3070217 +"^DD",22706.9,22706.9,5.5,10) +18 +"^DD",22706.9,22706.9,5.5,21,0) +^.001^2^2^3070211^^^ +"^DD",22706.9,22706.9,5.5,21,1,0) +This will hold a pointer to an entry in the VA PRODUCT file +"^DD",22706.9,22706.9,5.5,21,2,0) +that has the same national drug code (NDC) +"^DD",22706.9,22706.9,5.5,"DT") +3070217 +"^DD",22706.9,22706.9,5.6,0) +DRUG TRADENAME LINK^P50'^PSDRUG(^7;1^Q +"^DD",22706.9,22706.9,5.6,1,0) +^.1^^-1 +"^DD",22706.9,22706.9,5.6,1,1,0) +22706.9^DRUGT +"^DD",22706.9,22706.9,5.6,1,1,1) +S ^TMG(22706.9,"DRUGT",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.6,1,1,2) +K ^TMG(22706.9,"DRUGT",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.6,1,1,"DT") +3070217 +"^DD",22706.9,22706.9,5.6,10) +63 +"^DD",22706.9,22706.9,5.6,21,0) +^^24^24^3070217^^ +"^DD",22706.9,22706.9,5.6,21,1,0) +This will contain a link the entry in the DRUG file that contains +"^DD",22706.9,22706.9,5.6,21,2,0) +the Trade name of a drug. +"^DD",22706.9,22706.9,5.6,21,3,0) + +"^DD",22706.9,22706.9,5.6,21,4,0) +A given entry in TMG FDA IMPORT COMPILED will generate TWO entries in +"^DD",22706.9,22706.9,5.6,21,5,0) +the DRUG file, one with a name of the Trade name, and one with a name +"^DD",22706.9,22706.9,5.6,21,6,0) +of the Generic name. +"^DD",22706.9,22706.9,5.6,21,7,0) + +"^DD",22706.9,22706.9,5.6,21,8,0) +It is the name stored in the .01 field (the 'GENERIC NAME' field) that +"^DD",22706.9,22706.9,5.6,21,9,0) +is considered the true name of a drug entry. The standard way that +"^DD",22706.9,22706.9,5.6,21,10,0) +drugs are entered in the VA is to put the generic name in the .01 field +"^DD",22706.9,22706.9,5.6,21,11,0) +and then put the brand name in the SYNONYM field. Then, in CPRS, both +"^DD",22706.9,22706.9,5.6,21,12,0) +the .01 field, and also any synonyms are displayed. But when one +"^DD",22706.9,22706.9,5.6,21,13,0) +views the drug, to pick the strength and requency, then it is the +"^DD",22706.9,22706.9,5.6,21,14,0) +generic name this is display. And I assume that this generic name is +"^DD",22706.9,22706.9,5.6,21,15,0) +what will be printed out. +"^DD",22706.9,22706.9,5.6,21,16,0) + +"^DD",22706.9,22706.9,5.6,21,17,0) +For example, if one wants to create a prescription for ZOCOR, it would +"^DD",22706.9,22706.9,5.6,21,18,0) +normally come out as SIMVASTATIN. +"^DD",22706.9,22706.9,5.6,21,19,0) + +"^DD",22706.9,22706.9,5.6,21,20,0) +To overcome this, drugs will be entered differently than is done at the VA. +"^DD",22706.9,22706.9,5.6,21,21,0) +A drug entry will be created for both ZOCOR and SIMVASTATIN. +"^DD",22706.9,22706.9,5.6,21,22,0) + +"^DD",22706.9,22706.9,5.6,21,23,0) +Field 5.6 will contain a link to the DRUG record containing the trade name. +"^DD",22706.9,22706.9,5.6,21,24,0) +Field 5.7 will contain a link to the DRUG record containing the brand name. +"^DD",22706.9,22706.9,5.6,"DT") +3071104 +"^DD",22706.9,22706.9,5.61,0) +POI TRADENAME LINK^P50.7'^PS(50.7,^8;3^Q +"^DD",22706.9,22706.9,5.61,1,0) +^.1 +"^DD",22706.9,22706.9,5.61,1,1,0) +22706.9^POIT +"^DD",22706.9,22706.9,5.61,1,1,1) +S ^TMG(22706.9,"POIT",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.61,1,1,2) +K ^TMG(22706.9,"POIT",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.61,1,1,"%D",0) +^^2^2^3071118^^ +"^DD",22706.9,22706.9,5.61,1,1,"%D",1,0) +This cross references the pointer to the PHARMACY +"^DD",22706.9,22706.9,5.61,1,1,"%D",2,0) +ORDERABLE ITEM FILE (#50.7) for Trade name drugs. +"^DD",22706.9,22706.9,5.61,1,1,"DT") +3071118 +"^DD",22706.9,22706.9,5.61,21,0) +^^1^1^3071117^^ +"^DD",22706.9,22706.9,5.61,21,1,0) +This will contain a pointer to the PHARMACY ORDERABLE ITEM used for this record. +"^DD",22706.9,22706.9,5.61,"DT") +3071118 +"^DD",22706.9,22706.9,5.611,0) +OI TRADENAME LINK^P101.43'^ORD(101.43,^8;5^Q +"^DD",22706.9,22706.9,5.611,1,0) +^.1 +"^DD",22706.9,22706.9,5.611,1,1,0) +22706.9^OIT +"^DD",22706.9,22706.9,5.611,1,1,1) +S ^TMG(22706.9,"OIT",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.611,1,1,2) +K ^TMG(22706.9,"OIT",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.611,1,1,"%D",0) +^^2^2^3071118^^ +"^DD",22706.9,22706.9,5.611,1,1,"%D",1,0) +This is a cross reference of the ORDERABLE ITEM to be used +"^DD",22706.9,22706.9,5.611,1,1,"%D",2,0) +for this record. +"^DD",22706.9,22706.9,5.611,1,1,"DT") +3071118 +"^DD",22706.9,22706.9,5.611,"DT") +3071118 +"^DD",22706.9,22706.9,5.7,0) +DRUG GENERIC LINK^P50'^PSDRUG(^7;2^Q +"^DD",22706.9,22706.9,5.7,1,0) +^.1^^-1 +"^DD",22706.9,22706.9,5.7,1,1,0) +22706.9^DRUG +"^DD",22706.9,22706.9,5.7,1,1,1) +S ^TMG(22706.9,"DRUG",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.7,1,1,2) +K ^TMG(22706.9,"DRUG",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.7,1,1,"DT") +3070217 +"^DD",22706.9,22706.9,5.7,10) +7 +"^DD",22706.9,22706.9,5.7,21,0) +^^24^24^3070217^^ +"^DD",22706.9,22706.9,5.7,21,1,0) +This will contain a link the entry in the DRUG file that contains +"^DD",22706.9,22706.9,5.7,21,2,0) +the Generic name of a drug. +"^DD",22706.9,22706.9,5.7,21,3,0) + +"^DD",22706.9,22706.9,5.7,21,4,0) +A given entry in TMG FDA IMPORT COMPILED will generate TWO entries in +"^DD",22706.9,22706.9,5.7,21,5,0) +the DRUG file, one with a name of the Trade name, and one with a name +"^DD",22706.9,22706.9,5.7,21,6,0) +of the Generic name. +"^DD",22706.9,22706.9,5.7,21,7,0) + +"^DD",22706.9,22706.9,5.7,21,8,0) +It is the name stored in the .01 field (the 'GENERIC NAME' field) that +"^DD",22706.9,22706.9,5.7,21,9,0) +is considered the true name of a drug entry. The standard way that +"^DD",22706.9,22706.9,5.7,21,10,0) +drugs are entered in the VA is to put the generic name in the .01 field +"^DD",22706.9,22706.9,5.7,21,11,0) +and then put the brand name in the SYNONYM field. Then, in CPRS, both +"^DD",22706.9,22706.9,5.7,21,12,0) +the .01 field, and also any synonyms are displayed. But when one +"^DD",22706.9,22706.9,5.7,21,13,0) +views the drug, to pick the strength and requency, then it is the +"^DD",22706.9,22706.9,5.7,21,14,0) +generic name this is display. And I assume that this generic name is +"^DD",22706.9,22706.9,5.7,21,15,0) +what will be printed out. +"^DD",22706.9,22706.9,5.7,21,16,0) + +"^DD",22706.9,22706.9,5.7,21,17,0) +For example, if one wants to create a prescription for ZOCOR, it would +"^DD",22706.9,22706.9,5.7,21,18,0) +normally come out as SIMVASTATIN. +"^DD",22706.9,22706.9,5.7,21,19,0) + +"^DD",22706.9,22706.9,5.7,21,20,0) +To overcome this, drugs will be entered differently than is done at the VA. +"^DD",22706.9,22706.9,5.7,21,21,0) +A drug entry will be created for both ZOCOR and SIMVASTATIN. +"^DD",22706.9,22706.9,5.7,21,22,0) + +"^DD",22706.9,22706.9,5.7,21,23,0) +Field 5.6 will contain a link to the DRUG record containing the trade name. +"^DD",22706.9,22706.9,5.7,21,24,0) +Field 5.7 will contain a link to the DRUG record containing the brand name. +"^DD",22706.9,22706.9,5.7,"DT") +3071104 +"^DD",22706.9,22706.9,5.71,0) +POI GENERIC LINK^P50.7'^PS(50.7,^8;4^Q +"^DD",22706.9,22706.9,5.71,1,0) +^.1 +"^DD",22706.9,22706.9,5.71,1,1,0) +22706.9^POIG +"^DD",22706.9,22706.9,5.71,1,1,1) +S ^TMG(22706.9,"POIG",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.71,1,1,2) +K ^TMG(22706.9,"POIG",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.71,1,1,"%D",0) +^^2^2^3071118^^ +"^DD",22706.9,22706.9,5.71,1,1,"%D",1,0) +This will cross reference pointers to the PHARMACY +"^DD",22706.9,22706.9,5.71,1,1,"%D",2,0) +ORDERABLE ITEM file (#50.7) for Generic name drugs. +"^DD",22706.9,22706.9,5.71,1,1,"DT") +3071118 +"^DD",22706.9,22706.9,5.71,21,0) +^^1^1^3071117^^ +"^DD",22706.9,22706.9,5.71,21,1,0) +This will be a link to the PHARMACY ORDERABLE ITEM uses for this record +"^DD",22706.9,22706.9,5.71,"DT") +3071118 +"^DD",22706.9,22706.9,5.711,0) +OI GENERIC LINK^P101.43'^ORD(101.43,^8;6^Q +"^DD",22706.9,22706.9,5.711,1,0) +^.1 +"^DD",22706.9,22706.9,5.711,1,1,0) +22706.9^OIG +"^DD",22706.9,22706.9,5.711,1,1,1) +S ^TMG(22706.9,"OIG",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,5.711,1,1,2) +K ^TMG(22706.9,"OIG",$E(X,1,30),DA) +"^DD",22706.9,22706.9,5.711,1,1,"%D",0) +^^2^2^3071118^^ +"^DD",22706.9,22706.9,5.711,1,1,"%D",1,0) +This is the cross refernce of the ORDERABLE item to be used +"^DD",22706.9,22706.9,5.711,1,1,"%D",2,0) +for this record, for Generic name drugs. +"^DD",22706.9,22706.9,5.711,1,1,"DT") +3071118 +"^DD",22706.9,22706.9,5.711,"DT") +3071118 +"^DD",22706.9,22706.9,6,0) +SKIP THIS RECORD^S^1:SKIP;0:KEEP;^1;4^Q +"^DD",22706.9,22706.9,6,1,0) +^.1 +"^DD",22706.9,22706.9,6,1,1,0) +22706.9^SKIP +"^DD",22706.9,22706.9,6,1,1,1) +S ^TMG(22706.9,"SKIP",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9,6,1,1,2) +K ^TMG(22706.9,"SKIP",$E(X,1,30),DA) +"^DD",22706.9,22706.9,6,1,1,"%D",0) +^^2^2^3070301^^ +"^DD",22706.9,22706.9,6,1,1,"%D",1,0) +This will be a cross reference of all the +"^DD",22706.9,22706.9,6,1,1,"%D",2,0) +records on the SKIP THIS RECORD field. +"^DD",22706.9,22706.9,6,1,1,"DT") +3070301 +"^DD",22706.9,22706.9,6,"DT") +3070301 +"^DD",22706.9,22706.9,7,0) +RX OR OTC^S^R:RX;O:OTC;^7;5^Q +"^DD",22706.9,22706.9,7,10) +7 +"^DD",22706.9,22706.9,7,21,0) +^^4^4^3070225^^ +"^DD",22706.9,22706.9,7,21,1,0) +If a drug is available over the counter (without a prescription) it should +"^DD",22706.9,22706.9,7,21,2,0) +be marked as OTC (code O). +"^DD",22706.9,22706.9,7,21,3,0) + +"^DD",22706.9,22706.9,7,21,4,0) +If a prescription is required, it should be marked as RX (code R) +"^DD",22706.9,22706.9,7,"DT") +3070225 +"^DD",22706.9,22706.9,14,0) +VA PRODUCT SIMILAR MATCHES^22706.914P^^2;0 +"^DD",22706.9,22706.9,14,21,0) +^^10^10^3070211^^ +"^DD",22706.9,22706.9,14,21,1,0) +This field will hold pointers to entries in the VA PRODUCT file +"^DD",22706.9,22706.9,14,21,2,0) +that have similar ingredients and doses etc. I.e. these are +"^DD",22706.9,22706.9,14,21,3,0) +the closest matches that the algorhythm can find. +"^DD",22706.9,22706.9,14,21,4,0) + +"^DD",22706.9,22706.9,14,21,5,0) +However, it is intended that this list will NOT hold the pointer +"^DD",22706.9,22706.9,14,21,6,0) +to the EXACT match, i.e. the one that has the same national drug +"^DD",22706.9,22706.9,14,21,7,0) +code (NDC). A separate field will hold that link. +"^DD",22706.9,22706.9,14,21,8,0) + +"^DD",22706.9,22706.9,14,21,9,0) +Essentially this field holds a one-to-many linkage between this +"^DD",22706.9,22706.9,14,21,10,0) +import from the FDA database and entries in the VA PRODUCT file. +"^DD",22706.9,22706.9,14,"DT") +3070211 +"^DD",22706.9,22706.9,15,0) +VA PRODUCT POSSIBLE MATCHES^22706.915P^^3;0 +"^DD",22706.9,22706.9,15,21,0) +^^10^10^3070211^^ +"^DD",22706.9,22706.9,15,21,1,0) +This field will hold linkages to entries in the VA PRODUCT file that +"^DD",22706.9,22706.9,15,21,2,0) +have some similarities to the FDA import, but differ in some way. +"^DD",22706.9,22706.9,15,21,3,0) + +"^DD",22706.9,22706.9,15,21,4,0) +Sometimes the algorhythm works well and these entries are actually +"^DD",22706.9,22706.9,15,21,5,0) +a close match. Other times it is completely wrong. For example, +"^DD",22706.9,22706.9,15,21,6,0) +it might include an entry here because both contain SODIUM CHLORIDE +"^DD",22706.9,22706.9,15,21,7,0) +and overlook that the major ingredients are different. +"^DD",22706.9,22706.9,15,21,8,0) + +"^DD",22706.9,22706.9,15,21,9,0) +So the links in this field should not be used for any automatic +"^DD",22706.9,22706.9,15,21,10,0) +filling of missing data without human intervention. +"^DD",22706.9,22706.9,15,"DT") +3070211 +"^DD",22706.9,22706.9,16,0) +INGREDIENTS^22706.916^^4;0 +"^DD",22706.9,22706.9,20,0) +COMMENT^22706.9001^^5;0 +"^DD",22706.9,22706.9001,0) +COMMENT SUB-FIELD^^1^2 +"^DD",22706.9,22706.9001,0,"DT") +3070119 +"^DD",22706.9,22706.9001,0,"IX","B",22706.9001,.01) + +"^DD",22706.9,22706.9001,0,"NM","COMMENT") + +"^DD",22706.9,22706.9001,0,"UP") +22706.9 +"^DD",22706.9,22706.9001,.01,0) +COMMENT^F^^0;1^K:$L(X)>200!($L(X)<1) X +"^DD",22706.9,22706.9001,.01,1,0) +^.1 +"^DD",22706.9,22706.9001,.01,1,1,0) +22706.9001^B +"^DD",22706.9,22706.9001,.01,1,1,1) +S ^TMG(22706.9,DA(1),5,"B",$E(X,1,30),DA)="" +"^DD",22706.9,22706.9001,.01,1,1,2) +K ^TMG(22706.9,DA(1),5,"B",$E(X,1,30),DA) +"^DD",22706.9,22706.9001,.01,3) +Answer must be 1-200 characters in length +"^DD",22706.9,22706.9001,.01,21,0) +^^1^1^3070119^^ +"^DD",22706.9,22706.9001,.01,21,1,0) +This will be used to store 1 line comments about record +"^DD",22706.9,22706.9001,.01,23,0) +^^2^2^3070119^^ +"^DD",22706.9,22706.9001,.01,23,1,0) +This field may be 1-200 characters long. It can store comments about when +"^DD",22706.9,22706.9001,.01,23,2,0) +field was edited, and why etc. +"^DD",22706.9,22706.9001,.01,"DT") +3070119 +"^DD",22706.9,22706.9001,1,0) +DATE^D^^0;2^S %DT="E" D ^%DT S X=Y K:X<1 X +"^DD",22706.9,22706.9001,1,3) +(No range limit on date) +"^DD",22706.9,22706.9001,1,21,0) +^^1^1^3070119^^ +"^DD",22706.9,22706.9001,1,21,1,0) +This is the date for the comment. +"^DD",22706.9,22706.9001,1,"DT") +3070119 +"^DD",22706.9,22706.914,0) +VA PRODUCT SIMILAR MATCHES SUB-FIELD^^.01^1 +"^DD",22706.9,22706.914,0,"DT") +3060318 +"^DD",22706.9,22706.914,0,"IX","B",22706.914,.01) + +"^DD",22706.9,22706.914,0,"NM","VA PRODUCT SIMILAR MATCHES") + +"^DD",22706.9,22706.914,0,"UP") +22706.9 +"^DD",22706.9,22706.914,.01,0) +ONE MATCH^P50.68'^PSNDF(50.68,^0;1^Q +"^DD",22706.9,22706.914,.01,1,0) +^.1^^-1 +"^DD",22706.9,22706.914,.01,1,1,0) +22706.914^B +"^DD",22706.9,22706.914,.01,1,1,1) +S ^TMG(22706.9,DA(1),2,"B",$E(X,1,30),DA)="" +"^DD",22706.9,22706.914,.01,1,1,2) +K ^TMG(22706.9,DA(1),2,"B",$E(X,1,30),DA) +"^DD",22706.9,22706.914,.01,1,2,0) +22706.9^VAP +"^DD",22706.9,22706.914,.01,1,2,1) +S ^TMG(22706.9,"VAP",$E(X,1,30),DA(1),DA)="" +"^DD",22706.9,22706.914,.01,1,2,2) +K ^TMG(22706.9,"VAP",$E(X,1,30),DA(1),DA) +"^DD",22706.9,22706.914,.01,1,2,"%D",0) +^^2^2^3060921^^ +"^DD",22706.9,22706.914,.01,1,2,"%D",1,0) +This is a cross reference between records in TMG FDA IMPORT COMPILED +"^DD",22706.9,22706.914,.01,1,2,"%D",2,0) +(the data from the FDA database) and records in the VA PRODUCT file +"^DD",22706.9,22706.914,.01,1,2,"DT") +3060921 +"^DD",22706.9,22706.914,.01,"DT") +3061120 +"^DD",22706.9,22706.915,0) +VA PRODUCT POSSIBLE MATCHES SUB-FIELD^^.01^1 +"^DD",22706.9,22706.915,0,"DT") +3060318 +"^DD",22706.9,22706.915,0,"IX","B",22706.915,.01) + +"^DD",22706.9,22706.915,0,"NM","VA PRODUCT POSSIBLE MATCHES") + +"^DD",22706.9,22706.915,0,"UP") +22706.9 +"^DD",22706.9,22706.915,.01,0) +POSS MATCH^P50.68'^PSNDF(50.68,^0;1^Q +"^DD",22706.9,22706.915,.01,1,0) +^.1 +"^DD",22706.9,22706.915,.01,1,1,0) +22706.915^B +"^DD",22706.9,22706.915,.01,1,1,1) +S ^TMG(22706.9,DA(1),3,"B",$E(X,1,30),DA)="" +"^DD",22706.9,22706.915,.01,1,1,2) +K ^TMG(22706.9,DA(1),3,"B",$E(X,1,30),DA) +"^DD",22706.9,22706.915,.01,"DT") +3060324 +"^DD",22706.9,22706.916,0) +INGREDIENTS SUB-FIELD^^5^4 +"^DD",22706.9,22706.916,0,"DT") +3060318 +"^DD",22706.9,22706.916,0,"IX","B",22706.916,.01) + +"^DD",22706.9,22706.916,0,"IX","C",22706.916,2) + +"^DD",22706.9,22706.916,0,"NM","INGREDIENTS") + +"^DD",22706.9,22706.916,0,"UP") +22706.9 +"^DD",22706.9,22706.916,.01,0) +NUMBER^NJ3,0^^0;1^K:+X'=X!(X>999)!(X<0)!(X?.E1"."1.N) X +"^DD",22706.9,22706.916,.01,1,0) +^.1 +"^DD",22706.9,22706.916,.01,1,1,0) +22706.916^B +"^DD",22706.9,22706.916,.01,1,1,1) +S ^TMG(22706.9,DA(1),4,"B",$E(X,1,30),DA)="" +"^DD",22706.9,22706.916,.01,1,1,2) +K ^TMG(22706.9,DA(1),4,"B",$E(X,1,30),DA) +"^DD",22706.9,22706.916,.01,1,2,0) +22706.9^TMG +"^DD",22706.9,22706.916,.01,1,2,1) +S ^TMG(22706.9,"TMG",$E(X,1,30),DA(1),DA)="" +"^DD",22706.9,22706.916,.01,1,2,2) +K ^TMG(22706.9,"TMG",$E(X,1,30),DA(1),DA) +"^DD",22706.9,22706.916,.01,1,2,"DT") +3060323 +"^DD",22706.9,22706.916,.01,3) +Type a number between 0 and 999, 0 Decimal Digits +"^DD",22706.9,22706.916,.01,"DT") +3060323 +"^DD",22706.9,22706.916,2,0) +INGREDIENT^P50.416'^PS(50.416,^0;3^Q +"^DD",22706.9,22706.916,2,1,0) +^.1 +"^DD",22706.9,22706.916,2,1,1,0) +22706.916^C +"^DD",22706.9,22706.916,2,1,1,1) +S ^TMG(22706.9,DA(1),4,"C",$E(X,1,30),DA)="" +"^DD",22706.9,22706.916,2,1,1,2) +K ^TMG(22706.9,DA(1),4,"C",$E(X,1,30),DA) +"^DD",22706.9,22706.916,2,1,1,"DT") +3060820 +"^DD",22706.9,22706.916,2,"DT") +3060820 +"^DD",22706.9,22706.916,3,0) +STRENGTH^F^^0;4^K:$L(X)>16!($L(X)<1) X +"^DD",22706.9,22706.916,3,3) +Answer must be 1-16 characters in length +"^DD",22706.9,22706.916,3,"DT") +3060318 +"^DD",22706.9,22706.916,5,0) +UNIT^P50.607'^PS(50.607,^0;6^Q +"^DD",22706.9,22706.916,5,"DT") +3060318 +"^DIC",8925.1,8925.1,0) +TIU DOCUMENT DEFINITION^8925.1 +"^DIC",8925.1,8925.1,0,"GL") +^TIU(8925.1, +"^DIC",8925.1,8925.1,"%",0) +^1.005^2^1 +"^DIC",8925.1,8925.1,"%",2,0) +GMTS +"^DIC",8925.1,8925.1,"%","B","GMTS",2) + +"^DIC",8925.1,8925.1,"%D",0) +^^76^76^2970604^^^ +"^DIC",8925.1,8925.1,"%D",1,0) +This file stores Document Definitions, which identify and define behavior +"^DIC",8925.1,8925.1,"%D",2,0) +for documents stored in the TIU DOCUMENTS FILE (#8925). For consistency +"^DIC",8925.1,8925.1,"%D",3,0) +with the V-file schema, it may be viewed as the "Attribute Dictionary" for +"^DIC",8925.1,8925.1,"%D",4,0) +the Text Integration Utilities. +"^DIC",8925.1,8925.1,"%D",5,0) + +"^DIC",8925.1,8925.1,"%D",6,0) +It also stores Objects, which can be embedded in a Document Definition's +"^DIC",8925.1,8925.1,"%D",7,0) +Boilerplate Text (Overprint). Objects contain M code which gets a piece of +"^DIC",8925.1,8925.1,"%D",8,0) +data and inserts it in the document's Boilerplate Text when a document is +"^DIC",8925.1,8925.1,"%D",9,0) +entered. +"^DIC",8925.1,8925.1,"%D",10,0) + +"^DIC",8925.1,8925.1,"%D",11,0) +Warning: objects embedded in boilerplate text are looked up by multiple +"^DIC",8925.1,8925.1,"%D",12,0) +index (i.e. DIC(0) contains 'M'). Current code (see routine CHECK^TIUFLF3) +"^DIC",8925.1,8925.1,"%D",13,0) +checks all present indexes to make sure object names, abbreviations and +"^DIC",8925.1,8925.1,"%D",14,0) +print names are not ambiguous for this lookup. If new indexes are added, +"^DIC",8925.1,8925.1,"%D",15,0) +this code MUST BE UPDATED to check the new index as well. +"^DIC",8925.1,8925.1,"%D",16,0) + +"^DIC",8925.1,8925.1,"%D",17,0) +Some entries in this file are developed Nationally and exported across the +"^DIC",8925.1,8925.1,"%D",18,0) +country. Others are created by local sites. Entries in the first +"^DIC",8925.1,8925.1,"%D",19,0) +category are marked National Standard and are not editable by sites. +"^DIC",8925.1,8925.1,"%D",20,0) + +"^DIC",8925.1,8925.1,"%D",21,0) +This file does NOT allow multiple entries OF THE SAME TYPE with the same +"^DIC",8925.1,8925.1,"%D",22,0) +name. That is, within a given Type, there are no duplicate names. (This +"^DIC",8925.1,8925.1,"%D",23,0) +refers to the .01 field, the Technical name of the entry.) +"^DIC",8925.1,8925.1,"%D",24,0) + +"^DIC",8925.1,8925.1,"%D",25,0) +This file does not allow a parent to have items with the same name, even +"^DIC",8925.1,8925.1,"%D",26,0) +if the items have different internal file numbers (i.e. are different file +"^DIC",8925.1,8925.1,"%D",27,0) +entries). Again, this refers to the .01 Technical name of the entry. +"^DIC",8925.1,8925.1,"%D",28,0) + +"^DIC",8925.1,8925.1,"%D",29,0) +Because of ownership considerations, the file does NOT allow an entry to +"^DIC",8925.1,8925.1,"%D",30,0) +be an item under more than 1 parent. If the same item is desired under +"^DIC",8925.1,8925.1,"%D",31,0) +more than 1 parent, the item must be copied into a new entry. There is +"^DIC",8925.1,8925.1,"%D",32,0) +one exception: Document Definitions of Type Component which have been +"^DIC",8925.1,8925.1,"%D",33,0) +marked Shared may have more than one parent. +"^DIC",8925.1,8925.1,"%D",34,0) + +"^DIC",8925.1,8925.1,"%D",35,0) +The Document Definition Utility TIUF categorizes certain fields as Basic, +"^DIC",8925.1,8925.1,"%D",36,0) +Technical, or Upload, and displays these fields together as a group when +"^DIC",8925.1,8925.1,"%D",37,0) +user edits or views a Document Definition. BASIC fields include Name, +"^DIC",8925.1,8925.1,"%D",38,0) +Abbreviation, Print Name, Type, Personal Owner, Class Owner, Status, In +"^DIC",8925.1,8925.1,"%D",39,0) +Use, Shared, Orphan, Has Boiltxt, National Standard, OK to Distribute, and +"^DIC",8925.1,8925.1,"%D",40,0) +Suppress Visit Selection. TECHNICAL fields include Entry Action, Exit +"^DIC",8925.1,8925.1,"%D",41,0) +Action, Edit Template, Print Method, Print Form Header, Print Form Number, +"^DIC",8925.1,8925.1,"%D",42,0) +Print Group, Allow Custom Form Headers, Visit Linkage Method, Validation +"^DIC",8925.1,8925.1,"%D",43,0) +Method, and Object Method. UPLOAD fields include Upload Target File, Laygo +"^DIC",8925.1,8925.1,"%D",44,0) +Allowed, Target Text Field Subscript, Upload Look-up Method, Upload +"^DIC",8925.1,8925.1,"%D",45,0) +Post-Filing Code, Upload Filing Error Code, and multiples Upload Captioned +"^DIC",8925.1,8925.1,"%D",46,0) +ASCII Header and Upload Delimited ASCII Header. +"^DIC",8925.1,8925.1,"%D",47,0) + +"^DIC",8925.1,8925.1,"%D",48,0) +The Document Definition file contains extensive, detailed field +"^DIC",8925.1,8925.1,"%D",49,0) +descriptions. Likewise, some protocols (File 101) used in TIU have +"^DIC",8925.1,8925.1,"%D",50,0) +extensive and careful descriptions in the Protocol file. Many of these +"^DIC",8925.1,8925.1,"%D",51,0) +descriptions are used in TIU for online help. If it becomes necessary for +"^DIC",8925.1,8925.1,"%D",52,0) +a national programmer to edit these descriptions, the programmer should +"^DIC",8925.1,8925.1,"%D",53,0) +check to make sure all online help is still displayed properly. +"^DIC",8925.1,8925.1,"%D",54,0) + +"^DIC",8925.1,8925.1,"%D",55,0) +Users are expected to use the Document Definition Utility TIUF to enter, +"^DIC",8925.1,8925.1,"%D",56,0) +edit, and delete file entries. In fact, the file prohibits the deletion +"^DIC",8925.1,8925.1,"%D",57,0) +of entries through generic Fileman Options. It also prohibits the edit +"^DIC",8925.1,8925.1,"%D",58,0) +through generic Fileman of a few critical fields: Type, Status, Shared, +"^DIC",8925.1,8925.1,"%D",59,0) +and National Standard. Adding and Deleting (but not editing) Items is +"^DIC",8925.1,8925.1,"%D",60,0) +also prohibited through generic Fileman options. Abbreviation and Print +"^DIC",8925.1,8925.1,"%D",61,0) +Name of OBJECTS cannot be edited through generic Fileman Options. +"^DIC",8925.1,8925.1,"%D",62,0) + +"^DIC",8925.1,8925.1,"%D",63,0) +This does NOT imply that it is SAFE to use generic Fileman to edit other +"^DIC",8925.1,8925.1,"%D",64,0) +fields. Users are cautioned that edit through generic Fileman bypasses +"^DIC",8925.1,8925.1,"%D",65,0) +many safeguards built in to the Document Definition Utility and can create +"^DIC",8925.1,8925.1,"%D",66,0) +havoc unless the user THOROUGHLY UNDERSTANDS the File and its uses. +"^DIC",8925.1,8925.1,"%D",67,0) + +"^DIC",8925.1,8925.1,"%D",68,0) +If users find needs which are not met through TIUF, please communicate +"^DIC",8925.1,8925.1,"%D",69,0) +them to the TIU development team. +"^DIC",8925.1,8925.1,"%D",70,0) + +"^DIC",8925.1,8925.1,"%D",71,0) + ***************** +"^DIC",8925.1,8925.1,"%D",72,0) + +"^DIC",8925.1,8925.1,"%D",73,0) +WARNING: Using generic Fileman options to edit entries can cause SERIOUS +"^DIC",8925.1,8925.1,"%D",74,0) +database problems. +"^DIC",8925.1,8925.1,"%D",75,0) + +"^DIC",8925.1,8925.1,"%D",76,0) + **************** +"^DIC",8925.1,"B","TIU DOCUMENT DEFINITION",8925.1) + +"^DIC",22706.1,22706.1,0) +TMG FDA APPLICATION^22706.1 +"^DIC",22706.1,22706.1,0,"GL") +^TMG(22706.1, +"^DIC",22706.1,"B","TMG FDA APPLICATION",22706.1) + +"^DIC",22706.2,22706.2,0) +TMG FDA DOSAGE FORM^22706.2 +"^DIC",22706.2,22706.2,0,"GL") +^TMG(22706.2, +"^DIC",22706.2,"B","TMG FDA DOSAGE FORM",22706.2) + +"^DIC",22706.3,22706.3,0) +TMG FDA FIRMS^22706.3 +"^DIC",22706.3,22706.3,0,"GL") +^TMG(22706.3, +"^DIC",22706.3,"B","TMG FDA FIRMS",22706.3) + +"^DIC",22706.4,22706.4,0) +TMG FDA FORMULATION^22706.4 +"^DIC",22706.4,22706.4,0,"GL") +^TMG(22706.4, +"^DIC",22706.4,22706.4,"%",0) +^1.005^^ +"^DIC",22706.4,"B","TMG FDA FORMULATION",22706.4) + +"^DIC",22706.5,22706.5,0) +TMG FDA LISTING^22706.5 +"^DIC",22706.5,22706.5,0,"GL") +^TMG(22706.5, +"^DIC",22706.5,"B","TMG FDA LISTING",22706.5) + +"^DIC",22706.6,22706.6,0) +TMG FDA PACKAGES^22706.6 +"^DIC",22706.6,22706.6,0,"GL") +^TMG(22706.6, +"^DIC",22706.6,"B","TMG FDA PACKAGES",22706.6) + +"^DIC",22706.7,22706.7,0) +TMG FDA ROUTES^22706.7 +"^DIC",22706.7,22706.7,0,"GL") +^TMG(22706.7, +"^DIC",22706.7,"B","TMG FDA ROUTES",22706.7) + +"^DIC",22706.8,22706.8,0) +TMG FDA FORMS VISTA EQUIVALENTS^22706.8 +"^DIC",22706.8,22706.8,0,"GL") +^TMG(22706.8, +"^DIC",22706.8,22706.8,"%",0) +^1.005^^ +"^DIC",22706.8,22706.8,"%D",0) +^1.001^3^3^3070126^^^ +"^DIC",22706.8,22706.8,"%D",1,0) +This file will hold linkages between FDA units and equivalents entries in +"^DIC",22706.8,22706.8,"%D",2,0) +file 50.607 (DRUG UNITS) +"^DIC",22706.8,22706.8,"%D",3,0) +) +"^DIC",22706.8,"B","TMG FDA FORMS VISTA EQUIVALENTS",22706.8) + +"^DIC",22706.82,22706.82,0) +TMG FDA ROUTES VISTA EQUIVALENTS^22706.82 +"^DIC",22706.82,22706.82,0,"GL") +^TMG(22706.82, +"^DIC",22706.82,"B","TMG FDA ROUTES VISTA EQUIVALENTS",22706.82) + +"^DIC",22706.9,22706.9,0) +TMG FDA IMPORT COMPILED^22706.9 +"^DIC",22706.9,22706.9,0,"GL") +^TMG(22706.9, +"^DIC",22706.9,22706.9,"%D",0) +^1.001^3^3^3071101^^^^ +"^DIC",22706.9,22706.9,"%D",1,0) +This file holds a compilation of the individual files put out by the FDA. +"^DIC",22706.9,22706.9,"%D",2,0) +After the data in the various files has been compiled into this file, it +"^DIC",22706.9,22706.9,"%D",3,0) +is then used to populate VistA drug files. +"^DIC",22706.9,"B","TMG FDA IMPORT COMPILED",22706.9) + +**END** +**END**