KIDS Distribution saved on Mar 09, 2005@07:42:02 Prosthetic Patch RMPR*3*61 **KIDS**:RMPR*3.0*61^ **INSTALL NAME** RMPR*3.0*61 "BLD",3166,0) RMPR*3.0*61^PROSTHETICS^0^3050309^y "BLD",3166,1,0) ^^1^1^3031103^^^^ "BLD",3166,1,1,0) Patch #61 - Barcoding and File Redesign. "BLD",3166,4,0) ^9.64PA^660^11 "BLD",3166,4,660,0) 660 "BLD",3166,4,660,2,0) ^9.641^660^1 "BLD",3166,4,660,2,660,0) RECORD OF PROS APPLIANCE/REPAIR (File-top level) "BLD",3166,4,660,2,660,1,0) ^9.6411^39^2 "BLD",3166,4,660,2,660,1,4.6,0) STOCK ISSUE "BLD",3166,4,660,2,660,1,39,0) DATE OF SERVICE "BLD",3166,4,660,222) y^y^p^^^^n "BLD",3166,4,661.11,0) 661.11 "BLD",3166,4,661.11,222) y^y^f^^^^n "BLD",3166,4,661.4,0) 661.4 "BLD",3166,4,661.4,222) y^y^f^^^^n "BLD",3166,4,661.41,0) 661.41 "BLD",3166,4,661.41,222) y^y^f^^^^n "BLD",3166,4,661.5,0) 661.5 "BLD",3166,4,661.5,222) y^y^f^^^^n "BLD",3166,4,661.6,0) 661.6 "BLD",3166,4,661.6,222) y^y^f^^^^n "BLD",3166,4,661.63,0) 661.63 "BLD",3166,4,661.63,222) y^y^f^^^^n "BLD",3166,4,661.69,0) 661.69 "BLD",3166,4,661.69,222) y^y^f^^^^n "BLD",3166,4,661.7,0) 661.7 "BLD",3166,4,661.7,222) y^y^f^^^^n "BLD",3166,4,661.8,0) 661.8 "BLD",3166,4,661.8,222) y^y^f^^^^n "BLD",3166,4,661.9,0) 661.9 "BLD",3166,4,661.9,222) y^y^f^^^^n "BLD",3166,4,"APDD",660,660) "BLD",3166,4,"APDD",660,660,4.6) "BLD",3166,4,"APDD",660,660,39) "BLD",3166,4,"B",660,660) "BLD",3166,4,"B",661.11,661.11) "BLD",3166,4,"B",661.4,661.4) "BLD",3166,4,"B",661.41,661.41) "BLD",3166,4,"B",661.5,661.5) "BLD",3166,4,"B",661.6,661.6) "BLD",3166,4,"B",661.63,661.63) "BLD",3166,4,"B",661.69,661.69) "BLD",3166,4,"B",661.7,661.7) "BLD",3166,4,"B",661.8,661.8) "BLD",3166,4,"B",661.9,661.9) "BLD",3166,"ABPKG") n^n "BLD",3166,"INIT") "BLD",3166,"KRN",0) ^9.67PA^19^17 "BLD",3166,"KRN",.4,0) .4 "BLD",3166,"KRN",.401,0) .401 "BLD",3166,"KRN",.402,0) .402 "BLD",3166,"KRN",.403,0) .403 "BLD",3166,"KRN",.5,0) .5 "BLD",3166,"KRN",.84,0) .84 "BLD",3166,"KRN",3.6,0) 3.6 "BLD",3166,"KRN",3.8,0) 3.8 "BLD",3166,"KRN",9.2,0) 9.2 "BLD",3166,"KRN",9.8,0) 9.8 "BLD",3166,"KRN",9.8,"NM",0) ^9.68A^103^99 "BLD",3166,"KRN",9.8,"NM",2,0) RMPR5HQC^^0^B27338962 "BLD",3166,"KRN",9.8,"NM",3,0) RMPR5HQL^^0^B22749450 "BLD",3166,"KRN",9.8,"NM",5,0) RMPROP^^0^B6838056 "BLD",3166,"KRN",9.8,"NM",6,0) RMPRPI01^^0^B31783788 "BLD",3166,"KRN",9.8,"NM",7,0) RMPRPI02^^0^B34609029 "BLD",3166,"KRN",9.8,"NM",8,0) RMPRPI03^^0^B17562500 "BLD",3166,"KRN",9.8,"NM",9,0) RMPRPI04^^0^B27130602 "BLD",3166,"KRN",9.8,"NM",10,0) RMPRPI05^^0^B16212132 "BLD",3166,"KRN",9.8,"NM",11,0) RMPRPI06^^0^B18539063 "BLD",3166,"KRN",9.8,"NM",12,0) RMPRPI07^^0^B16064991 "BLD",3166,"KRN",9.8,"NM",13,0) RMPRPI08^^0^B23150298 "BLD",3166,"KRN",9.8,"NM",14,0) RMPRPI09^^0^B30171234 "BLD",3166,"KRN",9.8,"NM",15,0) RMPRPIU6^^0^B17282265 "BLD",3166,"KRN",9.8,"NM",16,0) RMPRPIU7^^0^B8094985 "BLD",3166,"KRN",9.8,"NM",17,0) RMPRPIU8^^0^B24703676 "BLD",3166,"KRN",9.8,"NM",18,0) RMPRPIU9^^0^B20353682 "BLD",3166,"KRN",9.8,"NM",19,0) RMPRPIUA^^0^B22135186 "BLD",3166,"KRN",9.8,"NM",20,0) RMPRPIUB^^0^B9656665 "BLD",3166,"KRN",9.8,"NM",21,0) RMPRPIUC^^0^B21527506 "BLD",3166,"KRN",9.8,"NM",22,0) RMPRPIUD^^0^B12009714 "BLD",3166,"KRN",9.8,"NM",23,0) RMPRPIUE^^0^B8394222 "BLD",3166,"KRN",9.8,"NM",24,0) RMPRPIUF^^0^B13236997 "BLD",3166,"KRN",9.8,"NM",25,0) RMPRPIUT^^0^B22622238 "BLD",3166,"KRN",9.8,"NM",26,0) RMPRPIX1^^0^B42076833 "BLD",3166,"KRN",9.8,"NM",27,0) RMPRPIX3^^0^B6118995 "BLD",3166,"KRN",9.8,"NM",28,0) RMPRPIX4^^0^B5460099 "BLD",3166,"KRN",9.8,"NM",29,0) RMPRPIX5^^0^B17419758 "BLD",3166,"KRN",9.8,"NM",30,0) RMPRPIX6^^0^B57949173 "BLD",3166,"KRN",9.8,"NM",31,0) RMPRPIX7^^0^B19458593 "BLD",3166,"KRN",9.8,"NM",32,0) RMPRPIXA^^0^B86939765 "BLD",3166,"KRN",9.8,"NM",33,0) RMPRPIXB^^0^B3412569 "BLD",3166,"KRN",9.8,"NM",34,0) RMPRPIXE^^0^B87424057 "BLD",3166,"KRN",9.8,"NM",35,0) RMPRPIXI^^0^B1346142 "BLD",3166,"KRN",9.8,"NM",36,0) RMPRPIXJ^^0^B27737512 "BLD",3166,"KRN",9.8,"NM",37,0) RMPRPIXN^^0^B22037698 "BLD",3166,"KRN",9.8,"NM",38,0) RMPRPIXZ^^0^B2340220 "BLD",3166,"KRN",9.8,"NM",39,0) RMPRPIY1^^0^B14707461 "BLD",3166,"KRN",9.8,"NM",40,0) RMPRPIY2^^0^B48005442 "BLD",3166,"KRN",9.8,"NM",41,0) RMPRPIY3^^0^B7655455 "BLD",3166,"KRN",9.8,"NM",42,0) RMPRPIY4^^0^B735047 "BLD",3166,"KRN",9.8,"NM",43,0) RMPRPIY5^^0^B26059922 "BLD",3166,"KRN",9.8,"NM",44,0) RMPRPIY9^^0^B30384790 "BLD",3166,"KRN",9.8,"NM",45,0) RMPRPIYA^^0^B10240071 "BLD",3166,"KRN",9.8,"NM",46,0) RMPRPIYB^^0^B22001165 "BLD",3166,"KRN",9.8,"NM",47,0) RMPRPIYC^^0^B26624824 "BLD",3166,"KRN",9.8,"NM",48,0) RMPRPIYD^^0^B43917687 "BLD",3166,"KRN",9.8,"NM",49,0) RMPRPIYE^^0^B48780163 "BLD",3166,"KRN",9.8,"NM",50,0) RMPRPIYF^^0^B75690546 "BLD",3166,"KRN",9.8,"NM",51,0) RMPRPIYG^^0^B51586715 "BLD",3166,"KRN",9.8,"NM",52,0) RMPRPIYH^^0^B16728879 "BLD",3166,"KRN",9.8,"NM",53,0) RMPRPIYI^^0^B60353445 "BLD",3166,"KRN",9.8,"NM",54,0) RMPRPIYJ^^0^B18204956 "BLD",3166,"KRN",9.8,"NM",55,0) RMPRPIYK^^0^B4220635 "BLD",3166,"KRN",9.8,"NM",56,0) RMPRPIYO^^0^B24383227 "BLD",3166,"KRN",9.8,"NM",57,0) RMPRPIYT^^0^B12442922 "BLD",3166,"KRN",9.8,"NM",58,0) RMPRPIYU^^0^B8685929 "BLD",3166,"KRN",9.8,"NM",59,0) RMPRPIYV^^0^B3926586 "BLD",3166,"KRN",9.8,"NM",60,0) RMPRPIYW^^0^B3506902 "BLD",3166,"KRN",9.8,"NM",61,0) RMPRPIYX^^0^B2308189 "BLD",3166,"KRN",9.8,"NM",63,0) RMPRPIU1^^0^B10935619 "BLD",3166,"KRN",9.8,"NM",64,0) RMPRPIU2^^0^B42102092 "BLD",3166,"KRN",9.8,"NM",65,0) RMPRPIUG^^0^B41843688 "BLD",3166,"KRN",9.8,"NM",66,0) RMPRPIUH^^0^B34910877 "BLD",3166,"KRN",9.8,"NM",67,0) RMPRPIUI^^0^B7265008 "BLD",3166,"KRN",9.8,"NM",68,0) RMPRPIUJ^^0^B7843461 "BLD",3166,"KRN",9.8,"NM",69,0) RMPRPIUK^^0^B19375579 "BLD",3166,"KRN",9.8,"NM",70,0) RMPRPIX2^^0^B37581172 "BLD",3166,"KRN",9.8,"NM",71,0) RMPRPIXC^^0^B13016068 "BLD",3166,"KRN",9.8,"NM",72,0) RMPRPIY6^^0^B78793890 "BLD",3166,"KRN",9.8,"NM",73,0) RMPRPIY7^^0^B53472701 "BLD",3166,"KRN",9.8,"NM",74,0) RMPRPIY8^^0^B25068279 "BLD",3166,"KRN",9.8,"NM",75,0) RMPRPIYL^^0^B28707505 "BLD",3166,"KRN",9.8,"NM",76,0) RMPRPIQ4^^0^B77926296 "BLD",3166,"KRN",9.8,"NM",77,0) RMPRPIQ5^^0^B39122637 "BLD",3166,"KRN",9.8,"NM",78,0) RMPRPIU3^^0^B22550640 "BLD",3166,"KRN",9.8,"NM",79,0) RMPRPIYN^^0^B9341297 "BLD",3166,"KRN",9.8,"NM",80,0) RMPRPIYY^^0^B17959585 "BLD",3166,"KRN",9.8,"NM",81,0) RMPRPIYM^^0^B3660364 "BLD",3166,"KRN",9.8,"NM",82,0) RMPRPIYP^^0^B11791614 "BLD",3166,"KRN",9.8,"NM",83,0) RMPRPIYQ^^0^B8888131 "BLD",3166,"KRN",9.8,"NM",84,0) RMPRPIYR^^0^B13064179 "BLD",3166,"KRN",9.8,"NM",85,0) RMPRPIYS^^0^B84402639 "BLD",3166,"KRN",9.8,"NM",86,0) RMPRPIXD^^0^B1459622 "BLD",3166,"KRN",9.8,"NM",87,0) RMPRPIUV^^0^B8651645 "BLD",3166,"KRN",9.8,"NM",88,0) RMPRPIU4^^0^B3104025 "BLD",3166,"KRN",9.8,"NM",89,0) RMPRPI11^^0^B23594413 "BLD",3166,"KRN",9.8,"NM",90,0) RMPRPI13^^0^B15249672 "BLD",3166,"KRN",9.8,"NM",91,0) RMPRPI14^^0^B17049149 "BLD",3166,"KRN",9.8,"NM",92,0) RMPRPI15^^0^B14961158 "BLD",3166,"KRN",9.8,"NM",93,0) RMPRPI10^^0^B23444540 "BLD",3166,"KRN",9.8,"NM",95,0) RMPR5NU^^0^B17140479 "BLD",3166,"KRN",9.8,"NM",96,0) RMPRST2^^0^B4091043 "BLD",3166,"KRN",9.8,"NM",97,0) RMPRPIU0^^0^B1088258 "BLD",3166,"KRN",9.8,"NM",98,0) RMPRPIYZ^^0^B11453009 "BLD",3166,"KRN",9.8,"NM",99,0) RMPRPIXF^^0^B18974461 "BLD",3166,"KRN",9.8,"NM",100,0) RMPR5HQ5^^0^B40855688 "BLD",3166,"KRN",9.8,"NM",101,0) RMPRPI16^^0^B9195029 "BLD",3166,"KRN",9.8,"NM",102,0) RMPRPIXR^^0^B26654827 "BLD",3166,"KRN",9.8,"NM",103,0) RMPRE29^^0^B43174042 "BLD",3166,"KRN",9.8,"NM","B","RMPR5HQ5",100) "BLD",3166,"KRN",9.8,"NM","B","RMPR5HQC",2) "BLD",3166,"KRN",9.8,"NM","B","RMPR5HQL",3) "BLD",3166,"KRN",9.8,"NM","B","RMPR5NU",95) "BLD",3166,"KRN",9.8,"NM","B","RMPRE29",103) "BLD",3166,"KRN",9.8,"NM","B","RMPROP",5) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI01",6) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI02",7) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI03",8) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI04",9) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI05",10) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI06",11) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI07",12) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI08",13) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI09",14) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI10",93) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI11",89) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI13",90) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI14",91) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI15",92) "BLD",3166,"KRN",9.8,"NM","B","RMPRPI16",101) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIQ4",76) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIQ5",77) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU0",97) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU1",63) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU2",64) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU3",78) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU4",88) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU6",15) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU7",16) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU8",17) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIU9",18) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUA",19) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUB",20) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUC",21) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUD",22) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUE",23) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUF",24) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUG",65) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUH",66) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUI",67) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUJ",68) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUK",69) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUT",25) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIUV",87) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX1",26) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX2",70) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX3",27) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX4",28) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX5",29) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX6",30) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIX7",31) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXA",32) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXB",33) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXC",71) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXD",86) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXE",34) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXF",99) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXI",35) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXJ",36) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXN",37) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXR",102) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIXZ",38) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY1",39) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY2",40) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY3",41) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY4",42) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY5",43) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY6",72) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY7",73) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY8",74) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIY9",44) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYA",45) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYB",46) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYC",47) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYD",48) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYE",49) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYF",50) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYG",51) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYH",52) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYI",53) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYJ",54) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYK",55) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYL",75) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYM",81) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYN",79) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYO",56) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYP",82) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYQ",83) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYR",84) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYS",85) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYT",57) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYU",58) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYV",59) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYW",60) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYX",61) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYY",80) "BLD",3166,"KRN",9.8,"NM","B","RMPRPIYZ",98) "BLD",3166,"KRN",9.8,"NM","B","RMPRST2",96) "BLD",3166,"KRN",19,0) 19 "BLD",3166,"KRN",19,"NM",0) ^9.68A^32^30 "BLD",3166,"KRN",19,"NM",1,0) RMPR INV ADD^^0 "BLD",3166,"KRN",19,"NM",2,0) RMPR INV EDIT^^0 "BLD",3166,"KRN",19,"NM",4,0) RMPR INV REMOVE^^1^ "BLD",3166,"KRN",19,"NM",5,0) RMPR INV ORDER^^0 "BLD",3166,"KRN",19,"NM",6,0) RMPR INV RECEIVE^^0 "BLD",3166,"KRN",19,"NM",7,0) RMPR INV TRAN^^0^ "BLD",3166,"KRN",19,"NM",8,0) RMPR INV RECONCILE^^0 "BLD",3166,"KRN",19,"NM",9,0) RMPR INV REPORTS^^2 "BLD",3166,"KRN",19,"NM",10,0) RMPR INV ON HND ITEM^^0 "BLD",3166,"KRN",19,"NM",11,0) RMPR INV ON HND HCPCS^^0 "BLD",3166,"KRN",19,"NM",12,0) RMPR INV ON HND GROUP/LINE^^0 "BLD",3166,"KRN",19,"NM",13,0) RMPR INV ON HND SUM^^0 "BLD",3166,"KRN",19,"NM",14,0) RMPR INV STOCK BY HCPCS^^0 "BLD",3166,"KRN",19,"NM",15,0) RMPR INV STOCK BY LOCATION^^0 "BLD",3166,"KRN",19,"NM",16,0) RMPR INV PRINT/CHECK BAL^^0 "BLD",3166,"KRN",19,"NM",17,0) RMPR INV PRINT ORDER/RECEIVE^^0 "BLD",3166,"KRN",19,"NM",18,0) RMPR INV PRINT ITEM USAGE^^0 "BLD",3166,"KRN",19,"NM",19,0) RMPR INV MAIN^^2 "BLD",3166,"KRN",19,"NM",20,0) RMPR INV EDIT LOCATION^^0 "BLD",3166,"KRN",19,"NM",21,0) RMPR INV PRINT WORK SHEET^^0 "BLD",3166,"KRN",19,"NM",22,0) RMPR INV REPRINT BARCODE^^0 "BLD",3166,"KRN",19,"NM",23,0) RMPR EDT 2319^^0 "BLD",3166,"KRN",19,"NM",25,0) RMPR INV PRINT OVER DATE^^0 "BLD",3166,"KRN",19,"NM",26,0) RMPR INV DEACTIVATE^^0 "BLD",3166,"KRN",19,"NM",27,0) RMPR INV PRINT 30-DAY^^0 "BLD",3166,"KRN",19,"NM",28,0) RMPR INV DELETE^^1^ "BLD",3166,"KRN",19,"NM",29,0) RMPR INV PRINT ALL BARCODE^^0 "BLD",3166,"KRN",19,"NM",30,0) RMPR INV PIP/IFCAP ITEM REPORT^^0 "BLD",3166,"KRN",19,"NM",31,0) RMPR INV REMOVE HCPCS/ITEM^^0 "BLD",3166,"KRN",19,"NM",32,0) RMPR ADD 2319^^0 "BLD",3166,"KRN",19,"NM","B","RMPR ADD 2319",32) "BLD",3166,"KRN",19,"NM","B","RMPR EDT 2319",23) "BLD",3166,"KRN",19,"NM","B","RMPR INV ADD",1) "BLD",3166,"KRN",19,"NM","B","RMPR INV DEACTIVATE",26) "BLD",3166,"KRN",19,"NM","B","RMPR INV DELETE",28) "BLD",3166,"KRN",19,"NM","B","RMPR INV EDIT",2) "BLD",3166,"KRN",19,"NM","B","RMPR INV EDIT LOCATION",20) "BLD",3166,"KRN",19,"NM","B","RMPR INV MAIN",19) "BLD",3166,"KRN",19,"NM","B","RMPR INV ON HND GROUP/LINE",12) "BLD",3166,"KRN",19,"NM","B","RMPR INV ON HND HCPCS",11) "BLD",3166,"KRN",19,"NM","B","RMPR INV ON HND ITEM",10) "BLD",3166,"KRN",19,"NM","B","RMPR INV ON HND SUM",13) "BLD",3166,"KRN",19,"NM","B","RMPR INV ORDER",5) "BLD",3166,"KRN",19,"NM","B","RMPR INV PIP/IFCAP ITEM REPORT",30) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT 30-DAY",27) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT ALL BARCODE",29) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT ITEM USAGE",18) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT ORDER/RECEIVE",17) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT OVER DATE",25) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT WORK SHEET",21) "BLD",3166,"KRN",19,"NM","B","RMPR INV PRINT/CHECK BAL",16) "BLD",3166,"KRN",19,"NM","B","RMPR INV RECEIVE",6) "BLD",3166,"KRN",19,"NM","B","RMPR INV RECONCILE",8) "BLD",3166,"KRN",19,"NM","B","RMPR INV REMOVE",4) "BLD",3166,"KRN",19,"NM","B","RMPR INV REMOVE HCPCS/ITEM",31) "BLD",3166,"KRN",19,"NM","B","RMPR INV REPORTS",9) "BLD",3166,"KRN",19,"NM","B","RMPR INV REPRINT BARCODE",22) "BLD",3166,"KRN",19,"NM","B","RMPR INV STOCK BY HCPCS",14) "BLD",3166,"KRN",19,"NM","B","RMPR INV STOCK BY LOCATION",15) "BLD",3166,"KRN",19,"NM","B","RMPR INV TRAN",7) "BLD",3166,"KRN",19.1,0) 19.1 "BLD",3166,"KRN",19.1,"NM",0) ^9.68A^^ "BLD",3166,"KRN",101,0) 101 "BLD",3166,"KRN",409.61,0) 409.61 "BLD",3166,"KRN",771,0) 771 "BLD",3166,"KRN",870,0) 870 "BLD",3166,"KRN",8994,0) 8994 "BLD",3166,"KRN","B",.4,.4) "BLD",3166,"KRN","B",.401,.401) "BLD",3166,"KRN","B",.402,.402) "BLD",3166,"KRN","B",.403,.403) "BLD",3166,"KRN","B",.5,.5) "BLD",3166,"KRN","B",.84,.84) "BLD",3166,"KRN","B",3.6,3.6) "BLD",3166,"KRN","B",3.8,3.8) "BLD",3166,"KRN","B",9.2,9.2) "BLD",3166,"KRN","B",9.8,9.8) "BLD",3166,"KRN","B",19,19) "BLD",3166,"KRN","B",19.1,19.1) "BLD",3166,"KRN","B",101,101) "BLD",3166,"KRN","B",409.61,409.61) "BLD",3166,"KRN","B",771,771) "BLD",3166,"KRN","B",870,870) "BLD",3166,"KRN","B",8994,8994) "BLD",3166,"QUES",0) ^9.62^^0 "BLD",3166,"REQB",0) ^9.611^9^7 "BLD",3166,"REQB",1,0) RMPR*3.0*51^1 "BLD",3166,"REQB",4,0) RMPR*3.0*53^1 "BLD",3166,"REQB",5,0) RMPR*3.0*52^1 "BLD",3166,"REQB",6,0) RMPR*3.0*62^1 "BLD",3166,"REQB",7,0) RMPR*3.0*74^1 "BLD",3166,"REQB",8,0) RMPR*3.0*81^1 "BLD",3166,"REQB",9,0) RMPR*3.0*84^2 "BLD",3166,"REQB","B","RMPR*3.0*51",1) "BLD",3166,"REQB","B","RMPR*3.0*52",5) "BLD",3166,"REQB","B","RMPR*3.0*53",4) "BLD",3166,"REQB","B","RMPR*3.0*62",6) "BLD",3166,"REQB","B","RMPR*3.0*74",7) "BLD",3166,"REQB","B","RMPR*3.0*81",8) "BLD",3166,"REQB","B","RMPR*3.0*84",9) "FIA",660) RECORD OF PROS APPLIANCE/REPAIR "FIA",660,0) ^RMPR(660, "FIA",660,0,0) 660IOD "FIA",660,0,1) y^y^p^^^^n "FIA",660,0,10) "FIA",660,0,11) "FIA",660,0,"RLRO") "FIA",660,0,"VR") 3.0^RMPR "FIA",660,660) 1 "FIA",660,660,4.6) "FIA",660,660,39) "FIA",661.11) PROSTHETICS HCPCS ITEM MASTER FILE "FIA",661.11,0) ^RMPR(661.11, "FIA",661.11,0,0) 661.11A "FIA",661.11,0,1) y^y^f^^^^n "FIA",661.11,0,10) "FIA",661.11,0,11) "FIA",661.11,0,"RLRO") "FIA",661.11,0,"VR") 3.0^RMPR "FIA",661.11,661.11) 0 "FIA",661.4) HCPCS INVENTORY "FIA",661.4,0) ^RMPR(661.4, "FIA",661.4,0,0) 661.4 "FIA",661.4,0,1) y^y^f^^^^n "FIA",661.4,0,10) "FIA",661.4,0,11) "FIA",661.4,0,"RLRO") "FIA",661.4,0,"VR") 3.0^RMPR "FIA",661.4,661.4) 0 "FIA",661.41) HCPCS INVENTORY ORDER AND REORDER "FIA",661.41,0) ^RMPR(661.41, "FIA",661.41,0,0) 661.41D "FIA",661.41,0,1) y^y^f^^^^n "FIA",661.41,0,10) "FIA",661.41,0,11) "FIA",661.41,0,"RLRO") "FIA",661.41,0,"VR") 3.0^RMPR "FIA",661.41,661.41) 0 "FIA",661.5) PROSTHETIC STOCK LOCATION "FIA",661.5,0) ^RMPR(661.5, "FIA",661.5,0,0) 661.5 "FIA",661.5,0,1) y^y^f^^^^n "FIA",661.5,0,10) "FIA",661.5,0,11) "FIA",661.5,0,"RLRO") "FIA",661.5,0,"VR") 3.0^RMPR "FIA",661.5,661.5) 0 "FIA",661.6) PROSTHETIC INVENTORY TRANSACTION "FIA",661.6,0) ^RMPR(661.6, "FIA",661.6,0,0) 661.6DA "FIA",661.6,0,1) y^y^f^^^^n "FIA",661.6,0,10) "FIA",661.6,0,11) "FIA",661.6,0,"RLRO") "FIA",661.6,0,"VR") 3.0^RMPR "FIA",661.6,661.6) 0 "FIA",661.63) PROSTHETIC TRANSACTION PATIENT ISSUE "FIA",661.63,0) ^RMPR(661.63, "FIA",661.63,0,0) 661.63P "FIA",661.63,0,1) y^y^f^^^^n "FIA",661.63,0,10) "FIA",661.63,0,11) "FIA",661.63,0,"RLRO") "FIA",661.63,0,"VR") 3.0^RMPR "FIA",661.63,661.63) 0 "FIA",661.69) PROSTHETIC INVENTORY GAIN/LOSS "FIA",661.69,0) ^RMPR(661.69, "FIA",661.69,0,0) 661.69PA "FIA",661.69,0,1) y^y^f^^^^n "FIA",661.69,0,10) "FIA",661.69,0,11) "FIA",661.69,0,"RLRO") "FIA",661.69,0,"VR") 3.0^RMPR "FIA",661.69,661.69) 0 "FIA",661.7) PROSTHETIC CURRENT STOCK "FIA",661.7,0) ^RMPR(661.7, "FIA",661.7,0,0) 661.7 "FIA",661.7,0,1) y^y^f^^^^n "FIA",661.7,0,10) "FIA",661.7,0,11) "FIA",661.7,0,"RLRO") "FIA",661.7,0,"VR") 3.0^RMPR "FIA",661.7,661.7) 0 "FIA",661.8) VENDOR PRODUCT HCPCS MAP "FIA",661.8,0) ^RMPR(661.8, "FIA",661.8,0,0) 661.8 "FIA",661.8,0,1) y^y^f^^^^n "FIA",661.8,0,10) "FIA",661.8,0,11) "FIA",661.8,0,"RLRO") "FIA",661.8,0,"VR") 3.0^RMPR "FIA",661.8,661.8) 0 "FIA",661.9) PROSTHETICS HCPCS RUNNING BALANCE "FIA",661.9,0) ^RMPR(661.9, "FIA",661.9,0,0) 661.9DA "FIA",661.9,0,1) y^y^f^^^^n "FIA",661.9,0,10) "FIA",661.9,0,11) "FIA",661.9,0,"RLRO") "FIA",661.9,0,"VR") 3.0^RMPR "FIA",661.9,661.9) 0 "IX",661.11,661.11,"ASHD",0) 661.11^ASHD^Index by Station, HCPCS, Description^R^^R^IR^I^661.11^^^^^S "IX",661.11,661.11,"ASHD",1) S ^RMPR(661.11,"ASHD",X(1),$E(X(2),1,30),$E(X(3),1,30),DA)="" "IX",661.11,661.11,"ASHD",2) K ^RMPR(661.11,"ASHD",X(1),$E(X(2),1,30),$E(X(3),1,30),DA) "IX",661.11,661.11,"ASHD",2.5) K ^RMPR(661.11,"ASHD") "IX",661.11,661.11,"ASHD",11.1,0) ^.114IA^3^3 "IX",661.11,661.11,"ASHD",11.1,1,0) 1^F^661.11^3^^1^F "IX",661.11,661.11,"ASHD",11.1,1,3) "IX",661.11,661.11,"ASHD",11.1,2,0) 2^F^661.11^.01^30^2^F "IX",661.11,661.11,"ASHD",11.1,2,3) "IX",661.11,661.11,"ASHD",11.1,3,0) 3^F^661.11^2^30^3^F "IX",661.11,661.11,"ASHD",11.1,3,3) "IX",661.11,661.11,"ASHI",0) 661.11^ASHI^STATION & HCPCS ITEM INDEX^R^^R^IR^I^661.11^^^^^S "IX",661.11,661.11,"ASHI",.1,0) ^^2^2^3010126^ "IX",661.11,661.11,"ASHI",.1,1,0) This is an index of Station, HCPCS and HCPCS Item to be used for Look-up "IX",661.11,661.11,"ASHI",.1,2,0) and sorting. "IX",661.11,661.11,"ASHI",1) S ^RMPR(661.11,"ASHI",X(1),$E(X(2),1,10),$E(X(3),1,30),DA)="" "IX",661.11,661.11,"ASHI",2) K ^RMPR(661.11,"ASHI",X(1),$E(X(2),1,10),$E(X(3),1,30),DA) "IX",661.11,661.11,"ASHI",2.5) K ^RMPR(661.11,"ASHI") "IX",661.11,661.11,"ASHI",11.1,0) ^.114IA^4^3 "IX",661.11,661.11,"ASHI",11.1,1,0) 1^F^661.11^3^^1^F "IX",661.11,661.11,"ASHI",11.1,1,3) "IX",661.11,661.11,"ASHI",11.1,3,0) 2^F^661.11^.01^10^2^F "IX",661.11,661.11,"ASHI",11.1,3,3) "IX",661.11,661.11,"ASHI",11.1,4,0) 3^F^661.11^1^30^3^F "IX",661.11,661.11,"ASHI",11.1,4,3) "IX",661.11,661.11,"ASHMDI",0) 661.11^ASHMDI^Index on Station, HCPCS, Item Master, Description, Item Num.^R^^R^IR^I^661.11^^^^^S "IX",661.11,661.11,"ASHMDI",.1,0) ^^19^19^3010810^ "IX",661.11,661.11,"ASHMDI",.1,1,0) Index used for listing items after a HCPCS has been selected in a PIP "IX",661.11,661.11,"ASHMDI",.1,2,0) option. The list will be in alpha order by description but grouped by Item "IX",661.11,661.11,"ASHMDI",.1,3,0) Master. This allows users to keep the Item Master description and just use "IX",661.11,661.11,"ASHMDI",.1,4,0) relevant text for their inventory item descriptions. "IX",661.11,661.11,"ASHMDI",.1,5,0) For example supose the item master description for HCPCS DL175 is "IX",661.11,661.11,"ASHMDI",.1,6,0) 'WHEELCHAIR GLOVES' "IX",661.11,661.11,"ASHMDI",.1,7,0) then 3 inventory items could be set up in PIP with descriptions: "IX",661.11,661.11,"ASHMDI",.1,8,0) 'MEDIUM' "IX",661.11,661.11,"ASHMDI",.1,9,0) 'LARGE' "IX",661.11,661.11,"ASHMDI",.1,10,0) 'SMALL' "IX",661.11,661.11,"ASHMDI",.1,11,0) When the user enters DL175 for HCPCS then they get the following selection "IX",661.11,661.11,"ASHMDI",.1,12,0) list: "IX",661.11,661.11,"ASHMDI",.1,13,0) HCPCS: DL175 WHEELCHAIR GLOVES "IX",661.11,661.11,"ASHMDI",.1,14,0) "IX",661.11,661.11,"ASHMDI",.1,15,0) Item master: WHEELCHAIR GLOVES "IX",661.11,661.11,"ASHMDI",.1,16,0) "IX",661.11,661.11,"ASHMDI",.1,17,0) 1 DL175-2 C LARGE "IX",661.11,661.11,"ASHMDI",.1,18,0) 2 DL175-1 C MEDIUM "IX",661.11,661.11,"ASHMDI",.1,19,0) 3 DL175-3 C SMALL "IX",661.11,661.11,"ASHMDI",1) S ^RMPR(661.11,"ASHMDI",X(1),$E(X(2),1,30),X(3),$E(X(4),1,30),X(5),DA)="" "IX",661.11,661.11,"ASHMDI",2) K ^RMPR(661.11,"ASHMDI",X(1),$E(X(2),1,30),X(3),$E(X(4),1,30),X(5),DA) "IX",661.11,661.11,"ASHMDI",2.5) K ^RMPR(661.11,"ASHMDI") "IX",661.11,661.11,"ASHMDI",11.1,0) ^.114IA^5^5 "IX",661.11,661.11,"ASHMDI",11.1,1,0) 1^F^661.11^3^^1^F "IX",661.11,661.11,"ASHMDI",11.1,1,3) "IX",661.11,661.11,"ASHMDI",11.1,2,0) 2^F^661.11^.01^30^2^F "IX",661.11,661.11,"ASHMDI",11.1,2,3) "IX",661.11,661.11,"ASHMDI",11.1,3,0) 3^F^661.11^7^^3^F "IX",661.11,661.11,"ASHMDI",11.1,3,3) "IX",661.11,661.11,"ASHMDI",11.1,4,0) 4^F^661.11^2^30^4^F "IX",661.11,661.11,"ASHMDI",11.1,4,3) "IX",661.11,661.11,"ASHMDI",11.1,5,0) 5^F^661.11^1^^5^F "IX",661.11,661.11,"ASHMDI",11.1,5,3) "IX",661.11,661.11,"XSD",0) 661.11^XSD^INDEX BY STATION, DESCRIPTION, HCPCS^R^^R^IR^I^661.11^^^^^LS "IX",661.11,661.11,"XSD",1) S ^RMPR(661.11,"XSD",X(1),$E(X(2),1,30),$E(X(3),1,30),DA)="" "IX",661.11,661.11,"XSD",2) K ^RMPR(661.11,"XSD",X(1),$E(X(2),1,30),$E(X(3),1,30),DA) "IX",661.11,661.11,"XSD",2.5) K ^RMPR(661.11,"XSD") "IX",661.11,661.11,"XSD",11.1,0) ^.114IA^3^3 "IX",661.11,661.11,"XSD",11.1,1,0) 1^F^661.11^3^^1^F "IX",661.11,661.11,"XSD",11.1,1,3) "IX",661.11,661.11,"XSD",11.1,2,0) 2^F^661.11^2^30^2^F "IX",661.11,661.11,"XSD",11.1,2,3) "IX",661.11,661.11,"XSD",11.1,3,0) 3^F^661.11^.01^30^3^F "IX",661.11,661.11,"XSD",11.1,3,3) "IX",661.4,661.4,"ASLHI",0) 661.4^ASLHI^Index by Station, Location, HCPCS, Item^R^^R^IR^I^661.4^^^^^S "IX",661.4,661.4,"ASLHI",1) S ^RMPR(661.4,"ASLHI",X(1),X(2),$E(X(3),1,30),X(4),DA)="" "IX",661.4,661.4,"ASLHI",2) K ^RMPR(661.4,"ASLHI",X(1),X(2),$E(X(3),1,30),X(4),DA) "IX",661.4,661.4,"ASLHI",2.5) K ^RMPR(661.4,"ASLHI") "IX",661.4,661.4,"ASLHI",11.1,0) ^.114IA^4^4 "IX",661.4,661.4,"ASLHI",11.1,1,0) 1^F^661.4^3^^1^F "IX",661.4,661.4,"ASLHI",11.1,1,3) "IX",661.4,661.4,"ASLHI",11.1,2,0) 2^F^661.4^7^^2^F "IX",661.4,661.4,"ASLHI",11.1,2,3) "IX",661.4,661.4,"ASLHI",11.1,3,0) 3^F^661.4^.01^30^3^F "IX",661.4,661.4,"ASLHI",11.1,3,3) "IX",661.4,661.4,"ASLHI",11.1,4,0) 4^F^661.4^2^^4^F "IX",661.4,661.4,"ASLHI",11.1,4,3) "IX",661.4,661.4,"XSHIL",0) 661.4^XSHIL^Index on STATION, HCPCS, HCPCS item, LOCATION fields.^R^^R^IR^I^661.4^^^^^LS "IX",661.4,661.4,"XSHIL",1) S ^RMPR(661.4,"XSHIL",X(1),X(2),X(3),X(4),DA)="" "IX",661.4,661.4,"XSHIL",2) K ^RMPR(661.4,"XSHIL",X(1),X(2),X(3),X(4),DA) "IX",661.4,661.4,"XSHIL",2.5) K ^RMPR(661.4,"XSHIL") "IX",661.4,661.4,"XSHIL",11.1,0) ^.114IA^4^4 "IX",661.4,661.4,"XSHIL",11.1,1,0) 1^F^661.4^3^^1^F "IX",661.4,661.4,"XSHIL",11.1,1,3) "IX",661.4,661.4,"XSHIL",11.1,2,0) 2^F^661.4^.01^^2^F "IX",661.4,661.4,"XSHIL",11.1,2,3) "IX",661.4,661.4,"XSHIL",11.1,3,0) 3^F^661.4^2^^3^F "IX",661.4,661.4,"XSHIL",11.1,3,3) "IX",661.4,661.4,"XSHIL",11.1,4,0) 4^F^661.4^7^^4^F "IX",661.4,661.4,"XSHIL",11.1,4,3) "IX",661.41,661.41,"ASSHID",0) 661.41^ASSHID^Index by Station, Status, HCPS, Item, Order Date^R^^R^IR^I^661.41^^^^^S "IX",661.41,661.41,"ASSHID",1) S ^RMPR(661.41,"ASSHID",X(1),X(2),$E(X(3),1,30),X(4),X(5),DA)="" "IX",661.41,661.41,"ASSHID",2) K ^RMPR(661.41,"ASSHID",X(1),X(2),$E(X(3),1,30),X(4),X(5),DA) "IX",661.41,661.41,"ASSHID",2.5) K ^RMPR(661.41,"ASSHID") "IX",661.41,661.41,"ASSHID",11.1,0) ^.114IA^5^5 "IX",661.41,661.41,"ASSHID",11.1,1,0) 1^F^661.41^2^^1^F "IX",661.41,661.41,"ASSHID",11.1,1,3) "IX",661.41,661.41,"ASSHID",11.1,2,0) 2^F^661.41^10^^2^F "IX",661.41,661.41,"ASSHID",11.1,2,3) "IX",661.41,661.41,"ASSHID",11.1,3,0) 3^F^661.41^5^30^3^F "IX",661.41,661.41,"ASSHID",11.1,3,3) "IX",661.41,661.41,"ASSHID",11.1,4,0) 4^F^661.41^1^^4^F "IX",661.41,661.41,"ASSHID",11.1,4,3) "IX",661.41,661.41,"ASSHID",11.1,5,0) 5^F^661.41^.01^^5^F "IX",661.41,661.41,"ASSHID",11.1,5,3) "IX",661.5,661.5,"AS",0) 661.5^AS^Station number index^R^^F^IR^I^661.5^^^^^S "IX",661.5,661.5,"AS",1) S ^RMPR(661.5,"AS",X,DA)="" "IX",661.5,661.5,"AS",2) K ^RMPR(661.5,"AS",X,DA) "IX",661.5,661.5,"AS",2.5) K ^RMPR(661.5,"AS") "IX",661.5,661.5,"AS",11.1,0) ^.114IA^1^1 "IX",661.5,661.5,"AS",11.1,1,0) 1^F^661.5^2^^1^F "IX",661.5,661.5,"AS",11.1,1,3) "IX",661.5,661.5,"ASSL",0) 661.5^ASSL^Stock location Status index^R^^R^IR^I^661.5^^^^^S "IX",661.5,661.5,"ASSL",.1,0) ^^2^2^3010116^ "IX",661.5,661.5,"ASSL",.1,1,0) This index is on Stock Location Status, Station and Name. Its purpose is "IX",661.5,661.5,"ASSL",.1,2,0) to be able to traverse locations which have a particular status. "IX",661.5,661.5,"ASSL",1) S ^RMPR(661.5,"ASSL",X(1),X(2),$E(X(3),1,30),DA)="" "IX",661.5,661.5,"ASSL",2) K ^RMPR(661.5,"ASSL",X(1),X(2),$E(X(3),1,30),DA) "IX",661.5,661.5,"ASSL",2.5) K ^RMPR(661.5,"ASSL") "IX",661.5,661.5,"ASSL",11.1,0) ^.114IA^3^3 "IX",661.5,661.5,"ASSL",11.1,1,0) 1^F^661.5^4^^1^F "IX",661.5,661.5,"ASSL",11.1,1,3) "IX",661.5,661.5,"ASSL",11.1,2,0) 2^F^661.5^2^^2^F "IX",661.5,661.5,"ASSL",11.1,2,3) "IX",661.5,661.5,"ASSL",11.1,3,0) 3^F^661.5^.01^30^3^F "IX",661.5,661.5,"ASSL",11.1,3,3) "IX",661.5,661.5,"XSL",0) 661.5^XSL^Uniqueness Index for Key 'A' of File #661.5^R^^R^IR^I^661.5^^^^^LS "IX",661.5,661.5,"XSL",1) S ^RMPR(661.5,"XSL",X(1),X(2),DA)="" "IX",661.5,661.5,"XSL",2) K ^RMPR(661.5,"XSL",X(1),X(2),DA) "IX",661.5,661.5,"XSL",2.5) K ^RMPR(661.5,"XSL") "IX",661.5,661.5,"XSL",11.1,0) ^.114IA^2^2 "IX",661.5,661.5,"XSL",11.1,1,0) 1^F^661.5^2^^1 "IX",661.5,661.5,"XSL",11.1,2,0) 2^F^661.5^.01^^2 "IX",661.6,661.6,"ADHS",0) 661.6^ADHS^xref on DATE&TIME STAMP, HCPCS and SEQUENCE^R^^R^IR^I^661.6^^^^^S "IX",661.6,661.6,"ADHS",1) S ^RMPR(661.6,"ADHS",X(1),$E(X(2),1,30),X(3),DA)="" "IX",661.6,661.6,"ADHS",2) K ^RMPR(661.6,"ADHS",X(1),$E(X(2),1,30),X(3),DA) "IX",661.6,661.6,"ADHS",2.5) K ^RMPR(661.6,"ADHS") "IX",661.6,661.6,"ADHS",11.1,0) ^.114IA^3^3 "IX",661.6,661.6,"ADHS",11.1,1,0) 1^F^661.6^2^^1^F "IX",661.6,661.6,"ADHS",11.1,1,3) "IX",661.6,661.6,"ADHS",11.1,2,0) 2^F^661.6^.01^30^2^F "IX",661.6,661.6,"ADHS",11.1,2,3) "IX",661.6,661.6,"ADHS",11.1,3,0) 3^F^661.6^3^^3^F "IX",661.6,661.6,"ADHS",11.1,3,3) "IX",661.6,661.6,"ASHD",0) 661.6^ASHD^STATION & HCPCS & DATE^R^^R^IR^I^661.6^^^^^S "IX",661.6,661.6,"ASHD",1) S ^RMPR(661.6,"ASHD",X(1),$E(X(2),1,30),X(3),DA)="" "IX",661.6,661.6,"ASHD",2) K ^RMPR(661.6,"ASHD",X(1),$E(X(2),1,30),X(3),DA) "IX",661.6,661.6,"ASHD",2.5) K ^RMPR(661.6,"ASHD") "IX",661.6,661.6,"ASHD",11.1,0) ^.114IA^3^3 "IX",661.6,661.6,"ASHD",11.1,1,0) 1^F^661.6^13^^1^F "IX",661.6,661.6,"ASHD",11.1,1,3) "IX",661.6,661.6,"ASHD",11.1,2,0) 2^F^661.6^.01^30^2^F "IX",661.6,661.6,"ASHD",11.1,2,3) "IX",661.6,661.6,"ASHD",11.1,3,0) 3^F^661.6^2^^3^F "IX",661.6,661.6,"ASHD",11.1,3,3) "IX",661.6,661.6,"ASLD",0) 661.6^ASLD^Index on Station ien, Location ien and date&time stamp^R^^R^IR^I^661.6^^^^^S "IX",661.6,661.6,"ASLD",1) S ^RMPR(661.6,"ASLD",X(1),X(2),X(3),DA)="" "IX",661.6,661.6,"ASLD",2) K ^RMPR(661.6,"ASLD",X(1),X(2),X(3),DA) "IX",661.6,661.6,"ASLD",2.5) K ^RMPR(661.6,"ASLD") "IX",661.6,661.6,"ASLD",11.1,0) ^.114IA^3^3 "IX",661.6,661.6,"ASLD",11.1,1,0) 1^F^661.6^13^^1^F "IX",661.6,661.6,"ASLD",11.1,1,3) "IX",661.6,661.6,"ASLD",11.1,2,0) 2^F^661.6^14^^2^F "IX",661.6,661.6,"ASLD",11.1,2,3) "IX",661.6,661.6,"ASLD",11.1,3,0) 3^F^661.6^2^^3^F "IX",661.6,661.6,"ASLD",11.1,3,3) "IX",661.6,661.6,"ASTHIDS",0) 661.6^ASTHIDS^Station, Transaction, HCPCS Item Index^R^^R^IR^I^661.6^^^^^S "IX",661.6,661.6,"ASTHIDS",.1,0) ^^4^4^3010117^ "IX",661.6,661.6,"ASTHIDS",.1,1,0) This cross-reference is an index on Station, Transaction type, HCPCS, "IX",661.6,661.6,"ASTHIDS",.1,2,0) Item, Date&Time stamp, and Sequence. "IX",661.6,661.6,"ASTHIDS",.1,3,0) It is used to sum total quantities and dollar values for a transaction "IX",661.6,661.6,"ASTHIDS",.1,4,0) type for a HCPCS Item between any 2 dates. "IX",661.6,661.6,"ASTHIDS",1) S ^RMPR(661.6,"ASTHIDS",X(1),X(2),$E(X(3),1,30),$E(X(4),1,30),X(5),X(6),DA)="" "IX",661.6,661.6,"ASTHIDS",2) K ^RMPR(661.6,"ASTHIDS",X(1),X(2),$E(X(3),1,30),$E(X(4),1,30),X(5),X(6),DA) "IX",661.6,661.6,"ASTHIDS",2.5) K ^RMPR(661.6,"ASTHIDS") "IX",661.6,661.6,"ASTHIDS",11.1,0) ^.114IA^6^6 "IX",661.6,661.6,"ASTHIDS",11.1,1,0) 1^F^661.6^13^^1^F "IX",661.6,661.6,"ASTHIDS",11.1,1,3) "IX",661.6,661.6,"ASTHIDS",11.1,2,0) 2^F^661.6^4^^2^F "IX",661.6,661.6,"ASTHIDS",11.1,2,3) "IX",661.6,661.6,"ASTHIDS",11.1,3,0) 3^F^661.6^.01^30^3^F "IX",661.6,661.6,"ASTHIDS",11.1,3,3) "IX",661.6,661.6,"ASTHIDS",11.1,4,0) 4^F^661.6^11^30^4^F "IX",661.6,661.6,"ASTHIDS",11.1,4,3) "IX",661.6,661.6,"ASTHIDS",11.1,5,0) 5^F^661.6^2^^5^F "IX",661.6,661.6,"ASTHIDS",11.1,5,3) "IX",661.6,661.6,"ASTHIDS",11.1,6,0) 6^F^661.6^3^^6^F "IX",661.6,661.6,"ASTHIDS",11.1,6,3) "IX",661.6,661.6,"XHDS",0) 661.6^XHDS^x-ref on HCPCS, DATE&TIME STAMP and SEQUENCE^R^^R^IR^I^661.6^^^^^LS "IX",661.6,661.6,"XHDS",.1,0) ^^2^2^3010117^^^ "IX",661.6,661.6,"XHDS",.1,1,0) The XHDS cross-reference is the main primary key reference for the "IX",661.6,661.6,"XHDS",.1,2,0) transaction file. "IX",661.6,661.6,"XHDS",1) S ^RMPR(661.6,"XHDS",$E(X(1),1,30),X(2),X(3),DA)="" "IX",661.6,661.6,"XHDS",2) K ^RMPR(661.6,"XHDS",$E(X(1),1,30),X(2),X(3),DA) "IX",661.6,661.6,"XHDS",2.5) K ^RMPR(661.6,"XHDS") "IX",661.6,661.6,"XHDS",11.1,0) ^.114IA^3^3 "IX",661.6,661.6,"XHDS",11.1,1,0) 1^F^661.6^.01^30^1^F "IX",661.6,661.6,"XHDS",11.1,1,3) "IX",661.6,661.6,"XHDS",11.1,2,0) 2^F^661.6^2^^2^F "IX",661.6,661.6,"XHDS",11.1,2,3) "IX",661.6,661.6,"XHDS",11.1,3,0) 3^F^661.6^3^^3^F "IX",661.6,661.6,"XHDS",11.1,3,3) "IX",661.6,661.6,"XSTD",0) 661.6^XSTD^S station, T type of transaction D date^R^^R^IR^I^661.6^^^^^LS "IX",661.6,661.6,"XSTD",.1,0) ^^1^1^3010515^ "IX",661.6,661.6,"XSTD",.1,1,0) Use for PIP report. "IX",661.6,661.6,"XSTD",1) S ^RMPR(661.6,"XSTD",X(1),X(2),X(3),DA)="" "IX",661.6,661.6,"XSTD",2) K ^RMPR(661.6,"XSTD",X(1),X(2),X(3),DA) "IX",661.6,661.6,"XSTD",2.5) K ^RMPR(661.6,"XSTD") "IX",661.6,661.6,"XSTD",11.1,0) ^.114IA^3^3 "IX",661.6,661.6,"XSTD",11.1,1,0) 1^F^661.6^13^^1^F "IX",661.6,661.6,"XSTD",11.1,1,3) "IX",661.6,661.6,"XSTD",11.1,2,0) 2^F^661.6^4^^2^F "IX",661.6,661.6,"XSTD",11.1,2,3) "IX",661.6,661.6,"XSTD",11.1,3,0) 3^F^661.6^2^^3^F "IX",661.6,661.6,"XSTD",11.1,3,3) "IX",661.7,661.7,"XHDS",0) 661.7^XHDS^Primary key cross-ref - HCPCS, DATE&TIME STAMP, SEQUENCE ^R^^R^IR^I^661.7^^^^^LS "IX",661.7,661.7,"XHDS",1) S ^RMPR(661.7,"XHDS",X(1),X(2),X(3),DA)="" "IX",661.7,661.7,"XHDS",2) K ^RMPR(661.7,"XHDS",X(1),X(2),X(3),DA) "IX",661.7,661.7,"XHDS",2.5) K ^RMPR(661.7,"XHDS") "IX",661.7,661.7,"XHDS",11.1,0) ^.114IA^3^3 "IX",661.7,661.7,"XHDS",11.1,1,0) 1^F^661.7^.01^^1^F "IX",661.7,661.7,"XHDS",11.1,1,3) "IX",661.7,661.7,"XHDS",11.1,2,0) 2^F^661.7^1^^2^F "IX",661.7,661.7,"XHDS",11.1,2,3) "IX",661.7,661.7,"XHDS",11.1,3,0) 3^F^661.7^2^^3^F "IX",661.7,661.7,"XHDS",11.1,3,3) "IX",661.7,661.7,"XSHIDS",0) 661.7^XSHIDS^xref for STATION, HCPCS, Item, DATE&TIME STAMP and SEQUENCE^R^^R^IR^I^661.7^^^^^LS "IX",661.7,661.7,"XSHIDS",1) S ^RMPR(661.7,"XSHIDS",X(1),X(2),$E(X(3),1,30),X(4),X(5),DA)="" "IX",661.7,661.7,"XSHIDS",2) K ^RMPR(661.7,"XSHIDS",X(1),X(2),$E(X(3),1,30),X(4),X(5),DA) "IX",661.7,661.7,"XSHIDS",2.5) K ^RMPR(661.7,"XSHIDS") "IX",661.7,661.7,"XSHIDS",11.1,0) ^.114IA^5^5 "IX",661.7,661.7,"XSHIDS",11.1,1,0) 1^F^661.7^4^^1^F "IX",661.7,661.7,"XSHIDS",11.1,1,3) "IX",661.7,661.7,"XSHIDS",11.1,2,0) 2^F^661.7^.01^^2^F "IX",661.7,661.7,"XSHIDS",11.1,2,3) "IX",661.7,661.7,"XSHIDS",11.1,3,0) 3^F^661.7^3^30^3^F "IX",661.7,661.7,"XSHIDS",11.1,3,3) "IX",661.7,661.7,"XSHIDS",11.1,4,0) 4^F^661.7^1^^4^F "IX",661.7,661.7,"XSHIDS",11.1,4,3) "IX",661.7,661.7,"XSHIDS",11.1,5,0) 5^F^661.7^2^^5^F "IX",661.7,661.7,"XSHIDS",11.1,5,3) "IX",661.7,661.7,"XSLHIDS",0) 661.7^XSLHIDS^Index on Station, Location, HCPCS, Item, Date&Time, Seq.^R^^R^IR^I^661.7^^^^^LS "IX",661.7,661.7,"XSLHIDS",1) S ^RMPR(661.7,"XSLHIDS",X(1),X(2),$E(X(3),1,30),X(4),X(5),X(6),DA)="" "IX",661.7,661.7,"XSLHIDS",2) K ^RMPR(661.7,"XSLHIDS",X(1),X(2),$E(X(3),1,30),X(4),X(5),X(6),DA) "IX",661.7,661.7,"XSLHIDS",2.5) K ^RMPR(661.7,"XSLHIDS") "IX",661.7,661.7,"XSLHIDS",11.1,0) ^.114IA^6^6 "IX",661.7,661.7,"XSLHIDS",11.1,1,0) 1^F^661.7^4^^1^F "IX",661.7,661.7,"XSLHIDS",11.1,1,3) "IX",661.7,661.7,"XSLHIDS",11.1,2,0) 2^F^661.7^5^^2^F "IX",661.7,661.7,"XSLHIDS",11.1,2,3) "IX",661.7,661.7,"XSLHIDS",11.1,3,0) 3^F^661.7^.01^30^3^F "IX",661.7,661.7,"XSLHIDS",11.1,3,3) "IX",661.7,661.7,"XSLHIDS",11.1,4,0) 4^F^661.7^3^^4^F "IX",661.7,661.7,"XSLHIDS",11.1,4,3) "IX",661.7,661.7,"XSLHIDS",11.1,5,0) 5^F^661.7^1^^5^F "IX",661.7,661.7,"XSLHIDS",11.1,5,3) "IX",661.7,661.7,"XSLHIDS",11.1,6,0) 6^F^661.7^2^^6^F "IX",661.7,661.7,"XSLHIDS",11.1,6,3) "IX",661.9,661.9,"ASHID",0) 661.9^ASHID^STATION & HCPCS & HCPCS ITEM & DATE^R^^R^IR^I^661.9^^^^^S "IX",661.9,661.9,"ASHID",1) S ^RMPR(661.9,"ASHID",X(1),X(2),X(3),X(4),DA)="" "IX",661.9,661.9,"ASHID",2) K ^RMPR(661.9,"ASHID",X(1),X(2),X(3),X(4),DA) "IX",661.9,661.9,"ASHID",2.5) K ^RMPR(661.9,"ASHID") "IX",661.9,661.9,"ASHID",11.1,0) ^.114IA^4^4 "IX",661.9,661.9,"ASHID",11.1,1,0) 1^F^661.9^4^^1^F "IX",661.9,661.9,"ASHID",11.1,1,3) "IX",661.9,661.9,"ASHID",11.1,2,0) 2^F^661.9^1^^2^F "IX",661.9,661.9,"ASHID",11.1,2,3) "IX",661.9,661.9,"ASHID",11.1,3,0) 3^F^661.9^2^^3^F "IX",661.9,661.9,"ASHID",11.1,3,3) "IX",661.9,661.9,"ASHID",11.1,4,0) 4^F^661.9^.01^^4^F "IX",661.9,661.9,"ASHID",11.1,4,3) "KEY",661.5,661.5,"A",0) 661.5^A^P^31 "KEY",661.5,661.5,"A",2,0) ^.312IA^2^2 "KEY",661.5,661.5,"A",2,1,0) 2^661.5^1 "KEY",661.5,661.5,"A",2,2,0) .01^661.5^2 "KEYPTR",661.5,661.5,"A") 661.5^XSL "KRN",19,5639,-1) 0^23 "KRN",19,5639,0) RMPR EDT 2319^Edit/Delete Issue From Stock^^R^^^^^^^^PROSTHETICS "KRN",19,5639,1,0) ^19.06^2^2^3011026^^^ "KRN",19,5639,1,1,0) This option edits the patient's VAF 10-2319 to correct Issue From Stock "KRN",19,5639,1,2,0) errors. "KRN",19,5639,25) RMPRPIYE "KRN",19,5639,"U") EDIT/DELETE ISSUE FROM STOCK "KRN",19,5646,-1) 0^32 "KRN",19,5646,0) RMPR ADD 2319^Issue From Stock^^R^^^^^^^^PROSTHETICS "KRN",19,5646,1,0) ^19.06^2^2^3040212^^^^ "KRN",19,5646,1,1,0) This records an issue from prosthetic stock and posts to the patient's "KRN",19,5646,1,2,0) VAF 10-2319 only. "KRN",19,5646,20) "KRN",19,5646,25) EN7^RMPROP "KRN",19,5646,"U") ISSUE FROM STOCK "KRN",19,10654,-1) 2^19 "KRN",19,10654,0) RMPR INV MAIN^Pros Inventory Main^^M^28^^^^^^^101^^1^1 "KRN",19,10654,10,0) ^19.01IP^13^10 "KRN",19,10654,10,2,0) 10671^AE^1 "KRN",19,10654,10,2,"^") RMPR INV ADD "KRN",19,10654,10,4,0) 10656^OI^5 "KRN",19,10654,10,4,"^") RMPR INV ORDER "KRN",19,10654,10,5,0) 10657^RC^6 "KRN",19,10654,10,5,"^") RMPR INV RECEIVE "KRN",19,10654,10,6,0) 10660^TR^7 "KRN",19,10654,10,6,"^") RMPR INV TRAN "KRN",19,10654,10,7,0) 10661^UP^8 "KRN",19,10654,10,7,"^") RMPR INV RECONCILE "KRN",19,10654,10,8,0) 10663^RP^10 "KRN",19,10654,10,8,"^") RMPR INV REPORTS "KRN",19,10654,10,9,0) 10670^EI^2 "KRN",19,10654,10,9,"^") RMPR INV EDIT "KRN",19,10654,10,11,0) 11320^EL^3 "KRN",19,10654,10,11,"^") RMPR INV EDIT LOCATION "KRN",19,10654,10,12,0) 11443^DE^4 "KRN",19,10654,10,12,"^") RMPR INV DEACTIVATE "KRN",19,10654,10,13,0) 11630^RE^9 "KRN",19,10654,10,13,"^") RMPR INV REMOVE HCPCS/ITEM "KRN",19,10654,"U") PROS INVENTORY MAIN "KRN",19,10656,-1) 0^5 "KRN",19,10656,0) RMPR INV ORDER^Order Item from Supply or Vendor^^R^^^^^^^^^^ "KRN",19,10656,1,0) ^^3^3^2990107^ "KRN",19,10656,1,1,0) This is an option to record an Item has been ordered. This option will "KRN",19,10656,1,2,0) not automatically order an item from Supply or Vendor. In the future this "KRN",19,10656,1,3,0) option will link to IFCAP, thus ordering will be done in Prosthetics. "KRN",19,10656,20) "KRN",19,10656,25) RMPRPIYO "KRN",19,10656,99) 57387,26549 "KRN",19,10656,"U") ORDER ITEM FROM SUPPLY OR VEND "KRN",19,10657,-1) 0^6 "KRN",19,10657,0) RMPR INV RECEIVE^Receive Item from Supply, Vendor or Patient^^R^^^^^^^^^^ "KRN",19,10657,1,0) ^^5^5^2990107^ "KRN",19,10657,1,1,0) This is an option to record that an Item has been received and entered "KRN",19,10657,1,2,0) into the Prosthetics Inventory. Receiving an Item in Supply through the "KRN",19,10657,1,3,0) IFCAP package does not update the Prosthetics Inventory module. This "KRN",19,10657,1,4,0) option has to be done seperately for an Item to be received and recorded "KRN",19,10657,1,5,0) in the Prosthetics module. "KRN",19,10657,20) "KRN",19,10657,25) RC^RMPRPIYG "KRN",19,10657,99) 57387,26563 "KRN",19,10657,"U") RECEIVE ITEM FROM SUPPLY, VEND "KRN",19,10658,-1) 0^15 "KRN",19,10658,0) RMPR INV STOCK BY LOCATION^Print Current Item Balance by Location^^R^^^^^^^^^^ "KRN",19,10658,1,0) ^^1^1^2990107^^ "KRN",19,10658,1,1,0) This option prints the current Prosthetics Inventory balance by Location. "KRN",19,10658,20) "KRN",19,10658,25) RMPRPI05 "KRN",19,10658,99) 57385,33476 "KRN",19,10658,"U") PRINT CURRENT ITEM BALANCE BY "KRN",19,10659,-1) 0^16 "KRN",19,10659,0) RMPR INV PRINT/CHECK BAL^Print Transaction History^^R^^^^^^^^^^ "KRN",19,10659,1,0) ^19.06^4^4^3011205^^ "KRN",19,10659,1,1,0) This is an option to print a daily Item statistics of all or particular "KRN",19,10659,1,2,0) HCPCS and ITEMS that are in Prosthetics Inventory. This option prints the "KRN",19,10659,1,3,0) VA form 10-1210. The report shows all the statistics of a particular "KRN",19,10659,1,4,0) HCPCS and ITEMS and dollar amount for certain date range. "KRN",19,10659,20) "KRN",19,10659,25) RMPRPI04 "KRN",19,10659,99) 57387,26613 "KRN",19,10659,"U") PRINT TRANSACTION HISTORY "KRN",19,10660,-1) 0^7 "KRN",19,10660,0) RMPR INV TRAN^Transfer Stock Between Locations^^R^^^^^^^^^^ "KRN",19,10660,1,0) ^19.06^4^4^3020122^^^^ "KRN",19,10660,1,1,0) This is an option to transfer an Item to a different Location. In order "KRN",19,10660,1,2,0) to transfer an Item, it must be set-up to both Location. User can "KRN",19,10660,1,3,0) transfer all Quantities or certain Quantities. This option does not "KRN",19,10660,1,4,0) remove an item from a location if all quantities have been transferred. "KRN",19,10660,20) "KRN",19,10660,25) TR^RMPRPIYT "KRN",19,10660,99) 57419,32993 "KRN",19,10660,"U") TRANSFER STOCK BETWEEN LOCATIO "KRN",19,10661,-1) 0^8 "KRN",19,10661,0) RMPR INV RECONCILE^Reconcile Item Balance^^R^^RMPRMANAGER^^^^^^^^ "KRN",19,10661,1,0) ^^3^3^2990107^ "KRN",19,10661,1,1,0) This is an option to reconcile or update Items in Prosthetics Inventory. "KRN",19,10661,1,2,0) User should be able to update the Quantity, Total Cost, Vendor, Unit of "KRN",19,10661,1,3,0) Issue, Re-order Level and Description. "KRN",19,10661,20) "KRN",19,10661,25) UP^RMPRPIYA "KRN",19,10661,99) 57415,44888 "KRN",19,10661,"U") RECONCILE ITEM BALANCE "KRN",19,10663,-1) 2^9 "KRN",19,10663,0) RMPR INV REPORTS^Inventory Reports^^M^28^^^^^^^101^^ "KRN",19,10663,10,0) ^19.01IP^18^15 "KRN",19,10663,10,2,0) 10659^PS^7 "KRN",19,10663,10,2,"^") RMPR INV PRINT/CHECK BAL "KRN",19,10663,10,3,0) 10658^PL^6 "KRN",19,10663,10,3,"^") RMPR INV STOCK BY LOCATION "KRN",19,10663,10,4,0) 10664^PI^5 "KRN",19,10663,10,4,"^") RMPR INV STOCK BY HCPCS "KRN",19,10663,10,6,0) 11093^SS^4 "KRN",19,10663,10,6,"^") RMPR INV ON HND SUM "KRN",19,10663,10,7,0) 11094^SG^3 "KRN",19,10663,10,7,"^") RMPR INV ON HND GROUP/LINE "KRN",19,10663,10,8,0) 11095^SH^2 "KRN",19,10663,10,8,"^") RMPR INV ON HND HCPCS "KRN",19,10663,10,9,0) 11096^SI^1 "KRN",19,10663,10,9,"^") RMPR INV ON HND ITEM "KRN",19,10663,10,10,0) 11278^PO^8 "KRN",19,10663,10,10,"^") RMPR INV PRINT ORDER/RECEIVE "KRN",19,10663,10,11,0) 11279^IU^9 "KRN",19,10663,10,11,"^") RMPR INV PRINT ITEM USAGE "KRN",19,10663,10,12,0) 11344^WS^10 "KRN",19,10663,10,12,"^") RMPR INV PRINT WORK SHEET "KRN",19,10663,10,13,0) 11349^BC^11 "KRN",19,10663,10,13,"^") RMPR INV REPRINT BARCODE "KRN",19,10663,10,15,0) 11379^OD^13 "KRN",19,10663,10,15,"^") RMPR INV PRINT OVER DATE "KRN",19,10663,10,16,0) 11376^P3^12 "KRN",19,10663,10,16,"^") RMPR INV PRINT 30-DAY "KRN",19,10663,10,17,0) 11617^AL^14 "KRN",19,10663,10,17,"^") RMPR INV PRINT ALL BARCODE "KRN",19,10663,10,18,0) 11627^IP^15 "KRN",19,10663,10,18,"^") RMPR INV PIP/IFCAP ITEM REPORT "KRN",19,10663,"U") INVENTORY REPORTS "KRN",19,10664,-1) 0^14 "KRN",19,10664,0) RMPR INV STOCK BY HCPCS^Print Current HCPCS Balance by HCPCS^^R^^^^^^^^ "KRN",19,10664,1,0) ^^1^1^2990107^^^^ "KRN",19,10664,1,1,0) Report to print the current inventory stock by HCPCS. "KRN",19,10664,25) RMPRPI06 "KRN",19,10664,"U") PRINT CURRENT HCPCS BALANCE BY "KRN",19,10670,-1) 0^2 "KRN",19,10670,0) RMPR INV EDIT^Edit Inventory Items^^R^^^^^^^^ "KRN",19,10670,1,0) ^^2^2^3030214^ "KRN",19,10670,1,1,0) This option is for editing an Inventory Location or Items. You can "KRN",19,10670,1,2,0) only edit an Item or Location that had already been set-up. "KRN",19,10670,25) EI^RMPRPIY6 "KRN",19,10670,"U") EDIT INVENTORY ITEMS "KRN",19,10671,-1) 0^1 "KRN",19,10671,0) RMPR INV ADD^Add Inventory LOCATION or ITEMS^^R^^^^^^^^PROSTHETICS^^ "KRN",19,10671,1,0) ^19.06^2^2^3040210^^^ "KRN",19,10671,1,1,0) This is an option to ADD a Location, HCPCS or ITEMS for inventory. User "KRN",19,10671,1,2,0) should also be able to edit item fields under this option. "KRN",19,10671,20) "KRN",19,10671,25) AE^RMPRPIY9 "KRN",19,10671,99) 57387,26464 "KRN",19,10671,"U") ADD INVENTORY LOCATION OR ITEM "KRN",19,11093,-1) 0^13 "KRN",19,11093,0) RMPR INV ON HND SUM^NPPD Group Summary Report^^R^^^^^^^^PROSTHETICS "KRN",19,11093,25) EN1^RMPRPIQ4 "KRN",19,11093,"U") NPPD GROUP SUMMARY REPORT "KRN",19,11094,-1) 0^12 "KRN",19,11094,0) RMPR INV ON HND GROUP/LINE^NPPD Group/Line Report^^R^^^^^^^^PROSTHETICS "KRN",19,11094,1,0) ^19.06^1^1^3040510^^^ "KRN",19,11094,1,1,0) Display Stock On Hand for a date range, sorted by NPPD Line. "KRN",19,11094,25) EN2^RMPRPIQ4 "KRN",19,11094,"U") NPPD GROUP/LINE REPORT "KRN",19,11095,-1) 0^11 "KRN",19,11095,0) RMPR INV ON HND HCPCS^HCPCS Summary Report^^R^^^^^^^^PROSTHETICS "KRN",19,11095,1,0) ^19.06^1^1^3001211^^ "KRN",19,11095,1,1,0) Display Stock On Hand, for a date range, sorted by HCPCS. "KRN",19,11095,25) EN3^RMPRPIQ4 "KRN",19,11095,"U") HCPCS SUMMARY REPORT "KRN",19,11096,-1) 0^10 "KRN",19,11096,0) RMPR INV ON HND ITEM^Item Detail Report^^R^^^^^^^^PROSTHETICS "KRN",19,11096,1,0) ^19.06^1^1^3001211^^^ "KRN",19,11096,1,1,0) Display Stock On Hand, for a date range, sorted by Item. "KRN",19,11096,25) EN4^RMPRPIQ4 "KRN",19,11096,"U") ITEM DETAIL REPORT "KRN",19,11278,-1) 0^17 "KRN",19,11278,0) RMPR INV PRINT ORDER/RECEIVE^Print Order/Receive Item^^R^^^^^^^^PROSTHETICS^^ "KRN",19,11278,1,0) ^^3^3^3020211^ "KRN",19,11278,1,1,0) This option prints the Open, Receive or Cancel item in the PIP. User will "KRN",19,11278,1,2,0) be asked on the number of days back an item was received, opened or "KRN",19,11278,1,3,0) cancelled. "KRN",19,11278,20) "KRN",19,11278,25) RMPRPI09 "KRN",19,11278,"U") PRINT ORDER/RECEIVE ITEM "KRN",19,11279,-1) 0^18 "KRN",19,11279,0) RMPR INV PRINT ITEM USAGE^Print Item Usage By Location^^R^^^^^^^^PROSTHETICS "KRN",19,11279,1,0) ^^4^4^3020802^ "KRN",19,11279,1,1,0) This option prints a report that shows the same information as in the PIP "KRN",19,11279,1,2,0) roll-up that is activated by CO, if the date range this report runs is the "KRN",19,11279,1,3,0) same. It displays Stock On Hand for certain date range, sorted by "KRN",19,11279,1,4,0) Location, HCPCS and Item for either NEW or OLD items. "KRN",19,11279,25) RMPRPI08 "KRN",19,11279,"U") PRINT ITEM USAGE BY LOCATION "KRN",19,11320,-1) 0^20 "KRN",19,11320,0) RMPR INV EDIT LOCATION^Edit Inventory Location^^R^^^^^^^^ "KRN",19,11320,1,0) ^19.06^1^1^3050202^^ "KRN",19,11320,1,1,0) This option is for editing an existing inventory location. "KRN",19,11320,25) EL^RMPRPIYN "KRN",19,11320,"U") EDIT INVENTORY LOCATION "KRN",19,11344,-1) 0^21 "KRN",19,11344,0) RMPR INV PRINT WORK SHEET^Print Stock Work Sheet^^R^^^^^^^^ "KRN",19,11344,1,0) ^^3^3^3010924^ "KRN",19,11344,1,1,0) This report prints the inventory stock by Location of a particular "KRN",19,11344,1,2,0) station. It shows the HCPCS, Item descripton, Date, Cost, Vendor "KRN",19,11344,1,3,0) Quantity, Location and a blank column for the Physical Count. "KRN",19,11344,25) RMPRPI15 "KRN",19,11344,"U") PRINT STOCK WORK SHEET "KRN",19,11349,-1) 0^22 "KRN",19,11349,0) RMPR INV REPRINT BARCODE^Reprint Barcode Label^^R^^^^^^^^ "KRN",19,11349,1,0) ^^2^2^3011005^ "KRN",19,11349,1,1,0) This option allows inventory users to print barcode labels. Only HCPCS "KRN",19,11349,1,2,0) in PIP can be printed using this option. "KRN",19,11349,25) PB^RMPRPIYS "KRN",19,11349,"U") REPRINT BARCODE LABEL "KRN",19,11376,-1) 0^27 "KRN",19,11376,0) RMPR INV PRINT 30-DAY^Print Items Not Issued Within 30-Day^^R^^^^^^^^ "KRN",19,11376,1,0) ^^2^2^3021120^ "KRN",19,11376,1,1,0) This report prints items not issued within 30 days period. Items issued "KRN",19,11376,1,2,0) within 30 days will not be printed in this report. "KRN",19,11376,25) RMPRPI14 "KRN",19,11376,"U") PRINT ITEMS NOT ISSUED WITHIN "KRN",19,11379,-1) 0^25 "KRN",19,11379,0) RMPR INV PRINT OVER DATE^Print Stock On Hand Over Date Range^^R^^^^^^^^ "KRN",19,11379,1,0) ^^3^3^3011219^ "KRN",19,11379,1,1,0) This report prints all Items in a particular Location, where the number of "KRN",19,11379,1,2,0) Days On Hand is greater than the number of Date Range selected. "KRN",19,11379,1,3,0) Sort creteria are based on Locations and New or Old Items. "KRN",19,11379,25) RMPRPI10 "KRN",19,11379,"U") PRINT STOCK ON HAND OVER DATE "KRN",19,11443,-1) 0^26 "KRN",19,11443,0) RMPR INV DEACTIVATE^Deactivate Inventory Location^^R^^^^^^^^ "KRN",19,11443,1,0) ^19.06^3^3^3050202^^^ "KRN",19,11443,1,1,0) This option is only given to the holder of RMPRMANGAER key. It requires "KRN",19,11443,1,2,0) the electronic signatures of 2 users holding the RMPRMANAGER key to be "KRN",19,11443,1,3,0) entered before a location can be deactivated. "KRN",19,11443,25) DL^RMPRPIYL "KRN",19,11443,"U") DEACTIVATE INVENTORY LOCATION "KRN",19,11617,-1) 0^29 "KRN",19,11617,0) RMPR INV PRINT ALL BARCODE^Print All Barcode in a Location^^R^^RMPRMANAGER^^^^^^PROSTHETICS "KRN",19,11617,1,0) ^19.06^4^4^3021126^^^ "KRN",19,11617,1,1,0) This option prints barcode of all items in a specific location for a "KRN",19,11617,1,2,0) station. In order to use this option, user must have an RMPRMANAGER "KRN",19,11617,1,3,0) key. Be sure to have enough labels before using this option, since it "KRN",19,11617,1,4,0) will print labels for all items in a given station. "KRN",19,11617,25) PB^RMPRPIYZ "KRN",19,11617,"U") PRINT ALL BARCODE IN A LOCATIO "KRN",19,11627,-1) 0^30 "KRN",19,11627,0) RMPR INV PIP/IFCAP ITEM REPORT^Print PIP/IFCAP Item Report^^R^^^^^^^^ "KRN",19,11627,1,0) ^^4^4^3021211^ "KRN",19,11627,1,1,0) This report prints all PIP items and the corresponding IFCAP items. "KRN",19,11627,1,2,0) Prosthetics users must edit the HCPCS/ITEM that has a blank IFCAP ITEM. "KRN",19,11627,1,3,0) This report is useful for checking if the IFCAP ITEM is correctly link to "KRN",19,11627,1,4,0) the PIP Item. "KRN",19,11627,25) RMPRPI16 "KRN",19,11627,"U") PRINT PIP/IFCAP ITEM REPORT "KRN",19,11630,-1) 0^31 "KRN",19,11630,0) RMPR INV REMOVE HCPCS/ITEM^Remove/Deactivate HCPCS/Item from Inventory^^R^^RMPRMANAGER^^^^^^PROSTHETICS "KRN",19,11630,1,0) ^^4^4^3030102^ "KRN",19,11630,1,1,0) This option removes/deactivates inventory item(s) from Prosthetics "KRN",19,11630,1,2,0) Inventory Program. Once an item has been removed/deactivated, that "KRN",19,11630,1,3,0) item is not accessible. Only users with RMPRMANAGER key can access this "KRN",19,11630,1,4,0) option. "KRN",19,11630,25) RE^RMPRPIXR "KRN",19,11630,"U") REMOVE/DEACTIVATE HCPCS/ITEM F "KRN",19,12354,-1) 1^4 "KRN",19,12354,0) RMPR INV REMOVE "KRN",19,12355,-1) 1^28 "KRN",19,12355,0) RMPR INV DELETE "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^ "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 61^3050309^28 "PKG",101,22,1,"PAH",1,1,0) ^^1^1^3050309 "PKG",101,22,1,"PAH",1,1,1,0) Patch #61 - Barcoding and File Redesign. "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") 99 "RTN","RMPR5HQ5") 0^100^B40855688 "RTN","RMPR5HQ5",1,0) RMPR5HQ5 ;HCIOFO/ODJ - INVENTORY REPORT - BUILD ^TMP SORT ARRAY ; 20 SEP 00 "RTN","RMPR5HQ5",2,0) ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996 "RTN","RMPR5HQ5",3,0) ; "RTN","RMPR5HQ5",4,0) ;RVD -patch #61 - modified to read the new PIP files; 661.11, 661.6 "RTN","RMPR5HQ5",5,0) ; 661.7, 661.9 "RTN","RMPR5HQ5",6,0) Q "RTN","RMPR5HQ5",7,0) ; "RTN","RMPR5HQ5",8,0) ; Start of Report build and print. Enter here after report params. "RTN","RMPR5HQ5",9,0) ; entered by user (see RMPR5HQ4). "RTN","RMPR5HQ5",10,0) ; Also called by TaskMan if report queued. "RTN","RMPR5HQ5",11,0) ; "RTN","RMPR5HQ5",12,0) ; Variables required "RTN","RMPR5HQ5",13,0) ; "RTN","RMPR5HQ5",14,0) ; RMPR("STA") "RTN","RMPR5HQ5",15,0) ; RMPRSDT "RTN","RMPR5HQ5",16,0) ; RMPREDT "RTN","RMPR5HQ5",17,0) ; RMPRDET "RTN","RMPR5HQ5",18,0) ; RMPRSEL "RTN","RMPR5HQ5",19,0) ; {IO vars} "RTN","RMPR5HQ5",20,0) ; "RTN","RMPR5HQ5",21,0) REPORT I $E(IOST)["C" W !!,"Processing report......." "RTN","RMPR5HQ5",22,0) D GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPR("STA")) ;generate ^TMP sort array "RTN","RMPR5HQ5",23,0) D CALC^RMPR5HQ6 ;calculations "RTN","RMPR5HQ5",24,0) U IO D ^RMPR5HQ2 ;print report "RTN","RMPR5HQ5",25,0) D ^%ZISC "RTN","RMPR5HQ5",26,0) ;K ^TMP($J,"RMPR5") ;make live after testing "RTN","RMPR5HQ5",27,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPR5HQ5",28,0) Q "RTN","RMPR5HQ5",29,0) ; "RTN","RMPR5HQ5",30,0) ; Entry point for national roll-up "RTN","RMPR5HQ5",31,0) NATION N RMPRSEL,RMPRDET,RMPRSTN,RMPRSDT,RMPREDT,X,RSTN "RTN","RMPR5HQ5",32,0) S RMPRSTN="*" "RTN","RMPR5HQ5",33,0) S RMPRDET="H" "RTN","RMPR5HQ5",34,0) ;D NOW^%DTC S RMPREDT=X S %H=%H-30 D YMD^%DTC S RMPRSDT=X "RTN","RMPR5HQ5",35,0) S RMPRSDT=RMPRPIP1,RMPREDT=RMPRPIP2 "RTN","RMPR5HQ5",36,0) S RMPRSEL("*")="" "RTN","RMPR5HQ5",37,0) D GEN(RMPRSDT,RMPREDT,RMPRDET,.RMPRSEL,RMPRSTN) "RTN","RMPR5HQ5",38,0) D CALC^RMPR5HQ6 ;put calcs in TMP array "RTN","RMPR5HQ5",39,0) D MAIL^RMPR5HQ7 ;build ^TMP($J,"RMPR5A" array for mailing "RTN","RMPR5HQ5",40,0) Q "RTN","RMPR5HQ5",41,0) ; "RTN","RMPR5HQ5",42,0) ; "RTN","RMPR5HQ5",43,0) ; Generate temporary index global ^TMP($J,"RMPR5" "RTN","RMPR5HQ5",44,0) ; (as of 11/29/00 we use the 660 file, not 661.2) "RTN","RMPR5HQ5",45,0) ; "RTN","RMPR5HQ5",46,0) GEN(STDT,ENDT,DETAIL,RMPRSEL,RMPRSTN) ; "RTN","RMPR5HQ5",47,0) N TNAM,FROM,EOF,DAT,HCDAT,HCPCIEN,NPGRP,NPLIN,S,HCPC,HCPCITEM "RTN","RMPR5HQ5",48,0) N OUPIEN,ITEM,ALLGRP,HCPCREF,SELECTED,STATION,QTY,STR,MULITEM "RTN","RMPR5HQ5",49,0) N ITMIEN,INVDT,SOURCE,ISCOST,PATIENT,COST "RTN","RMPR5HQ5",50,0) S TNAM="RMPR5" ;TMP global name "RTN","RMPR5HQ5",51,0) K ^TMP($J,TNAM) "RTN","RMPR5HQ5",52,0) D CURVAL(TNAM,RMPRSTN,.RMPRSEL,DETAIL) "RTN","RMPR5HQ5",53,0) ;S FROM="" S:$G(STDT)'="*" FROM=STDT-1 "RTN","RMPR5HQ5",54,0) S RSTN=RMPRSTN "RTN","RMPR5HQ5",55,0) S:RMPRSTN="*" RSTN=1 "RTN","RMPR5HQ5",56,0) S EOF=0,ENDT=ENDT+1 "RTN","RMPR5HQ5",57,0) F RSTN=RSTN:0 S RSTN=$O(^RMPR(661.6,"XSTD",RSTN)) Q:RSTN'>0 D "RTN","RMPR5HQ5",58,0) .F RSDT=STDT:0 S RSDT=$O(^RMPR(661.6,"XSTD",RSTN,3,RSDT)) Q:(RSDT>ENDT)!(RSDT="") D Q:EOF "RTN","RMPR5HQ5",59,0) .. S OUPIEN=0 "RTN","RMPR5HQ5",60,0) .. F S OUPIEN=$O(^RMPR(661.6,"XSTD",RSTN,3,RSDT,OUPIEN)) Q:OUPIEN'>0 D "RTN","RMPR5HQ5",61,0) ... S S=$G(^RMPR(661.6,OUPIEN,0)) "RTN","RMPR5HQ5",62,0) ... S PATIENT=$P(S,"^",2) Q:PATIENT="" "RTN","RMPR5HQ5",63,0) ... S QTY=+$P(S,"^",5) Q:QTY<1 "RTN","RMPR5HQ5",64,0) ... S HCPC=$P(S,"^",1) Q:HCPC="" "RTN","RMPR5HQ5",65,0) ... S HCPCIEN=$O(^RMPR(661.1,"B",HCPC,0)) Q:HCPCIEN="" "RTN","RMPR5HQ5",66,0) ... S STATION=RSTN Q:STATION="" "RTN","RMPR5HQ5",67,0) ... I RMPRSTN'="*",STATION'=RSTN Q "RTN","RMPR5HQ5",68,0) ... Q:'$D(^TMP($J,TNAM,"Z",HCPCIEN)) "RTN","RMPR5HQ5",69,0) ... Q:$P(^TMP($J,TNAM,"Z",HCPCIEN),"^",3)=1 "RTN","RMPR5HQ5",70,0) ... S HCPCITEM=HCPC_"-"_$P(S,"^",11) "RTN","RMPR5HQ5",71,0) ... S ITEM=$P(HCPCITEM,"-",2) "RTN","RMPR5HQ5",72,0) ... S:ITEM="" ITEM="?" "RTN","RMPR5HQ5",73,0) ... S ISCOST=$P(S,"^",6) "RTN","RMPR5HQ5",74,0) ...; S COST=$$PRECOST(OUPIEN,HCPCIEN,HCPCITEM,STATION) "RTN","RMPR5HQ5",75,0) ...; I COST'="" S ISCOST=COST-ISCOST "RTN","RMPR5HQ5",76,0) ...; S:COST="" ISCOST=QTY*$P(S,"^",5) "RTN","RMPR5HQ5",77,0) ... S R11=$O(^RMPR(661.11,"C",HCPCITEM,0)) "RTN","RMPR5HQ5",78,0) ... S R11DAT=$G(^RMPR(661.11,R11,0)) "RTN","RMPR5HQ5",79,0) ... S SOURCE=$P(R11DAT,"^",5) "RTN","RMPR5HQ5",80,0) ... S STR=^TMP($J,TNAM,"Z",HCPCIEN) "RTN","RMPR5HQ5",81,0) ... S NPGRP=$P(STR,"^",1) "RTN","RMPR5HQ5",82,0) ... S NPLIN=$P(STR,"^",2) "RTN","RMPR5HQ5",83,0) ... S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN "RTN","RMPR5HQ5",84,0) ... I '$D(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)) D Q:'+QTY "RTN","RMPR5HQ5",85,0) .... S:+QTY ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)="" "RTN","RMPR5HQ5",86,0) .... Q "RTN","RMPR5HQ5",87,0) ... S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM,OUPIEN)=QTY_"^"_ISCOST_"^"_SOURCE "RTN","RMPR5HQ5",88,0) ... Q "RTN","RMPR5HQ5",89,0) .. Q "RTN","RMPR5HQ5",90,0) Q "RTN","RMPR5HQ5",91,0) ; "RTN","RMPR5HQ5",92,0) ; Get total cost of item just prior to current issue "RTN","RMPR5HQ5",93,0) PRECOST(INVIEN,HCPCIEN,HCPCITEM,STATION) ; "RTN","RMPR5HQ5",94,0) N IEN,COST,STR,LOC "RTN","RMPR5HQ5",95,0) S COST="" "RTN","RMPR5HQ5",96,0) S IEN=INVIEN,RD=RMPRSDT "RTN","RMPR5HQ5",97,0) S RD=$O(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD),-1) "RTN","RMPR5HQ5",98,0) Q:'$G(RD) COST S RIEN=$O(^RMPR(661.9,"ASHID",RSTN,HCPC,IEN,RD,0)) "RTN","RMPR5HQ5",99,0) S STR=^RMPR(661.9,RIEN,0) "RTN","RMPR5HQ5",100,0) S COST=$P(STR,"^",9) "RTN","RMPR5HQ5",101,0) Q COST "RTN","RMPR5HQ5",102,0) ; "RTN","RMPR5HQ5",103,0) ; Get QOH for HCPC "RTN","RMPR5HQ5",104,0) CURVAL(RMPRNAM,RMPRSTN,RMPRSEL,DETAIL) ; "RTN","RMPR5HQ5",105,0) N INVIEN,STR,IEN1,IEN2,LOCN,HCPCIEN,HCDAT,NPLIN,NPGRP,ALLGRP,SELECTED "RTN","RMPR5HQ5",106,0) N S,SOURCE,STATION,QOH,COST,HCPC,HCPCREF,ITEM,RSTN "RTN","RMPR5HQ5",107,0) S ALLGRP=0 S:$O(RMPRSEL(""))="*" ALLGRP=1 "RTN","RMPR5HQ5",108,0) S RSTN=RMPRSTN "RTN","RMPR5HQ5",109,0) S:RMPRSTN="*" RSTN=1 "RTN","RMPR5HQ5",110,0) F RSTN=RSTN:0 S RSTN=$O(^RMPR(661.9,"ASHID",RSTN)) Q:RSTN'>0 D "RTN","RMPR5HQ5",111,0) .S RH="" "RTN","RMPR5HQ5",112,0) .F S RH=$O(^RMPR(661.9,"ASHID",RSTN,RH)) Q:RH="" D "RTN","RMPR5HQ5",113,0) .. S IEN1=0 "RTN","RMPR5HQ5",114,0) .. F S IEN1=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1)) Q:'+IEN1 D "RTN","RMPR5HQ5",115,0) ... S HCPCIEN=$O(^RMPR(661.1,"B",RH,0)) Q:HCPCIEN="" "RTN","RMPR5HQ5",116,0) ... I '$D(^TMP($J,RMPRNAM,"Z",HCPCIEN)) D "RTN","RMPR5HQ5",117,0) .... S S=^RMPR(661.1,HCPCIEN,0) "RTN","RMPR5HQ5",118,0) .... S NPLIN=$P(S,"^",7) "RTN","RMPR5HQ5",119,0) .... S:NPLIN="" NPLIN="999 X" "RTN","RMPR5HQ5",120,0) .... S NPGRP=$P(NPLIN," ",1) ;group num. is 1st set of digits of new line "RTN","RMPR5HQ5",121,0) .... S STR=NPGRP "RTN","RMPR5HQ5",122,0) .... S $P(STR,"^",2)=NPLIN "RTN","RMPR5HQ5",123,0) .... S ^TMP($J,RMPRNAM,"Z",HCPCIEN)=STR "RTN","RMPR5HQ5",124,0) .... Q "RTN","RMPR5HQ5",125,0) ... E D Q:$P(S,"^",3)=1 "RTN","RMPR5HQ5",126,0) .... S S=^TMP($J,RMPRNAM,"Z",HCPCIEN) "RTN","RMPR5HQ5",127,0) .... S NPGRP=$P(S,"^",1) "RTN","RMPR5HQ5",128,0) .... S NPLIN=$P(S,"^",2) "RTN","RMPR5HQ5",129,0) .... Q "RTN","RMPR5HQ5",130,0) ... ; "RTN","RMPR5HQ5",131,0) ... ; Test if record matches selection criteria "RTN","RMPR5HQ5",132,0) ... ; (only needed if not all groups selected) "RTN","RMPR5HQ5",133,0) ... I 'ALLGRP D I 'SELECTED S $P(^TMP($J,RMPRNAM,"Z",HCPCIEN),"^",3)=1 Q "RTN","RMPR5HQ5",134,0) .... S SELECTED=0 "RTN","RMPR5HQ5",135,0) .... I '$D(RMPRSEL(NPGRP)) Q "RTN","RMPR5HQ5",136,0) .... I DETAIL="G" S SELECTED=1 Q "RTN","RMPR5HQ5",137,0) .... I $O(RMPRSEL(NPGRP,""))="*" S SELECTED=1 Q "RTN","RMPR5HQ5",138,0) .... I '$D(RMPRSEL(NPGRP,NPLIN)) Q "RTN","RMPR5HQ5",139,0) .... I DETAIL="L" S SELECTED=1 Q "RTN","RMPR5HQ5",140,0) .... I $O(RMPRSEL(NPGRP,NPLIN,""))="*" S SELECTED=1 Q "RTN","RMPR5HQ5",141,0) .... I '$D(RMPRSEL(NPGRP,NPLIN,HCPCIEN)) Q "RTN","RMPR5HQ5",142,0) .... S SELECTED=1 "RTN","RMPR5HQ5",143,0) .... Q "RTN","RMPR5HQ5",144,0) ... S RD="" "RTN","RMPR5HQ5",145,0) ... S RD=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD),-1),RIEN=$O(^RMPR(661.9,"ASHID",RSTN,RH,IEN1,RD,0)) D "RTN","RMPR5HQ5",146,0) .... S HCPC=RH,S=^RMPR(661.9,RIEN,0) "RTN","RMPR5HQ5",147,0) .... S QOH=+$P(S,"^",8) Q:'QOH "RTN","RMPR5HQ5",148,0) .... S COST=$P(S,"^",9) "RTN","RMPR5HQ5",149,0) .... S ITEM=IEN1 "RTN","RMPR5HQ5",150,0) .... S RS=$O(^RMPR(661.11,"C",HCPC_"-"_ITEM,0)) Q:RS="" "RTN","RMPR5HQ5",151,0) .... S SOURCE=$P($G(^RMPR(661.11,RS,0)),U,5) "RTN","RMPR5HQ5",152,0) .... S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN "RTN","RMPR5HQ5",153,0) .... S S=$G(^TMP($J,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM)) "RTN","RMPR5HQ5",154,0) .... I SOURCE="C" D "RTN","RMPR5HQ5",155,0) ..... S $P(S,"^",9)=QOH+$P(S,"^",9) "RTN","RMPR5HQ5",156,0) ..... S $P(S,"^",11)=COST+$P(S,"^",11) "RTN","RMPR5HQ5",157,0) ..... Q "RTN","RMPR5HQ5",158,0) .... E D "RTN","RMPR5HQ5",159,0) ..... S $P(S,"^",8)=QOH+$P(S,"^",8) "RTN","RMPR5HQ5",160,0) ..... S $P(S,"^",10)=COST+$P(S,"^",10) "RTN","RMPR5HQ5",161,0) ..... Q "RTN","RMPR5HQ5",162,0) .... S ^TMP($J,RMPRNAM,RSTN,NPGRP,NPLIN,HCPCREF,ITEM)=S "RTN","RMPR5HQ5",163,0) .... Q "RTN","RMPR5HQ5",164,0) ... Q "RTN","RMPR5HQ5",165,0) .. Q "RTN","RMPR5HQ5",166,0) Q "RTN","RMPR5HQ5",167,0) ; "RTN","RMPR5HQ5",168,0) ; return item text string given HCPC and ITEM IENs to 661.11 "RTN","RMPR5HQ5",169,0) ; if null ITEMIEN passed the just return the HCPC short name text "RTN","RMPR5HQ5",170,0) GETITEM(HCPCIEN,ITEMIEN) ; "RTN","RMPR5HQ5",171,0) N STR,ITEMTXT "RTN","RMPR5HQ5",172,0) S ITEMTXT="" "RTN","RMPR5HQ5",173,0) I ITEMIEN="" D G GETITEMX "RTN","RMPR5HQ5",174,0) . S STR=$G(^RMPR(661.1,HCPCIEN,0)) "RTN","RMPR5HQ5",175,0) . S ITEMTXT=$P(STR,"^",2) "RTN","RMPR5HQ5",176,0) . Q "RTN","RMPR5HQ5",177,0) S HCPC=$P($G(^RMPR(661.1,HCPCIEN,0)),U,1) "RTN","RMPR5HQ5",178,0) S STR=$G(^RMPR(661.11,"C",HCPC_"-"_ITEMIEN,0)) "RTN","RMPR5HQ5",179,0) I STR="" D "RTN","RMPR5HQ5",180,0) . S ITEMTXT=$P(^RMPR(661.1,HCPCIEN,0),"^",2) "RTN","RMPR5HQ5",181,0) . Q "RTN","RMPR5HQ5",182,0) E D "RTN","RMPR5HQ5",183,0) . S ITEMTXT=$P(STR,"^",1) "RTN","RMPR5HQ5",184,0) . Q "RTN","RMPR5HQ5",185,0) S:ITEMTXT="" ITEMTXT="ITEM "_ITEMIEN "RTN","RMPR5HQ5",186,0) GETITEMX Q ITEMTXT "RTN","RMPR5HQ5",187,0) ; "RTN","RMPR5HQ5",188,0) ; return NPPD line text from line code (New lines only) "RTN","RMPR5HQ5",189,0) NPLIN(CODE) ; "RTN","RMPR5HQ5",190,0) N I,S,LINTXT "RTN","RMPR5HQ5",191,0) S LINTXT="" "RTN","RMPR5HQ5",192,0) F I=1:1 S S=$P($T(DES+I^RMPRN62),";;",2) Q:$E(S,1,3)="END" D Q:LINTXT'="" "RTN","RMPR5HQ5",193,0) . I $P(S,";",1)=CODE S LINTXT=$P(S,";",2) "RTN","RMPR5HQ5",194,0) . Q "RTN","RMPR5HQ5",195,0) Q LINTXT "RTN","RMPR5HQC") 0^2^B27338962 "RTN","RMPR5HQC",1,0) RMPR5HQC ;HCIOFO/RVD - NPPD LINE USAGE REPORT FOR HQ ; 06 OCT 00 "RTN","RMPR5HQC",2,0) ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996 "RTN","RMPR5HQC",3,0) DQ1 ;print PIP Report "RTN","RMPR5HQC",4,0) F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 D:(RSTA'="")&(RSTA'=RST)&(RPR=1) HDRL S RSTA=RST F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:$G(RFL)!(RI'>0) D "RTN","RMPR5HQC",5,0) .D:RPR=0 HDRL "RTN","RMPR5HQC",6,0) .S RGRP=RI "RTN","RMPR5HQC",7,0) .S RNPGRP=RMARRAY(RI) "RTN","RMPR5HQC",8,0) .S RJ="" "RTN","RMPR5HQC",9,0) .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:RJ="" D "RTN","RMPR5HQC",10,0) ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ) "RTN","RMPR5HQC",11,0) ..I RGCNT=0 S RGCNT=RGCNT+1 "RTN","RMPR5HQC",12,0) ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D "RTN","RMPR5HQC",13,0) ...S RL="" "RTN","RMPR5HQC",14,0) ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D "RTN","RMPR5HQC",15,0) ....I RLCNT=0 D GLN1 "RTN","RMPR5HQC",16,0) ....S RLCNT=RLCNT+1 "RTN","RMPR5HQC",17,0) ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL) "RTN","RMPR5HQC",18,0) ....S RMVA=$P(RDAT,U,1) "RTN","RMPR5HQC",19,0) ....S RMCOM=$P(RDAT,U,2) "RTN","RMPR5HQC",20,0) ....S RMUSE=$P(RDAT,U,3) "RTN","RMPR5HQC",21,0) ....S RMISU=$P(RDAT,U,4) "RTN","RMPR5HQC",22,0) ....S RMISN=$P(RDAT,U,5) "RTN","RMPR5HQC",23,0) ....S RMAVEN=$P(RDAT,U,6) "RTN","RMPR5HQC",24,0) ....S RMDLEN=$P(RDAT,U,7) "RTN","RMPR5HQC",25,0) ....S RMQOHU=$P(RDAT,U,8) "RTN","RMPR5HQC",26,0) ....S RMQOHN=$P(RDAT,U,9) "RTN","RMPR5HQC",27,0) ....S RMVALU=$P(RDAT,U,10) "RTN","RMPR5HQC",28,0) ....S RMVALN=$P(RDAT,U,11) "RTN","RMPR5HQC",29,0) ....S RMAVEU=$P(RDAT,U,12) "RTN","RMPR5HQC",30,0) ....S RMDLEU=$P(RDAT,U,13) "RTN","RMPR5HQC",31,0) ....;total for GROUP "RTN","RMPR5HQC",32,0) ....S RMTVAG=RMTVAG+RMVA "RTN","RMPR5HQC",33,0) ....S RMTCOMG=RMTCOMG+RMCOM "RTN","RMPR5HQC",34,0) ....S RMTUSEG=RMTUSEG+RMVA+RMCOM "RTN","RMPR5HQC",35,0) ....S RMTISUG=RMTISUG+RMISU "RTN","RMPR5HQC",36,0) ....S RMTISNG=RMTISNG+RMISN "RTN","RMPR5HQC",37,0) ....S RMTDLEG=RMTDLEG+RMDLEU+RMDLEN "RTN","RMPR5HQC",38,0) ....S RMTQOHUG=RMTQOHUG+RMQOHU "RTN","RMPR5HQC",39,0) ....S RMTQOHNG=RMTQOHNG+RMQOHN "RTN","RMPR5HQC",40,0) ....S RMTVALUG=RMTVALUG+RMVALU "RTN","RMPR5HQC",41,0) ....S RMTVALNG=RMTVALNG+RMVALN "RTN","RMPR5HQC",42,0) ....S RMGTOU=RMGTOU+RMVALU "RTN","RMPR5HQC",43,0) ....S RMGTON=RMGTON+RMVALN "RTN","RMPR5HQC",44,0) ....S RMGTIU=RMGTIU+RMISU "RTN","RMPR5HQC",45,0) ....S RMGTIN=RMGTIN+RMISN "RTN","RMPR5HQC",46,0) ....;total for line item "RTN","RMPR5HQC",47,0) ....S RMTVAL=RMTVAL+RMVA "RTN","RMPR5HQC",48,0) ....S RMTCOML=RMTCOML+RMCOM "RTN","RMPR5HQC",49,0) ....I (RMCOM'=""),$G(RMCOM) S RMTUSELN=RMTUSELN+RMCOM "RTN","RMPR5HQC",50,0) ....I (RMVA'=""),$G(RMVA) S RMTUSELU=RMTUSELU+RMVA "RTN","RMPR5HQC",51,0) ....S RMTISUL=RMTISUL+RMISU "RTN","RMPR5HQC",52,0) ....S RMTISNL=RMTISNL+RMISN "RTN","RMPR5HQC",53,0) ....S RMTQOHUL=RMTQOHUL+RMQOHU "RTN","RMPR5HQC",54,0) ....S RMTQOHNL=RMTQOHNL+RMQOHN "RTN","RMPR5HQC",55,0) ....S RMTVALUL=RMTVALUL+RMVALU "RTN","RMPR5HQC",56,0) ....S RMTVALNL=RMTVALNL+RMVALN "RTN","RMPR5HQC",57,0) ....S (RPRINT,RPR)=1 "RTN","RMPR5HQC",58,0) Q "RTN","RMPR5HQC",59,0) ; "RTN","RMPR5HQC",60,0) HDRL ;print heading. "RTN","RMPR5HQC",61,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="" "RTN","RMPR5HQC",62,0) I RPR=1 D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RES "RTN","RMPR5HQC",63,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="" "RTN","RMPR5HQC",64,0) S RPR=1 "RTN","RMPR5HQC",65,0) S RSTN=$$STN(RSTA) "RTN","RMPR5HQC",66,0) D CNTRX^RMPR5HQA "RTN","RMPR5HQC",67,0) S ^TMP($J,"RI",RC)="PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT"_RB10_"Run Date: "_RMRDATE "RTN","RMPR5HQC",68,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="STATION: "_$E(RSTN,1,30)_RB6_RMBD_" - "_RMED_" [ "_RMCALDAY_" calendar days ]" "RTN","RMPR5HQC",69,0) Q "RTN","RMPR5HQC",70,0) ; "RTN","RMPR5HQC",71,0) GLN1 ;print NPPD GROUP and LINE header. "RTN","RMPR5HQC",72,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="" "RTN","RMPR5HQC",73,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)="" "RTN","RMPR5HQC",74,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RNPGRP "RTN","RMPR5HQC",75,0) D LBL1^RMPR5HQA "RTN","RMPR5HQC",76,0) Q "RTN","RMPR5HQC",77,0) ; "RTN","RMPR5HQC",78,0) SUML1 ; "RTN","RMPR5HQC",79,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=RLINE_RB1_RNPLINE "RTN","RMPR5HQC",80,0) S:$G(RMTUSELU) RMTAVELU=RMTUSELU/RMCALDAY "RTN","RMPR5HQC",81,0) S:$G(RMTUSELN) RMTAVELN=RMTUSELN/RMCALDAY "RTN","RMPR5HQC",82,0) S:$G(RMTUSELU) RTDLELA=RMTQOHUL/RMTAVELU "RTN","RMPR5HQC",83,0) S:$G(RMTUSELN) RTDLELC=RMTQOHNL/RMTAVELN "RTN","RMPR5HQC",84,0) S RTDLELA=$S(RTDLELA>999:">999",1:$J(RTDLELA,5,0)) "RTN","RMPR5HQC",85,0) S RTDLELC=$S(RTDLELC>999:">999",1:$J(RTDLELC,5,0)) "RTN","RMPR5HQC",86,0) S:RMTQOHNL=0 RTDLELC="" "RTN","RMPR5HQC",87,0) S:RMTQOHUL=0 RTDLELA="" "RTN","RMPR5HQC",88,0) S:(RMTQOHNL>0)&(RMTCOML<1) RTDLELC=">"_RMCALDAY "RTN","RMPR5HQC",89,0) S:(RMTQOHUL>0)&(RMTVAL<1) RTDLELA=">"_RMCALDAY "RTN","RMPR5HQC",90,0) S RMTAVEG=RTAVELA+RTAVELC "RTN","RMPR5HQC",91,0) D CNTRX^RMPR5HQA "RTN","RMPR5HQC",92,0) S ^TMP($J,"RI",RC)=" (Used)"_RB13_$J(RMTVAL,5)_RB1_$J($FN(RMTISUL,",",2),9)_RB1_"|"_RB18_"|"_RB1_$J(RMTUSELU,5)_RB1_"|"_RB1_$J(RMTAVELU,8,2)_RB1_"|" "RTN","RMPR5HQC",93,0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUL,6)_RB8_"|"_RB1_$J(RTDLELA,6)_RB1_"|"_RB1_$J($FN(RMTVALUL,",",2),11) "RTN","RMPR5HQC",94,0) ;next two lines print new total "RTN","RMPR5HQC",95,0) D CNTRX^RMPR5HQA "RTN","RMPR5HQC",96,0) S ^TMP($J,"RI",RC)=" (New)"_RB30_"|"_RB1_$J(RMTCOML,6)_RB1_$J($FN(RMTISNL,",",2),9)_RB1_"|"_RB1_$J(RMTUSELN,5)_RB1_"|"_RB1_$J(RMTAVELN,8,2)_RB1_"|" "RTN","RMPR5HQC",97,0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB6_$J(RMTQOHNL,8)_RB1_"|"_RB1_$J(RTDLELC,6)_RB1_"|"_RB12_$J($FN(RMTVALNL,",",2),11) "RTN","RMPR5HQC",98,0) ; "RTN","RMPR5HQC",99,0) S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSELU,RMTAVELU,RMTAVELN,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0 "RTN","RMPR5HQC",100,0) S (RMTUSELN,RMTUSELU,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0 "RTN","RMPR5HQC",101,0) S (RNPLINE,RLINE)="" "RTN","RMPR5HQC",102,0) Q "RTN","RMPR5HQC",103,0) ; "RTN","RMPR5HQC",104,0) SUMG1 ;print summary total for NPPD GROUP "RTN","RMPR5HQC",105,0) D CNTRX^RMPR5HQA S ^TMP($J,"RI",RC)=REQ "RTN","RMPR5HQC",106,0) D CNTRX^RMPR5HQA "RTN","RMPR5HQC",107,0) S ^TMP($J,"RI",RC)=RB24_$J(RMTVAG,5)_RB1_$J($FN(RMTISUG,",",2),9)_RB1_"|"_RB1_$J(RMTCOMG,6)_RB1_$J($FN(RMTISNG,",",2),9)_RB1_"|"_RB1_$J(RMTUSEG,5)_RB1_"|"_RB10_"|" "RTN","RMPR5HQC",108,0) S ^TMP($J,"RI",RC)=^TMP($J,"RI",RC)_RB1_$J(RMTQOHUG,6)_RB1_$J(RMTQOHNG,6)_RB1_"|"_RB8_"|"_RB1_$J($FN(RMTVALUG,",",2),11)_$J($FN(RMTVALNG,",",2),11) "RTN","RMPR5HQC",109,0) ;W !,?26,$J(RMTVAG,5),?34,$J($FN(RMTISUG,",",2),6),?40,"|",?41,$J(RMTCOMG,4),?49,$J($FN(RMTISNG,",",2),9),?59,"|",?60,$J(RMTUSEG,5),?67,"|",?78,"|" "RTN","RMPR5HQC",110,0) ;W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11) "RTN","RMPR5HQC",111,0) ; "RTN","RMPR5HQC",112,0) S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0 "RTN","RMPR5HQC",113,0) S (RNPGRP,RGRP)="" "RTN","RMPR5HQC",114,0) Q "RTN","RMPR5HQC",115,0) ; "RTN","RMPR5HQC",116,0) STN(RST) ;STATION FUNCTION "RTN","RMPR5HQC",117,0) N Y,RS "RTN","RMPR5HQC",118,0) S RS=$O(^RMPR(669.9,"C",RST,0)),Y=$P(^RMPR(669.9,RS,0),U,1) "RTN","RMPR5HQC",119,0) Q Y "RTN","RMPR5HQL") 0^3^B22749450 "RTN","RMPR5HQL",1,0) RMPR5HQL ;HCIOFO/RVD - NPPD LINE USAGE REPORT ; 15 AUG 00 "RTN","RMPR5HQL",2,0) ;;3.0;PROSTHETICS;**51,61**;Feb 09, 1996 "RTN","RMPR5HQL",3,0) ; "RTN","RMPR5HQL",4,0) DQ1 ;print PIP Report "RTN","RMPR5HQL",5,0) ;$O the ^TMP( global for all the records "RTN","RMPR5HQL",6,0) ;print all records based on the sort criteria given. "RTN","RMPR5HQL",7,0) I IOST["C-" W @IOF "RTN","RMPR5HQL",8,0) F RST=0:0 S RST=$O(^TMP($J,R5,RST)) Q:RST'>0 S RSTN=$$STN(RST),RPR=0 F RI=0:0 S RI=$O(^TMP($J,R5,RST,RI)) Q:$G(RFL) D:(RGRP'="")&(RGRP'=RI) SUMG1 Q:RI'>0 D "RTN","RMPR5HQL",9,0) .D:RPR=0 HDRL "RTN","RMPR5HQL",10,0) .S RGRP=RI "RTN","RMPR5HQL",11,0) .S RNPGRP=RMARRAY(RI) "RTN","RMPR5HQL",12,0) .S RJ="" "RTN","RMPR5HQL",13,0) .F S RJ=$O(^TMP($J,R5,RST,RI,RJ)) Q:$G(RFL) D:(RLINE'="")&(RLINE'=RJ) SUML1 Q:(RJ="")!(RFL=1) D "RTN","RMPR5HQL",14,0) ..S RLINE=RJ,RNPLINE=$$NPLIN^RMPR5HQ5(RJ) "RTN","RMPR5HQL",15,0) ..I RGCNT=0 S RGCNT=RGCNT+1 "RTN","RMPR5HQL",16,0) ..S RK="" F S RK=$O(^TMP($J,R5,RST,RI,RJ,RK)) Q:$G(RFL)!(RK="") D "RTN","RMPR5HQL",17,0) ...S RL="" "RTN","RMPR5HQL",18,0) ...F S RL=$O(^TMP($J,R5,RST,RI,RJ,RK,RL)) Q:$G(RFL)!(RL="") D "RTN","RMPR5HQL",19,0) ....I RLCNT=0 D GLN1 "RTN","RMPR5HQL",20,0) ....S RLCNT=RLCNT+1 "RTN","RMPR5HQL",21,0) ....S RDAT=^TMP($J,R5,RST,RI,RJ,RK,RL) "RTN","RMPR5HQL",22,0) ....S RMVA=$P(RDAT,U,1) "RTN","RMPR5HQL",23,0) ....S RMCOM=$P(RDAT,U,2) "RTN","RMPR5HQL",24,0) ....S RMUSE=$P(RDAT,U,3) "RTN","RMPR5HQL",25,0) ....S RMISU=$P(RDAT,U,4) "RTN","RMPR5HQL",26,0) ....S RMISN=$P(RDAT,U,5) "RTN","RMPR5HQL",27,0) ....S RMAVEN=$P(RDAT,U,6) "RTN","RMPR5HQL",28,0) ....S RMDLEN=$P(RDAT,U,7) "RTN","RMPR5HQL",29,0) ....S RMQOHU=$P(RDAT,U,8) "RTN","RMPR5HQL",30,0) ....S RMQOHN=$P(RDAT,U,9) "RTN","RMPR5HQL",31,0) ....S RMVALU=$P(RDAT,U,10) "RTN","RMPR5HQL",32,0) ....S RMVALN=$P(RDAT,U,11) "RTN","RMPR5HQL",33,0) ....S RMAVEU=$P(RDAT,U,12) "RTN","RMPR5HQL",34,0) ....S RMDLEU=$P(RDAT,U,13) "RTN","RMPR5HQL",35,0) ....;total for GROUP "RTN","RMPR5HQL",36,0) ....S RMTVAG=RMTVAG+RMVA "RTN","RMPR5HQL",37,0) ....S RMTCOMG=RMTCOMG+RMCOM "RTN","RMPR5HQL",38,0) ....S RMTUSEG=RMTUSEG+RMVA+RMCOM "RTN","RMPR5HQL",39,0) ....S RMTISUG=RMTISUG+RMISU "RTN","RMPR5HQL",40,0) ....S RMTISNG=RMTISNG+RMISN "RTN","RMPR5HQL",41,0) ....S RMTDLEG=RMTDLEG+RMDLEU+RMDLEN "RTN","RMPR5HQL",42,0) ....S RMTQOHUG=RMTQOHUG+RMQOHU "RTN","RMPR5HQL",43,0) ....S RMTQOHNG=RMTQOHNG+RMQOHN "RTN","RMPR5HQL",44,0) ....S RMTVALUG=RMTVALUG+RMVALU "RTN","RMPR5HQL",45,0) ....S RMTVALNG=RMTVALNG+RMVALN "RTN","RMPR5HQL",46,0) ....S RMGTOU=RMGTOU+RMVALU "RTN","RMPR5HQL",47,0) ....S RMGTON=RMGTON+RMVALN "RTN","RMPR5HQL",48,0) ....S RMGTIU=RMGTIU+RMISU "RTN","RMPR5HQL",49,0) ....S RMGTIN=RMGTIN+RMISN "RTN","RMPR5HQL",50,0) ....;total for line item "RTN","RMPR5HQL",51,0) ....S RMTVAL=RMTVAL+RMVA "RTN","RMPR5HQL",52,0) ....S RMTCOML=RMTCOML+RMCOM "RTN","RMPR5HQL",53,0) ....I (RMCOM'=""),$G(RMCOM) S RTUSELC=RTUSELC+RMCOM "RTN","RMPR5HQL",54,0) ....I (RMVA'=""),$G(RMVA) S RTUSELA=RTUSELA+RMVA "RTN","RMPR5HQL",55,0) ....S RMTISUL=RMTISUL+RMISU "RTN","RMPR5HQL",56,0) ....S RMTISNL=RMTISNL+RMISN "RTN","RMPR5HQL",57,0) ....S RMTQOHUL=RMTQOHUL+RMQOHU "RTN","RMPR5HQL",58,0) ....S RMTQOHNL=RMTQOHNL+RMQOHN "RTN","RMPR5HQL",59,0) ....S RMTVALUL=RMTVALUL+RMVALU "RTN","RMPR5HQL",60,0) ....S RMTVALNL=RMTVALNL+RMVALN "RTN","RMPR5HQL",61,0) ....S (RPRINT,RPR)=1 "RTN","RMPR5HQL",62,0) ....I $Y+8>IOSL,IOST["C-" K DIR S DIR(0)="E" D ^DIR S:+Y'>0 RFL=1 Q:+Y'>0 W @IOF D HDRL,LBL1^RMPR5HQ2 "RTN","RMPR5HQL",63,0) ....I $Y+8>IOSL,IOST'["C-" W @IOF D HDRL,LBL1^RMPR5HQ2 "RTN","RMPR5HQL",64,0) Q "RTN","RMPR5HQL",65,0) ; "RTN","RMPR5HQL",66,0) HDRL ;print heading. "RTN","RMPR5HQL",67,0) Q:$G(RFL) "RTN","RMPR5HQL",68,0) S RMPAGE=RMPAGE+1 "RTN","RMPR5HQL",69,0) W !,"PROSTHETIC INVENTORY NPPD GROUP/LINE REPORT",?55,"Run Date: ",RMRDATE,?100,"Page: ",RMPAGE "RTN","RMPR5HQL",70,0) W !,"STATION: ",$E(RSTN,1,20) "RTN","RMPR5HQL",71,0) W ?32,RMBD," - ",RMED," [ ",RMCALDAY," calendar days ]" "RTN","RMPR5HQL",72,0) Q "RTN","RMPR5HQL",73,0) ; "RTN","RMPR5HQL",74,0) GLN1 ;print NPPD GROUP and LINE header. "RTN","RMPR5HQL",75,0) Q:$G(RFL) "RTN","RMPR5HQL",76,0) W !!,RNPGRP "RTN","RMPR5HQL",77,0) D LBL1^RMPR5HQ2 "RTN","RMPR5HQL",78,0) Q "RTN","RMPR5HQL",79,0) SUML1 ; "RTN","RMPR5HQL",80,0) Q:$G(RFL) "RTN","RMPR5HQL",81,0) W !,RLINE," ",RNPLINE "RTN","RMPR5HQL",82,0) S:$G(RTUSELA) RTAVELA=RTUSELA/RMCALDAY "RTN","RMPR5HQL",83,0) S:$G(RTUSELC) RTAVELC=RTUSELC/RMCALDAY "RTN","RMPR5HQL",84,0) S:$G(RTUSELA) RTDLELA=RMTQOHUL/RTAVELA "RTN","RMPR5HQL",85,0) S:$G(RTUSELC) RTDLELC=RMTQOHNL/RTAVELC "RTN","RMPR5HQL",86,0) S RTDLELA=$S(RTDLELA>999:">999",1:$J(RTDLELA,5,0)) "RTN","RMPR5HQL",87,0) S RTDLELC=$S(RTDLELC>999:">999",1:$J(RTDLELC,5,0)) "RTN","RMPR5HQL",88,0) S:RMTQOHNL=0 RTDLELC="" "RTN","RMPR5HQL",89,0) S:RMTQOHUL=0 RTDLELA="" "RTN","RMPR5HQL",90,0) S:(RMTQOHNL>0)&(RMTCOML<1) RTDLELC=">"_RMCALDAY "RTN","RMPR5HQL",91,0) S:(RMTQOHUL>0)&(RMTVAL<1) RTDLELA=">"_RMCALDAY "RTN","RMPR5HQL",92,0) S RMTAVEG=RTAVELA+RTAVELC "RTN","RMPR5HQL",93,0) ;next 2 lines for used: "RTN","RMPR5HQL",94,0) W !,?5,"(Used)",?26,$J(RMTVAL,5),?34,$J($FN(RMTISUL,",",2),6),?40,"|",?59,"|",?60,$J(RTUSELA,5),?67,"|",?71,$J(RTAVELA,5,2),?78,"|" "RTN","RMPR5HQL",95,0) W ?81,$J(RMTQOHUL,5),?94,"|",?97,$J(RTDLELA,6),?103,"|",?103,$J($FN(RMTVALUL,",",2),11) "RTN","RMPR5HQL",96,0) ;next 2 lines for new: "RTN","RMPR5HQL",97,0) W !,?5,"(New)",?40,"|",?41,$J(RMTCOML,4),?49,$J($FN(RMTISNL,",",2),9),?59,"|",?60,$J(RTUSELC,5),?67,"|",?71,$J(RTAVELC,5,2),?78,"|" "RTN","RMPR5HQL",98,0) W ?87,$J(RMTQOHNL,6),?94,"|",?97,$J(RTDLELC,6),?103,"|",?116,$J($FN(RMTVALNL,",",2),11) "RTN","RMPR5HQL",99,0) ; "RTN","RMPR5HQL",100,0) S (RMTVAL,RMTISUL,RMTCOML,RMTISNL,RMTUSEL,RMTAVEL,RMTQOHUL,RMTQOHNL,RMTVALUL,RMTVALNL)=0 "RTN","RMPR5HQL",101,0) S (RTUSELA,RTUSELC,RTDLELA,RTDLELC,RTAVELA,RTAVELC)=0 "RTN","RMPR5HQL",102,0) S (RNPLINE,RLINE)="" "RTN","RMPR5HQL",103,0) Q "RTN","RMPR5HQL",104,0) ; "RTN","RMPR5HQL",105,0) SUMG1 ;print summary total for NPPD GROUP "RTN","RMPR5HQL",106,0) Q:$G(RFL) "RTN","RMPR5HQL",107,0) W !,REQ "RTN","RMPR5HQL",108,0) W !,?26,$J(RMTVAG,5),?34,$J($FN(RMTISUG,",",2),6),?40,"|",?41,$J(RMTCOMG,4),?49,$J($FN(RMTISNG,",",2),9),?59,"|",?60,$J(RMTUSEG,5),?67,"|",?78,"|" "RTN","RMPR5HQL",109,0) W ?81,$J(RMTQOHUG,5),?87,$J(RMTQOHNG,6),?94,"|",?103,"|",?104,$J($FN(RMTVALUG,",",2),11),?116,$J($FN(RMTVALNG,",",2),11) "RTN","RMPR5HQL",110,0) S (RMTVAG,RMTISUG,RMTCOMG,RMTISNG,RMTUSEG,RMTAVEG,RMTQOHUG,RMTQOHNG,RMTVALUG,RMTVALNG,RLCNT)=0 "RTN","RMPR5HQL",111,0) S (RNPGRP,RGRP)="" "RTN","RMPR5HQL",112,0) Q "RTN","RMPR5HQL",113,0) STN(RST) ;STATION FUNCTION "RTN","RMPR5HQL",114,0) N Y,RS "RTN","RMPR5HQL",115,0) S RS=$O(^RMPR(669.9,"C",RST,0)),Y=$P(^RMPR(669.9,RS,0),U,1) "RTN","RMPR5HQL",116,0) Q Y "RTN","RMPR5NU") 0^95^B17140479 "RTN","RMPR5NU",1,0) RMPR5NU ;HIN/RVD-PROS INVENTORY SITE PARAMETERS UTILITY ;3/8/05 08:08 "RTN","RMPR5NU",2,0) ;;3.0;PROSTHETICS;**33,38,52,61**;Feb 09, 1996 "RTN","RMPR5NU",3,0) ; "RTN","RMPR5NU",4,0) ;DBIA #10090 - file #4. "RTN","RMPR5NU",5,0) ; ODJ - patch 52 - 10/17/00 - if a 661.3 record is corrupted with a null "RTN","RMPR5NU",6,0) ; HCPC code then put message in report and "RTN","RMPR5NU",7,0) ; prevent routine from crashing. "RTN","RMPR5NU",8,0) ; (see nois NYH-0900-12030) "RTN","RMPR5NU",9,0) ; "RTN","RMPR5NU",10,0) ; RVD - patch #61 - used new files for inventory balance task job. "RTN","RMPR5NU",11,0) ; "RTN","RMPR5NU",12,0) ADD ;add/edit inventory SITE PARAMETER "RTN","RMPR5NU",13,0) S DIC("A")="Select Prosthetics Site Name : " "RTN","RMPR5NU",14,0) S DIR("A")="Would you like to ACTIVATE this Item (Y/N) ",DIC=669.9,DIR(0)="Y" "RTN","RMPR5NU",15,0) S DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT G:$D(DTOUT) EXIT S DA=+Y "RTN","RMPR5NU",16,0) ; "RTN","RMPR5NU",17,0) ;I $P(^RMPR(661,RMDA,1),U,9)'=1 W !!,$C(7),"*** Item is inactive ***" D ^DIR S:Y=1 $P(^RMPR(661,RMDA,1),U,9)=1 G:Y=0 ADD "RTN","RMPR5NU",18,0) S DIE=DIC,DR="35" D ^DIE "RTN","RMPR5NU",19,0) G ADD "RTN","RMPR5NU",20,0) ; "RTN","RMPR5NU",21,0) TASK ;entry point for task job to check balances. "RTN","RMPR5NU",22,0) K ^TMP($J) "RTN","RMPR5NU",23,0) S IO=0 "RTN","RMPR5NU",24,0) S Y=DT D DD^%DT S RMRDAT=Y "RTN","RMPR5NU",25,0) S RMERR=$$MES^RMPRPIUD("") "RTN","RMPR5NU",26,0) ;a TMP($J global created for mail message. "RTN","RMPR5NU",27,0) Q:$G(RMERR) "RTN","RMPR5NU",28,0) D PROC S RMSUBI=5 "RTN","RMPR5NU",29,0) I $D(^TMP($J,"RMX")) D BUILD "RTN","RMPR5NU",30,0) MAIL D:$D(^XMB(3.8,"B","RMPR INVENTORY")) MES1,MES2 "RTN","RMPR5NU",31,0) ;set Notification Date in file #669.9 "RTN","RMPR5NU",32,0) S RS=0 "RTN","RMPR5NU",33,0) F S RS=$O(^RMPR(669.9,RS)) Q:RS'>0 S $P(^RMPR(669.9,RS,"INV"),U,3)=DT "RTN","RMPR5NU",34,0) ;D WRI ;for printing to a designated inventory printer. "RTN","RMPR5NU",35,0) G EXIT "RTN","RMPR5NU",36,0) ; "RTN","RMPR5NU",37,0) PROC ;process "RTN","RMPR5NU",38,0) F I=0:0 S I=$O(^TMP($J,"RMPRPIUD",I)) Q:I'>0 S J="" F S J=$O(^TMP($J,"RMPRPIUD",I,J)) Q:J="" F K=0:0 S K=$O(^TMP($J,"RMPRPIUD",I,J,K)) Q:K'>0 D "RTN","RMPR5NU",39,0) .F L=0:0 S L=$O(^TMP($J,"RMPRPIUD",I,J,K,"L",L)) Q:L'>0 D "RTN","RMPR5NU",40,0) ..S RMDATA=$G(^TMP($J,"RMPRPIUD",I,J,K,"L",L)) "RTN","RMPR5NU",41,0) ..S RMREOR=$P(RMDATA,U,1) "RTN","RMPR5NU",42,0) ..S RMQUAN=$P(RMDATA,U,2) I RMQUAN="" S RMQUAN=0 "RTN","RMPR5NU",43,0) ..I RMREOR>RMQUAN D "RTN","RMPR5NU",44,0) ...S RM11=$O(^RMPR(661.11,"ASHI",I,J,K,0)) "RTN","RMPR5NU",45,0) ...S RMITEM="xxxx" "RTN","RMPR5NU",46,0) ...I RM11,$D(^RMPR(661.11,RM11,0)) Q:$P(^RMPR(661.11,RM11,0),U,9) S RMITEM=$P(^RMPR(661.11,RM11,0),U,3) "RTN","RMPR5NU",47,0) ...S RML="****" "RTN","RMPR5NU",48,0) ...I L,$D(^RMPR(661.5,L,0)) S RML=$P(^RMPR(661.5,L,0),U,1) "RTN","RMPR5NU",49,0) ...S ^TMP($J,"RMX",I,RML,RMITEM)=RMITEM_"^"_RMREOR_"^"_RMQUAN_"^"_J_"-"_K "RTN","RMPR5NU",50,0) ...I $D(^TMP($J,"RMPRPIUD",I,J,K,"M")) D "RTN","RMPR5NU",51,0) ....F RMI=0:0 S RMI=$O(^TMP($J,"RMPRPIUD",I,J,K,"M",RMI)) Q:RMI'>0 D "RTN","RMPR5NU",52,0) .....S RMLEFT=0 "RTN","RMPR5NU",53,0) .....F RMJ=0:0 S RMJ=$O(^TMP($J,"RMPRPIUD",I,J,K,"M",RMI,RMJ)) Q:RMJ'>0 S RM41=^TMP($J,"RMPRPIUD",I,J,K,"M",RMI,RMJ) D "RTN","RMPR5NU",54,0) ......S RMORD=$P(RM41,U,1) "RTN","RMPR5NU",55,0) ......S RMDATO=$P(RM41,U,2) "RTN","RMPR5NU",56,0) ......;S RMLEF=RMORD-RMREC "RTN","RMPR5NU",57,0) ......;I $G(RMLEF) S RMLEFT=RMLEFT+RMLEF "RTN","RMPR5NU",58,0) .....I $G(RMORD) S ^TMP($J,"RMX",I,RML,RMITEM,"M")=" **** Quantity = "_RMORD_" has been ordered for item..."_RMITEM_" on "_RMDATO "RTN","RMPR5NU",59,0) ; "RTN","RMPR5NU",60,0) Q "RTN","RMPR5NU",61,0) MES1 ; "RTN","RMPR5NU",62,0) S XMY("G.RMPR INVENTORY")="",XMDUZ=.5,XMTEXT="RMX(" "RTN","RMPR5NU",63,0) S XMSUB="PROSTHETICS INVENTORY MESSAGE" "RTN","RMPR5NU",64,0) S RMX(1)="Run Date: "_RMRDAT "RTN","RMPR5NU",65,0) S RMX(2)="This is a notification from the Prosthetics Department........" "RTN","RMPR5NU",66,0) S RMX(3)="" "RTN","RMPR5NU",67,0) S RMX(4)="The current balance for the following item(s) is/are below the reorder level:" "RTN","RMPR5NU",68,0) S RMX(5)="[Site] [Location] [Item] [HCPCS] [Reorder Lvl] [Bal] " "RTN","RMPR5NU",69,0) Q "RTN","RMPR5NU",70,0) MES2 ; "RTN","RMPR5NU",71,0) S RMX(RMSUBI+2)="" "RTN","RMPR5NU",72,0) S RMX(RMSUBI+3)="" "RTN","RMPR5NU",73,0) S RMX(RMSUBI+4)="Thank You!!!" "RTN","RMPR5NU",74,0) S RMX(RMSUBI+5)="" "RTN","RMPR5NU",75,0) S RMX(RMSUBI+6)="PROSTHETICS DEPARTMENT" "RTN","RMPR5NU",76,0) D ^XMD "RTN","RMPR5NU",77,0) Q "RTN","RMPR5NU",78,0) ; "RTN","RMPR5NU",79,0) BUILD S I="" "RTN","RMPR5NU",80,0) F S I=$O(^TMP($J,"RMX",I)) Q:I="" S J="" F S J=$O(^TMP($J,"RMX",I,J)) Q:J="" S K="" F S K=$O(^TMP($J,"RMX",I,J,K)) Q:K="" S RM0=^TMP($J,"RMX",I,J,K) D "RTN","RMPR5NU",81,0) .S RML=$P(RM0,U,2),RMB=$P(RM0,U,3),RMSTA=I,RMLO=J,RMITEM=K,RMHCPC=$P(RM0,U,4)_" " "RTN","RMPR5NU",82,0) .S RMITEM=RMITEM_" " "RTN","RMPR5NU",83,0) .S RMSUBI=RMSUBI+1,RMLO=RMLO_" " "RTN","RMPR5NU",84,0) .S RMX(RMSUBI)=$E($P(^DIC(4,RMSTA,0),U,1),1,6)_" "_$E(RMLO,1,16)_" "_$E(RMITEM,1,28)_" "_$E(RMHCPC,1,9)_" "_$J(RML,5)_" "_$J(RMB,5) "RTN","RMPR5NU",85,0) .;S RMXI(RMSUBI)=RMX(RMSUBI)_"^"_I_"^"_J_"^"_K "RTN","RMPR5NU",86,0) .I $D(^TMP($J,"RMX",I,J,K,"M")) S RMSUBI=RMSUBI+1,RMX(RMSUBI)=^TMP($J,"RMX",I,J,K,"M") "RTN","RMPR5NU",87,0) Q "RTN","RMPR5NU",88,0) ; "RTN","RMPR5NU",89,0) WRI ;PRINT NOTIFICATION LETTER IN SUPPLY PRINTER. This functionality is not included with this released. "RTN","RMPR5NU",90,0) ;S RMDEV=$P(^RMPR(669.9,RS,"INV"),U,1) "RTN","RMPR5NU",91,0) ;S RMIOS=IO,IO=$P(^%ZIS(1,RMDEV,0),U,2) "RTN","RMPR5NU",92,0) ;D NOW^%DTC "RTN","RMPR5NU",93,0) ;O IO U IO W !,"Run Date: ",RMRDAT,!!,"This is a notification from the Prosthetics Department..." "RTN","RMPR5NU",94,0) ;W !!,"The current balance for the following item(s) is/are below the reorder level:" "RTN","RMPR5NU",95,0) ;W !,"[Location] [Item] [HCPCS] [Reorder Level] [Current Balance]" "RTN","RMPR5NU",96,0) ;F I=0:0 S I=$O(RMXI(I)) Q:I'>0 D "RTN","RMPR5NU",97,0) ;.S RMLO=$P(RMXI(I),U,2),RMI=$P(RMXI(I),U,3) "RTN","RMPR5NU",98,0) ;.W !,$P(RMXI(I),U,1) "RTN","RMPR5NU",99,0) ;.S $P(^RMPR(661.3,RMLO,1,RMI,0),U,7)=% "RTN","RMPR5NU",100,0) ;W !!!,"Thank You!!!!!" "RTN","RMPR5NU",101,0) ;W !!,"PROSTHETICS DEPARTMENT" "RTN","RMPR5NU",102,0) ;S $P(^RMPR(669.9,RS,"INV"),U,3)=DT "RTN","RMPR5NU",103,0) ;D ^%ZISC S IO=RMIOS O IO U IO "RTN","RMPR5NU",104,0) ;K RMB,RMD,RMI,RML,RMDO,RMDATI,RMLOCI,RMXI,I,J,XMTEXT,RMGROUP,RMHCPC "RTN","RMPR5NU",105,0) ;Q "RTN","RMPR5NU",106,0) ; "RTN","RMPR5NU",107,0) EXIT ;MAIN EXIT POINT "RTN","RMPR5NU",108,0) N RMPRSITE,RMPR D KILL^XUSCLEAN "RTN","RMPR5NU",109,0) K ^TMP($J) "RTN","RMPR5NU",110,0) Q "RTN","RMPRE29") 0^103^B43174042 "RTN","RMPRE29",1,0) RMPRE29 ;PHX/JLT,RVD-EDIT 2319 ;10/2/03 13:04 "RTN","RMPRE29",2,0) ;;3.0;PROSTHETICS;**36,41,51,57,62,74,81,61**;Feb 09, 1996 "RTN","RMPRE29",3,0) ; "RTN","RMPRE29",4,0) ;RVD patch #62 - call PCE API to update patient care encounter. "RTN","RMPRE29",5,0) ; - add a screen display if no changes to the HCPCS. "RTN","RMPRE29",6,0) ;RVD patch #74 - call $$STATCHK^ICPTAPIU to check if CPT Code is "RTN","RMPRE29",7,0) ; active for a given date. "RTN","RMPRE29",8,0) ;RVD patch #81 - roll back patch RMPR*3.0*74 and returns the screen "RTN","RMPRE29",9,0) ; to the STATUS field of file #661.1. "RTN","RMPRE29",10,0) ;RVD patch #61 - Bar Coding. Don't include Stock Issue for ED2. "RTN","RMPRE29",11,0) ;uses DBIA # 1995 & 1997. "RTN","RMPRE29",12,0) W ! S DIC="^RMPR(660,",DIC(0)="AEMQZ",DIC("A")="Select PATIENT: " "RTN","RMPRE29",13,0) S DIC("W")="D EN^RMPRD1",RMEND=0 "RTN","RMPRE29",14,0) S DIC("S")="I ($P(^(0),U,6)!($P(^(0),U,26)'="""")),($P(^(0),U,13)'=11)" W ! "RTN","RMPRE29",15,0) D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPRE29",16,0) ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE L -^RMPR(660,DA,0) "RTN","RMPRE29",17,0) S DIE=DIC,(RMPRDA,DA)=+Y "RTN","RMPRE29",18,0) TYP1 ;edit type of transaction.... "RTN","RMPRE29",19,0) S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)),R1("AM")=$G(^("AM")) "RTN","RMPRE29",20,0) S RMTOTCOS=$P(R1(0),U,16) "RTN","RMPRE29",21,0) S (RMHCPC,RMHCOLD)=$P(R1(1),U,4),(RMTYPE,RMTYPS)=$P(R1(0),U,4),(RMCAT,RMCATS)=$P(R1("AM"),U,3),(RMSPE,RMSPES)=$P(R1("AM"),U,4),RMSOUR=$P(R1(1),U,14) "RTN","RMPRE29",22,0) TRAN K DIR S DIR(0)="660,2" "RTN","RMPRE29",23,0) ;S DIR("A")="Enter Type of Transaction: " "RTN","RMPRE29",24,0) S:$D(RMTYPS) DIR("B")=$S(RMTYPS="I":"INITIAL",RMTYPS="X":"REPAIR",RMTYPS="R":"REPLACE",RMTYPS="S":"SPARE",1:"") "RTN","RMPRE29",25,0) D ^DIR "RTN","RMPRE29",26,0) I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",27,0) I Y="" W !,"Please enter type of Transaction!!" G TRAN "RTN","RMPRE29",28,0) S $P(R1(0),U,4)=Y,RMTYPE=Y "RTN","RMPRE29",29,0) S RMTYPS=$S(Y="I":"INITIAL",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",1:"") "RTN","RMPRE29",30,0) PCAT K DIR S DIR(0)="660,62" "RTN","RMPRE29",31,0) S:$D(RMCATS) DIR("B")=$S(RMCATS=1:"SC/OP",RMCATS=2:"SC/IP",RMCATS=3:"NSC/IP",RMCATS=4:"NSC/OP",1:"") "RTN","RMPRE29",32,0) D ^DIR "RTN","RMPRE29",33,0) I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",34,0) I Y="" W !,"Please enter Patient Category!!" G PCAT "RTN","RMPRE29",35,0) S RMCAT=Y "RTN","RMPRE29",36,0) S $P(R1("AM"),U,3)=Y,RMCATS=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"") "RTN","RMPRE29",37,0) K DIR I RMCAT<4 S $P(R1("AM"),U,4)="" G HCPC "RTN","RMPRE29",38,0) S DIR(0)="660,63" "RTN","RMPRE29",39,0) S:$D(RMSPES) DIR("B")=$S(RMSPES=1:"SPECIAL LEGISLATION",RMSPES=2:"A&A",RMSPES=3:"PHC",RMSPES=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRE29",40,0) I RMCAT=4 D ^DIR I $D(DUOUT)!$D(DTOUT) S RMEND=1 D SETED2 G QED2 "RTN","RMPRE29",41,0) I RMCAT=4 S $P(R1("AM"),U,4)=Y,RMSPE=Y,RMSPES=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRE29",42,0) K DIR "RTN","RMPRE29",43,0) ; "RTN","RMPRE29",44,0) HCPC ;set type and ask item and HCPCS "RTN","RMPRE29",45,0) D SETED2 "RTN","RMPRE29",46,0) ;ask source "RTN","RMPRE29",47,0) N SRC "RTN","RMPRE29",48,0) S SRC=$P(R1(0),U,14) "RTN","RMPRE29",49,0) S DIE("NO^")="BACK" "RTN","RMPRE29",50,0) S DR="12;4;4.5" D ^DIE "RTN","RMPRE29",51,0) K DIE("NO^") "RTN","RMPRE29",52,0) I $D(DUOUT)!$D(DTOUT)!$D(Y) S RMEND=1 G QED2 "RTN","RMPRE29",53,0) S R1(0)=$G(^RMPR(660,RMPRDA,0)),R1(1)=$G(^(1)) "RTN","RMPRE29",54,0) I $P(R1(0),U,14)'=SRC S RMHCOLD="" "RTN","RMPRE29",55,0) S RMHCPC=$P(R1(1),U,4) "RTN","RMPRE29",56,0) W !,"OLD CPT MODIFER: ",$P(R1(1),U,6) "RTN","RMPRE29",57,0) ;if HCPCS was changed, Modifier must be changed "RTN","RMPRE29",58,0) I RMHCOLD'=RMHCPC D "RTN","RMPRE29",59,0) .S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660 "RTN","RMPRE29",60,0) .D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",61,0) .W !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",62,0) ;if HCPCS the same, ask user if want to edit modifier. "RTN","RMPRE29",63,0) E D "RTN","RMPRE29",64,0) .S DIR(0)="Y",DIR("B")="N",DIR("A")="Would you like to edit the CPT Modifier " "RTN","RMPRE29",65,0) .D ^DIR Q:$D(DUOUT)!$D(DTOUT) "RTN","RMPRE29",66,0) .I (Y>0) D "RTN","RMPRE29",67,0) ..S RDA=RMHCPC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660 "RTN","RMPRE29",68,0) ..D CPT^RMPRCPTU(RDA) S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",69,0) ..K DIR "RTN","RMPRE29",70,0) ..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",! "RTN","RMPRE29",71,0) ..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",72,0) S DR="7;5;14;9;21;16;28" D ^DIE "RTN","RMPRE29",73,0) I RMTOTCOS'=$P(^RMPR(660,DA,0),U,16) S DR="35////^S X=DUZ;36////^S X=DT" D ^DIE "RTN","RMPRE29",74,0) I $D(DTOUT)!('$G(Y))!($D(DUOUT)) D CHK "RTN","RMPRE29",75,0) QED2 ; "RTN","RMPRE29",76,0) Q:$D(RMPREDT) "RTN","RMPRE29",77,0) ;modified by #62 "RTN","RMPRE29",78,0) ;call PCE API to update patient care encounter. "RTN","RMPRE29",79,0) I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D "RTN","RMPRE29",80,0) .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA) "RTN","RMPRE29",81,0) .I RMCHK<1 H 3 "RTN","RMPRE29",82,0) L -^RMPR(660,RMPRDA,0) "RTN","RMPRE29",83,0) K DIR W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N) " D ^DIR "RTN","RMPRE29",84,0) G:'$D(DTOUT)&(Y>0) RMPRE29 "RTN","RMPRE29",85,0) EXIT ; "RTN","RMPRE29",86,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRE29",87,0) K DIC,DIE,DIR,%,X,Y "RTN","RMPRE29",88,0) Q "RTN","RMPRE29",89,0) SETED2 ;set 660 "RTN","RMPRE29",90,0) S ^RMPR(660,DA,0)=R1(0),^RMPR(660,DA,1)=R1(1),^RMPR(660,DA,"AM")=R1("AM") "RTN","RMPRE29",91,0) S DIK="^RMPR(660,",DA=RMPRDA D IX1^DIK K DIC "RTN","RMPRE29",92,0) D CHK "RTN","RMPRE29",93,0) Q "RTN","RMPRE29",94,0) ; "RTN","RMPRE29",95,0) QUICK ;quick edit for HCPCS and type "RTN","RMPRE29",96,0) K RMCPT "RTN","RMPRE29",97,0) W ! S DIC="^RMPR(660,",DIC(0)="AEMNQZ",DIC("A")="Select NUMBER, or Patient: " "RTN","RMPRE29",98,0) S DIC("W")="D EN^RMPRD1" "RTN","RMPRE29",99,0) S DIC("S")="I $P(^(0),U,6)!($P(^(0),U,26)'="""")" W ! "RTN","RMPRE29",100,0) D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPRE29",101,0) ;add source "RTN","RMPRE29",102,0) S (RMPRDA,DA)=+Y,DIE=DIC,DR="2;4.5" "RTN","RMPRE29",103,0) S R1(0)=$G(^RMPR(660,DA,0)),R1(1)=$G(^RMPR(660,DA,1)) "RTN","RMPRE29",104,0) S RMTYPE=$P(R1(0),U,4),RMSOUR=$P(R1(0),U,14) "RTN","RMPRE29",105,0) S RMHCOLD=$P(R1(1),U,4) "RTN","RMPRE29",106,0) D ^DIE G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)!$D(Y) SET "RTN","RMPRE29",107,0) S RMHCNEW=$P($G(^RMPR(660,DA,1)),U,4) "RTN","RMPRE29",108,0) S RMTYPE=$P($G(^RMPR(660,DA,0)),U,4) "RTN","RMPRE29",109,0) S RDA=RMHCNEW_"^"_RMTYPE_"^"_RMSOUR_"^"_660 "RTN","RMPRE29",110,0) W !,"OLD CPT MODIFER: ",$P(R1(1),U,6) "RTN","RMPRE29",111,0) I RMHCOLD'=RMHCNEW D "RTN","RMPRE29",112,0) .D CPT^RMPRCPTU(RDA) "RTN","RMPRE29",113,0) .W !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",114,0) .S $P(^RMPR(660,DA,1),U,6)=RMCPT "RTN","RMPRE29",115,0) I RMHCOLD=RMHCNEW D "RTN","RMPRE29",116,0) .W ! S DIR("B")="N",DIR(0)="Y",DIR("A")="Would You like to Edit CPT MODIFIER " D ^DIR "RTN","RMPRE29",117,0) .I $D(DTOUT)!('$G(Y)) K DIR Q "RTN","RMPRE29",118,0) .D CPT^RMPRCPTU(RDA) "RTN","RMPRE29",119,0) .W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",! "RTN","RMPRE29",120,0) .W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",RMCPT "RTN","RMPRE29",121,0) .S $P(^RMPR(660,DA,1),U,6)=RMCPT "RTN","RMPRE29",122,0) SET K DIR D CHK "RTN","RMPRE29",123,0) ;modified by #62 "RTN","RMPRE29",124,0) ;call PCE API to update patient care encounter "RTN","RMPRE29",125,0) I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D "RTN","RMPRE29",126,0) .S RMCHK=$$SENDPCE^RMPRPCEA(RMPRDA) "RTN","RMPRE29",127,0) .I RMCHK<1 H 3 "RTN","RMPRE29",128,0) W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR "RTN","RMPRE29",129,0) G:'$D(DTOUT)&(Y>0) QUICK^RMPRE29 "RTN","RMPRE29",130,0) L -^RMPR(660,RMPRDA,0) "RTN","RMPRE29",131,0) D KILL^XUSCLEAN Q "RTN","RMPRE29",132,0) ; "RTN","RMPRE29",133,0) CHK ;check for transaction changes "RTN","RMPRE29",134,0) S RMTYPE=$P($G(^RMPR(660,RMPRDA,0)),U,4) "RTN","RMPRE29",135,0) S RMHCPC=$P($G(^RMPR(660,RMPRDA,1)),U,4) Q:'$G(RMHCPC) "RTN","RMPRE29",136,0) S RMCPT1=$P($G(^RMPR(661.1,RMHCPC,4)),U,1) "RTN","RMPRE29",137,0) S RMCPT=$P($G(^RMPR(660,RMPRDA,1)),U,6) "RTN","RMPRE29",138,0) I ((RMTYPE="R")!(RMTYPE="X")),(RMCPT'["RP"),($G(^RMPR(661.1,RMHCPC,4))["RP") D ADDRP "RTN","RMPRE29",139,0) I ((RMTYPE="I")!(RMTYPE="S")),(RMCPT["RP") D DELRP "RTN","RMPRE29",140,0) I (RMSOUR="C"),(RMCPT["RR") D DELNU "RTN","RMPRE29",141,0) I (RMSOUR="C"),(RMCPT'["RR"),(RMCPT1["NU"),(RMCPT'["N") D ADDNU "RTN","RMPRE29",142,0) K RMHCPC,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA Q "RTN","RMPRE29",143,0) ;return to EDIT option "RTN","RMPRE29",144,0) DELRP ;logic for deleting 'RP' modifier with transaction change. "RTN","RMPRE29",145,0) F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="RP" S $P(RMCPT,",",RMCI)="" D "RTN","RMPRE29",146,0) .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2) "RTN","RMPRE29",147,0) .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT) "RTN","RMPRE29",148,0) .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN) "RTN","RMPRE29",149,0) .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1) "RTN","RMPRE29",150,0) .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",151,0) Q "RTN","RMPRE29",152,0) DELNU ;logic for deleting 'NU' modifier. "RTN","RMPRE29",153,0) F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="NU" S $P(RMCPT,",",RMCI)="" D "RTN","RMPRE29",154,0) .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2) "RTN","RMPRE29",155,0) .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE,RMCLEN=$L(RMCPT) "RTN","RMPRE29",156,0) .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN) "RTN","RMPRE29",157,0) .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1) "RTN","RMPRE29",158,0) .S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",159,0) Q "RTN","RMPRE29",160,0) ; "RTN","RMPRE29",161,0) ADDRP ;logic for adding 'RP' modifier with transaction change. "RTN","RMPRE29",162,0) S RMCPT=RMCPT_",RP" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",163,0) Q "RTN","RMPRE29",164,0) ADDNU ;logic for adding 'NU' modifier. "RTN","RMPRE29",165,0) S RMCPT=RMCPT_",NU" S $P(^RMPR(660,RMPRDA,1),U,6)=RMCPT "RTN","RMPRE29",166,0) Q "RTN","RMPRE29",167,0) ;END "RTN","RMPROP") 0^5^B6838056 "RTN","RMPROP",1,0) RMPROP ;PHX/RFM,JLT,RVD-PURCHASING OPTIONS ;8/29/1994 "RTN","RMPROP",2,0) ;;3.0;PROSTHETICS;**41,45,53,62,61**;Feb 09, 1996 "RTN","RMPROP",3,0) ; "RTN","RMPROP",4,0) ;RVD patch #53 only issue stock items from PIP "RTN","RMPROP",5,0) ; "RTN","RMPROP",6,0) ;RVD patch #62 pce interface, delete transaction if 2319 is deleted. "RTN","RMPROP",7,0) ; "RTN","RMPROP",8,0) ;RVD patch #61 PIP new files. "RTN","RMPROP",9,0) ; "RTN","RMPROP",10,0) EN1 ;EACH OF THE BELOW ENTRY POINTS SETS THE FORM TYPE, SITE PARAMETERS "RTN","RMPROP",11,0) ;AND CALLS THE ROUTINE FOR PURCHASING TRANSACTIONS "RTN","RMPROP",12,0) S RMPRF=1 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT "RTN","RMPROP",13,0) ; "RTN","RMPROP",14,0) EN2 ;Create 10-2421 "RTN","RMPROP",15,0) S RMPRF=2 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT "RTN","RMPROP",16,0) ; "RTN","RMPROP",17,0) EN3 ;2520 Transaction without printing "RTN","RMPROP",18,0) S RMPRF=10 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 K RMPRAMT G EXIT "RTN","RMPROP",19,0) ; "RTN","RMPROP",20,0) EN4 ;2914 EYEGLASS RECORD "RTN","RMPROP",21,0) ;SETS FORM TYPE CODE FOR 2914 "RTN","RMPROP",22,0) ;VARIABLES REQUIRED: NONE "RTN","RMPROP",23,0) S RMPRF=8 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT "RTN","RMPROP",24,0) ; "RTN","RMPROP",25,0) EN5 ;CLOSE-OUT "RTN","RMPROP",26,0) S RMPRF="E" D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPRE21 G EXIT "RTN","RMPROP",27,0) ; "RTN","RMPROP",28,0) EN6 ;NO-FORM DAILY RECORD "RTN","RMPROP",29,0) S RMPRF=9 D DIV4^RMPRSIT G:$D(X) EXIT D ^RMPR21 G EXIT "RTN","RMPROP",30,0) ; "RTN","RMPROP",31,0) EN7 ;ISSUE FROM STOCK "RTN","RMPROP",32,0) K RMPRDFN,RMPR "RTN","RMPROP",33,0) ;patch #61 call rmprpiyi instead of rmprsti "RTN","RMPROP",34,0) S RMPRF=11 D ^RMPRPIYI G EXIT "RTN","RMPROP",35,0) ; "RTN","RMPROP",36,0) EN9 ;PICKUP AND DELIVERY "RTN","RMPROP",37,0) D DIV4^RMPRSIT G:$D(X) EXIT S RMPRF=1 D EN^RMPRDP G EXIT "RTN","RMPROP",38,0) ; "RTN","RMPROP",39,0) EN10 ;Edit 2319 Entry "RTN","RMPROP",40,0) S RMPREDT=1 ;set flag for the edit "RTN","RMPROP",41,0) D DIV4^RMPRSIT G:$D(X) EXIT S DIC("S")="I $P(^(0),U,13)=3,$P(^(0),U,10)=RMPR(""STA"")" I RMPRSITE=1 S DIC("S")=DIC("S")_"!($P(^(0),U,10)="""")" "RTN","RMPROP",42,0) S DIC("W")="D EN^RMPRD1",DIC="^RMPR(660,",DIC(0)="AEQMZ",DIC("A")="Please Enter the 2319 Date or the Patient's Name: " "RTN","RMPROP",43,0) D ^DIC G:+Y'>0 EXIT L +^RMPR(660,+Y,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT "RTN","RMPROP",44,0) ;S (RMPRDA,DA)=+Y,DIE=DIC,DR="[RMPRE2319]" D ^DIE "RTN","RMPROP",45,0) S (RMPRDA,DA)=+Y,DIE=DIC D TYP1^RMPRE29 K DIR "RTN","RMPROP",46,0) W ! S DIR(0)="Y",DIR("A")="Would You like to Delete this 2319 Entry (Y/N)" D ^DIR "RTN","RMPROP",47,0) I '$D(DTOUT)&(Y>0) D "RTN","RMPROP",48,0) .;added by patch #62. "RTN","RMPROP",49,0) .I $D(^RMPR(660,RMPRDA,10)),$P(^RMPR(660,RMPRDA,10),U,12) D "RTN","RMPROP",50,0) ..S RMCHK=$$DEL^RMPRPCED(RMPRDA) "RTN","RMPROP",51,0) .S DA=RMPRDA,DIK="^RMPR(660," D ^DIK "RTN","RMPROP",52,0) L -^RMPR(660,RMPRDA,0) "RTN","RMPROP",53,0) W ! S DIR(0)="Y",DIR("A")="Would You like to Edit another Entry (Y/N)" D ^DIR "RTN","RMPROP",54,0) G:'$D(DTOUT)&(Y>0) EN10 "RTN","RMPROP",55,0) EXIT K I,%,DA,DIE,DIK,DR,J,X,Y,RMPRF,DIC,DIR "RTN","RMPROP",56,0) N RMPR,RMPRSITE D KILL^XUSCLEAN Q "RTN","RMPRPI01") 0^6^B31783788 "RTN","RMPRPI01",1,0) RMPRPI01 ;HINCIO/ODJ - PIP Report APIs ;9/18/02 15:13 "RTN","RMPRPI01",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI01",3,0) ; "RTN","RMPRPI01",4,0) Q "RTN","RMPRPI01",5,0) ; "RTN","RMPRPI01",6,0) ;***** HBAL - returns a ^TMP array structured as follows:- "RTN","RMPRPI01",7,0) ; ^TMP($J,N,H,I,D,S,L)=data (^ delimiter) "RTN","RMPRPI01",8,0) ; "RTN","RMPRPI01",9,0) ; where N = ^TMP array name (eg. RMPRPI01) "RTN","RMPRPI01",10,0) ; H = HCPCS code (eg. L5000) "RTN","RMPRPI01",11,0) ; I = Item number (eg. 1) "RTN","RMPRPI01",12,0) ; D = full FM date (eg. 3010309.135415) "RTN","RMPRPI01",13,0) ; S = Source (C - comercial, V - VA) "RTN","RMPRPI01",14,0) ; L = Location ien (ptr. ^RMPR(661.5,) "RTN","RMPRPI01",15,0) ; "RTN","RMPRPI01",16,0) ; data pc 1 = Quantity on hand "RTN","RMPRPI01",17,0) ; 2 = Value "RTN","RMPRPI01",18,0) ; 3 = Unit Cost "RTN","RMPRPI01",19,0) ; 4 = Vendor Desc. "RTN","RMPRPI01",20,0) ; 5 = HCPCS Item description "RTN","RMPRPI01",21,0) ; 6 = Location Desc. "RTN","RMPRPI01",22,0) ; 7 = Re-Order Level "RTN","RMPRPI01",23,0) ; "RTN","RMPRPI01",24,0) ; Inputs: "RTN","RMPRPI01",25,0) ; RMPRNM - Name for ^TMP array "RTN","RMPRPI01",26,0) ; RMPRSTN - Station number (ptr. ^DIC(4)) "RTN","RMPRPI01",27,0) ; RMPRHCPC - Array of HCPCS codes, or * for all HCPCS. "RTN","RMPRPI01",28,0) ; "RTN","RMPRPI01",29,0) ; Outputs: "RTN","RMPRPI01",30,0) ; RMPRERR - 0 if no errors, +ve int. if errors "RTN","RMPRPI01",31,0) ; ^TMP - (see above) "RTN","RMPRPI01",32,0) ; "RTN","RMPRPI01",33,0) HBAL(RMPRNM,RMPRSTN,RMPRHCPC) ; "RTN","RMPRPI01",34,0) N RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPRT,RMPR6E,RMPR11E,RMPR6I "RTN","RMPRPI01",35,0) N RMPREI,RMPR4 "RTN","RMPRPI01",36,0) S RMPRERR=0 "RTN","RMPRPI01",37,0) I $G(RMPRNM)="" S RMPRNM="RMPRPI01" "RTN","RMPRPI01",38,0) I $G(RMPRSTN)="" S RMPRERR=1 G HBALX "RTN","RMPRPI01",39,0) I '$D(RMPRHCPC) S RMPRHCPC="*" "RTN","RMPRPI01",40,0) K ^TMP($J,RMPRNM) "RTN","RMPRPI01",41,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPI01",42,0) I $G(RMPRHCPC)="*" G HBAL2 "RTN","RMPRPI01",43,0) S RMPRH="" "RTN","RMPRPI01",44,0) HBAL1 S RMPRH=$O(RMPRHCPC(RMPRH)) "RTN","RMPRPI01",45,0) I RMPRH="" G HBALX "RTN","RMPRPI01",46,0) K RMPR "RTN","RMPRPI01",47,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPI01",48,0) S RMPR("HCPCS")=RMPRH "RTN","RMPRPI01",49,0) HBAL2 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPI01",50,0) I RMPRERR G HBALX "RTN","RMPRPI01",51,0) I RMPREOF G HBALX "RTN","RMPRPI01",52,0) I $G(RMPRHCPC)'="*",RMPROLD("HCPCS")'=RMPR("HCPCS") G HBAL1 "RTN","RMPRPI01",53,0) I RMPROLD("STATION")'=RMPR("STATION") G:$G(RMPRHCPC)="*" HBAL2 G HBAL1 "RTN","RMPRPI01",54,0) K RMPRE M RMPRE=RMPR "RTN","RMPRPI01",55,0) S RMPRERR=$$GET^RMPRPIX7(.RMPRE) "RTN","RMPRPI01",56,0) I RMPRERR G HBALX "RTN","RMPRPI01",57,0) K RMPREI S RMPRERR=$$ETOI^RMPRPIX7(.RMPRE,.RMPREI) "RTN","RMPRPI01",58,0) I RMPRERR G HBALX "RTN","RMPRPI01",59,0) K RMPR6E "RTN","RMPRPI01",60,0) S RMPR6E("HCPCS")=RMPR("HCPCS") "RTN","RMPRPI01",61,0) S RMPR6E("ITEM")=RMPR("ITEM") "RTN","RMPRPI01",62,0) S RMPR6E("DATE&TIME")=RMPR("DATE&TIME") "RTN","RMPRPI01",63,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6E) "RTN","RMPRPI01",64,0) K RMPR11E "RTN","RMPRPI01",65,0) S RMPR11E("HCPCS")=RMPR("HCPCS") "RTN","RMPRPI01",66,0) S RMPR11E("ITEM")=RMPR("ITEM") "RTN","RMPRPI01",67,0) S RMPR11E("STATION")=RMPR("STATION") "RTN","RMPRPI01",68,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11E) "RTN","RMPRPI01",69,0) I RMPRERR G HBALX "RTN","RMPRPI01",70,0) K RMPR11I "RTN","RMPRPI01",71,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11E,.RMPR11I) "RTN","RMPRPI01",72,0) I RMPRERR G HBALX "RTN","RMPRPI01",73,0) S RMPRT="" "RTN","RMPRPI01",74,0) S $P(RMPRT,"^",1)=RMPRE("QUANTITY") "RTN","RMPRPI01",75,0) S $P(RMPRT,"^",2)=RMPRE("VALUE") "RTN","RMPRPI01",76,0) I +RMPRE("QUANTITY") D "RTN","RMPRPI01",77,0) . S $P(RMPRT,"^",3)=$J(RMPRE("VALUE")/RMPRE("QUANTITY"),0,2) "RTN","RMPRPI01",78,0) . Q "RTN","RMPRPI01",79,0) S $P(RMPRT,"^",4)=RMPR6E("VENDOR") "RTN","RMPRPI01",80,0) S $P(RMPRT,"^",5)=RMPR11E("DESCRIPTION") "RTN","RMPRPI01",81,0) S $P(RMPRT,"^",6)=RMPRE("LOCATION") "RTN","RMPRPI01",82,0) K RMPR4 "RTN","RMPRPI01",83,0) S RMPR4("IEN")=$O(^RMPR(661.4,"ASLHI",RMPR11I("STATION"),RMPREI("LOCATION"),RMPR11I("HCPCS"),RMPR11I("ITEM"),"")) "RTN","RMPRPI01",84,0) ;next line added "RTN","RMPRPI01",85,0) G:RMPR4("IEN")="" HBAL2 "RTN","RMPRPI01",86,0) S RMPRERR=$$GET^RMPRPIX4(.RMPR4) "RTN","RMPRPI01",87,0) S $P(RMPRT,"^",7)=RMPR4("RE-ORDER QTY") "RTN","RMPRPI01",88,0) S ^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR("ITEM"),RMPR("DATE&TIME"),RMPR11I("SOURCE"),RMPREI("LOCATION"))=RMPRT "RTN","RMPRPI01",89,0) G HBAL2 "RTN","RMPRPI01",90,0) HBALX Q RMPRERR "RTN","RMPRPI01",91,0) ; "RTN","RMPRPI01",92,0) PROC(RMSUB,RS,RMPRI) ; "RTN","RMPRPI01",93,0) N RMDAT,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPRT,RMPR6E,RMPR11E,RMPR6I "RTN","RMPRPI01",94,0) N RMST2,RMTY,RM6,RM11,RMIT2,RMII,I,J,K,RMIDES,RMINS,RM11DA "RTN","RMPRPI01",95,0) I $G(RMPRI)="*" D ALL "RTN","RMPRPI01",96,0) D HCPC "RTN","RMPRPI01",97,0) ; "RTN","RMPRPI01",98,0) NOINV ; "RTN","RMPRPI01",99,0) ;check for other items not currently in the inventory but previously in. "RTN","RMPRPI01",100,0) S I="" "RTN","RMPRPI01",101,0) F S I=$O(^RMPR(661.11,"ASHI",RS,I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.11,"ASHI",RS,I,J)) Q:J'>0 D "RTN","RMPRPI01",102,0) .F K=0:0 S K=$O(^RMPR(661.11,"ASHI",RS,I,J,K)) Q:K'>0 D "RTN","RMPRPI01",103,0) ..S RM11=$G(^RMPR(661.11,K,0)) "RTN","RMPRPI01",104,0) ..Q:RM11="" "RTN","RMPRPI01",105,0) ..Q:$D(^TMP($J,"RMTMP",I,J)) "RTN","RMPRPI01",106,0) ..S RMIDES=$P(RM11,U,3) "RTN","RMPRPI01",107,0) ..Q:($P(RM11,U,9))=1 "RTN","RMPRPI01",108,0) ..;check what location this HCCPS/ITEM belongs to previously. "RTN","RMPRPI01",109,0) ..F RMII=0:0 S RMII=$O(^RMPR(661.6,"B",I,RMII)) Q:RMII'>0 D "RTN","RMPRPI01",110,0) ...Q:'$D(^RMPR(661.6,RMII,0)) "RTN","RMPRPI01",111,0) ...S RM6=$G(^RMPR(661.6,RMII,0)),RMIT2=$P(RM6,U,11) "RTN","RMPRPI01",112,0) ...S RMTY=$P(RM6,U,4),RMST2=$P(RM6,U,13) "RTN","RMPRPI01",113,0) ...I $G(RMPRI)'="*",'$D(RMPRI(I)) Q "RTN","RMPRPI01",114,0) ...Q:(RMST2'=RS)!(RMIT2'=J)!(RMTY'=1) "RTN","RMPRPI01",115,0) ...S ^TMP($J,RMSUB,I,J,1,1)="^^^^"_RMIDES "RTN","RMPRPI01",116,0) ;EXIT "RTN","RMPRPI01",117,0) Q "RTN","RMPRPI01",118,0) ; "RTN","RMPRPI01",119,0) ALL ;process all HCPCS in a station "RTN","RMPRPI01",120,0) S I="" "RTN","RMPRPI01",121,0) F S I=$O(^RMPR(661.7,"B",I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.7,"B",I,J)) Q:J'>0 D CRE "RTN","RMPRPI01",122,0) Q "RTN","RMPRPI01",123,0) HCPC ;process certain HCPCS "RTN","RMPRPI01",124,0) S I="" F S I=$O(RMPRI(I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.7,"B",I,J)) Q:J'>0 D CRE "RTN","RMPRPI01",125,0) Q "RTN","RMPRPI01",126,0) ; "RTN","RMPRPI01",127,0) CRE ;create the tmp global "RTN","RMPRPI01",128,0) S RMDAT=$G(^RMPR(661.7,J,0)) "RTN","RMPRPI01",129,0) Q:RS'=$P(RMDAT,U,5) "RTN","RMPRPI01",130,0) S RMUNI="" "RTN","RMPRPI01",131,0) S RMHC=$P(RMDAT,U,1) "RTN","RMPRPI01",132,0) S RMDT=$P(RMDAT,U,2) "RTN","RMPRPI01",133,0) S RMSE=$P(RMDAT,U,3) "RTN","RMPRPI01",134,0) S RMHI=$P(RMDAT,U,4) "RTN","RMPRPI01",135,0) S RMST=$P(RMDAT,U,5) "RTN","RMPRPI01",136,0) S RMLO=$P(RMDAT,U,6) "RTN","RMPRPI01",137,0) S RMQU=$P(RMDAT,U,7) "RTN","RMPRPI01",138,0) S RMVA=$P(RMDAT,U,8) "RTN","RMPRPI01",139,0) S RMUN=$P(RMDAT,U,9) "RTN","RMPRPI01",140,0) S:$G(RMUN) RMUNI=$$GETUNI^RMPRPIU0(RMUN) "RTN","RMPRPI01",141,0) S RMUC=RMVA "RTN","RMPRPI01",142,0) I RMVA,RMQU S RMUC=RMVA/RMQU "RTN","RMPRPI01",143,0) S RMRO=0 "RTN","RMPRPI01",144,0) S RMSO="**" "RTN","RMPRPI01",145,0) S (RMVEN,RMLOC,RMIDES)=" " "RTN","RMPRPI01",146,0) I $G(RMLO),$D(^RMPR(661.5,RMLO,0)) S RMLOC=$P(^RMPR(661.5,RMLO,0),U,1) "RTN","RMPRPI01",147,0) S RM11=$O(^RMPR(661.11,"ASHI",RS,RMHC,RMHI,0)) "RTN","RMPRPI01",148,0) I $G(RM11),$D(^RMPR(661.11,RM11,0)) S RMSO=$P(^RMPR(661.11,RM11,0),U,5),RMIDES=$P(^RMPR(661.11,RM11,0),U,3) "RTN","RMPRPI01",149,0) S RM4=$O(^RMPR(661.4,"ASLHI",RS,RMLO,RMHC,RMHI,0)) "RTN","RMPRPI01",150,0) I $G(RM4),$D(^RMPR(661.4,RM4,0)) S RMRO=$P(^RMPR(661.4,RM4,0),U,4) "RTN","RMPRPI01",151,0) S RMHCIEN=$O(^RMPR(661.1,"B",RMHC,0)) "RTN","RMPRPI01",152,0) I RMHCIEN,$D(^RMPR(661.1,RMHCIEN,0)) S RMHDES=$P(^RMPR(661.1,RMHCIEN,0),U,2) "RTN","RMPRPI01",153,0) F K=0:0 S K=$O(^RMPR(661.6,"C",RMDT,K)) Q:K'>0 S RM6=$G(^RMPR(661.6,K,0)) D "RTN","RMPRPI01",154,0) .Q:RMHC'=$P(RM6,U,1) "RTN","RMPRPI01",155,0) .I (RMHC=$P(RM6,U,1)),(RMSE=$P(RM6,U,3)) S RMV=$P(RM6,U,12) "RTN","RMPRPI01",156,0) .S:$G(RMV) RMVEN=$$GETVEN^RMPRPIU0(RMV) "RTN","RMPRPI01",157,0) S RMPRT=RMQU_"^"_RMVA_"^"_RMUC_"^"_RMVEN_"^"_RMIDES_"^"_RMLOC_"^"_RMRO "RTN","RMPRPI01",158,0) S ^TMP($J,RMSUB,RMHC,RMHI,RMDT,RMLO)=RMPRT_"^"_RMUNI_"^"_RMSO "RTN","RMPRPI01",159,0) S ^TMP($J,"RMTMP",RMHC,RMHI)="" "RTN","RMPRPI01",160,0) Q "RTN","RMPRPI02") 0^7^B34609029 "RTN","RMPRPI02",1,0) RMPRPI02 ;HINCIO/ODJ - PIP Report APIs ;9/18/02 15:13 "RTN","RMPRPI02",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI02",3,0) ; "RTN","RMPRPI02",4,0) Q "RTN","RMPRPI02",5,0) ; "RTN","RMPRPI02",6,0) ; LBAL - returns a ^TMP array structured as follows:- "RTN","RMPRPI02",7,0) ; ^TMP($J,N,L,H,I,D,S)=data (^ delimiter) "RTN","RMPRPI02",8,0) ; "RTN","RMPRPI02",9,0) ; where N = ^TMP array name (eg. RMPRPI01) "RTN","RMPRPI02",10,0) ; L = Location (NAME) "RTN","RMPRPI02",11,0) ; H = HCPCS code (eg. L5000) "RTN","RMPRPI02",12,0) ; I = Item number (eg. 1) "RTN","RMPRPI02",13,0) ; D = full FM date (eg. 3010309.135415) "RTN","RMPRPI02",14,0) ; S = Source (C - comercial, V - VA) "RTN","RMPRPI02",15,0) ; "RTN","RMPRPI02",16,0) ; data pc 1 = Quantity on hand "RTN","RMPRPI02",17,0) ; 2 = Value "RTN","RMPRPI02",18,0) ; 3 = Unit Cost "RTN","RMPRPI02",19,0) ; 4 = Vendor Desc. "RTN","RMPRPI02",20,0) ; 5 = HCPCS Item description "RTN","RMPRPI02",21,0) ; 6 = Location Desc. "RTN","RMPRPI02",22,0) ; 7 = Re-Order level "RTN","RMPRPI02",23,0) ; "RTN","RMPRPI02",24,0) ; Inputs: "RTN","RMPRPI02",25,0) ; RMPRNM - Name for ^TMP array "RTN","RMPRPI02",26,0) ; RMPRSTN - Station number (ptr. ^DIC(4)) "RTN","RMPRPI02",27,0) ; RMPRLOCA - Array of Location iens, or * for all Locations. "RTN","RMPRPI02",28,0) ; "RTN","RMPRPI02",29,0) ; Outputs: "RTN","RMPRPI02",30,0) ; RMPRERR - 0 if no errors, +ve int. if errors "RTN","RMPRPI02",31,0) ; ^TMP - (see above) "RTN","RMPRPI02",32,0) ; "RTN","RMPRPI02",33,0) LBAL(RMPRNM,RMPRSTN,RMPRLOCA) ; "RTN","RMPRPI02",34,0) N RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPRT,RMPR6E,RMPR11E,RMPR6I "RTN","RMPRPI02",35,0) N RMPR4,RMPR5 "RTN","RMPRPI02",36,0) S RMPRERR=0 "RTN","RMPRPI02",37,0) I $G(RMPRNM)="" S RMPRNM="RMPRPI02" "RTN","RMPRPI02",38,0) I $G(RMPRSTN)="" S RMPRERR=1 G LBALX "RTN","RMPRPI02",39,0) I '$D(RMPRLOCA)="" S RMPRLOCA="*" "RTN","RMPRPI02",40,0) K ^TMP($J,RMPRNM) "RTN","RMPRPI02",41,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPI02",42,0) I $G(RMPRLOCA)="*" G LBAL2 "RTN","RMPRPI02",43,0) S RMPRH="" "RTN","RMPRPI02",44,0) LBAL1 S RMPRH=$O(RMPRLOCA(RMPRH)) "RTN","RMPRPI02",45,0) I RMPRH="" G LBALX "RTN","RMPRPI02",46,0) K RMPR "RTN","RMPRPI02",47,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPI02",48,0) S RMPR("LOCATION")=RMPRH "RTN","RMPRPI02",49,0) LBAL2 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPI02",50,0) I RMPRERR W !,"*** ERROR IN RMPRPIXE ROUTINE!!!",! G LBALX "RTN","RMPRPI02",51,0) I RMPREOF G LBAL1 "RTN","RMPRPI02",52,0) I $G(RMPRLOCA)'="*",RMPROLD("LOCATION")'=RMPR("LOCATION") G LBAL1 "RTN","RMPRPI02",53,0) I RMPROLD("STATION")'=RMPR("STATION") G:$G(RMPRLOCA)="*" LBALX G LBAL1 "RTN","RMPRPI02",54,0) K RMPRE S RMPRE("IEN")=RMPR("IEN") "RTN","RMPRPI02",55,0) S RMPRERR=$$GET^RMPRPIX7(.RMPRE) "RTN","RMPRPI02",56,0) I RMPRERR W !,"*** ERROR IN RMPRPIX7 ROUTINE!!!",! G LBALX "RTN","RMPRPI02",57,0) K RMPR6E "RTN","RMPRPI02",58,0) S RMPR6E("HCPCS")=RMPR("HCPCS") "RTN","RMPRPI02",59,0) S RMPR6E("ITEM")=RMPR("ITEM") "RTN","RMPRPI02",60,0) S RMPR6E("DATE&TIME")=RMPR("DATE&TIME") "RTN","RMPRPI02",61,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6E) "RTN","RMPRPI02",62,0) K RMPR11E "RTN","RMPRPI02",63,0) S RMPR11E("HCPCS")=RMPR("HCPCS") "RTN","RMPRPI02",64,0) S RMPR11E("ITEM")=RMPR("ITEM") "RTN","RMPRPI02",65,0) S RMPR11E("STATION")=RMPR("STATION") "RTN","RMPRPI02",66,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11E) "RTN","RMPRPI02",67,0) I RMPRERR W !,"*** ERROR IN RMPRPIX1 ROUTINE!!!",! G LBALX "RTN","RMPRPI02",68,0) K RMPR11I "RTN","RMPRPI02",69,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11E,.RMPR11I) "RTN","RMPRPI02",70,0) I RMPRERR W !,"*** ERROR IN RMPRPIX1 ROUTINE!!!",! G LBALX "RTN","RMPRPI02",71,0) S RMPRT="" "RTN","RMPRPI02",72,0) S $P(RMPRT,"^",1)=RMPRE("QUANTITY") "RTN","RMPRPI02",73,0) S $P(RMPRT,"^",2)=RMPRE("VALUE") "RTN","RMPRPI02",74,0) I +RMPRE("QUANTITY") D "RTN","RMPRPI02",75,0) . S $P(RMPRT,"^",3)=$J(RMPRE("VALUE")/RMPRE("QUANTITY"),0,2) "RTN","RMPRPI02",76,0) . Q "RTN","RMPRPI02",77,0) S $P(RMPRT,"^",4)=RMPR6E("VENDOR") "RTN","RMPRPI02",78,0) S $P(RMPRT,"^",5)=RMPR11E("DESCRIPTION") "RTN","RMPRPI02",79,0) S $P(RMPRT,"^",6)=RMPRE("LOCATION") "RTN","RMPRPI02",80,0) K RMPR4 "RTN","RMPRPI02",81,0) S RMPR4("IEN")=$O(^RMPR(661.4,"ASLHI",RMPR11I("STATION"),RMPR("LOCATION"),RMPR11I("HCPCS"),RMPR11I("ITEM"),"")) "RTN","RMPRPI02",82,0) ;next line added "RTN","RMPRPI02",83,0) G:RMPR4("IEN")="" LBALX "RTN","RMPRPI02",84,0) S RMPRERR=$$GET^RMPRPIX4(.RMPR4,,) "RTN","RMPRPI02",85,0) S $P(RMPRT,"^",7)=RMPR4("RE-ORDER QTY") "RTN","RMPRPI02",86,0) S ^TMP($J,RMPRNM,RMPRE("LOCATION"),RMPR("HCPCS"),RMPR("ITEM"),RMPR("DATE&TIME"),RMPR11I("SOURCE"))=RMPRT "RTN","RMPRPI02",87,0) G LBAL2 "RTN","RMPRPI02",88,0) LBALX Q RMPRERR "RTN","RMPRPI02",89,0) ; "RTN","RMPRPI02",90,0) PROC(RMSUB,RS,RMPRI) ; "RTN","RMPRPI02",91,0) N RMDAT,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPRT,RMPR6E,RMPR11E,RMPR6I "RTN","RMPRPI02",92,0) N RMST2,RMTY,RM6,RM11,RMIT2,RMLOC2,RMII,I,J,K,RMIDES,RMINS,RM11DA "RTN","RMPRPI02",93,0) I $G(RMPRI)="*" D ALL "RTN","RMPRPI02",94,0) D LOC "RTN","RMPRPI02",95,0) NOINV ; "RTN","RMPRPI02",96,0) ;check for other items not currently in the inventory but previously in. "RTN","RMPRPI02",97,0) S I="" "RTN","RMPRPI02",98,0) F S I=$O(^RMPR(661.11,"ASHI",RS,I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.11,"ASHI",RS,I,J)) Q:J'>0 D "RTN","RMPRPI02",99,0) .F K=0:0 S K=$O(^RMPR(661.11,"ASHI",RS,I,J,K)) Q:K'>0 D "RTN","RMPRPI02",100,0) ..Q:'$D(^RMPR(661.11,K,0)) "RTN","RMPRPI02",101,0) ..S RM11=$G(^RMPR(661.11,K,0)) "RTN","RMPRPI02",102,0) ..Q:RM11="" "RTN","RMPRPI02",103,0) ..Q:$D(^TMP($J,"RMTMP",I,J)) "RTN","RMPRPI02",104,0) ..S RMIDES=$P(RM11,U,3) "RTN","RMPRPI02",105,0) ..Q:($P(RM11,U,9))=1 "RTN","RMPRPI02",106,0) ..;check what location this HCCPS/ITEM belongs to previously. "RTN","RMPRPI02",107,0) ..F RMII=0:0 S RMII=$O(^RMPR(661.6,"B",I,RMII)) Q:RMII'>0 D "RTN","RMPRPI02",108,0) ...Q:'$D(^RMPR(661.6,RMII,0)) "RTN","RMPRPI02",109,0) ...S RM6=$G(^RMPR(661.6,RMII,0)),RMIT2=$P(RM6,U,11) "RTN","RMPRPI02",110,0) ...S RMTY=$P(RM6,U,4),RMST2=$P(RM6,U,13),RMLOC2=$P(RM6,U,14) "RTN","RMPRPI02",111,0) ...Q:'$G(RMLOC2) "RTN","RMPRPI02",112,0) ...I $G(RMPRI)'="*",'$D(RMPRI(RMLOC2)) Q "RTN","RMPRPI02",113,0) ...Q:(RMST2'=RS)!(RMIT2'=J)!(RMTY'=1)!(RMLOC2="") "RTN","RMPRPI02",114,0) ...Q:'$D(^RMPR(661.5,RMLOC2,0)) "RTN","RMPRPI02",115,0) ...S RMLOC2N=$P(^RMPR(661.5,RMLOC2,0),U,1) "RTN","RMPRPI02",116,0) ...Q:$D(^TMP($J,RMSUB,RMLOC2N,I,J,1)) "RTN","RMPRPI02",117,0) ...S ^TMP($J,RMSUB,RMLOC2N,I,J,1)="^^^^"_RMIDES "RTN","RMPRPI02",118,0) ;EXIT "RTN","RMPRPI02",119,0) Q "RTN","RMPRPI02",120,0) ; "RTN","RMPRPI02",121,0) ALL ;process all LOCATION in a station "RTN","RMPRPI02",122,0) S I="" "RTN","RMPRPI02",123,0) F S I=$O(^RMPR(661.7,"B",I)) Q:I="" F J=0:0 S J=$O(^RMPR(661.7,"B",I,J)) Q:J'>0 D CRE "RTN","RMPRPI02",124,0) Q "RTN","RMPRPI02",125,0) LOC ;process certain LOCATION. "RTN","RMPRPI02",126,0) F I=0:0 S I=$O(RMPRI(I)) Q:I'>0 F J=0:0 S J=$O(^RMPR(661.7,"C",I,J)) Q:J'>0 D CRE "RTN","RMPRPI02",127,0) Q "RTN","RMPRPI02",128,0) ; "RTN","RMPRPI02",129,0) CRE ;create the tmp global "RTN","RMPRPI02",130,0) S RMDAT=$G(^RMPR(661.7,J,0)) "RTN","RMPRPI02",131,0) Q:RS'=$P(RMDAT,U,5) "RTN","RMPRPI02",132,0) S RMUNIT="" "RTN","RMPRPI02",133,0) S RMHC=$P(RMDAT,U,1) "RTN","RMPRPI02",134,0) S RMDT=$P(RMDAT,U,2) "RTN","RMPRPI02",135,0) S RMSE=$P(RMDAT,U,3) "RTN","RMPRPI02",136,0) S RMHI=$P(RMDAT,U,4) "RTN","RMPRPI02",137,0) S RMST=$P(RMDAT,U,5) "RTN","RMPRPI02",138,0) S RMLO=$P(RMDAT,U,6) "RTN","RMPRPI02",139,0) S RMQU=$P(RMDAT,U,7) "RTN","RMPRPI02",140,0) S RMVA=$P(RMDAT,U,8) "RTN","RMPRPI02",141,0) S RMUN=$P(RMDAT,U,9) "RTN","RMPRPI02",142,0) S:$G(RMUN) RMUNIT=$$GETUNI^RMPRPIU0(RMUN) "RTN","RMPRPI02",143,0) S RMUC=RMVA "RTN","RMPRPI02",144,0) I RMVA,RMQU S RMUC=RMVA/RMQU "RTN","RMPRPI02",145,0) S RMRO=0 "RTN","RMPRPI02",146,0) S RMSO="**" "RTN","RMPRPI02",147,0) S (RMVEN,RMLOC,RMIDES)=" " "RTN","RMPRPI02",148,0) I $G(RMLO),$D(^RMPR(661.5,RMLO,0)) S RMLOC=$P(^RMPR(661.5,RMLO,0),U,1) "RTN","RMPRPI02",149,0) S RM11=$O(^RMPR(661.11,"ASHI",RS,RMHC,RMHI,0)) "RTN","RMPRPI02",150,0) Q:'$G(RM11) "RTN","RMPRPI02",151,0) Q:'$D(^RMPR(661.11,RM11,0)) "RTN","RMPRPI02",152,0) S RM11DA=$G(^RMPR(661.11,RM11,0)) "RTN","RMPRPI02",153,0) S RMSO=$P(RM11DA,U,5),RMIDES=$P(RM11DA,U,3),RMINS=$P(RM11DA,U,9) "RTN","RMPRPI02",154,0) Q:RMINS=1 "RTN","RMPRPI02",155,0) S RM4=$O(^RMPR(661.4,"ASLHI",RS,RMLO,RMHC,RMHI,0)) "RTN","RMPRPI02",156,0) I $G(RM4),$D(^RMPR(661.4,RM4,0)) S RMRO=$P(^RMPR(661.4,RM4,0),U,4) "RTN","RMPRPI02",157,0) S RMHCIEN=$O(^RMPR(661.1,"B",RMHC,0)) "RTN","RMPRPI02",158,0) I RMHCIEN,$D(^RMPR(661.1,RMHCIEN,0)) S RMHDES=$P(^RMPR(661.1,RMHCIEN,0),U,2) "RTN","RMPRPI02",159,0) F K=0:0 S K=$O(^RMPR(661.6,"C",RMDT,K)) Q:K'>0 S RM6=$G(^RMPR(661.6,K,0)) D "RTN","RMPRPI02",160,0) .Q:RMHC'=$P(RM6,U,1) "RTN","RMPRPI02",161,0) .I (RMHC=$P(RM6,U,1)),(RMSE=$P(RM6,U,3)) S RMV=$P(RM6,U,12) "RTN","RMPRPI02",162,0) .S:$G(RMV) RMVEN=$$GETVEN^RMPRPIU0(RMV) "RTN","RMPRPI02",163,0) S RMPRT=RMQU_"^"_RMVA_"^"_RMUC_"^"_RMVEN_"^"_RMIDES_"^"_RMLOC_"^"_RMRO "RTN","RMPRPI02",164,0) S ^TMP($J,RMSUB,RMLOC,RMHC,RMHI,RMDT)=RMPRT_"^"_RMUNIT_"^"_RMSO "RTN","RMPRPI02",165,0) S ^TMP($J,"RMTMP",RMHC,RMHI)="" "RTN","RMPRPI02",166,0) Q "RTN","RMPRPI03") 0^8^B17562500 "RTN","RMPRPI03",1,0) RMPRPI03 ;HINCIO/ODJ - PIP Report APIs ;3/8/01 "RTN","RMPRPI03",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI03",3,0) Q "RTN","RMPRPI03",4,0) ; "RTN","RMPRPI03",5,0) ; THIS - returns a ^TMP array structured as follows:- "RTN","RMPRPI03",6,0) ; ^TMP($J,N,H,I,S)=data (^ delimiter) "RTN","RMPRPI03",7,0) ; "RTN","RMPRPI03",8,0) ; where N = ^TMP array name (eg. RMPRPI03) "RTN","RMPRPI03",9,0) ; H = HCPCS code (eg. L5000) "RTN","RMPRPI03",10,0) ; A = Item name "RTN","RMPRPI03",11,0) ; I = Item number (eg. 1) "RTN","RMPRPI03",12,0) ; S = Sequence (1,2,etc) "RTN","RMPRPI03",13,0) ; "RTN","RMPRPI03",14,0) ; data pc 1 = Date "RTN","RMPRPI03",15,0) ; 2 = Time "RTN","RMPRPI03",16,0) ; 3 = Opening Balance "RTN","RMPRPI03",17,0) ; 4 = Closing Balance "RTN","RMPRPI03",18,0) ; 5 = Quantity "RTN","RMPRPI03",19,0) ; 6 = Value "RTN","RMPRPI03",20,0) ; 7 = Transaction Type desc. "RTN","RMPRPI03",21,0) ; 8 = Patient Name (if patient issue, else null) "RTN","RMPRPI03",22,0) ; 9 = Patient SSN (if patient issue, else null) "RTN","RMPRPI03",23,0) ; 10 = User name "RTN","RMPRPI03",24,0) ; "RTN","RMPRPI03",25,0) THIS(RMPRNM,RMPRSTN,RMPRSDT,RMPREDT,RMPRHCPC) ; "RTN","RMPRPI03",26,0) N RMPRERR,RMPRH,RMPR,RMPROLD,RMPREOF,RMPRE,RMPR11 "RTN","RMPRPI03",27,0) N RMPROBAL,RMPRCBAL,RMPRSEQ,RMPRRX,RMPRFMDT,RMPR60,RMPR69 "RTN","RMPRPI03",28,0) N VA,VADM,DFN "RTN","RMPRPI03",29,0) S RMPRERR=0 "RTN","RMPRPI03",30,0) I $G(RMPRNM)="" S RMPRNM="RMPRPI03" "RTN","RMPRPI03",31,0) I $G(RMPRSTN)="" S RMPRERR=1 G THISX "RTN","RMPRPI03",32,0) I '$D(RMPRHCPC) S RMPRHCPC="*" "RTN","RMPRPI03",33,0) K ^TMP($J,RMPRNM) "RTN","RMPRPI03",34,0) S RMPRH="" "RTN","RMPRPI03",35,0) THIS1 S RMPRH=$O(RMPRHCPC(RMPRH)) "RTN","RMPRPI03",36,0) I RMPRH="" G THISX "RTN","RMPRPI03",37,0) K RMPR "RTN","RMPRPI03",38,0) S RMPR("HCPCS")=RMPRH "RTN","RMPRPI03",39,0) THIS1A S RMPR("DATE&TIME")=RMPRSDT "RTN","RMPRPI03",40,0) S RMPRERR=$$SRCH^RMPRPIXA(.RMPR,"XHDS","DATE&TIME",1,,.RMPREOF) "RTN","RMPRPI03",41,0) I RMPRERR G THISX "RTN","RMPRPI03",42,0) I RMPREOF G THIS1 "RTN","RMPRPI03",43,0) I $G(RMPRHCPC)'="*",RMPR("HCPCS")'=RMPRH G THIS1 "RTN","RMPRPI03",44,0) THIS2 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPI03",45,0) I RMPRERR G THISX "RTN","RMPRPI03",46,0) I RMPREOF G THISX "RTN","RMPRPI03",47,0) I RMPROLD("HCPCS")'=RMPR("HCPCS") G:$G(RMPRHCPC)'="*" THIS1 G THIS1A "RTN","RMPRPI03",48,0) I RMPR("DATE")>RMPREDT G:$G(RMPRHCPC)="*" THIS3 G THIS1 "RTN","RMPRPI03",49,0) S RMPRFMDT=RMPR("DATE") "RTN","RMPRPI03",50,0) K RMPRE "RTN","RMPRPI03",51,0) M RMPRE=RMPR "RTN","RMPRPI03",52,0) S RMPRERR=$$GET^RMPRPIX6(.RMPRE) "RTN","RMPRPI03",53,0) I RMPRERR G THISX "RTN","RMPRPI03",54,0) S RMPRERR=$$STNIEN^RMPRPIX6(.RMPRE) "RTN","RMPRPI03",55,0) I RMPRERR G THISX "RTN","RMPRPI03",56,0) I RMPRE("STATION IEN")'=RMPRSTN G THIS2 "RTN","RMPRPI03",57,0) K RMPR11 "RTN","RMPRPI03",58,0) S RMPR11("STATION")=RMPRSTN "RTN","RMPRPI03",59,0) S RMPR11("HCPCS")=RMPR("HCPCS") "RTN","RMPRPI03",60,0) S RMPR11("ITEM")=RMPRE("ITEM") "RTN","RMPRPI03",61,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPI03",62,0) I '$D(RMPR11("DESCRIPTION")) S RMPR11("DESCRIPTION")="NO DESCRIPTION" "RTN","RMPRPI03",63,0) S RMPRSEQ=$O(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),""),-1) "RTN","RMPRPI03",64,0) I RMPRSEQ'="" D "RTN","RMPRPI03",65,0) . S RMPROBAL=$P(^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ),"^",4) "RTN","RMPRPI03",66,0) . Q "RTN","RMPRPI03",67,0) E D "RTN","RMPRPI03",68,0) . K RMPRRX "RTN","RMPRPI03",69,0) . S RMPRRX("STA")=RMPRSTN "RTN","RMPRPI03",70,0) . S RMPRRX("HCP")=RMPR("HCPCS") "RTN","RMPRPI03",71,0) . S RMPRRX("ITE")=RMPRE("ITEM") "RTN","RMPRPI03",72,0) . S RMPRRX("RDT")=RMPRSDT "RTN","RMPRPI03",73,0) . S RMPROBAL=$$SQTY^RMPRPIXJ(.RMPRRX) "RTN","RMPRPI03",74,0) . Q "RTN","RMPRPI03",75,0) S RMPRERR=$$TFLOW^RMPRPIX6(.RMPRE) "RTN","RMPRPI03",76,0) I RMPRE("TRAN FLOW")="+" D "RTN","RMPRPI03",77,0) . S RMPRCBAL=RMPROBAL+RMPRE("QUANTITY") "RTN","RMPRPI03",78,0) . Q "RTN","RMPRPI03",79,0) I RMPRE("TRAN FLOW")="-" D "RTN","RMPRPI03",80,0) . S RMPRCBAL=RMPROBAL-RMPRE("QUANTITY") "RTN","RMPRPI03",81,0) . Q "RTN","RMPRPI03",82,0) I RMPRE("TRAN FLOW")="=" D "RTN","RMPRPI03",83,0) . K RMPR69 "RTN","RMPRPI03",84,0) . S RMPR69("TRANS IEN")=RMPRE("IEN") "RTN","RMPRPI03",85,0) . S RMPRERR=$$GET^RMPRPIXB(.RMPR69) "RTN","RMPRPI03",86,0) . I '$D(RMPR69("GAIN/LOSS")) S (RMPRE("QUANTITY"),RMPRE("VALUE"),RMPROBAL,RMPRCBAL)=0 Q "RTN","RMPRPI03",87,0) . S RMPRCBAL=RMPROBAL+RMPR69("GAIN/LOSS") "RTN","RMPRPI03",88,0) . S RMPRE("QUANTITY")=RMPR69("GAIN/LOSS") "RTN","RMPRPI03",89,0) . S RMPRE("VALUE")=RMPR69("GAIN/LOSS VALUE") "RTN","RMPRPI03",90,0) . Q "RTN","RMPRPI03",91,0) I RMPRE("TRAN FLOW")="" D "RTN","RMPRPI03",92,0) . S RMPRCBAL=RMPROBAL "RTN","RMPRPI03",93,0) . Q "RTN","RMPRPI03",94,0) S RMPRSTR="" "RTN","RMPRPI03",95,0) S $P(RMPRSTR,"^",1)=$E(RMPRFMDT,4,5)_"/"_$E(RMPRFMDT,6,7)_"/"_$E(RMPRFMDT,2,3) "RTN","RMPRPI03",96,0) S $P(RMPRSTR,"^",2)=RMPRE("TIME") "RTN","RMPRPI03",97,0) S $P(RMPRSTR,"^",3)=RMPROBAL "RTN","RMPRPI03",98,0) S $P(RMPRSTR,"^",4)=RMPRCBAL "RTN","RMPRPI03",99,0) S $P(RMPRSTR,"^",5)=RMPRE("QUANTITY") "RTN","RMPRPI03",100,0) S $P(RMPRSTR,"^",6)=RMPRE("VALUE") "RTN","RMPRPI03",101,0) S $P(RMPRSTR,"^",7)=RMPRE("TRAN TYPE") "RTN","RMPRPI03",102,0) S $P(RMPRSTR,"^",10)=RMPRE("USER") "RTN","RMPRPI03",103,0) K RMPR60 "RTN","RMPRPI03",104,0) S RMPRERR=$$IEN60^RMPRPIX6(.RMPRE,.RMPR60) "RTN","RMPRPI03",105,0) I 'RMPRERR,$G(RMPR60("IEN"))'="" D "RTN","RMPRPI03",106,0) . S DFN=$P($G(^RMPR(660,RMPR60("IEN"),0)),"^",2) "RTN","RMPRPI03",107,0) . D DEM^VADPT "RTN","RMPRPI03",108,0) . S $P(RMPRSTR,"^",8)=$G(VADM(1)) "RTN","RMPRPI03",109,0) . S $P(RMPRSTR,"^",9)=$P($G(VADM(2)),"^",2) "RTN","RMPRPI03",110,0) . Q "RTN","RMPRPI03",111,0) S ^TMP($J,RMPRNM,RMPR("HCPCS"),RMPR11("DESCRIPTION"),RMPRE("ITEM"),RMPRSEQ+1)=RMPRSTR "RTN","RMPRPI03",112,0) G THIS2 "RTN","RMPRPI03",113,0) THIS3 S RMPRERR=$$NEXT^RMPRPIXA(.RMPR,"XHDS","HCPCS",1,.RMPROLD,.RMPREOF) "RTN","RMPRPI03",114,0) I RMPREOF G THISX "RTN","RMPRPI03",115,0) G THIS1A "RTN","RMPRPI03",116,0) THISX Q RMPRERR "RTN","RMPRPI04") 0^9^B27130602 "RTN","RMPRPI04",1,0) RMPRPI04 ;HIN/RVD-PROS STOCK ITEM RECORDS ;3/8/05 11:24 "RTN","RMPRPI04",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI04",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI04",4,0) ; "RTN","RMPRPI04",5,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI04",6,0) S RS=RMPR("STA") "RTN","RMPRPI04",7,0) ; "RTN","RMPRPI04",8,0) EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI04",9,0) S DIC="^RMPR(661.1,",DIC(0)="AEQM" "RTN","RMPRPI04",10,0) F HCPCS=1:1 S DIC("A")="Select HCPCS "_HCPCS_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(HCPCS=1)) EXIT1 Q:X="" D "RTN","RMPRPI04",11,0) .Q:'$D(^RMPR(661.1,+Y,0)) S RMHCPC=$P(^RMPR(661.1,+Y,0),U,1) "RTN","RMPRPI04",12,0) .I $D(RMPRI(RMHCPC)) W $C(7)," ??",?40,"..Duplicate HCPCS" S HCPCS=HCPCS-1 Q "RTN","RMPRPI04",13,0) .S:RMHCPC'="" RMPRI(RMHCPC)=+Y "RTN","RMPRPI04",14,0) S RMPRCOUN=0 W !! S %DT("A")="Beginning Date: ",%DT="AEPX" "RTN","RMPRPI04",15,0) S %DT("B")="T-30" D ^%DT S RMPRBDT=Y G:Y<0 EXIT1 "RTN","RMPRPI04",16,0) ; "RTN","RMPRPI04",17,0) ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT "RTN","RMPRPI04",18,0) G:Y<0 EXIT1 "RTN","RMPRPI04",19,0) I RMPRBDT>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE "RTN","RMPRPI04",20,0) G:Y<0 EXIT S RMPREDT=Y,Y=RMPRBDT D DD^%DT S RMPRX=Y,Y=RMPREDT "RTN","RMPRPI04",21,0) D DD^%DT S RMPRY=Y "RTN","RMPRPI04",22,0) S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT "RTN","RMPRPI04",23,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI04",24,0) K IO("Q") S ZTDESC="STOCK ITEM REPORT",ZTRTN="PRINT^RMPRPI04",ZTIO=ION "RTN","RMPRPI04",25,0) S ZTSAVE("RMPRBDT")="",ZTSAVE("RMPREDT")="",ZTSAVE("RMPRI(")="" "RTN","RMPRPI04",26,0) S ZTSAVE("RMPRX")="",ZTSAVE("RMPRY")="",ZTSAVE("RMPR(""STA"")")="" "RTN","RMPRPI04",27,0) S ZTSAVE("RMPR(")="" "RTN","RMPRPI04",28,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI04",29,0) ; "RTN","RMPRPI04",30,0) ;Entry point for printing report. "RTN","RMPRPI04",31,0) PRINT I $E(IOST)["C" W @IOF,!!,"Processing report......" "RTN","RMPRPI04",32,0) I '$D(RMPRI) D NONEALL G EXIT "RTN","RMPRPI04",33,0) ;call API "RTN","RMPRPI04",34,0) ;input variables: "RTN","RMPRPI04",35,0) ; RM = 'RM' subscript "RTN","RMPRPI04",36,0) ; RS = station "RTN","RMPRPI04",37,0) ; RMPRI = array of HCPCS "RTN","RMPRPI04",38,0) ; RMPRBDT = beginning date "RTN","RMPRPI04",39,0) ; RMPREDT = ending date "RTN","RMPRPI04",40,0) ; "RTN","RMPRPI04",41,0) S RS=RMPR("STA"),RM="RM" "RTN","RMPRPI04",42,0) S RMCHK=$$THIS^RMPRPI03(RM,RS,RMPRBDT,RMPREDT,.RMPRI) "RTN","RMPRPI04",43,0) I RMCHK W !!,"ERROR NUMBER = ",RMCHK,!,"*** Error in API RMPRPI03 !!!" G EXIT "RTN","RMPRPI04",44,0) ; "RTN","RMPRPI04",45,0) S RMBDATE=$E(RMPRBDT,4,5)_"/"_$E(RMPRBDT,6,7)_"/"_$E(RMPRBDT,2,3) "RTN","RMPRPI04",46,0) S RMPAGE=1 "RTN","RMPRPI04",47,0) S (RMPREND,RP,QTYT,RMIFL,RMCO,RMTOCO,RMTOCOH,RMSTAFL,RMSUF,RMQTYT)=0 "RTN","RMPRPI04",48,0) D HEAD "RTN","RMPRPI04",49,0) S RQ="" F S RQ=$O(RMPRI(RQ)) Q:RQ="" I '$D(^TMP($J,"RM",RQ)) D NONE "RTN","RMPRPI04",50,0) D WRI "RTN","RMPRPI04",51,0) W !,"" "RTN","RMPRPI04",52,0) ; "RTN","RMPRPI04",53,0) EXIT ;exit here if report prints in home device. "RTN","RMPRPI04",54,0) I $E(IOST)["C",'$D(DUOUT),'$G(RMPREND) K DIR S DIR(0)="E" D ^DIR "RTN","RMPRPI04",55,0) ; "RTN","RMPRPI04",56,0) EXIT1 ;close device and clean-up variables. "RTN","RMPRPI04",57,0) D ^%ZISC "RTN","RMPRPI04",58,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI04",59,0) K ^TMP($J) "RTN","RMPRPI04",60,0) Q "RTN","RMPRPI04",61,0) ;end of processing (exit program) "RTN","RMPRPI04",62,0) ; "RTN","RMPRPI04",63,0) ; RH = HCPCS "RTN","RMPRPI04",64,0) ; RI = HCPCS ITEM NAME "RTN","RMPRPI04",65,0) ; R2 = ITEM NUMBER "RTN","RMPRPI04",66,0) ; R3 =SEQUENCE "RTN","RMPRPI04",67,0) ; "RTN","RMPRPI04",68,0) WRI S (RMFH,RMFI,RMPRFLG,RMTOCO,RMTOCOH,RMTOCOI)=0 "RTN","RMPRPI04",69,0) S (RMITEM,RH)="" "RTN","RMPRPI04",70,0) F S RH=$O(^TMP($J,"RM",RH)) D:RMFH HTOTAL D:RH'="" HEAD1 Q:RH="" S (RIT2,RI)="" F S RI=$O(^TMP($J,"RM",RH,RI)) Q:RI="" D "RTN","RMPRPI04",71,0) .F R2=0:0 S R2=$O(^TMP($J,"RM",RH,RI,R2)) D:RMFI ITOTAL Q:(R2'>0)!(RMPREND) D:RIT2'=R2 IHEAD F R3=0:0 S R3=$O(^TMP($J,"RM",RH,RI,R2,R3)) Q:(R3'>0)!(RMPREND) D "RTN","RMPRPI04",72,0) ..S RDATA=^TMP($J,"RM",RH,RI,R2,R3) "RTN","RMPRPI04",73,0) ..S RMDAT=$P(RDATA,U,1),RMTIM=$P(RDATA,U,2),RMOPE=$P(RDATA,U,3) "RTN","RMPRPI04",74,0) ..S RMCLO=$P(RDATA,U,4),RMQTY=$P(RDATA,U,5) "RTN","RMPRPI04",75,0) ..S RMVAL=$P(RDATA,U,6),RMTRA=$P(RDATA,U,7),RMPAT=$P(RDATA,U,8) "RTN","RMPRPI04",76,0) ..S RMSSN=$P(RDATA,U,9),RMUSE=$E($P(RDATA,U,10),1,10) "RTN","RMPRPI04",77,0) ..S RMITE=$P(RDATA,U,11) "RTN","RMPRPI04",78,0) ..S RMAVCO=$P(RDATA,U,11) S:RMAVCO'="" RMCO=RMAVCO*RMQTY "RTN","RMPRPI04",79,0) ..S RIT2=R2 "RTN","RMPRPI04",80,0) ..I 'RMPRFLG D HEAD1 "RTN","RMPRPI04",81,0) ..S (RMFH,RMFI)=1 "RTN","RMPRPI04",82,0) ..W !,RMDAT "RTN","RMPRPI04",83,0) ..I RMPAT'="" D "RTN","RMPRPI04",84,0) ...W ?9,$E(RMPAT,1,14),?26,$P(RMSSN,"-",3),?31,RMUSE,?45,$J(RMQTY,4) "RTN","RMPRPI04",85,0) ...W ?69,$J(RMVAL,9,2) "RTN","RMPRPI04",86,0) ..I RMTRA="PATIENT ISSUE" S RMTOCO=RMTOCO+RMVAL "RTN","RMPRPI04",87,0) ..I RMTRA="RETURN IN" S RMTOCO=RMTOCO-RMVAL "RTN","RMPRPI04",88,0) ..I RMPAT="" D "RTN","RMPRPI04",89,0) ...W:RMTRA="RECEIPT" ?9,"**Note: ",RMTRA,?31,RMUSE,?60,$J(RMQTY,4),?69,$J(RMVAL,9,2) "RTN","RMPRPI04",90,0) ...W:RMTRA="ORDER" ?9,"**Note: ",RMTRA,?31,RMUSE,?54,$J(RMQTY,4),?69,$J(RMVAL,9,2) "RTN","RMPRPI04",91,0) ...I (RMTRA'="RECEIPT"),(RMTRA'="ORDER") W ?9,"**Note: ",RMTRA,?31,RMUSE,?45,$J(RMQTY,4),?69,$J(RMVAL,9,2) "RTN","RMPRPI04",92,0) ..S RMPRFLG=1 "RTN","RMPRPI04",93,0) ..I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI04",94,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 S RMPRFLG=1 "RTN","RMPRPI04",95,0) Q "RTN","RMPRPI04",96,0) ; "RTN","RMPRPI04",97,0) HEAD ;print headers "RTN","RMPRPI04",98,0) W !,"*** ISSUE and STOCK CONTROL RECORD - PROSTHETICS STOCK ITEMS ***" "RTN","RMPRPI04",99,0) W ?65,"Page: ",RMPAGE,!,?30,"station: " "RTN","RMPRPI04",100,0) W $E($P($G(^DIC(4,RMPR("STA"),0)),U,1),1,20) "RTN","RMPRPI04",101,0) N X,% S Y=RMPRBDT D DD^%DT W !,Y," to " S Y=RMPREDT D DD^%DT W Y "RTN","RMPRPI04",102,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI04",103,0) Q "RTN","RMPRPI04",104,0) ; "RTN","RMPRPI04",105,0) IHEAD S RMDAHC=$O(^RMPR(661.1,"B",RH,0)) "RTN","RMPRPI04",106,0) S RMITEM=$E(RMITEM,1,26) "RTN","RMPRPI04",107,0) W !,"HCPCS: ",RH,"-",R2,?16,"Item: ",RI "RTN","RMPRPI04",108,0) S RMI=1 "RTN","RMPRPI04",109,0) Q "RTN","RMPRPI04",110,0) ; "RTN","RMPRPI04",111,0) HEAD1 ;write column headers "RTN","RMPRPI04",112,0) I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI04",113,0) W !,RMPR("L") "RTN","RMPRPI04",114,0) W !,?45,"QTY",?54,"QTY",?61,"QTY",?72,"DOLLAR" "RTN","RMPRPI04",115,0) W !," DATE",?9,"PATIENT",?26,"SSN",?31,"USER",?44,"ISSUE" "RTN","RMPRPI04",116,0) W ?53,"ORDER",?61,"REC",?72,"VALUE" "RTN","RMPRPI04",117,0) W !," ----",?9,"-------",?26,"---",?31,"----",?44,"-----" "RTN","RMPRPI04",118,0) W ?53,"-----",?61,"---",?72,"------" "RTN","RMPRPI04",119,0) S RMPRFLG=1 "RTN","RMPRPI04",120,0) Q "RTN","RMPRPI04",121,0) ; "RTN","RMPRPI04",122,0) HTOTAL ; "RTN","RMPRPI04",123,0) I RMFH,'RMPREND D "RTN","RMPRPI04",124,0) .W !!,?23,"*** Dollar Value of HCPCS Issued",?60,"=" "RTN","RMPRPI04",125,0) .W ?60,$J(RMTOCOH,10,2) "RTN","RMPRPI04",126,0) S (RMTOCOH,RMFH)=0 "RTN","RMPRPI04",127,0) Q "RTN","RMPRPI04",128,0) ; "RTN","RMPRPI04",129,0) ITOTAL ;prints totals. "RTN","RMPRPI04",130,0) I RMFI,'RMPREND D "RTN","RMPRPI04",131,0) .W !,?42,"--------------------------------------",! "RTN","RMPRPI04",132,0) .W ?23,"*** Dollar Value of Item Issued",?60,"=",?60,$J(RMTOCO,10,2) "RTN","RMPRPI04",133,0) S RMTOCOH=RMTOCOH+RMTOCO,(RMTOCO,RMCO,RMFI)=0 "RTN","RMPRPI04",134,0) Q "RTN","RMPRPI04",135,0) ; "RTN","RMPRPI04",136,0) NONE ;nothing to report. "RTN","RMPRPI04",137,0) W !,RMPR("L"),!,"No Item Statistics for HCPCS: " "RTN","RMPRPI04",138,0) W RQ,"...for this date range !!!" "RTN","RMPRPI04",139,0) Q "RTN","RMPRPI04",140,0) ; "RTN","RMPRPI04",141,0) NONEALL W !!,"NO DATA AT THIS DATE RANGE!!!!" "RTN","RMPRPI04",142,0) Q "RTN","RMPRPI05") 0^10^B16212132 "RTN","RMPRPI05",1,0) RMPRPI05 ;HIN/RVD-PRINT INVENTORY BALANCE BY LOCATION ;3/8/05 11:26 "RTN","RMPRPI05",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI05",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI05",4,0) ; DBIA #10096 - Access to all %ZOSF nodes. "RTN","RMPRPI05",5,0) ; "RTN","RMPRPI05",6,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI05",7,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI05",8,0) ; "RTN","RMPRPI05",9,0) EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI05",10,0) S DIC="^RMPR(661.5,",DIC(0)="AEQ" "RTN","RMPRPI05",11,0) S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")" "RTN","RMPRPI05",12,0) ; "RTN","RMPRPI05",13,0) EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1 "RTN","RMPRPI05",14,0) G:RMENTER["?" EN1 "RTN","RMPRPI05",15,0) S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y "RTN","RMPRPI05",16,0) I RMENTER="ALL" S RMPRI="*" G CONT "RTN","RMPRPI05",17,0) W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D "RTN","RMPRPI05",18,0) .S RMLOCI=+Y "RTN","RMPRPI05",19,0) .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q "RTN","RMPRPI05",20,0) .S RMPRI(RMLOCI)="" "RTN","RMPRPI05",21,0) ; "RTN","RMPRPI05",22,0) CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI05",23,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI05",24,0) K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY" "RTN","RMPRPI05",25,0) S ZTRTN="PRINT^RMPRPI05",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPRI")="" "RTN","RMPRPI05",26,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")="" "RTN","RMPRPI05",27,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI05",28,0) ; "RTN","RMPRPI05",29,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI05",30,0) ; "RTN","RMPRPI05",31,0) ;call API "RTN","RMPRPI05",32,0) ;input variables: "RTN","RMPRPI05",33,0) ; RM = any subscript to be used "RTN","RMPRPI05",34,0) ; RS = rmpr("sta") "RTN","RMPRPI05",35,0) ; RMPRI = rmpri(location array) "RTN","RMPRPI05",36,0) ; "RTN","RMPRPI05",37,0) S RS=RMPR("STA"),RM="RM" "RTN","RMPRPI05",38,0) ;S RMCHK=$$LBAL^RMPRPI02(RM,RS,.RMPRI) "RTN","RMPRPI05",39,0) ;I RMCHK W !!,"***Error in API RMPRPI02 !!!!",!! G EXIT "RTN","RMPRPI05",40,0) D PROC^RMPRPI02(RM,RS,.RMPRI) "RTN","RMPRPI05",41,0) ; "RTN","RMPRPI05",42,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI05",43,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI05",44,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI05",45,0) D HEAD,WRI "RTN","RMPRPI05",46,0) G EXIT "RTN","RMPRPI05",47,0) ; "RTN","RMPRPI05",48,0) ;write/print report "RTN","RMPRPI05",49,0) ;rl = Location "RTN","RMPRPI05",50,0) ;rh = HCPCS "RTN","RMPRPI05",51,0) ;j = Item "RTN","RMPRPI05",52,0) ;k = Date "RTN","RMPRPI05",53,0) ; "RTN","RMPRPI05",54,0) WRI S RL="" "RTN","RMPRPI05",55,0) F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="",RLF=RL F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J=0 D "RTN","RMPRPI05",56,0) .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J'>0)!(RMPREND) S K=0 F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K'>0)!(RMPREND) D "RTN","RMPRPI05",57,0) ..S RM3=^TMP($J,"RM",RL,RH,J,K) "RTN","RMPRPI05",58,0) ..S RMIT=J "RTN","RMPRPI05",59,0) ..S RMDTE=" " "RTN","RMPRPI05",60,0) ..S:K'=1 RMDTE=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) "RTN","RMPRPI05",61,0) ..S (RMAST,RMUNI)="" "RTN","RMPRPI05",62,0) ..S RMROR=$P(RM3,U,7) "RTN","RMPRPI05",63,0) ..S RMQTY=$P(RM3,U,1) "RTN","RMPRPI05",64,0) ..S RMCOS=$P(RM3,U,3) "RTN","RMPRPI05",65,0) ..S RMVAL=$P(RM3,U,2) "RTN","RMPRPI05",66,0) ..S RMVEN=$P(RM3,U,4) "RTN","RMPRPI05",67,0) ..S RMIDE=$P(RM3,U,5) "RTN","RMPRPI05",68,0) ..S RMUNI=$P(RM3,U,8) "RTN","RMPRPI05",69,0) ..S RMSOR=$P(RM3,U,9) "RTN","RMPRPI05",70,0) ..S:RMROR>RMQTY RMAST="*" "RTN","RMPRPI05",71,0) ..S:RMQTY="" RMQTY=0 "RTN","RMPRPI05",72,0) ..S RLO=RL "RTN","RMPRPI05",73,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI05",74,0) ..S RMIDE=$E(RMIDE,1,24) "RTN","RMPRPI05",75,0) ..W !,RH_"-"_RMIT,?10,RMIDE,?35,RMSOR,?37,$E(RMVEN,1,6),?44,RMDTE,?54,RMUNI,?56,$J(RMQTY,4) "RTN","RMPRPI05",76,0) ..W ?61,$J(RMCOS,8,2),?69,$J($FN(RMVAL,",",2),10) "RTN","RMPRPI05",77,0) ..S RMPRFLG=1 "RTN","RMPRPI05",78,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI05",79,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI05",80,0) W !,RMPR("L"),!,"" "RTN","RMPRPI05",81,0) Q "RTN","RMPRPI05",82,0) ; "RTN","RMPRPI05",83,0) HEAD W !,"*** PROSTHETICS INVENTORY BALANCE BY LOCATION ***" "RTN","RMPRPI05",84,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI05",85,0) W !,"Run Date: ",RMDAT,?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20) "RTN","RMPRPI05",86,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI05",87,0) Q "RTN","RMPRPI05",88,0) ; "RTN","RMPRPI05",89,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI05",90,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI05",91,0) W !,RMPR("L") "RTN","RMPRPI05",92,0) W !,"Location: ",RLO "RTN","RMPRPI05",93,0) W !,?52,"UNIT" "RTN","RMPRPI05",94,0) W !,?45,"DATE",?53,"OF",?65,"UNIT",?74,"TOTAL" "RTN","RMPRPI05",95,0) W !,"HCPCS",?10,"ITEM",?33,"SRC",?37,"VENDOR" "RTN","RMPRPI05",96,0) W ?45,"RECVD",?52,"ISSUE",?58,"QTY",?65,"COST",?74,"VALUE" "RTN","RMPRPI05",97,0) W !,"-----",?10,"----",?33,"---",?37,"------" "RTN","RMPRPI05",98,0) W ?45,"-----",?52,"-----",?58,"---",?65,"----",?73,"------" "RTN","RMPRPI05",99,0) S RMPRFLG=1 "RTN","RMPRPI05",100,0) Q "RTN","RMPRPI05",101,0) ; "RTN","RMPRPI05",102,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI05",103,0) ; "RTN","RMPRPI05",104,0) EXIT1 D ^%ZISC "RTN","RMPRPI05",105,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI05",106,0) K ^TMP($J) "RTN","RMPRPI05",107,0) Q "RTN","RMPRPI05",108,0) ; "RTN","RMPRPI05",109,0) NONE ; "RTN","RMPRPI05",110,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI05",111,0) D HEAD "RTN","RMPRPI05",112,0) W !!,"NO DATA !!!!" "RTN","RMPRPI05",113,0) Q "RTN","RMPRPI06") 0^11^B18539063 "RTN","RMPRPI06",1,0) RMPRPI06 ;HIN/RVD-PRINT INVENTORY BALANCE BY HCPCS ;3/8/05 11:36 "RTN","RMPRPI06",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI06",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI06",4,0) ; DBIA #10096 - Access to all %ZOSF nodes. "RTN","RMPRPI06",5,0) ; "RTN","RMPRPI06",6,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI06",7,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI06",8,0) ; "RTN","RMPRPI06",9,0) EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI06",10,0) S DIC="^RMPR(661.1,",DIC(0)="AEQM" "RTN","RMPRPI06",11,0) S DIC("S")="I $D(^RMPR(661.1,+Y,0))" "RTN","RMPRPI06",12,0) ; "RTN","RMPRPI06",13,0) EN1 ; "RTN","RMPRPI06",14,0) S RAS1="Enter 'ALL' for all HCPCS or 'RETURN' " "RTN","RMPRPI06",15,0) S RAS2="to select individual HCPCS: " "RTN","RMPRPI06",16,0) W !!,RAS1,RAS2 "RTN","RMPRPI06",17,0) R RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1 "RTN","RMPRPI06",18,0) G:RMENTER["?" EN1 "RTN","RMPRPI06",19,0) S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y "RTN","RMPRPI06",20,0) I RMENTER="ALL" S RMPRI="*" G CONT "RTN","RMPRPI06",21,0) ; "RTN","RMPRPI06",22,0) SEL W ! F RML=1:1 S DIC("A")="Select HCPCS "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D "RTN","RMPRPI06",23,0) .S RMI=$P(^RMPR(661.1,+Y,0),U,1) "RTN","RMPRPI06",24,0) .I $D(RMPRI(RMI)) W $C(7)," ??",?40,"..Duplicate HCPCS" S RML=RML-1 Q "RTN","RMPRPI06",25,0) .S RMPRI(RMI)=+Y "RTN","RMPRPI06",26,0) ; "RTN","RMPRPI06",27,0) CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI06",28,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI06",29,0) K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY" "RTN","RMPRPI06",30,0) S ZTRTN="PRINT^RMPRPI06",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPRI")="" "RTN","RMPRPI06",31,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")="" "RTN","RMPRPI06",32,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT "RTN","RMPRPI06",33,0) ; "RTN","RMPRPI06",34,0) PRINT I $E(IOST)["C" W !!,"Processing report......." "RTN","RMPRPI06",35,0) S RMSUB="RM",RS=RMPR("STA") "RTN","RMPRPI06",36,0) ;call API "RTN","RMPRPI06",37,0) ;input variables: "RTN","RMPRPI06",38,0) ; RMSUB = 'RM' subscript "RTN","RMPRPI06",39,0) ; RS = rmpr("sta") "RTN","RMPRPI06",40,0) ; rmpri = an array of Location "RTN","RMPRPI06",41,0) ;S RMCHK=$$HBAL^RMPRPI01(RMSUB,RS,.RMPRI) "RTN","RMPRPI06",42,0) ;I RMCHK W !!,"*** Error in API RMPRPI01 !!!" G EXIT "RTN","RMPRPI06",43,0) D PROC^RMPRPI01(RMSUB,RS,.RMPRI) "RTN","RMPRPI06",44,0) ; "RTN","RMPRPI06",45,0) S RMPAGE=1,(RMTOBAL,RMPREND)=0 "RTN","RMPRPI06",46,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI06",47,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI06",48,0) D HEAD,WRI "RTN","RMPRPI06",49,0) I RMSUF D TOTAL W !,"" G EXIT "RTN","RMPRPI06",50,0) ; "RTN","RMPRPI06",51,0) ;write/print report "RTN","RMPRPI06",52,0) ;rh = HCPCS "RTN","RMPRPI06",53,0) ;rl = Location "RTN","RMPRPI06",54,0) ;j = Item "RTN","RMPRPI06",55,0) ;k = Date "RTN","RMPRPI06",56,0) ; "RTN","RMPRPI06",57,0) WRI S RH="",(RMPREND,RMSUF)=0 D HEAD1 "RTN","RMPRPI06",58,0) F S RH=$O(^TMP($J,"RM",RH)) Q:(RH="")!(RMPREND) D:RMSUF TOTAL S (RVA,RTO)=0,RHO=RH K RMPRFLG S RI=0 F S RI=$O(^TMP($J,"RM",RH,RI)) Q:(RI'>0)!(RMPREND) S J=0 D "RTN","RMPRPI06",59,0) .F S J=$O(^TMP($J,"RM",RH,RI,J)) Q:(J'>0)!(RMPREND) S RMPRLOCN="" F S RMPRLOCN=$O(^TMP($J,"RM",RH,RI,J,RMPRLOCN)) Q:(RMPRLOCN="")!(RMPREND) D "RTN","RMPRPI06",60,0) ..S RMAST="",RMTMP=^TMP($J,"RM",RH,RI,J,RMPRLOCN),RMQTY=$P(RMTMP,U,1) "RTN","RMPRPI06",61,0) ..S RMVAL=$P(RMTMP,U,2),RMCOS=$P(RMTMP,U,3),RMVEN=$P(RMTMP,U,4)_" " "RTN","RMPRPI06",62,0) ..S RMIDE=$P(RMTMP,U,5),RMLOC=$P(RMTMP,U,6),RMUNI=$P(RMTMP,U,8) "RTN","RMPRPI06",63,0) ..;S RMDAT=$E(J,4,5)_"/"_$E(J,6,7)_"/"_$E(J,2,3) "RTN","RMPRPI06",64,0) ..S RMROR=$P(RMTMP,U,7) "RTN","RMPRPI06",65,0) ..S RMSOR=$P(RMTMP,U,9) "RTN","RMPRPI06",66,0) ..S:RMROR>RMQTY RMAST="*" "RTN","RMPRPI06",67,0) ..S:RMQTY="" RMQTY=0 "RTN","RMPRPI06",68,0) ..S RTO=RTO+RMQTY,RVA=RVA+RMVAL "RTN","RMPRPI06",69,0) ..S RMITEM=RI,RMHCPC=RH,RMSUF=1 "RTN","RMPRPI06",70,0) ..S RMIDE=$E(RMIDE,1,17) "RTN","RMPRPI06",71,0) ..W !,RH_"-"_RI,?10,RMIDE,?28,RMSOR,?31,$E(RMLOC,1,8),?40,$E(RMVEN,1,7) "RTN","RMPRPI06",72,0) ..W ?46,$J(RMROR,4),?52,RMUNI,?57,$J(RMQTY,4),?61,$J(RMCOS,8,2),?69,$J($FN(RMVAL,",",2),10) "RTN","RMPRPI06",73,0) ..S RMPRFLG=1 "RTN","RMPRPI06",74,0) ..I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI06",75,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 K RMPRFLG Q "RTN","RMPRPI06",76,0) Q "RTN","RMPRPI06",77,0) ; "RTN","RMPRPI06",78,0) TOTAL W !,?56,"=======================",!,?31,"Totals for ",RHO," = " "RTN","RMPRPI06",79,0) W ?54,$J(RTO,7),?69,$J($FN(RVA,",",2),10),!,RMPR("L") "RTN","RMPRPI06",80,0) S RMSUF=0,RTO=0 "RTN","RMPRPI06",81,0) Q "RTN","RMPRPI06",82,0) ; "RTN","RMPRPI06",83,0) HEAD W !,"*** PROSTHETICS INVENTORY BALANCE BY HCPCS ***" "RTN","RMPRPI06",84,0) W ?68,"PAGE: ",RMPAGE,!,"Run Date: ",RMDAT "RTN","RMPRPI06",85,0) W ?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20) "RTN","RMPRPI06",86,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI06",87,0) Q "RTN","RMPRPI06",88,0) ; "RTN","RMPRPI06",89,0) HEAD1 I $E(IOST)["C"&($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI06",90,0) I $E(IOST)'["C"&($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI06",91,0) W !,RMPR("L") "RTN","RMPRPI06",92,0) W !,?47,"RE-",?52,"UNIT" "RTN","RMPRPI06",93,0) W !,?46,"ORDER",?53,"OF",?65,"UNIT",?74,"TOTAL" "RTN","RMPRPI06",94,0) W !,"HCPCS",?10,"ITEM",?26,"SRC",?30,"LOCATION",?39,"VENDOR" "RTN","RMPRPI06",95,0) W ?46,"LEVEL",?52,"ISSUE",?59,"QTY",?65,"COST",?74,"VALUE" "RTN","RMPRPI06",96,0) W !,"-----",?10,"----",?26,"---",?30,"--------",?39,"------" "RTN","RMPRPI06",97,0) W ?46,"-----",?52,"-----",?59,"---",?65,"----",?73,"------" "RTN","RMPRPI06",98,0) S RMPRFLG=1 "RTN","RMPRPI06",99,0) Q "RTN","RMPRPI06",100,0) ; "RTN","RMPRPI06",101,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI06",102,0) ; "RTN","RMPRPI06",103,0) EXIT1 D ^%ZISC "RTN","RMPRPI06",104,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI06",105,0) K ^TMP($J) "RTN","RMPRPI06",106,0) Q "RTN","RMPRPI06",107,0) ; "RTN","RMPRPI06",108,0) NONE ; "RTN","RMPRPI06",109,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI06",110,0) D HEAD W !!,"NO DATA !!!!!" "RTN","RMPRPI06",111,0) Q "RTN","RMPRPI07") 0^12^B16064991 "RTN","RMPRPI07",1,0) RMPRPI07 ;HINCIO/ODJ - PIP APIs ;3/8/01 "RTN","RMPRPI07",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI07",3,0) Q "RTN","RMPRPI07",4,0) ; "RTN","RMPRPI07",5,0) ; LOC - Build workfile for Quantity on hand by location "RTN","RMPRPI07",6,0) LOC(RMPRNM,RMPRSTN,RMPRLOCA,RMPRSRC,RMPRSDT,RMPREDT) ; "RTN","RMPRPI07",7,0) N RMPRERR,RMPRL,RMPRALL,RMPRDT,RMPRI,RMPR6,RMPR6I,RMPRSTR,RMPR11 "RTN","RMPRPI07",8,0) N RMPR11I,RMPR7,RMPREOF,RMPRDAYS,RMPR7I "RTN","RMPRPI07",9,0) N X1,X2,X "RTN","RMPRPI07",10,0) S RMPRERR=0 "RTN","RMPRPI07",11,0) I $G(RMPRSTN)="" S RMPRERR=1 G LOCX "RTN","RMPRPI07",12,0) I $G(RMPRNM)="" S RMPRNM="RMPRPI07" "RTN","RMPRPI07",13,0) K ^TMP($J,RMPRNM) "RTN","RMPRPI07",14,0) S RMPRALL=$S($G(RMPRLOCA)="*":1,1:0) "RTN","RMPRPI07",15,0) I $G(RMPRSRC)="" S RMPRSRC="C" "RTN","RMPRPI07",16,0) I $G(RMPREDT)="" D NOW^%DTC S RMPREDT=X "RTN","RMPRPI07",17,0) I $G(RMPRSDT)="" D "RTN","RMPRPI07",18,0) . S X1=RMPREDT,X2=-89 D C^%DTC S RMPRSDT=X "RTN","RMPRPI07",19,0) . Q "RTN","RMPRPI07",20,0) S X2=RMPRSDT,X1=RMPREDT D ^%DTC S RMPRDAYS=X+1 "RTN","RMPRPI07",21,0) ; "RTN","RMPRPI07",22,0) ; First loop on transaction file (661.6) for issues "RTN","RMPRPI07",23,0) S RMPRL="" "RTN","RMPRPI07",24,0) LOC1 I RMPRALL D "RTN","RMPRPI07",25,0) . S RMPRL=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL)) "RTN","RMPRPI07",26,0) . Q "RTN","RMPRPI07",27,0) E D "RTN","RMPRPI07",28,0) . S RMPRL=$O(RMPRLOCA(RMPRL)) "RTN","RMPRPI07",29,0) . Q "RTN","RMPRPI07",30,0) I RMPRL="" G LOC11 "RTN","RMPRPI07",31,0) I RMPRSDT="" D "RTN","RMPRPI07",32,0) . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,"")) "RTN","RMPRPI07",33,0) . Q "RTN","RMPRPI07",34,0) E D "RTN","RMPRPI07",35,0) . I $D(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT)) S RMPRDT=RMPRSDT Q "RTN","RMPRPI07",36,0) . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRSDT)) "RTN","RMPRPI07",37,0) . Q "RTN","RMPRPI07",38,0) LOC2 I RMPRDT="" G LOC1 "RTN","RMPRPI07",39,0) I $P(RMPRDT,".",1)>RMPREDT G LOC1 "RTN","RMPRPI07",40,0) S RMPRI="" "RTN","RMPRPI07",41,0) LOC3 S RMPRI=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT,RMPRI)) "RTN","RMPRPI07",42,0) I RMPRI="" D G LOC2 "RTN","RMPRPI07",43,0) . S RMPRDT=$O(^RMPR(661.6,"ASLD",RMPRSTN,RMPRL,RMPRDT)) "RTN","RMPRPI07",44,0) . Q "RTN","RMPRPI07",45,0) K RMPR6 "RTN","RMPRPI07",46,0) S RMPR6("IEN")=RMPRI "RTN","RMPRPI07",47,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPI07",48,0) I RMPRERR S RMPRERR=1 G LOCX "RTN","RMPRPI07",49,0) S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) ;read trans. rec. (661.6) "RTN","RMPRPI07",50,0) I RMPRERR S RMPRERR=2 G LOCX "RTN","RMPRPI07",51,0) I RMPR6I("TRAN TYPE")'=3 G LOC3 ;not patient issue "RTN","RMPRPI07",52,0) K RMPR11 "RTN","RMPRPI07",53,0) S RMPR11("STATION")=RMPRSTN "RTN","RMPRPI07",54,0) S RMPR11("HCPCS")=RMPR6("HCPCS") "RTN","RMPRPI07",55,0) S RMPR11("ITEM")=RMPR6("ITEM") "RTN","RMPRPI07",56,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11) "RTN","RMPRPI07",57,0) I RMPRERR S RMPRERR=3 G LOCX "RTN","RMPRPI07",58,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I) "RTN","RMPRPI07",59,0) I RMPRERR S RMPRERR=4 G LOCX "RTN","RMPRPI07",60,0) I RMPR11I("SOURCE")'=RMPRSRC G LOC3 ;not required source "RTN","RMPRPI07",61,0) S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM"))) "RTN","RMPRPI07",62,0) S $P(RMPRSTR,"^",1)=RMPR6("QUANTITY")+$P(RMPRSTR,"^",1) "RTN","RMPRPI07",63,0) S $P(RMPRSTR,"^",2)=RMPR6("VALUE")+$P(RMPRSTR,"^",2) "RTN","RMPRPI07",64,0) S ^TMP($J,RMPRNM,RMPRL,RMPR6("HCPCS"),RMPR11("DESCRIPTION"),RMPR6("ITEM"))=RMPRSTR "RTN","RMPRPI07",65,0) G LOC3 "RTN","RMPRPI07",66,0) ; "RTN","RMPRPI07",67,0) ; Second loop on Current Stock (661.7) for quantity on hand "RTN","RMPRPI07",68,0) S RMPRL="" "RTN","RMPRPI07",69,0) LOC11 I RMPRALL D "RTN","RMPRPI07",70,0) . S RMPRL=$O(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRL)) "RTN","RMPRPI07",71,0) . Q "RTN","RMPRPI07",72,0) E D "RTN","RMPRPI07",73,0) . S RMPRL=$O(RMPRLOCA(RMPRL)) "RTN","RMPRPI07",74,0) . Q "RTN","RMPRPI07",75,0) I RMPRL="" G LOCX "RTN","RMPRPI07",76,0) K RMPR7I "RTN","RMPRPI07",77,0) S RMPR7I("STATION")=RMPRSTN "RTN","RMPRPI07",78,0) S RMPR7I("LOCATION")=RMPRL "RTN","RMPRPI07",79,0) LOC12 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR7I,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPI07",80,0) I RMPREOF G LOC11 "RTN","RMPRPI07",81,0) I RMPR7I("STATION")'=RMPRSTN G LOC11 "RTN","RMPRPI07",82,0) I RMPR7I("LOCATION")'=RMPRL G LOC11 "RTN","RMPRPI07",83,0) K RMPR7 "RTN","RMPRPI07",84,0) S RMPR7("IEN")=RMPR7I("IEN") "RTN","RMPRPI07",85,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;read in cur. stock rec. "RTN","RMPRPI07",86,0) K RMPR11,RMPR11I "RTN","RMPRPI07",87,0) S RMPR11("STATION")=RMPRSTN "RTN","RMPRPI07",88,0) S RMPR11("HCPCS")=RMPR7("HCPCS") "RTN","RMPRPI07",89,0) S RMPR11("ITEM")=RMPR7("ITEM") "RTN","RMPRPI07",90,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) ;read in Item rec. (661.11) "RTN","RMPRPI07",91,0) I RMPRERR S RMPRERR=99 G LOCX "RTN","RMPRPI07",92,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I) "RTN","RMPRPI07",93,0) I RMPRERR S RMPRERR=99 G LOCX "RTN","RMPRPI07",94,0) I RMPR11I("SOURCE")'=RMPRSRC G LOC12 ;not required source "RTN","RMPRPI07",95,0) S RMPRSTR=$G(^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM"))) "RTN","RMPRPI07",96,0) S $P(RMPRSTR,"^",5)=RMPR7("QUANTITY")+$P(RMPRSTR,"^",5) "RTN","RMPRPI07",97,0) S $P(RMPRSTR,"^",6)=RMPR7("VALUE")+$P(RMPRSTR,"^",6) "RTN","RMPRPI07",98,0) S ^TMP($J,RMPRNM,RMPRL,RMPR7("HCPCS"),RMPR11("DESCRIPTION"),RMPR7("ITEM"))=RMPRSTR "RTN","RMPRPI07",99,0) G LOC12 "RTN","RMPRPI07",100,0) LOCX Q RMPRERR "RTN","RMPRPI08") 0^13^B23150298 "RTN","RMPRPI08",1,0) RMPRPI08 ;HIN/RVD-PRINT ITEM DETAIL BY LOCATION ;3/8/05 11:37 "RTN","RMPRPI08",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI08",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI08",4,0) ; DBIA #10096 - Access to all %ZOSF nodes. "RTN","RMPRPI08",5,0) ; "RTN","RMPRPI08",6,0) K DIC,DIR,%DT "RTN","RMPRPI08",7,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI08",8,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI08",9,0) ; "RTN","RMPRPI08",10,0) EN K RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI08",11,0) S DIC="^RMPR(661.5,",DIC(0)="AEQ" "RTN","RMPRPI08",12,0) S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")" "RTN","RMPRPI08",13,0) ; "RTN","RMPRPI08",14,0) EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1 "RTN","RMPRPI08",15,0) G:RMENTER["?" EN1 "RTN","RMPRPI08",16,0) S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y "RTN","RMPRPI08",17,0) I RMENTER="ALL" S RMPRI="*" G CONT "RTN","RMPRPI08",18,0) W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D "RTN","RMPRPI08",19,0) .S RMLOCI=+Y "RTN","RMPRPI08",20,0) .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q "RTN","RMPRPI08",21,0) .S RMPRI(RMLOCI)="" "RTN","RMPRPI08",22,0) ; "RTN","RMPRPI08",23,0) CONT ; "RTN","RMPRPI08",24,0) K DIR "RTN","RMPRPI08",25,0) S DIR("B")="NEW Items",DIR("A")="Enter a SOURCE Creteria" "RTN","RMPRPI08",26,0) S DIR(0)="S^V:OLD Items;C:NEW Items" "RTN","RMPRPI08",27,0) D ^DIR G:$D(DUOUT)!$D(DIRUT)!$D(DTOUT) EXIT1 "RTN","RMPRPI08",28,0) S RE=Y K DIR "RTN","RMPRPI08",29,0) ; "RTN","RMPRPI08",30,0) DT ; "RTN","RMPRPI08",31,0) W ! S %DT("A")="Beginning Date: ",%DT="AEPX",%DT("B")="T-30" D ^%DT S RMB=Y G:Y<0 EXIT1 "RTN","RMPRPI08",32,0) ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT G:Y<0 EXIT1 I RMB>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE "RTN","RMPRPI08",33,0) S RME=Y "RTN","RMPRPI08",34,0) ; "RTN","RMPRPI08",35,0) G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI08",36,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI08",37,0) K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY" "RTN","RMPRPI08",38,0) S ZTRTN="PRINT^RMPRPI08",ZTIO=ION,ZTSAVE("RMPRI(")="" "RTN","RMPRPI08",39,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")="" "RTN","RMPRPI08",40,0) S ZTSAVE("RE")="",ZTSAVE("RMPRI")="" "RTN","RMPRPI08",41,0) S ZTSAVE("RME")="",ZTSAVE("RMB")="" "RTN","RMPRPI08",42,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI08",43,0) ; "RTN","RMPRPI08",44,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI08",45,0) ; "RTN","RMPRPI08",46,0) ;call API "RTN","RMPRPI08",47,0) ;input variables: "RTN","RMPRPI08",48,0) ; RM = any subscript to be used "RTN","RMPRPI08",49,0) ; RS = rmpr("sta") "RTN","RMPRPI08",50,0) ; RE = source (V or C) "RTN","RMPRPI08",51,0) ; RMPRI = rmpri(location array; '*' for all location ) "RTN","RMPRPI08",52,0) ; RMB = beginning date "RTN","RMPRPI08",53,0) ; RME = ending date "RTN","RMPRPI08",54,0) ; "RTN","RMPRPI08",55,0) S X1=RME,X2=RMB "RTN","RMPRPI08",56,0) D ^%DTC S RMCALDAY=X+1 "RTN","RMPRPI08",57,0) S Y=RMB D DD^%DT S RMBDAT=Y S Y=RME D DD^%DT S RMEDAT=Y "RTN","RMPRPI08",58,0) D NOW^%DTC S Y=% X ^DD("DD") S RMDAT=Y "RTN","RMPRPI08",59,0) S RSOU=$S(RE="V":"USED",RE="C":"NEW",1:"") "RTN","RMPRPI08",60,0) S RS=RMPR("STA"),RM="RM" "RTN","RMPRPI08",61,0) ; "RTN","RMPRPI08",62,0) S RMCHK=$$LOC^RMPRPI07(RM,RS,.RMPRI,RE,RMB,RME) "RTN","RMPRPI08",63,0) I RMCHK W !!,"ERROR NUMBER = ",RMCHK,!,"***Error in API RMPRPI07 !!!!",!! G EXIT "RTN","RMPRPI08",64,0) ; "RTN","RMPRPI08",65,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI08",66,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI08",67,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI08",68,0) D HEAD,WRI "RTN","RMPRPI08",69,0) G EXIT "RTN","RMPRPI08",70,0) ; "RTN","RMPRPI08",71,0) ;write/print report "RTN","RMPRPI08",72,0) ;rl = Location "RTN","RMPRPI08",73,0) ;rh = HCPCS "RTN","RMPRPI08",74,0) ;j = Item "RTN","RMPRPI08",75,0) ;k = Item description "RTN","RMPRPI08",76,0) ; "RTN","RMPRPI08",77,0) ; "RTN","RMPRPI08",78,0) WRI S RL="" "RTN","RMPRPI08",79,0) F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="" F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J="" D "RTN","RMPRPI08",80,0) .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J="")!(RMPREND) S K="" F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K="")!(RMPREND) D "RTN","RMPRPI08",81,0) ..S RM3=^TMP($J,"RM",RL,RH,J,K) "RTN","RMPRPI08",82,0) ..S RMIT=K "RTN","RMPRPI08",83,0) ..S RMQTY=$P(RM3,U,1) "RTN","RMPRPI08",84,0) ..S RMCOS=$P(RM3,U,2) "RTN","RMPRPI08",85,0) ..S RMDAU=RMQTY/RMCALDAY "RTN","RMPRPI08",86,0) ..S RMDOH="" "RTN","RMPRPI08",87,0) ..S RMSOH=$P(RM3,U,5) "RTN","RMPRPI08",88,0) ..S:+RMDAU RMDOH=$J(RMSOH/RMDAU,0,1) S:RMDOH>999 RMDOH=">999" "RTN","RMPRPI08",89,0) ..S RMDAU=$J(RMDAU,0,3) "RTN","RMPRPI08",90,0) ..S RMTDV=$P(RM3,U,6) "RTN","RMPRPI08",91,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI08",92,0) ..S RMIDE=$E(J,1,13) "RTN","RMPRPI08",93,0) ..W !,RH_"-"_RMIT,?10,RMIDE,?24,$J(RMQTY,4),?29,$J($FN(RMCOS,",",2),9),?42,RMDAU,?54,$J(RMDOH,4) "RTN","RMPRPI08",94,0) ..W ?61,$J(RMSOH,5),?70,$J($FN(RMTDV,",",2),10) "RTN","RMPRPI08",95,0) ..S RMPRFLG=1 "RTN","RMPRPI08",96,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI08",97,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI08",98,0) W !,RMPR("L"),!,"" "RTN","RMPRPI08",99,0) Q "RTN","RMPRPI08",100,0) ; "RTN","RMPRPI08",101,0) HEAD W !,"*** DETAIL ITEM USAGE BY LOCATION ***"," for ",RSOU," Items" "RTN","RMPRPI08",102,0) W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT "RTN","RMPRPI08",103,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI08",104,0) W !,RMBDAT," to ",RMEDAT,?30,"[ ",RMCALDAY," calendar days ]" "RTN","RMPRPI08",105,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI08",106,0) Q "RTN","RMPRPI08",107,0) ; "RTN","RMPRPI08",108,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI08",109,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI08",110,0) W !,RMPR("L") "RTN","RMPRPI08",111,0) W !,"Location: ",$P($G(^RMPR(661.5,RL,0)),"^",1) "RTN","RMPRPI08",112,0) W !,?25,"QTY",?35,"$",?41,"DAYS AVE" "RTN","RMPRPI08",113,0) W ?54,"DAYS",?62,"STOCK",?72,"TOTAL $" "RTN","RMPRPI08",114,0) W !,"HCPCS",?10,"ITEM",?24,"ISSUE",?33,"VALUE" "RTN","RMPRPI08",115,0) W ?40,"USAGE RATE",?52,"ON-HAND",?61,"ON-HAND",?70,"VAL ON-HND" "RTN","RMPRPI08",116,0) W !,"-----",?10,"----",?24,"-----",?33,"-----" "RTN","RMPRPI08",117,0) W ?40,"----------",?52,"-------",?61,"-------",?70,"----------" "RTN","RMPRPI08",118,0) S RMPRFLG=1 "RTN","RMPRPI08",119,0) Q "RTN","RMPRPI08",120,0) ; "RTN","RMPRPI08",121,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI08",122,0) ; "RTN","RMPRPI08",123,0) EXIT1 D ^%ZISC "RTN","RMPRPI08",124,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI08",125,0) K ^TMP($J) "RTN","RMPRPI08",126,0) Q "RTN","RMPRPI08",127,0) ; "RTN","RMPRPI08",128,0) NONE ; "RTN","RMPRPI08",129,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI08",130,0) D HEAD "RTN","RMPRPI08",131,0) W !,RMPR("L") "RTN","RMPRPI08",132,0) W !!,"NO DATA to print !!!" "RTN","RMPRPI08",133,0) Q "RTN","RMPRPI09") 0^14^B30171234 "RTN","RMPRPI09",1,0) RMPRPI09 ;HIN/RVD-PRINT ORDER AND RECIEVE ITEM REPORT ;3/8/05 11:39 "RTN","RMPRPI09",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI09",3,0) ; "RTN","RMPRPI09",4,0) ; DBIA #800 - global read of file #440. "RTN","RMPRPI09",5,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI09",6,0) ; "RTN","RMPRPI09",7,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI09",8,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI09",9,0) ; "RTN","RMPRPI09",10,0) EN K RMPRI S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI09",11,0) ; "RTN","RMPRPI09",12,0) TYPE ;select type of report "RTN","RMPRPI09",13,0) K DIR "RTN","RMPRPI09",14,0) S DIR(0)="S^1:30 Days Old or Less;2:60 Days Old or Less;3:90 Days Old or Less;4:Over 90 Days Old or Less " "RTN","RMPRPI09",15,0) S DIR("A")="Select number of days old",DIR("B")="30 Days Old or Less" "RTN","RMPRPI09",16,0) D ^DIR "RTN","RMPRPI09",17,0) I Y="",$D(DTOUT) G EXIT1 "RTN","RMPRPI09",18,0) I Y="^"!(Y="^^") G EXIT1 "RTN","RMPRPI09",19,0) S RMTY=Y "RTN","RMPRPI09",20,0) ; "RTN","RMPRPI09",21,0) ; "RTN","RMPRPI09",22,0) CAT ;select STATUS of report "RTN","RMPRPI09",23,0) K DIR "RTN","RMPRPI09",24,0) S DIR(0)="S^O:OPEN;R:RECIEVED;C:CANCEL" "RTN","RMPRPI09",25,0) S DIR("A")="Select Category of report",DIR("B")="OPEN" "RTN","RMPRPI09",26,0) D ^DIR "RTN","RMPRPI09",27,0) I Y="",$D(DTOUT) G EXIT1 "RTN","RMPRPI09",28,0) I Y="^"!(Y="^^") G EXIT1 "RTN","RMPRPI09",29,0) S RMCAT=Y "RTN","RMPRPI09",30,0) K DIR "RTN","RMPRPI09",31,0) ; "RTN","RMPRPI09",32,0) DT ; "RTN","RMPRPI09",33,0) S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI09",34,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI09",35,0) K IO("Q") S ZTDESC="PIP ORDER AND RECEIVE ITEM REPORT" "RTN","RMPRPI09",36,0) S ZTRTN="PRINT^RMPRPI09",ZTIO=ION,ZTSAVE("RMPR(")="" "RTN","RMPRPI09",37,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="" "RTN","RMPRPI09",38,0) S ZTSAVE("RMTY")="",ZTSAVE("RMDRA")="",ZTSAVE("RMCAT")="" "RTN","RMPRPI09",39,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI09",40,0) ; "RTN","RMPRPI09",41,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI09",42,0) K RMPRT,RMPRFLG "RTN","RMPRPI09",43,0) S RMCAL=$S(RMTY=1:30,RMTY=2:60,RMTY=3:90,RMTY=4:"OVER 90") "RTN","RMPRPI09",44,0) S X="T-"_RMCAL D ^%DT S RDT=Y-1 K Y S:'RDT RDT=0 "RTN","RMPRPI09",45,0) S RMCAY=$S(RMCAT="O":"OPEN",RMCAT="R":"RECIEVED",RMCAT="C":"CANCEL") "RTN","RMPRPI09",46,0) S RS=RMPR("STA") "RTN","RMPRPI09",47,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI09",48,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI09",49,0) D HEAD "RTN","RMPRPI09",50,0) G:RMCAT="R" REC "RTN","RMPRPI09",51,0) ; "RTN","RMPRPI09",52,0) OPCA ;for open and cancel order "RTN","RMPRPI09",53,0) S RI="" "RTN","RMPRPI09",54,0) F S RI=$O(^RMPR(661.41,"ASSHID",RS,RMCAT,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.41,"ASSHID",RS,RMCAT,RI,RK)) Q:RK'>0!RMPREND=1 D "RTN","RMPRPI09",55,0) .F RM=RDT:0 S RM=$O(^RMPR(661.41,"ASSHID",RS,RMCAT,RI,RK,RM)) Q:RM'>0!RMPREND=1 D "RTN","RMPRPI09",56,0) ..F RN=0:0 S RN=$O(^RMPR(661.41,"ASSHID",RS,RMCAT,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 D "RTN","RMPRPI09",57,0) ...S RM3=$G(^RMPR(661.41,RN,0)) "RTN","RMPRPI09",58,0) ...S (RMVNAM,RMIDE)="" "RTN","RMPRPI09",59,0) ...S RMDOR=$P(RM3,U,1) "RTN","RMPRPI09",60,0) ...S RMIT=$P(RM3,U,2) "RTN","RMPRPI09",61,0) ...S RMVEN=$P(RM3,U,5) "RTN","RMPRPI09",62,0) ...S RMHCPC=$P(RM3,U,6) "RTN","RMPRPI09",63,0) ...S RMDRE=$P(RM3,U,7) "RTN","RMPRPI09",64,0) ...S RMQOR=$P(RM3,U,8) "RTN","RMPRPI09",65,0) ...S RMQRE=$P(RM3,U,9) "RTN","RMPRPI09",66,0) ...S RMCOM=$P(RM3,U,10) "RTN","RMPRPI09",67,0) ...S RMSTA=$P(RM3,U,11) "RTN","RMPRPI09",68,0) ...I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI09",69,0) ...S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3) "RTN","RMPRPI09",70,0) ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3) "RTN","RMPRPI09",71,0) ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1) "RTN","RMPRPI09",72,0) ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0)) "RTN","RMPRPI09",73,0) ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3) "RTN","RMPRPI09",74,0) ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?44,RMDOR,?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6) "RTN","RMPRPI09",75,0) ...W:RMCOM'="" !,?5,"Comment: ",RMCOM "RTN","RMPRPI09",76,0) ...S (RMPRFLG,RMPRT)=1 "RTN","RMPRPI09",77,0) ...I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI09",78,0) ...I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI09",79,0) W:$G(RMPRT) !,RMPR("L"),!,"" "RTN","RMPRPI09",80,0) G EXIT "RTN","RMPRPI09",81,0) ; "RTN","RMPRPI09",82,0) REC ;process a Recieved order. "RTN","RMPRPI09",83,0) S RI="" "RTN","RMPRPI09",84,0) F S RI=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI)) Q:RI=""!RMPREND=1 F RK=0:0 S RK=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK)) Q:RK'>0!RMPREND=1 D "RTN","RMPRPI09",85,0) .F RM=RDT:0 S RM=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM)) Q:RM'>0!RMPREND=1 D "RTN","RMPRPI09",86,0) ..F RN=0:0 S RN=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN)) Q:RN'>0!RMPREND=1 F RP=0:0 S RP=$O(^RMPR(661.6,"ASTHIDS",RS,1,RI,RK,RM,RN,RP)) Q:RP'>0!RMPREND=1 D "RTN","RMPRPI09",87,0) ...S RM3=$G(^RMPR(661.6,RP,0)) "RTN","RMPRPI09",88,0) ...S (RMVNAM,RMIDE)="" "RTN","RMPRPI09",89,0) ...S RMDOR=$P(RM3,U,1) "RTN","RMPRPI09",90,0) ...S RMIT=RK "RTN","RMPRPI09",91,0) ...S RMVEN=$P(RM3,U,12) "RTN","RMPRPI09",92,0) ...S RMHCPC=RI "RTN","RMPRPI09",93,0) ...S RMDRE=RM "RTN","RMPRPI09",94,0) ...S RMQOR="" "RTN","RMPRPI09",95,0) ...S RMQRE=$P(RM3,U,5) "RTN","RMPRPI09",96,0) ...S RMCOM=$P(RM3,U,8) "RTN","RMPRPI09",97,0) ...S RMSTA=RS "RTN","RMPRPI09",98,0) ...I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI09",99,0) ...;S:RMDOR RMDOR=$E(RMDOR,4,5)_"/"_$E(RMDOR,6,7)_"/"_$E(RMDOR,2,3) "RTN","RMPRPI09",100,0) ...S:RMDRE RMDRE=$E(RMDRE,4,5)_"/"_$E(RMDRE,6,7)_"/"_$E(RMDRE,2,3) "RTN","RMPRPI09",101,0) ...S:RMVEN RMVNAM=$P($G(^PRC(440,RMVEN,0)),U,1) "RTN","RMPRPI09",102,0) ...S RMIDA=$O(^RMPR(661.11,"ASHI",RS,RMHCPC,RMIT,0)) "RTN","RMPRPI09",103,0) ...S:RMIDA RMIDE=$P($G(^RMPR(661.11,RMIDA,0)),U,3) "RTN","RMPRPI09",104,0) ...W !,RMHCPC_"-"_RMIT,?10,$E(RMIDE,1,20),?31,$E(RMVNAM,1,11),?54,RMDRE,?64,$J(RMQOR,6),?72,$J(RMQRE,6) "RTN","RMPRPI09",105,0) ...W:RMCOM'="" !,?5,"Comment: ",RMCOM "RTN","RMPRPI09",106,0) ...S (RMPRFLG,RMPRT)=1 "RTN","RMPRPI09",107,0) ...I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI09",108,0) ...I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI09",109,0) W:$G(RMPRT) !,RMPR("L"),!,"" "RTN","RMPRPI09",110,0) G EXIT "RTN","RMPRPI09",111,0) ; "RTN","RMPRPI09",112,0) HEAD W !,"*** PIP ORDER AND RECEIVE ITEM REPORT ***"," for ",RMCAL," days old or Less, ",RMCAY," order" "RTN","RMPRPI09",113,0) W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT "RTN","RMPRPI09",114,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI09",115,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI09",116,0) Q "RTN","RMPRPI09",117,0) ; "RTN","RMPRPI09",118,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI09",119,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI09",120,0) W !,RMPR("L") "RTN","RMPRPI09",121,0) W !,?45,"DATE",?56,"DATE",?66,"QTY",?75,"QTY" "RTN","RMPRPI09",122,0) W !,"HCPCS",?10,"ITEM",?31,"VENDOR",?44,"ORDERED",?54,"RECIEVED" "RTN","RMPRPI09",123,0) W ?64,"ORDERED",?72,"RECIEVED" "RTN","RMPRPI09",124,0) W !,"-----",?10,"----",?31,"------",?44,"-------",?54,"--------" "RTN","RMPRPI09",125,0) W ?64,"-------",?72,"--------" "RTN","RMPRPI09",126,0) S RMPRFLG=1 "RTN","RMPRPI09",127,0) Q "RTN","RMPRPI09",128,0) ; "RTN","RMPRPI09",129,0) EXIT W:'$G(RMPRT) !,RMPR("L"),!!,"No DATA to print !!!" "RTN","RMPRPI09",130,0) I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI09",131,0) ; "RTN","RMPRPI09",132,0) EXIT1 D ^%ZISC "RTN","RMPRPI09",133,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI09",134,0) Q "RTN","RMPRPI10") 0^93^B23444540 "RTN","RMPRPI10",1,0) RMPRPI10 ;HIN/RVD-PRINT ITEM DETAIL OVER 30 DAYS ;3/8/05 11:40 "RTN","RMPRPI10",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI10",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI10",4,0) ; DBIA #10096 - Access to all %ZOSF nodes. "RTN","RMPRPI10",5,0) ; "RTN","RMPRPI10",6,0) K DIC,DIR,%DT "RTN","RMPRPI10",7,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI10",8,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI10",9,0) ; "RTN","RMPRPI10",10,0) EN K RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI10",11,0) S DIC="^RMPR(661.5,",DIC(0)="AEQ" "RTN","RMPRPI10",12,0) S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")" "RTN","RMPRPI10",13,0) ; "RTN","RMPRPI10",14,0) EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1 "RTN","RMPRPI10",15,0) G:RMENTER["?" EN1 "RTN","RMPRPI10",16,0) S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y "RTN","RMPRPI10",17,0) I RMENTER="ALL" S RMPRI="*" G CONT "RTN","RMPRPI10",18,0) W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D "RTN","RMPRPI10",19,0) .S RMLOCI=+Y "RTN","RMPRPI10",20,0) .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q "RTN","RMPRPI10",21,0) .S RMPRI(RMLOCI)="" "RTN","RMPRPI10",22,0) ; "RTN","RMPRPI10",23,0) CONT ; "RTN","RMPRPI10",24,0) K DIR "RTN","RMPRPI10",25,0) S DIR("B")="NEW Items",DIR("A")="Enter a SOURCE Creteria" "RTN","RMPRPI10",26,0) S DIR(0)="S^V:OLD Items;C:NEW Items" "RTN","RMPRPI10",27,0) D ^DIR G:$D(DUOUT)!$D(DIRUT)!$D(DTOUT) EXIT1 "RTN","RMPRPI10",28,0) S RE=Y K DIR "RTN","RMPRPI10",29,0) ; "RTN","RMPRPI10",30,0) DT ; "RTN","RMPRPI10",31,0) W ! S %DT("A")="Beginning Date: ",%DT="AEPX",%DT("B")="T-30" D ^%DT S RMB=Y G:Y<0 EXIT1 "RTN","RMPRPI10",32,0) ENDATE S %DT("A")="Ending Date: ",%DT="AEX",%DT("B")="TODAY" D ^%DT G:Y<0 EXIT1 I RMB>Y W !,$C(7),"Invalid Date Range Selection!!" G ENDATE "RTN","RMPRPI10",33,0) S RME=Y "RTN","RMPRPI10",34,0) ; "RTN","RMPRPI10",35,0) G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI10",36,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI10",37,0) K IO("Q") S ZTDESC="PROSTHETIC INVENTORY LOCATION SUMMARY" "RTN","RMPRPI10",38,0) S ZTRTN="PRINT^RMPRPI10",ZTIO=ION,ZTSAVE("RMPRI(")="" "RTN","RMPRPI10",39,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")="" "RTN","RMPRPI10",40,0) S ZTSAVE("RE")="",ZTSAVE("RMPRI")="" "RTN","RMPRPI10",41,0) S ZTSAVE("RME")="",ZTSAVE("RMB")="" "RTN","RMPRPI10",42,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI10",43,0) ; "RTN","RMPRPI10",44,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI10",45,0) ; "RTN","RMPRPI10",46,0) ;call API "RTN","RMPRPI10",47,0) ;input variables: "RTN","RMPRPI10",48,0) ; RM = any subscript to be used "RTN","RMPRPI10",49,0) ; RS = rmpr("sta") "RTN","RMPRPI10",50,0) ; RE = source (V or C) "RTN","RMPRPI10",51,0) ; RMPRI = rmpri(location array; '*' for all location ) "RTN","RMPRPI10",52,0) ; RMB = beginning date "RTN","RMPRPI10",53,0) ; RME = ending date "RTN","RMPRPI10",54,0) ; "RTN","RMPRPI10",55,0) S X1=RME,X2=RMB "RTN","RMPRPI10",56,0) D ^%DTC S RMCALDAY=X+1 "RTN","RMPRPI10",57,0) S Y=RMB D DD^%DT S RMBDAT=Y S Y=RME D DD^%DT S RMEDAT=Y "RTN","RMPRPI10",58,0) D NOW^%DTC S Y=% X ^DD("DD") S RMDAT=Y "RTN","RMPRPI10",59,0) S RSOU=$S(RE="V":"USED",RE="C":"NEW",1:"") "RTN","RMPRPI10",60,0) S RS=RMPR("STA"),RM="RM" "RTN","RMPRPI10",61,0) ; "RTN","RMPRPI10",62,0) S RMCHK=$$LOC^RMPRPI07(RM,RS,.RMPRI,RE,RMB,RME) "RTN","RMPRPI10",63,0) I RMCHK W !!,"ERROR NUMBER = ",RMCHK,!,"***Error in API RMPRPI07 !!!!",!! G EXIT "RTN","RMPRPI10",64,0) ; "RTN","RMPRPI10",65,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI10",66,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI10",67,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI10",68,0) D HEAD,WRI "RTN","RMPRPI10",69,0) G EXIT "RTN","RMPRPI10",70,0) ; "RTN","RMPRPI10",71,0) ;write/print report "RTN","RMPRPI10",72,0) ;rl = Location "RTN","RMPRPI10",73,0) ;rh = HCPCS "RTN","RMPRPI10",74,0) ;j = Item "RTN","RMPRPI10",75,0) ;k = Item description "RTN","RMPRPI10",76,0) ; "RTN","RMPRPI10",77,0) ; "RTN","RMPRPI10",78,0) WRI S RL="" "RTN","RMPRPI10",79,0) F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="" F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J="" D "RTN","RMPRPI10",80,0) .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J="")!(RMPREND) S K="" F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K="")!(RMPREND) D "RTN","RMPRPI10",81,0) ..S RM3=^TMP($J,"RM",RL,RH,J,K) "RTN","RMPRPI10",82,0) ..S RMIT=K "RTN","RMPRPI10",83,0) ..S RMQTY=$P(RM3,U,1) "RTN","RMPRPI10",84,0) ..S RMCOS=$P(RM3,U,2) "RTN","RMPRPI10",85,0) ..S RMDAU=RMQTY/RMCALDAY "RTN","RMPRPI10",86,0) ..S RMDOH="" "RTN","RMPRPI10",87,0) ..S RMSOH=$P(RM3,U,5) "RTN","RMPRPI10",88,0) ..S:+RMDAU RMDOH=$J(RMSOH/RMDAU,0,1) S:RMDOH>999 RMDOH=">999" "RTN","RMPRPI10",89,0) ..I 'RMDAU S RMDOH=">"_RMCALDAY "RTN","RMPRPI10",90,0) ..S RMDAU=$J(RMDAU,0,3) "RTN","RMPRPI10",91,0) ..S RMTDV=$P(RM3,U,6) "RTN","RMPRPI10",92,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI10",93,0) ..S RMIDE=$E(J,1,13) "RTN","RMPRPI10",94,0) ..W !,RH_"-"_RMIT,?10,RMIDE,?24,$J(RMQTY,4),?29,$J($FN(RMCOS,",",2),9),?42,RMDAU,?54,$J(RMDOH,4) "RTN","RMPRPI10",95,0) ..W ?61,$J(RMSOH,5),?70,$J($FN(RMTDV,",",2),10) "RTN","RMPRPI10",96,0) ..S RMPRFLG=1 "RTN","RMPRPI10",97,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI10",98,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI10",99,0) W !,RMPR("L"),!,"" "RTN","RMPRPI10",100,0) Q "RTN","RMPRPI10",101,0) ; "RTN","RMPRPI10",102,0) HEAD W !,"*** STOCK ON HAND OVER DATE RANGE ***"," for ",RSOU," Items" "RTN","RMPRPI10",103,0) W !,"Station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20),?30,"Run Date: ",RMDAT "RTN","RMPRPI10",104,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI10",105,0) W !,RMBDAT," to ",RMEDAT,?30,"[ ",RMCALDAY," calendar days ]" "RTN","RMPRPI10",106,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI10",107,0) Q "RTN","RMPRPI10",108,0) ; "RTN","RMPRPI10",109,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI10",110,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI10",111,0) W !,RMPR("L") "RTN","RMPRPI10",112,0) W !,"Location: ",$P($G(^RMPR(661.5,RL,0)),"^",1) "RTN","RMPRPI10",113,0) W !,?25,"QTY",?35,"$",?41,"DAYS AVE" "RTN","RMPRPI10",114,0) W ?54,"DAYS",?62,"STOCK",?72,"TOTAL $" "RTN","RMPRPI10",115,0) W !,"HCPCS",?10,"ITEM",?24,"ISSUE",?33,"VALUE" "RTN","RMPRPI10",116,0) W ?40,"USAGE RATE",?52,"ON-HAND",?61,"ON-HAND",?70,"VAL ON-HND" "RTN","RMPRPI10",117,0) W !,"-----",?10,"----",?24,"-----",?33,"-----" "RTN","RMPRPI10",118,0) W ?40,"----------",?52,"-------",?61,"-------",?70,"----------" "RTN","RMPRPI10",119,0) S RMPRFLG=1 "RTN","RMPRPI10",120,0) Q "RTN","RMPRPI10",121,0) ; "RTN","RMPRPI10",122,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI10",123,0) ; "RTN","RMPRPI10",124,0) EXIT1 D ^%ZISC "RTN","RMPRPI10",125,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI10",126,0) K ^TMP($J) "RTN","RMPRPI10",127,0) Q "RTN","RMPRPI10",128,0) ; "RTN","RMPRPI10",129,0) NONE ; "RTN","RMPRPI10",130,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI10",131,0) D HEAD "RTN","RMPRPI10",132,0) W !,RMPR("L") "RTN","RMPRPI10",133,0) W !!,"NO DATA to print !!!" "RTN","RMPRPI10",134,0) Q "RTN","RMPRPI11") 0^89^B23594413 "RTN","RMPRPI11",1,0) RMPRPI11 ;HIN/ODJ-PRINT BAR CODE LABELS ;10/8/02 13:11 "RTN","RMPRPI11",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI11",3,0) ; "RTN","RMPRPI11",4,0) Q "RTN","RMPRPI11",5,0) ; "RTN","RMPRPI11",6,0) ;***** SELP - Prompt for Bar Code printer "RTN","RMPRPI11",7,0) SELP(RMPRBCP,RMPREXC,RMPRQ,RMPRIOP) ; "RTN","RMPRPI11",8,0) N POP "RTN","RMPRPI11",9,0) START S %ZIS("A")="Select Bar Code Printer: " "RTN","RMPRPI11",10,0) S %ZIS("B")="" "RTN","RMPRPI11",11,0) S %ZIS="QN" K IOP "RTN","RMPRPI11",12,0) D ^%ZIS "RTN","RMPRPI11",13,0) S RMPRQ=0 "RTN","RMPRPI11",14,0) S RMPREXC="" "RTN","RMPRPI11",15,0) I POP S RMPREXC="P" G SELPX "RTN","RMPRPI11",16,0) I '$D(IO("Q")) D G SELPX "RTN","RMPRPI11",17,0) . S RMPRBCP=$G(IOST) "RTN","RMPRPI11",18,0) . S:RMPRBCP="" RMPREXC="^" "RTN","RMPRPI11",19,0) . S RMPRIOP=$G(ION) "RTN","RMPRPI11",20,0) . Q "RTN","RMPRPI11",21,0) ;I '$D(IO("Q")) U IO D TEST G SELPX "RTN","RMPRPI11",22,0) ;K IO("Q") S ZTDESC="SLAVE PRINT TEST" "RTN","RMPRPI11",23,0) ;S ZTRTN="TEST^RMPRPI11",ZTIO=ION "RTN","RMPRPI11",24,0) ;D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!",! H 1 G SELPX "RTN","RMPRPI11",25,0) SELPX Q "RTN","RMPRPI11",26,0) TEST S IOP=ION,%ZIS="" D ^%ZIS "RTN","RMPRPI11",27,0) W !!,"TESTING SLAVE DEVICE",!! "RTN","RMPRPI11",28,0) W @IOF "RTN","RMPRPI11",29,0) D ^%ZISC "RTN","RMPRPI11",30,0) Q "RTN","RMPRPI11",31,0) ; "RTN","RMPRPI11",32,0) ; Print bar code for printer using ZPLII command set (ZEBRAS) "RTN","RMPRPI11",33,0) ; applies to Z4000 and all Zebra printers. "RTN","RMPRPI11",34,0) ZPLII(RMPRBARC,RMPRITXT,RMPRNCOP) ; "RTN","RMPRPI11",35,0) N RMPRUNIT,RMPRLTYP,RMPRLWID,RMPRLHGT,RMPRMMIN "RTN","RMPRPI11",36,0) N RMPRXDIM,RMPRQUIZ,RMPRHCPC,RMPRBLEN,RMPRDT,RMPRBHGT,RMPRCRLF "RTN","RMPRPI11",37,0) N RMPRLEFT,RMPRDOWN,RMPRLCNT "RTN","RMPRPI11",38,0) S RMPRUNIT="MM" ; use mm units "RTN","RMPRPI11",39,0) S RMPRLTYP="" ; "RTN","RMPRPI11",40,0) S RMPRLWID=75 ; Lable width 75mm "RTN","RMPRPI11",41,0) S RMPRLHGT=25 ; Label height 25mm "RTN","RMPRPI11",42,0) ;if printer resolution not defined in terminal type file, "RTN","RMPRPI11",43,0) ;default to 8 dpm "RTN","RMPRPI11",44,0) I '$G(RMPRLRES) S RMPRLRES=8 ; 8 for 203dpi & 12 for 300dpi "RTN","RMPRPI11",45,0) S RMPRMMIN=25.333 ; mm to the inch conversion factor "RTN","RMPRPI11",46,0) I '+$G(RMPRNCOP) S RMPRNCOP=1 "RTN","RMPRPI11",47,0) ; "RTN","RMPRPI11",48,0) ; Set the X dimension in dots (width of narrow bar) "RTN","RMPRPI11",49,0) ; minimum recommended X dimension is .25mm (7.5/1000th inch) "RTN","RMPRPI11",50,0) I RMPRUNIT="MM" D "RTN","RMPRPI11",51,0) . S RMPRXDIM=RMPRLRES*.25 "RTN","RMPRPI11",52,0) . Q "RTN","RMPRPI11",53,0) I RMPRUNIT="IN" D "RTN","RMPRPI11",54,0) . S RMPRXDIM=RMPRLRES*.0075 "RTN","RMPRPI11",55,0) . Q "RTN","RMPRPI11",56,0) S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=.5+(RMPRXDIM\1) "RTN","RMPRPI11",57,0) ; "RTN","RMPRPI11",58,0) ; Calculate the quiet zone in dots "RTN","RMPRPI11",59,0) ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch) "RTN","RMPRPI11",60,0) I RMPRUNIT="MM" D "RTN","RMPRPI11",61,0) . S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1 "RTN","RMPRPI11",62,0) . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM "RTN","RMPRPI11",63,0) . Q "RTN","RMPRPI11",64,0) I RMPRUNIT="IN" D "RTN","RMPRPI11",65,0) . S RMPRQUIZ=((.1*RMPRLRES)\1)+1 "RTN","RMPRPI11",66,0) . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM "RTN","RMPRPI11",67,0) . Q "RTN","RMPRPI11",68,0) ; "RTN","RMPRPI11",69,0) ; Calculate length (in dots) of symbol to be printed "RTN","RMPRPI11",70,0) ; Symbol is [HCPCS code][-][Date and Time] "RTN","RMPRPI11",71,0) ; [HCPCS code] and [-] will be alphanumeric "RTN","RMPRPI11",72,0) ; [Date and Time] will be numeric using code C "RTN","RMPRPI11",73,0) S RMPRHCPC=$P(RMPRBARC,"-",1) "RTN","RMPRPI11",74,0) S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM "RTN","RMPRPI11",75,0) S RMPRDT=$P(RMPRBARC,"-",2) "RTN","RMPRPI11",76,0) S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM) "RTN","RMPRPI11",77,0) ; "RTN","RMPRPI11",78,0) ; Calculate bar height in dots "RTN","RMPRPI11",79,0) ; this should be .15 times symbol length or .25 inches "RTN","RMPRPI11",80,0) I RMPRUNIT="MM" D "RTN","RMPRPI11",81,0) . S RMPRBHGT=((6.33325*RMPRLRES)\1)+2 "RTN","RMPRPI11",82,0) . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1) "RTN","RMPRPI11",83,0) . Q "RTN","RMPRPI11",84,0) I RMPRUNIT="IN" D "RTN","RMPRPI11",85,0) . S RMPRBHGT=((.25*RMPRLRES)\1)+2 "RTN","RMPRPI11",86,0) . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=2+((.15*RMPRBLEN)\1) "RTN","RMPRPI11",87,0) . Q "RTN","RMPRPI11",88,0) ; "RTN","RMPRPI11",89,0) ; *** Print the symbol *** "RTN","RMPRPI11",90,0) S RMPRCRLF=$C(13)_$C(10) "RTN","RMPRPI11",91,0) S RMPRLCNT=0 "RTN","RMPRPI11",92,0) I '$D(RMPR("NAME")),$D(RMPRITXT("NAME")) S RMPR("NAME")=RMPRITXT("NAME") "RTN","RMPRPI11",93,0) I '$D(RMPR("NAME")),$D(RMPRSTN("SITE NAME")) S RMPR("NAME")=RMPRSTN("SITE NAME") "RTN","RMPRPI11",94,0) I '$D(RMPR("NAME")) S RMPR("NAME")="" "RTN","RMPRPI11",95,0) ZPLIIP W "^XA",RMPRCRLF "RTN","RMPRPI11",96,0) W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF "RTN","RMPRPI11",97,0) W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF "RTN","RMPRPI11",98,0) S RMPRLEFT=RMPRQUIZ+5 "RTN","RMPRPI11",99,0) S RMPRDOWN=(RMPRQUIZ\2)-10 "RTN","RMPRPI11",100,0) ; "RTN","RMPRPI11",101,0) ; the BAR CODE "RTN","RMPRPI11",102,0) W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF "RTN","RMPRPI11",103,0) S RMPRDOWN=RMPRDOWN+((1.33*RMPRBHGT)\1) "RTN","RMPRPI11",104,0) ; "RTN","RMPRPI11",105,0) ; Description fields "RTN","RMPRPI11",106,0) S RMPRIND=RMPRLEFT+20 "RTN","RMPRPI11",107,0) S RMPRITXT("DT")=$E(RMPRITXT("DATE"),1,6)_$E(RMPRITXT("DATE"),9,10) "RTN","RMPRPI11",108,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI11",109,0) W:RMPRLRES=12 "^AE,^FD"_$E(RMPRITXT("ITEM")_$J("",12),1,12)_$E("$ "_$J(RMPRITXT("UNIT PRICE"),0,2)_$J("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF "RTN","RMPRPI11",110,0) W:RMPRLRES=8 "^AF,^FD"_$E(RMPRITXT("ITEM")_$J("",12),1,12)_$E("$ "_$J(RMPRITXT("UNIT PRICE"),0,2)_$J("",10),1,10)_" "_RMPRITXT("DT")_"^FS",RMPRCRLF "RTN","RMPRPI11",111,0) S RMPRDOWN=RMPRDOWN+14+(RMPRQUIZ\1.5) "RTN","RMPRPI11",112,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI11",113,0) W:RMPRLRES=12 "^AF^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF "RTN","RMPRPI11",114,0) W:RMPRLRES=8 "^AD^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF "RTN","RMPRPI11",115,0) S RMPRDOWN=RMPRDOWN+10+(RMPRQUIZ\1.5) "RTN","RMPRPI11",116,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI11",117,0) W "^AF^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF "RTN","RMPRPI11",118,0) S RMPRDOWN=RMPRDOWN+8+(RMPRQUIZ\1.5) "RTN","RMPRPI11",119,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI11",120,0) W:RMPRLRES=12 "^AF^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF "RTN","RMPRPI11",121,0) W:RMPRLRES=8 "^AD^FD"_$E(RMPRITXT("VENDOR"),1,18)_" # "_$E(RMPRITXT("LOCATION"),1,18)_" # "_$E(RMPR("NAME"),1,15)_"^FS",RMPRCRLF "RTN","RMPRPI11",122,0) ;W:RMPRLRES=8 "^AD^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF "RTN","RMPRPI11",123,0) ; "RTN","RMPRPI11",124,0) ; finish "RTN","RMPRPI11",125,0) W "^XZ",RMPRCRLF "RTN","RMPRPI11",126,0) S RMPRLCNT=1+RMPRLCNT "RTN","RMPRPI11",127,0) I RMPRLCNT "RTN","RMPRPI13",40,0) S RMPRLWID=75 ; Lable width 75mm "RTN","RMPRPI13",41,0) S RMPRLHGT=25 ; Label height 25mm "RTN","RMPRPI13",42,0) S RMPRLRES=8 ; 8 dots/mm resolution "RTN","RMPRPI13",43,0) S RMPRMMIN=25.333 ; mm to the inch conversion factor "RTN","RMPRPI13",44,0) I '+$G(RMPRNCOP) S RMPRNCOP=1 "RTN","RMPRPI13",45,0) ; "RTN","RMPRPI13",46,0) ; Set the X dimension in dots (width of narrow bar) "RTN","RMPRPI13",47,0) ; minimum recommended X dimension is .19mm (7.5/1000th inch) "RTN","RMPRPI13",48,0) I RMPRUNIT="MM" D "RTN","RMPRPI13",49,0) . S RMPRXDIM=RMPRLRES*.19 "RTN","RMPRPI13",50,0) . Q "RTN","RMPRPI13",51,0) I RMPRUNIT="IN" D "RTN","RMPRPI13",52,0) . S RMPRXDIM=RMPRLRES*.0075 "RTN","RMPRPI13",53,0) . Q "RTN","RMPRPI13",54,0) S:RMPRXDIM'=(RMPRXDIM\1) RMPRXDIM=1+(RMPRXDIM\1) "RTN","RMPRPI13",55,0) ; "RTN","RMPRPI13",56,0) ; Calculate the quiet zone in dots "RTN","RMPRPI13",57,0) ; this should be greater of 10 X dimensions or 2.5333 mm (.1 inch) "RTN","RMPRPI13",58,0) I RMPRUNIT="MM" D "RTN","RMPRPI13",59,0) . S RMPRQUIZ=((2.5333*RMPRLRES)\1)+1 "RTN","RMPRPI13",60,0) . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM "RTN","RMPRPI13",61,0) . Q "RTN","RMPRPI13",62,0) I RMPRUNIT="IN" D "RTN","RMPRPI13",63,0) . S RMPRQUIZ=((.1*RMPRLRES)\1)+1 "RTN","RMPRPI13",64,0) . S:RMPRQUIZ<(10*RMPRXDIM) RMPRQUIZ=10*RMPRXDIM "RTN","RMPRPI13",65,0) . Q "RTN","RMPRPI13",66,0) ; "RTN","RMPRPI13",67,0) ; Calculate length (in dots) of symbol to be printed "RTN","RMPRPI13",68,0) ; Symbol is [HCPCS code][-][Date and Time] "RTN","RMPRPI13",69,0) ; [HCPCS code] and [-] will be alphanumeric "RTN","RMPRPI13",70,0) ; [Date and Time] will be numeric using code C "RTN","RMPRPI13",71,0) S RMPRHCPC=$P(RMPRBARC,"-",1) "RTN","RMPRPI13",72,0) S RMPRBLEN=((11*($L(RMPRHCPC)+5))+35)*RMPRXDIM "RTN","RMPRPI13",73,0) S RMPRDT=$P(RMPRBARC,"-",2) "RTN","RMPRPI13",74,0) S RMPRBLEN=RMPRBLEN+(((5.5*($L(RMPRDT)))+35)*RMPRXDIM) "RTN","RMPRPI13",75,0) ; "RTN","RMPRPI13",76,0) ; Calculate bar height in dots "RTN","RMPRPI13",77,0) ; this should be .15 times symbol length or .25 inches "RTN","RMPRPI13",78,0) I RMPRUNIT="MM" D "RTN","RMPRPI13",79,0) . S RMPRBHGT=((6.33325*RMPRLRES)\1)+1 "RTN","RMPRPI13",80,0) . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1) "RTN","RMPRPI13",81,0) . Q "RTN","RMPRPI13",82,0) I RMPRUNIT="IN" D "RTN","RMPRPI13",83,0) . S RMPRBHGT=((.25*RMPRLRES)\1)+1 "RTN","RMPRPI13",84,0) . S:RMPRBHGT<(((.15*RMPRBLEN)\1)+1) RMPRBHGT=1+((.15*RMPRBLEN)\1) "RTN","RMPRPI13",85,0) . Q "RTN","RMPRPI13",86,0) ; "RTN","RMPRPI13",87,0) ; *** Print the symbol *** "RTN","RMPRPI13",88,0) S RMPRCRLF=$C(13)_$C(10) "RTN","RMPRPI13",89,0) S RMPRLCNT=0 "RTN","RMPRPI13",90,0) ZPLIIP W "^XA",RMPRCRLF "RTN","RMPRPI13",91,0) W "^LH"_RMPRQUIZ_","_RMPRQUIZ,RMPRCRLF "RTN","RMPRPI13",92,0) W "^BY"_RMPRXDIM_",3.0,"_RMPRBHGT,RMPRCRLF "RTN","RMPRPI13",93,0) S RMPRLEFT=RMPRQUIZ "RTN","RMPRPI13",94,0) S RMPRDOWN=RMPRQUIZ\2 "RTN","RMPRPI13",95,0) ; "RTN","RMPRPI13",96,0) ; the BAR CODE "RTN","RMPRPI13",97,0) W "^FO"_RMPRLEFT_","_RMPRDOWN_","_"^BCN,"_RMPRBHGT_",Y,N,N,A^FD"_RMPRBARC_"^FS",RMPRCRLF "RTN","RMPRPI13",98,0) S RMPRDOWN=RMPRDOWN+((1.4*RMPRBHGT)\1) "RTN","RMPRPI13",99,0) ; "RTN","RMPRPI13",100,0) ; Description fields "RTN","RMPRPI13",101,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI13",102,0) W "^AC^FD"_$E(RMPRITXT("ITEM")_$J("",15),1,15)_$E("$ "_RMPRITXT("UNIT PRICE")_$J("",15),1,15)_RMPRITXT("DATE")_"^FS",RMPRCRLF "RTN","RMPRPI13",103,0) S RMPRDOWN=RMPRDOWN+1+RMPRQUIZ "RTN","RMPRPI13",104,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI13",105,0) W "^AB^FD"_RMPRITXT("MASTER DESC")_"^FS",RMPRCRLF "RTN","RMPRPI13",106,0) S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5) "RTN","RMPRPI13",107,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI13",108,0) W "^AB^FD"_RMPRITXT("ITEM DESC")_"^FS",RMPRCRLF "RTN","RMPRPI13",109,0) S RMPRDOWN=RMPRDOWN+1+(RMPRQUIZ\1.5) "RTN","RMPRPI13",110,0) W "^FO"_RMPRLEFT_","_RMPRDOWN,RMPRCRLF "RTN","RMPRPI13",111,0) W "^AB^FD"_RMPRITXT("VENDOR")_"^FS",RMPRCRLF "RTN","RMPRPI13",112,0) ; "RTN","RMPRPI13",113,0) ; finish "RTN","RMPRPI13",114,0) W "^XZ",RMPRCRLF "RTN","RMPRPI13",115,0) S RMPRLCNT=1+RMPRLCNT "RTN","RMPRPI13",116,0) I RMPRLCNT0)!(RMPREND) S K=0 F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K'>0)!(RMPREND) D "RTN","RMPRPI14",57,0) ..Q:K>RMD30 "RTN","RMPRPI14",58,0) ..S RM3=^TMP($J,"RM",RL,RH,J,K) "RTN","RMPRPI14",59,0) ..S RMFLG=0 "RTN","RMPRPI14",60,0) ..F RDT=RMD30:0 S RDT=$O(^RMPR(661.6,"ASTHIDS",RS,3,RH,J,RDT)) Q:RDT'>0 I RDT>RMD30 S RMFLG=1 Q "RTN","RMPRPI14",61,0) ..Q:RMFLG=1!(K=1) "RTN","RMPRPI14",62,0) ..S RMIT=J "RTN","RMPRPI14",63,0) ..S RMDAT=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) "RTN","RMPRPI14",64,0) ..S RMAST="" "RTN","RMPRPI14",65,0) ..S RMROR=$P(RM3,U,7) "RTN","RMPRPI14",66,0) ..S RMQTY=$P(RM3,U,1) "RTN","RMPRPI14",67,0) ..S RMCOS=$P(RM3,U,3) "RTN","RMPRPI14",68,0) ..S RMVAL=$P(RM3,U,2) "RTN","RMPRPI14",69,0) ..S RMVEN=$P(RM3,U,4) "RTN","RMPRPI14",70,0) ..S RMIDE=$P(RM3,U,5) "RTN","RMPRPI14",71,0) ..S RMSOR=$P(RM3,U,9) "RTN","RMPRPI14",72,0) ..S:RMROR>RMQTY RMAST="*" "RTN","RMPRPI14",73,0) ..S RLO=RL "RTN","RMPRPI14",74,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI14",75,0) ..S RMCNT=RMCNT+1 "RTN","RMPRPI14",76,0) ..S RMIDE=$E(RMIDE,1,24) "RTN","RMPRPI14",77,0) ..W !,RH_"-"_RMIT,?10,RMIDE,?36,RMSOR,?39,$E(RMVEN,1,7),?47,RMDAT,?56,$J(RMQTY,4) "RTN","RMPRPI14",78,0) ..W ?61,$J(RMCOS,8,2),?69,$J($FN(RMVAL,",",2),10) "RTN","RMPRPI14",79,0) ..S RMPRFLG=1 "RTN","RMPRPI14",80,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI14",81,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI14",82,0) W:'$G(RMCNT) !!,"NO DATA TO PRINT!!!!",!! "RTN","RMPRPI14",83,0) W !,RMPR("L"),!,"" "RTN","RMPRPI14",84,0) Q "RTN","RMPRPI14",85,0) ; "RTN","RMPRPI14",86,0) HEAD W !,"*** PROSTHETICS ITEMS NOT ISSUED WITHIN 30-DAY ***" "RTN","RMPRPI14",87,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI14",88,0) W !,"Run Date: ",RMTODAT,?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20) "RTN","RMPRPI14",89,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI14",90,0) Q "RTN","RMPRPI14",91,0) ; "RTN","RMPRPI14",92,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI14",93,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI14",94,0) W !,RMPR("L") "RTN","RMPRPI14",95,0) W !,"Location: ",RLO "RTN","RMPRPI14",96,0) W !,?48,"DATE",?65,"UNIT",?74,"TOTAL" "RTN","RMPRPI14",97,0) W !,"HCPCS",?10,"ITEM",?34,"SRC",?39,"VENDOR" "RTN","RMPRPI14",98,0) W ?47,"ENTERED",?57,"QTY",?65,"COST",?74,"VALUE" "RTN","RMPRPI14",99,0) W !,"-----",?10,"----",?34,"---",?39,"------" "RTN","RMPRPI14",100,0) W ?47,"-------",?57,"---",?65,"----",?73,"------" "RTN","RMPRPI14",101,0) S RMPRFLG=1 "RTN","RMPRPI14",102,0) Q "RTN","RMPRPI14",103,0) ; "RTN","RMPRPI14",104,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI14",105,0) ; "RTN","RMPRPI14",106,0) EXIT1 D ^%ZISC "RTN","RMPRPI14",107,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI14",108,0) K ^TMP($J) "RTN","RMPRPI14",109,0) Q "RTN","RMPRPI14",110,0) ; "RTN","RMPRPI14",111,0) NONE ; "RTN","RMPRPI14",112,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI14",113,0) D HEAD "RTN","RMPRPI14",114,0) W !!,"NO DATA !!!!" "RTN","RMPRPI14",115,0) Q "RTN","RMPRPI15") 0^92^B14961158 "RTN","RMPRPI15",1,0) RMPRPI15 ;HINES OIFO/RVD-PRINT STOCK RECONCILIATION WORK SHEET ;3/8/05 11:43 "RTN","RMPRPI15",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI15",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPI15",4,0) ; DBIA #10096 - Access to all %ZOSF nodes. "RTN","RMPRPI15",5,0) ; "RTN","RMPRPI15",6,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI15",7,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI15",8,0) ; "RTN","RMPRPI15",9,0) EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI15",10,0) S DIC="^RMPR(661.5,",DIC(0)="AEQ" "RTN","RMPRPI15",11,0) S DIC("S")="I $P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")" "RTN","RMPRPI15",12,0) ; "RTN","RMPRPI15",13,0) EN1 R !!,"Enter 'ALL' for all Locations or 'RETURN' to select individual Locations: ",RMENTER:DTIME G:$D(DTOUT)!$D(DUOUT)!(RMENTER="^") EXIT1 "RTN","RMPRPI15",14,0) G:RMENTER["?" EN1 "RTN","RMPRPI15",15,0) S X=RMENTER X ^%ZOSF("UPPERCASE") S RMENTER=Y "RTN","RMPRPI15",16,0) I RMENTER="ALL" S RMPRI="*" G CONT "RTN","RMPRPI15",17,0) W ! F RML=1:1 S DIC("A")="Select Location "_RML_": " D ^DIC G:$D(DTOUT)!(X["^")!(X=""&(RML=1)) EXIT1 Q:X="" D "RTN","RMPRPI15",18,0) .S RMLOCI=+Y "RTN","RMPRPI15",19,0) .I $D(RMPRI(RMLOCI)) W $C(7)," ??",?40,"..Duplicate Location" S RML=RML-1 Q "RTN","RMPRPI15",20,0) .S RMPRI(RMLOCI)="" "RTN","RMPRPI15",21,0) ; "RTN","RMPRPI15",22,0) CONT G:'$D(RMPRI) EXIT1 S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI15",23,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI15",24,0) K IO("Q") S ZTDESC="PROSTHETIC STOCK RECONCILIATION REPORT" "RTN","RMPRPI15",25,0) S ZTRTN="PRINT^RMPRPI15",ZTIO=ION,ZTSAVE("RMPRI(")="",ZTSAVE("RMPRI")="" "RTN","RMPRPI15",26,0) S ZTSAVE("RMPR(""STA"")")="",ZTSAVE("RMDAT")="",ZTSAVE("RMPR(")="" "RTN","RMPRPI15",27,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI15",28,0) ; "RTN","RMPRPI15",29,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI15",30,0) ; "RTN","RMPRPI15",31,0) ;call API "RTN","RMPRPI15",32,0) ;input variables: "RTN","RMPRPI15",33,0) ; RM = any subscript to be used "RTN","RMPRPI15",34,0) ; RS = rmpr("sta") "RTN","RMPRPI15",35,0) ; RMPRI = rmpri(location array) "RTN","RMPRPI15",36,0) ; "RTN","RMPRPI15",37,0) S RS=RMPR("STA"),RM="RM" "RTN","RMPRPI15",38,0) D PROC^RMPRPI02(RM,RS,.RMPRI) "RTN","RMPRPI15",39,0) ; "RTN","RMPRPI15",40,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI15",41,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI15",42,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI15",43,0) D HEAD,WRI "RTN","RMPRPI15",44,0) G EXIT "RTN","RMPRPI15",45,0) ; "RTN","RMPRPI15",46,0) ;write/print report "RTN","RMPRPI15",47,0) ;rl = Location "RTN","RMPRPI15",48,0) ;rh = HCPCS "RTN","RMPRPI15",49,0) ;j = Item "RTN","RMPRPI15",50,0) ;k = Date "RTN","RMPRPI15",51,0) ; "RTN","RMPRPI15",52,0) WRI S RL="" "RTN","RMPRPI15",53,0) F S RL=$O(^TMP($J,"RM",RL)) Q:(RL="")!(RMPREND) K RMPRFLG S RH="",RLF=RL F S RH=$O(^TMP($J,"RM",RL,RH)) Q:(RH="")!(RMPREND) S J=0 D "RTN","RMPRPI15",54,0) .F S J=$O(^TMP($J,"RM",RL,RH,J)) Q:(J'>0)!(RMPREND) S K=0 F S K=$O(^TMP($J,"RM",RL,RH,J,K)) Q:(K'>0)!(RMPREND) D "RTN","RMPRPI15",55,0) ..Q:K=1 "RTN","RMPRPI15",56,0) ..S RM3=^TMP($J,"RM",RL,RH,J,K) "RTN","RMPRPI15",57,0) ..S RMIT=J "RTN","RMPRPI15",58,0) ..S RMDTE=" " "RTN","RMPRPI15",59,0) ..S RMDTE=$E(K,4,5)_"/"_$E(K,6,7)_"/"_$E(K,2,3) "RTN","RMPRPI15",60,0) ..S RMROR=$P(RM3,U,7) "RTN","RMPRPI15",61,0) ..S RMQTY=$P(RM3,U,1) "RTN","RMPRPI15",62,0) ..S RMCOS=$P(RM3,U,3) "RTN","RMPRPI15",63,0) ..S RMVAL=$P(RM3,U,2) "RTN","RMPRPI15",64,0) ..S RMVEN=$P(RM3,U,4) "RTN","RMPRPI15",65,0) ..S RMIDE=$P(RM3,U,5) "RTN","RMPRPI15",66,0) ..S RMSOR=$P(RM3,U,9) "RTN","RMPRPI15",67,0) ..S RLO=RL "RTN","RMPRPI15",68,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI15",69,0) ..S RMIDE=$E(RMIDE,1,60) "RTN","RMPRPI15",70,0) ..W !,RH_"-"_RMIT,?12,RMIDE "RTN","RMPRPI15",71,0) ..W !,?27,RMDTE,?36,$J(RMCOS,8,2),?46,$E(RMVEN,1,9),?56,$J(RMQTY,4),?62,$E(RLO,1,9),?72,"________" "RTN","RMPRPI15",72,0) ..S RMPRFLG=1 "RTN","RMPRPI15",73,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI15",74,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI15",75,0) W !,RMPR("L"),!,"" "RTN","RMPRPI15",76,0) Q "RTN","RMPRPI15",77,0) ; "RTN","RMPRPI15",78,0) HEAD W !,"*** PROSTHETICS STOCK RECONCILIATION WORK SHEET ***" "RTN","RMPRPI15",79,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI15",80,0) W !,"Run Date: ",RMDAT,?30,"station: ",$E($P($G(^DIC(4,RS,0)),U,1),1,20) "RTN","RMPRPI15",81,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI15",82,0) Q "RTN","RMPRPI15",83,0) ; "RTN","RMPRPI15",84,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI15",85,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI15",86,0) W !,RMPR("L") "RTN","RMPRPI15",87,0) W !,"Location: ",RLO "RTN","RMPRPI15",88,0) W !,?40,"UNIT",?72,"PHYSICAL" "RTN","RMPRPI15",89,0) W !,"HCPCS",?12,"ITEM",?27,"DATE",?40,"COST",?46,"VENDOR" "RTN","RMPRPI15",90,0) W ?57,"QTY",?62,"LOCATION",?75,"COUNT" "RTN","RMPRPI15",91,0) W !,"-----",?12,"----",?27,"----",?40,"----",?46,"------" "RTN","RMPRPI15",92,0) W ?57,"---",?62,"--------",?75,"-----" "RTN","RMPRPI15",93,0) S RMPRFLG=1 "RTN","RMPRPI15",94,0) Q "RTN","RMPRPI15",95,0) ; "RTN","RMPRPI15",96,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI15",97,0) ; "RTN","RMPRPI15",98,0) EXIT1 D ^%ZISC "RTN","RMPRPI15",99,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI15",100,0) K ^TMP($J) "RTN","RMPRPI15",101,0) Q "RTN","RMPRPI15",102,0) ; "RTN","RMPRPI15",103,0) NONE ; "RTN","RMPRPI15",104,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI15",105,0) D HEAD "RTN","RMPRPI15",106,0) W !!,"NO DATA !!!!" "RTN","RMPRPI15",107,0) Q "RTN","RMPRPI16") 0^101^B9195029 "RTN","RMPRPI16",1,0) RMPRPI16 ;HINES OIFO/RVD-PRINT PIP/IFCAP ITEMS ;12/11/02 07:12 "RTN","RMPRPI16",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPI16",3,0) ; "RTN","RMPRPI16",4,0) D DIV4^RMPRSIT I $D(Y),(Y<0) Q "RTN","RMPRPI16",5,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPI16",6,0) ; "RTN","RMPRPI16",7,0) EN K ^TMP($J),RMPRI,RMPRFLG S RMPREND=0 D HOME^%ZIS "RTN","RMPRPI16",8,0) ; "RTN","RMPRPI16",9,0) ; "RTN","RMPRPI16",10,0) CONT S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT1 "RTN","RMPRPI16",11,0) I '$D(IO("Q")) U IO G PRINT "RTN","RMPRPI16",12,0) K IO("Q") S ZTDESC="PROSTHETIC PIP/IFCAP ITEMS REPORT" "RTN","RMPRPI16",13,0) S ZTRTN="PRINT^RMPRPI16",ZTIO=ION,ZTSAVE("RMPR(""L"")")="" "RTN","RMPRPI16",14,0) S ZTSAVE("RMPR(""STA"")")="" "RTN","RMPRPI16",15,0) S ZTSAVE("RMDAT")="" "RTN","RMPRPI16",16,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT1 "RTN","RMPRPI16",17,0) ; "RTN","RMPRPI16",18,0) PRINT I $E(IOST)["C" W !!,"Processing report....." "RTN","RMPRPI16",19,0) ; "RTN","RMPRPI16",20,0) ;call API "RTN","RMPRPI16",21,0) ;input variables: "RTN","RMPRPI16",22,0) ; RM = any subscript to be used "RTN","RMPRPI16",23,0) ; "RTN","RMPRPI16",24,0) S RMSTAT=$$GETSTN^RMPRPIU0(RMPR("STA")) "RTN","RMPRPI16",25,0) S RM="RM" "RTN","RMPRPI16",26,0) F I=0:0 S I=$O(^RMPR(661.11,I)) Q:I'>0 D "RTN","RMPRPI16",27,0) .S RM11=$G(^RMPR(661.11,I,0)),RMHC=$P(RM11,U,1),RMIT=$P(RM11,U,2) "RTN","RMPRPI16",28,0) .S RMDE=$P(RM11,U,3),RMST=$P(RM11,U,4),RMIF=$P(RM11,U,8) "RTN","RMPRPI16",29,0) .Q:RMPR("STA")'=RMST "RTN","RMPRPI16",30,0) .S (RM44,RMIFIT)="" "RTN","RMPRPI16",31,0) .I $G(RMIF),$D(^RMPR(661,RMIF,0)) S RM44=$P(^RMPR(661,RMIF,0),U,1) "RTN","RMPRPI16",32,0) .I $G(RM44) S RMIFIT=$$GETITM^RMPRPIU0(RM44) "RTN","RMPRPI16",33,0) .S ^TMP($J,RM,RMSTAT,RMHC,RMIT)=RMDE_"^"_RMIFIT "RTN","RMPRPI16",34,0) ; "RTN","RMPRPI16",35,0) S RMPAGE=1,RMPREND=0 "RTN","RMPRPI16",36,0) I '$D(^TMP($J,"RM")) D NONE G EXIT "RTN","RMPRPI16",37,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI16",38,0) D HEAD,WRI "RTN","RMPRPI16",39,0) G EXIT "RTN","RMPRPI16",40,0) ; "RTN","RMPRPI16",41,0) ;write/print report "RTN","RMPRPI16",42,0) ; "RTN","RMPRPI16",43,0) WRI S RS="" "RTN","RMPRPI16",44,0) F S RS=$O(^TMP($J,"RM",RS)) Q:(RS="")!(RMPREND) K RMPRFLG S RH="" F S RH=$O(^TMP($J,"RM",RS,RH)) Q:(RH="")!(RMPREND) S J=0 D "RTN","RMPRPI16",45,0) .F S J=$O(^TMP($J,"RM",RS,RH,J)) Q:(J'>0)!(RMPREND) D "RTN","RMPRPI16",46,0) ..S RM3=^TMP($J,"RM",RS,RH,J) "RTN","RMPRPI16",47,0) ..S RMIT=J "RTN","RMPRPI16",48,0) ..S RMITDE=$P(RM3,U,1) "RTN","RMPRPI16",49,0) ..S RMIFDE=$P(RM3,U,2) "RTN","RMPRPI16",50,0) ..S RSO=RS "RTN","RMPRPI16",51,0) ..I '$D(RMPRFLG) D HEAD1 "RTN","RMPRPI16",52,0) ..S RMITDE=$E(RMITDE,1,20) "RTN","RMPRPI16",53,0) ..S RMIFDE=$E(RMIFDE,1,35) "RTN","RMPRPI16",54,0) ..W !,RH_"-"_RMIT,?16,RMITDE,?43,RMIFDE "RTN","RMPRPI16",55,0) ..S RMPRFLG=1 "RTN","RMPRPI16",56,0) ..I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI16",57,0) ..I $Y>(IOSL-6) W @IOF D HEAD,HEAD1 Q "RTN","RMPRPI16",58,0) W !,RMPR("L"),!,"" "RTN","RMPRPI16",59,0) Q "RTN","RMPRPI16",60,0) ; "RTN","RMPRPI16",61,0) HEAD W !,"*** PROSTHETICS PIP/IFCAP ITEMS REPORT***" "RTN","RMPRPI16",62,0) W ?68,"PAGE: ",RMPAGE "RTN","RMPRPI16",63,0) W !,"Run Date: ",RMDAT,?35,"Station: ",RMSTAT,! "RTN","RMPRPI16",64,0) S RMPAGE=RMPAGE+1 "RTN","RMPRPI16",65,0) Q "RTN","RMPRPI16",66,0) ; "RTN","RMPRPI16",67,0) HEAD1 I $E(IOST)["C",($Y>(IOSL-7)) S DIR(0)="E" D ^DIR S:$D(DTOUT)!(Y=0) RMPREND=1 Q:RMPREND W @IOF D HEAD "RTN","RMPRPI16",68,0) I $E(IOST)'["C",($Y>(IOSL-6)) W @IOF D HEAD "RTN","RMPRPI16",69,0) W !,RMPR("L") "RTN","RMPRPI16",70,0) W !,"HCPCS-ITEM",?16,"PIP ITEM",?43,"IFCAP ITEM" "RTN","RMPRPI16",71,0) W !,"----------",?16,"--------",?43,"----------" "RTN","RMPRPI16",72,0) S RMPRFLG=1 "RTN","RMPRPI16",73,0) Q "RTN","RMPRPI16",74,0) ; "RTN","RMPRPI16",75,0) EXIT I $E(IOST)["C",'RMPREND W ! S DIR(0)="E" D ^DIR "RTN","RMPRPI16",76,0) ; "RTN","RMPRPI16",77,0) EXIT1 D ^%ZISC "RTN","RMPRPI16",78,0) N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPI16",79,0) K ^TMP($J) "RTN","RMPRPI16",80,0) Q "RTN","RMPRPI16",81,0) ; "RTN","RMPRPI16",82,0) NONE ; "RTN","RMPRPI16",83,0) W:$E(IOST)["C" @IOF "RTN","RMPRPI16",84,0) D HEAD "RTN","RMPRPI16",85,0) W !!,"NO DATA !!!!" "RTN","RMPRPI16",86,0) Q "RTN","RMPRPIQ4") 0^76^B77926296 "RTN","RMPRPIQ4",1,0) RMPRPIQ4 ;HCIOFO/ODJ - INVENTORY REPORT - PARAMETER DATA ENTRY ;6/16/04 07:57 "RTN","RMPRPIQ4",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIQ4",3,0) ; "RTN","RMPRPIQ4",4,0) ;RVD patch #61 - this routine is a copy of RMPR5HQ4, except, it calls "RTN","RMPRPIQ4",5,0) ; routine RMPRPIQ5 & reads the new files. "RTN","RMPRPIQ4",6,0) ; "RTN","RMPRPIQ4",7,0) ; Prompts for Station, Start date, End date, level of detail, "RTN","RMPRPIQ4",8,0) ; NPPD group, NPPD line, HCPC selections and Report Device "RTN","RMPRPIQ4",9,0) START N RMPRSDT,RMPREDT,RMPREXC,RMPRSEL,RMPRHTY,RMPRGLST,RMPRLINX "RTN","RMPRPIQ4",10,0) N RMPRI,RMPRJ,RMPRLCN,RMPRHCN,RMPR,RMPRGRPA,RMPRVISN "RTN","RMPRPIQ4",11,0) ; RMPR("STA") Station Number (ien ^DIC(4) "RTN","RMPRPIQ4",12,0) S RMPRSDT="" ; start date VM internal "RTN","RMPRPIQ4",13,0) S RMPREDT=DT ; end date VM internal "RTN","RMPRPIQ4",14,0) I '$D(RMPRDET) N RMPRDET S RMPRDET="" ; Level of detail "RTN","RMPRPIQ4",15,0) S RMPRHTY="" ; type of HCPCS selection "RTN","RMPRPIQ4",16,0) S RMPRLCN=1 ; Count for number of individual NPPD lines selected "RTN","RMPRPIQ4",17,0) S RMPRHCN=1 ; Count for number of individual HCPCs selected "RTN","RMPRPIQ4",18,0) K RMPREXC ; Exit condition from prompts (^ defined as quit) "RTN","RMPRPIQ4",19,0) K RMPRSEL ; Array of parameter selections "RTN","RMPRPIQ4",20,0) ; If this array gets too big then need to save in ^TMP "RTN","RMPRPIQ4",21,0) ; in which case queuing option will have to be removed "RTN","RMPRPIQ4",22,0) ; "RTN","RMPRPIQ4",23,0) D GRPLST(.RMPRGLST) ;set list of NPPD group codes for DIR prompt "RTN","RMPRPIQ4",24,0) D GRPARY(.RMPRGRPA) "RTN","RMPRPIQ4",25,0) D SETLIN(.RMPRLINX) ;set an indexing array for NPPD line help "RTN","RMPRPIQ4",26,0) S RMPREXC=$$STN(.RMPR,.RMPRVISN) "RTN","RMPRPIQ4",27,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",28,0) S RMPREXC=$$STDT(.RMPRSDT) ;get Start Date (fileman format) "RTN","RMPRPIQ4",29,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",30,0) S RMPREXC=$$ENDT(.RMPREDT,RMPRSDT) ;get End Date (fileman format) "RTN","RMPRPIQ4",31,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",32,0) I RMPRDET="" S RMPREXC=$$LEV(.RMPRDET) ;get Level of Detail "RTN","RMPRPIQ4",33,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",34,0) I RMPRDET="G" K RMPRSEL S RMPRSEL("*")="" G EDDEV ;NPPD group level of detail "RTN","RMPRPIQ4",35,0) I RMPRDET="L" G EDLIN ;NPPD line level of detail "RTN","RMPRPIQ4",36,0) I RMPRDET="H"!(RMPRDET="I") G EDHCPC ;HCPC or Item level of detail "RTN","RMPRPIQ4",37,0) ; "RTN","RMPRPIQ4",38,0) ; NPPD Group level of detail "RTN","RMPRPIQ4",39,0) EDGRP S RMPREXC=$$NPGRP(.RMPRSEL) "RTN","RMPRPIQ4",40,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",41,0) G EDDEV "RTN","RMPRPIQ4",42,0) ; "RTN","RMPRPIQ4",43,0) ; NPPD Line level of detail "RTN","RMPRPIQ4",44,0) EDLIN S RMPREXC=$$NPLIN(.RMPRSEL) "RTN","RMPRPIQ4",45,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",46,0) EDLINX G EDDEV "RTN","RMPRPIQ4",47,0) ; "RTN","RMPRPIQ4",48,0) ; HCPC level of detail "RTN","RMPRPIQ4",49,0) EDHCPC S RMPREXC=$$HCPCTY(.RMPRHTY) "RTN","RMPRPIQ4",50,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",51,0) I RMPRHTY="" G EDDEV "RTN","RMPRPIQ4",52,0) I RMPRHTY="A" K RMPRSEL S RMPRSEL("*")="" G EDDEV "RTN","RMPRPIQ4",53,0) I RMPRHTY="G" S RMPREXC=$$NPGRP(.RMPRSEL) G EDDEV "RTN","RMPRPIQ4",54,0) I RMPRHTY="L" S RMPREXC=$$NPLIN(.RMPRSEL) G EDDEV "RTN","RMPRPIQ4",55,0) S RMPREXC=$$HCPC(.RMPRSEL,.RMPRHCN) "RTN","RMPRPIQ4",56,0) G EDDEV "RTN","RMPRPIQ4",57,0) ; "RTN","RMPRPIQ4",58,0) ; Get device and run report or queue it "RTN","RMPRPIQ4",59,0) EDDEV S RMPREXC=$$REPDEV("") "RTN","RMPRPIQ4",60,0) I RMPREXC="^" G EDX "RTN","RMPRPIQ4",61,0) I '$D(IO("Q")) D REPORT^RMPRPIQ5 G EDX "RTN","RMPRPIQ4",62,0) K IO("Q") "RTN","RMPRPIQ4",63,0) S ZTDESC="INVENTORY REPORT",ZTRTN="REPORT^RMPRPIQ5",ZTIO=ION "RTN","RMPRPIQ4",64,0) S ZTSAVE("RMPRSDT")="" "RTN","RMPRPIQ4",65,0) S ZTSAVE("RMPREDT")="" "RTN","RMPRPIQ4",66,0) S ZTSAVE("RMPRDET")="" "RTN","RMPRPIQ4",67,0) S ZTSAVE("RMPRSEL(")="" "RTN","RMPRPIQ4",68,0) S ZTSAVE("RMPR(""STA"")")="" "RTN","RMPRPIQ4",69,0) D ^%ZTLOAD "RTN","RMPRPIQ4",70,0) W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 "RTN","RMPRPIQ4",71,0) EDX Q "RTN","RMPRPIQ4",72,0) ; "RTN","RMPRPIQ4",73,0) ; Prompt for Site/Station "RTN","RMPRPIQ4",74,0) STN(RMPR,RMPRVISN) ; "RTN","RMPRPIQ4",75,0) N X,Y,DIC,DA "RTN","RMPRPIQ4",76,0) S RMPRVISN="" "RTN","RMPRPIQ4",77,0) D DIV4^RMPRSIT ; call standard Prosthetic site look-up "RTN","RMPRPIQ4",78,0) I $D(X) S X="^" "RTN","RMPRPIQ4",79,0) E S X="" S:RMPRSITE'="" RMPRVISN=$P($G(^RMPR(669.9,RMPRSITE,"INV")),"^",2) "RTN","RMPRPIQ4",80,0) Q X "RTN","RMPRPIQ4",81,0) ; "RTN","RMPRPIQ4",82,0) ; Prompt for level of detail "RTN","RMPRPIQ4",83,0) EN1 N RMPRDET S RMPRDET="G" ;entry point NPPD Group level "RTN","RMPRPIQ4",84,0) G START "RTN","RMPRPIQ4",85,0) EN2 N RMPRDET S RMPRDET="L" ;entry point NPPD Line level "RTN","RMPRPIQ4",86,0) G START "RTN","RMPRPIQ4",87,0) EN3 N RMPRDET S RMPRDET="H" ;entry point HCPCS level "RTN","RMPRPIQ4",88,0) G START "RTN","RMPRPIQ4",89,0) EN4 N RMPRDET S RMPRDET="I" ;entry point Item level "RTN","RMPRPIQ4",90,0) G START "RTN","RMPRPIQ4",91,0) LEV(RMPRDET) ; "RTN","RMPRPIQ4",92,0) N DIR,X,Y "RTN","RMPRPIQ4",93,0) S RMPRDET=$G(RMPRDET) "RTN","RMPRPIQ4",94,0) S DIR(0)="S^G:NPPD Group;L:NPPD Line;H:HCPCS Code;I:HCPCS Item" "RTN","RMPRPIQ4",95,0) S DIR("A")="Select inventory report level of detail" "RTN","RMPRPIQ4",96,0) D ^DIR "RTN","RMPRPIQ4",97,0) I Y="",$D(DTOUT) S X="^" G LEVX "RTN","RMPRPIQ4",98,0) I Y="^"!(Y="^^") S X="^" G LEVX "RTN","RMPRPIQ4",99,0) S RMPRDET=Y "RTN","RMPRPIQ4",100,0) LEVX Q X "RTN","RMPRPIQ4",101,0) ; "RTN","RMPRPIQ4",102,0) ; Prompt for Start Date "RTN","RMPRPIQ4",103,0) STDT(RMPRSDT) ; RMPRSDT is start date in FM internal form "RTN","RMPRPIQ4",104,0) N %DT,X,Y "RTN","RMPRPIQ4",105,0) S %DT("A")="Beginning Date: " "RTN","RMPRPIQ4",106,0) S %DT(0)=-DT "RTN","RMPRPIQ4",107,0) S %DT="AEP" "RTN","RMPRPIQ4",108,0) D ^%DT "RTN","RMPRPIQ4",109,0) I Y<0 S X="^" "RTN","RMPRPIQ4",110,0) S RMPRSDT=$P(Y,".",1) "RTN","RMPRPIQ4",111,0) Q X "RTN","RMPRPIQ4",112,0) ; "RTN","RMPRPIQ4",113,0) ; Prompt for End Date "RTN","RMPRPIQ4",114,0) ENDT(RMPREDT,RMPRSDT) ; RMPREDT is end date in FM internal form "RTN","RMPRPIQ4",115,0) N %DT,X,Y "RTN","RMPRPIQ4",116,0) ENDT1 S %DT("A")="Ending Date: " "RTN","RMPRPIQ4",117,0) S %DT(0)=-DT "RTN","RMPRPIQ4",118,0) S %DT="AEP" "RTN","RMPRPIQ4",119,0) D ^%DT "RTN","RMPRPIQ4",120,0) I Y<0 S X="^" G ENDT1X "RTN","RMPRPIQ4",121,0) S RMPREDT=$P(Y,".",1) "RTN","RMPRPIQ4",122,0) I RMPREDTENDT)!(RSDT="") D Q:EOF "RTN","RMPRPIQ5",56,0) .; I INVDT="" S EOF=1 Q "RTN","RMPRPIQ5",57,0) .; I ENDT'="*",INVDT>ENDT S EOF=1 Q "RTN","RMPRPIQ5",58,0) . S OUPIEN=0 "RTN","RMPRPIQ5",59,0) . F S OUPIEN=$O(^RMPR(661.6,"XSTD",RMPRSTN,3,RSDT,OUPIEN)) Q:OUPIEN'>0 D "RTN","RMPRPIQ5",60,0) .. S S=$G(^RMPR(661.6,OUPIEN,0)) "RTN","RMPRPIQ5",61,0) .. S PATIENT=$P(S,"^",2) Q:PATIENT="" "RTN","RMPRPIQ5",62,0) .. S QTY=+$P(S,"^",5) Q:QTY<1 "RTN","RMPRPIQ5",63,0) .. S HCPC=$P(S,"^",1) Q:HCPC="" "RTN","RMPRPIQ5",64,0) .. S HCPCIEN=$O(^RMPR(661.1,"B",HCPC,0)) Q:HCPCIEN="" "RTN","RMPRPIQ5",65,0) .. S STATION=RMPRSTN Q:STATION="" "RTN","RMPRPIQ5",66,0) .. I RMPRSTN'="*",STATION'=RMPRSTN Q "RTN","RMPRPIQ5",67,0) .. Q:'$D(^TMP($J,TNAM,"Z",HCPCIEN)) "RTN","RMPRPIQ5",68,0) .. Q:$P(^TMP($J,TNAM,"Z",HCPCIEN),"^",3)=1 "RTN","RMPRPIQ5",69,0) .. S HCPCITEM=HCPC_"-"_$P(S,"^",11) "RTN","RMPRPIQ5",70,0) .. S ITEM=$P(HCPCITEM,"-",2) "RTN","RMPRPIQ5",71,0) .. S:ITEM="" ITEM="?" "RTN","RMPRPIQ5",72,0) .. S ISCOST=$P(S,"^",6) "RTN","RMPRPIQ5",73,0) ..; S COST=$$PRECOST(OUPIEN,HCPCIEN,HCPCITEM,STATION) "RTN","RMPRPIQ5",74,0) ..; I COST'="" S ISCOST=COST-ISCOST "RTN","RMPRPIQ5",75,0) ..; S:COST="" ISCOST=QTY*$P(S,"^",5) "RTN","RMPRPIQ5",76,0) .. S R11=$O(^RMPR(661.11,"C",HCPCITEM,0)) "RTN","RMPRPIQ5",77,0) .. S R11DAT=$G(^RMPR(661.11,R11,0)) "RTN","RMPRPIQ5",78,0) .. S SOURCE=$P(R11DAT,"^",5) "RTN","RMPRPIQ5",79,0) .. S STR=^TMP($J,TNAM,"Z",HCPCIEN) "RTN","RMPRPIQ5",80,0) .. S NPGRP=$P(STR,"^",1) "RTN","RMPRPIQ5",81,0) .. S NPLIN=$P(STR,"^",2) "RTN","RMPRPIQ5",82,0) .. S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN "RTN","RMPRPIQ5",83,0) .. I '$D(^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)) D Q:'+QTY "RTN","RMPRPIQ5",84,0) ... S:+QTY ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM)="" "RTN","RMPRPIQ5",85,0) ... Q "RTN","RMPRPIQ5",86,0) .. S ^TMP($J,TNAM,STATION,NPGRP,NPLIN,HCPCREF,ITEM,OUPIEN)=QTY_"^"_ISCOST_"^"_SOURCE "RTN","RMPRPIQ5",87,0) .. Q "RTN","RMPRPIQ5",88,0) . Q "RTN","RMPRPIQ5",89,0) Q "RTN","RMPRPIQ5",90,0) ; "RTN","RMPRPIQ5",91,0) ; Get total cost of item just prior to current issue "RTN","RMPRPIQ5",92,0) PRECOST(INVIEN,HCPCIEN,HCPCITEM,STATION) ; "RTN","RMPRPIQ5",93,0) N IEN,COST,STR,LOC "RTN","RMPRPIQ5",94,0) S COST="" "RTN","RMPRPIQ5",95,0) S IEN=INVIEN,RD=RMPRSDT "RTN","RMPRPIQ5",96,0) S RD=$O(^RMPR(661.9,"ASHID",RMPRSTN,HCPC,IEN,RD),-1) "RTN","RMPRPIQ5",97,0) Q:'$G(RD) S RIEN=$O(^RMPR(661.9,"ASHID",RMPRSTN,HCPC,IEN,RD,0)) "RTN","RMPRPIQ5",98,0) S STR=^RMPR(661.9,RIEN,0) "RTN","RMPRPIQ5",99,0) S COST=$P(STR,"^",9) "RTN","RMPRPIQ5",100,0) Q COST "RTN","RMPRPIQ5",101,0) ; "RTN","RMPRPIQ5",102,0) ; Get QOH for HCPC "RTN","RMPRPIQ5",103,0) CURVAL(RMPRNAM,RMPRSTN,RMPRSEL,DETAIL) ; "RTN","RMPRPIQ5",104,0) N INVIEN,STR,IEN1,IEN2,LOCN,HCPCIEN,HCDAT,NPLIN,NPGRP,ALLGRP,SELECTED "RTN","RMPRPIQ5",105,0) N S,SOURCE,STATION,QOH,COST,HCPC,HCPCREF,ITEM "RTN","RMPRPIQ5",106,0) S ALLGRP=0 S:$O(RMPRSEL(""))="*" ALLGRP=1 "RTN","RMPRPIQ5",107,0) S RH="" "RTN","RMPRPIQ5",108,0) F S RH=$O(^RMPR(661.9,"ASHID",RMPRSTN,RH)) Q:RH="" D "RTN","RMPRPIQ5",109,0) . S IEN1=0 "RTN","RMPRPIQ5",110,0) . F S IEN1=$O(^RMPR(661.9,"ASHID",RMPRSTN,RH,IEN1)) Q:'+IEN1 D "RTN","RMPRPIQ5",111,0) .. S HCPCIEN=$O(^RMPR(661.1,"B",RH,0)) Q:HCPCIEN="" "RTN","RMPRPIQ5",112,0) .. I '$D(^TMP($J,RMPRNAM,"Z",HCPCIEN)) D "RTN","RMPRPIQ5",113,0) ... S S=^RMPR(661.1,HCPCIEN,0) "RTN","RMPRPIQ5",114,0) ... S NPLIN=$P(S,"^",7) "RTN","RMPRPIQ5",115,0) ... S:NPLIN="" NPLIN="999 X" "RTN","RMPRPIQ5",116,0) ... S NPGRP=$P(NPLIN," ",1) ;group num. is 1st set of digits of new line "RTN","RMPRPIQ5",117,0) ... S STR=NPGRP "RTN","RMPRPIQ5",118,0) ... S $P(STR,"^",2)=NPLIN "RTN","RMPRPIQ5",119,0) ... S ^TMP($J,RMPRNAM,"Z",HCPCIEN)=STR "RTN","RMPRPIQ5",120,0) ... Q "RTN","RMPRPIQ5",121,0) .. E D Q:$P(S,"^",3)=1 "RTN","RMPRPIQ5",122,0) ... S S=^TMP($J,RMPRNAM,"Z",HCPCIEN) "RTN","RMPRPIQ5",123,0) ... S NPGRP=$P(S,"^",1) "RTN","RMPRPIQ5",124,0) ... S NPLIN=$P(S,"^",2) "RTN","RMPRPIQ5",125,0) ... Q "RTN","RMPRPIQ5",126,0) .. ; "RTN","RMPRPIQ5",127,0) .. ; Test if record matches selection criteria "RTN","RMPRPIQ5",128,0) .. ; (only needed if not all groups selected) "RTN","RMPRPIQ5",129,0) .. I 'ALLGRP D I 'SELECTED S $P(^TMP($J,RMPRNAM,"Z",HCPCIEN),"^",3)=1 Q "RTN","RMPRPIQ5",130,0) ... S SELECTED=0 "RTN","RMPRPIQ5",131,0) ... I '$D(RMPRSEL(NPGRP)) Q "RTN","RMPRPIQ5",132,0) ... I DETAIL="G" S SELECTED=1 Q "RTN","RMPRPIQ5",133,0) ... I $O(RMPRSEL(NPGRP,""))="*" S SELECTED=1 Q "RTN","RMPRPIQ5",134,0) ... I '$D(RMPRSEL(NPGRP,NPLIN)) Q "RTN","RMPRPIQ5",135,0) ... I DETAIL="L" S SELECTED=1 Q "RTN","RMPRPIQ5",136,0) ... I $O(RMPRSEL(NPGRP,NPLIN,""))="*" S SELECTED=1 Q "RTN","RMPRPIQ5",137,0) ... I '$D(RMPRSEL(NPGRP,NPLIN,HCPCIEN)) Q "RTN","RMPRPIQ5",138,0) ... S SELECTED=1 "RTN","RMPRPIQ5",139,0) ... Q "RTN","RMPRPIQ5",140,0) .. S RD="" "RTN","RMPRPIQ5",141,0) .. S RD=$O(^RMPR(661.9,"ASHID",RMPRSTN,RH,IEN1,RD),-1),RIEN=$O(^RMPR(661.9,"ASHID",RMPRSTN,RH,IEN1,RD,""),-1) D "RTN","RMPRPIQ5",142,0) ... Q:'$D(^RMPR(661.9,RIEN,0)) "RTN","RMPRPIQ5",143,0) ... S HCPC=RH,S=^RMPR(661.9,RIEN,0) "RTN","RMPRPIQ5",144,0) ... S QOH=+$P(S,"^",8) Q:'QOH "RTN","RMPRPIQ5",145,0) ... S COST=$P(S,"^",9) "RTN","RMPRPIQ5",146,0) ... S ITEM=IEN1 "RTN","RMPRPIQ5",147,0) ... S RS=$O(^RMPR(661.11,"C",HCPC_"-"_ITEM,0)) Q:RS="" "RTN","RMPRPIQ5",148,0) ... S SOURCE=$P($G(^RMPR(661.11,RS,0)),U,5) "RTN","RMPRPIQ5",149,0) ... S HCPCREF=HCPC,$P(HCPCREF,"/",2)=HCPCIEN "RTN","RMPRPIQ5",150,0) ... S S=$G(^TMP($J,RMPRNAM,RMPRSTN,NPGRP,NPLIN,HCPCREF,ITEM)) "RTN","RMPRPIQ5",151,0) ... I SOURCE="C" D "RTN","RMPRPIQ5",152,0) .... S $P(S,"^",9)=QOH+$P(S,"^",9) "RTN","RMPRPIQ5",153,0) .... S $P(S,"^",11)=COST+$P(S,"^",11) "RTN","RMPRPIQ5",154,0) .... Q "RTN","RMPRPIQ5",155,0) ... E D "RTN","RMPRPIQ5",156,0) .... S $P(S,"^",8)=QOH+$P(S,"^",8) "RTN","RMPRPIQ5",157,0) .... S $P(S,"^",10)=COST+$P(S,"^",10) "RTN","RMPRPIQ5",158,0) .... Q "RTN","RMPRPIQ5",159,0) ... S ^TMP($J,RMPRNAM,RMPRSTN,NPGRP,NPLIN,HCPCREF,ITEM)=S "RTN","RMPRPIQ5",160,0) ... Q "RTN","RMPRPIQ5",161,0) .. Q "RTN","RMPRPIQ5",162,0) . Q "RTN","RMPRPIQ5",163,0) Q "RTN","RMPRPIQ5",164,0) ; "RTN","RMPRPIQ5",165,0) ; return item text string given HCPC and ITEM IENs to 661.11 "RTN","RMPRPIQ5",166,0) ; if null ITEMIEN passed the just return the HCPC short name text "RTN","RMPRPIQ5",167,0) GETITEM(HCPCIEN,ITEMIEN) ; "RTN","RMPRPIQ5",168,0) N STR,ITEMTXT "RTN","RMPRPIQ5",169,0) S ITEMTXT="" "RTN","RMPRPIQ5",170,0) I ITEMIEN="" D G GETITEMX "RTN","RMPRPIQ5",171,0) . S STR=$G(^RMPR(661.1,HCPCIEN,0)) "RTN","RMPRPIQ5",172,0) . S ITEMTXT=$P(STR,"^",2) "RTN","RMPRPIQ5",173,0) . Q "RTN","RMPRPIQ5",174,0) S HCPC=$P($G(^RMPR(661.1,HCPCIEN,0)),U,1) "RTN","RMPRPIQ5",175,0) S STR=$G(^RMPR(661.11,"C",HCPC_"-"_ITEMIEN,0)) "RTN","RMPRPIQ5",176,0) I STR="" D "RTN","RMPRPIQ5",177,0) . S ITEMTXT=$P(^RMPR(661.1,HCPCIEN,0),"^",2) "RTN","RMPRPIQ5",178,0) . Q "RTN","RMPRPIQ5",179,0) E D "RTN","RMPRPIQ5",180,0) . S ITEMTXT=$P(STR,"^",1) "RTN","RMPRPIQ5",181,0) . Q "RTN","RMPRPIQ5",182,0) S:ITEMTXT="" ITEMTXT="ITEM "_ITEMIEN "RTN","RMPRPIQ5",183,0) GETITEMX Q ITEMTXT "RTN","RMPRPIQ5",184,0) ; "RTN","RMPRPIQ5",185,0) ; return NPPD line text from line code (New lines only) "RTN","RMPRPIQ5",186,0) NPLIN(CODE) ; "RTN","RMPRPIQ5",187,0) N I,S,LINTXT "RTN","RMPRPIQ5",188,0) S LINTXT="" "RTN","RMPRPIQ5",189,0) F I=1:1 S S=$P($T(DES+I^RMPRN62),";;",2) Q:$E(S,1,3)="END" D Q:LINTXT'="" "RTN","RMPRPIQ5",190,0) . I $P(S,";",1)=CODE S LINTXT=$P(S,";",2) "RTN","RMPRPIQ5",191,0) . Q "RTN","RMPRPIQ5",192,0) Q LINTXT "RTN","RMPRPIU0") 0^97^B1088258 "RTN","RMPRPIU0",1,0) RMPRPIU0 ;HINES OIFO/RVD-UTILITY ROUTINE ;9/24/02 10:52 "RTN","RMPRPIU0",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU0",3,0) ; "RTN","RMPRPIU0",4,0) ;DBIA #799 - Fileman read of file #420.5 "RTN","RMPRPIU0",5,0) ;DBIA #800 - Fileman read of file #440. "RTN","RMPRPIU0",6,0) ;DBIA #801 - Fileman read of file #441. "RTN","RMPRPIU0",7,0) ;DBIA #10035 - Fileman read of file #2. "RTN","RMPRPIU0",8,0) ;DBIA #10090 - Fileman read of file #4. "RTN","RMPRPIU0",9,0) ;DBIA #10060 - Fileman read of file #200. "RTN","RMPRPIU0",10,0) Q "RTN","RMPRPIU0",11,0) ; "RTN","RMPRPIU0",12,0) ; Return Station Name "RTN","RMPRPIU0",13,0) GETSTN(RMPRIEN) ;input IEN of file #4 "RTN","RMPRPIU0",14,0) N RMPRO "RTN","RMPRPIU0",15,0) S RMPRO=$$GET1^DIQ(4,RMPRIEN,.01) "RTN","RMPRPIU0",16,0) Q RMPRO "RTN","RMPRPIU0",17,0) ; "RTN","RMPRPIU0",18,0) ; Return Vendor Name "RTN","RMPRPIU0",19,0) GETVEN(RMPRIEN) ;input IEN of file #440 "RTN","RMPRPIU0",20,0) N RMPRO "RTN","RMPRPIU0",21,0) S RMPRO=$$GET1^DIQ(440,RMPRIEN,.01) "RTN","RMPRPIU0",22,0) Q RMPRO "RTN","RMPRPIU0",23,0) ; "RTN","RMPRPIU0",24,0) ; Return Unit of Issue "RTN","RMPRPIU0",25,0) GETUNI(RMPRIEN) ;input IEN of file #420.5 "RTN","RMPRPIU0",26,0) N RMPRO "RTN","RMPRPIU0",27,0) S RMPRO=$$GET1^DIQ(420.5,RMPRIEN,.01) "RTN","RMPRPIU0",28,0) Q RMPRO "RTN","RMPRPIU0",29,0) ; Return Item Master Short Description. "RTN","RMPRPIU0",30,0) GETITM(RMPRIEN) ;input IEN of file #441 "RTN","RMPRPIU0",31,0) N RMPRO "RTN","RMPRPIU0",32,0) S RMPRO=$$GET1^DIQ(441,RMPRIEN,.05) "RTN","RMPRPIU0",33,0) Q RMPRO "RTN","RMPRPIU0",34,0) ; Return USER Name "RTN","RMPRPIU0",35,0) GETUSR(RMPRIEN) ;input IEN of file #200 "RTN","RMPRPIU0",36,0) N RMPRO "RTN","RMPRPIU0",37,0) S RMPRO=$$GET1^DIQ(200,RMPRIEN,.01) "RTN","RMPRPIU0",38,0) Q RMPRO "RTN","RMPRPIU0",39,0) ; Return Patient Name "RTN","RMPRPIU0",40,0) GETPAT(RMPRIEN) ;input IEN of file #2 "RTN","RMPRPIU0",41,0) N RMPRO "RTN","RMPRPIU0",42,0) S RMPRO=$$GET1^DIQ(2,RMPRIEN,.01) "RTN","RMPRPIU0",43,0) Q RMPRO "RTN","RMPRPIU1") 0^63^B10935619 "RTN","RMPRPIU1",1,0) RMPRPIU1 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01 "RTN","RMPRPIU1",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU1",3,0) Q "RTN","RMPRPIU1",4,0) ; "RTN","RMPRPIU1",5,0) ; MOD - Modify a Stock 'Issue to Patient' Transaction "RTN","RMPRPIU1",6,0) ; "RTN","RMPRPIU1",7,0) ; Inputs: "RTN","RMPRPIU1",8,0) ; RMPR60 - array of data fields for 660 file record... "RTN","RMPRPIU1",9,0) ; RMPR60("IEN") must be set to the ien of 660 rec. "RTN","RMPRPIU1",10,0) ; being modified. "RTN","RMPRPIU1",11,0) ; The other elements should ONLY be set if modifying. "RTN","RMPRPIU1",12,0) ; RMPR60("IEN") - IEN of 660 record being modified "RTN","RMPRPIU1",13,0) ; RMPR60("PATIENT IEN")- Prosthetic Patient "RTN","RMPRPIU1",14,0) ; (.01 field ptr to ^RMPR(665,) "RTN","RMPRPIU1",15,0) ; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes) "RTN","RMPRPIU1",16,0) ; RMPR60("QUANTITY") - Number of items issued (fld 5) "RTN","RMPRPIU1",17,0) ; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,) "RTN","RMPRPIU1",18,0) ; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,) "RTN","RMPRPIU1",19,0) ; RMPR60("SERIAL NUM") - Serial Number (fld 9) "RTN","RMPRPIU1",20,0) ; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes) "RTN","RMPRPIU1",21,0) ; RMPR60("REMARKS") - Comments (fld 16) "RTN","RMPRPIU1",22,0) ; RMPR60("LOT NUM") - Lot number (fld 21) "RTN","RMPRPIU1",23,0) ; RMPR60("CPT MOD") - CPT modifier string (fld 4.7) "RTN","RMPRPIU1",24,0) ; RMPR60("COST") - Total value of issue (fld 14) "RTN","RMPRPIU1",25,0) ; RMPR60("CPT IEN") - field 21 ptr to ^ICPT "RTN","RMPRPIU1",26,0) ; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9 "RTN","RMPRPIU1",27,0) ; RMPR60("PAT CAT") - Patient category "RTN","RMPRPIU1",28,0) ; (fld 62 see FM set of codes) "RTN","RMPRPIU1",29,0) ; RMPR60("SPEC CAT") - fld 63 "RTN","RMPRPIU1",30,0) ; "RTN","RMPRPIU1",31,0) ; RMPR11 - array of data fields for 661.11 record "RTN","RMPRPIU1",32,0) ; If any changes then RMPR11("HCPCS"), RMPR11("ITEM") "RTN","RMPRPIU1",33,0) ; and RMPR11("DESCRIPTION") must be set, otherwise only "RTN","RMPRPIU1",34,0) ; set those fields which are being changed. "RTN","RMPRPIU1",35,0) ; RMPR11("STATION") - Station ien "RTN","RMPRPIU1",36,0) ; RMPR11("HCPCS") - HCPCS code "RTN","RMPRPIU1",37,0) ; RMPR11("ITEM") - Item number "RTN","RMPRPIU1",38,0) ; RMPR11("UNIT") - Unit (optional) "RTN","RMPRPIU1",39,0) ; RMPR11("DESCRIPTION") - Item description "RTN","RMPRPIU1",40,0) ; RMPR11("SOURCE") - V - VA, C - Commercial "RTN","RMPRPIU1",41,0) ; "RTN","RMPRPIU1",42,0) ; RMPR5 - array of data fields for 661.5 record "RTN","RMPRPIU1",43,0) ; only set if modifying stock location "RTN","RMPRPIU1",44,0) ; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,) "RTN","RMPRPIU1",45,0) ; "RTN","RMPRPIU1",46,0) MOD(RMPR60,RMPR11,RMPR5) ; "RTN","RMPRPIU1",47,0) N RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK,RMPR,RMPRQDIF,RMPRVDIF,RMPRC5 "RTN","RMPRPIU1",48,0) N RMPRC6,RMPRC60,RMPRC11,RMPRC1,RMPRC6I,RMPRC60I,RMPRC1I,RMPRIREV "RTN","RMPRPIU1",49,0) S RMPRERR=0 "RTN","RMPRPIU1",50,0) S:$D(RMPR11("STATION")) RMPR11("STATION IEN")=RMPR11("STATION") "RTN","RMPRPIU1",51,0) ; "RTN","RMPRPIU1",52,0) ; STEP 1 "RTN","RMPRPIU1",53,0) ; read in existing 660 and 661.6 recs. "RTN","RMPRPIU1",54,0) S RMPRC60("IEN")=RMPR60("IEN") "RTN","RMPRPIU1",55,0) M:$D(RMPR11) RMPRC11=RMPR11 "RTN","RMPRPIU1",56,0) S:$D(RMPR5("IEN")) RMPRC5("IEN")=RMPR5("IEN") "RTN","RMPRPIU1",57,0) S RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC11) ;660 rec "RTN","RMPRPIU1",58,0) I RMPRERR S RMPRERR=11 G MODX^RMPRPIU2 "RTN","RMPRPIU1",59,0) S RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC11,.RMPRC60I,.RMPRC1I) "RTN","RMPRPIU1",60,0) I RMPRERR S RMPRERR=11 G MODX^RMPRPIU2 "RTN","RMPRPIU1",61,0) S RMPRC6("IEN")=RMPRC60("TRANS IEN") "RTN","RMPRPIU1",62,0) S RMPRERR=$$GET^RMPRPIX6(.RMPRC6) ;661.6 rec "RTN","RMPRPIU1",63,0) I RMPRERR S RMPRERR=12 G MODX^RMPRPIU2 "RTN","RMPRPIU1",64,0) S RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I) "RTN","RMPRPIU1",65,0) I RMPRERR S RMPRERR=12 G MODX^RMPRPIU2 "RTN","RMPRPIU1",66,0) S:'$D(RMPR5("IEN")) RMPRC5("IEN")=RMPRC6I("LOCATION") "RTN","RMPRPIU1",67,0) I '$D(RMPR11("STATION IEN")) D "RTN","RMPRPIU1",68,0) . S RMPRC11("STATION")=RMPRC6I("STATION") "RTN","RMPRPIU1",69,0) . S RMPRC11("STATION IEN")=RMPRC6I("STATION") "RTN","RMPRPIU1",70,0) . Q "RTN","RMPRPIU1",71,0) S:'$D(RMPR11("HCPCS")) RMPRC11("HCPCS")=RMPRC6I("HCPCS") "RTN","RMPRPIU1",72,0) S:'$D(RMPR11("ITEM")) RMPRC11("ITEM")=RMPRC6I("ITEM") "RTN","RMPRPIU1",73,0) S RMPRC60("VENDOR IEN")=$S('$D(RMPR60("VENDOR IEN")):RMPRC6I("VENDOR"),1:RMPR60("VENDOR IEN")) "RTN","RMPRPIU1",74,0) S RMPRQDIF="" "RTN","RMPRPIU1",75,0) I $D(RMPR60("QUANTITY")) S RMPRQDIF=RMPR60("QUANTITY")-RMPRC60I("QUANTITY") "RTN","RMPRPIU1",76,0) S RMPRVDIF="" "RTN","RMPRPIU1",77,0) I $D(RMPR60("COST")) S RMPRVDIF=RMPR60("COST")-RMPRC60I("COST") "RTN","RMPRPIU1",78,0) ; "RTN","RMPRPIU1",79,0) ; STEP 2 "RTN","RMPRPIU1",80,0) ; if HCPCS, Item, Location, Vendor, Quanity or Cost has changed "RTN","RMPRPIU1",81,0) ; then need to go to the complex update rules at MOD3 "RTN","RMPRPIU1",82,0) ; otherwise just update the 660 "RTN","RMPRPIU1",83,0) S RMPRIREV=1 ;set if HCPCS, Item, Vendor or Location modified "RTN","RMPRPIU1",84,0) I RMPRC6I("HCPCS")'=RMPRC11("HCPCS") G MOD3 "RTN","RMPRPIU1",85,0) I RMPRC6I("ITEM")'=RMPRC11("ITEM") G MOD3 "RTN","RMPRPIU1",86,0) I RMPRC6I("VENDOR")'=RMPRC60("VENDOR IEN") G MOD3 "RTN","RMPRPIU1",87,0) I RMPRC6I("LOCATION")'=RMPRC5("IEN") G MOD3 "RTN","RMPRPIU1",88,0) S RMPRIREV=0 ;only qty. or cost may have changed "RTN","RMPRPIU1",89,0) I +RMPRQDIF G MOD3 "RTN","RMPRPIU1",90,0) I +RMPRVDIF G MOD3 "RTN","RMPRPIU1",91,0) ; "RTN","RMPRPIU1",92,0) ; if we get here just update 660 and exit "RTN","RMPRPIU1",93,0) S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11) "RTN","RMPRPIU1",94,0) G MODX^RMPRPIU2 "RTN","RMPRPIU1",95,0) ; "RTN","RMPRPIU1",96,0) ; if we get here then update is complex "RTN","RMPRPIU1",97,0) MOD3 G MOD3^RMPRPIU2 "RTN","RMPRPIU1",98,0) ; "RTN","RMPRPIU1",99,0) ; REVI - bring back Issue transaction into stock "RTN","RMPRPIU1",100,0) REVI(RMPRC6I) ; "RTN","RMPRPIU1",101,0) Q $$REVI^RMPRPIU2(.RMPRC6I) "RTN","RMPRPIU2") 0^64^B42102092 "RTN","RMPRPIU2",1,0) RMPRPIU2 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT UPDATE UILITY ;3/8/01 "RTN","RMPRPIU2",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU2",3,0) Q "RTN","RMPRPIU2",4,0) ; "RTN","RMPRPIU2",5,0) ; Continuation of RMPRPIU1 "RTN","RMPRPIU2",6,0) ; "RTN","RMPRPIU2",7,0) ; if we get here then update is complex "RTN","RMPRPIU2",8,0) ; "RTN","RMPRPIU2",9,0) MOD3 L +^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM")) "RTN","RMPRPIU2",10,0) S RMPRERR=0 "RTN","RMPRPIU2",11,0) ; "RTN","RMPRPIU2",12,0) ; Get current stock on hand and return error = 9 if not enough "RTN","RMPRPIU2",13,0) S RMPRCSTK("STATION IEN")=RMPRC11("STATION IEN") "RTN","RMPRPIU2",14,0) S RMPRCSTK("HCPCS")=RMPRC11("HCPCS") "RTN","RMPRPIU2",15,0) S RMPRCSTK("ITEM")=RMPRC11("ITEM") "RTN","RMPRPIU2",16,0) S RMPRCSTK("LOCATION IEN")=RMPRC5("IEN") "RTN","RMPRPIU2",17,0) S RMPRCSTK("VENDOR IEN")=RMPRC60("VENDOR IEN") "RTN","RMPRPIU2",18,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK) "RTN","RMPRPIU2",19,0) I RMPRERR S RMPRERR=21 G MODU "RTN","RMPRPIU2",20,0) ; "RTN","RMPRPIU2",21,0) ; if Location, HCPCS, Item or Vendor modified and the modified quantity "RTN","RMPRPIU2",22,0) ; is more than the original then set error if insufficient current stock "RTN","RMPRPIU2",23,0) I RMPRIREV D "RTN","RMPRPIU2",24,0) . I RMPRQDIF'="",RMPR60("QUANTITY")>RMPRCSTK("QOH") D Q "RTN","RMPRPIU2",25,0) .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") "RTN","RMPRPIU2",26,0) .. Q "RTN","RMPRPIU2",27,0) . I RMPRC60I("QUANTITY")>RMPRCSTK("QOH") D Q "RTN","RMPRPIU2",28,0) .. S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") "RTN","RMPRPIU2",29,0) . Q "RTN","RMPRPIU2",30,0) ; "RTN","RMPRPIU2",31,0) ; if just modifying quantity then check the difference "RTN","RMPRPIU2",32,0) E D "RTN","RMPRPIU2",33,0) . I +RMPRQDIF>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") "RTN","RMPRPIU2",34,0) . Q "RTN","RMPRPIU2",35,0) ;I RMPRERR G MODU "RTN","RMPRPIU2",36,0) ; "RTN","RMPRPIU2",37,0) ; If Location, HCPCS, Item or Vendor modified bring back the "RTN","RMPRPIU2",38,0) ; stock for these values prior to modification and then reduce "RTN","RMPRPIU2",39,0) ; stock for the modified values "RTN","RMPRPIU2",40,0) I RMPRIREV D "RTN","RMPRPIU2",41,0) . ; "RTN","RMPRPIU2",42,0) . ; 1st bring back stock for original transaction "RTN","RMPRPIU2",43,0) . S RMPRERR=$$REVI(.RMPRC6I) "RTN","RMPRPIU2",44,0) . ; "RTN","RMPRPIU2",45,0) . ; 2nd reduce stock for modified transaction "RTN","RMPRPIU2",46,0) . ; 661.7 - current stock "RTN","RMPRPIU2",47,0) . K RMPR "RTN","RMPRPIU2",48,0) . S RMPR("STATION IEN")=RMPRC11("STATION IEN") "RTN","RMPRPIU2",49,0) . S RMPR("LOCATION IEN")=RMPRC5("IEN") "RTN","RMPRPIU2",50,0) . S RMPR("HCPCS")=RMPRC11("HCPCS") "RTN","RMPRPIU2",51,0) . S RMPR("ITEM")=RMPRC11("ITEM") "RTN","RMPRPIU2",52,0) . S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN") "RTN","RMPRPIU2",53,0) . S RMPR("ISSUED QTY")=$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY")) "RTN","RMPRPIU2",54,0) . S RMPR("ISSUED VALUE")=$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST")) "RTN","RMPRPIU2",55,0) . S RMPRERR=$$FIFO^RMPRPIUF(.RMPR) "RTN","RMPRPIU2",56,0) . ; "RTN","RMPRPIU2",57,0) . ; 3rd update running balance 661.9 "RTN","RMPRPIU2",58,0) . K RMPR "RTN","RMPRPIU2",59,0) . S RMPR("STA")=RMPRC11("STATION IEN") "RTN","RMPRPIU2",60,0) . S RMPR("HCP")=RMPRC11("HCPCS") "RTN","RMPRPIU2",61,0) . S RMPR("ITE")=RMPRC11("ITEM") "RTN","RMPRPIU2",62,0) . S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1) "RTN","RMPRPIU2",63,0) . S RMPR("TQTY")=0-$S(RMPRQDIF'="":RMPR60("QUANTITY"),1:RMPRC60I("QUANTITY")) "RTN","RMPRPIU2",64,0) . S RMPR("TCST")=0-$S(RMPRVDIF'="":RMPR60("COST"),1:RMPRC60I("COST")) "RTN","RMPRPIU2",65,0) . S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR) "RTN","RMPRPIU2",66,0) . Q "RTN","RMPRPIU2",67,0) ; "RTN","RMPRPIU2",68,0) ; otherwise just adjust stock "RTN","RMPRPIU2",69,0) E D "RTN","RMPRPIU2",70,0) . I RMPRQDIF<0 D Q "RTN","RMPRPIU2",71,0) .. S RMPRC6I("QUANTITY")=0-RMPRQDIF "RTN","RMPRPIU2",72,0) .. S RMPRC6I("VALUE")=0-RMPRVDIF "RTN","RMPRPIU2",73,0) .. S RMPRERR=$$REVI(.RMPRC6I) "RTN","RMPRPIU2",74,0) .. Q "RTN","RMPRPIU2",75,0) . I RMPRQDIF>0 D Q "RTN","RMPRPIU2",76,0) .. K RMPR "RTN","RMPRPIU2",77,0) .. S RMPR("STATION IEN")=RMPRC11("STATION IEN") "RTN","RMPRPIU2",78,0) .. S RMPR("LOCATION IEN")=RMPRC5("IEN") "RTN","RMPRPIU2",79,0) .. S RMPR("HCPCS")=RMPRC11("HCPCS") "RTN","RMPRPIU2",80,0) .. S RMPR("ITEM")=RMPRC11("ITEM") "RTN","RMPRPIU2",81,0) .. S RMPR("VENDOR IEN")=RMPRC60("VENDOR IEN") "RTN","RMPRPIU2",82,0) .. S RMPR("ISSUED QTY")=+RMPRQDIF "RTN","RMPRPIU2",83,0) .. S RMPR("ISSUED VALUE")=+RMPRVDIF "RTN","RMPRPIU2",84,0) .. S RMPRERR=$$FIFO^RMPRPIUF(.RMPR) "RTN","RMPRPIU2",85,0) .. K RMPR "RTN","RMPRPIU2",86,0) .. S RMPR("STA")=RMPRC11("STATION IEN") "RTN","RMPRPIU2",87,0) .. S RMPR("HCP")=RMPRC11("HCPCS") "RTN","RMPRPIU2",88,0) .. S RMPR("ITE")=RMPRC11("ITEM") "RTN","RMPRPIU2",89,0) .. S RMPR("RDT")=$P(RMPRC6I("DATE&TIME"),".",1) "RTN","RMPRPIU2",90,0) .. S RMPR("TQTY")=0-RMPRQDIF "RTN","RMPRPIU2",91,0) .. S RMPR("TCST")=0-RMPRVDIF "RTN","RMPRPIU2",92,0) .. S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR) "RTN","RMPRPIU2",93,0) .. Q "RTN","RMPRPIU2",94,0) . Q "RTN","RMPRPIU2",95,0) ; "RTN","RMPRPIU2",96,0) ; Update 661.6 "RTN","RMPRPIU2",97,0) K RMPR "RTN","RMPRPIU2",98,0) S RMPR("IEN")=RMPRC6I("IEN") "RTN","RMPRPIU2",99,0) S:$D(RMPR60("QUANTITY")) RMPR("QUANTITY")=RMPR60("QUANTITY") "RTN","RMPRPIU2",100,0) S:$D(RMPR60("COST")) RMPR("VALUE")=RMPR60("COST") "RTN","RMPRPIU2",101,0) S RMPRERR=$$UPD^RMPRPIX6(.RMPR,.RMPR11) "RTN","RMPRPIU2",102,0) I RMPRERR G MODU "RTN","RMPRPIU2",103,0) ; "RTN","RMPRPIU2",104,0) ; Update 660 "RTN","RMPRPIU2",105,0) S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11) "RTN","RMPRPIU2",106,0) ; "RTN","RMPRPIU2",107,0) ; exit "RTN","RMPRPIU2",108,0) MODU L -^RMPR(661.7,"XSLHIDS",RMPRC11("STATION IEN"),RMPRC5("IEN"),RMPRC11("HCPCS"),RMPRC11("ITEM")) "RTN","RMPRPIU2",109,0) MODX Q RMPRERR "RTN","RMPRPIU2",110,0) ; "RTN","RMPRPIU2",111,0) ; REVI - bring back Issue transaction into stock "RTN","RMPRPIU2",112,0) REVI(RMPRC6I) ; "RTN","RMPRPIU2",113,0) N RMPR,RMPROLD,RMPREOF,RMPRERR,RMPR7,RMPR7I,RMPRI,RMPR6,RMPR6I,RMPR9 "RTN","RMPRPIU2",114,0) S RMPRERR=0 "RTN","RMPRPIU2",115,0) S RMPR("STATION")=RMPRC6I("STATION") "RTN","RMPRPIU2",116,0) S RMPR("HCPCS")=RMPRC6I("HCPCS") "RTN","RMPRPIU2",117,0) S RMPR("ITEM")=RMPRC6I("ITEM") "RTN","RMPRPIU2",118,0) S RMPR("LOCATION")=RMPRC6I("LOCATION") "RTN","RMPRPIU2",119,0) L +^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM")) "RTN","RMPRPIU2",120,0) REVIA S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIU2",121,0) I RMPRERR S RMPRERR=11 G REVIX "RTN","RMPRPIU2",122,0) I RMPREOF G REVIC "RTN","RMPRPIU2",123,0) I RMPR("STATION")'=RMPRC6I("STATION") G REVIC "RTN","RMPRPIU2",124,0) I RMPR("HCPCS")'=RMPRC6I("HCPCS") G REVIC "RTN","RMPRPIU2",125,0) I RMPR("ITEM")'=RMPRC6I("ITEM") G REVIC "RTN","RMPRPIU2",126,0) I RMPR("DATE&TIME")'=$G(RMPRC6I("DATE&TIME")) G REVIC "RTN","RMPRPIU2",127,0) I RMPR("LOCATION")'=RMPRC6I("LOCATION") G REVIC "RTN","RMPRPIU2",128,0) K RMPR7 "RTN","RMPRPIU2",129,0) S RMPR7("IEN")=RMPR("IEN") "RTN","RMPRPIU2",130,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIU2",131,0) I RMPRERR S RMPRERR=11 G REVIX "RTN","RMPRPIU2",132,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIU2",133,0) I RMPRERR S RMPRERR=11 G REVIX ;error 11 - problem with 661.7 "RTN","RMPRPIU2",134,0) I '$D(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"))) G REVIA "RTN","RMPRPIU2",135,0) S RMPRI="" "RTN","RMPRPIU2",136,0) REVIB S RMPRI=$O(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI)) "RTN","RMPRPIU2",137,0) I RMPRI="" G REVIA "RTN","RMPRPIU2",138,0) K RMPR6 "RTN","RMPRPIU2",139,0) S RMPR6("IEN")=RMPRI "RTN","RMPRPIU2",140,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIU2",141,0) I RMPRERR S RMPRERR=21 G REVIX "RTN","RMPRPIU2",142,0) S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) "RTN","RMPRPIU2",143,0) I RMPRERR S RMPRERR=21 G REVIX ;error 21 - problem with 661.6 "RTN","RMPRPIU2",144,0) I RMPR6I("VENDOR")'=RMPRC6I("VENDOR") G REVIB "RTN","RMPRPIU2",145,0) ; "RTN","RMPRPIU2",146,0) ; Update the current stock record "RTN","RMPRPIU2",147,0) K RMPR "RTN","RMPRPIU2",148,0) S RMPR("QUANTITY")=RMPR7I("QUANTITY")+RMPRC6I("QUANTITY") "RTN","RMPRPIU2",149,0) S RMPR("VALUE")=RMPR7I("VALUE")+RMPRC6I("VALUE") "RTN","RMPRPIU2",150,0) S RMPR("IEN")=RMPR7I("IEN") "RTN","RMPRPIU2",151,0) S RMPRERR=$$UPD^RMPRPIX7(.RMPR,) "RTN","RMPRPIU2",152,0) I RMPRERR S RMPRERR=31 G REVIX ;error 31 - problem with 661.7 "RTN","RMPRPIU2",153,0) G REVID ;now update 661.9 and exit "RTN","RMPRPIU2",154,0) ; "RTN","RMPRPIU2",155,0) ; If we get here there was no current stock record to update "RTN","RMPRPIU2",156,0) ; so create one. "RTN","RMPRPIU2",157,0) REVIC K RMPR,RMPR7 "RTN","RMPRPIU2",158,0) S RMPR("STATION")=RMPRC6I("STATION") "RTN","RMPRPIU2",159,0) S RMPR("HCPCS")=RMPRC6I("HCPCS") "RTN","RMPRPIU2",160,0) S RMPR("ITEM")=RMPRC6I("ITEM") "RTN","RMPRPIU2",161,0) S RMPR7("DATE&TIME")=$G(RMPRC6I("DATE&TIME")) "RTN","RMPRPIU2",162,0) S RMPR7("SEQUENCE")=RMPRC6I("SEQUENCE") "RTN","RMPRPIU2",163,0) S RMPR7("LOCATION")=RMPRC6I("LOCATION") "RTN","RMPRPIU2",164,0) S RMPR7("QUANTITY")=RMPRC6I("QUANTITY") "RTN","RMPRPIU2",165,0) S RMPR7("VALUE")=RMPRC6I("VALUE") "RTN","RMPRPIU2",166,0) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR) "RTN","RMPRPIU2",167,0) I RMPRERR S RMPRERR=31 G REVIX "RTN","RMPRPIU2",168,0) ; "RTN","RMPRPIU2",169,0) ; Update 661.9 'running balance file' and exit "RTN","RMPRPIU2",170,0) REVID S RMPR9("STA")=RMPRC6I("STATION") "RTN","RMPRPIU2",171,0) S RMPR9("HCP")=RMPRC6I("HCPCS") "RTN","RMPRPIU2",172,0) S RMPR9("ITE")=RMPRC6I("ITEM") "RTN","RMPRPIU2",173,0) S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1) "RTN","RMPRPIU2",174,0) S RMPR9("TQTY")=RMPRC6I("QUANTITY") "RTN","RMPRPIU2",175,0) S RMPR9("TCST")=RMPRC6I("VALUE") "RTN","RMPRPIU2",176,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 41 - problem with 661.9 "RTN","RMPRPIU2",177,0) I RMPRERR S RMPRERR=41 G REVIX "RTN","RMPRPIU2",178,0) REVIX L -^RMPR(661.7,"XSLHIDS",RMPRC6I("STATION"),RMPRC6I("LOCATION"),RMPRC6I("HCPCS"),RMPRC6I("ITEM")) "RTN","RMPRPIU2",179,0) Q RMPRERR "RTN","RMPRPIU3") 0^78^B22550640 "RTN","RMPRPIU3",1,0) RMPRPIU3 ;HINCIO/ODJ - PIP STOCK ISSUE TO PATIENT DELETE UILITY ;3/8/01 "RTN","RMPRPIU3",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU3",3,0) Q "RTN","RMPRPIU3",4,0) ; "RTN","RMPRPIU3",5,0) ; DEL - Delete a Stock 'Issue to Patient' Transaction "RTN","RMPRPIU3",6,0) ; Deletes the 2319 record in file 660 "RTN","RMPRPIU3",7,0) ; the patient issue record in 661.63 "RTN","RMPRPIU3",8,0) ; Creates a type 8 'Return In' transaction "RTN","RMPRPIU3",9,0) ; Brings back issue quantity into stock "RTN","RMPRPIU3",10,0) ; Updates running balance "RTN","RMPRPIU3",11,0) ; "RTN","RMPRPIU3",12,0) ; Inputs: "RTN","RMPRPIU3",13,0) ; RMPR60 - array of data fields for 660 file record... "RTN","RMPRPIU3",14,0) ; RMPR60("IEN") must be set to the ien of 660 rec. "RTN","RMPRPIU3",15,0) ; being deleted. "RTN","RMPRPIU3",16,0) ; RMPR60("IEN") - IEN of 660 record being deleted "RTN","RMPRPIU3",17,0) ; "RTN","RMPRPIU3",18,0) ; Outputs: "RTN","RMPRPIU3",19,0) ; RMPRERR - 0 - no problems "RTN","RMPRPIU3",20,0) ; 11 - problem reading 660 rec. to delete "RTN","RMPRPIU3",21,0) ; 12 - problem reading 661.6 rec. to delete "RTN","RMPRPIU3",22,0) ; 29 - problem with 660 rec. delete "RTN","RMPRPIU3",23,0) ; 39 - problem with 661.6,661.63 rec. delete "RTN","RMPRPIU3",24,0) ; 49 - problem with 661.6 return rec. creation "RTN","RMPRPIU3",25,0) ; 59 - problem with bringing back into stock "RTN","RMPRPIU3",26,0) ; "RTN","RMPRPIU3",27,0) DEL(RMPR60) ; "RTN","RMPRPIU3",28,0) N RMPRERR,RMPRC60,RMPRC60I,RMPRC1,RMPRC1I,RMPRC6,RMPRC6I "RTN","RMPRPIU3",29,0) N RMPRC5,RMPRC11,RMPRRET,RMPR7R "RTN","RMPRPIU3",30,0) S RMPRERR=0 "RTN","RMPRPIU3",31,0) ; "RTN","RMPRPIU3",32,0) ; STEP 1 "RTN","RMPRPIU3",33,0) ; read in existing 660 and 661.6 recs. "RTN","RMPRPIU3",34,0) S RMPRC60("IEN")=RMPR60("IEN") "RTN","RMPRPIU3",35,0) S RMPRERR=$$GET^RMPRPIX2(.RMPRC60,.RMPRC1) ;read in current 660 rec "RTN","RMPRPIU3",36,0) I RMPRERR S RMPRERR=11 G DELX "RTN","RMPRPIU3",37,0) S RMPRERR=$$ETOI^RMPRPIX2(.RMPRC60,.RMPRC1,.RMPRC60I,.RMPRC1I) "RTN","RMPRPIU3",38,0) I RMPRERR S RMPRERR=11 G DELX "RTN","RMPRPIU3",39,0) S RMPRC6("IEN")=RMPRC60("TRANS IEN") "RTN","RMPRPIU3",40,0) S RMPRERR=$$GET^RMPRPIX6(.RMPRC6) ;read in current 661.6 rec "RTN","RMPRPIU3",41,0) I RMPRERR S RMPRERR=12 G DELX "RTN","RMPRPIU3",42,0) S RMPRERR=$$ETOI^RMPRPIX6(.RMPRC6,.RMPRC6I) "RTN","RMPRPIU3",43,0) I RMPRERR S RMPRERR=12 G DELX "RTN","RMPRPIU3",44,0) S RMPRC5("IEN")=RMPRC6I("LOCATION") "RTN","RMPRPIU3",45,0) S RMPRC11("STATION")=RMPRC6I("STATION") "RTN","RMPRPIU3",46,0) S RMPRC11("STATION IEN")=RMPRC6I("STATION") "RTN","RMPRPIU3",47,0) S RMPRC11("HCPCS")=RMPRC6I("HCPCS") "RTN","RMPRPIU3",48,0) S RMPRC11("ITEM")=RMPRC6I("ITEM") "RTN","RMPRPIU3",49,0) S RMST1=RMPRC6I("STATION"),RMHC1=RMPRC6I("HCPCS") "RTN","RMPRPIU3",50,0) S RMLO1=RMPRC6I("LOCATION"),RMIT1=RMPRC6I("ITEM") "RTN","RMPRPIU3",51,0) ; "RTN","RMPRPIU3",52,0) ; STEP 2 "RTN","RMPRPIU3",53,0) ; Delete the 660 record "RTN","RMPRPIU3",54,0) S RMPRERR=$$DEL^RMPRPIX2(.RMPR60) "RTN","RMPRPIU3",55,0) I RMPRERR S RMPRERR=29 G DELX ;err 29 if 660 delete problem "RTN","RMPRPIU3",56,0) ; "RTN","RMPRPIU3",57,0) ; STEP 3 "RTN","RMPRPIU3",58,0) ; get 661.63 information "RTN","RMPRPIU3",59,0) K RMDTTIM "RTN","RMPRPIU3",60,0) S RM6613I=$O(^RMPR(661.63,"B",RMPRC6("IEN"),0)) "RTN","RMPRPIU3",61,0) I $G(RM6613I),$D(^RMPR(661.63,RM6613I,0)) D "RTN","RMPRPIU3",62,0) .S RM63DAT=$G(^RMPR(661.63,RM6613I,0)) "RTN","RMPRPIU3",63,0) .S RMDTTIM=$P(RM63DAT,U,6) "RTN","RMPRPIU3",64,0) .Q:'$G(RMDTTIM) "RTN","RMPRPIU3",65,0) .S RMPRRET("DATE&TIME")=RMDTTIM "RTN","RMPRPIU3",66,0) .S RMPRRET("QUANTITY")=$P(RM63DAT,U,12) "RTN","RMPRPIU3",67,0) .S RMPRRET("VALUE")=$P(RM63DAT,U,10) "RTN","RMPRPIU3",68,0) .S RMPRRET("UNIT")=$P(RM63DAT,U,11) "RTN","RMPRPIU3",69,0) .S RMPRRET("VENDOR")=$P(RM63DAT,U,9) "RTN","RMPRPIU3",70,0) .S RMPRRET("LOCATION")=$P(RM63DAT,U,8) "RTN","RMPRPIU3",71,0) ; Delete 661.63 Patient Issue record "RTN","RMPRPIU3",72,0) S RMPRERR=$$DEL^RMPRPIX3(.RMPRC6) "RTN","RMPRPIU3",73,0) I RMPRERR S RMPRERR=39 "RTN","RMPRPIU3",74,0) ; "RTN","RMPRPIU3",75,0) ; STEP 4 "RTN","RMPRPIU3",76,0) ; Create a Return to Stock Record "RTN","RMPRPIU3",77,0) S RMPRRET("SEQUENCE")=1 "RTN","RMPRPIU3",78,0) S RMPRRET("TRAN TYPE")=8 "RTN","RMPRPIU3",79,0) S RMPRRET("COMMENT")="" "RTN","RMPRPIU3",80,0) S RMPRRET("USER")=$G(DUZ) "RTN","RMPRPIU3",81,0) I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPRC60I("QUANTITY") "RTN","RMPRPIU3",82,0) I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=$G(RMPRC60I("COST")) "RTN","RMPRPIU3",83,0) I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=$G(RMPRC60I("UNIT")) "RTN","RMPRPIU3",84,0) I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=$G(RMPRC60I("VENDOR")) "RTN","RMPRPIU3",85,0) I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMPRC5("IEN")) "RTN","RMPRPIU3",86,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPRC11) "RTN","RMPRPIU3",87,0) I RMPRERR S RMPRERR=49 "RTN","RMPRPIU3",88,0) ; "RTN","RMPRPIU3",89,0) ; STEP 5 "RTN","RMPRPIU3",90,0) ; Bring back into current stock "RTN","RMPRPIU3",91,0) D NOW^%DTC "RTN","RMPRPIU3",92,0) S RMPR7R("STATION")=RMPRC11("STATION") "RTN","RMPRPIU3",93,0) S RMPR7R("HCPCS")=RMPRC11("HCPCS") "RTN","RMPRPIU3",94,0) S RMPR7R("ITEM")=RMPRC11("ITEM") "RTN","RMPRPIU3",95,0) S RMPR7R("LOCATION")=RMPRC5("IEN") "RTN","RMPRPIU3",96,0) S RMPR7R("VENDOR")=RMPRRET("VENDOR") "RTN","RMPRPIU3",97,0) S RMPR7R("DATE&TIME")=% "RTN","RMPRPIU3",98,0) S RMPR7R("SEQUENCE")=RMPRRET("SEQUENCE") "RTN","RMPRPIU3",99,0) S RMPR7R("QUANTITY")=RMPRRET("QUANTITY") "RTN","RMPRPIU3",100,0) S RMPR7R("VALUE")=RMPRRET("VALUE") "RTN","RMPRPIU3",101,0) S RMPR7R("UNIT")=$G(RMPRRET("UNIT")) "RTN","RMPRPIU3",102,0) I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71 "RTN","RMPRPIU3",103,0) .S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0)) "RTN","RMPRPIU3",104,0) .I '$G(RMPR7R("IEN")) S RMPRERR=1 Q "RTN","RMPRPIU3",105,0) .S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0)) "RTN","RMPRPIU3",106,0) .S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7) "RTN","RMPRPIU3",107,0) .S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA "RTN","RMPRPIU3",108,0) .S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL "RTN","RMPRPIU3",109,0) .S RMPRERR=0 "RTN","RMPRPIU3",110,0) .S RMPR7R("DATE&TIME")=RMDTTIM "RTN","RMPRPIU3",111,0) .S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPRC11) "RTN","RMPRPIU3",112,0) I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=72 "RTN","RMPRPIU3",113,0) .S RMPRERR=0 "RTN","RMPRPIU3",114,0) .S RMPR7R("DATE&TIME")=RMDTTIM "RTN","RMPRPIU3",115,0) .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11) "RTN","RMPRPIU3",116,0) I '$G(RMDTTIM) D I RMPRERR S RMPRERR=73 "RTN","RMPRPIU3",117,0) .;create an entry "RTN","RMPRPIU3",118,0) .S RMPRERR=0 "RTN","RMPRPIU3",119,0) .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPRC11) "RTN","RMPRPIU3",120,0) ;update 661.9 "RTN","RMPRPIU3",121,0) S RMPR9("STA")=RMPRC6I("STATION") "RTN","RMPRPIU3",122,0) S RMPR9("HCP")=RMPRC6I("HCPCS") "RTN","RMPRPIU3",123,0) S RMPR9("ITE")=RMPRC6I("ITEM") "RTN","RMPRPIU3",124,0) S RMPR9("RDT")=$P(RMPRC6I("DATE&TIME"),".",1) "RTN","RMPRPIU3",125,0) S RMPR9("TQTY")=RMPRC6I("QUANTITY") "RTN","RMPRPIU3",126,0) S RMPR9("TCST")=RMPRC6I("VALUE") "RTN","RMPRPIU3",127,0) S RMPRERR=0 "RTN","RMPRPIU3",128,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) "RTN","RMPRPIU3",129,0) I RMPRERR S RMPRERR=59 "RTN","RMPRPIU3",130,0) ; "RTN","RMPRPIU3",131,0) ;exit "RTN","RMPRPIU3",132,0) DELX Q RMPRERR "RTN","RMPRPIU4") 0^88^B3104025 "RTN","RMPRPIU4",1,0) RMPRPIU4 ;HINCIO/ODJ - APIS ;3/8/01 "RTN","RMPRPIU4",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU4",3,0) Q "RTN","RMPRPIU4",4,0) ; Count number of issues "RTN","RMPRPIU4",5,0) ; "RTN","RMPRPIU4",6,0) ; Item level "RTN","RMPRPIU4",7,0) ISNI(RMPRSTN,RMPRL,RMPRH,RMPRI,RMPRSDT,RMPREDT,RMPROUP) ; "RTN","RMPRPIU4",8,0) N RMPR6,X,X1,X2,RMPRD,RMPRS,RMPRIEN,RMPR6I "RTN","RMPRPIU4",9,0) S RMPROUP("QUANTITY")=0 "RTN","RMPRPIU4",10,0) S RMPROUP("VALUE")=0 "RTN","RMPRPIU4",11,0) I $G(RMPREDT)="" D NOW^%DTC S RMPREDT=X ;end date def=today "RTN","RMPRPIU4",12,0) I $G(RMPRSDT)="" D ;start date def=365 days ago "RTN","RMPRPIU4",13,0) . S X1=RMPREDT,X2=-365 D C^%DTC "RTN","RMPRPIU4",14,0) . S RMPRSDT=X "RTN","RMPRPIU4",15,0) . Q "RTN","RMPRPIU4",16,0) S RMPRD=RMPRSDT "RTN","RMPRPIU4",17,0) F S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD)) Q:RMPRD=""!($P(RMPRD,".",1)>RMPREDT) D "RTN","RMPRPIU4",18,0) . S RMPRS="" "RTN","RMPRPIU4",19,0) . F S RMPRS=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS)) Q:RMPRS="" D "RTN","RMPRPIU4",20,0) .. S RMPRIEN="" "RTN","RMPRPIU4",21,0) .. F S RMPRIEN=$O(^RMPR(661.6,"ASTHIDS",RMPRSTN,3,RMPRH,RMPRI,RMPRD,RMPRS,RMPRIEN)) Q:RMPRIEN="" D "RTN","RMPRPIU4",22,0) ... K RMPR6 "RTN","RMPRPIU4",23,0) ... S RMPR6("IEN")=RMPRIEN "RTN","RMPRPIU4",24,0) ... S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIU4",25,0) ... S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) "RTN","RMPRPIU4",26,0) ... I RMPRL'=RMPR6I("LOCATION") Q "RTN","RMPRPIU4",27,0) ... S RMPROUP("QUANTITY")=RMPR6("QUANTITY")+RMPROUP("QUANTITY") "RTN","RMPRPIU4",28,0) ... S RMPROUP("VALUE")=RMPR6("VALUE")+RMPROUP("VALUE") "RTN","RMPRPIU4",29,0) ... Q "RTN","RMPRPIU4",30,0) .. Q "RTN","RMPRPIU4",31,0) . Q "RTN","RMPRPIU4",32,0) Q "RTN","RMPRPIU6") 0^15^B17282265 "RTN","RMPRPIU6",1,0) RMPRPIU6 ;HINCIO/ODJ - PIP STOCK ISSUE UPDATE UTILITY ;3/8/01 "RTN","RMPRPIU6",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU6",3,0) Q "RTN","RMPRPIU6",4,0) ; "RTN","RMPRPIU6",5,0) ;***** ISS - Create a Stock 'Issue to Patient' Transaction "RTN","RMPRPIU6",6,0) ; implements business rules for stock issue "RTN","RMPRPIU6",7,0) ; "RTN","RMPRPIU6",8,0) ; Inputs: "RTN","RMPRPIU6",9,0) ; RMPR60 - array of data fields for 660 file record... "RTN","RMPRPIU6",10,0) ; (all elements are required unless otherwise indicated) "RTN","RMPRPIU6",11,0) ; RMPR60("PATIENT IEN")- Prosthetic Patient "RTN","RMPRPIU6",12,0) ; (.01 field ptr to ^RMPR(665,) "RTN","RMPRPIU6",13,0) ; RMPR60("ISSUE TYPE") - Type of Issue (fld 2 - see FM set of codes) "RTN","RMPRPIU6",14,0) ; RMPR60("QUANTITY") - Number of items issued (fld 5) "RTN","RMPRPIU6",15,0) ; RMPR60("IFCAP ITEM") - IFCAP item (fld 4 ptr to ^RMPR(661,) "RTN","RMPRPIU6",16,0) ; RMPR60("VENDOR IEN") - Item Vendor (fld 7 ptr to ^PRC(440,) "RTN","RMPRPIU6",17,0) ; RMPR60("SERIAL NUM") - Serial Number (fld 9) "RTN","RMPRPIU6",18,0) ; (optional) "RTN","RMPRPIU6",19,0) ; RMPR60("REQ TYPE") - Request Type (fld 11 - see FM set of codes) "RTN","RMPRPIU6",20,0) ; (optional but will be set to 11 if not input) "RTN","RMPRPIU6",21,0) ; RMPR60("REMARKS") - Comments (fld 16) "RTN","RMPRPIU6",22,0) ; (optional) "RTN","RMPRPIU6",23,0) ; RMPR60("LOT NUM") - Lot number (fld 21) "RTN","RMPRPIU6",24,0) ; (optional) "RTN","RMPRPIU6",25,0) ; RMPR60("CPT MOD") - CPT modifier string (fld 4.7) "RTN","RMPRPIU6",26,0) ; (optional) "RTN","RMPRPIU6",27,0) ; RMPR60("COST") - Total value of issue (fld 14) "RTN","RMPRPIU6",28,0) ; RMPR60("CPT IEN") - field 21 ptr to ^ICPT "RTN","RMPRPIU6",29,0) ; RMPR60("SITE IEN") - ptr to prosthetic site param file 669.9 "RTN","RMPRPIU6",30,0) ; RMPR60("USER") - User creating the issue "RTN","RMPRPIU6",31,0) ; (fld 27 ptr to ^VA(200,) "RTN","RMPRPIU6",32,0) ; RMPR60("PAT CAT") - Patient category "RTN","RMPRPIU6",33,0) ; (fld 62 see FM set of codes) "RTN","RMPRPIU6",34,0) ; RMPR60("SPEC CAT") - fld 63 "RTN","RMPRPIU6",35,0) ; (optional) "RTN","RMPRPIU6",36,0) ; RMPR60("GROUPER") - AMIS grouper number "RTN","RMPRPIU6",37,0) ; RMPR60("DATE&TIME") - date and time item received "RTN","RMPRPIU6",38,0) ; "RTN","RMPRPIU6",39,0) ; RMPR11 - array of data fields for 661.11 record "RTN","RMPRPIU6",40,0) ; RMPR11("STATION") - Station ien "RTN","RMPRPIU6",41,0) ; RMPR11("HCPCS") - HCPCS code "RTN","RMPRPIU6",42,0) ; RMPR11("ITEM") - Item number "RTN","RMPRPIU6",43,0) ; RMPR11("UNIT") - Unit (optional) "RTN","RMPRPIU6",44,0) ; RMPR11("DESCRIPTION") - Item description "RTN","RMPRPIU6",45,0) ; RMPR11("SOURCE") - V - VA, C - Commercial "RTN","RMPRPIU6",46,0) ; "RTN","RMPRPIU6",47,0) ; RMPR5 - array of data fields for 661.5 record "RTN","RMPRPIU6",48,0) ; RMPR5("IEN") - Location ien (ptr to ^RMPR(661.5,) "RTN","RMPRPIU6",49,0) ; "RTN","RMPRPIU6",50,0) ; Outputs: "RTN","RMPRPIU6",51,0) ; RMPRERR - returned by function "RTN","RMPRPIU6",52,0) ; 0 - no problems "RTN","RMPRPIU6",53,0) ; 9 - insufficient stock to issue "RTN","RMPRPIU6",54,0) ; 10 - PIP item is locked "RTN","RMPRPIU6",55,0) ; "RTN","RMPRPIU6",56,0) ISS(RMPR60,RMPR11,RMPR5) ; "RTN","RMPRPIU6",57,0) N RMPRERR,RMPR6,RMPR9,RMPR1,RMPRCSTK "RTN","RMPRPIU6",58,0) S RMPRERR=0 "RTN","RMPRPIU6",59,0) S RMPR11("STATION IEN")=RMPR11("STATION") "RTN","RMPRPIU6",60,0) ; "RTN","RMPRPIU6",61,0) ; Lock Current Stock file (661.7) at Station, Location, HCPCS, Item "RTN","RMPRPIU6",62,0) ; level so that same item at same location cannot be depleted "RTN","RMPRPIU6",63,0) ; simultaneously. "RTN","RMPRPIU6",64,0) L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")):1 "RTN","RMPRPIU6",65,0) I $T=0 W !,?5,$C(7),"Someone else is Accessing the PIP item!",! S RMPRERR=10 G ISSX "RTN","RMPRPIU6",66,0) ; "RTN","RMPRPIU6",67,0) ; Check stock level for entered Station, Location, HCPCS, Item "RTN","RMPRPIU6",68,0) ; and Vendor. Return error=9 if not enough stock. "RTN","RMPRPIU6",69,0) S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIU6",70,0) S RMPRCSTK("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIU6",71,0) S RMPRCSTK("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIU6",72,0) S RMPRCSTK("ITEM")=RMPR11("ITEM") "RTN","RMPRPIU6",73,0) S RMPRCSTK("VENDOR IEN")=RMPR60("VENDOR IEN") "RTN","RMPRPIU6",74,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK) "RTN","RMPRPIU6",75,0) I RMPRERR S RMPRERR=90 G ISSU "RTN","RMPRPIU6",76,0) S RMPRCSTK("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR60("DATE&TIME"),1,0)) "RTN","RMPRPIU6",77,0) I RMPR60("QUANTITY")>RMPRCSTK("QOH") S RMPRERR=9,RMPR60("QOH")=RMPRCSTK("QOH") G ISSU "RTN","RMPRPIU6",78,0) ; "RTN","RMPRPIU6",79,0) ; Create 661.6 - inventory transaction record - stock issue to patient "RTN","RMPRPIU6",80,0) S RMPR6("COMMENT")=$G(RMPR6("COMMENT")) "RTN","RMPRPIU6",81,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIU6",82,0) S RMPR6("TRAN TYPE")=3 "RTN","RMPRPIU6",83,0) S RMPR6("LOCATION")=RMPR5("IEN") "RTN","RMPRPIU6",84,0) S RMPR6("USER")=RMPR60("USER") "RTN","RMPRPIU6",85,0) S RMPR6("QUANTITY")=RMPR60("QUANTITY") "RTN","RMPRPIU6",86,0) S RMPR6("VALUE")=RMPR60("COST") "RTN","RMPRPIU6",87,0) S RMPR6("VENDOR")=RMPR60("VENDOR IEN") "RTN","RMPRPIU6",88,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIU6",89,0) I RMPRERR S RMPRERR=91 G ISSU "RTN","RMPRPIU6",90,0) ; "RTN","RMPRPIU6",91,0) ; Create 660 record - patient 2319 - record of appliances, etc. "RTN","RMPRPIU6",92,0) S RMPR60("COST")=$J(RMPR60("COST"),0,2) "RTN","RMPRPIU6",93,0) S RMPR60("TRANS IEN")=RMPR6("IEN") "RTN","RMPRPIU6",94,0) S RMPR60("ENTRY DATE")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIU6",95,0) S RMPR60("REQ DATE")=RMPR60("ENTRY DATE") "RTN","RMPRPIU6",96,0) S RMPR60("DELIV DATE")=RMPR60("DELIV DATE") "RTN","RMPRPIU6",97,0) I $G(RMPR60("REQ TYPE"))="" S RMPR60("REQ TYPE")=11 "RTN","RMPRPIU6",98,0) S RMPRERR=$$CRE^RMPRPIX2(.RMPR60,.RMPR11) "RTN","RMPRPIU6",99,0) I RMPRERR S RMPRERR=92 G ISSU "RTN","RMPRPIU6",100,0) ; "RTN","RMPRPIU6",101,0) ; Create 661.63 record "RTN","RMPRPIU6",102,0) S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11) "RTN","RMPRPIU6",103,0) I RMPRERR S RMPRERR=93 G ISSU "RTN","RMPRPIU6",104,0) ; "RTN","RMPRPIU6",105,0) ; Update 661.7 record "RTN","RMPRPIU6",106,0) S RMPR7("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIU6",107,0) S RMPR7("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIU6",108,0) S RMPR7("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIU6",109,0) S RMPR7("ITEM")=RMPR11("ITEM") "RTN","RMPRPIU6",110,0) S RMPR7("ISSUED QTY")=RMPR60("QUANTITY") "RTN","RMPRPIU6",111,0) S RMPR7("ISSUED VALUE")=RMPR60("COST") "RTN","RMPRPIU6",112,0) S RMPR7("DATE&TIME")=RMPR60("DATE&TIME") "RTN","RMPRPIU6",113,0) S RMPR7("IEN")=RMPRCSTK("IEN") "RTN","RMPRPIU6",114,0) S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7) "RTN","RMPRPIU6",115,0) I RMPRERR S RMPRERR=94 G ISSU "RTN","RMPRPIU6",116,0) ; "RTN","RMPRPIU6",117,0) ; Update 661.9 record "RTN","RMPRPIU6",118,0) S RMPR9("STA")=RMPR11("STATION IEN") "RTN","RMPRPIU6",119,0) S RMPR9("HCP")=RMPR11("HCPCS") "RTN","RMPRPIU6",120,0) S RMPR9("ITE")=RMPR11("ITEM") "RTN","RMPRPIU6",121,0) S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIU6",122,0) S RMPR9("TQTY")=0-RMPR6("QUANTITY") "RTN","RMPRPIU6",123,0) S RMPR9("TCST")=0-RMPR6("VALUE") "RTN","RMPRPIU6",124,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) "RTN","RMPRPIU6",125,0) I RMPRERR S RMPRERR=95 G ISSU "RTN","RMPRPIU6",126,0) ; "RTN","RMPRPIU6",127,0) ;***** release lock on current stock and exit "RTN","RMPRPIU6",128,0) ISSU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU6",129,0) ISSX Q RMPRERR "RTN","RMPRPIU7") 0^16^B8094985 "RTN","RMPRPIU7",1,0) RMPRPIU7 ;HINCIO/ODJ - PIP STOCK RECEIPT UPDATE UTILITY ;3/8/01 "RTN","RMPRPIU7",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU7",3,0) Q "RTN","RMPRPIU7",4,0) ; "RTN","RMPRPIU7",5,0) ;***** REC - Create a Stock Receipt Transaction "RTN","RMPRPIU7",6,0) ; implements business rules for Stock Receipt "RTN","RMPRPIU7",7,0) ; called by RMPRPIY9 "RTN","RMPRPIU7",8,0) ; "RTN","RMPRPIU7",9,0) ; Inputs: "RTN","RMPRPIU7",10,0) ; RMPR6 - Transaction (661.6) array elements "RTN","RMPRPIU7",11,0) ; RMPR6("VENDOR") - Vendor ien "RTN","RMPRPIU7",12,0) ; RMPR6("QUANTITY") - Receipt quantity "RTN","RMPRPIU7",13,0) ; RMPR6("VALUE") - Total $ value of received quantity "RTN","RMPRPIU7",14,0) ; RMPR6("COMMENT") - (optional) comment "RTN","RMPRPIU7",15,0) ; "RTN","RMPRPIU7",16,0) ; RMPR11 - HCPCS Item (661.11) array elements "RTN","RMPRPIU7",17,0) ; RMPR11("STATION IEN") "RTN","RMPRPIU7",18,0) ; RMPR11("HCPCS") "RTN","RMPRPIU7",19,0) ; RMPR11("ITEM") "RTN","RMPRPIU7",20,0) ; "RTN","RMPRPIU7",21,0) ; RMPR5 - Location (661.5) array elements "RTN","RMPRPIU7",22,0) ; RMPR5("IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIU7",23,0) ; "RTN","RMPRPIU7",24,0) ; RMPR4 "RTN","RMPRPIU7",25,0) ; "RTN","RMPRPIU7",26,0) ; Outputs: "RTN","RMPRPIU7",27,0) ; RMPR6("IEN") "RTN","RMPRPIU7",28,0) ; RMPR4("IEN") "RTN","RMPRPIU7",29,0) ; RMPRERR "RTN","RMPRPIU7",30,0) ; "RTN","RMPRPIU7",31,0) REC(RMPR6,RMPR11,RMPR5) ; "RTN","RMPRPIU7",32,0) N RMPRERR,RMPR6I,RMPR7,RMPR9 "RTN","RMPRPIU7",33,0) S RMPRERR=0 "RTN","RMPRPIU7",34,0) S RMPR6("COMMENT")=$G(RMPR6("COMMENT")) "RTN","RMPRPIU7",35,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIU7",36,0) S RMPR6("TRAN TYPE")=1 "RTN","RMPRPIU7",37,0) S RMPR6("LOCATION")=$G(RMPR5("IEN")) "RTN","RMPRPIU7",38,0) S RMPR6("HCPCS")=$G(RMPR11("HCPCS")) "RTN","RMPRPIU7",39,0) S RMPR6("ITEM")=$G(RMPR11("ITEM")) "RTN","RMPRPIU7",40,0) S RMPR6("USER")=$G(DUZ) "RTN","RMPRPIU7",41,0) I RMPR6("QUANTITY")=0 G RECX "RTN","RMPRPIU7",42,0) ; "RTN","RMPRPIU7",43,0) ; Lock current stock to prevent simultaneous access at HCPCS Item level "RTN","RMPRPIU7",44,0) L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU7",45,0) ; "RTN","RMPRPIU7",46,0) ; Create 661.6 Transaction record "RTN","RMPRPIU7",47,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIU7",48,0) I RMPRERR S RMPRERR=19 G RECU ;error 19 problem with 661.6 create "RTN","RMPRPIU7",49,0) ; "RTN","RMPRPIU7",50,0) ; Create 661.7 Current Stock record "RTN","RMPRPIU7",51,0) S RMPR7("DATE&TIME")=RMPR6("DATE&TIME") "RTN","RMPRPIU7",52,0) S RMPR7("SEQUENCE")=RMPR6("SEQUENCE") "RTN","RMPRPIU7",53,0) S RMPR7("QUANTITY")=RMPR6("QUANTITY") "RTN","RMPRPIU7",54,0) S RMPR7("VALUE")=RMPR6("VALUE") "RTN","RMPRPIU7",55,0) S RMPR7("LOCATION")=RMPR6("LOCATION") "RTN","RMPRPIU7",56,0) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR11) "RTN","RMPRPIU7",57,0) I RMPRERR S RMPRERR=29 G RECU ;error 29 problem with 661.7 create "RTN","RMPRPIU7",58,0) ; "RTN","RMPRPIU7",59,0) ; Update 661.9 Daily Running Balance record "RTN","RMPRPIU7",60,0) S RMPR9("STA")=RMPR11("STATION") "RTN","RMPRPIU7",61,0) S RMPR9("HCP")=RMPR11("HCPCS") "RTN","RMPRPIU7",62,0) S RMPR9("ITE")=RMPR11("ITEM") "RTN","RMPRPIU7",63,0) S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIU7",64,0) S RMPR9("TQTY")=RMPR6("QUANTITY") "RTN","RMPRPIU7",65,0) S RMPR9("TCST")=RMPR6("VALUE") "RTN","RMPRPIU7",66,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) ;error 49 problem with 661.9 update "RTN","RMPRPIU7",67,0) I RMPRERR S RMPRERR=49 G RECU ;error 49 problem with 661.9 update "RTN","RMPRPIU7",68,0) ; "RTN","RMPRPIU7",69,0) ; Update 661.41 orders record "RTN","RMPRPIU7",70,0) S RMPRERR=$$UPORD^RMPRPIU8(RMPR11("STATION IEN"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("QUANTITY"),RMPR6("VENDOR")) "RTN","RMPRPIU7",71,0) I RMPRERR S RMPRERR=59 G RECU ;error 59 problem with Orders update "RTN","RMPRPIU7",72,0) ; "RTN","RMPRPIU7",73,0) ; Exit points "RTN","RMPRPIU7",74,0) RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU7",75,0) RECX Q RMPRERR "RTN","RMPRPIU8") 0^17^B24703676 "RTN","RMPRPIU8",1,0) RMPRPIU8 ;HINCIO/ODJ - PIP STOCK RECEIPT UPDATE UTILITY ;3/8/01 "RTN","RMPRPIU8",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU8",3,0) Q "RTN","RMPRPIU8",4,0) ; "RTN","RMPRPIU8",5,0) ;***** REC - Create a Stock Receipt Transaction for existing item "RTN","RMPRPIU8",6,0) ; Implements business rules for creating a receipt "RTN","RMPRPIU8",7,0) ; of an existing PIP HCPCS Item. "RTN","RMPRPIU8",8,0) ; called by RMPRPIYG,RMPRPIY6 "RTN","RMPRPIU8",9,0) ; "RTN","RMPRPIU8",10,0) ; Inputs: "RTN","RMPRPIU8",11,0) ; RMPR6 - Transaction (661.6) array elements "RTN","RMPRPIU8",12,0) ; RMPR6("VENDOR") - Vendor ien "RTN","RMPRPIU8",13,0) ; RMPR6("QUANTITY") - Receipt Quantity "RTN","RMPRPIU8",14,0) ; RMPR6("VALUE") - Total $ value of received qty. "RTN","RMPRPIU8",15,0) ; RMPR6("COMMENT") - (optional) comment "RTN","RMPRPIU8",16,0) ; "RTN","RMPRPIU8",17,0) ; RMPR11 - HCPCS Item (661.11) array elements "RTN","RMPRPIU8",18,0) ; RMPR11("STATION") - Station ien "RTN","RMPRPIU8",19,0) ; RMPR11("HCPCS") - HCPCS code "RTN","RMPRPIU8",20,0) ; RMPR11("ITEM") - HCPCS Item number "RTN","RMPRPIU8",21,0) ; "RTN","RMPRPIU8",22,0) ; RMPR5 - Location (661.5) array elements... "RTN","RMPRPIU8",23,0) ; RMPR5("IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIU8",24,0) ; "RTN","RMPRPIU8",25,0) ; RMPRUPO - flag true=> update, false=> dont update orders "RTN","RMPRPIU8",26,0) ; RMPR41 - array for orders "RTN","RMPRPIU8",27,0) ; "RTN","RMPRPIU8",28,0) ; Outputs: "RTN","RMPRPIU8",29,0) ; RMPRERR - returned by function "RTN","RMPRPIU8",30,0) ; 0 - no errors "RTN","RMPRPIU8",31,0) ; 19 - problem creating 661.6 rec. "RTN","RMPRPIU8",32,0) ; 29 - problem creating 661.7 rec. "RTN","RMPRPIU8",33,0) ; 39 - problem creating 661.9 rec. "RTN","RMPRPIU8",34,0) ; 49 - problem updating 661.41 orders "RTN","RMPRPIU8",35,0) ; "RTN","RMPRPIU8",36,0) REC(RMPR6,RMPR11,RMPR5,RMPRUPO,RMPR41) ; "RTN","RMPRPIU8",37,0) N RMPRERR,RMPR6I,RMPRDIEN,RMPR7,RMPR9,RMPR41N,RMPRTOD,X "RTN","RMPRPIU8",38,0) S RMPRERR=0 "RTN","RMPRPIU8",39,0) D NOW^%DTC S RMPRTOD=X ;today's date "RTN","RMPRPIU8",40,0) ; "RTN","RMPRPIU8",41,0) ; Lock current stock to prevent simultaneous access at HCPCS Item level "RTN","RMPRPIU8",42,0) L +^RMPR(661.7,"XSHIDS",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU8",43,0) ; "RTN","RMPRPIU8",44,0) ; init. data elements for 661.6 transaction rec. "RTN","RMPRPIU8",45,0) S RMPR6("COMMENT")=$G(RMPR6("COMMENT")) "RTN","RMPRPIU8",46,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIU8",47,0) S RMPR6("TRAN TYPE")=1 ;receipt "RTN","RMPRPIU8",48,0) S RMPR6("LOCATION")=RMPR5("IEN") "RTN","RMPRPIU8",49,0) S RMPR6("USER")=$G(DUZ) "RTN","RMPRPIU8",50,0) S RMPR6("DATE&TIME")="" "RTN","RMPRPIU8",51,0) I RMPR6("QUANTITY")=0 G RECU "RTN","RMPRPIU8",52,0) ; "RTN","RMPRPIU8",53,0) ; Create 661.6 transaction rec. "RTN","RMPRPIU8",54,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIU8",55,0) I RMPRERR S RMPRERR=19 G RECU ;error 19 problem with 661.6 "RTN","RMPRPIU8",56,0) ; "RTN","RMPRPIU8",57,0) ; Update 661.7 current stock rec. "RTN","RMPRPIU8",58,0) S RMPR7("DATE&TIME")=RMPR6("DATE&TIME") "RTN","RMPRPIU8",59,0) S RMPR7("SEQUENCE")=RMPR6("SEQUENCE") "RTN","RMPRPIU8",60,0) S RMPR7("QUANTITY")=RMPR6("QUANTITY") "RTN","RMPRPIU8",61,0) S RMPR7("VALUE")=RMPR6("VALUE") "RTN","RMPRPIU8",62,0) S RMPR7("UNIT")=RMPR6("UNIT") "RTN","RMPRPIU8",63,0) S RMPR7("LOCATION")=RMPR6("LOCATION") "RTN","RMPRPIU8",64,0) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7,.RMPR11) "RTN","RMPRPIU8",65,0) I RMPRERR S RMPRERR=29 G RECU ;error 29 problem with 661.7 create "RTN","RMPRPIU8",66,0) ; "RTN","RMPRPIU8",67,0) ; Update 661.9 daily running balance record "RTN","RMPRPIU8",68,0) S RMPR9("STA")=RMPR11("STATION") "RTN","RMPRPIU8",69,0) S RMPR9("HCP")=RMPR11("HCPCS") "RTN","RMPRPIU8",70,0) S RMPR9("ITE")=RMPR11("ITEM") "RTN","RMPRPIU8",71,0) S RMPR9("RDT")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIU8",72,0) S RMPR9("TQTY")=RMPR6("QUANTITY") "RTN","RMPRPIU8",73,0) S RMPR9("TCST")=RMPR6("VALUE") "RTN","RMPRPIU8",74,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9) "RTN","RMPRPIU8",75,0) I RMPRERR S RMPRERR=39 G RECU ;error 39 problem with 661.9 "RTN","RMPRPIU8",76,0) ; "RTN","RMPRPIU8",77,0) ; Update the orders file "RTN","RMPRPIU8",78,0) I RMPRUPO,+$G(RMPR41("IEN")) D "RTN","RMPRPIU8",79,0) . I RMPR6("QUANTITY")'RMPRQ D "RTN","RMPRPIU8",132,0) ... S RMPR41U("IEN")=RMPR41("IEN") "RTN","RMPRPIU8",133,0) ... S RMPR41U("RECEIVE QTY")=RMPR41("ORDER QTY") "RTN","RMPRPIU8",134,0) ... S RMPR41U("STATUS")="R" ;set status to received "RTN","RMPRPIU8",135,0) ... S RMPR41U("DATE RECEIVE")=RMPRTOD ;set receive date to today "RTN","RMPRPIU8",136,0) ... S RMPRQ=RMPRQ-RMPR41("BALANCE QTY") "RTN","RMPRPIU8",137,0) ... S RMPRERR=$$UPD^RMPRPIXN(.RMPR41U,) ;update order "RTN","RMPRPIU8",138,0) ... Q "RTN","RMPRPIU8",139,0) .. ; "RTN","RMPRPIU8",140,0) .. ; balance more than receipt balance so just add to received qty. "RTN","RMPRPIU8",141,0) .. E D "RTN","RMPRPIU8",142,0) ... S RMPR41U("IEN")=RMPR41("IEN") "RTN","RMPRPIU8",143,0) ... S RMPR41U("RECEIVE QTY")=RMPR41("RECEIVE QTY")+RMPRQ "RTN","RMPRPIU8",144,0) ... S RMPR41U("DATE RECEIVE")=RMPRTOD ;set receive date to today "RTN","RMPRPIU8",145,0) ... S RMPRERR=$$UPD^RMPRPIXN(.RMPR41U,) ;update order "RTN","RMPRPIU8",146,0) ... S RMPRQ=0 "RTN","RMPRPIU8",147,0) ... Q "RTN","RMPRPIU8",148,0) .. Q "RTN","RMPRPIU8",149,0) . Q "RTN","RMPRPIU8",150,0) I RMPRERR S RMPRERR=99 ; problem occurred "RTN","RMPRPIU8",151,0) UPORDX Q RMPRERR "RTN","RMPRPIU9") 0^18^B20353682 "RTN","RMPRPIU9",1,0) RMPRPIU9 ;HINCIO/ODJ - PIP STOCK RECONCILE UPDATE UTILITY;3/8/01 "RTN","RMPRPIU9",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIU9",3,0) Q "RTN","RMPRPIU9",4,0) ; "RTN","RMPRPIU9",5,0) ;***** REC - Create a Stock Reconciliation Transaction "RTN","RMPRPIU9",6,0) ; "RTN","RMPRPIU9",7,0) ; Inputs: "RTN","RMPRPIU9",8,0) ; RMPR6 - "RTN","RMPRPIU9",9,0) ; RMPR11 - "RTN","RMPRPIU9",10,0) ; RMPR5 - "RTN","RMPRPIU9",11,0) ; "RTN","RMPRPIU9",12,0) ; Outputs: "RTN","RMPRPIU9",13,0) ; RMPRERR - "RTN","RMPRPIU9",14,0) ; "RTN","RMPRPIU9",15,0) REC(RMPR6,RMPR11,RMPR5) ; "RTN","RMPRPIU9",16,0) N RMPRERR,RMPRCSTK,RMPRQGL,RMPRVGL,RMPRD,RMPRT,RMPR,RMPRUCST "RTN","RMPRPIU9",17,0) S RMPRERR=0 "RTN","RMPRPIU9",18,0) ; "RTN","RMPRPIU9",19,0) ; Lock the current stock 661.7 file at HCPCS Item level as we may be "RTN","RMPRPIU9",20,0) ; reducing or increasing the quantity on hand "RTN","RMPRPIU9",21,0) L +^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU9",22,0) ; "RTN","RMPRPIU9",23,0) ; Get current quantity on hand "RTN","RMPRPIU9",24,0) S RMPRCSTK("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIU9",25,0) S RMPRCSTK("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIU9",26,0) S RMPRCSTK("ITEM")=RMPR11("ITEM") "RTN","RMPRPIU9",27,0) S RMPRCSTK("UNIT")=$G(RMPR11("UNIT")) "RTN","RMPRPIU9",28,0) S RMPRCSTK("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIU9",29,0) S RMPRCSTK("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIU9",30,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPRCSTK) "RTN","RMPRPIU9",31,0) I RMPRERR S RMPRERR=11 G RECU ;error 11 - problem getting current qoh "RTN","RMPRPIU9",32,0) S RMPRQGL=RMPR6("QUANTITY")-RMPRCSTK("QOH") ;gain/loss "RTN","RMPRPIU9",33,0) S RMPRUCST="" "RTN","RMPRPIU9",34,0) I $G(RMPR6("NEW UNIT COST"))'="" S RMPRUCST=RMPR6("NEW UNIT COST") "RTN","RMPRPIU9",35,0) ; "RTN","RMPRPIU9",36,0) ; If not showing any quantity on hand then use the unit cost "RTN","RMPRPIU9",37,0) ; of the most recent receipt or reconciliation transaction "RTN","RMPRPIU9",38,0) I RMPRUCST="",RMPRCSTK("QOH")=0 D "RTN","RMPRPIU9",39,0) . F RMPRT=3,9 D Q:RMPRERR!(RMPRD'="") "RTN","RMPRPIU9",40,0) .. S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),""),-1) "RTN","RMPRPIU9",41,0) .. Q:RMPRD="" "RTN","RMPRPIU9",42,0) .. K RMPR "RTN","RMPRPIU9",43,0) .. S RMPR("IEN")=$QS($Q(^RMPR(661.6,"ASTHIDS",RMPR11("STATION IEN"),RMPRT,RMPR11("HCPCS"),RMPR11("ITEM"),RMPRD)),9) "RTN","RMPRPIU9",44,0) .. S RMPRERR=$$GET^RMPRPIX6(.RMPR) "RTN","RMPRPIU9",45,0) .. Q:RMPRERR "RTN","RMPRPIU9",46,0) .. S:+RMPR("QUANTITY") RMPRUCST=RMPR("VALUE")/RMPR("QUANTITY") "RTN","RMPRPIU9",47,0) .. Q "RTN","RMPRPIU9",48,0) . Q "RTN","RMPRPIU9",49,0) E D "RTN","RMPRPIU9",50,0) . S:RMPRUCST="" RMPRUCST=RMPRCSTK("UNIT COST") "RTN","RMPRPIU9",51,0) . Q "RTN","RMPRPIU9",52,0) I RMPRUCST="" D "RTN","RMPRPIU9",53,0) . S RMPRUCST=0 "RTN","RMPRPIU9",54,0) . I +RMPR6("QUANTITY"),+$G(RMPR6("VALUE")) D "RTN","RMPRPIU9",55,0) .. S RMPRUCST=RMPR6("VALUE")/RMPR6("QUANTITY") "RTN","RMPRPIU9",56,0) .. Q "RTN","RMPRPIU9",57,0) . Q "RTN","RMPRPIU9",58,0) I RMPRERR S RMPRERR=12 G RECU ;error 12 problem with cost "RTN","RMPRPIU9",59,0) ; "RTN","RMPRPIU9",60,0) ; calculate the gain/loss for value "RTN","RMPRPIU9",61,0) S RMPRVGL=$J(RMPRQGL*RMPRUCST,0,2) "RTN","RMPRPIU9",62,0) ; "RTN","RMPRPIU9",63,0) ; Create a 661.6 Reconciliation Transaction record "RTN","RMPRPIU9",64,0) S RMPR6("COMMENT")=$G(RMPR6("COMMENT")) "RTN","RMPRPIU9",65,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIU9",66,0) S RMPR6("TRAN TYPE")=9 "RTN","RMPRPIU9",67,0) S RMPR6("LOCATION")=RMPR5("IEN") "RTN","RMPRPIU9",68,0) S RMPR6("USER")=$G(DUZ) "RTN","RMPRPIU9",69,0) S RMPR6("VENDOR")=RMPR6("VENDOR IEN") "RTN","RMPRPIU9",70,0) S RMPR6("VALUE")=$J(RMPR6("QUANTITY")*RMPRUCST,0,2) "RTN","RMPRPIU9",71,0) K RMPR6("IEN") "RTN","RMPRPIU9",72,0) S RMPR11("STATION")=RMPR11("STATION IEN") "RTN","RMPRPIU9",73,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIU9",74,0) I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.6 "RTN","RMPRPIU9",75,0) ; "RTN","RMPRPIU9",76,0) ; Create 661.69 Gain/Loss record "RTN","RMPRPIU9",77,0) K RMPR "RTN","RMPRPIU9",78,0) S RMPR("TRANS IEN")=RMPR6("IEN") "RTN","RMPRPIU9",79,0) S RMPR("GAIN/LOSS")=RMPRQGL "RTN","RMPRPIU9",80,0) S RMPR("GAIN/LOSS VALUE")=RMPRVGL "RTN","RMPRPIU9",81,0) S RMPRERR=$$CRE^RMPRPIXB(.RMPR) "RTN","RMPRPIU9",82,0) I RMPRERR S RMPRERR=61 G RECU ;error 61 if problem with 661.69 "RTN","RMPRPIU9",83,0) ; "RTN","RMPRPIU9",84,0) ; Adjust stock for gain/loss "RTN","RMPRPIU9",85,0) I RMPRQGL=0 G RECU ;no gain loss so just exit "RTN","RMPRPIU9",86,0) I RMPRQGL>0 G RECGN ;adjust for stock gain "RTN","RMPRPIU9",87,0) ; "RTN","RMPRPIU9",88,0) ; Adjust for stock loss "RTN","RMPRPIU9",89,0) RECLS K RMPR "RTN","RMPRPIU9",90,0) S RMPR("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIU9",91,0) S RMPR("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIU9",92,0) S RMPR("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIU9",93,0) S RMPR("ITEM")=RMPR11("ITEM") "RTN","RMPRPIU9",94,0) S RMPR("UNIT")=$G(RMPR11("UNIT")) "RTN","RMPRPIU9",95,0) S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIU9",96,0) S RMPR("ISSUED QTY")=0-RMPRQGL "RTN","RMPRPIU9",97,0) S RMPR("ISSUED VALUE")=0-RMPRVGL "RTN","RMPRPIU9",98,0) S RMPRERR=$$FIFO^RMPRPIUF(.RMPR) "RTN","RMPRPIU9",99,0) I RMPRERR S RMPRERR=71 G RECU ;error 71 problem with adjusting "RTN","RMPRPIU9",100,0) K RMPR "RTN","RMPRPIU9",101,0) S RMPR("STA")=RMPR11("STATION IEN") "RTN","RMPRPIU9",102,0) S RMPR("HCP")=RMPR11("HCPCS") "RTN","RMPRPIU9",103,0) S RMPR("ITE")=RMPR11("ITEM") "RTN","RMPRPIU9",104,0) S RMPR("RDT")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIU9",105,0) S RMPR("TQTY")=RMPRQGL "RTN","RMPRPIU9",106,0) S RMPR("TCST")=RMPRVGL "RTN","RMPRPIU9",107,0) S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR) "RTN","RMPRPIU9",108,0) I RMPRERR S RMPRERR=71 "RTN","RMPRPIU9",109,0) G RECU "RTN","RMPRPIU9",110,0) ; "RTN","RMPRPIU9",111,0) ; Adjust for stock gain "RTN","RMPRPIU9",112,0) RECGN K RMPR "RTN","RMPRPIU9",113,0) S RMPR("STATION")=RMPR11("STATION IEN") "RTN","RMPRPIU9",114,0) S RMPR("LOCATION")=RMPR5("IEN") "RTN","RMPRPIU9",115,0) S RMPR("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIU9",116,0) S RMPR("ITEM")=RMPR11("ITEM") "RTN","RMPRPIU9",117,0) S RMPR("UNIT")=$G(RMPR11("UNIT")) "RTN","RMPRPIU9",118,0) S RMPR("VENDOR")=RMPR6("VENDOR IEN") "RTN","RMPRPIU9",119,0) S RMPR("QUANTITY")=RMPRQGL "RTN","RMPRPIU9",120,0) S RMPR("VALUE")=RMPRVGL "RTN","RMPRPIU9",121,0) S RMPR("DATE&TIME")=$G(RMPR6("DATE&TIME")) "RTN","RMPRPIU9",122,0) S RMPR("SEQUENCE")=RMPR6("SEQUENCE") "RTN","RMPRPIU9",123,0) S RMPRERR=$$REVI^RMPRPIU1(.RMPR) "RTN","RMPRPIU9",124,0) I RMPRERR S RMPRERR=71 "RTN","RMPRPIU9",125,0) G RECU "RTN","RMPRPIU9",126,0) ; "RTN","RMPRPIU9",127,0) ; exit points "RTN","RMPRPIU9",128,0) RECU L -^RMPR(661.7,"XSLHIDS",RMPR11("STATION IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIU9",129,0) RECX Q RMPRERR "RTN","RMPRPIUA") 0^19^B22135186 "RTN","RMPRPIUA",1,0) RMPRPIUA ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01 "RTN","RMPRPIUA",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUA",3,0) Q "RTN","RMPRPIUA",4,0) ; "RTN","RMPRPIUA",5,0) ; SCAN - If scanned an item's barcode locate record from "RTN","RMPRPIUA",6,0) ; Prosthetic Current Stock file 661.7 "RTN","RMPRPIUA",7,0) ; "RTN","RMPRPIUA",8,0) ; Inputs: "RTN","RMPRPIUA",9,0) ; RMPR7 - array containing... "RTN","RMPRPIUA",10,0) ; RMPR7("STATION") - Station ien "RTN","RMPRPIUA",11,0) ; RMPR7("HCPCS") - HCPCS code (contained in bar code) "RTN","RMPRPIUA",12,0) ; RMPR7("DATE&TIME") - Date&Time (contained in bar code) "RTN","RMPRPIUA",13,0) ; "RTN","RMPRPIUA",14,0) ; Outputs: "RTN","RMPRPIUA",15,0) ; RMPR7 - complete array for the 661.7 record read (if any)... "RTN","RMPRPIUA",16,0) ; RMPR7("IEN") "RTN","RMPRPIUA",17,0) ; RMPR7("STATION") - Station Name "RTN","RMPRPIUA",18,0) ; (nb will now be in external form) "RTN","RMPRPIUA",19,0) ; RMPR7("HCPCS") - "RTN","RMPRPIUA",20,0) ; RMPR7("SEQUENCE") - "RTN","RMPRPIUA",21,0) ; RMPR7("HCPCS ITEM") - "RTN","RMPRPIUA",22,0) ; RMPR7("LOCATION") - "RTN","RMPRPIUA",23,0) ; RMPR7("QUANTITY") - "RTN","RMPRPIUA",24,0) ; RMPR7("VALUE") - "RTN","RMPRPIUA",25,0) ; RMPR7("UNIT") - "RTN","RMPRPIUA",26,0) ; "RTN","RMPRPIUA",27,0) ; RMPREXC - exit condition "RTN","RMPRPIUA",28,0) ; 0 - normal, everything ok "RTN","RMPRPIUA",29,0) ; 1 - multi-instance but with station match (RMPR7 set) "RTN","RMPRPIUA",30,0) ; 2 - single instance but with "RTN","RMPRPIUA",31,0) ; station mis-match (RMPR7 set) "RTN","RMPRPIUA",32,0) ; 3 - multi-instance and station mis-match (RMPR7 not set) "RTN","RMPRPIUA",33,0) ; RMPRERR - error code returned by function "RTN","RMPRPIUA",34,0) ; 0 - no error "RTN","RMPRPIUA",35,0) ; 1 - null HCPCS input "RTN","RMPRPIUA",36,0) ; 2 - null Date&Time entered "RTN","RMPRPIUA",37,0) ; 3 - corrupt file (sequence but no ien) "RTN","RMPRPIUA",38,0) ; 4 - corrupt file (ien but no record) "RTN","RMPRPIUA",39,0) ; 5 - error reading 661.7 "RTN","RMPRPIUA",40,0) ; 99 - no instances found for input HCPCS and Date&Time "RTN","RMPRPIUA",41,0) SCAN(RMPR7,RMPREXC) ; "RTN","RMPRPIUA",42,0) N RMPRERR,RMPRC,RMPRSEQ,RMPRIEN,RMPRS,RMPRIEN1,RMPRIEN2,RMPRDTTM "RTN","RMPRPIUA",43,0) S RMPRERR=0 "RTN","RMPRPIUA",44,0) S RMPREXC=0 "RTN","RMPRPIUA",45,0) S RMPR7("STATION")=$G(RMPR7("STATION")) "RTN","RMPRPIUA",46,0) I $G(RMPR7("HCPCS"))="" S RMPRERR=1 G SCANX "RTN","RMPRPIUA",47,0) I $G(RMPR7("DATE&TIME"))="" S RMPRERR=2 G SCANX "RTN","RMPRPIUA",48,0) S RMPRDTTM=RMPR7("DATE&TIME") "RTN","RMPRPIUA",49,0) S RMPRC=0,RMPRIEN1="",RMPRIEN2="",RMPR7("IEN")="" "RTN","RMPRPIUA",50,0) S RMPRSEQ="" "RTN","RMPRPIUA",51,0) ; "RTN","RMPRPIUA",52,0) ; Get ien for current stock record "RTN","RMPRPIUA",53,0) ; Record number of instances for same HCPCS and Date&Time in "RTN","RMPRPIUA",54,0) ; RMPRC (more than 1 should be very, very rare) "RTN","RMPRPIUA",55,0) ; RMPRIEN1 is IEN for first instance "RTN","RMPRPIUA",56,0) ; RMPRIEN2 is ien for any instance with station ien matching input "RTN","RMPRPIUA",57,0) L +^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM) "RTN","RMPRPIUA",58,0) F S RMPRSEQ=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ)) Q:RMPRSEQ="" D Q:RMPRERR "RTN","RMPRPIUA",59,0) . S RMPRIEN=$O(^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM,RMPRSEQ,"")) "RTN","RMPRPIUA",60,0) . I RMPRIEN="" S RMPRERR=3 Q "RTN","RMPRPIUA",61,0) . I '$D(^RMPR(661.7,RMPRIEN,0)) S RMPRERR=4 Q "RTN","RMPRPIUA",62,0) . S RMPRS=^RMPR(661.7,RMPRIEN,0) "RTN","RMPRPIUA",63,0) . S RMPRC=RMPRC+1 "RTN","RMPRPIUA",64,0) . S RMPR7("UNIT")=$P(RMPRS,U,9) "RTN","RMPRPIUA",65,0) . I RMPR7("STATION")=$P(RMPRS,"^",5) S RMPRIEN2=RMPRIEN "RTN","RMPRPIUA",66,0) . I RMPRC=1 S RMPRIEN1=RMPRIEN "RTN","RMPRPIUA",67,0) . Q "RTN","RMPRPIUA",68,0) I RMPRERR G SCANU "RTN","RMPRPIUA",69,0) I 'RMPRC S RMPRERR=99 G SCANU "RTN","RMPRPIUA",70,0) ; "RTN","RMPRPIUA",71,0) ; Set exit condition "RTN","RMPRPIUA",72,0) I RMPRC>1 D "RTN","RMPRPIUA",73,0) . I RMPRIEN2'="" S RMPR7("IEN")=RMPRIEN2,RMPREXC=1 "RTN","RMPRPIUA",74,0) . E S RMPREXC=3 "RTN","RMPRPIUA",75,0) . Q "RTN","RMPRPIUA",76,0) E D "RTN","RMPRPIUA",77,0) . I RMPRIEN2="" S RMPREXC=2 "RTN","RMPRPIUA",78,0) . S RMPR7("IEN")=RMPRIEN1 "RTN","RMPRPIUA",79,0) . Q "RTN","RMPRPIUA",80,0) I RMPR7("IEN")'="" D "RTN","RMPRPIUA",81,0) . S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIUA",82,0) . I RMPRERR S RMPRERR=5 "RTN","RMPRPIUA",83,0) . Q "RTN","RMPRPIUA",84,0) SCANU L -^RMPR(661.7,"XHDS",RMPR7("HCPCS"),RMPRDTTM) "RTN","RMPRPIUA",85,0) SCANX Q RMPRERR "RTN","RMPRPIUA",86,0) ; "RTN","RMPRPIUA",87,0) ; STOCK - For an entered Station, Location, HCPCS and Item return "RTN","RMPRPIUA",88,0) ; total quantity on hand for that item, the average unit cost "RTN","RMPRPIUA",89,0) ; and the vendor. If more than one vendor, use the first one. "RTN","RMPRPIUA",90,0) ; "RTN","RMPRPIUA",91,0) ; Inputs: "RTN","RMPRPIUA",92,0) ; RMPR - an array with the following elements... "RTN","RMPRPIUA",93,0) ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,) "RTN","RMPRPIUA",94,0) ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIUA",95,0) ; RMPR("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIUA",96,0) ; RMPR("ITEM") - HCPCS Item number (eg 1) "RTN","RMPRPIUA",97,0) ; "RTN","RMPRPIUA",98,0) ; Outputs: "RTN","RMPRPIUA",99,0) ; RMPR - additional elements to the input RMPR array "RTN","RMPRPIUA",100,0) ; RMPR("QOH") - Quantity on hand "RTN","RMPRPIUA",101,0) ; RMPR("UNIT COST") - Unit cost per Item "RTN","RMPRPIUA",102,0) ; RMPR("VENDOR") - Vendor Name "RTN","RMPRPIUA",103,0) ; RMPR("VENDOR IEN") - Vendor ien "RTN","RMPRPIUA",104,0) ; "RTN","RMPRPIUA",105,0) ; RMPRERR - function return... "RTN","RMPRPIUA",106,0) ; 0 - no errors "RTN","RMPRPIUA",107,0) ; 1 - null Station ien input "RTN","RMPRPIUA",108,0) ; 2 - null Location ien input "RTN","RMPRPIUA",109,0) ; 3 - null HCPCS code input "RTN","RMPRPIUA",110,0) ; 4 - null Item input "RTN","RMPRPIUA",111,0) ; 5 - problem with 661.7 file "RTN","RMPRPIUA",112,0) ; 6 - problem with 661.6 file "RTN","RMPRPIUA",113,0) STOCK(RMPR) ; "RTN","RMPRPIUA",114,0) N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST "RTN","RMPRPIUA",115,0) S RMPRERR=0 "RTN","RMPRPIUA",116,0) S RMPRTCST=0 "RTN","RMPRPIUA",117,0) S RMPR("QOH")=0 "RTN","RMPRPIUA",118,0) S RMPR("UNIT COST")=0 "RTN","RMPRPIUA",119,0) S RMPR("VENDOR")="" "RTN","RMPRPIUA",120,0) S RMPR("VENDOR IEN")="" "RTN","RMPRPIUA",121,0) S RMPRK("STATION")=$G(RMPR("STATION IEN")) "RTN","RMPRPIUA",122,0) I RMPRK("STATION")="" S RMPRERR=1 G STOCKX "RTN","RMPRPIUA",123,0) S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN")) "RTN","RMPRPIUA",124,0) I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX "RTN","RMPRPIUA",125,0) S RMPRK("HCPCS")=$G(RMPR("HCPCS")) "RTN","RMPRPIUA",126,0) I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX "RTN","RMPRPIUA",127,0) S RMPRK("ITEM")=$G(RMPR("ITEM")) "RTN","RMPRPIUA",128,0) I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX "RTN","RMPRPIUA",129,0) L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUA",130,0) ; "RTN","RMPRPIUA",131,0) ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst "RTN","RMPRPIUA",132,0) STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIUA",133,0) I RMPRERR S RMPRERR=5 G STOCKU "RTN","RMPRPIUA",134,0) I RMPREOF G STOCKU "RTN","RMPRPIUA",135,0) I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU "RTN","RMPRPIUA",136,0) I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU "RTN","RMPRPIUA",137,0) I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU "RTN","RMPRPIUA",138,0) I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU "RTN","RMPRPIUA",139,0) K RMPR7 M RMPR7=RMPRK "RTN","RMPRPIUA",140,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIUA",141,0) I RMPRERR S RMPRERR=5 G STOCKU "RTN","RMPRPIUA",142,0) S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH") "RTN","RMPRPIUA",143,0) S RMPRTCST=RMPRTCST+RMPR7("VALUE") "RTN","RMPRPIUA",144,0) I RMPR("VENDOR IEN")="" D G:RMPRERR STOCKU "RTN","RMPRPIUA",145,0) . K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")="" "RTN","RMPRPIUA",146,0) . S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIUA",147,0) . I RMPRERR S RMPRERR=6 Q "RTN","RMPRPIUA",148,0) . S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIUA",149,0) . I RMPRERR S RMPRERR=6 Q "RTN","RMPRPIUA",150,0) . S RMPR("VENDOR")=RMPR6("VENDOR") "RTN","RMPRPIUA",151,0) . S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIUA",152,0) . Q "RTN","RMPRPIUA",153,0) G STOCKA "RTN","RMPRPIUA",154,0) STOCKU L -^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUA",155,0) I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH") "RTN","RMPRPIUA",156,0) STOCKX Q RMPRERR "RTN","RMPRPIUB") 0^20^B9656665 "RTN","RMPRPIUB",1,0) RMPRPIUB ;HINCIO/ODJ - APIs for file 661.7 ;3/8/01 "RTN","RMPRPIUB",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUB",3,0) Q "RTN","RMPRPIUB",4,0) ; "RTN","RMPRPIUB",5,0) ; "RTN","RMPRPIUB",6,0) ; Inputs: "RTN","RMPRPIUB",7,0) ; RMPR - an array with the following elements... "RTN","RMPRPIUB",8,0) ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,) "RTN","RMPRPIUB",9,0) ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIUB",10,0) ; RMPR("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIUB",11,0) ; RMPR("ITEM") - HCPCS Item number (eg 1) "RTN","RMPRPIUB",12,0) ; RMPR("ISSUED QTY") - Quantity Issued "RTN","RMPRPIUB",13,0) ; RMPR("ISSUED VALUE") - Issue Value "RTN","RMPRPIUB",14,0) ; "RTN","RMPRPIUB",15,0) ; RMPRERR - function return... "RTN","RMPRPIUB",16,0) ; 0 - no errors "RTN","RMPRPIUB",17,0) ; 1 - null Station ien input "RTN","RMPRPIUB",18,0) ; 2 - null Location ien input "RTN","RMPRPIUB",19,0) ; 3 - null HCPCS code input "RTN","RMPRPIUB",20,0) ; 4 - null Item input "RTN","RMPRPIUB",21,0) ; 5 - issued qty not greater than 0 "RTN","RMPRPIUB",22,0) ; 6 - problem with 661.7 file "RTN","RMPRPIUB",23,0) FIFO(RMPR) ; "RTN","RMPRPIUB",24,0) N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL "RTN","RMPRPIUB",25,0) N RMPRUVAL "RTN","RMPRPIUB",26,0) S RMPRERR=0 "RTN","RMPRPIUB",27,0) S RMPRK("STATION")=$G(RMPR("STATION IEN")) "RTN","RMPRPIUB",28,0) I RMPRK("STATION")="" S RMPRERR=1 G FIFOX "RTN","RMPRPIUB",29,0) S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN")) "RTN","RMPRPIUB",30,0) I RMPRK("LOCATION")="" S RMPRERR=2 G FIFOX "RTN","RMPRPIUB",31,0) S RMPRK("HCPCS")=$G(RMPR("HCPCS")) "RTN","RMPRPIUB",32,0) I RMPRK("HCPCS")="" S RMPRERR=3 G FIFOX "RTN","RMPRPIUB",33,0) S RMPRK("ITEM")=$G(RMPR("ITEM")) "RTN","RMPRPIUB",34,0) S RMPRK("IEN")=$G(RMPR("IEN")) "RTN","RMPRPIUB",35,0) S RMPRK("DATE&TIME")=$G(RMPR("DATE&TIME")) "RTN","RMPRPIUB",36,0) I RMPRK("ITEM")="" S RMPRERR=4 G FIFOX "RTN","RMPRPIUB",37,0) I '+$G(RMPR("ISSUED QTY")) S RMPRERR=5 G FIFOX "RTN","RMPRPIUB",38,0) S RMPRIBAL=RMPR("ISSUED QTY") ; init issued qty. balance "RTN","RMPRPIUB",39,0) S RMPRVBAL=+$G(RMPR("ISSUED VALUE")) ; init issue value balance "RTN","RMPRPIUB",40,0) S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per issued item "RTN","RMPRPIUB",41,0) L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUB",42,0) G PASS "RTN","RMPRPIUB",43,0) ; "RTN","RMPRPIUB",44,0) ; Loop on all records for Stn, Loc, HCPCS and Item until stock "RTN","RMPRPIUB",45,0) ; depleted by the issued amount "RTN","RMPRPIUB",46,0) FIFOA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIUB",47,0) I RMPRERR S RMPRERR=6 G FIFOU "RTN","RMPRPIUB",48,0) I RMPREOF G FIFOU "RTN","RMPRPIUB",49,0) I RMPRK("ITEM")'=RMPROLD("ITEM") G FIFOU "RTN","RMPRPIUB",50,0) I RMPRK("HCPCS")'=RMPROLD("HCPCS") G FIFOU "RTN","RMPRPIUB",51,0) I RMPRK("LOCATION")'=RMPROLD("LOCATION") G FIFOU "RTN","RMPRPIUB",52,0) I RMPRK("STATION")'=RMPROLD("STATION") G FIFOU "RTN","RMPRPIUB",53,0) PASS K RMPR7 M RMPR7=RMPRK "RTN","RMPRPIUB",54,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec. "RTN","RMPRPIUB",55,0) I RMPRERR S RMPRERR=6 G FIFOU "RTN","RMPRPIUB",56,0) K RMPR7I "RTN","RMPRPIUB",57,0) S RMPR7I("IEN")=RMPR7("IEN") "RTN","RMPRPIUB",58,0) S RMPR7I("QUANTITY")=RMPR7("QUANTITY") "RTN","RMPRPIUB",59,0) S RMPR7I("VALUE")=RMPR7("VALUE") "RTN","RMPRPIUB",60,0) ; "RTN","RMPRPIUB",61,0) ; If issued balance less than on-hand quantity then update "RTN","RMPRPIUB",62,0) ; the on-hand record "RTN","RMPRPIUB",63,0) I RMPRIBAL0 D "RTN","RMPRPIUD",35,0) .I $D(^RMPR(661.7,J,0)) S RMD7=^RMPR(661.7,J,0) D "RTN","RMPRPIUD",36,0) ..S RMITEM=$P(RMD7,U,4),RMLOC=$P(RMD7,U,6),RMSTN=$P(RMD7,U,5) "RTN","RMPRPIUD",37,0) ..S RMQUA=$P(RMD7,U,7) "RTN","RMPRPIUD",38,0) ..I $D(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC)) S $P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=$P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)+RMQUA "RTN","RMPRPIUD",39,0) ..E S $P(^TMP($J,RMPRNM,RMSTN,I,RMITEM,"L",RMLOC),U,2)=RMQUA "RTN","RMPRPIUD",40,0) ;get reorder level for all HCPCS "RTN","RMPRPIUD",41,0) F S RMPRSTN=$O(^RMPR(661.4,"XSHIL",RMPRSTN)) Q:RMPRSTN="" D "RTN","RMPRPIUD",42,0) . S RMPRERR=$$STN(RMPRNM,RMPRSTN) "RTN","RMPRPIUD",43,0) . Q "RTN","RMPRPIUD",44,0) ALLX Q RMPRERR "RTN","RMPRPIUD",45,0) ; "RTN","RMPRPIUD",46,0) ; Generate reorder/order position for single Station "RTN","RMPRPIUD",47,0) STN(RMPRNM,RMPRSTN) ; "RTN","RMPRPIUD",48,0) N RMPRERR,RMPRH,RMPRI,RMPRL,RMPRK,RMPROLD,RMPREOF,RMPRQFOR,RMPR7E "RTN","RMPRPIUD",49,0) N RMPR7I,RMPRTQOH,RMPRTORQ,RMPRTREO,RMPRD,RMPR11,RMPR41,RMPRIEN,RML,RME "RTN","RMPRPIUD",50,0) N RMDATA,RMREQUAN "RTN","RMPRPIUD",51,0) S RMPRERR=0 "RTN","RMPRPIUD",52,0) I $G(RMPRNM)="" S RMPRNM="STN-RMPRPIUD" "RTN","RMPRPIUD",53,0) S RMPRH="" "RTN","RMPRPIUD",54,0) F S RMPRH=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH)) Q:RMPRH="" D "RTN","RMPRPIUD",55,0) . F RMPRI=0:0 S RMPRI=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI)) Q:RMPRI'>0 D "RTN","RMPRPIUD",56,0) .. ;set initial balance of re-order quantity "RTN","RMPRPIUD",57,0) .. F RML=0:0 S RML=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML)) Q:RML'>0 D "RTN","RMPRPIUD",58,0) ... F RME=0:0 S RME=$O(^RMPR(661.4,"XSHIL",RMPRSTN,RMPRH,RMPRI,RML,RME)) Q:RME'>0 D "RTN","RMPRPIUD",59,0) .... I RME,$D(^RMPR(661.4,RME,0)) S RMDATA=$G(^RMPR(661.4,RME,0)) "RTN","RMPRPIUD",60,0) .... S RMREQUAN=$P(RMDATA,U,4) Q:'$G(RMREQUAN) "RTN","RMPRPIUD",61,0) .... S $P(^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"L",RML),U,1)=$G(RMREQUAN) "RTN","RMPRPIUD",62,0) .. ; "RTN","RMPRPIUD",63,0) .. ; Loop on open orders "RTN","RMPRPIUD",64,0) .. S RMPRD="" "RTN","RMPRPIUD",65,0) .. F S RMPRD=$O(^RMPR(661.41,"ASSHID",RMPRSTN,"O",RMPRH,RMPRI,RMPRD)) Q:RMPRD="" D Q:RMPRERR "RTN","RMPRPIUD",66,0) ... S RMPRIEN="" "RTN","RMPRPIUD",67,0) ... F S RMPRIEN=$O(^RMPR(661.41,"ASSHID",RMPRSTN,"O",RMPRH,RMPRI,RMPRD,RMPRIEN)) Q:RMPRIEN="" D Q:RMPRERR "RTN","RMPRPIUD",68,0) .... K RMPR41 S RMPR41("IEN")=RMPRIEN "RTN","RMPRPIUD",69,0) .... S RMPRERR=$$GET^RMPRPIXN(.RMPR41,) "RTN","RMPRPIUD",70,0) .... I RMPRERR S RMPRERR=99 Q "RTN","RMPRPIUD",71,0) .... S ^TMP($J,RMPRNM,RMPRSTN,RMPRH,RMPRI,"M",RMPRD,RMPRIEN)=RMPR41("BALANCE QTY")_"^"_RMPR41("DATE ORDER") "RTN","RMPRPIUD",72,0) .... Q "RTN","RMPRPIUD",73,0) ... Q "RTN","RMPRPIUD",74,0) .. Q "RTN","RMPRPIUD",75,0) . Q "RTN","RMPRPIUD",76,0) STNX Q RMPRERR "RTN","RMPRPIUE") 0^23^B8394222 "RTN","RMPRPIUE",1,0) RMPRPIUE ;HINCIO/ODJ - Get Current Stock Utility ;3/8/01 "RTN","RMPRPIUE",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUE",3,0) Q "RTN","RMPRPIUE",4,0) ; STOCK - For an entered Station, Location, Vendor "RTN","RMPRPIUE",5,0) ; HCPCS and Item "RTN","RMPRPIUE",6,0) ; return total quantity on hand for that item "RTN","RMPRPIUE",7,0) ; and the average unit cost. "RTN","RMPRPIUE",8,0) ; "RTN","RMPRPIUE",9,0) ; Inputs: "RTN","RMPRPIUE",10,0) ; RMPR - an array with the following elements... "RTN","RMPRPIUE",11,0) ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,) "RTN","RMPRPIUE",12,0) ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIUE",13,0) ; RMPR("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIUE",14,0) ; RMPR("ITEM") - HCPCS Item number (eg 1) "RTN","RMPRPIUE",15,0) ; RMPR("VENDOR IEN") - Vendor ien "RTN","RMPRPIUE",16,0) ; "RTN","RMPRPIUE",17,0) ; Outputs: "RTN","RMPRPIUE",18,0) ; RMPR - additional elements to the input RMPR array "RTN","RMPRPIUE",19,0) ; RMPR("QOH") - Quantity on hand "RTN","RMPRPIUE",20,0) ; RMPR("UNIT COST") - Unit cost per Item "RTN","RMPRPIUE",21,0) ; "RTN","RMPRPIUE",22,0) ; RMPRERR - function return... "RTN","RMPRPIUE",23,0) ; 0 - no errors "RTN","RMPRPIUE",24,0) ; 1 - null Station ien input "RTN","RMPRPIUE",25,0) ; 2 - null Location ien input "RTN","RMPRPIUE",26,0) ; 3 - null HCPCS code input "RTN","RMPRPIUE",27,0) ; 4 - null Item input "RTN","RMPRPIUE",28,0) ; 5 - problem with 661.7 file "RTN","RMPRPIUE",29,0) ; 6 - problem with 661.6 file "RTN","RMPRPIUE",30,0) STOCK(RMPR) ; "RTN","RMPRPIUE",31,0) N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR6,RMPRTCST "RTN","RMPRPIUE",32,0) S RMPRERR=0 "RTN","RMPRPIUE",33,0) S RMPRTCST=0 "RTN","RMPRPIUE",34,0) S RMPR("QOH")=0 "RTN","RMPRPIUE",35,0) S RMPR("UNIT COST")=0 "RTN","RMPRPIUE",36,0) S RMPRK("STATION")=$G(RMPR("STATION IEN")) "RTN","RMPRPIUE",37,0) I RMPRK("STATION")="" S RMPRERR=1 G STOCKX "RTN","RMPRPIUE",38,0) S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN")) "RTN","RMPRPIUE",39,0) I RMPRK("LOCATION")="" S RMPRERR=2 G STOCKX "RTN","RMPRPIUE",40,0) S RMPRK("HCPCS")=$G(RMPR("HCPCS")) "RTN","RMPRPIUE",41,0) I RMPRK("HCPCS")="" S RMPRERR=3 G STOCKX "RTN","RMPRPIUE",42,0) S RMPRK("ITEM")=$G(RMPR("ITEM")) "RTN","RMPRPIUE",43,0) I RMPRK("ITEM")="" S RMPRERR=4 G STOCKX "RTN","RMPRPIUE",44,0) L +^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUE",45,0) ; "RTN","RMPRPIUE",46,0) ; Loop on all records for Stn, Loc, HCPCS and Item, and sum qty and cst "RTN","RMPRPIUE",47,0) STOCKA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIUE",48,0) I RMPRERR S RMPRERR=5 G STOCKU "RTN","RMPRPIUE",49,0) I RMPREOF G STOCKU "RTN","RMPRPIUE",50,0) I RMPRK("ITEM")'=RMPROLD("ITEM") G STOCKU "RTN","RMPRPIUE",51,0) I RMPRK("HCPCS")'=RMPROLD("HCPCS") G STOCKU "RTN","RMPRPIUE",52,0) I RMPRK("LOCATION")'=RMPROLD("LOCATION") G STOCKU "RTN","RMPRPIUE",53,0) I RMPRK("STATION")'=RMPROLD("STATION") G STOCKU "RTN","RMPRPIUE",54,0) K RMPR7 M RMPR7=RMPRK "RTN","RMPRPIUE",55,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ;get current stock record "RTN","RMPRPIUE",56,0) I RMPRERR S RMPRERR=5 G STOCKU "RTN","RMPRPIUE",57,0) I RMPR("VENDOR IEN")'="" D G:RMPRERR STOCKU "RTN","RMPRPIUE",58,0) . K RMPR6 M RMPR6=RMPRK S RMPR6("IEN")="" "RTN","RMPRPIUE",59,0) . S RMPRERR=$$GET^RMPRPIX6(.RMPR6) ;get transaction record "RTN","RMPRPIUE",60,0) . I RMPRERR S RMPRERR=6 Q "RTN","RMPRPIUE",61,0) . S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) ;get vendor ien "RTN","RMPRPIUE",62,0) . I RMPRERR S RMPRERR=6 Q "RTN","RMPRPIUE",63,0) . Q:RMPR("VENDOR IEN")'=RMPR6("VENDOR IEN") "RTN","RMPRPIUE",64,0) . S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH") "RTN","RMPRPIUE",65,0) . S RMPRTCST=RMPRTCST+RMPR7("VALUE") "RTN","RMPRPIUE",66,0) . Q "RTN","RMPRPIUE",67,0) E D "RTN","RMPRPIUE",68,0) . S RMPR("QOH")=RMPR7("QUANTITY")+RMPR("QOH") "RTN","RMPRPIUE",69,0) . S RMPRTCST=RMPRTCST+RMPR7("VALUE") "RTN","RMPRPIUE",70,0) . Q "RTN","RMPRPIUE",71,0) G STOCKA "RTN","RMPRPIUE",72,0) STOCKU L -^RMPR(661.7,"XSHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUE",73,0) I RMPR("QOH") S RMPR("UNIT COST")=RMPRTCST/RMPR("QOH") "RTN","RMPRPIUE",74,0) STOCKX Q RMPRERR "RTN","RMPRPIUF") 0^24^B13236997 "RTN","RMPRPIUF",1,0) RMPRPIUF ;HINCIO/ODJ - APIs for Current Stock file 661.7 ;3/8/01 "RTN","RMPRPIUF",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUF",3,0) Q "RTN","RMPRPIUF",4,0) ;***** "RTN","RMPRPIUF",5,0) ; "RTN","RMPRPIUF",6,0) ; Inputs: "RTN","RMPRPIUF",7,0) ; RMPR - an array with the following elements... "RTN","RMPRPIUF",8,0) ; RMPR("STATION IEN") - Station ien (ptr ^DIC(4,) "RTN","RMPRPIUF",9,0) ; RMPR("LOCATION IEN") - Location ien (ptr ^RMPR(661.5,) "RTN","RMPRPIUF",10,0) ; RMPR("VENDOR IEN") - Vendor ien "RTN","RMPRPIUF",11,0) ; RMPR("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIUF",12,0) ; RMPR("ITEM") - HCPCS Item number (eg 1) "RTN","RMPRPIUF",13,0) ; RMPR("ISSUED QTY") - Quantity Issued "RTN","RMPRPIUF",14,0) ; RMPR("ISSUED VALUE") - Issue Value "RTN","RMPRPIUF",15,0) ; "RTN","RMPRPIUF",16,0) ; RMPRERR - function return... "RTN","RMPRPIUF",17,0) ; 0 - no errors "RTN","RMPRPIUF",18,0) ; 1 - null Station ien input "RTN","RMPRPIUF",19,0) ; 2 - null Location ien input "RTN","RMPRPIUF",20,0) ; 3 - null HCPCS code input "RTN","RMPRPIUF",21,0) ; 4 - null Item input "RTN","RMPRPIUF",22,0) ; 5 - issued qty not greater than 0 "RTN","RMPRPIUF",23,0) ; 6 - problem with 661.7 file "RTN","RMPRPIUF",24,0) ; 7 - null Vendor input "RTN","RMPRPIUF",25,0) ; 8 - problem with 661.6 file "RTN","RMPRPIUF",26,0) FIFO(RMPR) ; "RTN","RMPRPIUF",27,0) N RMPRERR,RMPRK,RMPROLD,RMPREOF,RMPR7,RMPR7I,RMPRIBAL,RMPRVBAL "RTN","RMPRPIUF",28,0) N RMPRUVAL,RMPRI,RMPR6,RMPR6I,RMPR7U "RTN","RMPRPIUF",29,0) S RMPRERR=0 "RTN","RMPRPIUF",30,0) S RMPRK("STATION")=$G(RMPR("STATION IEN")) "RTN","RMPRPIUF",31,0) I RMPRK("STATION")="" S RMPRERR=1 G FIFOX "RTN","RMPRPIUF",32,0) S RMPRK("LOCATION")=$G(RMPR("LOCATION IEN")) "RTN","RMPRPIUF",33,0) I RMPRK("LOCATION")="" S RMPRERR=2 G FIFOX "RTN","RMPRPIUF",34,0) S RMPRK("HCPCS")=$G(RMPR("HCPCS")) "RTN","RMPRPIUF",35,0) I RMPRK("HCPCS")="" S RMPRERR=3 G FIFOX "RTN","RMPRPIUF",36,0) S RMPRK("ITEM")=$G(RMPR("ITEM")) "RTN","RMPRPIUF",37,0) I RMPRK("ITEM")="" S RMPRERR=4 G FIFOX "RTN","RMPRPIUF",38,0) I $G(RMPR("VENDOR IEN"))="" S RMPRERR=7 G FIFOX "RTN","RMPRPIUF",39,0) I '+$G(RMPR("ISSUED QTY")) S RMPRERR=5 G FIFOX "RTN","RMPRPIUF",40,0) S RMPRIBAL=RMPR("ISSUED QTY") ; init issued qty. balance "RTN","RMPRPIUF",41,0) S RMPRVBAL=+$G(RMPR("ISSUED VALUE")) ; init issue value balance "RTN","RMPRPIUF",42,0) S RMPRUVAL=RMPRVBAL/RMPRIBAL ; unit cost per issued item "RTN","RMPRPIUF",43,0) ; "RTN","RMPRPIUF",44,0) ; Lock 661.7 "RTN","RMPRPIUF",45,0) L +^RMPR(661.7,"XSLHIDS",RMPR("STATION IEN"),RMPR("LOCATION IEN"),RMPR("HCPCS"),RMPR("ITEM")) "RTN","RMPRPIUF",46,0) ; "RTN","RMPRPIUF",47,0) ; Primary loop on all records for Stn, Loc, HCPCS and Item until stock "RTN","RMPRPIUF",48,0) ; depleted by the issued amount "RTN","RMPRPIUF",49,0) FIFOA S RMPRERR=$$NEXT^RMPRPIXE(.RMPRK,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIUF",50,0) I RMPRERR S RMPRERR=6 G FIFOU "RTN","RMPRPIUF",51,0) I RMPREOF G FIFOU "RTN","RMPRPIUF",52,0) I RMPRK("ITEM")'=RMPROLD("ITEM") G FIFOU "RTN","RMPRPIUF",53,0) I RMPRK("HCPCS")'=RMPROLD("HCPCS") G FIFOU "RTN","RMPRPIUF",54,0) I RMPRK("LOCATION")'=RMPROLD("LOCATION") G FIFOU "RTN","RMPRPIUF",55,0) I RMPRK("STATION")'=RMPROLD("STATION") G FIFOU "RTN","RMPRPIUF",56,0) K RMPR7 S RMPR7("IEN")=RMPRK("IEN") "RTN","RMPRPIUF",57,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) ; read in current stock rec. "RTN","RMPRPIUF",58,0) I RMPRERR S RMPRERR=6 G FIFOU "RTN","RMPRPIUF",59,0) K RMPR7I "RTN","RMPRPIUF",60,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIUF",61,0) I RMPRERR S RMPRERR=6 G FIFOU "RTN","RMPRPIUF",62,0) ; "RTN","RMPRPIUF",63,0) ; 2nd Loop on 661.6 transactions so as to match vendor "RTN","RMPRPIUF",64,0) S RMPRI="" "RTN","RMPRPIUF",65,0) FIFOB S RMPRI=$O(^RMPR(661.6,"XHDS",RMPR7I("HCPCS"),RMPR7I("DATE&TIME"),RMPR7I("SEQUENCE"),RMPRI)) "RTN","RMPRPIUF",66,0) I RMPRI="" G FIFOA "RTN","RMPRPIUF",67,0) K RMPR6 S RMPR6("IEN")=RMPRI S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIUF",68,0) I RMPRERR S RMPRERR=8 G FIFOU "RTN","RMPRPIUF",69,0) S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIUF",70,0) I RMPRERR S RMPRERR=8 G FIFOU "RTN","RMPRPIUF",71,0) I RMPR6("VENDOR IEN")'=RMPR("VENDOR IEN") G FIFOB "RTN","RMPRPIUF",72,0) K RMPR7U "RTN","RMPRPIUF",73,0) S RMPR7U("IEN")=RMPR7("IEN") "RTN","RMPRPIUF",74,0) S RMPR7U("QUANTITY")=RMPR7("QUANTITY") "RTN","RMPRPIUF",75,0) S RMPR7U("VALUE")=RMPR7("VALUE") "RTN","RMPRPIUF",76,0) ; "RTN","RMPRPIUF",77,0) ; If issued balance less than on-hand quantity then update "RTN","RMPRPIUF",78,0) ; the on-hand record "RTN","RMPRPIUF",79,0) I RMPRIBAL0 D "RTN","RMPRPIUG",126,0) . S RMPR41("VENDOR")=RMPR6("VENDOR IEN") "RTN","RMPRPIUG",127,0) . S RMPR41("DATE ORDER")=RMPRTODT "RTN","RMPRPIUG",128,0) . S RMPR41("STATUS")="O" "RTN","RMPRPIUG",129,0) . S RMPRERR=$$CRE^RMPRPIXN(.RMPR41,.RMPR11) "RTN","RMPRPIUG",130,0) . Q "RTN","RMPRPIUG",131,0) G CONV3 ;next item in 661.3 "RTN","RMPRPIUG",132,0) ; "RTN","RMPRPIUG",133,0) ; Process the ^TMP($J,"H") global just created "RTN","RMPRPIUG",134,0) TMPH(RMPR5) ; "RTN","RMPRPIUG",135,0) N RMPRH,RMPRI,RMPRV,RMPR,RMPR11,RMPRERR,RMPRSS,RMPR6,RMPRUCST "RTN","RMPRPIUG",136,0) S RMPRH="" "RTN","RMPRPIUG",137,0) F S RMPRH=$O(^TMP($J,"H",RMPRH)) Q:RMPRH="" D "RTN","RMPRPIUG",138,0) . S RMPRI="" "RTN","RMPRPIUG",139,0) . F S RMPRI=$O(^TMP($J,"H",RMPRH,RMPRI)) Q:RMPRI="" D "RTN","RMPRPIUG",140,0) .. S RMPRV="" "RTN","RMPRPIUG",141,0) .. F S RMPRV=$O(^TMP($J,"H",RMPRH,RMPRI,RMPRV)) Q:RMPRV="" D "RTN","RMPRPIUG",142,0) ... S RMPRSS=^TMP($J,"H",RMPRH,RMPRI,RMPRV) "RTN","RMPRPIUG",143,0) ... K RMPR6 "RTN","RMPRPIUG",144,0) ... S RMPR6("QUANTITY")=+$P(RMPRSS,"^",1) "RTN","RMPRPIUG",145,0) ... S RMPR6("VALUE")=+$P(RMPRSS,"^",2) "RTN","RMPRPIUG",146,0) ... S RMPR6("UNIT")=+$P(RMPRSS,"^",3) "RTN","RMPRPIUG",147,0) ... S RMPR6("VENDOR IEN")=RMPRV "RTN","RMPRPIUG",148,0) ... K RMPR11 "RTN","RMPRPIUG",149,0) ... S RMPR11("STATION")=RMPR5("STATION") "RTN","RMPRPIUG",150,0) ... S RMPR11("STATION IEN")=RMPR5("STATION") "RTN","RMPRPIUG",151,0) ... S RMPR11("HCPCS")=RMPRH "RTN","RMPRPIUG",152,0) ... S RMPR11("ITEM")=RMPRI "RTN","RMPRPIUG",153,0) ... S RMPR11("UNIT")=$P(RMPRSS,U,3) "RTN","RMPRPIUG",154,0) ... ; "RTN","RMPRPIUG",155,0) ... ; If quantity<0 then create a reconciliation gain "RTN","RMPRPIUG",156,0) ... ; of the amount followed by a 0 reconciliation "RTN","RMPRPIUG",157,0) ... I RMPR6("QUANTITY")<0 D "RTN","RMPRPIUG",158,0) .... K RMPR "RTN","RMPRPIUG",159,0) .... S RMPR("QUANTITY")=0-RMPR6("QUANTITY") "RTN","RMPRPIUG",160,0) .... S RMPR("VALUE")=$S(RMPR6("VALUE")<0:0-RMPR6("VALUE"),1:RMPR6("VALUE")) "RTN","RMPRPIUG",161,0) .... S RMPR("NEW UNIT COST")=$J(RMPR("VALUE")/RMPR("QUANTITY"),0,2) "RTN","RMPRPIUG",162,0) .... S RMPRUCST=RMPR("NEW UNIT COST") "RTN","RMPRPIUG",163,0) .... S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIUG",164,0) .... S RMPRERR=$$REC^RMPRPIU9(.RMPR,.RMPR11,.RMPR5) "RTN","RMPRPIUG",165,0) .... K RMPR "RTN","RMPRPIUG",166,0) .... S RMPR("QUANTITY")=0 "RTN","RMPRPIUG",167,0) .... S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIUG",168,0) .... S RMPR("NEW UNIT COST")=RMPRUCST "RTN","RMPRPIUG",169,0) .... S RMPRERR=$$REC^RMPRPIU9(.RMPR,.RMPR11,.RMPR5) "RTN","RMPRPIUG",170,0) .... Q "RTN","RMPRPIUG",171,0) ... ; "RTN","RMPRPIUG",172,0) ... ; If +VE qty. just record as a gain "RTN","RMPRPIUG",173,0) ... E D "RTN","RMPRPIUG",174,0) .... S:RMPR6("VALUE")<0 RMPR6("VALUE")=0-RMPR6("VALUE") "RTN","RMPRPIUG",175,0) .... S RMPR6("NEW UNIT COST")=0 "RTN","RMPRPIUG",176,0) .... S:RMPR6("QUANTITY") RMPR6("NEW UNIT COST")=$J(RMPR6("VALUE")/RMPR6("QUANTITY"),0,2) "RTN","RMPRPIUG",177,0) .... S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5) "RTN","RMPRPIUG",178,0) .... Q "RTN","RMPRPIUG",179,0) ... Q "RTN","RMPRPIUG",180,0) .. Q "RTN","RMPRPIUG",181,0) . Q "RTN","RMPRPIUG",182,0) TMPHX K ^TMP($J,"H") "RTN","RMPRPIUG",183,0) Q "RTN","RMPRPIUG",184,0) ; "RTN","RMPRPIUG",185,0) ;exit "RTN","RMPRPIUG",186,0) CONV1AX K ^TMP($J,"H") "RTN","RMPRPIUG",187,0) Q "RTN","RMPRPIUH") 0^66^B34910877 "RTN","RMPRPIUH",1,0) RMPRPIUH ;HINCIO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:45 "RTN","RMPRPIUH",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUH",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPIUH",4,0) Q "RTN","RMPRPIUH",5,0) ; "RTN","RMPRPIUH",6,0) ;***** CONV - Convert old PIP files to the new design "RTN","RMPRPIUH",7,0) ; continued from RMPRPIUG "RTN","RMPRPIUH",8,0) ; Create issue transactions "RTN","RMPRPIUH",9,0) ; "RTN","RMPRPIUH",10,0) ; Convert patient issues in 660 file "RTN","RMPRPIUH",11,0) ; "RTN","RMPRPIUH",12,0) ; Start loop at 1st date in 661.2 "RTN","RMPRPIUH",13,0) CONV N RMPRDT,RMPRIEN,RMPRR60,RMPR62P,RMPRREC,RMPR6,RMPR11,RMPR62R,RMPRITM "RTN","RMPRPIUH",14,0) N RMPR63P,RMPR63R,RMPR5,RMPRHIEN,RMPRS,RMPRERR,RMPRTIME,RMPR60 "RTN","RMPRPIUH",15,0) I '$D(IO("Q")) D "RTN","RMPRPIUH",16,0) . W !,"Creating patient issue transactions - file 661.6 " "RTN","RMPRPIUH",17,0) . Q "RTN","RMPRPIUH",18,0) K ^TMP($J,"ISS") "RTN","RMPRPIUH",19,0) S RMPRDT=$O(^RMPR(661.2,"B","")) "RTN","RMPRPIUH",20,0) I RMPRDT'="" S RMPRDT=RMPRDT-1 "RTN","RMPRPIUH",21,0) ; "RTN","RMPRPIUH",22,0) ; Loop on ENTRY DATE ('B') x-ref in 660 file "RTN","RMPRPIUH",23,0) CONV1 S RMPRDT=$O(^RMPR(660,"B",RMPRDT)) "RTN","RMPRPIUH",24,0) I '$D(IO("Q")) D "RTN","RMPRPIUH",25,0) . W:$X=79 ! W "." "RTN","RMPRPIUH",26,0) . Q "RTN","RMPRPIUH",27,0) I RMPRDT="" G CONVX "RTN","RMPRPIUH",28,0) S RMPRIEN=0 "RTN","RMPRPIUH",29,0) CONV2 S RMPRIEN=$O(^RMPR(660,"B",RMPRDT,RMPRIEN)) "RTN","RMPRPIUH",30,0) I '+RMPRIEN G CONV1 "RTN","RMPRPIUH",31,0) ; "RTN","RMPRPIUH",32,0) ; read 660 recs and set up arrays "RTN","RMPRPIUH",33,0) K RMPR60 "RTN","RMPRPIUH",34,0) S RMPR60("IEN")=RMPRIEN "RTN","RMPRPIUH",35,0) S RMPRR60=$G(^RMPR(660,RMPRIEN,1)) "RTN","RMPRPIUH",36,0) S RMPR62P=$P(RMPRR60,"^",5) ;pointer to 661.2 "RTN","RMPRPIUH",37,0) I RMPR62P="" G CONV2 ;ignore if null ptr. "RTN","RMPRPIUH",38,0) I '$D(^RMPR(661.2,RMPR62P)) G CONV2 ;ignore if invalid ptr. "RTN","RMPRPIUH",39,0) S RMPRREC=$G(^RMPR(660,RMPRIEN,0)) "RTN","RMPRPIUH",40,0) K RMPR6 "RTN","RMPRPIUH",41,0) I RMPRDT'=$P(RMPRREC,"^",1) G CONV2 ;bad 'B' x-ref "RTN","RMPRPIUH",42,0) S RMPR6("QUANTITY")=+$P(RMPRREC,"^",7) "RTN","RMPRPIUH",43,0) I RMPR6("QUANTITY")=0 G CONV2 ;ignore if 0 qty "RTN","RMPRPIUH",44,0) S RMPR6("VALUE")=$P(RMPRREC,"^",16) "RTN","RMPRPIUH",45,0) S RMPR6("VENDOR")=$P(RMPRREC,"^",9) "RTN","RMPRPIUH",46,0) I RMPR6("VENDOR")="" G CONV2 ;ignore if null vendor "RTN","RMPRPIUH",47,0) S RMPR6("USER")=$P(RMPRREC,"^",27) "RTN","RMPRPIUH",48,0) ; "RTN","RMPRPIUH",49,0) ; Get HCPCS and HCPCS Item using file 661.2 "RTN","RMPRPIUH",50,0) S RMPR62R=$G(^RMPR(661.2,RMPR62P,0)) "RTN","RMPRPIUH",51,0) S RMPR60("661.2PTR")=RMPR62P "RTN","RMPRPIUH",52,0) K RMPR11 "RTN","RMPRPIUH",53,0) S RMPR11("ITEM MASTER IEN")=$P(RMPRREC,"^",6) "RTN","RMPRPIUH",54,0) S RMPR11("STATION")=$P(RMPR62R,"^",15) "RTN","RMPRPIUH",55,0) I RMPR11("STATION")="" G CONV2 ;ignore if null station "RTN","RMPRPIUH",56,0) I '$D(^DIC(4,RMPR11("STATION"),0)) G CONV2 ;ignore if bad ptr "RTN","RMPRPIUH",57,0) S RMPR11("HCPCS")=$P($P(RMPR62R,"^",9),"-",1) ;HCPCS Code "RTN","RMPRPIUH",58,0) I RMPR11("HCPCS")="" G CONV2 ;ignore if null HCPCS "RTN","RMPRPIUH",59,0) S RMPRHIEN=$P(RMPR62R,"^",4) ;HCPCS ptr "RTN","RMPRPIUH",60,0) I RMPRHIEN="" G CONV2 ;ignore if null HCPCS ptr "RTN","RMPRPIUH",61,0) S RMPRITM=$P($P(RMPR62R,"^",9),"-",2) ;Item ptr "RTN","RMPRPIUH",62,0) I RMPRITM="" G CONV2 ;ignore if null item "RTN","RMPRPIUH",63,0) S RMPR11("SOURCE")=$P(RMPR62R,"^",3) "RTN","RMPRPIUH",64,0) I RMPR11("SOURCE")'="V" S RMPR11("SOURCE")="C" "RTN","RMPRPIUH",65,0) S RMPR11("UNIT")=$P(RMPR62R,"^",5) "RTN","RMPRPIUH",66,0) D GETITM(.RMPR11,RMPRHIEN,RMPRITM) "RTN","RMPRPIUH",67,0) ; "RTN","RMPRPIUH",68,0) ; Get Location "RTN","RMPRPIUH",69,0) K RMPR5 "RTN","RMPRPIUH",70,0) S RMPR63P=$P(RMPR62R,"^",16) ;ptr to location 661.3 file "RTN","RMPRPIUH",71,0) S RMPR5("STATION")=RMPR11("STATION") "RTN","RMPRPIUH",72,0) S RMPRERR=$$GETLCN(RMPR63P,.RMPR5) ; get location "RTN","RMPRPIUH",73,0) I RMPRERR G CONV2 ;ignore if bad location "RTN","RMPRPIUH",74,0) ; "RTN","RMPRPIUH",75,0) ; If get here then enough to create a stock issue to patient "RTN","RMPRPIUH",76,0) ; transaction... "RTN","RMPRPIUH",77,0) S RMPR6("DATE&TIME")="" "RTN","RMPRPIUH",78,0) F D Q:RMPR6("DATE&TIME")'="" "RTN","RMPRPIUH",79,0) . D NOW^%DTC "RTN","RMPRPIUH",80,0) . S RMPRTIME=RMPRDT_"."_$P(%,".",2) "RTN","RMPRPIUH",81,0) . I $D(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME)) H (1+$R(3)) Q "RTN","RMPRPIUH",82,0) . L +^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME):0 E H (1+$R(3)) Q "RTN","RMPRPIUH",83,0) . S RMPR6("DATE&TIME")=RMPRTIME "RTN","RMPRPIUH",84,0) . Q "RTN","RMPRPIUH",85,0) S RMPR6("LOCATION")=RMPR5("IEN") "RTN","RMPRPIUH",86,0) S RMPRS=$G(^TMP($J,"ISS",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("LOCATION"),RMPR6("VENDOR"))) "RTN","RMPRPIUH",87,0) S $P(RMPRS,"^",1)=RMPR6("QUANTITY")+$P(RMPRS,"^",1) "RTN","RMPRPIUH",88,0) S $P(RMPRS,"^",2)=RMPR6("VALUE")+$P(RMPRS,"^",2) "RTN","RMPRPIUH",89,0) S ^TMP($J,"ISS",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"),RMPR6("LOCATION"),RMPR6("VENDOR"))=RMPRS "RTN","RMPRPIUH",90,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIUH",91,0) S RMPR6("COMMENT")="" "RTN","RMPRPIUH",92,0) S RMPR6("TRAN TYPE")=3 "RTN","RMPRPIUH",93,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIUH",94,0) S $P(RMPRR60,"^",5)=RMPR6("IEN") "RTN","RMPRPIUH",95,0) S ^RMPR(660,RMPRIEN,1)=RMPRR60 "RTN","RMPRPIUH",96,0) L -^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPR6("DATE&TIME")) "RTN","RMPRPIUH",97,0) ; "RTN","RMPRPIUH",98,0) ; Create 661.63 Patient Issue transaction record "RTN","RMPRPIUH",99,0) S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11) "RTN","RMPRPIUH",100,0) ; "RTN","RMPRPIUH",101,0) ; Next rec "RTN","RMPRPIUH",102,0) G CONV2 "RTN","RMPRPIUH",103,0) ; "RTN","RMPRPIUH",104,0) ; Exit "RTN","RMPRPIUH",105,0) CONVX Q "RTN","RMPRPIUH",106,0) ; "RTN","RMPRPIUH",107,0) ; Get a Location from the pointer to file 661.3 "RTN","RMPRPIUH",108,0) ; RMPRPIUJ should have been already run to set up the new locations "RTN","RMPRPIUH",109,0) ; file 661.5 and the temp map file. "RTN","RMPRPIUH",110,0) ; If can't get a valid location default to the GENERIC location "RTN","RMPRPIUH",111,0) GETLCN(RMPR63P,RMPR5) ; "RTN","RMPRPIUH",112,0) N RMPRERR "RTN","RMPRPIUH",113,0) S RMPRERR=0 "RTN","RMPRPIUH",114,0) I RMPR63P="" S RMPRERR=1 G GETLCNX "RTN","RMPRPIUH",115,0) I '$D(^RMPR(661.5,"XSL",RMPR5("STATION"))) S RMPRERR=2 G GETLCNX "RTN","RMPRPIUH",116,0) ; "RTN","RMPRPIUH",117,0) ; if old (661.3) pointer mapped to new (661.5) pointer use it "RTN","RMPRPIUH",118,0) I $D(^TMP($J,"LOCN",RMPR63P)) D G GETLCNX "RTN","RMPRPIUH",119,0) . S RMPR5("IEN")=^TMP($J,"LOCN",RMPR63P) "RTN","RMPRPIUH",120,0) . Q "RTN","RMPRPIUH",121,0) ; "RTN","RMPRPIUH",122,0) ; else use the 661.5 pointer for GENERIC location "RTN","RMPRPIUH",123,0) E D "RTN","RMPRPIUH",124,0) . S RMPR5("IEN")=$O(^RMPR(661.5,"XSL",RMPR5("STATION"),"GENERIC","")) "RTN","RMPRPIUH",125,0) . Q "RTN","RMPRPIUH",126,0) GETLCNX Q RMPRERR "RTN","RMPRPIUH",127,0) ; "RTN","RMPRPIUH",128,0) ; Get HCPCS Item "RTN","RMPRPIUH",129,0) ; Commercial items should have already been set up by running "RTN","RMPRPIUH",130,0) ; RMPRPIUI "RTN","RMPRPIUH",131,0) ; VA items and those items in 661.2 which are no longer in the 661.3 "RTN","RMPRPIUH",132,0) ; file will be created together with a map of old to new iens. "RTN","RMPRPIUH",133,0) GETITM(RMPR11,RMPRHIEN,RMPRITM) ; "RTN","RMPRPIUH",134,0) N RMPRI,RMPRS,RMPRERR,RMPRIM,RMPR11U,RMPRGOT "RTN","RMPRPIUH",135,0) S RMPR11("ITEM MASTER IEN")=$G(RMPR11("ITEM MASTER IEN")) "RTN","RMPRPIUH",136,0) S RMPRIM=RMPR11("ITEM MASTER IEN") "RTN","RMPRPIUH",137,0) S:RMPRIM="" RMPRIM="*" "RTN","RMPRPIUH",138,0) ; "RTN","RMPRPIUH",139,0) ; If item has new number from previous update then use the temp map "RTN","RMPRPIUH",140,0) I $D(^TMP($J,"ITEM",RMPRHIEN,RMPRITM,RMPR11("SOURCE"),RMPRIM)) D G GETITMX "RTN","RMPRPIUH",141,0) . S RMPRS=^TMP($J,"ITEM",RMPRHIEN,RMPRITM,RMPR11("SOURCE"),RMPRIM) "RTN","RMPRPIUH",142,0) . S RMPR11("ITEM")=$P(RMPRS,"^",3) "RTN","RMPRPIUH",143,0) . Q "RTN","RMPRPIUH",144,0) ; "RTN","RMPRPIUH",145,0) ; If item number not already in use then can use it to create a new "RTN","RMPRPIUH",146,0) ; item in file 661.11 "RTN","RMPRPIUH",147,0) I '$D(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPRITM)) S RMPR11("ITEM")=RMPRITM G GETITM1 "RTN","RMPRPIUH",148,0) ; "RTN","RMPRPIUH",149,0) ; Ensure not duplicating Item number for different source "RTN","RMPRPIUH",150,0) S RMPRGOT=0 "RTN","RMPRPIUH",151,0) S RMPRI=$O(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPRITM,"")) "RTN","RMPRPIUH",152,0) S RMPRS=^RMPR(661.11,RMPRI,0) "RTN","RMPRPIUH",153,0) I $P(RMPRS,"^",5)=RMPR11("SOURCE") D "RTN","RMPRPIUH",154,0) . I $P(RMPRS,"^",8)=RMPR11("ITEM MASTER IEN") S RMPRGOT=1 Q "RTN","RMPRPIUH",155,0) . I $P(RMPRS,"^",8)="" D "RTN","RMPRPIUH",156,0) .. K RMPR11U "RTN","RMPRPIUH",157,0) .. S RMPR11U("IEN")=RMPRI "RTN","RMPRPIUH",158,0) .. S RMPR11U("ITEM MASTER IEN")=RMPR11("ITEM MASTER IEN") "RTN","RMPRPIUH",159,0) .. S RMPRERR=$$UPD^RMPRPIX1(.RMPR11U) "RTN","RMPRPIUH",160,0) .. S RMPRGOT=1 "RTN","RMPRPIUH",161,0) .. Q "RTN","RMPRPIUH",162,0) . Q "RTN","RMPRPIUH",163,0) I RMPRGOT S RMPR11("ITEM")=RMPRITM G GETITMX "RTN","RMPRPIUH",164,0) S RMPR11("ITEM")="" ; ensure new item will be created "RTN","RMPRPIUH",165,0) GETITM1 S RMPRS=$G(^RMPR(661.1,RMPRHIEN,3,RMPRITM,0)) "RTN","RMPRPIUH",166,0) S RMPR11("DESCRIPTION")=$P(RMPRS,"^",1) "RTN","RMPRPIUH",167,0) S:RMPR11("DESCRIPTION")="" RMPR11("DESCRIPTION")="NO DESCRIPTION" "RTN","RMPRPIUH",168,0) S RMPRERR=$$CRE^RMPRPIX1(.RMPR11) "RTN","RMPRPIUH",169,0) ; "RTN","RMPRPIUH",170,0) ; map new HCPCS Item in 661.11 to old iens in 661.1 "RTN","RMPRPIUH",171,0) S RMPRS="" "RTN","RMPRPIUH",172,0) S $P(RMPRS,"^",1)=RMPR11("STATION") "RTN","RMPRPIUH",173,0) S $P(RMPRS,"^",2)=RMPR11("HCPCS") "RTN","RMPRPIUH",174,0) S $P(RMPRS,"^",3)=RMPR11("ITEM") "RTN","RMPRPIUH",175,0) S $P(RMPRS,"^",4)=RMPR11("IEN") "RTN","RMPRPIUH",176,0) S ^TMP($J,"ITEM",RMPRHIEN,RMPRITM,RMPR11("SOURCE"),RMPRIM)=RMPRS "RTN","RMPRPIUH",177,0) GETITMX Q "RTN","RMPRPIUI") 0^67^B7265008 "RTN","RMPRPIUI",1,0) RMPRPIUI ;HINCIO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:46 "RTN","RMPRPIUI",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUI",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPIUI",4,0) Q "RTN","RMPRPIUI",5,0) ; "RTN","RMPRPIUI",6,0) ;***** CONV - Convert Item records in 661.3 to 661.11 "RTN","RMPRPIUI",7,0) ; In the current PIP file design a HCPC Item is held as "RTN","RMPRPIUI",8,0) ; free text in the form HCPCS-ITEM where HCPCS is the "RTN","RMPRPIUI",9,0) ; HCPCS code (.01 field in 661.1 eg E0111) and ITEM is "RTN","RMPRPIUI",10,0) ; the ien (ptr) to the item held on the ^RMPR(661.3,,3,) "RTN","RMPRPIUI",11,0) ; multiple. "RTN","RMPRPIUI",12,0) ; In the new design ITEM will be a number and not a pointer. "RTN","RMPRPIUI",13,0) ; In this first pass through HCPCS Items the ITEM number "RTN","RMPRPIUI",14,0) ; will be the same as ITEM ien for all commercial items. "RTN","RMPRPIUI",15,0) ; Non-commercial items will have a different ITEM number "RTN","RMPRPIUI",16,0) ; from their ITEM ien only where commercial and "RTN","RMPRPIUI",17,0) ; non-commercial items have used the same HCPCS-ITEM code. "RTN","RMPRPIUI",18,0) ; Non-commercial items will be ignored on this pass. "RTN","RMPRPIUI",19,0) ; Any item whose Source field is not V "RTN","RMPRPIUI",20,0) ; is assumed commercial. "RTN","RMPRPIUI",21,0) ; "RTN","RMPRPIUI",22,0) CONV N RMPRHIEN,RMPRIIEN,RMPRHREC,RMPRIREC,RMPRHCPC,RMPRHIT,RMPRGBL "RTN","RMPRPIUI",23,0) N RMPR1,RMPR2,RMPR3,RMPRL13,RMPRI13,RMPR11,RMPRERR "RTN","RMPRPIUI",24,0) I '$D(IO("Q")) D "RTN","RMPRPIUI",25,0) . W !,"Creating HCPCS Items in file 661.11 - 1st pass " "RTN","RMPRPIUI",26,0) . Q "RTN","RMPRPIUI",27,0) ; "RTN","RMPRPIUI",28,0) ; Loop on HCPCS and Items as defined in the PSAS HCPCS file 661.1 "RTN","RMPRPIUI",29,0) S RMPRHIEN=0 "RTN","RMPRPIUI",30,0) HCPC S RMPRHIEN=$O(^RMPR(661.1,RMPRHIEN)) "RTN","RMPRPIUI",31,0) I '+RMPRHIEN G CONVX ;no more HCPCS so exit "RTN","RMPRPIUI",32,0) I '$D(IO("Q")) D "RTN","RMPRPIUI",33,0) . W:$X=79 ! W "." "RTN","RMPRPIUI",34,0) . Q "RTN","RMPRPIUI",35,0) S RMPRHREC=$G(^RMPR(661.1,RMPRHIEN,0)) ;HCPCS node "RTN","RMPRPIUI",36,0) S RMPRIIEN=0 "RTN","RMPRPIUI",37,0) ITEM S RMPRIIEN=$O(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN)) "RTN","RMPRPIUI",38,0) I '+RMPRIIEN G HCPC "RTN","RMPRPIUI",39,0) S RMPRIREC=$G(^RMPR(661.1,RMPRHIEN,3,RMPRIIEN,0)) ;HCPCS Item node "RTN","RMPRPIUI",40,0) S RMPRHCPC=$P(RMPRHREC,"^",1) "RTN","RMPRPIUI",41,0) I RMPRHCPC="" G ITEM "RTN","RMPRPIUI",42,0) S RMPRHIT=RMPRHCPC_"-"_RMPRIIEN "RTN","RMPRPIUI",43,0) ; "RTN","RMPRPIUI",44,0) ; create 661.11 rec if item in 661.3 (should be) "RTN","RMPRPIUI",45,0) S RMPRGBL="^RMPR(661.3,""D"","""_RMPRHIT_""")" "RTN","RMPRPIUI",46,0) LOCI S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIUI",47,0) I $QS(RMPRGBL,1)'=661.3 G ITEM "RTN","RMPRPIUI",48,0) I $QS(RMPRGBL,2)'="D" G ITEM "RTN","RMPRPIUI",49,0) I $QS(RMPRGBL,3)'=RMPRHIT G ITEM "RTN","RMPRPIUI",50,0) S RMPR1=$QS(RMPRGBL,4) G:RMPR1="" LOCI "RTN","RMPRPIUI",51,0) S RMPR2=$QS(RMPRGBL,5) G:RMPR2="" LOCI "RTN","RMPRPIUI",52,0) S RMPR3=$QS(RMPRGBL,6) G:RMPR3="" LOCI "RTN","RMPRPIUI",53,0) S RMPRL13=$G(^RMPR(661.3,RMPR1,0)) "RTN","RMPRPIUI",54,0) S RMPRI13=$G(^RMPR(661.3,RMPR1,1,RMPR2,1,RMPR3,0)) "RTN","RMPRPIUI",55,0) ; "RTN","RMPRPIUI",56,0) ; create 661.11 record "RTN","RMPRPIUI",57,0) K RMPR11 "RTN","RMPRPIUI",58,0) S RMPR11("STATION")=$P(RMPRL13,"^",3) ;Station must be in DIC(4 "RTN","RMPRPIUI",59,0) I RMPR11("STATION")="" G LOCI "RTN","RMPRPIUI",60,0) I '$D(^DIC(4,RMPR11("STATION"))) G LOCI "RTN","RMPRPIUI",61,0) I $P(RMPRI13,"^",9)="V" G LOCI ;ignore non-commercial items on this pass "RTN","RMPRPIUI",62,0) S RMPR11("SOURCE")="C" "RTN","RMPRPIUI",63,0) S RMPR11("HCPCS")=RMPRHCPC "RTN","RMPRPIUI",64,0) S RMPR11("ITEM")=RMPRIIEN "RTN","RMPRPIUI",65,0) I $D(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"))) G LOCI ;already defined "RTN","RMPRPIUI",66,0) S RMPR11("UNIT")=$P(RMPRI13,"^",4) "RTN","RMPRPIUI",67,0) S RMPR11("DESCRIPTION")=$P(RMPRIREC,"^",1) "RTN","RMPRPIUI",68,0) S RMPR11("ITEM MASTER IEN")="" "RTN","RMPRPIUI",69,0) S RMPRERR=$$CRE^RMPRPIX1(.RMPR11) "RTN","RMPRPIUI",70,0) G LOCI "RTN","RMPRPIUI",71,0) ; "RTN","RMPRPIUI",72,0) ;exit "RTN","RMPRPIUI",73,0) CONVX Q "RTN","RMPRPIUJ") 0^68^B7843461 "RTN","RMPRPIUJ",1,0) RMPRPIUJ ;HINES OIFO/ODJ - CONVERT OLD PIP TO NEW PIP ;3/8/05 11:47 "RTN","RMPRPIUJ",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUJ",3,0) ; DBIA #10090 - Read Access to entire file #4. "RTN","RMPRPIUJ",4,0) Q "RTN","RMPRPIUJ",5,0) ; "RTN","RMPRPIUJ",6,0) ;***** LOCN - Convert Locations in 661.3 to new 661.5 file "RTN","RMPRPIUJ",7,0) ; A GENERIC location will be created as a scratch "RTN","RMPRPIUJ",8,0) ; area. "RTN","RMPRPIUJ",9,0) ; Duplicate location names will not be allowed. "RTN","RMPRPIUJ",10,0) ; Build map file in ^TMP($J,"LOCN" which maps old "RTN","RMPRPIUJ",11,0) ; to new location iens. "RTN","RMPRPIUJ",12,0) ; "RTN","RMPRPIUJ",13,0) LOCN N RMPRSTN,RMPRLCN,RMPRTOD,RMPRL,RMPRCNT,RMPRREC,RMPRERR,RMPR5,RMPRI "RTN","RMPRPIUJ",14,0) N X,Y,DA "RTN","RMPRPIUJ",15,0) I '$D(IO("Q")) D "RTN","RMPRPIUJ",16,0) . W !,"Creating Locations in file 661.5 " "RTN","RMPRPIUJ",17,0) . Q "RTN","RMPRPIUJ",18,0) K ^TMP($J,"LOCN") "RTN","RMPRPIUJ",19,0) D NOW^%DTC "RTN","RMPRPIUJ",20,0) S RMPRTOD=X ; today's date "RTN","RMPRPIUJ",21,0) ; "RTN","RMPRPIUJ",22,0) ; Init RMPR5 "RTN","RMPRPIUJ",23,0) S RMPR5("STATUS")="A" ;active status "RTN","RMPRPIUJ",24,0) S RMPR5("STATUS DATE")=RMPRTOD ;status date is today's date "RTN","RMPRPIUJ",25,0) S RMPR5("USER")="" "RTN","RMPRPIUJ",26,0) S RMPRDUZ=$$GETUSR^RMPRPIU0(DUZ) "RTN","RMPRPIUJ",27,0) I $G(DUZ)'="",(RMPRDUZ'="") S RMPR5("USER")=DUZ "RTN","RMPRPIUJ",28,0) ; "RTN","RMPRPIUJ",29,0) ; Loop on Locations 661.3 "RTN","RMPRPIUJ",30,0) S RMPRL=0 "RTN","RMPRPIUJ",31,0) LOC1 S RMPRL=$O(^RMPR(661.3,RMPRL)) "RTN","RMPRPIUJ",32,0) I '+RMPRL G LOCNX ;exit if no more Locations "RTN","RMPRPIUJ",33,0) I '$D(IO("Q")) D "RTN","RMPRPIUJ",34,0) . W:$X=79 ! W "." "RTN","RMPRPIUJ",35,0) . Q "RTN","RMPRPIUJ",36,0) S RMPRREC=$G(^RMPR(661.3,RMPRL,0)) "RTN","RMPRPIUJ",37,0) K RMPR5("IEN") "RTN","RMPRPIUJ",38,0) S RMPR5("STATION")=$P(RMPRREC,"^",3) ; Station "RTN","RMPRPIUJ",39,0) I RMPR5("STATION")="" G LOC1 ;ignore if null Station "RTN","RMPRPIUJ",40,0) I '$D(^DIC(4,RMPR5("STATION"),0)) G LOC1 ;ignore if bad ptr. "RTN","RMPRPIUJ",41,0) ; "RTN","RMPRPIUJ",42,0) ; Create GENERIC stock location if 1st location @ Station "RTN","RMPRPIUJ",43,0) I '$D(^RMPR(661.5,"XSL",RMPR5("STATION"))) D "RTN","RMPRPIUJ",44,0) . S RMPR5("NAME")="GENERIC" "RTN","RMPRPIUJ",45,0) . S RMPR5("ADDRESS")="GENERIC STOCK LOCATION (SYSTEM)" "RTN","RMPRPIUJ",46,0) . S RMPRERR=$$CRE^RMPRPIX5(.RMPR5) "RTN","RMPRPIUJ",47,0) . K RMPR5("IEN") "RTN","RMPRPIUJ",48,0) . Q "RTN","RMPRPIUJ",49,0) ; "RTN","RMPRPIUJ",50,0) ; Create Location "RTN","RMPRPIUJ",51,0) S RMPR5("NAME")=$P(RMPRREC,"^",1) "RTN","RMPRPIUJ",52,0) S RMPR5("ADDRESS")=$P(RMPRREC,"^",2) "RTN","RMPRPIUJ",53,0) ; "RTN","RMPRPIUJ",54,0) ; Check for duplicate location name and force to be unique "RTN","RMPRPIUJ",55,0) I $D(^RMPR(661.5,"XSL",RMPR5("STATION"),RMPR5("NAME"))) D "RTN","RMPRPIUJ",56,0) . S RMPRCNT=2 "RTN","RMPRPIUJ",57,0) . F D Q:'$D(^RMPR(661.5,"XSL",RMPR5("STATION"),RMPR5("NAME"))) "RTN","RMPRPIUJ",58,0) .. S RMPR5("NAME")=RMPR5("NAME")_" ("_RMPRCNT_")" "RTN","RMPRPIUJ",59,0) .. S RMPRCNT=1+RMPRCNT "RTN","RMPRPIUJ",60,0) .. Q "RTN","RMPRPIUJ",61,0) . Q "RTN","RMPRPIUJ",62,0) ; "RTN","RMPRPIUJ",63,0) ; Create Location in new 661.5 file "RTN","RMPRPIUJ",64,0) S RMPRERR=$$CRE^RMPRPIX5(.RMPR5) "RTN","RMPRPIUJ",65,0) S ^TMP($J,"LOCN",RMPRL)=RMPR5("IEN") ; map old to new Locn. ien "RTN","RMPRPIUJ",66,0) ; "RTN","RMPRPIUJ",67,0) G LOC1 ;next Location "RTN","RMPRPIUJ",68,0) ; "RTN","RMPRPIUJ",69,0) ;exit "RTN","RMPRPIUJ",70,0) LOCNX Q "RTN","RMPRPIUJ",71,0) ; "RTN","RMPRPIUJ",72,0) UNIT ;update UNIT of issue #661.7 "RTN","RMPRPIUJ",73,0) N RI,RMDA,RMU,RHC,RIT,RST,R11DA,R11 "RTN","RMPRPIUJ",74,0) F RI=0:0 S RI=$O(^RMPR(661.7,RI)) Q:RI'>0 S RMDA=$G(^RMPR(661.7,RI,0)) D "RTN","RMPRPIUJ",75,0) .S RMU=$P(RMDA,U,9) "RTN","RMPRPIUJ",76,0) .Q:$G(RMU) "RTN","RMPRPIUJ",77,0) .S RHC=$P(RMDA,U,1),RIT=$P(RMDA,U,4),RST=$P(RMDA,U,5) "RTN","RMPRPIUJ",78,0) .S R11=$O(^RMPR(661.11,"ASHI",RST,RHC,RIT,0)) "RTN","RMPRPIUJ",79,0) .Q:'$G(R11) "RTN","RMPRPIUJ",80,0) .Q:'$D(^RMPR(661.11,R11,0)) "RTN","RMPRPIUJ",81,0) .S R11DA=$G(^RMPR(661.11,R11,0)),RMU=$P(R11DA,U,6) "RTN","RMPRPIUJ",82,0) .Q:'$G(RMU) "RTN","RMPRPIUJ",83,0) .S $P(^RMPR(661.7,RI,0),U,9)=RMU "RTN","RMPRPIUJ",84,0) Q "RTN","RMPRPIUK") 0^69^B19375579 "RTN","RMPRPIUK",1,0) RMPRPIUK ;HINCIO/ODJ - PIP CONVERSION UTILITIES (contd) ;3/8/01 "RTN","RMPRPIUK",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUK",3,0) Q "RTN","RMPRPIUK",4,0) ; "RTN","RMPRPIUK",5,0) ;***** REC - Create initial reconciliations "RTN","RMPRPIUK",6,0) ; These will balance the Patient Issues just created "RTN","RMPRPIUK",7,0) REC N RMPRGBL,RMPRS,RMPR6,RMPR11,RMPRDT,X1,X2,X,RMPRTIME,RMPR5,RMPR69 "RTN","RMPRPIUK",8,0) N RMPR9 "RTN","RMPRPIUK",9,0) I '$D(IO("Q")) D "RTN","RMPRPIUK",10,0) . W !,"Creating balancing reconciliations " "RTN","RMPRPIUK",11,0) . Q "RTN","RMPRPIUK",12,0) S RMPRGBL="^TMP("""_$J_""",""ISS"")" "RTN","RMPRPIUK",13,0) REC1 S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIUK",14,0) I $QS(RMPRGBL,2)'="ISS" G RECX "RTN","RMPRPIUK",15,0) I $QS(RMPRGBL,1)'=$J G RECX "RTN","RMPRPIUK",16,0) I '$D(IO("Q")) D "RTN","RMPRPIUK",17,0) . W:$X=79 ! W "." "RTN","RMPRPIUK",18,0) . Q "RTN","RMPRPIUK",19,0) S RMPR11("STATION")=$QS(RMPRGBL,3) "RTN","RMPRPIUK",20,0) S RMPR11("STATION IEN")=RMPR11("STATION") "RTN","RMPRPIUK",21,0) S RMPR11("HCPCS")=$QS(RMPRGBL,4) "RTN","RMPRPIUK",22,0) S RMPR11("ITEM")=$QS(RMPRGBL,5) "RTN","RMPRPIUK",23,0) S RMPR6("LOCATION")=$QS(RMPRGBL,6) "RTN","RMPRPIUK",24,0) S RMPR5("IEN")=RMPR6("LOCATION") "RTN","RMPRPIUK",25,0) S RMPR6("VENDOR")=$QS(RMPRGBL,7) "RTN","RMPRPIUK",26,0) S RMPR6("VENDOR IEN")=RMPR6("VENDOR") "RTN","RMPRPIUK",27,0) S RMPR6("COMMENT")="" "RTN","RMPRPIUK",28,0) S RMPR6("USER")=DUZ "RTN","RMPRPIUK",29,0) S RMPRS=@RMPRGBL "RTN","RMPRPIUK",30,0) S RMPR6("QUANTITY")=$P(RMPRS,"^",1) "RTN","RMPRPIUK",31,0) S RMPR6("VALUE")=$P(RMPRS,"^",2) "RTN","RMPRPIUK",32,0) ; "RTN","RMPRPIUK",33,0) ; ensure initial reconciliation date is the first one "RTN","RMPRPIUK",34,0) S X1=$O(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),"")) "RTN","RMPRPIUK",35,0) S X1=$P(X1,".",1) "RTN","RMPRPIUK",36,0) S X2=-2 "RTN","RMPRPIUK",37,0) D C^%DTC "RTN","RMPRPIUK",38,0) S RMPRDT=$P(X,".",1) "RTN","RMPRPIUK",39,0) ; "RTN","RMPRPIUK",40,0) ; compute DATE&TIME for initial reconciliation "RTN","RMPRPIUK",41,0) S RMPR6("DATE&TIME")="" "RTN","RMPRPIUK",42,0) F D Q:RMPR6("DATE&TIME")'="" "RTN","RMPRPIUK",43,0) . D NOW^%DTC "RTN","RMPRPIUK",44,0) . S RMPRTIME=RMPRDT_"."_$P(%,".",2) "RTN","RMPRPIUK",45,0) . I $D(^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME)) H (1+$R(3)) Q "RTN","RMPRPIUK",46,0) . L +^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPRTIME):0 E H (1+$R(3)) Q "RTN","RMPRPIUK",47,0) . S RMPR6("DATE&TIME")=RMPRTIME "RTN","RMPRPIUK",48,0) . Q "RTN","RMPRPIUK",49,0) ; "RTN","RMPRPIUK",50,0) ; create transaction "RTN","RMPRPIUK",51,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIUK",52,0) S RMPR6("TRAN TYPE")=9 "RTN","RMPRPIUK",53,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIUK",54,0) K RMPR69 "RTN","RMPRPIUK",55,0) S RMPR69("TRANS IEN")=RMPR6("IEN") "RTN","RMPRPIUK",56,0) S RMPR69("GAIN/LOSS")=RMPR6("QUANTITY") "RTN","RMPRPIUK",57,0) S RMPR69("GAIN/LOSS VALUE")=RMPR6("VALUE") "RTN","RMPRPIUK",58,0) S RMPRERR=$$CRE^RMPRPIXB(.RMPR69) "RTN","RMPRPIUK",59,0) L -^RMPR(661.6,"XHDS",RMPR11("HCPCS"),RMPR6("DATE&TIME")) "RTN","RMPRPIUK",60,0) G REC1 "RTN","RMPRPIUK",61,0) RECX Q "RTN","RMPRPIUK",62,0) ; "RTN","RMPRPIUK",63,0) ;***** BAL - update running balance file "RTN","RMPRPIUK",64,0) BAL N RMPR6,RMPR9,RMPRDT,RMPRS,RMPRH,RMPRI,RMPRD,RMPRQ,RMPRV,RMPRX,RMPRY "RTN","RMPRPIUK",65,0) N RMPRIEN,RMPRFME "RTN","RMPRPIUK",66,0) I '$D(IO("Q")) D "RTN","RMPRPIUK",67,0) . W !,"Creating Running Balance file 661.9 " "RTN","RMPRPIUK",68,0) . Q "RTN","RMPRPIUK",69,0) S RMPRS="" "RTN","RMPRPIUK",70,0) F S RMPRS=$O(^RMPR(661.6,"ASTHIDS",RMPRS)) Q:RMPRS="" D "RTN","RMPRPIUK",71,0) . I '$D(IO("Q")) D "RTN","RMPRPIUK",72,0) .. W:$X=79 ! W "." "RTN","RMPRPIUK",73,0) .. Q "RTN","RMPRPIUK",74,0) . S RMPRH="" "RTN","RMPRPIUK",75,0) . F S RMPRH=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH)) Q:RMPRH="" D "RTN","RMPRPIUK",76,0) .. S RMPRI="" "RTN","RMPRPIUK",77,0) .. F S RMPRI=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI)) Q:RMPRI="" D "RTN","RMPRPIUK",78,0) ... Q:'$D(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI)) "RTN","RMPRPIUK",79,0) ... S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,"")) "RTN","RMPRPIUK",80,0) ... S RMPRQ=0,RMPRV=0,RMPRX="" "RTN","RMPRPIUK",81,0) ... F S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX="" D "RTN","RMPRPIUK",82,0) .... S RMPRY="" "RTN","RMPRPIUK",83,0) .... F S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,9,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY="" D "RTN","RMPRPIUK",84,0) ..... S RMPR6=^RMPR(661.6,RMPRY,0) "RTN","RMPRPIUK",85,0) ..... S RMPRQ=RMPRQ+$P(RMPR6,"^",5) "RTN","RMPRPIUK",86,0) ..... S RMPRV=RMPRV+$P(RMPR6,"^",6) "RTN","RMPRPIUK",87,0) ..... Q "RTN","RMPRPIUK",88,0) .... Q "RTN","RMPRPIUK",89,0) ... I RMPRQ<0 S RMPRQ=0 "RTN","RMPRPIUK",90,0) ... I RMPRV<0 S RMPRV=0 "RTN","RMPRPIUK",91,0) ... K RMPR9,RMPRIEN,RMPRFME "RTN","RMPRPIUK",92,0) ... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1) "RTN","RMPRPIUK",93,0) ... S RMPR9(661.9,"+1,",1)=RMPRH "RTN","RMPRPIUK",94,0) ... S RMPR9(661.9,"+1,",2)=RMPRI "RTN","RMPRPIUK",95,0) ... S RMPR9(661.9,"+1,",4)=RMPRS "RTN","RMPRPIUK",96,0) ... S RMPR9(661.9,"+1,",7)=RMPRQ "RTN","RMPRPIUK",97,0) ... S RMPR9(661.9,"+1,",8)=RMPRV "RTN","RMPRPIUK",98,0) ... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME") "RTN","RMPRPIUK",99,0) ... F S RMPRD=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD)) Q:RMPRD="" D "RTN","RMPRPIUK",100,0) .... S RMPRX="" "RTN","RMPRPIUK",101,0) .... F S RMPRX=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX)) Q:RMPRX="" D "RTN","RMPRPIUK",102,0) ..... S RMPRY="" "RTN","RMPRPIUK",103,0) ..... F S RMPRY=$O(^RMPR(661.6,"ASTHIDS",RMPRS,3,RMPRH,RMPRI,RMPRD,RMPRX,RMPRY)) Q:RMPRY="" D "RTN","RMPRPIUK",104,0) ...... S RMPR6=^RMPR(661.6,RMPRY,0) "RTN","RMPRPIUK",105,0) ...... S RMPRQ=RMPRQ-$P(RMPR6,"^",5) "RTN","RMPRPIUK",106,0) ...... S RMPRV=RMPRV-$P(RMPR6,"^",6) "RTN","RMPRPIUK",107,0) ...... Q "RTN","RMPRPIUK",108,0) ..... Q "RTN","RMPRPIUK",109,0) .... K RMPR9,RMPRIEN,RMPRFME "RTN","RMPRPIUK",110,0) .... I RMPRQ<0 S RMPRQ=0 "RTN","RMPRPIUK",111,0) .... I RMPRV<0 S RMPRV=0 "RTN","RMPRPIUK",112,0) .... S RMPR9(661.9,"+1,",.01)=$P(RMPRD,".",1) "RTN","RMPRPIUK",113,0) .... S RMPR9(661.9,"+1,",1)=RMPRH "RTN","RMPRPIUK",114,0) .... S RMPR9(661.9,"+1,",2)=RMPRI "RTN","RMPRPIUK",115,0) .... S RMPR9(661.9,"+1,",4)=RMPRS "RTN","RMPRPIUK",116,0) .... S RMPR9(661.9,"+1,",7)=RMPRQ "RTN","RMPRPIUK",117,0) .... S RMPR9(661.9,"+1,",8)=RMPRV "RTN","RMPRPIUK",118,0) .... D UPDATE^DIE("","RMPR9","RMPRIEN","RMPRFME") "RTN","RMPRPIUK",119,0) .... Q "RTN","RMPRPIUK",120,0) ... Q "RTN","RMPRPIUK",121,0) .. Q "RTN","RMPRPIUK",122,0) . Q "RTN","RMPRPIUK",123,0) BALX Q "RTN","RMPRPIUT") 0^25^B22622238 "RTN","RMPRPIUT",1,0) RMPRPIUT ;HINCIO/ODJ - STOCK TRANSFER TRANSACTION ;3/8/01 "RTN","RMPRPIUT",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIUT",3,0) Q "RTN","RMPRPIUT",4,0) ; "RTN","RMPRPIUT",5,0) ;***** TRNF - create stock transfer transaction. "RTN","RMPRPIUT",6,0) ; implements business rules for transferring stock "RTN","RMPRPIUT",7,0) ; from one location to another. "RTN","RMPRPIUT",8,0) ; "RTN","RMPRPIUT",9,0) ; Inputs: "RTN","RMPRPIUT",10,0) ; RMPR - array with following elements... "RTN","RMPRPIUT",11,0) ; RMPR("QUANTITY") "RTN","RMPRPIUT",12,0) ; RMPR("VENDOR IEN") "RTN","RMPRPIUT",13,0) ; "RTN","RMPRPIUT",14,0) ; RMPR5F - array with 'From' Location data elements (661.5)... "RTN","RMPRPIUT",15,0) ; RMPR5F("IEN") - ien of 'From' Location "RTN","RMPRPIUT",16,0) ; "RTN","RMPRPIUT",17,0) ; RMPR5T - array with 'To' Location data elements (661.5)... "RTN","RMPRPIUT",18,0) ; RMPR5T("IEN") - ien of 'To' Location "RTN","RMPRPIUT",19,0) ; "RTN","RMPRPIUT",20,0) ; RMPR11 - array with HCPCS Item data elements (661.11)... "RTN","RMPRPIUT",21,0) ; RMPR11("STATION IEN") - Station number (ptr DIC(4,) "RTN","RMPRPIUT",22,0) ; RMPR11("HCPCS") - HCPCS Code "RTN","RMPRPIUT",23,0) ; RMPR11("ITEM") - HCPCS Item number "RTN","RMPRPIUT",24,0) ; "RTN","RMPRPIUT",25,0) ; Outputs: "RTN","RMPRPIUT",26,0) ; RMPRERR - error status returned by function "RTN","RMPRPIUT",27,0) ; 0 - no problems "RTN","RMPRPIUT",28,0) ; 1 - insufficient stock level at 'From' Location "RTN","RMPRPIUT",29,0) ; 19 - problem getting current stock level "RTN","RMPRPIUT",30,0) ; 29 - problem creating 'From' transfer "RTN","RMPRPIUT",31,0) ; 39 - problem creating 'To' transfer "RTN","RMPRPIUT",32,0) ; "RTN","RMPRPIUT",33,0) TRNF(RMPR,RMPR5F,RMPR5T,RMPR11) ; "RTN","RMPRPIUT",34,0) N RMPRERR,RMPR6,RMPR7,RMPR7E,RMPR4,RMPRTCOS "RTN","RMPRPIUT",35,0) S RMPRERR=0 "RTN","RMPRPIUT",36,0) S RMPR11("STATION")=RMPR11("STATION IEN") "RTN","RMPRPIUT",37,0) S RMPR7("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIUT",38,0) S RMPR7("LOCATION IEN")=RMPR5F("IEN") "RTN","RMPRPIUT",39,0) S RMPR7("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIUT",40,0) S RMPR7("ITEM")=RMPR11("ITEM") "RTN","RMPRPIUT",41,0) S RMPR7("UNIT")=$G(RMPR5F("UNIT")) "RTN","RMPRPIUT",42,0) S RMPR7("VENDOR IEN")=RMPR("VENDOR IEN") "RTN","RMPRPIUT",43,0) ; "RTN","RMPRPIUT",44,0) ; Lock file so that -ve stock not possible "RTN","RMPRPIUT",45,0) L +^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM")) "RTN","RMPRPIUT",46,0) ; "RTN","RMPRPIUT",47,0) ; Get item's total current stock for location and vendor "RTN","RMPRPIUT",48,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPR7) "RTN","RMPRPIUT",49,0) I RMPRERR S RMPRERR=19 G TRNFU ;error 19 problem getting cur. qty. "RTN","RMPRPIUT",50,0) ; "RTN","RMPRPIUT",51,0) ; If not enough available stock set error code 1 and exit "RTN","RMPRPIUT",52,0) I RMPR("QUANTITY")>RMPR7("QOH") D G TRNFU "RTN","RMPRPIUT",53,0) . S RMPRERR=1 "RTN","RMPRPIUT",54,0) . S RMPR("QOH")=RMPR7("QOH") "RTN","RMPRPIUT",55,0) . Q "RTN","RMPRPIUT",56,0) ; "RTN","RMPRPIUT",57,0) ; Continue the transaction "RTN","RMPRPIUT",58,0) S RMPR("STATION")=RMPR11("STATION IEN") "RTN","RMPRPIUT",59,0) S RMPR("LOCATION")=RMPR5F("IEN") "RTN","RMPRPIUT",60,0) S RMPR("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIUT",61,0) S RMPR("ITEM")=RMPR11("ITEM") "RTN","RMPRPIUT",62,0) S RMPRERR=$$QCOST(.RMPR,RMPR("QUANTITY"),.RMPRTCOS) "RTN","RMPRPIUT",63,0) S RMPR("VALUE")=RMPRTCOS "RTN","RMPRPIUT",64,0) ; "RTN","RMPRPIUT",65,0) ; Create transfer 'OUT' transaction (661.6) "RTN","RMPRPIUT",66,0) K RMPR6 "RTN","RMPRPIUT",67,0) S RMPR6("SEQUENCE")=1 "RTN","RMPRPIUT",68,0) S RMPR6("TRAN TYPE")=7 "RTN","RMPRPIUT",69,0) S RMPR6("COMMENT")=$G(RMPR("COMMENT")) "RTN","RMPRPIUT",70,0) S RMPR6("QUANTITY")=0-RMPR("QUANTITY") "RTN","RMPRPIUT",71,0) S RMPR6("VALUE")=0-RMPR("VALUE") "RTN","RMPRPIUT",72,0) S RMPR6("USER")=RMPR("USER") "RTN","RMPRPIUT",73,0) S RMPR6("LOCATION")=RMPR5F("IEN") "RTN","RMPRPIUT",74,0) S RMPR6("UNIT")=$G(RMPR5F("UNIT")) "RTN","RMPRPIUT",75,0) S RMPR6("VENDOR")=RMPR7("VENDOR IEN") "RTN","RMPRPIUT",76,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIUT",77,0) I RMPRERR S RMPRERR=29 G TRNFU ;error 29 'From' transfer 661.6 problem "RTN","RMPRPIUT",78,0) ; "RTN","RMPRPIUT",79,0) ; Create transfer 'IN' transaction (661.6) "RTN","RMPRPIUT",80,0) S RMPR6("QUANTITY")=RMPR("QUANTITY") "RTN","RMPRPIUT",81,0) S RMPR6("VALUE")=RMPR("VALUE") "RTN","RMPRPIUT",82,0) S RMPR6("LOCATION")=RMPR5T("IEN") "RTN","RMPRPIUT",83,0) S RMPR6("UNIT")=$G(RMPR5T("UNIT")) "RTN","RMPRPIUT",84,0) S RMPRERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIUT",85,0) I RMPRERR S RMPRERR=39 G TRNFU ;error 39 'To' transfer 661.6 problem "RTN","RMPRPIUT",86,0) ; "RTN","RMPRPIUT",87,0) ; See if need to create a PIP record in 661.4 "RTN","RMPRPIUT",88,0) I '$D(^RMPR(661.4,"ASLHI",RMPR11("STATION IEN"),RMPR5T("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D "RTN","RMPRPIUT",89,0) . K RMPR4 "RTN","RMPRPIUT",90,0) . S RMPR4("RE-ORDER QTY")=0 "RTN","RMPRPIUT",91,0) . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5T) "RTN","RMPRPIUT",92,0) . Q "RTN","RMPRPIUT",93,0) I RMPRERR S RMPRERR=39 G TRNFU "RTN","RMPRPIUT",94,0) ; "RTN","RMPRPIUT",95,0) ; Update current stock "RTN","RMPRPIUT",96,0) K RMPR7E "RTN","RMPRPIUT",97,0) S RMPR7E("TRNF QTY")=RMPR("QUANTITY") "RTN","RMPRPIUT",98,0) S RMPR7E("TRNF VALUE")=RMPR("VALUE") "RTN","RMPRPIUT",99,0) S RMPR7E("VENDOR IEN")=RMPR("VENDOR IEN") "RTN","RMPRPIUT",100,0) S RMPR7E("UNIT")=$G(RMPR("UNIT")) "RTN","RMPRPIUT",101,0) S RMPRERR=$$TRNF^RMPRPIUC(.RMPR11,.RMPR5F,.RMPR5T,.RMPR7E) "RTN","RMPRPIUT",102,0) I RMPRERR S RMPRERR=49 G TRNFU ;error 49 current stock update problem "RTN","RMPRPIUT",103,0) ; "RTN","RMPRPIUT",104,0) ; exit points "RTN","RMPRPIUT",105,0) TRNFU L -^RMPR(661.7,"XSLHIDS",RMPR7("STATION IEN"),RMPR7("LOCATION IEN"),RMPR7("HCPCS"),RMPR7("ITEM")) "RTN","RMPRPIUT",106,0) TRNFX Q RMPRERR "RTN","RMPRPIUT",107,0) ; "RTN","RMPRPIUT",108,0) ; Work out total cost of quantity based on FIFO principles "RTN","RMPRPIUT",109,0) QCOST(RMPRK,RMPRQTY,RMPRTCOS) ; "RTN","RMPRPIUT",110,0) N RMPRERR,RMPR,RMPR6,RMPR7,RMPRVNDR,RMPRQ,RMPRUVAL,RMPROLD,RMPREOF "RTN","RMPRPIUT",111,0) S RMPRERR=0 "RTN","RMPRPIUT",112,0) S RMPRTCOS=0 "RTN","RMPRPIUT",113,0) S RMPRQ=RMPRQTY "RTN","RMPRPIUT",114,0) M RMPR=RMPRK "RTN","RMPRPIUT",115,0) S RMPRVNDR=RMPRK("VENDOR IEN") "RTN","RMPRPIUT",116,0) QCOST1 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSLHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIUT",117,0) I RMPRERR S RMPRERR=1 G QCOSTX "RTN","RMPRPIUT",118,0) I RMPREOF G QCOSTX "RTN","RMPRPIUT",119,0) I RMPR("STATION")'=RMPRK("STATION") G QCOSTX "RTN","RMPRPIUT",120,0) I RMPR("LOCATION")'=RMPRK("LOCATION") G QCOSTX "RTN","RMPRPIUT",121,0) I RMPR("HCPCS")'=RMPRK("HCPCS") G QCOSTX "RTN","RMPRPIUT",122,0) I RMPR("ITEM")'=RMPRK("ITEM") G QCOSTX "RTN","RMPRPIUT",123,0) K RMPR7 M RMPR7=RMPR "RTN","RMPRPIUT",124,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIUT",125,0) I RMPRERR S RMPRERR=1 G QCOSTX "RTN","RMPRPIUT",126,0) K RMPR6 M RMPR6=RMPR S RMPR6("IEN")="" "RTN","RMPRPIUT",127,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIUT",128,0) S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIUT",129,0) I RMPRERR S RMPRERR=1 G QCOSTX "RTN","RMPRPIUT",130,0) I RMPR6("VENDOR IEN")'=RMPRVNDR G QCOST1 "RTN","RMPRPIUT",131,0) S RMPRUVAL=$J(RMPR7("VALUE")/RMPR7("QUANTITY"),"",2) "RTN","RMPRPIUT",132,0) S RMPRTCOS=RMPRTCOS+(RMPRQ*RMPRUVAL) "RTN","RMPRPIUT",133,0) I RMPR7("QUANTITY")0 F I=0:0 S I=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD,1,I)) Q:I'>0 D "RTN","RMPRPIX7",111,0) .Q:I'>0 "RTN","RMPRPIX7",112,0) .Q:'$D(^RMPR(661.7,I,0)) "RTN","RMPRPIX7",113,0) .S RM7=^RMPR(661.7,I,0) "RTN","RMPRPIX7",114,0) .S RMB7=$P(RM7,U,7) "RTN","RMPRPIX7",115,0) .S RMUB=RMUB+RMB7 "RTN","RMPRPIX7",116,0) Q RMUB "RTN","RMPRPIXA") 0^32^B86939765 "RTN","RMPRPIXA",1,0) RMPRPIXA ;HINCIO/ODJ - FILE 661.6 API ;3/8/01 "RTN","RMPRPIXA",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXA",3,0) Q "RTN","RMPRPIXA",4,0) ; "RTN","RMPRPIXA",5,0) ; SRCH "RTN","RMPRPIXA",6,0) SRCH(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPRFIND,RMPREOF) ; "RTN","RMPRPIXA",7,0) N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4 "RTN","RMPRPIXA",8,0) S RMPRRET=0 "RTN","RMPRPIXA",9,0) S RMPREOF=0 "RTN","RMPRPIXA",10,0) I RMPRXREF="XHDS" D G SRCHX "RTN","RMPRPIXA",11,0) . S RMPRK1=$G(RMPR("HCPCS")) "RTN","RMPRPIXA",12,0) . S RMPRK2=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXA",13,0) . S RMPRK3=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXA",14,0) . S RMPRK4=$G(RMPR("IEN")) "RTN","RMPRPIXA",15,0) . S RMPRFIND=0 "RTN","RMPRPIXA",16,0) . I RMPRK1="" D "RTN","RMPRPIXA",17,0) .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT) "RTN","RMPRPIXA",18,0) .. Q "RTN","RMPRPIXA",19,0) . E D "RTN","RMPRPIXA",20,0) .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1)) D Q "RTN","RMPRPIXA",21,0) ... S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXA",22,0) ... Q "RTN","RMPRPIXA",23,0) .. S RMPRFIND=1 "RTN","RMPRPIXA",24,0) .. Q "RTN","RMPRPIXA",25,0) . I RMPRK1="" S RMPREOF=1 Q "RTN","RMPRPIXA",26,0) . S RMPR("HCPCS")=RMPRK1 "RTN","RMPRPIXA",27,0) . I RMPRLEV="HCPCS" Q "RTN","RMPRPIXA",28,0) . S RMPRFIND=0 "RTN","RMPRPIXA",29,0) . I RMPRK2="" D "RTN","RMPRPIXA",30,0) .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT) "RTN","RMPRPIXA",31,0) .. Q "RTN","RMPRPIXA",32,0) . E D "RTN","RMPRPIXA",33,0) .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2)) D Q "RTN","RMPRPIXA",34,0) ... S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXA",35,0) ... Q "RTN","RMPRPIXA",36,0) .. S RMPRFIND=1 "RTN","RMPRPIXA",37,0) .. Q "RTN","RMPRPIXA",38,0) . I RMPRK2="" S RMPREOF=1 Q "RTN","RMPRPIXA",39,0) . S RMPR("DATE&TIME")=RMPRK2 "RTN","RMPRPIXA",40,0) . I RMPRLEV="DATE&TIME" Q "RTN","RMPRPIXA",41,0) . S RMPRFIND=0 "RTN","RMPRPIXA",42,0) . I RMPRK3="" D "RTN","RMPRPIXA",43,0) .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) "RTN","RMPRPIXA",44,0) .. Q "RTN","RMPRPIXA",45,0) . E D "RTN","RMPRPIXA",46,0) .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3)) D Q "RTN","RMPRPIXA",47,0) ... S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXA",48,0) ... Q "RTN","RMPRPIXA",49,0) .. S RMPRFIND=1 "RTN","RMPRPIXA",50,0) .. Q "RTN","RMPRPIXA",51,0) . I RMPRK3="" S RMPREOF=1 Q "RTN","RMPRPIXA",52,0) . S RMPR("SEQUENCE")=RMPRK3 "RTN","RMPRPIXA",53,0) . I RMPRLEV="SEQUENCE" Q "RTN","RMPRPIXA",54,0) . S RMPRFIND=0 "RTN","RMPRPIXA",55,0) . I RMPRK4="" D "RTN","RMPRPIXA",56,0) .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) "RTN","RMPRPIXA",57,0) .. Q "RTN","RMPRPIXA",58,0) . E D "RTN","RMPRPIXA",59,0) .. I '$D(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4)) D Q "RTN","RMPRPIXA",60,0) ... S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXA",61,0) ... Q "RTN","RMPRPIXA",62,0) .. S RMPRFIND=1 "RTN","RMPRPIXA",63,0) .. Q "RTN","RMPRPIXA",64,0) . I RMPRK4="" S RMPREOF=1 Q "RTN","RMPRPIXA",65,0) . S RMPR("IEN")=RMPRK4 "RTN","RMPRPIXA",66,0) . Q "RTN","RMPRPIXA",67,0) SRCHX Q RMPRRET "RTN","RMPRPIXA",68,0) ; "RTN","RMPRPIXA",69,0) ; NEXT "RTN","RMPRPIXA",70,0) NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ; "RTN","RMPRPIXA",71,0) N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7 "RTN","RMPRPIXA",72,0) I $G(RMPRT)'=-1 S RMPRT=1 "RTN","RMPRPIXA",73,0) S RMPRRET=0,RMPREOF=0 "RTN","RMPRPIXA",74,0) ; "RTN","RMPRPIXA",75,0) ; HCPCS, Date&Time, Sequence X-ref "RTN","RMPRPIXA",76,0) I RMPRXREF="XHDS" D G NEXTX "RTN","RMPRPIXA",77,0) . S RMPRK1=$G(RMPR("HCPCS")) "RTN","RMPRPIXA",78,0) . S RMPRK2=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXA",79,0) . S RMPRK3=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXA",80,0) . S RMPRK4=$G(RMPR("IEN")) "RTN","RMPRPIXA",81,0) . I RMPRLEV="HCPCS" D Q:RMPREOF "RTN","RMPRPIXA",82,0) .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXA",83,0) .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q "RTN","RMPRPIXA",84,0) .. S (RMPRK2,RMPRK3,RMPRK4)="" "RTN","RMPRPIXA",85,0) .. Q "RTN","RMPRPIXA",86,0) . I RMPRLEV="DATE&TIME",RMPRK1'="" D "RTN","RMPRPIXA",87,0) .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXA",88,0) .. I RMPRK2="" S RMPREOF=1 "RTN","RMPRPIXA",89,0) .. S (RMPRK3,RMPRK4)="" "RTN","RMPRPIXA",90,0) .. Q "RTN","RMPRPIXA",91,0) . I RMPRLEV="SEQUENCE",RMPRK2'="" D "RTN","RMPRPIXA",92,0) .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXA",93,0) .. I RMPRK3="" S RMPREOF=1 "RTN","RMPRPIXA",94,0) .. S RMPRK4="" "RTN","RMPRPIXA",95,0) .. Q "RTN","RMPRPIXA",96,0) . I RMPRLEV="",RMPRK3'="" D "RTN","RMPRPIXA",97,0) .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXA",98,0) .. I RMPRK4="" S RMPREOF=1 "RTN","RMPRPIXA",99,0) .. Q "RTN","RMPRPIXA",100,0) . K RMPROLD "RTN","RMPRPIXA",101,0) . I RMPREOF D "RTN","RMPRPIXA",102,0) .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXA",103,0) .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXA",104,0) .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1 "RTN","RMPRPIXA",105,0) .. Q "RTN","RMPRPIXA",106,0) . I RMPRK1="",RMPREOF Q "RTN","RMPRPIXA",107,0) . S RMPREOF=0 "RTN","RMPRPIXA",108,0) . M RMPROLD=RMPR "RTN","RMPRPIXA",109,0) . I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT) "RTN","RMPRPIXA",110,0) . I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT) "RTN","RMPRPIXA",111,0) . I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) "RTN","RMPRPIXA",112,0) . I RMPRK3="" W !,"*** HCPCS = ",RMPRK1,!,"*** DATE = ",RMPRK2,!,"*** is not in file #661.6",!,"*** Please investigate!!!!" Q "RTN","RMPRPIXA",113,0) . I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) "RTN","RMPRPIXA",114,0) . S RMPR("HCPCS")=RMPRK1 "RTN","RMPRPIXA",115,0) . S RMPR("DATE&TIME")=RMPRK2 "RTN","RMPRPIXA",116,0) . S RMPR("DATE")=$P(RMPRK2,".",1) "RTN","RMPRPIXA",117,0) . S RMPR("TIME")=$P(RMPRK2,".",2) "RTN","RMPRPIXA",118,0) . S RMPR("SEQUENCE")=RMPRK3 "RTN","RMPRPIXA",119,0) . S RMPR("IEN")=RMPRK4 "RTN","RMPRPIXA",120,0) . Q "RTN","RMPRPIXA",121,0) ; "RTN","RMPRPIXA",122,0) ; Station, Trans. Type, HCPCS, Item, Date&Time, Sequence X-ref. "RTN","RMPRPIXA",123,0) I RMPRXREF="ASTHIDS" D G NEXTX "RTN","RMPRPIXA",124,0) . S RMPRK1=$G(RMPR("STATION")) "RTN","RMPRPIXA",125,0) . S RMPRK2=$G(RMPR("TRAN TYPE")) "RTN","RMPRPIXA",126,0) . S RMPRK3=$G(RMPR("HCPCS")) "RTN","RMPRPIXA",127,0) . S RMPRK4=$G(RMPR("ITEM")) "RTN","RMPRPIXA",128,0) . S RMPRK5=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXA",129,0) . S RMPRK6=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXA",130,0) . S RMPRK7=$G(RMPR("IEN")) "RTN","RMPRPIXA",131,0) . I RMPRLEV="STATION" D Q:RMPREOF "RTN","RMPRPIXA",132,0) .. S RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXA",133,0) .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q "RTN","RMPRPIXA",134,0) .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXA",135,0) .. Q "RTN","RMPRPIXA",136,0) . I RMPRLEV="TRAN TYPE",RMPRK1'="" D "RTN","RMPRPIXA",137,0) .. S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXA",138,0) .. I RMPRK2="" S RMPREOF=1 "RTN","RMPRPIXA",139,0) .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXA",140,0) .. Q "RTN","RMPRPIXA",141,0) . I RMPRLEV="HCPCS",RMPRK2'="" D "RTN","RMPRPIXA",142,0) .. S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXA",143,0) .. I RMPRK3="" S RMPREOF=1 "RTN","RMPRPIXA",144,0) .. S (RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXA",145,0) .. Q "RTN","RMPRPIXA",146,0) . I RMPRLEV="ITEM",RMPRK3'="" D "RTN","RMPRPIXA",147,0) .. S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXA",148,0) .. I RMPRK4="" S RMPREOF=1 "RTN","RMPRPIXA",149,0) .. S (RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXA",150,0) .. Q "RTN","RMPRPIXA",151,0) . I RMPRLEV="DATE&TIME",RMPRK4'="" D "RTN","RMPRPIXA",152,0) .. S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXA",153,0) .. I RMPRK5="" S RMPREOF=1 "RTN","RMPRPIXA",154,0) .. S (RMPRK6,RMPRK7)="" "RTN","RMPRPIXA",155,0) .. Q "RTN","RMPRPIXA",156,0) . I RMPRLEV="SEQUENCE",RMPRK5'="" D "RTN","RMPRPIXA",157,0) .. S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT) "RTN","RMPRPIXA",158,0) .. I RMPRK6="" S RMPREOF=1 "RTN","RMPRPIXA",159,0) .. S RMPRK7="" "RTN","RMPRPIXA",160,0) .. Q "RTN","RMPRPIXA",161,0) . I RMPRLEV="",RMPRK6'="" D "RTN","RMPRPIXA",162,0) .. S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT) "RTN","RMPRPIXA",163,0) .. I RMPRK7="" S RMPREOF=1 "RTN","RMPRPIXA",164,0) .. Q "RTN","RMPRPIXA",165,0) . K RMPROLD "RTN","RMPRPIXA",166,0) . I RMPREOF D "RTN","RMPRPIXA",167,0) .. I RMPRK7="" S:RMPRK6'="" RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT) "RTN","RMPRPIXA",168,0) .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXA",169,0) .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXA",170,0) .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXA",171,0) .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXA",172,0) .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.6,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1 "RTN","RMPRPIXA",173,0) .. Q "RTN","RMPRPIXA",174,0) . I RMPRK1="",RMPREOF Q "RTN","RMPRPIXA",175,0) . M RMPROLD=RMPR "RTN","RMPRPIXA",176,0) . I RMPRK1="" S RMPRK1=$O(^RMPR(661.6,RMPRXREF,""),RMPRT) "RTN","RMPRPIXA",177,0) . I RMPRK2="" S RMPRK2=$O(^RMPR(661.6,RMPRXREF,RMPRK1,""),RMPRT) "RTN","RMPRPIXA",178,0) . I RMPRK3="" S RMPRK3=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) "RTN","RMPRPIXA",179,0) . I RMPRK4="" S RMPRK4=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) "RTN","RMPRPIXA",180,0) . I RMPRK5="" S RMPRK5=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT) "RTN","RMPRPIXA",181,0) . I RMPRK6="" S RMPRK6=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT) "RTN","RMPRPIXA",182,0) . I RMPRK7="" S RMPRK7=$O(^RMPR(661.6,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT) "RTN","RMPRPIXA",183,0) . S RMPR("STATION")=RMPRK1 "RTN","RMPRPIXA",184,0) . S RMPR("TRAN TYPE")=RMPRK2 "RTN","RMPRPIXA",185,0) . S RMPR("HCPCS")=RMPRK3 "RTN","RMPRPIXA",186,0) . S RMPR("ITEM")=RMPRK4 "RTN","RMPRPIXA",187,0) . S RMPR("DATE&TIME")=RMPRK5 "RTN","RMPRPIXA",188,0) . S RMPR("SEQUENCE")=RMPRK6 "RTN","RMPRPIXA",189,0) . S RMPR("IEN")=RMPRK7 "RTN","RMPRPIXA",190,0) . Q "RTN","RMPRPIXA",191,0) NEXTX Q RMPRRET "RTN","RMPRPIXA",192,0) ; "RTN","RMPRPIXA",193,0) ; CRE "RTN","RMPRPIXA",194,0) CRE(RMPR616,RMPR6111) ; "RTN","RMPRPIXA",195,0) N RMPRRET,RMPRIENA,RMPRFDA,RMPRFME,X,Y,% "RTN","RMPRPIXA",196,0) N %,%H,%I,X "RTN","RMPRPIXA",197,0) S RMPRRET=0 "RTN","RMPRPIXA",198,0) ; "RTN","RMPRPIXA",199,0) ; Get DATE&TIME for transaction and lock the file "RTN","RMPRPIXA",200,0) S RMPR616("DATE&TIME")="" "RTN","RMPRPIXA",201,0) F D Q:RMPR616("DATE&TIME")'="" "RTN","RMPRPIXA",202,0) . D NOW^%DTC "RTN","RMPRPIXA",203,0) . I $D(^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%,1)) H (1+$R(3)) Q "RTN","RMPRPIXA",204,0) . L +^RMPR(661.6,"XHDS",RMPR616("HCPCS"),%):0 E Q "RTN","RMPRPIXA",205,0) . S RMPR616("DATE&TIME")=% "RTN","RMPRPIXA",206,0) . Q "RTN","RMPRPIXA",207,0) S RMPRFDA(661.6,"+1,",.01)=RMPR6111("HCPCS") "RTN","RMPRPIXA",208,0) S RMPRFDA(661.6,"+1,",2)=RMPR616("DATE&TIME") "RTN","RMPRPIXA",209,0) S RMPRFDA(661.6,"+1,",3)=RMPR616("SEQUENCE") "RTN","RMPRPIXA",210,0) S RMPRFDA(661.6,"+1,",4)=RMPR616("TRAN TYPE") "RTN","RMPRPIXA",211,0) S RMPRFDA(661.6,"+1,",5)=RMPR616("QUANTITY") "RTN","RMPRPIXA",212,0) S RMPRFDA(661.6,"+1,",6)=RMPR616("VALUE") "RTN","RMPRPIXA",213,0) S RMPRFDA(661.6,"+1,",8)=RMPR616("COMMENT") "RTN","RMPRPIXA",214,0) S RMPRFDA(661.6,"+1,",9)=RMPR616("USER") "RTN","RMPRPIXA",215,0) S RMPRFDA(661.6,"+1,",11)=RMPR6111("ITEM") "RTN","RMPRPIXA",216,0) S RMPRFDA(661.6,"+1,",12)=RMPR616("VENDOR") "RTN","RMPRPIXA",217,0) S RMPRFDA(661.6,"+1,",13)=RMPR6111("STATION") "RTN","RMPRPIXA",218,0) S RMPRFDA(661.6,"+1,",14)=RMPR616("LOCATION") "RTN","RMPRPIXA",219,0) D UPDATE^DIE("","RMPRFDA","RMPRIENA","RMPRFME") "RTN","RMPRPIXA",220,0) L -^RMPR(661.6,"XHDS",RMPR616("HCPCS"),RMPR616("DATE&TIME")) "RTN","RMPRPIXA",221,0) I $D(RMPRFME) S RMPRRET=1 G CREX "RTN","RMPRPIXA",222,0) S RMPR616("IEN")=RMPRIENA(1) "RTN","RMPRPIXA",223,0) CREX Q RMPRRET "RTN","RMPRPIXA",224,0) ; "RTN","RMPRPIXA",225,0) ; GET "RTN","RMPRPIXA",226,0) GET(RMPR) ; "RTN","RMPRPIXA",227,0) N RMPRRET,RMPRFME,RMPRIEN,RMPRKEY,RMPRERR,RMPROUP "RTN","RMPRPIXA",228,0) S RMPRRET=0 "RTN","RMPRPIXA",229,0) I $G(RMPR("IEN"))="" D "RTN","RMPRPIXA",230,0) . I $G(RMPR("HCPCS"))="" S RMPRRET=1 Q "RTN","RMPRPIXA",231,0) . I $G(RMPR("DATE&TIME"))="" S RMPRRET=2 Q "RTN","RMPRPIXA",232,0) . S RMPRKEY("HCPCS")=RMPR("HCPCS") "RTN","RMPRPIXA",233,0) . S RMPRKEY("DATE&TIME")=RMPR("DATE&TIME") "RTN","RMPRPIXA",234,0) . S RMPRERR=$$NEXT(.RMPRKEY,"XHDS","",-1,,.RMPREOF) "RTN","RMPRPIXA",235,0) . I RMPRERR S RMPRRET=3 Q "RTN","RMPRPIXA",236,0) . I RMPRKEY("SEQUENCE")'=1 S RMPRRET=4 Q "RTN","RMPRPIXA",237,0) . S RMPR("IEN")=RMPRKEY("IEN") "RTN","RMPRPIXA",238,0) . Q "RTN","RMPRPIXA",239,0) I RMPRRET G GETX "RTN","RMPRPIXA",240,0) S RMPRIEN=RMPR("IEN")_"," "RTN","RMPRPIXA",241,0) D GETS^DIQ(661.6,RMPRIEN,"*","","RMPROUP","RMPRFME") "RTN","RMPRPIXA",242,0) I $D(RMPRFME) S RMPRRET=5 G GETX "RTN","RMPRPIXA",243,0) S RMPR("HCPCS")=RMPROUP(661.6,RMPRIEN,.01) "RTN","RMPRPIXA",244,0) S RMPR("DATE&TIME")=RMPROUP(661.6,RMPRIEN,2) "RTN","RMPRPIXA",245,0) S RMPR("SEQUENCE")=RMPROUP(661.6,RMPRIEN,3) "RTN","RMPRPIXA",246,0) S RMPR("TRAN TYPE")=RMPROUP(661.6,RMPRIEN,4) "RTN","RMPRPIXA",247,0) S RMPR("QUANTITY")=RMPROUP(661.6,RMPRIEN,5) "RTN","RMPRPIXA",248,0) S RMPR("VALUE")=RMPROUP(661.6,RMPRIEN,6) "RTN","RMPRPIXA",249,0) S RMPR("COMMENT")=RMPROUP(661.6,RMPRIEN,8) "RTN","RMPRPIXA",250,0) S RMPR("USER")=RMPROUP(661.6,RMPRIEN,9) "RTN","RMPRPIXA",251,0) S RMPR("ITEM")=RMPROUP(661.6,RMPRIEN,11) "RTN","RMPRPIXA",252,0) S RMPR("VENDOR")=RMPROUP(661.6,RMPRIEN,12) "RTN","RMPRPIXA",253,0) S RMPR("STATION")=RMPROUP(661.6,RMPRIEN,13) "RTN","RMPRPIXA",254,0) S RMPR("LOCATION")=RMPROUP(661.6,RMPRIEN,14) "RTN","RMPRPIXA",255,0) GETX Q RMPRRET "RTN","RMPRPIXB") 0^33^B3412569 "RTN","RMPRPIXB",1,0) RMPRPIXB ;HINCIO/ODJ - SUB TRANSACTION FILE 661.69 APIs ;3/8/01 "RTN","RMPRPIXB",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXB",3,0) Q "RTN","RMPRPIXB",4,0) ; "RTN","RMPRPIXB",5,0) ; CRE - Create a stock reconciliation gain/loss record (661.69) "RTN","RMPRPIXB",6,0) CRE(RMPR6) ; "RTN","RMPRPIXB",7,0) N RMPRERR,RMPRFDA,RMPRFME,RMPRIEN,X,Y,DA "RTN","RMPRPIXB",8,0) S RMPRERR=0 "RTN","RMPRPIXB",9,0) S RMPRFDA(661.69,"+1,",.01)=RMPR6("TRANS IEN") "RTN","RMPRPIXB",10,0) S RMPRFDA(661.69,"+1,",2)=RMPR6("GAIN/LOSS") "RTN","RMPRPIXB",11,0) S RMPRFDA(661.69,"+1,",3)=RMPR6("GAIN/LOSS VALUE") "RTN","RMPRPIXB",12,0) D UPDATE^DIE("","RMPRFDA","RMPRIEN","RMPRFME") "RTN","RMPRPIXB",13,0) I $D(RMPRFME) S RMPRERR=99 G CREX "RTN","RMPRPIXB",14,0) CREX Q RMPRERR "RTN","RMPRPIXB",15,0) ; "RTN","RMPRPIXB",16,0) ; UPD - Update a stock reconciliation gain/loss record "RTN","RMPRPIXB",17,0) UPD(RMPR69) ; "RTN","RMPRPIXB",18,0) N RMPRERR,RMPRFDA,RMPRIEN,RMPRFME,X,Y,DA "RTN","RMPRPIXB",19,0) S RMPRERR=0 "RTN","RMPRPIXB",20,0) S RMPRIEN=$O(^RMPR(661.69,"B",RMPR69("TRANS IEN"),"")) "RTN","RMPRPIXB",21,0) S RMPRIEN=RMPRIEN_"," "RTN","RMPRPIXB",22,0) S:$D(RMPR69("GAIN/LOSS")) RMPRFDA(661.69,RMPRIEN,2)=RMPR69("GAIN/LOSS") "RTN","RMPRPIXB",23,0) S:$D(RMPR69("GAIN/LOSS VALUE")) RMPRFDA(661.69,RMPRIEN,3)=RMPR69("GAIN/LOSS VALUE") "RTN","RMPRPIXB",24,0) D:$D(RMPRFDA) FILE^DIE("","RMPRFDA","RMPRFME") "RTN","RMPRPIXB",25,0) I $D(RMPRFME) S RMPRERR=3 "RTN","RMPRPIXB",26,0) UPDX Q RMPRERR "RTN","RMPRPIXB",27,0) ; "RTN","RMPRPIXB",28,0) ; GET - Get a stock reconciliation gain/loss record "RTN","RMPRPIXB",29,0) GET(RMPR6) ; "RTN","RMPRPIXB",30,0) N RMPRERR,RMPRFME,RMPROUP,RMPRIEN,X,Y,DA "RTN","RMPRPIXB",31,0) S RMPRERR=0 "RTN","RMPRPIXB",32,0) I $G(RMPR6("TRANS IEN"))="" S RMPRERR=1 G GETX "RTN","RMPRPIXB",33,0) S RMPRIEN=$O(^RMPR(661.69,"B",RMPR6("TRANS IEN"),"")) "RTN","RMPRPIXB",34,0) I RMPRIEN="" S RMPRERR=1 G GETX "RTN","RMPRPIXB",35,0) S RMPR6("IEN")=RMPRIEN "RTN","RMPRPIXB",36,0) S RMPRIEN=RMPRIEN_"," "RTN","RMPRPIXB",37,0) D GETS^DIQ(661.69,RMPRIEN,"*","","RMPROUP","RMPRFME") "RTN","RMPRPIXB",38,0) I $D(RMPRFME) S RMPRERR=1 G GETX "RTN","RMPRPIXB",39,0) S RMPR6("GAIN/LOSS")=RMPROUP(661.69,RMPRIEN,2) "RTN","RMPRPIXB",40,0) S RMPR6("GAIN/LOSS VALUE")=RMPROUP(661.69,RMPRIEN,3) "RTN","RMPRPIXB",41,0) GETX Q RMPRERR "RTN","RMPRPIXC") 0^71^B13016068 "RTN","RMPRPIXC",1,0) RMPRPIXC ;HINCIO/ODJ - APIs for 660 file ;3/8/01 "RTN","RMPRPIXC",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXC",3,0) Q "RTN","RMPRPIXC",4,0) ; "RTN","RMPRPIXC",5,0) ;***** GET - read in 660 patient 2319 record "RTN","RMPRPIXC",6,0) GET(RMPR60,RMPR11) ; "RTN","RMPRPIXC",7,0) N RMPRI,RMPRA,RMPRFME,RMPRERR,RMPRLIN,RMPRC "RTN","RMPRPIXC",8,0) S RMPRERR=0 "RTN","RMPRPIXC",9,0) I $G(RMPR60("IEN"))="" S RMPRERR=1 G GETX "RTN","RMPRPIXC",10,0) S RMPRI=RMPR60("IEN")_"," "RTN","RMPRPIXC",11,0) D GETS^DIQ(660,RMPRI,"*","","RMPRA","RMPRFME") "RTN","RMPRPIXC",12,0) I $D(RMPRFME) S RMPRERR=99 G GETX "RTN","RMPRPIXC",13,0) S RMPR60("ENTRY DATE")=RMPRA(660,RMPRI,.01) "RTN","RMPRPIXC",14,0) S RMPR60("PATIENT")=RMPRA(660,RMPRI,.02) "RTN","RMPRPIXC",15,0) S RMPR60("REQ DATE")=RMPRA(660,RMPRI,1) "RTN","RMPRPIXC",16,0) S RMPR60("ISSUE TYPE")=RMPRA(660,RMPRI,2) "RTN","RMPRPIXC",17,0) S RMPR60("IFCAP ITEM")=RMPRA(660,RMPRI,4) "RTN","RMPRPIXC",18,0) S RMPR60("QUANTITY")=RMPRA(660,RMPRI,5) "RTN","RMPRPIXC",19,0) S RMPR11("UNIT")=RMPRA(660,RMPRI,78) "RTN","RMPRPIXC",20,0) S RMPR60("UNIT")=RMPRA(660,RMPRI,78) "RTN","RMPRPIXC",21,0) S RMPR60("VENDOR")=RMPRA(660,RMPRI,7) "RTN","RMPRPIXC",22,0) S RMPR11("STATION")=RMPRA(660,RMPRI,8) "RTN","RMPRPIXC",23,0) S RMPR60("SERIAL NUM")=RMPRA(660,RMPRI,9) "RTN","RMPRPIXC",24,0) S RMPR60("DELIV DATE")=RMPRA(660,RMPRI,10) "RTN","RMPRPIXC",25,0) S RMPR60("REQ TYPE")=RMPRA(660,RMPRI,11) "RTN","RMPRPIXC",26,0) S RMPR11("SOURCE")=RMPRA(660,RMPRI,12) "RTN","RMPRPIXC",27,0) S RMPR60("COST")=RMPRA(660,RMPRI,14) "RTN","RMPRPIXC",28,0) S RMPR60("REMARKS")=RMPRA(660,RMPRI,16) "RTN","RMPRPIXC",29,0) S RMPR11("CPT CODE")=RMPRA(660,RMPRI,4.1) "RTN","RMPRPIXC",30,0) S RMPR60("LOT NUM")=RMPRA(660,RMPRI,21) "RTN","RMPRPIXC",31,0) S RMPR60("USER")=RMPRA(660,RMPRI,27) "RTN","RMPRPIXC",32,0) ; "RTN","RMPRPIXC",33,0) ; for the type 1 rec. "RTN","RMPRPIXC",34,0) S RMPR11("SHORT DESC")=RMPRA(660,RMPRI,24) "RTN","RMPRPIXC",35,0) S RMPR11("IEN")=RMPRA(660,RMPRI,4.5) "RTN","RMPRPIXC",36,0) S RMPR60("CPT MOD")=RMPRA(660,RMPRI,4.7) "RTN","RMPRPIXC",37,0) ;S RMPR60("TRANS IEN")=RMPRA(660,RMPRI,4.6) "RTN","RMPRPIXC",38,0) S RMPR60("TRANS IEN")=$P(^RMPR(660,RMPR60("IEN"),1),"^",5) "RTN","RMPRPIXC",39,0) ; "RTN","RMPRPIXC",40,0) ; for the type 2 rec. "RTN","RMPRPIXC",41,0) S RMPR11("HCPCS-ITEM")=RMPRA(660,RMPRI,37) "RTN","RMPRPIXC",42,0) S RMPR11("DESCRIPTION")=RMPRA(660,RMPRI,38) "RTN","RMPRPIXC",43,0) ; "RTN","RMPRPIXC",44,0) ; for the type AM rec. "RTN","RMPRPIXC",45,0) S RMPR60("PAT CAT")=RMPRA(660,RMPRI,62) "RTN","RMPRPIXC",46,0) S RMPR60("SPEC CAT")=RMPRA(660,RMPRI,63) "RTN","RMPRPIXC",47,0) ; "RTN","RMPRPIXC",48,0) ; for the type AMS rec. "RTN","RMPRPIXC",49,0) S RMPR60("AMIS GROUPER")=RMPRA(660,RMPRI,68) "RTN","RMPRPIXC",50,0) ; "RTN","RMPRPIXC",51,0) ; 'DES' "RTN","RMPRPIXC",52,0) S RMPRLIN="",RMPRC=0 "RTN","RMPRPIXC",53,0) F S RMPRLIN=$O(RMPRA(660,RMPRI,28,RMPRLIN)) Q:RMPRLIN="" D "RTN","RMPRPIXC",54,0) . S RMPRC=RMPRC+1 "RTN","RMPRPIXC",55,0) . S RMPR60("DES",RMPRC)=RMPRA(660,RMPRI,28,RMPRLIN) "RTN","RMPRPIXC",56,0) . Q "RTN","RMPRPIXC",57,0) GETX Q RMPRERR "RTN","RMPRPIXC",58,0) ; "RTN","RMPRPIXC",59,0) ;***** ETOI - convert external to internal form "RTN","RMPRPIXC",60,0) ETOI(RMPR60,RMPR11,RMPR60I,RMPR11I) ; "RTN","RMPRPIXC",61,0) N RMPRERR,RMPRFDA,RMPRFDI,RMPRFME,RMPRI,X,Y,DA "RTN","RMPRPIXC",62,0) S RMPRERR=0 "RTN","RMPRPIXC",63,0) S RMPRI=RMPR60("IEN")_"," "RTN","RMPRPIXC",64,0) D GETS^DIQ(660,RMPRI,"*","I","RMPRFDI","RMPRFME") "RTN","RMPRPIXC",65,0) I $D(RMPRFME) S RMPRERR=99 G ETOIX "RTN","RMPRPIXC",66,0) S RMPR60I("ENTRY DATE")=RMPRFDI(660,RMPRI,.01,"I") "RTN","RMPRPIXC",67,0) S RMPR60I("PATIENT")=RMPRFDI(660,RMPRI,.02,"I") "RTN","RMPRPIXC",68,0) S RMPR60I("REQ DATE")=RMPRFDI(660,RMPRI,1,"I") "RTN","RMPRPIXC",69,0) S RMPR60I("ISSUE TYPE")=RMPRFDI(660,RMPRI,2,"I") "RTN","RMPRPIXC",70,0) S RMPR60I("IFCAP ITEM")=$P(^RMPR(660,RMPR60("IEN"),0),"^",6) ;FM problem "RTN","RMPRPIXC",71,0) S RMPR60I("QUANTITY")=RMPRFDI(660,RMPRI,5,"I") "RTN","RMPRPIXC",72,0) S RMPR11I("UNIT")=RMPRFDI(660,RMPRI,78,"I") "RTN","RMPRPIXC",73,0) S RMPR60I("UNIT")=RMPRFDI(660,RMPRI,78,"I") "RTN","RMPRPIXC",74,0) S RMPR60I("VENDOR")=RMPRFDI(660,RMPRI,7,"I") "RTN","RMPRPIXC",75,0) S RMPR11I("STATION")=RMPRFDI(660,RMPRI,8,"I") "RTN","RMPRPIXC",76,0) S RMPR60I("SERIAL NUM")=RMPRFDI(660,RMPRI,9,"I") "RTN","RMPRPIXC",77,0) S RMPR60I("DELIV DATE")=RMPRFDI(660,RMPRI,10,"I") "RTN","RMPRPIXC",78,0) S RMPR60I("REQ TYPE")=RMPRFDI(660,RMPRI,11,"I") "RTN","RMPRPIXC",79,0) S RMPR11I("SOURCE")=RMPRFDI(660,RMPRI,12,"I") "RTN","RMPRPIXC",80,0) S RMPR60I("COST")=RMPRFDI(660,RMPRI,14,"I") "RTN","RMPRPIXC",81,0) S RMPR60I("REMARKS")=RMPRFDI(660,RMPRI,16,"I") "RTN","RMPRPIXC",82,0) S RMPR11I("CPT IEN")=RMPRFDI(660,RMPRI,4.1,"I") "RTN","RMPRPIXC",83,0) S RMPR60I("LOT NUM")=RMPRFDI(660,RMPRI,21,"I") "RTN","RMPRPIXC",84,0) ; "RTN","RMPRPIXC",85,0) ; for the type 1 rec. "RTN","RMPRPIXC",86,0) S RMPR11I("SHORT DESC")=RMPRFDI(660,RMPRI,24,"I") "RTN","RMPRPIXC",87,0) S RMPR11I("IEN")=RMPRFDI(660,RMPRI,4.5,"I") "RTN","RMPRPIXC",88,0) S RMPR60I("CPT MOD")=RMPRFDI(660,RMPRI,4.7,"I") "RTN","RMPRPIXC",89,0) ; "RTN","RMPRPIXC",90,0) ; for the type AM rec. "RTN","RMPRPIXC",91,0) S RMPR60I("PAT CAT")=RMPRFDI(660,RMPRI,62,"I") "RTN","RMPRPIXC",92,0) S RMPR60I("SPEC CAT")=RMPRFDI(660,RMPRI,63,"I") "RTN","RMPRPIXC",93,0) ETOIX Q RMPRERR "RTN","RMPRPIXD") 0^86^B1459622 "RTN","RMPRPIXD",1,0) RMPRPIXD ;HINCIO/ODJ - PROSTHETIC ITEM MASTER FILE 661.1 APIs ;3/8/01 "RTN","RMPRPIXD",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXD",3,0) Q "RTN","RMPRPIXD",4,0) ; "RTN","RMPRPIXD",5,0) ;***** GET - read Item Master 661 record "RTN","RMPRPIXD",6,0) GET(RMPR) ; "RTN","RMPRPIXD",7,0) N RMPRCRE,RMPRFME,RMPROUP,RMPRIEN,X,Y,DA,RMPRI "RTN","RMPRPIXD",8,0) S RMPRCRE=0 "RTN","RMPRPIXD",9,0) S RMPRIEN=RMPR("IEN")_"," "RTN","RMPRPIXD",10,0) D GETS^DIQ(661,RMPRIEN,"*","","RMPROUP","RMPRFME") "RTN","RMPRPIXD",11,0) I $D(RMPRFME) S RMPRCRE=1 G GETX "RTN","RMPRPIXD",12,0) S RMPR("ITEM MASTER")=RMPROUP(661,RMPRIEN,.01) "RTN","RMPRPIXD",13,0) S RMPRCRE=$$ETOI(.RMPR,.RMPRI) "RTN","RMPRPIXD",14,0) S RMPR("ITEM MASTER IEN")=RMPRI("ITEM MASTER IEN") "RTN","RMPRPIXD",15,0) GETX Q RMPRCRE "RTN","RMPRPIXD",16,0) ; "RTN","RMPRPIXD",17,0) ;***** ETOI - Convert external to internal form "RTN","RMPRPIXD",18,0) ETOI(RMPRE,RMPRI) ; "RTN","RMPRPIXD",19,0) N RMPRFDA,RMPRIEN,RMPRFDI,RMPRFME,RMPRERR,X,Y,DA "RTN","RMPRPIXD",20,0) S RMPRERR=0 "RTN","RMPRPIXD",21,0) S RMPRIEN=RMPRE("IEN")_"," "RTN","RMPRPIXD",22,0) D GETS^DIQ(661,RMPRIEN,"*","I","RMPRFDI","RMPRFME") "RTN","RMPRPIXD",23,0) I $D(RMPRFME) S RMPRERR=1 G ETOIX "RTN","RMPRPIXD",24,0) S RMPRI("IEN")=RMPRE("IEN") "RTN","RMPRPIXD",25,0) S RMPRI("ITEM MASTER IEN")=RMPRFDI(661,RMPRIEN,.01,"I") "RTN","RMPRPIXD",26,0) ETOIX Q RMPRERR "RTN","RMPRPIXE") 0^34^B87424057 "RTN","RMPRPIXE",1,0) RMPRPIXE ;HINCIO/ODJ-FILE 661.7 API ;3/8/01 "RTN","RMPRPIXE",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXE",3,0) Q "RTN","RMPRPIXE",4,0) ; "RTN","RMPRPIXE",5,0) ; NEXT - is used to get the next (or previous) record keys "RTN","RMPRPIXE",6,0) ; from an input set of keys, on file 661.7, using a "RTN","RMPRPIXE",7,0) ; specified cross-reference and key level. "RTN","RMPRPIXE",8,0) ; The following cross-references are currently supported... "RTN","RMPRPIXE",9,0) ; "RTN","RMPRPIXE",10,0) ; XHDS - HCPCS, Date&Time and Sequence "RTN","RMPRPIXE",11,0) ; XSHIDS - Station, HCPCS, Item, Date&Time and Sequence "RTN","RMPRPIXE",12,0) ; XSLHIDS - Station, Location, HCPCS, Item, "RTN","RMPRPIXE",13,0) ; Date&Time and Sequence "RTN","RMPRPIXE",14,0) ; "RTN","RMPRPIXE",15,0) ; Inputs: "RTN","RMPRPIXE",16,0) ; RMPR - an array of key values which define a record. "RTN","RMPRPIXE",17,0) ; The specification of this array is dependent on which "RTN","RMPRPIXE",18,0) ; cross-reference is entered (see below) "RTN","RMPRPIXE",19,0) ; RMPRXREF - The cross-reference used to order on (see above) "RTN","RMPRPIXE",20,0) ; RMPRLEV - The level of traversal. This is also dependent on "RTN","RMPRPIXE",21,0) ; which cross-reference is used (see below) "RTN","RMPRPIXE",22,0) ; RMPRT - Direction of traversal: 1 - Next (ascending) "RTN","RMPRPIXE",23,0) ; -1 - Previous (descending) "RTN","RMPRPIXE",24,0) ; RMPROLD - This is a copy of RMPR prior to changing RMPR values "RTN","RMPRPIXE",25,0) ; RMPREOF - End Of File flag: 1 - End Of File, 0 - not end of file "RTN","RMPRPIXE",26,0) ; "RTN","RMPRPIXE",27,0) ; XHDS x-ref: "RTN","RMPRPIXE",28,0) ; RMPR("HCPCS") "RTN","RMPRPIXE",29,0) ; RMPR("DATE&TIME") "RTN","RMPRPIXE",30,0) ; RMPR("SEQUENCE") "RTN","RMPRPIXE",31,0) ; RMPR("IEN") "RTN","RMPRPIXE",32,0) ; Set RMPRLEV to... "RTN","RMPRPIXE",33,0) ; "HCPCS" - HCPCS "RTN","RMPRPIXE",34,0) ; "DATE&TIME" - DATE&TIME "RTN","RMPRPIXE",35,0) ; "SEQUENCE" - SEQUENCE "RTN","RMPRPIXE",36,0) ; "" - All records "RTN","RMPRPIXE",37,0) ; "RTN","RMPRPIXE",38,0) ; XSHIDS x-ref: "RTN","RMPRPIXE",39,0) ; RMPR("STATION") "RTN","RMPRPIXE",40,0) ; RMPR("HCPCS") "RTN","RMPRPIXE",41,0) ; RMPR("ITEM") "RTN","RMPRPIXE",42,0) ; RMPR("DATE&TIME") "RTN","RMPRPIXE",43,0) ; RMPR("SEQUENCE") "RTN","RMPRPIXE",44,0) ; Set RMPRLEV to... "RTN","RMPRPIXE",45,0) ; "STATION" "RTN","RMPRPIXE",46,0) ; "HCPCS" "RTN","RMPRPIXE",47,0) ; "ITEM" "RTN","RMPRPIXE",48,0) ; "DATE&TIME" "RTN","RMPRPIXE",49,0) ; "SEQUENCE" "RTN","RMPRPIXE",50,0) ; "" "RTN","RMPRPIXE",51,0) NEXT(RMPR,RMPRXREF,RMPRLEV,RMPRT,RMPROLD,RMPREOF) ; "RTN","RMPRPIXE",52,0) N RMPRRET,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7 "RTN","RMPRPIXE",53,0) I $G(RMPRT)'=-1 S RMPRT=1 "RTN","RMPRPIXE",54,0) S RMPRRET=0,RMPREOF=0 "RTN","RMPRPIXE",55,0) ; "RTN","RMPRPIXE",56,0) ; HCPCS, Date&Time, Sequence X-ref "RTN","RMPRPIXE",57,0) I RMPRXREF="XHDS" D G NEXTX "RTN","RMPRPIXE",58,0) . S RMPRK1=$G(RMPR("HCPCS")) "RTN","RMPRPIXE",59,0) . S RMPRK2=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXE",60,0) . S RMPRK3=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXE",61,0) . S RMPRK4=$G(RMPR("IEN")) "RTN","RMPRPIXE",62,0) . I RMPRLEV="HCPCS" D Q:RMPREOF "RTN","RMPRPIXE",63,0) .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXE",64,0) .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q "RTN","RMPRPIXE",65,0) .. S (RMPRK2,RMPRK3,RMPRK4)="" "RTN","RMPRPIXE",66,0) .. Q "RTN","RMPRPIXE",67,0) . I RMPRLEV="DATE&TIME",RMPRK1'="" D "RTN","RMPRPIXE",68,0) .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",69,0) .. I RMPRK2="" S RMPREOF=1 "RTN","RMPRPIXE",70,0) .. S (RMPRK3,RMPRK4)="" "RTN","RMPRPIXE",71,0) .. Q "RTN","RMPRPIXE",72,0) . I RMPRLEV="SEQUENCE",RMPRK2'="" D "RTN","RMPRPIXE",73,0) .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",74,0) .. I RMPRK3="" S RMPREOF=1 "RTN","RMPRPIXE",75,0) .. S RMPRK4="" "RTN","RMPRPIXE",76,0) .. Q "RTN","RMPRPIXE",77,0) . I RMPRLEV="",RMPRK3'="" D "RTN","RMPRPIXE",78,0) .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXE",79,0) .. I RMPRK4="" S RMPREOF=1 "RTN","RMPRPIXE",80,0) .. Q "RTN","RMPRPIXE",81,0) . K RMPROLD "RTN","RMPRPIXE",82,0) . I RMPREOF D "RTN","RMPRPIXE",83,0) .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",84,0) .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",85,0) .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1 "RTN","RMPRPIXE",86,0) .. Q "RTN","RMPRPIXE",87,0) . I RMPRK1="",RMPREOF Q "RTN","RMPRPIXE",88,0) . S RMPREOF=0 "RTN","RMPRPIXE",89,0) . M RMPROLD=RMPR "RTN","RMPRPIXE",90,0) . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT) "RTN","RMPRPIXE",91,0) . Q:RMPRK1="" "RTN","RMPRPIXE",92,0) . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT) "RTN","RMPRPIXE",93,0) . Q:RMPRK2="" "RTN","RMPRPIXE",94,0) . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) "RTN","RMPRPIXE",95,0) . Q:RMPRK3="" "RTN","RMPRPIXE",96,0) . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) "RTN","RMPRPIXE",97,0) . S RMPR("HCPCS")=RMPRK1 "RTN","RMPRPIXE",98,0) . S RMPR("DATE&TIME")=RMPRK2 "RTN","RMPRPIXE",99,0) . S RMPR("SEQUENCE")=RMPRK3 "RTN","RMPRPIXE",100,0) . S RMPR("IEN")=RMPRK4 "RTN","RMPRPIXE",101,0) . Q "RTN","RMPRPIXE",102,0) ; "RTN","RMPRPIXE",103,0) ; Station, HCPCS, Item, Date&Time, Sequence X-ref. "RTN","RMPRPIXE",104,0) I RMPRXREF="XSHIDS" D G NEXTX "RTN","RMPRPIXE",105,0) . S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6)="" "RTN","RMPRPIXE",106,0) . S RMPRK1=$G(RMPR("STATION")) "RTN","RMPRPIXE",107,0) . S:RMPRK1'="" RMPRK2=$G(RMPR("HCPCS")) "RTN","RMPRPIXE",108,0) . S:RMPRK2'="" RMPRK3=$G(RMPR("ITEM")) "RTN","RMPRPIXE",109,0) . S:RMPRK3'="" RMPRK4=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXE",110,0) . S:RMPRK4'="" RMPRK5=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXE",111,0) . S:RMPRK5'="" RMPRK6=$G(RMPR("IEN")) "RTN","RMPRPIXE",112,0) . I RMPRLEV="STATION" D Q:RMPREOF "RTN","RMPRPIXE",113,0) .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXE",114,0) .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q "RTN","RMPRPIXE",115,0) .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6)="" "RTN","RMPRPIXE",116,0) .. Q "RTN","RMPRPIXE",117,0) . I RMPRLEV="HCPCS",RMPRK1'="" D "RTN","RMPRPIXE",118,0) .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",119,0) .. I RMPRK2="" S RMPREOF=1 "RTN","RMPRPIXE",120,0) .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6)="" "RTN","RMPRPIXE",121,0) .. Q "RTN","RMPRPIXE",122,0) . I RMPRLEV="ITEM",RMPRK2'="" D "RTN","RMPRPIXE",123,0) .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",124,0) .. I RMPRK3="" S RMPREOF=1 "RTN","RMPRPIXE",125,0) .. S (RMPRK4,RMPRK5,RMPRK6)="" "RTN","RMPRPIXE",126,0) .. Q "RTN","RMPRPIXE",127,0) . I RMPRLEV="DATE&TIME",RMPRK3'="" D "RTN","RMPRPIXE",128,0) .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXE",129,0) .. I RMPRK4="" S RMPREOF=1 "RTN","RMPRPIXE",130,0) .. S (RMPRK5,RMPRK6)="" "RTN","RMPRPIXE",131,0) .. Q "RTN","RMPRPIXE",132,0) . I RMPRLEV="SEQUENCE",RMPRK4'="" D "RTN","RMPRPIXE",133,0) .. S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXE",134,0) .. I RMPRK5="" S RMPREOF=1 "RTN","RMPRPIXE",135,0) .. S RMPRK6="" "RTN","RMPRPIXE",136,0) .. Q "RTN","RMPRPIXE",137,0) . I RMPRLEV="",RMPRK5'="" D "RTN","RMPRPIXE",138,0) .. S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT) "RTN","RMPRPIXE",139,0) .. I RMPRK6="" S RMPREOF=1 "RTN","RMPRPIXE",140,0) .. Q "RTN","RMPRPIXE",141,0) . K RMPROLD "RTN","RMPRPIXE",142,0) . I RMPREOF D "RTN","RMPRPIXE",143,0) .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXE",144,0) .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXE",145,0) .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",146,0) .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",147,0) .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1 "RTN","RMPRPIXE",148,0) .. Q "RTN","RMPRPIXE",149,0) . I RMPRK1="",RMPREOF Q "RTN","RMPRPIXE",150,0) . S RMPREOF=0 "RTN","RMPRPIXE",151,0) . M RMPROLD=RMPR "RTN","RMPRPIXE",152,0) . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT) I RMPRK1="" S RMPREOF=1 Q "RTN","RMPRPIXE",153,0) . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT) I RMPRK2="" S RMPREOF=1 Q "RTN","RMPRPIXE",154,0) . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) I RMPRK3="" S RMPREOF=1 Q "RTN","RMPRPIXE",155,0) . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) I RMPRK4="" S RMPREOF=1 Q "RTN","RMPRPIXE",156,0) . I RMPRK5="" S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT) I RMPRK5="" S RMPREOF=1 Q "RTN","RMPRPIXE",157,0) . I RMPRK6="" S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT) I RMPRK6="" S RMPREOF=1 Q "RTN","RMPRPIXE",158,0) . S RMPR("STATION")=RMPRK1 "RTN","RMPRPIXE",159,0) . S RMPR("HCPCS")=RMPRK2 "RTN","RMPRPIXE",160,0) . S RMPR("ITEM")=RMPRK3 "RTN","RMPRPIXE",161,0) . S RMPR("DATE&TIME")=RMPRK4 "RTN","RMPRPIXE",162,0) . S RMPR("SEQUENCE")=RMPRK5 "RTN","RMPRPIXE",163,0) . S RMPR("IEN")=RMPRK6 "RTN","RMPRPIXE",164,0) . Q "RTN","RMPRPIXE",165,0) ; "RTN","RMPRPIXE",166,0) ; Station, Location, HCPCS, Item, Date&Time, Sequence "RTN","RMPRPIXE",167,0) I RMPRXREF="XSLHIDS" D G NEXTX "RTN","RMPRPIXE",168,0) . S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",169,0) . S RMPRK1=$G(RMPR("STATION")) "RTN","RMPRPIXE",170,0) . S:RMPRK1'="" RMPRK2=$G(RMPR("LOCATION")) "RTN","RMPRPIXE",171,0) . S:RMPRK2'="" RMPRK3=$G(RMPR("HCPCS")) "RTN","RMPRPIXE",172,0) . S:RMPRK3'="" RMPRK4=$G(RMPR("ITEM")) "RTN","RMPRPIXE",173,0) . S:RMPRK4'="" RMPRK5=$G(RMPR("DATE&TIME")) "RTN","RMPRPIXE",174,0) . S:RMPRK5'="" RMPRK6=$G(RMPR("SEQUENCE")) "RTN","RMPRPIXE",175,0) . S:RMPRK6'="" RMPRK7=$G(RMPR("IEN")) "RTN","RMPRPIXE",176,0) . I RMPRLEV="STATION" D Q:RMPREOF "RTN","RMPRPIXE",177,0) .. S RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) "RTN","RMPRPIXE",178,0) .. I RMPRK1="" S RMPREOF=1 K RMPROLD Q "RTN","RMPRPIXE",179,0) .. S (RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",180,0) .. Q "RTN","RMPRPIXE",181,0) . I RMPRLEV="LOCATION",RMPRK1'="" D "RTN","RMPRPIXE",182,0) .. S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",183,0) .. I RMPRK2="" S RMPREOF=1 "RTN","RMPRPIXE",184,0) .. S (RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",185,0) .. Q "RTN","RMPRPIXE",186,0) . I RMPRLEV="HCPCS",RMPRK2'="" D "RTN","RMPRPIXE",187,0) .. S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",188,0) .. I RMPRK3="" S RMPREOF=1 "RTN","RMPRPIXE",189,0) .. S (RMPRK4,RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",190,0) .. Q "RTN","RMPRPIXE",191,0) . I RMPRLEV="ITEM",RMPRK3'="" D "RTN","RMPRPIXE",192,0) .. S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXE",193,0) .. I RMPRK4="" S RMPREOF=1 "RTN","RMPRPIXE",194,0) .. S (RMPRK5,RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",195,0) .. Q "RTN","RMPRPIXE",196,0) . I RMPRLEV="DATE&TIME",RMPRK4'="" D "RTN","RMPRPIXE",197,0) .. S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXE",198,0) .. I RMPRK5="" S RMPREOF=1 "RTN","RMPRPIXE",199,0) .. S (RMPRK6,RMPRK7)="" "RTN","RMPRPIXE",200,0) .. Q "RTN","RMPRPIXE",201,0) . I RMPRLEV="SEQUENCE",RMPRK5'="" D "RTN","RMPRPIXE",202,0) .. S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT) "RTN","RMPRPIXE",203,0) .. I RMPRK6="" S RMPREOF=1 "RTN","RMPRPIXE",204,0) .. S RMPRK7="" "RTN","RMPRPIXE",205,0) .. Q "RTN","RMPRPIXE",206,0) . I RMPRLEV="",RMPRK6'="" D "RTN","RMPRPIXE",207,0) .. S RMPRK7=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,RMPRK7),RMPRT) "RTN","RMPRPIXE",208,0) .. I RMPRK7="" S RMPREOF=1 "RTN","RMPRPIXE",209,0) .. Q "RTN","RMPRPIXE",210,0) . K RMPROLD "RTN","RMPRPIXE",211,0) . I RMPREOF D "RTN","RMPRPIXE",212,0) .. I RMPRK7="" S:RMPRK6'="" RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6),RMPRT) "RTN","RMPRPIXE",213,0) .. I RMPRK6="" S:RMPRK5'="" RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5),RMPRT) "RTN","RMPRPIXE",214,0) .. I RMPRK5="" S:RMPRK4'="" RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4),RMPRT) "RTN","RMPRPIXE",215,0) .. I RMPRK4="" S:RMPRK3'="" RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3),RMPRT) "RTN","RMPRPIXE",216,0) .. I RMPRK3="" S:RMPRK2'="" RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2),RMPRT) "RTN","RMPRPIXE",217,0) .. I RMPRK2="" S:RMPRK1'="" RMPRK1=$O(^RMPR(661.7,RMPRXREF,RMPRK1),RMPRT) S:RMPRK1="" RMPREOF=1 "RTN","RMPRPIXE",218,0) .. Q "RTN","RMPRPIXE",219,0) . I RMPRK1="",RMPREOF Q "RTN","RMPRPIXE",220,0) . S RMPREOF=0 "RTN","RMPRPIXE",221,0) . M RMPROLD=RMPR "RTN","RMPRPIXE",222,0) . I RMPRK1="" S RMPRK1=$O(^RMPR(661.7,RMPRXREF,""),RMPRT) I RMPRK1="" S RMPREOF=1 Q "RTN","RMPRPIXE",223,0) . I RMPRK2="" S RMPRK2=$O(^RMPR(661.7,RMPRXREF,RMPRK1,""),RMPRT) I RMPRK2="" S RMPREOF=1 Q "RTN","RMPRPIXE",224,0) . I RMPRK3="" S RMPRK3=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,""),RMPRT) I RMPRK3="" S RMPREOF=1 Q "RTN","RMPRPIXE",225,0) . I RMPRK4="" S RMPRK4=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,""),RMPRT) I RMPRK4="" S RMPREOF=1 Q "RTN","RMPRPIXE",226,0) . I RMPRK5="" S RMPRK5=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,""),RMPRT) I RMPRK5="" S RMPREOF=1 Q "RTN","RMPRPIXE",227,0) . I RMPRK6="" S RMPRK6=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,""),RMPRT) I RMPRK6="" S RMPREOF=1 Q "RTN","RMPRPIXE",228,0) . I RMPRK7="" S RMPRK7=$O(^RMPR(661.7,RMPRXREF,RMPRK1,RMPRK2,RMPRK3,RMPRK4,RMPRK5,RMPRK6,""),RMPRT) I RMPRK7="" S RMPREOF=1 Q "RTN","RMPRPIXE",229,0) . S RMPR("STATION")=RMPRK1 "RTN","RMPRPIXE",230,0) . S RMPR("LOCATION")=RMPRK2 "RTN","RMPRPIXE",231,0) . S RMPR("HCPCS")=RMPRK3 "RTN","RMPRPIXE",232,0) . S RMPR("ITEM")=RMPRK4 "RTN","RMPRPIXE",233,0) . S RMPR("DATE&TIME")=RMPRK5 "RTN","RMPRPIXE",234,0) . S RMPR("SEQUENCE")=RMPRK6 "RTN","RMPRPIXE",235,0) . S RMPR("IEN")=RMPRK7 "RTN","RMPRPIXE",236,0) . Q "RTN","RMPRPIXE",237,0) NEXTX Q RMPRRET "RTN","RMPRPIXF") 0^99^B18974461 "RTN","RMPRPIXF",1,0) RMPRPIXF ;HINES OIFO/ODJ - Cont of EI - Edit Locations ;10/7/02 14:46 "RTN","RMPRPIXF",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXF",3,0) Q "RTN","RMPRPIXF",4,0) ; "RTN","RMPRPIXF",5,0) ;***** TRANS - Modify current stock record "RTN","RMPRPIXF",6,0) TRANS K RMPR7M,RMPR6M "RTN","RMPRPIXF",7,0) ; "RTN","RMPRPIXF",8,0) I $G(RMHCC) D Q "RTN","RMPRPIXF",9,0) .;call deactivate the item "RTN","RMPRPIXF",10,0) .N RS,RL,RD,RV,R6 "RTN","RMPRPIXF",11,0) .S RS=RMPR11("STATION"),RL=RMPR5("IEN"),RD=RMPR7("DATE&TIME") "RTN","RMPRPIXF",12,0) .S RMPR6("QUANTITY")=0 "RTN","RMPRPIXF",13,0) .S R6=$O(^RMPR(661.6,"ASLD",RS,RL,RD,0)) I $D(^RMPR(661.6,R6,0)) S RV=$P(^RMPR(661.6,R6,0),U,12) "RTN","RMPRPIXF",14,0) .Q:'$G(RV) "RTN","RMPRPIXF",15,0) .S RMPR6("VENDOR")=RV "RTN","RMPRPIXF",16,0) .S RMPR6("VENDOR IEN")=RV "RTN","RMPRPIXF",17,0) .S RMPR11("HCPCS")=RH,RMPR11("ITEM")=RI,RMPR5("IEN")=RL "RTN","RMPRPIXF",18,0) .S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5) "RTN","RMPRPIXF",19,0) .I RMPRERR=1 W !!,"*** ERROR IN API RMPRPIU9 ***",! "RTN","RMPRPIXF",20,0) .;create a new entry "RTN","RMPRPIXF",21,0) .S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIXF",22,0) .S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIXF",23,0) .S RMPR6("QUANTITY")=RMPRQTY "RTN","RMPRPIXF",24,0) .S RMPR6("VALUE")=RMPRTVAL "RTN","RMPRPIXF",25,0) .S RMPR6("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIXF",26,0) .S RMPR6("UNIT")=RMPRUNI("IEN") "RTN","RMPRPIXF",27,0) .S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1) ;receipt API "RTN","RMPRPIXF",28,0) .I RMPRERR D "RTN","RMPRPIXF",29,0) .. W !!,"** Inventory could not be updated, please contact support",! "RTN","RMPRPIXF",30,0) .. Q "RTN","RMPRPIXF",31,0) .E D "RTN","RMPRPIXF",32,0) .. W !!,"** Inventory updated.",! "RTN","RMPRPIXF",33,0) .K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST "RTN","RMPRPIXF",34,0) ; "RTN","RMPRPIXF",35,0) ; Modify Vendor in the 661.6 transaction record if changed "RTN","RMPRPIXF",36,0) I RMPRVEND("IEN")'=RMPR6("VENDOR IEN") D "RTN","RMPRPIXF",37,0) . S RMPR6M("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIXF",38,0) . S RMPR6M("IEN")=RMPR6("IEN") "RTN","RMPRPIXF",39,0) . S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,) "RTN","RMPRPIXF",40,0) . K RMPR6M "RTN","RMPRPIXF",41,0) . Q "RTN","RMPRPIXF",42,0) K RMPR6I "RTN","RMPRPIXF",43,0) S RMPRERR=$$ETOI^RMPRPIX6(.RMPR6,.RMPR6I) "RTN","RMPRPIXF",44,0) ; "RTN","RMPRPIXF",45,0) ;if unit of issue changed "RTN","RMPRPIXF",46,0) I RMPRUNI("UNIT")'=RMPR7("UNIT") S RMPR7M("UNIT")=RMPRUNI("UNIT") D "RTN","RMPRPIXF",47,0) . S RMPR7M("IEN")=RMPR7("IEN") "RTN","RMPRPIXF",48,0) . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,) "RTN","RMPRPIXF",49,0) ; Modify Location in 661.6 and 661.7 if changed "RTN","RMPRPIXF",50,0) I RMPR6I("LOCATION")'=RMPR5("IEN") D "RTN","RMPRPIXF",51,0) . S RMPR6M("LOCATION")=RMPR5("IEN") "RTN","RMPRPIXF",52,0) . S RMPR6M("IEN")=RMPR6("IEN") "RTN","RMPRPIXF",53,0) . S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,) "RTN","RMPRPIXF",54,0) . S RMPR7M("LOCATION")=RMPR5("IEN") "RTN","RMPRPIXF",55,0) . S RMPR7M("IEN")=RMPR7("IEN") "RTN","RMPRPIXF",56,0) . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,) "RTN","RMPRPIXF",57,0) . K RMPR6M,RMPR7M "RTN","RMPRPIXF",58,0) . Q "RTN","RMPRPIXF",59,0) ; "RTN","RMPRPIXF",60,0) ; Modify Quantity or Value in current stock 661.7 record, the "RTN","RMPRPIXF",61,0) ; transaction record 661.6 and running balance 661.9, if changed "RTN","RMPRPIXF",62,0) I +RMPRQTY'=+RMPR6("QUANTITY")!(+RMPRTVAL'=+RMPR6("VALUE")) D "RTN","RMPRPIXF",63,0) . K RMPR69,RMPR9M "RTN","RMPRPIXF",64,0) . I RMPR6I("TRAN TYPE")=9 D "RTN","RMPRPIXF",65,0) .. S RMPR69("TRANS IEN")=RMPR6("IEN") "RTN","RMPRPIXF",66,0) .. S RMPRERR=$$GET^RMPRPIXB(.RMPR69) "RTN","RMPRPIXF",67,0) .. Q "RTN","RMPRPIXF",68,0) . S (RMPR9M("TQTY"),RMPR9M("TCST"),RMPRGLQ,RMPRGLAM)=0 "RTN","RMPRPIXF",69,0) . I +RMPRQTY'=+RMPR6("QUANTITY") D Q:RMPR7M("QUANTITY")<0 "RTN","RMPRPIXF",70,0) .. S RMPR6M("QUANTITY")=RMPRQTY "RTN","RMPRPIXF",71,0) .. S RMPRGLQ=RMPRQTY-RMPR6("QUANTITY") "RTN","RMPRPIXF",72,0) .. S RMPR7M("QUANTITY")=RMPR7("QUANTITY")+RMPRGLQ "RTN","RMPRPIXF",73,0) .. S RMPR9M("TQTY")=RMPRGLQ "RTN","RMPRPIXF",74,0) .. S:$D(RMPR69) RMPR69("GAIN/LOSS")=RMPR69("GAIN/LOSS")+RMPRGLQ "RTN","RMPRPIXF",75,0) .. Q "RTN","RMPRPIXF",76,0) . I +RMPRTVAL'=+RMPR6("VALUE") D "RTN","RMPRPIXF",77,0) .. S RMPR6M("VALUE")=RMPRTVAL "RTN","RMPRPIXF",78,0) .. S RMPRGLAM=RMPRTVAL-RMPR6("VALUE") "RTN","RMPRPIXF",79,0) .. S RMPR7M("VALUE")=RMPR7("VALUE")+RMPRGLAM,RMPR7M("VALUE")=$J(RMPR7M("VALUE"),0,2) "RTN","RMPRPIXF",80,0) .. S RMPR9M("TCST")=RMPRGLAM "RTN","RMPRPIXF",81,0) .. S:$D(RMPR69) RMPR69("GAIN/LOSS VALUE")=RMPR69("GAIN/LOSS VALUE")+RMPRGLAM "RTN","RMPRPIXF",82,0) .. Q "RTN","RMPRPIXF",83,0) . S RMPR7M("IEN")=RMPR7("IEN") "RTN","RMPRPIXF",84,0) . S RMPRERR=$$UPD^RMPRPIX7(.RMPR7M,) "RTN","RMPRPIXF",85,0) . S RMPR6M("IEN")=RMPR6("IEN") "RTN","RMPRPIXF",86,0) . S RMPRERR=$$UPD^RMPRPIX6(.RMPR6M,) "RTN","RMPRPIXF",87,0) . I $D(RMPR69) S RMPRERR=$$UPD^RMPRPIXB(.RMPR69) "RTN","RMPRPIXF",88,0) . S RMPR9M("STA")=RMPRSTN("IEN") "RTN","RMPRPIXF",89,0) . S RMPR9M("HCP")=RMPR11("HCPCS") "RTN","RMPRPIXF",90,0) . S RMPR9M("ITE")=RMPR11("ITEM") "RTN","RMPRPIXF",91,0) . S RMPRERR=$$DTIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIXF",92,0) . S RMPR9M("RDT")=$P(RMPR6("DATE&TIME"),".",1) "RTN","RMPRPIXF",93,0) . S RMPRERR=$$UPCR^RMPRPIXJ(.RMPR9M) "RTN","RMPRPIXF",94,0) . K RMPR7M,RMPR6M,RMPR9M "RTN","RMPRPIXF",95,0) . Q "RTN","RMPRPIXF",96,0) I $D(RMPR7M("QUANTITY")),RMPR7M("QUANTITY")<1 D G QTY^RMPRPIY6 "RTN","RMPRPIXF",97,0) . W !,"The quantity cannot be allowed because it would cause a",! "RTN","RMPRPIXF",98,0) . W "negative on hand quantity.",! "RTN","RMPRPIXF",99,0) . W "Please check your inventory and use the reconciliation option",! "RTN","RMPRPIXF",100,0) . W "as needed.",! "RTN","RMPRPIXF",101,0) . Q "RTN","RMPRPIXF",102,0) TRANSX I 'RMPRERR D "RTN","RMPRPIXF",103,0) . W !!,"** Item " "RTN","RMPRPIXF",104,0) . W RMPR11("HCPCS-ITEM") "RTN","RMPRPIXF",105,0) . W " was " "RTN","RMPRPIXF",106,0) . W "Edited by " "RTN","RMPRPIXF",107,0) . W $$GETUSR^RMPRPIU0(DUZ) "RTN","RMPRPIXF",108,0) . W:$D(RMPRGLQ) ": ("_$S(RMPRGLQ>0:"+",1:"")_RMPRGLQ_")" "RTN","RMPRPIXF",109,0) . W " @ Location ",RMPR5("NAME") "RTN","RMPRPIXF",110,0) . Q "RTN","RMPRPIXF",111,0) E D "RTN","RMPRPIXF",112,0) . W !!,"** The Item could not be modified due to a problem - please contact support" "RTN","RMPRPIXF",113,0) . Q "RTN","RMPRPIXF",114,0) Q "RTN","RMPRPIXI") 0^35^B1346142 "RTN","RMPRPIXI",1,0) RMPRPIXI ;HINCIO/ODJ - FILE 661.7 APIs ;3/8/01 "RTN","RMPRPIXI",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXI",3,0) Q "RTN","RMPRPIXI",4,0) ; "RTN","RMPRPIXI",5,0) ; Get Total Quantity On Hand at the HCPC level "RTN","RMPRPIXI",6,0) QOHH(RMPRHCPC,RMPRSTN,RMPRQOH) ; "RTN","RMPRPIXI",7,0) N RMPRERR,RMPR,RMPROLD,RMPREOF,RMPRIN "RTN","RMPRPIXI",8,0) S RMPRERR=0 "RTN","RMPRPIXI",9,0) S RMPRQOH("QUANTITY")="" "RTN","RMPRPIXI",10,0) S RMPRQOH("VALUE")="" "RTN","RMPRPIXI",11,0) ;I RMPRSTN="*" G QOHHS ; for all stations "RTN","RMPRPIXI",12,0) ; "RTN","RMPRPIXI",13,0) ; Sum over all HCPCS items for single station "RTN","RMPRPIXI",14,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPIXI",15,0) S RMPR("HCPCS")=RMPRHCPC "RTN","RMPRPIXI",16,0) QOHH1 S RMPRERR=$$NEXT^RMPRPIXE(.RMPR,"XSHIDS","",1,.RMPROLD,.RMPREOF) "RTN","RMPRPIXI",17,0) I RMPRERR G QOHHX "RTN","RMPRPIXI",18,0) I RMPREOF G QOHHX "RTN","RMPRPIXI",19,0) I RMPROLD("HCPCS")'=RMPR("HCPCS") G QOHHX "RTN","RMPRPIXI",20,0) K RMPRIN M RMPRIN=RMPR "RTN","RMPRPIXI",21,0) S RMPRERR=$$GET^RMPRPIX7(.RMPRIN) "RTN","RMPRPIXI",22,0) I RMPRERR G QOHHX "RTN","RMPRPIXI",23,0) S RMPRQOH("QUANTITY")=RMPRIN("QUANTITY")+RMPRQOH("QUANTITY") "RTN","RMPRPIXI",24,0) S RMPRQOH("VALUE")=RMPRIN("VALUE")+RMPRQOH("VALUE") "RTN","RMPRPIXI",25,0) G QOHH1 "RTN","RMPRPIXI",26,0) QOHHX Q RMPRERR "RTN","RMPRPIXJ") 0^36^B27737512 "RTN","RMPRPIXJ",1,0) RMPRPIXJ ;HIN/RVD - INVENTORY UTILITY UPDATE BALANCE ;2/13/01 "RTN","RMPRPIXJ",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXJ",3,0) ;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","RMPRPIXJ",4,0) W !,"***Invalid Entry!!!!" Q "RTN","RMPRPIXJ",5,0) ; "RTN","RMPRPIXJ",6,0) SVAL(RX) ;STARTING total Value. "RTN","RMPRPIXJ",7,0) ;The Starting total Value is the Total Value of the previous entry "RTN","RMPRPIXJ",8,0) ;date specified. If no previous entry, the Total Value will "RTN","RMPRPIXJ",9,0) ;be set to ZERO. "RTN","RMPRPIXJ",10,0) ; "RTN","RMPRPIXJ",11,0) ;pass variable station, hcpcs, hcpcs item and date in RX local array. "RTN","RMPRPIXJ",12,0) ; RX("STA") = station "RTN","RMPRPIXJ",13,0) ; RX("HCP") = HCPCS "RTN","RMPRPIXJ",14,0) ; RX("ITE") = HCPCS item "RTN","RMPRPIXJ",15,0) ; RX("RDT") = date (starting date) "RTN","RMPRPIXJ",16,0) ; REBAL = return variable (Starting Total Value based on the date) "RTN","RMPRPIXJ",17,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",18,0) S REBAL=0 "RTN","RMPRPIXJ",19,0) S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT") "RTN","RMPRPIXJ",20,0) Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL "RTN","RMPRPIXJ",21,0) S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1) "RTN","RMPRPIXJ",22,0) I '$G(RDATE) Q REBAL "RTN","RMPRPIXJ",23,0) S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0)) "RTN","RMPRPIXJ",24,0) S RDATA=$G(^RMPR(661.9,RI,0)) "RTN","RMPRPIXJ",25,0) S REBAL=$P(RDATA,U,9) "RTN","RMPRPIXJ",26,0) Q REBAL "RTN","RMPRPIXJ",27,0) ; "RTN","RMPRPIXJ",28,0) ; "RTN","RMPRPIXJ",29,0) CVAL(RX) ;CURRENT total Value "RTN","RMPRPIXJ",30,0) ;The Current total Value is the total value based on the date specified. "RTN","RMPRPIXJ",31,0) ;If the Date specified has no entry, the Current Total Value will be "RTN","RMPRPIXJ",32,0) ;extracted from the previous date entry. If it has no previous entry, "RTN","RMPRPIXJ",33,0) ;the Current Total Value will be set to ZERO. "RTN","RMPRPIXJ",34,0) ; "RTN","RMPRPIXJ",35,0) ;pass variable station, hcpcs, hcpcs item and date in RX local array. "RTN","RMPRPIXJ",36,0) ; RX("STA") = station "RTN","RMPRPIXJ",37,0) ; RX("HCP") = HCPCS "RTN","RMPRPIXJ",38,0) ; RX("ITE") = HCPCS item "RTN","RMPRPIXJ",39,0) ; RX("RDT") = date (current date) "RTN","RMPRPIXJ",40,0) ; REBAL = return variable (Current Total value based on the date) "RTN","RMPRPIXJ",41,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",42,0) S REBAL=0 "RTN","RMPRPIXJ",43,0) S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT") "RTN","RMPRPIXJ",44,0) Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL "RTN","RMPRPIXJ",45,0) S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0)) "RTN","RMPRPIXJ",46,0) I '$G(RI) D I '$G(RI) Q REBAL "RTN","RMPRPIXJ",47,0) .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1) "RTN","RMPRPIXJ",48,0) .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0)) "RTN","RMPRPIXJ",49,0) S RDATA=$G(^RMPR(661.9,RI,0)) "RTN","RMPRPIXJ",50,0) S REBAL=$P(RDATA,U,9) "RTN","RMPRPIXJ",51,0) Q REBAL "RTN","RMPRPIXJ",52,0) ; "RTN","RMPRPIXJ",53,0) ; "RTN","RMPRPIXJ",54,0) SQTY(RX) ;STARTING total Quantity. "RTN","RMPRPIXJ",55,0) ;The Starting total Quantity is the Total qty of the previous entry "RTN","RMPRPIXJ",56,0) ;date specified. If no previous entry, the Total qty will "RTN","RMPRPIXJ",57,0) ;be set to ZERO. "RTN","RMPRPIXJ",58,0) ; "RTN","RMPRPIXJ",59,0) ;pass variable station, hcpcs, hcpcs item and date in RX local array. "RTN","RMPRPIXJ",60,0) ; RX("STA") = station "RTN","RMPRPIXJ",61,0) ; RX("HCP") = HCPCS "RTN","RMPRPIXJ",62,0) ; RX("ITE") = HCPCS item "RTN","RMPRPIXJ",63,0) ; RX("RDT") = date (starting date) "RTN","RMPRPIXJ",64,0) ; REBAL = return variable (Starting Total qty based on the date) "RTN","RMPRPIXJ",65,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",66,0) S REBAL=0 "RTN","RMPRPIXJ",67,0) S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT") "RTN","RMPRPIXJ",68,0) Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL "RTN","RMPRPIXJ",69,0) S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1) "RTN","RMPRPIXJ",70,0) I '$G(RDATE) Q REBAL "RTN","RMPRPIXJ",71,0) S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0)) "RTN","RMPRPIXJ",72,0) S RDATA=$G(^RMPR(661.9,RI,0)) "RTN","RMPRPIXJ",73,0) S REBAL=$P(RDATA,U,8) "RTN","RMPRPIXJ",74,0) Q REBAL "RTN","RMPRPIXJ",75,0) ; "RTN","RMPRPIXJ",76,0) ; "RTN","RMPRPIXJ",77,0) CQTY(RX) ;CURRENT total QTY "RTN","RMPRPIXJ",78,0) ;The Current total qty is the total qty based on the date specified. "RTN","RMPRPIXJ",79,0) ;If the Date specified has no entry, the Current Total qty will be "RTN","RMPRPIXJ",80,0) ;extracted from the previous date entry. If it has no previous entry, "RTN","RMPRPIXJ",81,0) ;the Current Total qty will be set to ZERO. "RTN","RMPRPIXJ",82,0) ; "RTN","RMPRPIXJ",83,0) ;pass variable station, hcpcs, hcpcs item and date in RX local array. "RTN","RMPRPIXJ",84,0) ; RX("STA") = station "RTN","RMPRPIXJ",85,0) ; RX("HCP") = HCPCS "RTN","RMPRPIXJ",86,0) ; RX("ITE") = HCPCS item "RTN","RMPRPIXJ",87,0) ; RX("RDT") = date (current date) "RTN","RMPRPIXJ",88,0) ; REBAL = return variable (Current Total qty based on the date) "RTN","RMPRPIXJ",89,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",90,0) S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT") "RTN","RMPRPIXJ",91,0) Q:(RS="")!(RH="")!(RM="")!(RD="") REBAL "RTN","RMPRPIXJ",92,0) S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0)) "RTN","RMPRPIXJ",93,0) I '$G(RI) D I '$G(RI) Q REBAL "RTN","RMPRPIXJ",94,0) .S RDATE=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD),-1) "RTN","RMPRPIXJ",95,0) .S:$G(RDATE) RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RDATE,0)) "RTN","RMPRPIXJ",96,0) S RDATA=$G(^RMPR(661.9,RI,0)) "RTN","RMPRPIXJ",97,0) S REBAL=$P(RDATA,U,8) "RTN","RMPRPIXJ",98,0) Q REBAL "RTN","RMPRPIXJ",99,0) ; "RTN","RMPRPIXJ",100,0) TVAQT ;get total qty and cost from 661.7 "RTN","RMPRPIXJ",101,0) N R7I,R7J,R7DAT,R7QBAL,R7CBAL "RTN","RMPRPIXJ",102,0) S (RMPRQBAL,RMPRCBAL)=0 "RTN","RMPRPIXJ",103,0) F R7I=0:0 S R7I=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I)) Q:R7I'>0 F R7J=0:0 S R7J=$O(^RMPR(661.7,"XSHIDS",RS,RH,RM,R7I,1,R7J)) Q:R7J'>0 D "RTN","RMPRPIXJ",104,0) .S R7DAT=$G(^RMPR(661.7,R7J,0)) "RTN","RMPRPIXJ",105,0) .S R7QBAL=$P(R7DAT,U,7) "RTN","RMPRPIXJ",106,0) .S R7CBAL=$P(R7DAT,U,8) "RTN","RMPRPIXJ",107,0) .I $G(R7QBAL) S RMPRQBAL=RMPRQBAL+R7QBAL "RTN","RMPRPIXJ",108,0) .I $G(R7CBAL) S RMPRCBAL=RMPRCBAL+R7CBAL "RTN","RMPRPIXJ",109,0) Q "RTN","RMPRPIXJ",110,0) ; "RTN","RMPRPIXJ",111,0) UPCR(RX) ;UPDATE or CREATE entry in 661.9 "RTN","RMPRPIXJ",112,0) ;If an entry already exist, this subroutine will update the entry. "RTN","RMPRPIXJ",113,0) ;If no entry exist, this subroutine will create an entry. "RTN","RMPRPIXJ",114,0) ;The calling routine should check if $G(RMERROR), then error occured. "RTN","RMPRPIXJ",115,0) ; "RTN","RMPRPIXJ",116,0) ;pass variable station, hcpcs, hcpcs item, date, total quantity "RTN","RMPRPIXJ",117,0) ;and total cost in RX local array. "RTN","RMPRPIXJ",118,0) ; RX("STA") = station "RTN","RMPRPIXJ",119,0) ; RX("HCP") = HCPCS "RTN","RMPRPIXJ",120,0) ; RX("ITE") = HCPCS item "RTN","RMPRPIXJ",121,0) ; RX("RDT") = date "RTN","RMPRPIXJ",122,0) ; RX("TQTY")= net quantity to add to balance "RTN","RMPRPIXJ",123,0) ; RX("TCST")= net cost to add to balance "RTN","RMPRPIXJ",124,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",125,0) N RMPRCBAL,RMPRQBAL "RTN","RMPRPIXJ",126,0) S RMERROR=0 "RTN","RMPRPIXJ",127,0) S RS=RX("STA"),RH=RX("HCP"),RM=RX("ITE"),RD=RX("RDT") "RTN","RMPRPIXJ",128,0) S RQ=RX("TQTY"),RC=$J(RX("TCST"),0,2) "RTN","RMPRPIXJ",129,0) I (RS="")!(RH="")!(RD="") S RMERROR=1 Q RMERROR "RTN","RMPRPIXJ",130,0) S (RMPRQBAL,RMPRCBAL)="" ;init quantity and cost balances "RTN","RMPRPIXJ",131,0) L +^RMPR(661.9,"ASHID",RS,RH,RM) "RTN","RMPRPIXJ",132,0) UPCRA K RI,RMDAT,RMERR,RDATA "RTN","RMPRPIXJ",133,0) ;get the current total quntity and cost from 661.7. "RTN","RMPRPIXJ",134,0) D TVAQT "RTN","RMPRPIXJ",135,0) S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD,0)) "RTN","RMPRPIXJ",136,0) ;if there is an entry, update totals: (balance & cost). "RTN","RMPRPIXJ",137,0) I $G(RI) D "RTN","RMPRPIXJ",138,0) .S RDATA=$G(^RMPR(661.9,RI,0)) "RTN","RMPRPIXJ",139,0) .;S RMPRQBAL=$P(RDATA,U,8) "RTN","RMPRPIXJ",140,0) .;S RMPRCBAL=$P(RDATA,U,9) "RTN","RMPRPIXJ",141,0) .S RMDAT(661.9,RI_",",.01)=RD "RTN","RMPRPIXJ",142,0) .S RMDAT(661.9,RI_",",1)=RH "RTN","RMPRPIXJ",143,0) .S RMDAT(661.9,RI_",",2)=RM "RTN","RMPRPIXJ",144,0) .S RMDAT(661.9,RI_",",4)=RS "RTN","RMPRPIXJ",145,0) .S RMDAT(661.9,RI_",",7)=RMPRQBAL "RTN","RMPRPIXJ",146,0) .S RMDAT(661.9,RI_",",8)=RMPRCBAL "RTN","RMPRPIXJ",147,0) .D FILE^DIE("K","RMDAT","RMERR") "RTN","RMPRPIXJ",148,0) .I $D(RMERR) S RMERROR=1 "RTN","RMPRPIXJ",149,0) ;if no entry, create an entry for the date being passed. "RTN","RMPRPIXJ",150,0) E D "RTN","RMPRPIXJ",151,0) .S RX("RDT")=RD "RTN","RMPRPIXJ",152,0) .S RMDAT(661.9,"+1,",.01)=RD "RTN","RMPRPIXJ",153,0) .S RMDAT(661.9,"+1,",1)=RH "RTN","RMPRPIXJ",154,0) .S RMDAT(661.9,"+1,",2)=RM "RTN","RMPRPIXJ",155,0) .S RMDAT(661.9,"+1,",4)=RS "RTN","RMPRPIXJ",156,0) .S RMDAT(661.9,"+1,",7)=RMPRQBAL "RTN","RMPRPIXJ",157,0) .S RMDAT(661.9,"+1,",8)=RMPRCBAL "RTN","RMPRPIXJ",158,0) .D UPDATE^DIE("","RMDAT","RI","RMERR") "RTN","RMPRPIXJ",159,0) .I $D(RMERR) S RMERROR=1 "RTN","RMPRPIXJ",160,0) I RMERROR G UPCRU "RTN","RMPRPIXJ",161,0) ; "RTN","RMPRPIXJ",162,0) ; Get next date and continue update so that all subsequent "RTN","RMPRPIXJ",163,0) ; balances are correct "RTN","RMPRPIXJ",164,0) UPCRN S RD=$O(^RMPR(661.9,"ASHID",RS,RH,RM,RD)) "RTN","RMPRPIXJ",165,0) I RD'="" G UPCRA "RTN","RMPRPIXJ",166,0) UPCRU L -^RMPR(661.9,"ASHID",RS,RH,RM) "RTN","RMPRPIXJ",167,0) UPCRX Q RMERROR "RTN","RMPRPIXJ",168,0) ; "RTN","RMPRPIXJ",169,0) ALLREC(RMA) ;reconcile all HCPCS in 661.9 "RTN","RMPRPIXJ",170,0) Q:RMA'="TEST" "RTN","RMPRPIXJ",171,0) N RM11,RM11DAT,RX "RTN","RMPRPIXJ",172,0) S U="^",RMERR=0 "RTN","RMPRPIXJ",173,0) S RX("TQTY")=0 "RTN","RMPRPIXJ",174,0) S RX("TCST")=0 "RTN","RMPRPIXJ",175,0) S RX("RDT")=DT "RTN","RMPRPIXJ",176,0) F RM11=0:0 S RM11=$O(^RMPR(661.11,RM11)) Q:RM11'>0 D "RTN","RMPRPIXJ",177,0) .S RM11DAT=^RMPR(661.11,RM11,0) "RTN","RMPRPIXJ",178,0) .S RX("HCP")=$P(RM11DAT,U,1) "RTN","RMPRPIXJ",179,0) .S RX("ITE")=$P(RM11DAT,U,2) "RTN","RMPRPIXJ",180,0) .S RX("STA")=$P(RM11DAT,U,4) "RTN","RMPRPIXJ",181,0) .W !,RX("HCP")," ",RX("ITE")," ",RX("STA") "RTN","RMPRPIXJ",182,0) .S RMERR=$$UPCR^RMPRPIXJ(.RX) "RTN","RMPRPIXJ",183,0) Q RMERR "RTN","RMPRPIXJ",184,0) ; "RTN","RMPRPIXJ",185,0) NVAR ;new all variables "RTN","RMPRPIXJ",186,0) N X,Y,RS,RH,RM,RD,RI,RQ,RC,RMERR,RMERROR,RMDAT,RDATA,RDATE,REBAL "RTN","RMPRPIXJ",187,0) N RMPRCBAL,RMPRQBAL "RTN","RMPRPIXJ",188,0) Q "RTN","RMPRPIXN") 0^37^B22037698 "RTN","RMPRPIXN",1,0) RMPRPIXN ;HINCIO/ODJ - PIP STOCK ORDERS 661.41 file APIs ;3/8/01 "RTN","RMPRPIXN",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXN",3,0) Q "RTN","RMPRPIXN",4,0) ; "RTN","RMPRPIXN",5,0) ;***** GET - read in a HCPCS Item order record (661.41) "RTN","RMPRPIXN",6,0) ; "RTN","RMPRPIXN",7,0) ; Inputs: "RTN","RMPRPIXN",8,0) ; RMPR41 - array of order data fields... "RTN","RMPRPIXN",9,0) ; RMPR41("IEN") - ien of 661.41 record being read "RTN","RMPRPIXN",10,0) ; "RTN","RMPRPIXN",11,0) ; Outputs: "RTN","RMPRPIXN",12,0) ; RMPR11 - HCPCS Item array "RTN","RMPRPIXN",13,0) ; RMPR11("STATION") - Station name "RTN","RMPRPIXN",14,0) ; RMPR11("HCPCS") - HCPCS code "RTN","RMPRPIXN",15,0) ; RMPR11("ITEM") - HCPCS Item "RTN","RMPRPIXN",16,0) ; "RTN","RMPRPIXN",17,0) ; RMPR41 - Order data fields array "RTN","RMPRPIXN",18,0) ; RMPR41("DATE ORDER") - Order date (external) "RTN","RMPRPIXN",19,0) ; RMPR41("VENDOR") - Vendor name "RTN","RMPRPIXN",20,0) ; RMPR41("DATE RECEIVE") - Date of last receipt against the order "RTN","RMPRPIXN",21,0) ; (external) "RTN","RMPRPIXN",22,0) ; RMPR41("ORDER QTY") - Quantity ordered "RTN","RMPRPIXN",23,0) ; RMPR41("RECEIVE QTY") - Quantity received against the order "RTN","RMPRPIXN",24,0) ; RMPR41("COMMENT") - optional comment "RTN","RMPRPIXN",25,0) ; RMPR41("BALANCE QTY") - Balance quantity still on order "RTN","RMPRPIXN",26,0) ; RMPR41("STATUS") - Status (external) "RTN","RMPRPIXN",27,0) ; "RTN","RMPRPIXN",28,0) ; RMPRERR - error status returned by function "RTN","RMPRPIXN",29,0) ; 0 - no problems "RTN","RMPRPIXN",30,0) ; 1 - invalid RMPR41("IEN") entered "RTN","RMPRPIXN",31,0) ; 2 - Problem with FM call "RTN","RMPRPIXN",32,0) ; "RTN","RMPRPIXN",33,0) GET(RMPR41,RMPR11) ; "RTN","RMPRPIXN",34,0) N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA "RTN","RMPRPIXN",35,0) S RMPRERR=0 "RTN","RMPRPIXN",36,0) I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX "RTN","RMPRPIXN",37,0) S RMPRIEN=RMPR41("IEN")_"," "RTN","RMPRPIXN",38,0) D GETS^DIQ(661.41,RMPRIEN,"*","","RMPROUP","RMPRFME") "RTN","RMPRPIXN",39,0) I $D(RMPRFME) S RMPRERR=2 G GETX "RTN","RMPRPIXN",40,0) S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2) "RTN","RMPRPIXN",41,0) S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5) "RTN","RMPRPIXN",42,0) S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1) "RTN","RMPRPIXN",43,0) S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4) "RTN","RMPRPIXN",44,0) S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01) "RTN","RMPRPIXN",45,0) S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6) "RTN","RMPRPIXN",46,0) S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7) "RTN","RMPRPIXN",47,0) S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8) "RTN","RMPRPIXN",48,0) S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9) "RTN","RMPRPIXN",49,0) S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY") "RTN","RMPRPIXN",50,0) S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10) "RTN","RMPRPIXN",51,0) GETX Q RMPRERR "RTN","RMPRPIXN",52,0) ; "RTN","RMPRPIXN",53,0) ;***** GETI - get internal form of Order data fields "RTN","RMPRPIXN",54,0) ; "RTN","RMPRPIXN",55,0) ; Inputs and Outputs same as above for GET, except all internal values "RTN","RMPRPIXN",56,0) ; ie pointer's not names, internal not display date formats, etc. "RTN","RMPRPIXN",57,0) ; "RTN","RMPRPIXN",58,0) GETI(RMPR41,RMPR11) ; "RTN","RMPRPIXN",59,0) N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA "RTN","RMPRPIXN",60,0) S RMPRERR=0 "RTN","RMPRPIXN",61,0) I $G(RMPR41("IEN"))="" S RMPRERR=1 G GETX "RTN","RMPRPIXN",62,0) S RMPRIEN=RMPR41("IEN")_"," "RTN","RMPRPIXN",63,0) D GETS^DIQ(661.41,RMPRIEN,"*","I","RMPROUP","RMPRFME") "RTN","RMPRPIXN",64,0) I $D(RMPRFME) S RMPRERR=2 G GETX "RTN","RMPRPIXN",65,0) S RMPR11("STATION")=RMPROUP(661.41,RMPRIEN,2,"I") "RTN","RMPRPIXN",66,0) S RMPR11("HCPCS")=RMPROUP(661.41,RMPRIEN,5,"I") "RTN","RMPRPIXN",67,0) S RMPR11("ITEM")=RMPROUP(661.41,RMPRIEN,1,"I") "RTN","RMPRPIXN",68,0) S RMPR41("VENDOR")=RMPROUP(661.41,RMPRIEN,4,"I") "RTN","RMPRPIXN",69,0) S RMPR41("DATE ORDER")=RMPROUP(661.41,RMPRIEN,.01,"I") "RTN","RMPRPIXN",70,0) S RMPR41("DATE RECEIVE")=RMPROUP(661.41,RMPRIEN,6,"I") "RTN","RMPRPIXN",71,0) S RMPR41("ORDER QTY")=RMPROUP(661.41,RMPRIEN,7,"I") "RTN","RMPRPIXN",72,0) S RMPR41("RECEIVE QTY")=RMPROUP(661.41,RMPRIEN,8,"I") "RTN","RMPRPIXN",73,0) S RMPR41("COMMENT")=RMPROUP(661.41,RMPRIEN,9,"I") "RTN","RMPRPIXN",74,0) S RMPR41("BALANCE QTY")=RMPR41("ORDER QTY")-RMPR41("RECEIVE QTY") "RTN","RMPRPIXN",75,0) S RMPR41("STATUS")=RMPROUP(661.41,RMPRIEN,10,"I") "RTN","RMPRPIXN",76,0) GETIX Q RMPRERR "RTN","RMPRPIXN",77,0) ; "RTN","RMPRPIXN",78,0) ;***** UPD - Update an existing Order 661.41 record "RTN","RMPRPIXN",79,0) ; "RTN","RMPRPIXN",80,0) ; Inputs/Outputs - see above "RTN","RMPRPIXN",81,0) ; See GETI above for structure of RMPR41 and RMPR11 input arrays "RTN","RMPRPIXN",82,0) ; values must be in internal form "RTN","RMPRPIXN",83,0) ; "RTN","RMPRPIXN",84,0) UPD(RMPR41,RMPR11) ; "RTN","RMPRPIXN",85,0) N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA "RTN","RMPRPIXN",86,0) S RMPRERR=0 "RTN","RMPRPIXN",87,0) I $G(RMPR41("IEN"))="" S RMPRERR=1 G UPDX "RTN","RMPRPIXN",88,0) S RMPRIEN=RMPR41("IEN")_"," "RTN","RMPRPIXN",89,0) S:$D(RMPR11("STATION")) RMPROUP(661.41,RMPRIEN,2)=RMPR11("STATION") "RTN","RMPRPIXN",90,0) S:$D(RMPR11("HCPCS")) RMPROUP(661.41,RMPRIEN,5)=RMPR11("HCPCS") "RTN","RMPRPIXN",91,0) S:$D(RMPR11("ITEM")) RMPROUP(661.41,RMPRIEN,1)=RMPR11("ITEM") "RTN","RMPRPIXN",92,0) S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,RMPRIEN,.01)=RMPR41("DATE ORDER") "RTN","RMPRPIXN",93,0) S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,RMPRIEN,6)=RMPR41("DATE RECEIVE") "RTN","RMPRPIXN",94,0) S:$D(RMPR41("VENDOR")) RMPROUP(661.41,RMPRIEN,4)=RMPR41("VENDOR") "RTN","RMPRPIXN",95,0) S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,RMPRIEN,7)=RMPR41("ORDER QTY") "RTN","RMPRPIXN",96,0) S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,RMPRIEN,8)=RMPR41("RECEIVE QTY") "RTN","RMPRPIXN",97,0) S:$D(RMPR41("COMMENT")) RMPROUP(661.41,RMPRIEN,9)=RMPR41("COMMENT") "RTN","RMPRPIXN",98,0) S:$D(RMPR41("STATUS")) RMPROUP(661.41,RMPRIEN,10)=RMPR41("STATUS") "RTN","RMPRPIXN",99,0) D:$D(RMPROUP) FILE^DIE("","RMPROUP","RMPRFME") "RTN","RMPRPIXN",100,0) I $D(RMPRFME) S RMPRERR=2 "RTN","RMPRPIXN",101,0) UPDX Q RMPRERR "RTN","RMPRPIXN",102,0) ; "RTN","RMPRPIXN",103,0) ;***** CRE - Create an Order 661.41 record "RTN","RMPRPIXN",104,0) ; "RTN","RMPRPIXN",105,0) ; Inputs/Outputs - see above "RTN","RMPRPIXN",106,0) ; See GETI above for structure of RMPR41 and RMPR11 input arrays "RTN","RMPRPIXN",107,0) ; values must be in internal form "RTN","RMPRPIXN",108,0) ; "RTN","RMPRPIXN",109,0) CRE(RMPR41,RMPR11) ; "RTN","RMPRPIXN",110,0) N RMPRERR,RMPRIEN,RMPROUP,RMPRFME,X,Y,DA "RTN","RMPRPIXN",111,0) S RMPRERR=0 "RTN","RMPRPIXN",112,0) S RMPROUP(661.41,"+1,",2)=RMPR11("STATION") "RTN","RMPRPIXN",113,0) S RMPROUP(661.41,"+1,",5)=RMPR11("HCPCS") "RTN","RMPRPIXN",114,0) S RMPROUP(661.41,"+1,",1)=RMPR11("ITEM") "RTN","RMPRPIXN",115,0) S:$D(RMPR41("DATE ORDER")) RMPROUP(661.41,"+1,",.01)=RMPR41("DATE ORDER") "RTN","RMPRPIXN",116,0) S:$D(RMPR41("DATE RECEIVE")) RMPROUP(661.41,"+1,",6)=RMPR41("DATE RECEIVE") "RTN","RMPRPIXN",117,0) S:$D(RMPR41("VENDOR")) RMPROUP(661.41,"+1,",4)=RMPR41("VENDOR") "RTN","RMPRPIXN",118,0) S:$D(RMPR41("ORDER QTY")) RMPROUP(661.41,"+1,",7)=RMPR41("ORDER QTY") "RTN","RMPRPIXN",119,0) S:$D(RMPR41("RECEIVE QTY")) RMPROUP(661.41,"+1,",8)=RMPR41("RECEIVE QTY") "RTN","RMPRPIXN",120,0) S RMPROUP(661.41,"+1,",9)=$G(RMPR41("COMMENT")) "RTN","RMPRPIXN",121,0) S RMPROUP(661.41,"+1,",10)=RMPR41("STATUS") "RTN","RMPRPIXN",122,0) D UPDATE^DIE("","RMPROUP","RMPRIEN","RMPRFME") "RTN","RMPRPIXN",123,0) I $D(RMPRFME) S RMPRERR=1 "RTN","RMPRPIXN",124,0) S RMPR41("IEN")=RMPRIEN(1) "RTN","RMPRPIXN",125,0) CREX Q RMPRERR "RTN","RMPRPIXR") 0^102^B26654827 "RTN","RMPRPIXR",1,0) RMPRPIXR ;HINES OIFO/ODJ - REMOVE/DEACTIVATE ITEM ;12/11/02 10:22 "RTN","RMPRPIXR",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXR",3,0) Q "RTN","RMPRPIXR",4,0) ; "RTN","RMPRPIXR",5,0) RE ;remove/deactivate an HCPCS/ITEM "RTN","RMPRPIXR",6,0) ;***** STN - prompt for Site/Station "RTN","RMPRPIXR",7,0) STN S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIXR",8,0) I RMPRERR G DLX "RTN","RMPRPIXR",9,0) I RMPREXC'="" G DLX "RTN","RMPRPIXR",10,0) W !!,"*** Removing/Deactivating HCPCS......",! "RTN","RMPRPIXR",11,0) ; "RTN","RMPRPIXR",12,0) HCPCS ; "RTN","RMPRPIXR",13,0) K ^TMP($J),Y,DIR "RTN","RMPRPIXR",14,0) K RMPR1,RMPR11,RMPR5,RMPRLCN,RMPREXC,RMPRERR,RMPRUNI,RMDEL,RMOUT "RTN","RMPRPIXR",15,0) W ! "RTN","RMPRPIXR",16,0) S RMPR1("REMOVE")=1 "RTN","RMPRPIXR",17,0) D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIXR",18,0) I RMPREXC="T" G DLX "RTN","RMPRPIXR",19,0) I RMPREXC="P" G STN "RTN","RMPRPIXR",20,0) I RMPREXC="^" D G DLX "RTN","RMPRPIXR",21,0) . W !,"** No HCPCS selected." H 1 "RTN","RMPRPIXR",22,0) S RS=RMPRSTN("IEN"),RH=RMPR1("HCPCS") "RTN","RMPRPIXR",23,0) ; "RTN","RMPRPIXR",24,0) ALL ;ask if all item will be remove/deactivate "RTN","RMPRPIXR",25,0) S DIR(0)="Y",DIR("B")="N" "RTN","RMPRPIXR",26,0) W ! "RTN","RMPRPIXR",27,0) S DIR("A")="Do you want to Remove/Deactivate ALL Items for this HCPCS" "RTN","RMPRPIXR",28,0) D ^DIR "RTN","RMPRPIXR",29,0) I $D(DTOUT)!$D(DUOUT)!(Y="^") W !!,"Nothing Remove.." G HCPCS "RTN","RMPRPIXR",30,0) I Y=1 S RMDEL="ALL" D I $G(RMOUT) H 2 G HCPCS "RTN","RMPRPIXR",31,0) .S DIR(0)="Y",DIR("B")="N" "RTN","RMPRPIXR",32,0) .W ! "RTN","RMPRPIXR",33,0) .S DIR("A")="Are you sure you want to Remove/Deactivate ALL ITEMs for HCPCS "_RMPR1("HCPCS") "RTN","RMPRPIXR",34,0) .D ^DIR "RTN","RMPRPIXR",35,0) .I $D(DTOUT)!$D(DUOUT)!(Y="^")!(Y=0) W !!,"Nothing Remove.." S RMOUT=1 "RTN","RMPRPIXR",36,0) G:$D(RMDEL) ZERO "RTN","RMPRPIXR",37,0) ; "RTN","RMPRPIXR",38,0) ITEM ; "RTN","RMPRPIXR",39,0) D ITEM^RMPRPIYP(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR11,.RMPREXC) "RTN","RMPRPIXR",40,0) I RMPREXC="T" G DLX "RTN","RMPRPIXR",41,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIXR",42,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIXR",43,0) ; "RTN","RMPRPIXR",44,0) S DIR(0)="Y",DIR("B")="N" "RTN","RMPRPIXR",45,0) W ! "RTN","RMPRPIXR",46,0) S DIR("A")="Are you sure you want to Remove/Deactivate this HCPCS/ITEM "_RMPR11("HCPCS-ITEM") "RTN","RMPRPIXR",47,0) D ^DIR "RTN","RMPRPIXR",48,0) I $D(DTOUT)!$D(DUOUT)!(Y="^")!(Y=0) W !!,"Nothing Remove.." G HCPCS "RTN","RMPRPIXR",49,0) ; "RTN","RMPRPIXR",50,0) ZERO ;zero out "RTN","RMPRPIXR",51,0) ;only delete one if item if specified "RTN","RMPRPIXR",52,0) I $D(RMPR11("ITEM")) G DEL1 "RTN","RMPRPIXR",53,0) G:$D(RMDEL) ALLIT "RTN","RMPRPIXR",54,0) ; "RTN","RMPRPIXR",55,0) DEL1 ;remove one item "RTN","RMPRPIXR",56,0) ; "RTN","RMPRPIXR",57,0) S RI=RMPR11("ITEM") "RTN","RMPRPIXR",58,0) F RD=0:0 S RD=$O(^RMPR(661.7,"XSHIDS",RS,RH,RI,RD)) Q:RD'>0 F RIEN=0:0 S RIEN=$O(^RMPR(661.7,"XSHIDS",RS,RH,RI,RD,1,RIEN)) Q:RIEN'>0 D "RTN","RMPRPIXR",59,0) .Q:'$D(^RMPR(661.7,RIEN,0)) "RTN","RMPRPIXR",60,0) .S RMDA=^RMPR(661.7,RIEN,0) "RTN","RMPRPIXR",61,0) .S RML=$P(RMDA,U,6),RMQ=$P(RMDA,U,7),RMV=$P(RMDA,U,8) "RTN","RMPRPIXR",62,0) .;call update 661.6 "RTN","RMPRPIXR",63,0) .S RMPR11("HCPCS")=RH,RMPR11("ITEM")=RI,RMPR11("STATION")=RS "RTN","RMPRPIXR",64,0) .S RMPR6("COMMENT")="",RMPR6("LOCATION")="",RMPR6("QUANTITY")=0 "RTN","RMPRPIXR",65,0) .S RMPR6("SEQUENCE")=0,RMPR6("TRAN TYPE")=9,RMPR6("USER")=$G(DUZ) "RTN","RMPRPIXR",66,0) .S RMPR6("VALUE")=0,RMPR6("VENDOR")="" "RTN","RMPRPIXR",67,0) .S RMERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIXR",68,0) .;delete entry in #661.7 "RTN","RMPRPIXR",69,0) .Q:'$G(RIEN) "RTN","RMPRPIXR",70,0) .K DIK S DIK="^RMPR(661.7,",DA=RIEN D ^DIK "RTN","RMPRPIXR",71,0) .;update 661.9 "RTN","RMPRPIXR",72,0) .K R9,R9DA "RTN","RMPRPIXR",73,0) .I $D(^RMPR(661.9,"ASHID",RS,RH,RI,DT)) D "RTN","RMPRPIXR",74,0) ..S R9=$O(^RMPR(661.9,"ASHID",RS,RH,RI,DT,""),-1) "RTN","RMPRPIXR",75,0) ..I $G(R9),$D(^RMPR(661.9,R9,0)) S R9DA=^RMPR(661.9,R9,0) "RTN","RMPRPIXR",76,0) ..I $D(R9DA),$P(R9DA,U,8)=0 Q "RTN","RMPRPIXR",77,0) ..D UP9 "RTN","RMPRPIXR",78,0) .I '$D(^RMPR(661.9,"ASHID",RS,RH,RI,DT)) D UP9 "RTN","RMPRPIXR",79,0) .S RHRI=RH_"-"_RI "RTN","RMPRPIXR",80,0) .S ^TMP($J,RHRI)="" "RTN","RMPRPIXR",81,0) ;print a message to the screen for items being removed "RTN","RMPRPIXR",82,0) D MESS "RTN","RMPRPIXR",83,0) ;change status of hcpcs & deactivation date in 661.11 "RTN","RMPRPIXR",84,0) K RMERR,RMDAT,K "RTN","RMPRPIXR",85,0) S RMDAT(661.11,RMPR11("IEN")_",",8)=1 "RTN","RMPRPIXR",86,0) S RMDAT(661.11,RMPR11("IEN")_",",9)=DT "RTN","RMPRPIXR",87,0) D FILE^DIE("K","RMDAT","RMERR") "RTN","RMPRPIXR",88,0) I $D(RMERR) W !!,"*** Error updating file #661.11 update!!!",!! "RTN","RMPRPIXR",89,0) G HCPCS "RTN","RMPRPIXR",90,0) ; "RTN","RMPRPIXR",91,0) ALLIT ;remove/deactivate all items for selected HCPCS. "RTN","RMPRPIXR",92,0) ; "RTN","RMPRPIXR",93,0) F RI=0:0 S RI=$O(^RMPR(661.7,"XSHIDS",RS,RH,RI)) Q:RI'>0 D "RTN","RMPRPIXR",94,0) .F RD=0:0 S RD=$O(^RMPR(661.7,"XSHIDS",RS,RH,RI,RD)) Q:RD'>0 F RIEN=0:0 S RIEN=$O(^RMPR(661.7,"XSHIDS",RS,RH,RI,RD,1,RIEN)) Q:RIEN'>0 D "RTN","RMPRPIXR",95,0) ..Q:'$D(^RMPR(661.7,RIEN,0)) "RTN","RMPRPIXR",96,0) ..S RMDA=^RMPR(661.7,RIEN,0) "RTN","RMPRPIXR",97,0) ..S RML=$P(RMDA,U,6),RMQ=$P(RMDA,U,7),RMV=$P(RMDA,U,8) "RTN","RMPRPIXR",98,0) ..;update 661.6 "RTN","RMPRPIXR",99,0) ..S RMPR11("HCPCS")=RH,RMPR11("ITEM")=RI,RMPR11("STATION")=RS "RTN","RMPRPIXR",100,0) ..S RMPR6("COMMENT")="",RMPR6("LOCATION")="",RMPR6("QUANTITY")=0 "RTN","RMPRPIXR",101,0) ..S RMPR6("SEQUENCE")=0,RMPR6("TRAN TYPE")=9,RMPR6("USER")=$G(DUZ) "RTN","RMPRPIXR",102,0) ..S RMPR6("VALUE")=0,RMPR6("VENDOR")="" "RTN","RMPRPIXR",103,0) ..S RMERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIXR",104,0) ..;delete entry from #661.7 "RTN","RMPRPIXR",105,0) ..Q:'$G(RIEN) "RTN","RMPRPIXR",106,0) ..K DIK S DIK="^RMPR(661.7,",DA=RIEN D ^DIK "RTN","RMPRPIXR",107,0) ..; update 661.9 "RTN","RMPRPIXR",108,0) K R9,R9DA "RTN","RMPRPIXR",109,0) F RI=0:0 S RI=$O(^RMPR(661.9,"ASHID",RS,RH,RI)) Q:RI'>0 D UP9 "RTN","RMPRPIXR",110,0) ; "RTN","RMPRPIXR",111,0) ;print a message of items being removed/deactivated "RTN","RMPRPIXR",112,0) F I=0:0 S I=$O(^RMPR(661.11,"ASHI",RS,RH,I)) Q:I'>0 D "RTN","RMPRPIXR",113,0) .F J=0:0 S J=$O(^RMPR(661.11,"ASHI",RS,RH,I,J)) Q:J'>0 D "RTN","RMPRPIXR",114,0) ..S RHRI=RH_"-"_I "RTN","RMPRPIXR",115,0) ..S ^TMP($J,RHRI)="" "RTN","RMPRPIXR",116,0) D MESS "RTN","RMPRPIXR",117,0) ;change status of hcpcs & deactivation date in 661.11 "RTN","RMPRPIXR",118,0) ;loop through all items in a particular HCPCS "RTN","RMPRPIXR",119,0) F RI=0:0 S RI=$O(^RMPR(661.11,"ASHI",RS,RH,RI)) Q:RI'>0 D "RTN","RMPRPIXR",120,0) .F RJ=0:0 S RJ=$O(^RMPR(661.11,"ASHI",RS,RH,RI,RJ)) Q:RJ'>0 D "RTN","RMPRPIXR",121,0) ..K RMERR,K,RMDAT "RTN","RMPRPIXR",122,0) ..S RMDAT(661.11,RJ_",",8)=1 "RTN","RMPRPIXR",123,0) ..S RMDAT(661.11,RJ_",",9)=DT "RTN","RMPRPIXR",124,0) ..D FILE^DIE("K","RMDAT","RMERR") "RTN","RMPRPIXR",125,0) ..I $D(RMERR) W !!,"*** Error updating file #661.11 update!!!",!! "RTN","RMPRPIXR",126,0) ;ask for another HCPCCS to remove "RTN","RMPRPIXR",127,0) G HCPCS "RTN","RMPRPIXR",128,0) ; "RTN","RMPRPIXR",129,0) UP9 ;CREATE entry in file #661.9 "RTN","RMPRPIXR",130,0) K RMDAT,RMERR,RIN "RTN","RMPRPIXR",131,0) S RMDAT(661.9,"+1,",.01)=DT "RTN","RMPRPIXR",132,0) S RMDAT(661.9,"+1,",1)=RH "RTN","RMPRPIXR",133,0) S RMDAT(661.9,"+1,",2)=RI "RTN","RMPRPIXR",134,0) S RMDAT(661.9,"+1,",4)=RS "RTN","RMPRPIXR",135,0) S RMDAT(661.9,"+1,",7)=0 "RTN","RMPRPIXR",136,0) S RMDAT(661.9,"+1,",8)=0 "RTN","RMPRPIXR",137,0) D UPDATE^DIE("","RMDAT","RIN","RMERR") "RTN","RMPRPIXR",138,0) I $D(RMERR) W !!,"*** Error updating file #661.9 !!!",!! "RTN","RMPRPIXR",139,0) Q "RTN","RMPRPIXR",140,0) ; "RTN","RMPRPIXR",141,0) MESS ;print a deleted message "RTN","RMPRPIXR",142,0) S I="" F S I=$O(^TMP($J,I)) Q:I="" D "RTN","RMPRPIXR",143,0) .W !!,"*** HCPCS/ITEM "_I_" has been Removed/Deactivated from PIP..." "RTN","RMPRPIXR",144,0) K ^TMP($J) "RTN","RMPRPIXR",145,0) Q "RTN","RMPRPIXR",146,0) ; "RTN","RMPRPIXR",147,0) DLX N RMPR,RMPRSITE D KILL^XUSCLEAN "RTN","RMPRPIXR",148,0) Q "RTN","RMPRPIXZ") 0^38^B2340220 "RTN","RMPRPIXZ",1,0) RMPRPIXZ ;HINCIO/ODJ - MISC. ;3/8/01 "RTN","RMPRPIXZ",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIXZ",3,0) Q "RTN","RMPRPIXZ",4,0) ; "RTN","RMPRPIXZ",5,0) ; Some miscellaneous routines to be used for testing only "RTN","RMPRPIXZ",6,0) ; NOT FOR GENERAL USE "RTN","RMPRPIXZ",7,0) ; "RTN","RMPRPIXZ",8,0) ; "RTN","RMPRPIXZ",9,0) ; Clear down new PIP files "RTN","RMPRPIXZ",10,0) ; Only use if need to re-run the old to new PIP file conversion "RTN","RMPRPIXZ",11,0) ; utility in RMPRPIUG "RTN","RMPRPIXZ",12,0) KILL N FIL,S,P62,I,P60 "RTN","RMPRPIXZ",13,0) ; "RTN","RMPRPIXZ",14,0) ; Restore pointers to 661.2 in file 660 "RTN","RMPRPIXZ",15,0) S I=0 "RTN","RMPRPIXZ",16,0) F S I=$O(^RMPR(661.63,I)) Q:'+I D "RTN","RMPRPIXZ",17,0) . S S=^RMPR(661.63,I,0) "RTN","RMPRPIXZ",18,0) . S P62=$P(S,"^",3) "RTN","RMPRPIXZ",19,0) . S P60=$P(S,"^",2) "RTN","RMPRPIXZ",20,0) . S $P(^RMPR(660,P60,1),"^",5)=P62 "RTN","RMPRPIXZ",21,0) . Q "RTN","RMPRPIXZ",22,0) ; "RTN","RMPRPIXZ",23,0) ; Clear down new files "RTN","RMPRPIXZ",24,0) F FIL=661.11,661.4,661.41,661.5,661.6,661.63,661.69,661.7,661.9 D "RTN","RMPRPIXZ",25,0) . S S=^RMPR(FIL,0) "RTN","RMPRPIXZ",26,0) . S $P(S,"^",3)=0,$P(S,"^",4)=0 "RTN","RMPRPIXZ",27,0) . K ^RMPR(FIL) "RTN","RMPRPIXZ",28,0) . S ^RMPR(FIL,0)=S "RTN","RMPRPIXZ",29,0) . Q "RTN","RMPRPIXZ",30,0) Q "RTN","RMPRPIXZ",31,0) ; "RTN","RMPRPIXZ",32,0) ; Make all Locations start with 'A' "RTN","RMPRPIXZ",33,0) ALOC N NM,IEN,RMPR,RMPRE,FIL "RTN","RMPRPIXZ",34,0) F FIL=661.3,661.5 D "RTN","RMPRPIXZ",35,0) . S IEN=0 "RTN","RMPRPIXZ",36,0) . F S IEN=$O(^RMPR(FIL,IEN)) Q:'+IEN D "RTN","RMPRPIXZ",37,0) .. S NM=$P(^RMPR(FIL,IEN,0),"^",1) "RTN","RMPRPIXZ",38,0) .. W !,NM "RTN","RMPRPIXZ",39,0) .. K RMPR "RTN","RMPRPIXZ",40,0) .. S RMPR(FIL,IEN_",",.01)="A"_NM "RTN","RMPRPIXZ",41,0) .. D FILE^DIE("","RMPR","RMPRE") "RTN","RMPRPIXZ",42,0) .. Q "RTN","RMPRPIXZ",43,0) . Q "RTN","RMPRPIXZ",44,0) Q "RTN","RMPRPIXZ",45,0) ; "RTN","RMPRPIXZ",46,0) ; Get rid of 1st char. "RTN","RMPRPIXZ",47,0) REMA N NM,IEN,RMPR,RMPRE,FIL "RTN","RMPRPIXZ",48,0) F FIL=661.3,661.5 D "RTN","RMPRPIXZ",49,0) . S IEN=0 "RTN","RMPRPIXZ",50,0) . F S IEN=$O(^RMPR(FIL,IEN)) Q:'+IEN D "RTN","RMPRPIXZ",51,0) .. S NM=$P(^RMPR(FIL,IEN,0),"^",1) "RTN","RMPRPIXZ",52,0) .. W !,NM "RTN","RMPRPIXZ",53,0) .. K RMPR "RTN","RMPRPIXZ",54,0) .. S RMPR(FIL,IEN_",",.01)=$E(NM,2,$L(NM)) "RTN","RMPRPIXZ",55,0) .. D FILE^DIE("","RMPR","RMPRE") "RTN","RMPRPIXZ",56,0) .. Q "RTN","RMPRPIXZ",57,0) . Q "RTN","RMPRPIXZ",58,0) Q "RTN","RMPRPIY1") 0^39^B14707461 "RTN","RMPRPIY1",1,0) RMPRPIY1 ;HINCIO/ODJ - PIP Data Entry - Prompts;3/8/01 "RTN","RMPRPIY1",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIY1",3,0) Q "RTN","RMPRPIY1",4,0) ; "RTN","RMPRPIY1",5,0) ;***** STN - Prompt for Station "RTN","RMPRPIY1",6,0) STN(RMPRSTN,RMPRESC) ; "RTN","RMPRPIY1",7,0) N X,Y,DIC,DA,DUOUT,DTOUT,DIROUT,DIRUT,RMPR,RMPRSITE "RTN","RMPRPIY1",8,0) S RMPRERR=0 "RTN","RMPRPIY1",9,0) S RMPRSTN("IEN")=$G(RMPRSTN("IEN")) "RTN","RMPRPIY1",10,0) I $G(DUZ)="" S RMPRERR=1 G STNX ;User must exist (ptr. to ^VA(200)) "RTN","RMPRPIY1",11,0) S RMPRESC="" "RTN","RMPRPIY1",12,0) D DIV4^RMPRSIT ; call standard Prosthetic site look-up "RTN","RMPRPIY1",13,0) I $G(X)="^^" S RMPREXC="P" G STNX "RTN","RMPRPIY1",14,0) I $D(X) S RMPRESC="^" G STNX "RTN","RMPRPIY1",15,0) S RMPRSTN("IEN")=$G(RMPR("STA")) "RTN","RMPRPIY1",16,0) I RMPRSTN("IEN")="" S RMPRERR=99 G STNX "RTN","RMPRPIY1",17,0) S RMPRSTN("SITE NAME")=$G(RMPR("NAME")) "RTN","RMPRPIY1",18,0) STNX Q RMPRERR "RTN","RMPRPIY1",19,0) ; "RTN","RMPRPIY1",20,0) ;***** ITED - Edit an Inventory Item description and update 661.11 "RTN","RMPRPIY1",21,0) ITED(RMPR11,RMPREXC) ; "RTN","RMPRPIY1",22,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIRUT,DIROUT,RMPRYN,RMPR11N,RMPRERR "RTN","RMPRPIY1",23,0) S DIR(0)="FOA^3:60" "RTN","RMPRPIY1",24,0) S DIR("A")="PIP Item Description: " "RTN","RMPRPIY1",25,0) S DIR("??")="^D ITEDH2^RMPRPIY1" "RTN","RMPRPIY1",26,0) S DIR("B")=$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIY1",27,0) ITED1 D ^DIR "RTN","RMPRPIY1",28,0) I $D(DTOUT) S RMPREXC="T" G ITEDX "RTN","RMPRPIY1",29,0) I $D(DIROUT) S RMPREXC="P" G ITEDX "RTN","RMPRPIY1",30,0) I X["^"!($D(DUOUT)) S RMPREXC="^" G ITEDX "RTN","RMPRPIY1",31,0) I X="" G ITEDX "RTN","RMPRPIY1",32,0) S RMPREXC="" "RTN","RMPRPIY1",33,0) I X=$G(RMPR11("DESCRIPTION")) G ITEDX "RTN","RMPRPIY1",34,0) L +^RMPR(661.11,RMPR11("IEN")):0 E D G ITEDX "RTN","RMPRPIY1",35,0) . W !,"Item being edited by another user, cannot continue." "RTN","RMPRPIY1",36,0) . H 2 "RTN","RMPRPIY1",37,0) . S RMPREXC="^" "RTN","RMPRPIY1",38,0) . Q "RTN","RMPRPIY1",39,0) S RMPR11N("DESCRIPTION")=X "RTN","RMPRPIY1",40,0) D ITEDO(.RMPRYN,.RMPREXC) "RTN","RMPRPIY1",41,0) I RMPREXC="T" G ITEDU "RTN","RMPRPIY1",42,0) I RMPREXC'=""!(RMPRYN="N") D G ITED1 "RTN","RMPRPIY1",43,0) . S RMPREXC="" "RTN","RMPRPIY1",44,0) . L -^RMPR(661.11,RMPR11("IEN")) "RTN","RMPRPIY1",45,0) . Q "RTN","RMPRPIY1",46,0) S RMPR11N("IEN")=RMPR11("IEN") "RTN","RMPRPIY1",47,0) S RMPRERR=$$UPD^RMPRPIX1(.RMPR11N) "RTN","RMPRPIY1",48,0) W ! "RTN","RMPRPIY1",49,0) S RMPR11("DESCRIPTION")=$G(RMPR11N("DESCRIPTION")) "RTN","RMPRPIY1",50,0) ITEDU L -^RMPR(661.11,RMPR11("IEN")) "RTN","RMPRPIY1",51,0) ITEDX Q "RTN","RMPRPIY1",52,0) ; "RTN","RMPRPIY1",53,0) ; (??) Help text for item desc. "RTN","RMPRPIY1",54,0) ITEDH2 W "Enter a description for this item which will be used locally by",! "RTN","RMPRPIY1",55,0) W "your Prosthetics Service.",! "RTN","RMPRPIY1",56,0) W "You may want to use the Item Master description with additional",! "RTN","RMPRPIY1",57,0) W "text specifying things like size, volume, etc." "RTN","RMPRPIY1",58,0) Q "RTN","RMPRPIY1",59,0) ; "RTN","RMPRPIY1",60,0) ; Y/N Prompt to confirm change of Item Description "RTN","RMPRPIY1",61,0) ITEDO(RMPRYN,RMPREXC) ; "RTN","RMPRPIY1",62,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIY1",63,0) S RMPRYN="N" "RTN","RMPRPIY1",64,0) S RMPREXC="" "RTN","RMPRPIY1",65,0) S DIR(0)="Y" "RTN","RMPRPIY1",66,0) S DIR("B")="N" "RTN","RMPRPIY1",67,0) S DIR("A")="Are you sure you want to change this Item's Description" "RTN","RMPRPIY1",68,0) D ^DIR "RTN","RMPRPIY1",69,0) I $D(DTOUT) S RMPREXC="T" G ITEDOX "RTN","RMPRPIY1",70,0) I $D(DIROUT) S RMPREXC="P" G ITEDOX "RTN","RMPRPIY1",71,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G ITEDOX "RTN","RMPRPIY1",72,0) S:Y RMPRYN="Y" "RTN","RMPRPIY1",73,0) ITEDOX Q "RTN","RMPRPIY1",74,0) ; "RTN","RMPRPIY1",75,0) ;***** MASIT - prompt for Item Master "RTN","RMPRPIY1",76,0) MASIT(RMPR1,RMPREXC) ; "RTN","RMPRPIY1",77,0) N DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIY1",78,0) S DIC(0)="AEQM" "RTN","RMPRPIY1",79,0) S DIC=661 "RTN","RMPRPIY1",80,0) S DIC("A")="IFCAP ITEM: " "RTN","RMPRPIY1",81,0) I $G(RMPR1("ITEM MASTER IEN"))'="" S DIC("B")=RMPR1("ITEM MASTER IEN") "RTN","RMPRPIY1",82,0) W ! "RTN","RMPRPIY1",83,0) D ^DIC "RTN","RMPRPIY1",84,0) I $D(DTOUT) S RMPREXC="T" G MASITX "RTN","RMPRPIY1",85,0) I $D(DUOUT) S RMPREXC=$S(X="^^":"P",1:"^") G MASITX "RTN","RMPRPIY1",86,0) I +Y=-1 S RMPREXC="^" G MASITX "RTN","RMPRPIY1",87,0) S RMPREXC="" "RTN","RMPRPIY1",88,0) S RMPR1("IEN")=$P(Y,"^",1) "RTN","RMPRPIY1",89,0) MASITX Q "RTN","RMPRPIY1",90,0) ; "RTN","RMPRPIY1",91,0) ;***** HCPCS - select HCPCS and inventory item "RTN","RMPRPIY1",92,0) HCPCS(RMPRSTN,RMPRHCPC,RMPR1,RMPR11,RMPREXC) ; "RTN","RMPRPIY1",93,0) HCPCS1 D HCPCS^RMPRPIY7(RMPRSTN,$G(RMPRHCPC),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIY1",94,0) I RMPREXC="T" G HCPCSX "RTN","RMPRPIY1",95,0) I RMPREXC="P"!(RMPREXC="^") G HCPCSX "RTN","RMPRPIY1",96,0) I $G(RMPR11("IEN"))'="" G HCPCSX "RTN","RMPRPIY1",97,0) HCPCS2 D ITEM^RMPRPIYP(RMPRSTN,RMPR1("HCPCS"),.RMPR11,.RMPREXC) "RTN","RMPRPIY1",98,0) I RMPREXC="T" G HCPCSX "RTN","RMPRPIY1",99,0) I RMPREXC="P" G HCPCS1 "RTN","RMPRPIY1",100,0) I RMPREXC="^" G HCPCSX "RTN","RMPRPIY1",101,0) S RMPR11("STATION")=RMPRSTN "RTN","RMPRPIY1",102,0) S RMPR11("STATION IEN")=RMPRSTN "RTN","RMPRPIY1",103,0) ; "RTN","RMPRPIY1",104,0) ; display selected HCPCS and item and continue "RTN","RMPRPIY1",105,0) HCPCS3 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC")) "RTN","RMPRPIY1",106,0) W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER")) "RTN","RMPRPIY1",107,0) W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIY1",108,0) HCPCSX Q "RTN","RMPRPIY2") 0^40^B48005442 "RTN","RMPRPIY2",1,0) RMPRPIY2 ;HINCIO/ODJ - PIP Data Entry - Location Prompt ;3/8/01 "RTN","RMPRPIY2",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIY2",3,0) Q "RTN","RMPRPIY2",4,0) ; "RTN","RMPRPIY2",5,0) ;***** LOCNM - Prompt for PIP Location by name (used by AE option) "RTN","RMPRPIY2",6,0) ; Use only where location can be added "RTN","RMPRPIY2",7,0) ; "RTN","RMPRPIY2",8,0) ; Inputs: "RTN","RMPRPIY2",9,0) ; RMPRSTN - Station number "RTN","RMPRPIY2",10,0) ; "RTN","RMPRPIY2",11,0) ; Outputs: "RTN","RMPRPIY2",12,0) ; RMPREXC - exit condition "RTN","RMPRPIY2",13,0) ; RMPR5 - Array of Location data fields "RTN","RMPRPIY2",14,0) ; RMPRERR - returned error code (ignore for time being) "RTN","RMPRPIY2",15,0) ; "RTN","RMPRPIY2",16,0) LOCNM(RMPRSTN,RMPR5,RMPREXC) ; "RTN","RMPRPIY2",17,0) N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT "RTN","RMPRPIY2",18,0) D NOW^%DTC S RMPRTDT=X ;today's date "RTN","RMPRPIY2",19,0) S RMPREXC="" "RTN","RMPRPIY2",20,0) S RMPRERR=0 "RTN","RMPRPIY2",21,0) S DIR(0)="FOA^1:30" "RTN","RMPRPIY2",22,0) S DIR("A")="Enter Pros Location: " "RTN","RMPRPIY2",23,0) I $G(RMPR5("NAME"))'="" S DIR("B")=RMPR5("NAME") "RTN","RMPRPIY2",24,0) S DIR("?")="^D QM^RMPRPIY2" "RTN","RMPRPIY2",25,0) S DIR("??")="^D QQM^RMPRPIY2" "RTN","RMPRPIY2",26,0) LOCNM1 D ^DIR "RTN","RMPRPIY2",27,0) I $D(DTOUT) S RMPREXC="T" G LOCNMX "RTN","RMPRPIY2",28,0) I $D(DIROUT) S RMPREXC="P" G LOCNMX "RTN","RMPRPIY2",29,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G LOCNMX "RTN","RMPRPIY2",30,0) K RMPR5 "RTN","RMPRPIY2",31,0) D LIKE(RMPRSTN,X,.RMPREXC,.RMPR5) "RTN","RMPRPIY2",32,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIY2",33,0) I +$G(RMPR5("IEN")) G LOCNMX "RTN","RMPRPIY2",34,0) I $L(X)<3 D G LOCNM1 "RTN","RMPRPIY2",35,0) . W !,"Location name must be at least 3 characters long" "RTN","RMPRPIY2",36,0) . Q "RTN","RMPRPIY2",37,0) S RMPR5("STATION")=RMPRSTN "RTN","RMPRPIY2",38,0) S RMPR5("STATION IEN")=RMPRSTN "RTN","RMPRPIY2",39,0) S RMPR5("NAME")=X "RTN","RMPRPIY2",40,0) ; "RTN","RMPRPIY2",41,0) ; Add new Stock Location "RTN","RMPRPIY2",42,0) LOCNMA D ADDNM(.RMPR5,.RMPRYN,.RMPREXC) "RTN","RMPRPIY2",43,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIY2",44,0) I RMPRYN="N" G LOCNM1 "RTN","RMPRPIY2",45,0) D ADDR(.RMPR5,.RMPREXC) ; get address for new location "RTN","RMPRPIY2",46,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIY2",47,0) S RMPR5("STATUS")="A" "RTN","RMPRPIY2",48,0) S RMPR5("STATUS DATE")=RMPRTDT "RTN","RMPRPIY2",49,0) S RMPR5("USER")=$G(DUZ) "RTN","RMPRPIY2",50,0) S RMPRERR=$$CRE^RMPRPIX5(.RMPR5) ; create new location "RTN","RMPRPIY2",51,0) LOCNMX Q RMPRERR "RTN","RMPRPIY2",52,0) ; "RTN","RMPRPIY2",53,0) ;***** ADDNM - Prompts for adding a new Stock Location "RTN","RMPRPIY2",54,0) ; "RTN","RMPRPIY2",55,0) ; Inputs: "RTN","RMPRPIY2",56,0) ; RMPR5 "RTN","RMPRPIY2",57,0) ; "RTN","RMPRPIY2",58,0) ; Outputs: "RTN","RMPRPIY2",59,0) ; RMPRYN "RTN","RMPRPIY2",60,0) ; RMPREXC "RTN","RMPRPIY2",61,0) ; RMPRERR "RTN","RMPRPIY2",62,0) ; "RTN","RMPRPIY2",63,0) ADDNM(RMPR5,RMPRYN,RMPREXC) ; "RTN","RMPRPIY2",64,0) N DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIY2",65,0) S RMPREXC="" "RTN","RMPRPIY2",66,0) S DIR(0)="Y" "RTN","RMPRPIY2",67,0) S DIR("B")="N" "RTN","RMPRPIY2",68,0) S DIR("A")="Are you adding '"_RMPR5("NAME")_"' as a new PROS ITEM LOCATION" "RTN","RMPRPIY2",69,0) D ^DIR "RTN","RMPRPIY2",70,0) I $D(DTOUT) S RMPREXC="T" G ADDNMX "RTN","RMPRPIY2",71,0) I $D(DIROUT) S RMPREXC="P" G ADDNMX "RTN","RMPRPIY2",72,0) I X=""!(X["^") S RMPREXC="^" G ADDNMX "RTN","RMPRPIY2",73,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIY2",74,0) S RMPREXC="" "RTN","RMPRPIY2",75,0) ADDNMX Q "RTN","RMPRPIY2",76,0) ; "RTN","RMPRPIY2",77,0) ;***** ADDR - Prompt for Stock Location Address "RTN","RMPRPIY2",78,0) ; "RTN","RMPRPIY2",79,0) ; Inputs: "RTN","RMPRPIY2",80,0) ; RMPR5 "RTN","RMPRPIY2",81,0) ; "RTN","RMPRPIY2",82,0) ; Outputs: "RTN","RMPRPIY2",83,0) ; RMPR5 "RTN","RMPRPIY2",84,0) ; RMPREXC "RTN","RMPRPIY2",85,0) ; "RTN","RMPRPIY2",86,0) ADDR(RMPR5,RMPREXC) ; "RTN","RMPRPIY2",87,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT "RTN","RMPRPIY2",88,0) S RMPREXC="" "RTN","RMPRPIY2",89,0) S DIR(0)="FOA" "RTN","RMPRPIY2",90,0) S DIR("A")=" PROS ITEM LOCATION ADDRESS: " "RTN","RMPRPIY2",91,0) S DIR("?")="Answer must be 3-30 characters in length." "RTN","RMPRPIY2",92,0) D ^DIR "RTN","RMPRPIY2",93,0) I $D(DTOUT) S RMPREXC="T" G ADDRX "RTN","RMPRPIY2",94,0) I $D(DIROUT) S RMPREXC="P" G ADDRX "RTN","RMPRPIY2",95,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ADDRX "RTN","RMPRPIY2",96,0) S RMPR5("ADDRESS")=X "RTN","RMPRPIY2",97,0) ADDRX Q "RTN","RMPRPIY2",98,0) ; "RTN","RMPRPIY2",99,0) ;***** QM - Single ? Help (for use by Location prompt) "RTN","RMPRPIY2",100,0) QM D QM1 ;ask if want to list locns. "RTN","RMPRPIY2",101,0) I RMPREXC'="" G QMX "RTN","RMPRPIY2",102,0) I RMPRYN'="Y" G QMX "RTN","RMPRPIY2",103,0) D QM2 ;list locns. "RTN","RMPRPIY2",104,0) D QM2H "RTN","RMPRPIY2",105,0) QMX Q "RTN","RMPRPIY2",106,0) ; "RTN","RMPRPIY2",107,0) ; Double ? Help "RTN","RMPRPIY2",108,0) QQM D QM2 ;list locns. "RTN","RMPRPIY2",109,0) D QQM1 "RTN","RMPRPIY2",110,0) Q "RTN","RMPRPIY2",111,0) ; "RTN","RMPRPIY2",112,0) ; QM1 - ask if want to list locns "RTN","RMPRPIY2",113,0) ; "RTN","RMPRPIY2",114,0) ; require RMPRSTN - Station number "RTN","RMPRPIY2",115,0) ; "RTN","RMPRPIY2",116,0) ; sets RMPREXC - exit condition "RTN","RMPRPIY2",117,0) ; RMPRYN - Y - list, any other response - don't bother "RTN","RMPRPIY2",118,0) ; "RTN","RMPRPIY2",119,0) QM1 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,%A "RTN","RMPRPIY2",120,0) S RMPRYN="N" "RTN","RMPRPIY2",121,0) S DIR("A",1)=" Answer with PROS ITEM LOCATION" "RTN","RMPRPIY2",122,0) S DIR("A")=" Do you want the entire PROS ITEM LOCATION List" "RTN","RMPRPIY2",123,0) S DIR("?")="^D QM1H^RMPRPIY2" "RTN","RMPRPIY2",124,0) S DIR(0)="YO" "RTN","RMPRPIY2",125,0) D ^DIR "RTN","RMPRPIY2",126,0) I $D(DTOUT) S RMPREXC="T" G QM1X "RTN","RMPRPIY2",127,0) I $D(DIROUT) S RMPREXC="P" G QM1X "RTN","RMPRPIY2",128,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G QM1X "RTN","RMPRPIY2",129,0) S:Y RMPRYN="Y" "RTN","RMPRPIY2",130,0) S RMPREXC="" "RTN","RMPRPIY2",131,0) QM1X I RMPRYN'="Y",RMPRYN'="?" D QM1H "RTN","RMPRPIY2",132,0) Q "RTN","RMPRPIY2",133,0) QM1H W:$X'=0 ! "RTN","RMPRPIY2",134,0) W " You may enter a new PROS ITEM LOCATION, if you wish" "RTN","RMPRPIY2",135,0) W !," Answer must be 3-30 characters in length." "RTN","RMPRPIY2",136,0) S %A="V",X="^",RMPRYN="?" "RTN","RMPRPIY2",137,0) Q "RTN","RMPRPIY2",138,0) QM2H W !," You may enter a new PROS ITEM LOCATION, if you wish" "RTN","RMPRPIY2",139,0) W !," Answer must be 3-30 characters in length." "RTN","RMPRPIY2",140,0) Q "RTN","RMPRPIY2",141,0) QQM1 W !," You may enter a new PROS ITEM LOCATION, if you wish" "RTN","RMPRPIY2",142,0) W !," This is a location of an item or stock being tracked for inventory." "RTN","RMPRPIY2",143,0) Q "RTN","RMPRPIY2",144,0) ; "RTN","RMPRPIY2",145,0) ;***** QM2 - List Location names; part of help for Location prompt "RTN","RMPRPIY2",146,0) ; "RTN","RMPRPIY2",147,0) ; require RMPRSTN - Station number "RTN","RMPRPIY2",148,0) ; "RTN","RMPRPIY2",149,0) QM2 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRMAX,RMPRGBL,RMPRLIN "RTN","RMPRPIY2",150,0) S RMPRMAX=19,RMPRLIN=0 "RTN","RMPRPIY2",151,0) S RMPREXC="" "RTN","RMPRPIY2",152,0) S DIR(0)="EA" "RTN","RMPRPIY2",153,0) S DIR("A")="'^' TO STOP: " "RTN","RMPRPIY2",154,0) W !?3,"Choose from:" "RTN","RMPRPIY2",155,0) S RMPRGBL="^RMPR(661.5,"_"""XSL"","_RMPRSTN_")" "RTN","RMPRPIY2",156,0) QM2A S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIY2",157,0) I RMPRGBL="" G QM2X "RTN","RMPRPIY2",158,0) I $QS(RMPRGBL,1)'=661.5 G QM2X "RTN","RMPRPIY2",159,0) I $QS(RMPRGBL,2)'="XSL" G QM2X "RTN","RMPRPIY2",160,0) I $QS(RMPRGBL,3)'=RMPRSTN G QM2X "RTN","RMPRPIY2",161,0) W !?3,$QS(RMPRGBL,4) "RTN","RMPRPIY2",162,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIY2",163,0) I RMPRLIN'0 D G HCPCS1 "RTN","RMPRPIY3",46,0) . W ! "RTN","RMPRPIY3",47,0) . W "** No HCPCS Selected or Unable to Select Inactive HCPCS..." "RTN","RMPRPIY3",48,0) . Q "RTN","RMPRPIY3",49,0) S RMPR1("HCPCS")=$P(^RMPR(661.1,+Y,0),"^",1) "RTN","RMPRPIY3",50,0) HCPCSX Q RMPRERR "RTN","RMPRPIY3",51,0) ; "RTN","RMPRPIY3",52,0) ;***** QM1 - HCPCS prompt Help - List HCPCS at a Location "RTN","RMPRPIY3",53,0) ; requires RMRPSTN - Station number "RTN","RMPRPIY3",54,0) ; RMPR5("IEN") - Location ien "RTN","RMPRPIY3",55,0) ; "RTN","RMPRPIY3",56,0) QM1 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRMAX,RMPRLIN,RMPRH,RMPR1 "RTN","RMPRPIY3",57,0) N RMPRERR,DIC "RTN","RMPRPIY3",58,0) S RMPRMAX=5,RMPRLIN=0 "RTN","RMPRPIY3",59,0) S DIR(0)="EA" "RTN","RMPRPIY3",60,0) S DIR("A")="Enter for more or ^ to STOP listing" "RTN","RMPRPIY3",61,0) I '$D(^RMPR(661.4,"ASLHI",RMPRSTN,RMPR5("IEN"))) G QM1C "RTN","RMPRPIY3",62,0) W !,"List of HCPCS at location: ",RMPR5("NAME") "RTN","RMPRPIY3",63,0) S RMPRH="" "RTN","RMPRPIY3",64,0) QM1A S RMPRH=$O(^RMPR(661.4,"ASLHI",RMPRSTN,RMPR5("IEN"),RMPRH)) "RTN","RMPRPIY3",65,0) I RMPRH="" G QM1C "RTN","RMPRPIY3",66,0) S RMPR1("HCPCS")=RMPRH "RTN","RMPRPIY3",67,0) S RMPRERR=$$HPACT^RMPRPIX1(.RMPR1) "RTN","RMPRPIY3",68,0) W !,RMPRH,?12,RMPR1("SHORT DESC") "RTN","RMPRPIY3",69,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIY3",70,0) I RMPRLIN'0:"+",1:"")_RMPRGLQ_")" "RTN","RMPRPIY6",262,0) . W " @ Location ",RMPR5("NAME") "RTN","RMPRPIY6",263,0) . Q "RTN","RMPRPIY6",264,0) E D "RTN","RMPRPIY6",265,0) . W !!,"** The Item could not be modified due to a problem - please contact support" "RTN","RMPRPIY6",266,0) . Q "RTN","RMPRPIY6",267,0) D UNLOCK "RTN","RMPRPIY6",268,0) HAL H 2 "RTN","RMPRPIY6",269,0) K RMPRTVAL,RMPRUCST,RMPR6,RMPR7,RMPRVEND,RMPRQTY,RMPRREO,RMPRGLQ,RMPRGLAM "RTN","RMPRPIY6",270,0) G HCPCS "RTN","RMPRPIY6",271,0) ; "RTN","RMPRPIY6",272,0) ;***** exit points "RTN","RMPRPIY6",273,0) EIU D UNLOCK "RTN","RMPRPIY6",274,0) EIX D KILL^XUSCLEAN "RTN","RMPRPIY6",275,0) Q "RTN","RMPRPIY6",276,0) UNLOCK L -^RMPR(661.7,"XSHIDS",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIY6",277,0) Q "RTN","RMPRPIY7") 0^73^B53472701 "RTN","RMPRPIY7",1,0) RMPRPIY7 ;HINCIO/ODJ - PIP EDIT - PROMPTS ;9/18/02 15:17 "RTN","RMPRPIY7",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIY7",3,0) ; "RTN","RMPRPIY7",4,0) ;DBIA # 800 - FILEMAN read of file #440. "RTN","RMPRPIY7",5,0) Q "RTN","RMPRPIY7",6,0) ; The following subroutines are a series of prompts called "RTN","RMPRPIY7",7,0) ; by Edit LOCATION/HCPCS/ITEM option (EI^RMPRPIY6) "RTN","RMPRPIY7",8,0) ; "RTN","RMPRPIY7",9,0) ;***** LOCNM - Prompt for location "RTN","RMPRPIY7",10,0) ; must be in 661.5 and active "RTN","RMPRPIY7",11,0) LOCNM(RMPRSTN,RMPR5,RMPREXC) ; "RTN","RMPRPIY7",12,0) N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT "RTN","RMPRPIY7",13,0) D NOW^%DTC S RMPRTDT=X ;today's date "RTN","RMPRPIY7",14,0) S RMPREXC="" "RTN","RMPRPIY7",15,0) S RMPRERR=0 "RTN","RMPRPIY7",16,0) S DIR(0)="FOA" "RTN","RMPRPIY7",17,0) S DIR("A")="Enter Pros Location: " "RTN","RMPRPIY7",18,0) I $G(RMPR5("NAME"))'="" S DIR("B")=RMPR5("NAME") "RTN","RMPRPIY7",19,0) S DIR("?")="^D QM^RMPRPIYB" "RTN","RMPRPIY7",20,0) S DIR("??")="^D QM2^RMPRPIYB" "RTN","RMPRPIY7",21,0) S RMPR5("IEN")="" "RTN","RMPRPIY7",22,0) LOCNM1 D ^DIR "RTN","RMPRPIY7",23,0) I $G(RMPR5("IEN"))'="" S RMPREXC="" G LOCNMX "RTN","RMPRPIY7",24,0) I $D(DTOUT) S RMPREXC="T" G LOCNMX "RTN","RMPRPIY7",25,0) I $D(DIROUT) S RMPREXC="P" G LOCNMX "RTN","RMPRPIY7",26,0) I X=""!(X["^") S RMPREXC="^" G LOCNMX "RTN","RMPRPIY7",27,0) K RMPR5 "RTN","RMPRPIY7",28,0) S RMPR5("STATION")=RMPRSTN "RTN","RMPRPIY7",29,0) S RMPR5("STATION IEN")=RMPRSTN "RTN","RMPRPIY7",30,0) D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5) "RTN","RMPRPIY7",31,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIY7",32,0) I $G(RMPR5("IEN"))="" D G LOCNM1 "RTN","RMPRPIY7",33,0) . W !,"Please enter a valid Location" "RTN","RMPRPIY7",34,0) . Q "RTN","RMPRPIY7",35,0) ; "RTN","RMPRPIY7",36,0) ; exit "RTN","RMPRPIY7",37,0) LOCNMX Q "RTN","RMPRPIY7",38,0) ; "RTN","RMPRPIY7",39,0) ;***** OK - Prompt for an OK "RTN","RMPRPIY7",40,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIY7",41,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIY7",42,0) S RMPREXC="" "RTN","RMPRPIY7",43,0) S RMPRYN="N" "RTN","RMPRPIY7",44,0) S DIR("A")=" ...OK" "RTN","RMPRPIY7",45,0) S DIR("B")="Yes" "RTN","RMPRPIY7",46,0) S DIR(0)="Y" "RTN","RMPRPIY7",47,0) D ^DIR "RTN","RMPRPIY7",48,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIY7",49,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIY7",50,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIY7",51,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIY7",52,0) OKX Q "RTN","RMPRPIY7",53,0) ; "RTN","RMPRPIY7",54,0) ;***** HCPCS - Prompt for HCPCS "RTN","RMPRPIY7",55,0) HCPCS(RMPRSTN,RMPRHPTX,RMPR1,RMPR11,RMPREXC) ; "RTN","RMPRPIY7",56,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DIC,DA,RMPR1N,RMSTN "RTN","RMPRPIY7",57,0) N RM6610 "RTN","RMPRPIY7",58,0) S DIR("A")="Select HCPCS: ",RMSTN=RMPRSTN "RTN","RMPRPIY7",59,0) S DIR("S")="I $P(^RMPR(661.11,+Y,0),U,4)=RMSTN" "RTN","RMPRPIY7",60,0) S RMPRERR=0 "RTN","RMPRPIY7",61,0) S RMPREXC="" "RTN","RMPRPIY7",62,0) S RMPRHPTX=$G(RMPRHPTX) "RTN","RMPRPIY7",63,0) I RMPRHPTX'="" S DIR("B")=RMPRHPTX "RTN","RMPRPIY7",64,0) S DIR(0)="FOA" "RTN","RMPRPIY7",65,0) S DIR("?")="^D QM2^RMPRPIYC" "RTN","RMPRPIY7",66,0) S DIR("??")="^D QM2^RMPRPIYC" "RTN","RMPRPIY7",67,0) S DIR("???")="^D QM2^RMPRPIYC" "RTN","RMPRPIY7",68,0) HCPCS1 K RMPR1N D ^DIR "RTN","RMPRPIY7",69,0) I $G(RMPR1N("IEN"))'="" S RMPRHPTX=RMPR1N("HCPCS") G CHECK "RTN","RMPRPIY7",70,0) I $D(DTOUT) S RMPREXC="T" G HCPCSX "RTN","RMPRPIY7",71,0) I $D(DIROUT) S RMPREXC="P" G HCPCSX "RTN","RMPRPIY7",72,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX "RTN","RMPRPIY7",73,0) D LIKE^RMPRPIYC(RMPRSTN,X,.RMPREXC,.RMPR1N,.RMPR11) "RTN","RMPRPIY7",74,0) I RMPREXC'="" G HCPCS1 "RTN","RMPRPIY7",75,0) I $G(RMPR1N("IEN"))'="",$G(RMPR1("REMOVE")) G HCPCSU "RTN","RMPRPIY7",76,0) CHECK I $G(RMPR1N("IEN")),$D(^RMPR(661.1,$G(RMPR1N("IEN")),0)),'($P(^RMPR(661.1,RMPR1N("IEN"),0),U,5)) W !,"** No HCPCS Selected or Unable to Select Inactive HCPCS..." G HCPCS1 "RTN","RMPRPIY7",77,0) I $G(RMPR1N("IEN"))'="" G HCPCSU "RTN","RMPRPIY7",78,0) G HCPCS1 "RTN","RMPRPIY7",79,0) HCPCSU K RMPR1 M RMPR1=RMPR1N "RTN","RMPRPIY7",80,0) HCPCSX Q "RTN","RMPRPIY7",81,0) ; "RTN","RMPRPIY7",82,0) ;***** ITEM - Prompt for Item - restrict choice to Location and HCPC "RTN","RMPRPIY7",83,0) ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ; "RTN","RMPRPIY7",84,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN "RTN","RMPRPIY7",85,0) S RMPRERR=0 "RTN","RMPRPIY7",86,0) S RMPREXC="" "RTN","RMPRPIY7",87,0) I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX "RTN","RMPRPIY7",88,0) I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX "RTN","RMPRPIY7",89,0) I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX "RTN","RMPRPIY7",90,0) K RMPR11,RMPR4 "RTN","RMPRPIY7",91,0) S DIR(0)="FOA^1:50" "RTN","RMPRPIY7",92,0) S DIR("A")="Enter PSAS Item to Edit: " "RTN","RMPRPIY7",93,0) S DIR("?")="^D QM^RMPRPIY8" "RTN","RMPRPIY7",94,0) S DIR("??")="^D QQM^RMPRPIY8" "RTN","RMPRPIY7",95,0) ITEMA1 D ^DIR "RTN","RMPRPIY7",96,0) I $D(DTOUT) S RMPREXC="T" G ITEMX "RTN","RMPRPIY7",97,0) I $D(DIROUT) S RMPREXC="P" G ITEMX "RTN","RMPRPIY7",98,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX "RTN","RMPRPIY7",99,0) D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4) "RTN","RMPRPIY7",100,0) I RMPREXC="T" G ITEMX "RTN","RMPRPIY7",101,0) I RMPREXC="P" G ITEMX "RTN","RMPRPIY7",102,0) I RMPREXC="^" G ITEMA1 "RTN","RMPRPIY7",103,0) I RMPR4("IEN")="" D G ITEMA1 "RTN","RMPRPIY7",104,0) . W !,"Cannot locate ITEM with this sequence NUMBER" "RTN","RMPRPIY7",105,0) . Q "RTN","RMPRPIY7",106,0) W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION") "RTN","RMPRPIY7",107,0) D OK(.RMPRYN,.RMPREXC) "RTN","RMPRPIY7",108,0) I RMPRYN'="Y" G ITEMA1 "RTN","RMPRPIY7",109,0) G ITEMX "RTN","RMPRPIY7",110,0) ITEMX Q RMPRERR "RTN","RMPRPIY7",111,0) ; "RTN","RMPRPIY7",112,0) ;***** QTY - Prompt for Quantity "RTN","RMPRPIY7",113,0) QTY(RMPRQTY,RMPREXC) ; "RTN","RMPRPIY7",114,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIY7",115,0) S RMPRQTY=$G(RMPRQTY) "RTN","RMPRPIY7",116,0) S RMPRERR=0 "RTN","RMPRPIY7",117,0) S DIR(0)="NA^1:99999:0" "RTN","RMPRPIY7",118,0) S DIR("A")="QUANTITY: " "RTN","RMPRPIY7",119,0) S:RMPRQTY'="" DIR("B")=RMPRQTY "RTN","RMPRPIY7",120,0) D ^DIR "RTN","RMPRPIY7",121,0) I $D(DTOUT) S RMPREXC="T" G QTYX "RTN","RMPRPIY7",122,0) I $D(DIROUT) S RMPREXC="P" G QTYX "RTN","RMPRPIY7",123,0) I X=""!(X["^") S RMPREXC="^" G QTYX "RTN","RMPRPIY7",124,0) S RMPRQTY=Y "RTN","RMPRPIY7",125,0) QTYX Q RMPRERR "RTN","RMPRPIY7",126,0) ; "RTN","RMPRPIY7",127,0) ;***** TVAL - Prompt for total $ value "RTN","RMPRPIY7",128,0) TVAL(RMPRTVAL,RMPREXC) ; "RTN","RMPRPIY7",129,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIY7",130,0) S RMPRTVAL=$G(RMPRTVAL) "RTN","RMPRPIY7",131,0) S RMPRERR=0 "RTN","RMPRPIY7",132,0) S DIR(0)="NOA^0:999999:2" "RTN","RMPRPIY7",133,0) S DIR("A")="TOTAL COST OF QUANTITY: " "RTN","RMPRPIY7",134,0) S:RMPRTVAL'="" DIR("B")=RMPRTVAL "RTN","RMPRPIY7",135,0) D ^DIR "RTN","RMPRPIY7",136,0) I $D(DTOUT) S RMPREXC="T" G TVALX "RTN","RMPRPIY7",137,0) I $D(DIROUT) S RMPREXC="P" G TVALX "RTN","RMPRPIY7",138,0) I X["^" S RMPREXC="^" G TVALX "RTN","RMPRPIY7",139,0) I X="" G TVALX "RTN","RMPRPIY7",140,0) S RMPRTVAL=Y "RTN","RMPRPIY7",141,0) TVALX Q RMPRERR "RTN","RMPRPIY7",142,0) ; "RTN","RMPRPIY7",143,0) ;***** REO - Prompt for Re-Order Level "RTN","RMPRPIY7",144,0) REO(RMPRREO,RMPREXC) ; "RTN","RMPRPIY7",145,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIY7",146,0) S RMPRREO=$G(RMPRREO) "RTN","RMPRPIY7",147,0) S RMPRERR=0 "RTN","RMPRPIY7",148,0) S DIR(0)="NOA^0::0" "RTN","RMPRPIY7",149,0) S DIR("A")="RE-ORDER LEVEL: " "RTN","RMPRPIY7",150,0) S:RMPRREO'="" DIR("B")=RMPRREO "RTN","RMPRPIY7",151,0) D ^DIR "RTN","RMPRPIY7",152,0) I $D(DTOUT) S RMPREXC="T" G REOX "RTN","RMPRPIY7",153,0) I $D(DIROUT) S RMPREXC="P" G REOX "RTN","RMPRPIY7",154,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G REOX "RTN","RMPRPIY7",155,0) S RMPRREO=Y "RTN","RMPRPIY7",156,0) REOX Q RMPRERR "RTN","RMPRPIY7",157,0) ; "RTN","RMPRPIY7",158,0) ;***** VEND - Prompt for Vendor "RTN","RMPRPIY7",159,0) VEND(RMPRVEND,RMPREXC) ; "RTN","RMPRPIY7",160,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIY7",161,0) S RMPRVEND=$G(RMPRVEND("IEN")) "RTN","RMPRPIY7",162,0) S RMPRERR=0 "RTN","RMPRPIY7",163,0) S DIR(0)="P^440:EMZ" "RTN","RMPRPIY7",164,0) S DIR("A")="VENDOR" "RTN","RMPRPIY7",165,0) S:RMPRVEND'="" DIR("B")=RMPRVEND("NAME") "RTN","RMPRPIY7",166,0) D ^DIR "RTN","RMPRPIY7",167,0) I $D(DTOUT) S RMPREXC="T" G VENDX "RTN","RMPRPIY7",168,0) I $D(DIROUT) S RMPREXC="P" G VENDX "RTN","RMPRPIY7",169,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G VENDX "RTN","RMPRPIY7",170,0) S RMPRVEND("IEN")=$P(Y,"^",1) "RTN","RMPRPIY7",171,0) S RMPRVEND("NAME")=$P(Y,"^",2) "RTN","RMPRPIY7",172,0) VENDX Q RMPRERR "RTN","RMPRPIY7",173,0) ; "RTN","RMPRPIY7",174,0) ;***** PVEN - Pick the current stock record to edit "RTN","RMPRPIY7",175,0) PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ; "RTN","RMPRPIY7",176,0) N DIR,X,Y,DA,RMPRGBL,RMPRLIN,RMPRA,RMPRERR,RMPRX,RMPRY,RMPRB "RTN","RMPRPIY7",177,0) N RMPR7I "RTN","RMPRPIY7",178,0) S RMPREXC="" "RTN","RMPRPIY7",179,0) S RMPRX="",RMPRY=0 "RTN","RMPRPIY7",180,0) S RMPRLIN=0 "RTN","RMPRPIY7",181,0) S RMPRGBL=$Q(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM)) "RTN","RMPRPIY7",182,0) G PVEN1A "RTN","RMPRPIY7",183,0) PVEN1 S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIY7",184,0) PVEN1A I $QS(RMPRGBL,1)'=661.7 G PVEN2 "RTN","RMPRPIY7",185,0) I $QS(RMPRGBL,2)'="XSLHIDS" G PVEN2 "RTN","RMPRPIY7",186,0) I $QS(RMPRGBL,3)'=RMPRSTN G PVEN2 "RTN","RMPRPIY7",187,0) I $QS(RMPRGBL,4)'=RMPRLCN G PVEN2 "RTN","RMPRPIY7",188,0) I $QS(RMPRGBL,5)'=RMPRHCPC G PVEN2 "RTN","RMPRPIY7",189,0) I $QS(RMPRGBL,6)'=RMPRITM G PVEN2 "RTN","RMPRPIY7",190,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIY7",191,0) S RMPRA(RMPRLIN)=$QS(RMPRGBL,9) "RTN","RMPRPIY7",192,0) G PVEN1 "RTN","RMPRPIY7",193,0) PVEN2 I RMPRLIN=0 G PVENX "RTN","RMPRPIY7",194,0) I RMPRLIN=1 S X=1 G PVEN3 "RTN","RMPRPIY7",195,0) W !,"Select a current Stock Record to edit...",! "RTN","RMPRPIY7",196,0) W !,?7,"Date",?21,"Quantity",?35,"Value",?42,"Vendor" "RTN","RMPRPIY7",197,0) S RMPRX="",RMPRLIN=0 "RTN","RMPRPIY7",198,0) F S RMPRX=$O(RMPRA(RMPRX)) Q:RMPRX="" D "RTN","RMPRPIY7",199,0) . S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIY7",200,0) . K RMPR7 "RTN","RMPRPIY7",201,0) . S RMPR7("IEN")=RMPRA(RMPRX) "RTN","RMPRPIY7",202,0) . S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIY7",203,0) . W !,?2,$J(RMPRLIN,2) "RTN","RMPRPIY7",204,0) . W ?7,$P(RMPR7("DATE&TIME"),"@",1) "RTN","RMPRPIY7",205,0) . W ?21,$J(RMPR7("QUANTITY"),8,0) "RTN","RMPRPIY7",206,0) . W ?30,$J(RMPR7("VALUE"),10,2) "RTN","RMPRPIY7",207,0) . K RMPR7I "RTN","RMPRPIY7",208,0) . S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIY7",209,0) . K RMPR6 "RTN","RMPRPIY7",210,0) . S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME") "RTN","RMPRPIY7",211,0) . S RMPR6("HCPCS")=RMPRHCPC "RTN","RMPRPIY7",212,0) . S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIY7",213,0) . W ?42,RMPR6("VENDOR") "RTN","RMPRPIY7",214,0) . Q "RTN","RMPRPIY7",215,0) K RMPR7,RMPR6 "RTN","RMPRPIY7",216,0) S DIR(0)="NAO^1:"_RMPRLIN_": " "RTN","RMPRPIY7",217,0) S DIR("A")="CHOOSE 1-"_RMPRLIN_": " "RTN","RMPRPIY7",218,0) D ^DIR "RTN","RMPRPIY7",219,0) I $D(DTOUT) S RMPREXC="T" G PVENX "RTN","RMPRPIY7",220,0) I $D(DIROUT) S RMPREXC="P" G PVENX "RTN","RMPRPIY7",221,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G PVENX "RTN","RMPRPIY7",222,0) PVEN3 S RMPR7("IEN")=RMPRA(X) "RTN","RMPRPIY7",223,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIY7",224,0) K RMPR7I "RTN","RMPRPIY7",225,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIY7",226,0) S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME") "RTN","RMPRPIY7",227,0) S RMPR6("HCPCS")=RMPRHCPC "RTN","RMPRPIY7",228,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIY7",229,0) PVENX Q "RTN","RMPRPIY8") 0^74^B25068279 "RTN","RMPRPIY8",1,0) RMPRPIY8 ;HINCIO/ODJ - Pick HCPCS Item ;3/8/01 "RTN","RMPRPIY8",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIY8",3,0) Q "RTN","RMPRPIY8",4,0) ; "RTN","RMPRPIY8",5,0) ; ? Help "RTN","RMPRPIY8",6,0) QM W ?4,"Answer with ITEM, or NUMBER, or DESCRIPTION" "RTN","RMPRPIY8",7,0) W !?3,"Choose from:" "RTN","RMPRPIY8",8,0) D QM2 "RTN","RMPRPIY8",9,0) Q "RTN","RMPRPIY8",10,0) ; "RTN","RMPRPIY8",11,0) ; ?? Help "RTN","RMPRPIY8",12,0) QQM W !?3,"Choose from:" "RTN","RMPRPIY8",13,0) D QM2 "RTN","RMPRPIY8",14,0) Q "RTN","RMPRPIY8",15,0) QM2 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRMAX,RMPRI,RMPRLIN,RMPR,RMPRERR "RTN","RMPRPIY8",16,0) S RMPRMAX=5,RMPRLIN=0 "RTN","RMPRPIY8",17,0) S RMPREXC="" "RTN","RMPRPIY8",18,0) S DIR(0)="EA" "RTN","RMPRPIY8",19,0) S DIR("A")="'^' TO STOP: " "RTN","RMPRPIY8",20,0) S RMPRI="" "RTN","RMPRPIY8",21,0) QM2A S RMPRI=$O(^RMPR(661.4,"ASLHI",RMPRSTN,RMPRLCN,RMPRHCPC,RMPRI)) "RTN","RMPRPIY8",22,0) I RMPRI="" G QM2X "RTN","RMPRPIY8",23,0) K RMPR "RTN","RMPRPIY8",24,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPIY8",25,0) S RMPR("HCPCS")=RMPRHCPC "RTN","RMPRPIY8",26,0) S RMPR("ITEM")=RMPRI "RTN","RMPRPIY8",27,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR) "RTN","RMPRPIY8",28,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIY8",29,0) W !?3,RMPRLIN,?16,RMPR("HCPCS-ITEM"),?28,RMPR("DESCRIPTION") "RTN","RMPRPIY8",30,0) I RMPRLIN'441) "RTN","RMPRPIY9",45,0) MASIT S RMPROVAL=$G(RMPR61("IEN")) "RTN","RMPRPIY9",46,0) D MASIT^RMPRPIY1(.RMPR61,.RMPREXC) "RTN","RMPRPIY9",47,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",48,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIY9",49,0) I RMPREXC="^" G AEX "RTN","RMPRPIY9",50,0) I RMPROVAL'=RMPR61("IEN") D "RTN","RMPRPIY9",51,0) . S RMPRERR=$$GET^RMPRPIXD(.RMPR61) "RTN","RMPRPIY9",52,0) . K RMPRSRC,RMPRREO,RMPR4 "RTN","RMPRPIY9",53,0) . S RMPR11("ITEM MASTER IEN")=RMPR61("IEN") "RTN","RMPRPIY9",54,0) . S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",55,0) . S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",56,0) . Q "RTN","RMPRPIY9",57,0) ; "RTN","RMPRPIY9",58,0) ;***** IDESC - call prompt for Item Description edit "RTN","RMPRPIY9",59,0) IDESC S RMPROVAL=$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIY9",60,0) D ITED^RMPRPIY4(.RMPR11,.RMPREXC) "RTN","RMPRPIY9",61,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",62,0) I RMPREXC="P" G MASIT "RTN","RMPRPIY9",63,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",64,0) I $G(RMPR11("DESCRIPTION"))="" D "RTN","RMPRPIY9",65,0) . S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",66,0) . S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",67,0) . Q "RTN","RMPRPIY9",68,0) I RMPROVAL'=RMPR11("DESCRIPTION") D "RTN","RMPRPIY9",69,0) . K RMPRSRC,RMPRREO "RTN","RMPRPIY9",70,0) . Q "RTN","RMPRPIY9",71,0) ; "RTN","RMPRPIY9",72,0) ;***** SRC - call prompt for Source (Commercial or VA) "RTN","RMPRPIY9",73,0) SRC S RMPROVAL=$G(RMPRSRC) "RTN","RMPRPIY9",74,0) D SRC^RMPRPIY5(.RMPRSRC,.RMPREXC) "RTN","RMPRPIY9",75,0) I RMPREXC="P" G IDESC "RTN","RMPRPIY9",76,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",77,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",78,0) I RMPROVAL'=RMPRSRC K RMPRREO "RTN","RMPRPIY9",79,0) ; "RTN","RMPRPIY9",80,0) ; Update the inventory file (661.11) "RTN","RMPRPIY9",81,0) S RMPR11("SOURCE")=RMPRSRC "RTN","RMPRPIY9",82,0) S RMPR11("UNIT")="" "RTN","RMPRPIY9",83,0) S RMPRERR=0 "RTN","RMPRPIY9",84,0) S RMPRUPDF=1 ;update flag "RTN","RMPRPIY9",85,0) ; "RTN","RMPRPIY9",86,0) ; Only create new record if one doesn't already exist "RTN","RMPRPIY9",87,0) I $D(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"))) D "RTN","RMPRPIY9",88,0) . S RMPRI="" "RTN","RMPRPIY9",89,0) . F S RMPRI=$O(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"),RMPRI)) Q:RMPRI="" D Q:'RMPRUPDF "RTN","RMPRPIY9",90,0) .. S RMPR11("ITEM")=RMPRI "RTN","RMPRPIY9",91,0) .. S RMPR11("IEN")="" "RTN","RMPRPIY9",92,0) .. S RMPRERR=$$DUP^RMPRPIX1(.RMPR11,.RMPRDUP) "RTN","RMPRPIY9",93,0) .. I RMPRERR S RMPRUPDF=0 Q "RTN","RMPRPIY9",94,0) .. I 'RMPRDUP S RMPRUPDF=0 Q "RTN","RMPRPIY9",95,0) .. Q "RTN","RMPRPIY9",96,0) . Q "RTN","RMPRPIY9",97,0) I RMPRUPDF D "RTN","RMPRPIY9",98,0) . S RMPR11("ITEM")="" "RTN","RMPRPIY9",99,0) . K RMPR11("IEN") "RTN","RMPRPIY9",100,0) . S RMPRERR=$$CRE^RMPRPIX1(.RMPR11) "RTN","RMPRPIY9",101,0) . S RMPR4("RE-ORDER QTY")=0 "RTN","RMPRPIY9",102,0) . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5) "RTN","RMPRPIY9",103,0) . Q "RTN","RMPRPIY9",104,0) I RMPRERR D G AEX "RTN","RMPRPIY9",105,0) . W !,"Problem updating inventory item file, please contact support." "RTN","RMPRPIY9",106,0) . H 3 "RTN","RMPRPIY9",107,0) . Q "RTN","RMPRPIY9",108,0) ; "RTN","RMPRPIY9",109,0) ;***** REO - call prompt for Re-Order Quantity "RTN","RMPRPIY9",110,0) REO S RMPROVAL=$G(RMPRREO) "RTN","RMPRPIY9",111,0) D REO^RMPRPIY5(.RMPRREO,.RMPREXC) "RTN","RMPRPIY9",112,0) I RMPREXC="P" G SRC "RTN","RMPRPIY9",113,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",114,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",115,0) ; "RTN","RMPRPIY9",116,0) ; Update the reorder file (661.4) "RTN","RMPRPIY9",117,0) I RMPROVAL=RMPRREO G QTY "RTN","RMPRPIY9",118,0) S RMPR4("RE-ORDER QTY")=RMPRREO "RTN","RMPRPIY9",119,0) S RMPRERR=$$UPD^RMPRPIX4(.RMPR4,,) "RTN","RMPRPIY9",120,0) ; "RTN","RMPRPIY9",121,0) ; At this point the item has been added to inventory (661.11) and "RTN","RMPRPIY9",122,0) ; the re-order file (661.4) "RTN","RMPRPIY9",123,0) ; The following prompts are for receipting in a quantity of the item "RTN","RMPRPIY9",124,0) ; "RTN","RMPRPIY9",125,0) ;***** QTY - call prompt for Quantity "RTN","RMPRPIY9",126,0) QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC) "RTN","RMPRPIY9",127,0) I RMPREXC="P" G REO "RTN","RMPRPIY9",128,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",129,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",130,0) S RMPRQTY=+$G(RMPRQTY) "RTN","RMPRPIY9",131,0) I 'RMPRQTY G QTY "RTN","RMPRPIY9",132,0) ; "RTN","RMPRPIY9",133,0) ;***** UCST - call prompt for Unit Cost "RTN","RMPRPIY9",134,0) UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC) "RTN","RMPRPIY9",135,0) I RMPREXC="P" G QTY "RTN","RMPRPIY9",136,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",137,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",138,0) S RMPRUCST=+$G(RMPRUCST) "RTN","RMPRPIY9",139,0) ; "RTN","RMPRPIY9",140,0) ;***** TVAL - Total Value - use if Unit Cost not used "RTN","RMPRPIY9",141,0) TVAL I RMPRUCST D G VEND "RTN","RMPRPIY9",142,0) . S RMPRTVAL=$J(RMPRQTY*RMPRUCST,0,2) "RTN","RMPRPIY9",143,0) . W !,"TOTAL COST OF QUANTITY: "_RMPRTVAL "RTN","RMPRPIY9",144,0) . Q "RTN","RMPRPIY9",145,0) D TVAL^RMPRPIY5(.RMPRTVAL,.RMPREXC) "RTN","RMPRPIY9",146,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",147,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",148,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",149,0) ; "RTN","RMPRPIY9",150,0) ;***** VEND - call prompt for Vendor "RTN","RMPRPIY9",151,0) VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC) "RTN","RMPRPIY9",152,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",153,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",154,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",155,0) ; "RTN","RMPRPIY9",156,0) ; "RTN","RMPRPIY9",157,0) ;***** UNIT - call prompt for UNIT OF ISSUE "RTN","RMPRPIY9",158,0) UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC) "RTN","RMPRPIY9",159,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",160,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",161,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",162,0) ; "RTN","RMPRPIY9",163,0) ;***** TRANS - Create receipt record for adding an item "RTN","RMPRPIY9",164,0) TRANS S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIY9",165,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIY9",166,0) S RMPR6("QUANTITY")=RMPRQTY "RTN","RMPRPIY9",167,0) S RMPR6("VALUE")=RMPRTVAL "RTN","RMPRPIY9",168,0) S RMPR6("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIY9",169,0) S RMPR6("UNIT")=RMPRUNI("IEN") "RTN","RMPRPIY9",170,0) S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1) ;receipt API "RTN","RMPRPIY9",171,0) TRANSX I RMPRERR D "RTN","RMPRPIY9",172,0) . W !!,"** Inventory could not be updated, please contact support",! "RTN","RMPRPIY9",173,0) . Q "RTN","RMPRPIY9",174,0) E D "RTN","RMPRPIY9",175,0) . W !!,"** Inventory updated.",! "RTN","RMPRPIY9",176,0) .;ask for number of labels and print barcode. "RTN","RMPRPIY9",177,0) . S RMPR11("HCPCS-ITEM")=RMPR11("HCPCS")_"-"_RMPR11("ITEM") "RTN","RMPRPIY9",178,0) . D NLAB^RMPRPIYY "RTN","RMPRPIY9",179,0) . Q "RTN","RMPRPIY9",180,0) K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST "RTN","RMPRPIY9",181,0) G HCPCS "RTN","RMPRPIY9",182,0) ; "RTN","RMPRPIY9",183,0) ;***** exit "RTN","RMPRPIY9",184,0) AEX D KILL^XUSCLEAN "RTN","RMPRPIY9",185,0) Q "RTN","RMPRPIYA") 0^45^B10240071 "RTN","RMPRPIYA",1,0) RMPRPIYA ;HINCIO/ODJ - UP - Stock Reconciliation ;3/8/01 "RTN","RMPRPIYA",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYA",3,0) Q "RTN","RMPRPIYA",4,0) ; "RTN","RMPRPIYA",5,0) ; Replaces UP option in old PIP (cf UPD^RMPR5NTU) "RTN","RMPRPIYA",6,0) UP N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR6,RMPR11,RMPRV,RMPR,RMPRI,RMPROVAL "RTN","RMPRPIYA",7,0) N RMPR1,RMPRLCN "RTN","RMPRPIYA",8,0) ; "RTN","RMPRPIYA",9,0) ; Station "RTN","RMPRPIYA",10,0) STN S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIYA",11,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYA",12,0) I RMPRERR G UPX "RTN","RMPRPIYA",13,0) I RMPREXC'="" G UPX "RTN","RMPRPIYA",14,0) I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11 "RTN","RMPRPIYA",15,0) ; "RTN","RMPRPIYA",16,0) ;***** HCPCS - prompt for HCPCS and Item "RTN","RMPRPIYA",17,0) HCPCS W !!,"Reconcile Inventory item quantities on hand...",! "RTN","RMPRPIYA",18,0) K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1 "RTN","RMPRPIYA",19,0) D HCPCS^RMPRPIY1(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIYA",20,0) I RMPREXC="P" G STN "RTN","RMPRPIYA",21,0) I RMPREXC="T" G UPX "RTN","RMPRPIYA",22,0) I RMPREXC="^" G UPX "RTN","RMPRPIYA",23,0) S (RMPR11("STATION"),RMPR11("STATION IEN"))=RMPRSTN("IEN") "RTN","RMPRPIYA",24,0) ; "RTN","RMPRPIYA",25,0) ;***** LOCN - prompt for location (if more than 1) "RTN","RMPRPIYA",26,0) LOCN W ! S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN")) "RTN","RMPRPIYA",27,0) I RMPRLCN D G VEND0 "RTN","RMPRPIYA",28,0) . K RMPR5 "RTN","RMPRPIYA",29,0) . S RMPR5("IEN")=RMPRLCN "RTN","RMPRPIYA",30,0) . S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYA",31,0) . W !,"Location: "_RMPR5("NAME") "RTN","RMPRPIYA",32,0) . Q "RTN","RMPRPIYA",33,0) D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIYA",34,0) I RMPREXC="T" G UPX "RTN","RMPRPIYA",35,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYA",36,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIYA",37,0) ; "RTN","RMPRPIYA",38,0) ; Vendor "RTN","RMPRPIYA",39,0) VEND0 K RMPR "RTN","RMPRPIYA",40,0) S RMPR("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYA",41,0) S RMPR("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIYA",42,0) S RMPR("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIYA",43,0) S RMPR("ITEM")=RMPR11("ITEM") "RTN","RMPRPIYA",44,0) K RMPRV "RTN","RMPRPIYA",45,0) S RMPRERR=$$STOCK^RMPRPIUV(.RMPR,.RMPRV) "RTN","RMPRPIYA",46,0) I RMPRV=0 G VEND "RTN","RMPRPIYA",47,0) S RMPRVEND("IEN")=$O(RMPRV("")) "RTN","RMPRPIYA",48,0) S RMPRVEND("NAME")=$P(RMPRV(RMPRVEND("IEN")),"^",3) "RTN","RMPRPIYA",49,0) S RMPRQTY=$P(RMPRV(RMPRVEND("IEN")),"^",1) "RTN","RMPRPIYA",50,0) I RMPRV>1 D "RTN","RMPRPIYA",51,0) . W !,"The following Vendors of the selected Item exist in this location..." "RTN","RMPRPIYA",52,0) . S RMPRI="" "RTN","RMPRPIYA",53,0) . F S RMPRI=$O(RMPRV(RMPRI)) Q:RMPRI="" D "RTN","RMPRPIYA",54,0) .. W !,$E($$GETVEN(RMPRI),1,20) "RTN","RMPRPIYA",55,0) .. W ?22,$P(RMPRV(RMPRI),"^",1)_" units on hand" "RTN","RMPRPIYA",56,0) .. Q "RTN","RMPRPIYA",57,0) . Q "RTN","RMPRPIYA",58,0) VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC) "RTN","RMPRPIYA",59,0) I RMPREXC="T" G UPX "RTN","RMPRPIYA",60,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYA",61,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIYA",62,0) ; "RTN","RMPRPIYA",63,0) ; Quantity "RTN","RMPRPIYA",64,0) QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC) "RTN","RMPRPIYA",65,0) I RMPREXC="T" G UPX "RTN","RMPRPIYA",66,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYA",67,0) I RMPREXC="P" G VEND "RTN","RMPRPIYA",68,0) ; "RTN","RMPRPIYA",69,0) ; Now create reconciliation record "RTN","RMPRPIYA",70,0) TRANS S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYA",71,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYA",72,0) S RMPR6("QUANTITY")=RMPRQTY "RTN","RMPRPIYA",73,0) S RMPR6("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIYA",74,0) S RMPR6("VENDOR IEN")=RMPRVEND("IEN") "RTN","RMPRPIYA",75,0) S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5) "RTN","RMPRPIYA",76,0) I RMPRERR D "RTN","RMPRPIYA",77,0) . W !,"*** There were problems with the reconciliation, please contact support." "RTN","RMPRPIYA",78,0) . Q "RTN","RMPRPIYA",79,0) E D "RTN","RMPRPIYA",80,0) . W !,"*** Item was reconciled..." "RTN","RMPRPIYA",81,0) . Q "RTN","RMPRPIYA",82,0) H 1 "RTN","RMPRPIYA",83,0) K RMPR11,RMPR6,RMPRVEND,RMPR5,RMPRQTY,RMPR1 "RTN","RMPRPIYA",84,0) G HCPCS "RTN","RMPRPIYA",85,0) UPX D KILL^XUSCLEAN "RTN","RMPRPIYA",86,0) Q "RTN","RMPRPIYA",87,0) Q "RTN","RMPRPIYA",88,0) ; "RTN","RMPRPIYA",89,0) ; Return Vendor Name "RTN","RMPRPIYA",90,0) GETVEN(RMPRIEN) ; "RTN","RMPRPIYA",91,0) N RMPRFDA,RMPRI,RMPRO,X,Y,DA "RTN","RMPRPIYA",92,0) S RMPRI=RMPRIEN_"," "RTN","RMPRPIYA",93,0) D GETS^DIQ(440,RMPRI,".01","","RMPRO") "RTN","RMPRPIYA",94,0) Q RMPRO(440,RMPRI,.01) "RTN","RMPRPIYB") 0^46^B22001165 "RTN","RMPRPIYB",1,0) RMPRPIYB ;HINCIO/ODJ - PIP Prompts - Select Existing Location ;3/8/01 "RTN","RMPRPIYB",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYB",3,0) Q "RTN","RMPRPIYB",4,0) ; "RTN","RMPRPIYB",5,0) ;***** LOCNM - General Prompt for stock location. "RTN","RMPRPIYB",6,0) ; Location must exist in ^RMPR(661.5 and be active "RTN","RMPRPIYB",7,0) LOCNM(RMPRSTN,RMPR5,RMPREXC) ; "RTN","RMPRPIYB",8,0) N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT "RTN","RMPRPIYB",9,0) STA D NOW^%DTC S RMPRTDT=X ;today's date "RTN","RMPRPIYB",10,0) S RMPREXC="" "RTN","RMPRPIYB",11,0) S RMPRERR=0 "RTN","RMPRPIYB",12,0) S DIR(0)="FOA^1:30" "RTN","RMPRPIYB",13,0) S DIR("A")="Enter Pros Location: " "RTN","RMPRPIYB",14,0) S DIR("?")="^D QM^RMPRPIYB" "RTN","RMPRPIYB",15,0) S DIR("??")="^D QM2^RMPRPIYB" "RTN","RMPRPIYB",16,0) W STA "RTN","RMPRPIYB",17,0) LOCNM1 D ^DIR "RTN","RMPRPIYB",18,0) I $D(DTOUT) S RMPREXC="T" G LOCNMX "RTN","RMPRPIYB",19,0) I $D(DIROUT) S RMPREXC="P" G LOCNMX "RTN","RMPRPIYB",20,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G LOCNMX "RTN","RMPRPIYB",21,0) K RMPR5 "RTN","RMPRPIYB",22,0) S RMPR5("STATION")=RMPRSTN "RTN","RMPRPIYB",23,0) S RMPR5("NAME")=X "RTN","RMPRPIYB",24,0) D LIKE(RMPRSTN,X,.RMPREXC,.RMPR5) "RTN","RMPRPIYB",25,0) I $G(RMPR5("IEN"))="" D G LOCNM1 "RTN","RMPRPIYB",26,0) . W !,"Please enter a valid Location" "RTN","RMPRPIYB",27,0) . Q "RTN","RMPRPIYB",28,0) G LOCNMX "RTN","RMPRPIYB",29,0) ; "RTN","RMPRPIYB",30,0) ; exit "RTN","RMPRPIYB",31,0) LOCNMX Q RMPRERR "RTN","RMPRPIYB",32,0) ; "RTN","RMPRPIYB",33,0) ; Single ? Help "RTN","RMPRPIYB",34,0) QM D QM1 ;ask if want to list locns. "RTN","RMPRPIYB",35,0) I RMPREXC'="" G QMX "RTN","RMPRPIYB",36,0) I RMPRYN="N" G QMX "RTN","RMPRPIYB",37,0) D QM2 ;list locns. "RTN","RMPRPIYB",38,0) I $G(RMPR5("IEN"))'="" D QM1H "RTN","RMPRPIYB",39,0) QMX Q "RTN","RMPRPIYB",40,0) ; "RTN","RMPRPIYB",41,0) ; QM1 - ask if want to list locns "RTN","RMPRPIYB",42,0) ; "RTN","RMPRPIYB",43,0) ; require RMPRSTN - Station number "RTN","RMPRPIYB",44,0) ; "RTN","RMPRPIYB",45,0) ; returns RMPREXC - exit condition "RTN","RMPRPIYB",46,0) ; RMPRYN - Y - list, N - don't bother "RTN","RMPRPIYB",47,0) ; "RTN","RMPRPIYB",48,0) QM1 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT "RTN","RMPRPIYB",49,0) S DIR("A",1)=" Answer with PROS ITEM LOCATION" "RTN","RMPRPIYB",50,0) S DIR("A")=" Do you want the entire PROS ITEM LOCATION List" "RTN","RMPRPIYB",51,0) S DIR("?")="^D QM1H^RMPRPIYB" "RTN","RMPRPIYB",52,0) S DIR(0)="YO" "RTN","RMPRPIYB",53,0) D ^DIR "RTN","RMPRPIYB",54,0) I $D(DTOUT) S RMPREXC="T" G QM1X "RTN","RMPRPIYB",55,0) I $D(DIROUT) S RMPREXC="P" G QM1X "RTN","RMPRPIYB",56,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G QM1X "RTN","RMPRPIYB",57,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYB",58,0) S RMPREXC="" "RTN","RMPRPIYB",59,0) QM1X Q "RTN","RMPRPIYB",60,0) QM1H S %A="V",X="^" "RTN","RMPRPIYB",61,0) Q "RTN","RMPRPIYB",62,0) ; "RTN","RMPRPIYB",63,0) ; QM2 - List active Location names (only to called from DIR("?")) "RTN","RMPRPIYB",64,0) ; "RTN","RMPRPIYB",65,0) ; require RMPRSTN - Station number "RTN","RMPRPIYB",66,0) ; "RTN","RMPRPIYB",67,0) QM2 D LIKE(RMPRSTN,"",.RMPREXC,.RMPR5) "RTN","RMPRPIYB",68,0) I $G(RMPR5("IEN"))'="" D QM1H "RTN","RMPRPIYB",69,0) Q "RTN","RMPRPIYB",70,0) ; "RTN","RMPRPIYB",71,0) ; LIKE - List active Locn. names with matching chars. "RTN","RMPRPIYB",72,0) LIKE(RMPRSTN,RMPRTXT,RMPREXC,RMPR5) ; "RTN","RMPRPIYB",73,0) N RMPRMAX,RMPRLIN,RMPRGBL,DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRA "RTN","RMPRPIYB",74,0) N RMPRYN,RMPRI,RMPRJ,RMPRERR "RTN","RMPRPIYB",75,0) S RMPREXC="" "RTN","RMPRPIYB",76,0) S RMPRYN="" "RTN","RMPRPIYB",77,0) S RMPRMAX=15 "RTN","RMPRPIYB",78,0) S RMPRJ=RMPRTXT "RTN","RMPRPIYB",79,0) I RMPRJ="" G LIKEA0 "RTN","RMPRPIYB",80,0) I '$D(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRJ)) D "RTN","RMPRPIYB",81,0) . S RMPRJ=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRJ)) "RTN","RMPRPIYB",82,0) . Q "RTN","RMPRPIYB",83,0) I RMPRJ=""!($E(RMPRJ,1,$L(RMPRTXT))'=RMPRTXT) S RMPR5("IEN")="" G LIKEX "RTN","RMPRPIYB",84,0) S RMPRI=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRJ)) "RTN","RMPRPIYB",85,0) I RMPRI=""!($E(RMPRI,1,$L(RMPRTXT))'=RMPRTXT) D "RTN","RMPRPIYB",86,0) . S RMPR5("IEN")=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRJ,"")) "RTN","RMPRPIYB",87,0) . W:RMPRJ'=RMPRTXT $E(RMPRJ,1+$L(RMPRTXT),$L(RMPRJ)) "RTN","RMPRPIYB",88,0) . S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYB",89,0) . D OK^RMPRPIYB(.RMPRYN,) "RTN","RMPRPIYB",90,0) . Q "RTN","RMPRPIYB",91,0) I $G(RMPR5("IEN"))'="" S:RMPRYN'="Y" RMPR5("IEN")="",RMPREXC="^" G LIKEX "RTN","RMPRPIYB",92,0) LIKEA0 S RMPRGBL="^RMPR(661.5,"_"""ASSL"",""A"","_RMPRSTN_","""_RMPRTXT_""")" "RTN","RMPRPIYB",93,0) LIKEA1 K RMPRA S RMPRLIN=0 "RTN","RMPRPIYB",94,0) LIKEA S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYB",95,0) LIKEA2 I RMPRGBL="" G LIKEB "RTN","RMPRPIYB",96,0) I $QS(RMPRGBL,1)'=661.5 G LIKEB "RTN","RMPRPIYB",97,0) I $QS(RMPRGBL,2)'="ASSL" G LIKEB "RTN","RMPRPIYB",98,0) I $QS(RMPRGBL,3)'="A" G LIKEB "RTN","RMPRPIYB",99,0) I $QS(RMPRGBL,4)'=RMPRSTN G LIKEB "RTN","RMPRPIYB",100,0) I $E($QS(RMPRGBL,5),1,$L(RMPRTXT))'=RMPRTXT G LIKEB "RTN","RMPRPIYB",101,0) I RMPRLIN,'(RMPRLIN#RMPRMAX) D G LIKEB "RTN","RMPRPIYB",102,0) . S DIR("A",1)="Press to see more, '^' to exit this list, OR" "RTN","RMPRPIYB",103,0) . Q "RTN","RMPRPIYB",104,0) LIKEA3 S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYB",105,0) W !,?4,$J(RMPRLIN,2),?9,$QS(RMPRGBL,5) "RTN","RMPRPIYB",106,0) S RMPRA(RMPRLIN)=$QS(RMPRGBL,6) "RTN","RMPRPIYB",107,0) G LIKEA "RTN","RMPRPIYB",108,0) LIKEB I RMPRLIN=0 G LIKEX "RTN","RMPRPIYB",109,0) LIKEC S DIR(0)="NAO^1:"_RMPRLIN_":0" "RTN","RMPRPIYB",110,0) S DIR("A")="CHOOSE 1-"_RMPRLIN_": " "RTN","RMPRPIYB",111,0) D ^DIR "RTN","RMPRPIYB",112,0) I $D(DTOUT) S RMPREXC="T" G LIKEX "RTN","RMPRPIYB",113,0) I $D(DIROUT) S RMPREXC="P" G LIKEX "RTN","RMPRPIYB",114,0) I X="",$D(DIR("A",1)) K DIR("A",1) G LIKEA3 "RTN","RMPRPIYB",115,0) I X="" S RMPREXC="^" G LIKEX "RTN","RMPRPIYB",116,0) I X["^"!$D(DUOUT) S RMPREXC="^" G LIKEX "RTN","RMPRPIYB",117,0) K RMPR5 "RTN","RMPRPIYB",118,0) S RMPR5("IEN")=RMPRA(X) "RTN","RMPRPIYB",119,0) S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYB",120,0) W " "_RMPR5("NAME") "RTN","RMPRPIYB",121,0) S RMPREXC="" "RTN","RMPRPIYB",122,0) LIKEX Q "RTN","RMPRPIYB",123,0) ; "RTN","RMPRPIYB",124,0) ;***** OK - prompt for OK "RTN","RMPRPIYB",125,0) ; "RTN","RMPRPIYB",126,0) ; Outputs: "RTN","RMPRPIYB",127,0) ; RMPRYN - Y - yes N - No "RTN","RMPRPIYB",128,0) ; RMPREXC - Exit condition "RTN","RMPRPIYB",129,0) ; "RTN","RMPRPIYB",130,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYB",131,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYB",132,0) S RMPREXC="",RMPRYN="N" "RTN","RMPRPIYB",133,0) S DIR("A")=" ...OK" "RTN","RMPRPIYB",134,0) S DIR("B")="Yes" "RTN","RMPRPIYB",135,0) S DIR(0)="Y" "RTN","RMPRPIYB",136,0) D ^DIR "RTN","RMPRPIYB",137,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYB",138,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYB",139,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G OKX "RTN","RMPRPIYB",140,0) S:Y RMPRYN="Y" "RTN","RMPRPIYB",141,0) OKX Q "RTN","RMPRPIYB",142,0) ; "RTN","RMPRPIYB",143,0) ; Function - returns location ien if 1 active location, else 0 "RTN","RMPRPIYB",144,0) LOC1(RMPRSTN) ; "RTN","RMPRPIYB",145,0) N RMPRL,RMPR1LOC "RTN","RMPRPIYB",146,0) S RMPR1LOC=0 "RTN","RMPRPIYB",147,0) S RMPRL=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,"")) "RTN","RMPRPIYB",148,0) I RMPRL'="" D "RTN","RMPRPIYB",149,0) . S RMPR1LOC=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRL,"")) "RTN","RMPRPIYB",150,0) . S RMPRL=$O(^RMPR(661.5,"ASSL","A",RMPRSTN,RMPRL)) "RTN","RMPRPIYB",151,0) . Q "RTN","RMPRPIYB",152,0) S:RMPRL'="" RMPR1LOC=0 "RTN","RMPRPIYB",153,0) Q RMPR1LOC "RTN","RMPRPIYC") 0^47^B26624824 "RTN","RMPRPIYC",1,0) RMPRPIYC ;HINCIO/ODJ - PIP HCPCS Prompt utilities ;3/8/01 "RTN","RMPRPIYC",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYC",3,0) Q "RTN","RMPRPIYC",4,0) ; "RTN","RMPRPIYC",5,0) ;***** HCPCS - Prompt for HCPCS called by reconciliation option "RTN","RMPRPIYC",6,0) ; (RMPRPIYA) "RTN","RMPRPIYC",7,0) HCPCS(RMPR5,RMPR1,RMPR11,RMPREXC) ; "RTN","RMPRPIYC",8,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DIC,DA,RMPRSTN,RMPRLCN,RMPR1N "RTN","RMPRPIYC",9,0) N RMPRYN "RTN","RMPRPIYC",10,0) S DIR("A")="Select HCPCS to RECONCILE: " "RTN","RMPRPIYC",11,0) S RMPRERR=0 "RTN","RMPRPIYC",12,0) S RMPREXC="" "RTN","RMPRPIYC",13,0) S RMPR1("HCPCS")=$G(RMPR1("HCPCS")) "RTN","RMPRPIYC",14,0) S RMPRSTN=RMPR5("STATION") "RTN","RMPRPIYC",15,0) S RMPRLCN=RMPR5("IEN") "RTN","RMPRPIYC",16,0) S DIR(0)="FOA" "RTN","RMPRPIYC",17,0) S DIR("?")="^D QM^RMPRPIYC" "RTN","RMPRPIYC",18,0) S DIR("??")="^D QM2^RMPRPIYC" "RTN","RMPRPIYC",19,0) HCPCS1 K RMPR1N D ^DIR "RTN","RMPRPIYC",20,0) I $D(DTOUT) S RMPREXC="T" G HCPCSX "RTN","RMPRPIYC",21,0) I $D(DIROUT) S RMPREXC="P" G HCPCSX "RTN","RMPRPIYC",22,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX "RTN","RMPRPIYC",23,0) D LIKE^RMPRPIYC(RMPRSTN,X,.RMPREXC,.RMPR1N,.RMPR11) "RTN","RMPRPIYC",24,0) I RMPREXC'="" G HCPCS1 "RTN","RMPRPIYC",25,0) I $G(RMPR1N("IEN"))'="" G HCPCSU "RTN","RMPRPIYC",26,0) G HCPCS1 "RTN","RMPRPIYC",27,0) HCPCSU K RMPR1 M RMPR1=RMPR1N "RTN","RMPRPIYC",28,0) HCPCSX Q RMPRERR "RTN","RMPRPIYC",29,0) ; "RTN","RMPRPIYC",30,0) ;***** QM - Single ? Help "RTN","RMPRPIYC",31,0) ; RMPRSTN required (see below QM2) "RTN","RMPRPIYC",32,0) ; "RTN","RMPRPIYC",33,0) QM D QM1 ; ask if want to list HCPCS "RTN","RMPRPIYC",34,0) I RMPREXC'="" G QMX "RTN","RMPRPIYC",35,0) I RMPRYN="N" G QMX "RTN","RMPRPIYC",36,0) D QM2 ;list HCPCS "RTN","RMPRPIYC",37,0) QMX Q "RTN","RMPRPIYC",38,0) QM1 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT "RTN","RMPRPIYC",39,0) ;S DIR("A",1)=" Answer with PSAS HCPCS, or SHORT NAME, or CPT, or SYNONYM, or" "RTN","RMPRPIYC",40,0) ;S DIR("A",2)=" DESCRIPTION" "RTN","RMPRPIYC",41,0) S DIR("A",1)="This response must be a number." "RTN","RMPRPIYC",42,0) S DIR("A")="Do you want the entire list of PSAS HCPCS in inventory " "RTN","RMPRPIYC",43,0) S DIR("?")="^D QM1H^RMPRPIYC" "RTN","RMPRPIYC",44,0) S DIR(0)="YO" "RTN","RMPRPIYC",45,0) D ^DIR "RTN","RMPRPIYC",46,0) I $D(DTOUT) S RMPREXC="T" G QM1X "RTN","RMPRPIYC",47,0) I $D(DIROUT) S RMPREXC="P" G QM1X "RTN","RMPRPIYC",48,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G QM1X "RTN","RMPRPIYC",49,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYC",50,0) S RMPREXC="" "RTN","RMPRPIYC",51,0) QM1X Q "RTN","RMPRPIYC",52,0) QM1H S %A="V",X="^" "RTN","RMPRPIYC",53,0) Q "RTN","RMPRPIYC",54,0) ; "RTN","RMPRPIYC",55,0) ;***** QM2 - List HCPCS associated with a Location "RTN","RMPRPIYC",56,0) ; called from a ?? help or Yes to the "RTN","RMPRPIYC",57,0) ; question in the ? help. "RTN","RMPRPIYC",58,0) ; "RTN","RMPRPIYC",59,0) ; requires RMPRSTN - Station ien "RTN","RMPRPIYC",60,0) ; "RTN","RMPRPIYC",61,0) QM2 D LIKE(RMPRSTN,"",.RMPREXC,.RMPR1N,.RMPR11) "RTN","RMPRPIYC",62,0) I $G(RMPR1N("IEN"))'="" D QM1H "RTN","RMPRPIYC",63,0) QM2X Q "RTN","RMPRPIYC",64,0) ; "RTN","RMPRPIYC",65,0) ; ***** LIKE "RTN","RMPRPIYC",66,0) ; Handle the various inputs from a HCPCS prompt where HCPCS is "RTN","RMPRPIYC",67,0) ; being selected from PIP as opposed to the general "RTN","RMPRPIYC",68,0) ; HCPCS file 661.1 "RTN","RMPRPIYC",69,0) ; This version uses the 661.11 file so any HCPCS that has been "RTN","RMPRPIYC",70,0) ; used in inventory can be selected. "RTN","RMPRPIYC",71,0) ; "RTN","RMPRPIYC",72,0) ; Inputs: "RTN","RMPRPIYC",73,0) ; RMPRSTN - Station ien "RTN","RMPRPIYC",74,0) ; RMPRTXT - Text entered at HCPCS prompt (cannot be null) "RTN","RMPRPIYC",75,0) ; "RTN","RMPRPIYC",76,0) ; Outputs: "RTN","RMPRPIYC",77,0) ; RMPREXC - exit condition "RTN","RMPRPIYC",78,0) ; RMPR1 - array of HCPCS data from 661.1 file "RTN","RMPRPIYC",79,0) ; RMPR1("IEN") - ien of HCPCS in 661.1 (null if not found) "RTN","RMPRPIYC",80,0) ; RMPR1("HCPCS") - HCPCS code "RTN","RMPRPIYC",81,0) ; RMPR1("SHORT DESC") - HCPCS short description "RTN","RMPRPIYC",82,0) ; RMPR11 - array of Inventory Item data from 661.11 file "RTN","RMPRPIYC",83,0) ; "RTN","RMPRPIYC",84,0) LIKE(RMPRSTN,RMPRTXT,RMPREXC,RMPR1,RMPR11) ; "RTN","RMPRPIYC",85,0) N RMPRMAX,RMPRLIN,DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRA,RMPRH "RTN","RMPRPIYC",86,0) N RMPRERR,RMPRHA,RMPR1N,RMPRH2,RMPRHTXT,RMPRITXT "RTN","RMPRPIYC",87,0) S RMPREXC="" "RTN","RMPRPIYC",88,0) S (RMPR1("IEN"),RMPR11("IEN"))="" "RTN","RMPRPIYC",89,0) S RMPRMAX=5 "RTN","RMPRPIYC",90,0) S RMPRLIN=0 "RTN","RMPRPIYC",91,0) S RMPRHTXT=$P(RMPRTXT,"-",1) "RTN","RMPRPIYC",92,0) S RMPRITXT="" "RTN","RMPRPIYC",93,0) I RMPRHTXT="" S RMPRH="" G LIKEA1 "RTN","RMPRPIYC",94,0) ; "RTN","RMPRPIYC",95,0) ; Check for exact match and skip selection if it is "RTN","RMPRPIYC",96,0) I $D(^RMPR(661.11,"ASHI",RMPRSTN,RMPRHTXT)) D G LIKEG "RTN","RMPRPIYC",97,0) . S RMPRITXT=$P(RMPRTXT,"-",2) "RTN","RMPRPIYC",98,0) . Q "RTN","RMPRPIYC",99,0) ; "RTN","RMPRPIYC",100,0) ; Check for unique partial match and skip selection if it is "RTN","RMPRPIYC",101,0) S RMPRH=$O(^RMPR(661.11,"ASHI",RMPRSTN,RMPRTXT)) "RTN","RMPRPIYC",102,0) I $E(RMPRH,1,$L(RMPRTXT))'=RMPRTXT G LIKEC "RTN","RMPRPIYC",103,0) S RMPRH2=$O(^RMPR(661.11,"ASHI",RMPRSTN,RMPRH)) "RTN","RMPRPIYC",104,0) I $E(RMPRH2,1,$L(RMPRTXT))'=RMPRTXT D G LIKEG "RTN","RMPRPIYC",105,0) . W $E(RMPRH,1+$L(RMPRTXT),$L(RMPRH)) "RTN","RMPRPIYC",106,0) . S RMPRHTXT=RMPRH "RTN","RMPRPIYC",107,0) . Q "RTN","RMPRPIYC",108,0) G LIKEA3 "RTN","RMPRPIYC",109,0) ; "RTN","RMPRPIYC",110,0) ; List partial matches "RTN","RMPRPIYC",111,0) LIKEA1 S RMPRH=$O(^RMPR(661.11,"ASHI",RMPRSTN,RMPRH)) "RTN","RMPRPIYC",112,0) I RMPRH="" G:'RMPRLIN LIKEX G LIKEB "RTN","RMPRPIYC",113,0) I $E(RMPRH,1,$L(RMPRTXT))'=RMPRTXT K DIR("A",1) G LIKEB "RTN","RMPRPIYC",114,0) LIKEA2 I RMPRLIN,'(RMPRLIN#RMPRMAX) D G LIKEB "RTN","RMPRPIYC",115,0) . S DIR("A",1)="Press to see more, '^' to exit this list, or" "RTN","RMPRPIYC",116,0) . Q "RTN","RMPRPIYC",117,0) LIKEA3 K RMPRHA S RMPRHA("HCPCS")=RMPRH "RTN","RMPRPIYC",118,0) S RMPRERR=$$HPACT^RMPRPIX1(.RMPRHA) "RTN","RMPRPIYC",119,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYC",120,0) W !?4,$J(RMPRLIN,2),?9,RMPRH,?19,RMPRHA("SHORT DESC") "RTN","RMPRPIYC",121,0) S RMPRA(RMPRLIN)=RMPRH "RTN","RMPRPIYC",122,0) G LIKEA1 "RTN","RMPRPIYC",123,0) LIKEB S DIR(0)="NAO" "RTN","RMPRPIYC",124,0) S DIR("A")="Choose 1 - "_RMPRLIN_" : " "RTN","RMPRPIYC",125,0) ;S DIR("?")="^D LIKEH^RMPRPIYC" "RTN","RMPRPIYC",126,0) D ^DIR "RTN","RMPRPIYC",127,0) I $D(DTOUT) S RMPREXC="T" G LIKEX "RTN","RMPRPIYC",128,0) I $D(DIROUT) S RMPREXC="P" G LIKEX "RTN","RMPRPIYC",129,0) I X="",$D(DIR("A",1)) S RMPREXC="" K DIR("A",1) G LIKEA3 "RTN","RMPRPIYC",130,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G LIKEX "RTN","RMPRPIYC",131,0) I $G(X),'$D(RMPRA(X)) W !!,"Please enter a number within the range." G LIKEB "RTN","RMPRPIYC",132,0) I '$D(RMPRA(X)) W !!,"This response must be a number." G LIKEB "RTN","RMPRPIYC",133,0) S RMPRHTXT=RMPRA(X) "RTN","RMPRPIYC",134,0) ; "RTN","RMPRPIYC",135,0) ; read in HCPCS and possibly Item as well "RTN","RMPRPIYC",136,0) LIKEG K RMPR1 "RTN","RMPRPIYC",137,0) S RMPR1("HCPCS")=RMPRHTXT "RTN","RMPRPIYC",138,0) S RMPRERR=$$HPACT^RMPRPIX1(.RMPR1) "RTN","RMPRPIYC",139,0) I RMPRITXT'="",$D(^RMPR(661.11,"ASHI",RMPRSTN,RMPRHTXT,RMPRITXT)) D "RTN","RMPRPIYC",140,0) . K RMPR11 "RTN","RMPRPIYC",141,0) . S RMPR11("STATION")=RMPRSTN "RTN","RMPRPIYC",142,0) . S RMPR11("HCPCS")=RMPRHTXT "RTN","RMPRPIYC",143,0) . S RMPR11("ITEM")=RMPRITXT "RTN","RMPRPIYC",144,0) . S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYC",145,0) . Q "RTN","RMPRPIYC",146,0) G LIKEX "RTN","RMPRPIYC",147,0) ; "RTN","RMPRPIYC",148,0) ; If can't find HCPCS in PIP files use old DIC lookup "RTN","RMPRPIYC",149,0) LIKEC D HCDIC(RMPRSTN,RMPRTXT,.RMPR1N) "RTN","RMPRPIYC",150,0) I $G(RMPR1N("IEN"))'="" K RMPR1 M RMPR1=RMPR1N "RTN","RMPRPIYC",151,0) ; "RTN","RMPRPIYC",152,0) ;exit "RTN","RMPRPIYC",153,0) LIKEX Q "RTN","RMPRPIYC",154,0) LIKEH D QM,QM1H "RTN","RMPRPIYC",155,0) Q "RTN","RMPRPIYC",156,0) ; "RTN","RMPRPIYC",157,0) ; Call DIC to match on text if not a HCPCS code "RTN","RMPRPIYC",158,0) HCDIC(RMPRSTN,RMPRTXT,RMPR1) ; "RTN","RMPRPIYC",159,0) N X,Y,DA,DIC "RTN","RMPRPIYC",160,0) S DIC="^RMPR(661.1," "RTN","RMPRPIYC",161,0) S DIC(0)="EMQ" "RTN","RMPRPIYC",162,0) S DIC("S")="I $$HCMAT^RMPRPIYC()" "RTN","RMPRPIYC",163,0) S X=RMPRTXT "RTN","RMPRPIYC",164,0) D ^DIC "RTN","RMPRPIYC",165,0) I +Y'>0!($D(DTOUT))!($D(DUOUT)) G HCDICX "RTN","RMPRPIYC",166,0) I $P(Y,"^",2)'="",$D(^RMPR(661.4,"XSHIL",RMPRSTN,$P(Y,"^",2))) D "RTN","RMPRPIYC",167,0) . S RMPR1("HCPCS")=$P(Y,"^",2) "RTN","RMPRPIYC",168,0) . S RMPRERR=$$HPACT^RMPRPIX1(.RMPR1) "RTN","RMPRPIYC",169,0) . Q "RTN","RMPRPIYC",170,0) HCDICX Q "RTN","RMPRPIYC",171,0) ; "RTN","RMPRPIYC",172,0) ;***** HCMAT - extrinsic called from DIC call to screen out "RTN","RMPRPIYC",173,0) ; HCPCS not associated with PIP "RTN","RMPRPIYC",174,0) ; RMPRSTN (station ien) must be set "RTN","RMPRPIYC",175,0) HCMAT() ; "RTN","RMPRPIYC",176,0) N RMPRMAT "RTN","RMPRPIYC",177,0) S RMPRMAT=0 "RTN","RMPRPIYC",178,0) I $D(^RMPR(661.4,"XSHIL",RMPRSTN,$P(^RMPR(661.1,Y,0),"^",1))) S RMPRMAT=1 "RTN","RMPRPIYC",179,0) HCMATX Q RMPRMAT "RTN","RMPRPIYD") 0^48^B43917687 "RTN","RMPRPIYD",1,0) RMPRPIYD ;HINES OIFO/ODJ - PIP RECONCILE - Pick HCPCS Item;3/8/01 "RTN","RMPRPIYD",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYD",3,0) Q "RTN","RMPRPIYD",4,0) ; "RTN","RMPRPIYD",5,0) ; Get an Item - restrict choice to Location and HCPC "RTN","RMPRPIYD",6,0) ITEM(RMPRSTN,RMPRLCN,RMPR11,RMPREXC) ; "RTN","RMPRPIYD",7,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRHCPC "RTN","RMPRPIYD",8,0) S RMPRERR=0 "RTN","RMPRPIYD",9,0) S RMPREXC="" "RTN","RMPRPIYD",10,0) I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX "RTN","RMPRPIYD",11,0) I $G(RMPR11("HCPCS"))="" S RMPRERR=2 G ITEMX "RTN","RMPRPIYD",12,0) S RMPR11("STATION")=RMPRSTN "RTN","RMPRPIYD",13,0) S RMPR11("STATION IEN")=RMPRSTN "RTN","RMPRPIYD",14,0) S RMPRHCPC=RMPR11("HCPCS") "RTN","RMPRPIYD",15,0) S DIR(0)="FOA^1:50" "RTN","RMPRPIYD",16,0) S DIR("A")="Enter Item to RECONCILE: " "RTN","RMPRPIYD",17,0) S DIR("?")="^D QM^RMPRPIYD" "RTN","RMPRPIYD",18,0) S DIR("??")="^D QQM^RMPRPIYD" "RTN","RMPRPIYD",19,0) ITEMA1 D ^DIR "RTN","RMPRPIYD",20,0) I $D(DTOUT) S RMPREXC="T" G ITEMX "RTN","RMPRPIYD",21,0) I $D(DIROUT) S RMPREXC="P" G ITEMX "RTN","RMPRPIYD",22,0) I X=""!(X["^") S RMPREXC="^" G ITEMX "RTN","RMPRPIYD",23,0) S RMPR11("IEN")="" "RTN","RMPRPIYD",24,0) D LIKE(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11) "RTN","RMPRPIYD",25,0) I RMPREXC="T" G ITEMX "RTN","RMPRPIYD",26,0) I RMPREXC="P" G ITEMX "RTN","RMPRPIYD",27,0) I RMPREXC="^" G ITEMA1 "RTN","RMPRPIYD",28,0) I RMPR11("IEN")="",$L(X)<3 G ITEMA1 "RTN","RMPRPIYD",29,0) I RMPR11("IEN")="" S RMPR11("DESCRIPTION")=X G ITEMX "RTN","RMPRPIYD",30,0) G ITEMX "RTN","RMPRPIYD",31,0) ITEMX Q RMPRERR "RTN","RMPRPIYD",32,0) ; "RTN","RMPRPIYD",33,0) ; CHKN - Check an Item Number "RTN","RMPRPIYD",34,0) ; "RTN","RMPRPIYD",35,0) ; Inputs: "RTN","RMPRPIYD",36,0) ; RMPR11 - array consisting of the following subscripts... "RTN","RMPRPIYD",37,0) ; RMPR11("STATION") - Station ien (eg 499) "RTN","RMPRPIYD",38,0) ; RMPR11("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIYD",39,0) ; RMPR11("ITEM") - HCPCS Item number (eg 1) "RTN","RMPRPIYD",40,0) ; "RTN","RMPRPIYD",41,0) ; Outputs: "RTN","RMPRPIYD",42,0) ; RMPR11 - additional elements from 661.11 record if Item exists... "RTN","RMPRPIYD",43,0) ; RMPR11("DESCRIPTION") - Item Description "RTN","RMPRPIYD",44,0) ; RMPR11("HCPCS-ITEM") - Combined HCPCS Item code (eg E0111-1) "RTN","RMPRPIYD",45,0) ; RMPR11("IEN") - ien of record "RTN","RMPRPIYD",46,0) ; RMPR11("SOURCE") - Source (external format) "RTN","RMPRPIYD",47,0) ; RMPR11("STATION") - Station Name (external format) "RTN","RMPRPIYD",48,0) ; RMPR11("UNIT") - Unit of Measure (external format) "RTN","RMPRPIYD",49,0) ; RMPR11("STATION IEN") - ien of input Station "RTN","RMPRPIYD",50,0) ; "RTN","RMPRPIYD",51,0) ; RMPRERR - exit condition (returned by function) "RTN","RMPRPIYD",52,0) ; 0 - no erros "RTN","RMPRPIYD",53,0) ; 1 - null station ien "RTN","RMPRPIYD",54,0) ; 2 - null HCPCS code "RTN","RMPRPIYD",55,0) ; 3 - HCPCS Item not valid number "RTN","RMPRPIYD",56,0) ; 4 - Item does not exist "RTN","RMPRPIYD",57,0) ; 99 - Problem with 661.11 file "RTN","RMPRPIYD",58,0) ; "RTN","RMPRPIYD",59,0) CHKN(RMPR11) ; "RTN","RMPRPIYD",60,0) N RMPRERR "RTN","RMPRPIYD",61,0) S RMPRERR=0 "RTN","RMPRPIYD",62,0) I $G(RMPR11("STATION"))="" S RMPRERR=1 G CHKNX "RTN","RMPRPIYD",63,0) S RMPR11("STATION IEN")=RMPR11("STATION") "RTN","RMPRPIYD",64,0) I $G(RMPR11("HCPCS"))="" S RMPRERR=2 G CHKNX "RTN","RMPRPIYD",65,0) I $G(RMPR11("ITEM"))'?1.N S RMPRERR=3 G CHKNX "RTN","RMPRPIYD",66,0) I '$D(^RMPR(661.11,"ASHI",RMPR11("STATION"),RMPR11("HCPCS"),RMPR11("ITEM"))) S RMPRERR=4 G CHKNX "RTN","RMPRPIYD",67,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYD",68,0) I RMPRERR S RMPRERR=99 "RTN","RMPRPIYD",69,0) CHKNX Q RMPRERR "RTN","RMPRPIYD",70,0) ; "RTN","RMPRPIYD",71,0) ; CHKD - Check an Item Description "RTN","RMPRPIYD",72,0) ; "RTN","RMPRPIYD",73,0) ; Inputs: "RTN","RMPRPIYD",74,0) ; RMPR11 - array consisting of the following subscripts... "RTN","RMPRPIYD",75,0) ; RMPR11("STATION") - Station ien (eg 499) "RTN","RMPRPIYD",76,0) ; RMPR11("HCPCS") - HCPCS code (eg E0111) "RTN","RMPRPIYD",77,0) ; RMPR11("DESCRIPTION") - HCPCS Item Description "RTN","RMPRPIYD",78,0) ; "RTN","RMPRPIYD",79,0) ; Outputs: "RTN","RMPRPIYD",80,0) ; RMPR11 - additional elements from 661.11 record if Item exists... "RTN","RMPRPIYD",81,0) ; RMPR11("ITEM") - HCPCS Item number "RTN","RMPRPIYD",82,0) ; RMPR11("HCPCS-ITEM") - Combined HCPCS Item code (eg E0111-1) "RTN","RMPRPIYD",83,0) ; RMPR11("IEN") - ien of record "RTN","RMPRPIYD",84,0) ; RMPR11("SOURCE") - Source (external format) "RTN","RMPRPIYD",85,0) ; RMPR11("STATION") - Station Name (external format) "RTN","RMPRPIYD",86,0) ; RMPR11("UNIT") - Unit of Measure (external format) "RTN","RMPRPIYD",87,0) ; RMPR11("STATION IEN") - ien of input Station "RTN","RMPRPIYD",88,0) ; "RTN","RMPRPIYD",89,0) ; RMPRERR - exit condition (returned by function) "RTN","RMPRPIYD",90,0) ; 0 - no erros "RTN","RMPRPIYD",91,0) ; 1 - null station ien "RTN","RMPRPIYD",92,0) ; 2 - null HCPCS code "RTN","RMPRPIYD",93,0) ; 3 - null HCPCS Item Desc. "RTN","RMPRPIYD",94,0) ; 4 - Item does not exist "RTN","RMPRPIYD",95,0) ; 5 - Item does not exist, but there are items matching "RTN","RMPRPIYD",96,0) ; the entered description text "RTN","RMPRPIYD",97,0) ; 99 - Problem with 661.11 file "RTN","RMPRPIYD",98,0) ; "RTN","RMPRPIYD",99,0) CHKD(RMPR11) ; "RTN","RMPRPIYD",100,0) N RMPRERR,RMPRD "RTN","RMPRPIYD",101,0) S RMPRERR=0 "RTN","RMPRPIYD",102,0) I $G(RMPR11("STATION"))="" S RMPRERR=1 G CHKDX "RTN","RMPRPIYD",103,0) S RMPR11("STATION IEN")=RMPR11("STATION") "RTN","RMPRPIYD",104,0) I $G(RMPR11("HCPCS"))="" S RMPRERR=2 G CHKDX "RTN","RMPRPIYD",105,0) I $G(RMPR11("DESCRIPTION"))="" S RMPRERR=3 G CHKDX "RTN","RMPRPIYD",106,0) I '$D(^RMPR(661.11,"XSD",RMPR11("STATION"),RMPR11("DESCRIPTION"),RMPR11("HCPCS"))) D G CHKDX "RTN","RMPRPIYD",107,0) . S RMPRERR=4 "RTN","RMPRPIYD",108,0) . S RMPRD=RMPR11("DESCRIPTION") "RTN","RMPRPIYD",109,0) . S RMPRD=$O(^RMPR(661.11,"XSD",RMPR11("STATION"),RMPRD)) "RTN","RMPRPIYD",110,0) . I $E(RMPRD,1,$L(RMPR11("DESCRIPTION")))=RMPR11("DESCRIPTION") S RMPRERR=5 "RTN","RMPRPIYD",111,0) . Q "RTN","RMPRPIYD",112,0) S RMPR11("IEN")=$O(^RMPR(661.11,"XSD",RMPR11("STATION"),RMPR11("DESCRIPTION"),RMPR11("HCPCS"),"")) "RTN","RMPRPIYD",113,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYD",114,0) I RMPRERR S RMPRERR=99 "RTN","RMPRPIYD",115,0) CHKDX Q RMPRERR "RTN","RMPRPIYD",116,0) ; "RTN","RMPRPIYD",117,0) ; Prompt if adding a new HCPCS Item "RTN","RMPRPIYD",118,0) OKADD(RMPR11,RMPRYN,RMPREXC) ; "RTN","RMPRPIYD",119,0) N DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYD",120,0) S RMPREXC="" "RTN","RMPRPIYD",121,0) S DIR(0)="Y" "RTN","RMPRPIYD",122,0) S DIR("A")="Are you adding '"_RMPR11("DESCRIPTION")_"' as a new ITEM for this HCPCS" "RTN","RMPRPIYD",123,0) D ^DIR "RTN","RMPRPIYD",124,0) I $D(DTOUT) S RMPREXC="T" G ADDNMX "RTN","RMPRPIYD",125,0) I $D(DIROUT) S RMPREXC="P" G ADDNMX "RTN","RMPRPIYD",126,0) I X=""!(X["^") S RMPREXC="^" G ADDNMX "RTN","RMPRPIYD",127,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYD",128,0) S RMPREXC="" "RTN","RMPRPIYD",129,0) ADDNMX Q "RTN","RMPRPIYD",130,0) ; "RTN","RMPRPIYD",131,0) ; Single ? Help "RTN","RMPRPIYD",132,0) QM W ?4,"Answer with ITEM NUMBER or DESCRIPTION:" "RTN","RMPRPIYD",133,0) D QM2 "RTN","RMPRPIYD",134,0) Q "RTN","RMPRPIYD",135,0) QQM D QM2 "RTN","RMPRPIYD",136,0) W !!?8,"You may enter a new ITEM, if you wish" "RTN","RMPRPIYD",137,0) W !?8,"This is an Item or Appliance under PSAS HCPCS kept by local site in" "RTN","RMPRPIYD",138,0) W !?8,"Prosthetics Inventory module." "RTN","RMPRPIYD",139,0) Q "RTN","RMPRPIYD",140,0) QM2 N DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRMAX,RMPRI,RMPRLIN,RMPR,RMPRERR "RTN","RMPRPIYD",141,0) S RMPRMAX=19,RMPRLIN=0 "RTN","RMPRPIYD",142,0) S RMPREXC="" "RTN","RMPRPIYD",143,0) S DIR(0)="EA" "RTN","RMPRPIYD",144,0) S DIR("A")="'^' TO STOP: " "RTN","RMPRPIYD",145,0) S RMPRI="" "RTN","RMPRPIYD",146,0) QM2A S RMPRI=$O(^RMPR(661.4,"ASLHI",RMPRSTN,RMPRLCN,RMPRHCPC,RMPRI)) "RTN","RMPRPIYD",147,0) I RMPRI="" G QM2X "RTN","RMPRPIYD",148,0) K RMPR "RTN","RMPRPIYD",149,0) S RMPR("STATION")=RMPRSTN "RTN","RMPRPIYD",150,0) S RMPR("HCPCS")=RMPRHCPC "RTN","RMPRPIYD",151,0) S RMPR("ITEM")=RMPRI "RTN","RMPRPIYD",152,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR) "RTN","RMPRPIYD",153,0) W !?3,RMPRI,?16,RMPR("HCPCS-ITEM"),?28,RMPR("DESCRIPTION") "RTN","RMPRPIYD",154,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYD",155,0) I RMPRLIN'0,RMPR7("QUANTITY")>0 S RMPRCOST=RMPR7("VALUE")/RMPR7("QUANTITY") "RTN","RMPRPIYE",76,0) S $P(R1(0),U,16)=RMPRCOST "RTN","RMPRPIYE",77,0) S $P(R1(1),U,4)=RMDAHC "RTN","RMPRPIYE",78,0) S $P(R1(0),U,14)=RMPR11I("SOURCE") "RTN","RMPRPIYE",79,0) G VEN0 "RTN","RMPRPIYE",80,0) ; "RTN","RMPRPIYE",81,0) CPT ;ask for CPT Modifier "RTN","RMPRPIYE",82,0) K DIC,Y,RQUIT "RTN","RMPRPIYE",83,0) S RDA=RMDAHC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660 "RTN","RMPRPIYE",84,0) D:$D(RMCPT) CHK^RMPRED5 "RTN","RMPRPIYE",85,0) W:$G(REDIT) !,"OLD CPT MODIFIER: ",$P(R1(1),U,6) "RTN","RMPRPIYE",86,0) I RMHCOLD'=RMDAHC D CPT^RMPRCPTU(RDA) G:$D(DUOUT)!$D(DTOUT) CO S $P(R1(1),U,6)=$G(RMCPT) W:$G(REDIT) !,"NEW CPT MODIFIER: ",$G(RMCPT) "RTN","RMPRPIYE",87,0) I RMHCOLD'="",(RMHCOLD=RMDAHC),$G(REDIT) D "RTN","RMPRPIYE",88,0) .S DIR(0)="Y",DIR("A")="Would you like to Edit CPT MODIFIER Entry ",DIR("B")="N" D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","RMPRPIYE",89,0) .I $G(Y) D "RTN","RMPRPIYE",90,0) ..S RMCPOLD=RMCPT "RTN","RMPRPIYE",91,0) ..D CPT^RMPRCPTU(RDA) Q:$D(DUOUT)!$D(DUOUT) S $P(R1(1),U,6)=$G(RMCPT) "RTN","RMPRPIYE",92,0) ..W:RMCPOLD=RMCPT !!,"*** Based on the information given above, CPT Modifier string has not changed!!!",! "RTN","RMPRPIYE",93,0) ..W:RMCPOLD'=RMCPT !,"NEW CPT MODIFIER: ",$G(RMCPT) "RTN","RMPRPIYE",94,0) K DIR "RTN","RMPRPIYE",95,0) ; "RTN","RMPRPIYE",96,0) VEN0 ;process vendor "RTN","RMPRPIYE",97,0) K DIC,DIR "RTN","RMPRPIYE",98,0) S:$D(RMPR6("VENDOR")) DIC("B")=RMPR6("VENDOR") "RTN","RMPRPIYE",99,0) S:'$D(RMPR6("VENDOR")) DIC("B")=$P(R1(0),U,9) "RTN","RMPRPIYE",100,0) S DIC(0)="AEQM" "RTN","RMPRPIYE",101,0) ;S DIC("S")="I $D(RMPRVEN(+Y))" "RTN","RMPRPIYE",102,0) S DIC("A")="VENDOR:" "RTN","RMPRPIYE",103,0) S DIC="^PRC(440,",DIC(0)="AEQM" D ^DIC I $D(DUOUT)!$D(DTOUT) G CO "RTN","RMPRPIYE",104,0) G:+Y<0 VEN0 "RTN","RMPRPIYE",105,0) S $P(R1(0),U,9)=+Y,$P(R3("D"),U,9)=$P(Y,U,2) K DIR,DIC "RTN","RMPRPIYE",106,0) ; "RTN","RMPRPIYE",107,0) SOURCE ; "RTN","RMPRPIYE",108,0) K DIR S DIR(0)="660,12",DIR("B")=$P(R1(0),U,14),DIR("A")="SOURCE" "RTN","RMPRPIYE",109,0) D ^DIR G:$D(DIRUT)!$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT^RMPRPIYF "RTN","RMPRPIYE",110,0) S $P(R1(0),U,14)=Y,$P(R3("D"),U,14)=$S(Y="C":"Commercial",1:"VA") "RTN","RMPRPIYE",111,0) ; "RTN","RMPRPIYE",112,0) QTY K DIR S DIR("A")="QUANTITY" "RTN","RMPRPIYE",113,0) S DIR(0)="660,5",DIR("B")=$P(R1(0),U,7) "RTN","RMPRPIYE",114,0) D ^DIR G:$D(DIRUT)!$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT^RMPRPIYF "RTN","RMPRPIYE",115,0) I $D(RMUBA),((RMUBA+$P(R1(0),U,7))-Y<0) D LOWBA^RMPRPIYI G HCPCS^RMPRPIYE "RTN","RMPRPIYE",116,0) S $P(R1(0),U,7)=Y K DIR "RTN","RMPRPIYE",117,0) ; "RTN","RMPRPIYE",118,0) CP G ^RMPRPIYF "RTN","RMPRPIYE",119,0) ; "RTN","RMPRPIYE",120,0) SET ;set the original variables. "RTN","RMPRPIYE",121,0) S $P(R3("D"),U,14)=$S($P(R1(0),U,14)="V":"VA",$P(R1(0),U,14)="C":"COMMERCIAL",1:"") "RTN","RMPRPIYE",122,0) S $P(R3("D"),U,4)=$S($P(R1(0),U,4)="I":"INITIAL ISSUE",$P(R1(0),U,4)="X":"REPAIR",$P(R1(0),U,4)="R":"REPLACE",$P(R1(0),U,4)="S":"SPARE",1:"") "RTN","RMPRPIYE",123,0) S $P(R4("D"),U,3)=$S($P(R1("AM"),U,3)=1:"SC/OP",$P(R1("AM"),U,3)=2:"SC/IP",$P(R1("AM"),U,3)=3:"NSC/IP",$P(R1("AM"),U,3)=4:"NSC/OP") "RTN","RMPRPIYE",124,0) S:$P(R1("AM"),U,3)=4&($P(R1("AM"),U,4)) $P(R4("D"),U,4)=$S($P(R1("AM"),U,4)=1:"SPECIAL LEGISLATION",$P(R1("AM"),U,4)=2:"A&A",$P(R1("AM"),U,4)=3:"PHC",$P(R1("AM"),U,4)=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRPIYE",125,0) S RMHCOLD=$P($G(R1(1)),U,4),RMPRPF=$P(R1(0),U,13),RMQOLD=$P(R1(0),U,7) "RTN","RMPRPIYE",126,0) S RMSO=$P(R1(0),U,14) "RTN","RMPRPIYE",127,0) I $G(RMQOLD),$P($G(R1(0)),U,16) S RMPRCOST=$P(R1(0),U,16)/RMQOLD "RTN","RMPRPIYE",128,0) S $P(R3("D"),U,6)=$P(^RMPR(661,$P(R1(0),U,6),0),U,1),RITOLD=$P(R1(0),U,6),RMQOLD=$P(R1(0),U,7),Y=$P(R1(0),U,12) G:Y="" CO D DD^%DT S $P(R3("D"),U,12)=Y "RTN","RMPRPIYE",129,0) S Y=$P(R1(1),U,8) G:Y="" CO D DD^%DT S $P(R1("D"),U,8)=Y "RTN","RMPRPIYE",130,0) D ^RMPRPIYK G DEL "RTN","RMPRPIYE",131,0) Q "RTN","RMPRPIYE",132,0) ; "RTN","RMPRPIYE",133,0) SET60 ; "RTN","RMPRPIYE",134,0) ;RMPR60 -array of data fields for 660 file record. "RTN","RMPRPIYE",135,0) S RMPR60("ISSUE TYPE")=$P(R1(0),U,4) "RTN","RMPRPIYE",136,0) S RMPR60("IFCAP ITEM")=$P(R1(0),U,6) "RTN","RMPRPIYE",137,0) S RMPR60("QUANTITY")=$P(R1(0),U,7) "RTN","RMPRPIYE",138,0) S RMPR60("UNIT")=$P(R1(0),U,8) "RTN","RMPRPIYE",139,0) S RMPR60("VENDOR IEN")=$P(R1(0),U,9) "RTN","RMPRPIYE",140,0) S RMPR60("SERIAL NUM")=$P(R1(0),U,11) "RTN","RMPRPIYE",141,0) S RMPR60("DELIV DATE")=$P(R1(0),U,12) "RTN","RMPRPIYE",142,0) S RMPR60("DATE OF SERVICE")=$P(R1(1),U,8) "RTN","RMPRPIYE",143,0) S RMPR60("SOURCE")=$P(R1(0),U,14) "RTN","RMPRPIYE",144,0) S RMPR60("COST")=$P(R1(0),U,16) "RTN","RMPRPIYE",145,0) S RMPR60("REMARKS")=$P(R1(0),U,18) "RTN","RMPRPIYE",146,0) S RMPR60("LOT NUM")=$P(R1(0),U,24) "RTN","RMPRPIYE",147,0) S RMPR60("CPT IEN")=$P(R1(0),U,22) "RTN","RMPRPIYE",148,0) S RMPR60("USER")=$P(R1(0),U,27) "RTN","RMPRPIYE",149,0) S RMPR60("CPT MOD")=$P(R1(1),U,6) "RTN","RMPRPIYE",150,0) S RMPR60("HCPCS")=$P(R1(1),U,4) "RTN","RMPRPIYE",151,0) S RMPR60("PAT CAT")=$P(R1("AM"),U,3) "RTN","RMPRPIYE",152,0) S RMPR60("SPEC CAT")=$P(R1("AM"),U,4) "RTN","RMPRPIYE",153,0) S RMPR60("VENDOR")=$P(R1(0),U,9) "RTN","RMPRPIYE",154,0) S:$G(RMDAHC) RMPR60("HCPCS")=RMDAHC "RTN","RMPRPIYE",155,0) ;S:$D(RMPR11I("HCPCS")) RMPR60("HCPCS")=RMPR11I("HCPCS") "RTN","RMPRPIYE",156,0) S:$D(RMPR11I("ITEM")) RMPR60("ITEM")=RMPR11I("ITEM") "RTN","RMPRPIYE",157,0) S:$D(R1("DATE&TIME")) RMPR60("DATE&TIME")=R1("DATE&TIME") "RTN","RMPRPIYE",158,0) S RMPR60("VALUE")=RMPR60("COST") "RTN","RMPRPIYE",159,0) S:'$D(RMPR11I("STATION")) RMPR11I("STATION")=$G(RMPR("STA")) "RTN","RMPRPIYE",160,0) S:$P(R1("AM"),U,3)'=4 RMPR60("SPEC CAT")="@" "RTN","RMPRPIYE",161,0) Q "RTN","RMPRPIYF") 0^50^B75690546 "RTN","RMPRPIYF",1,0) RMPRPIYF ;PHX/RFM,RVD-EDIT ISSUE FROM STOCK ;8/2/02 07:27 "RTN","RMPRPIYF",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYF",3,0) ; RVD #61 - phase III of PIP enhancement. "RTN","RMPRPIYF",4,0) ; "RTN","RMPRPIYF",5,0) ;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","RMPRPIYF",6,0) COST ; "RTN","RMPRPIYF",7,0) S RMACNT=RMPRCOST*$P(R1(0),U,7),$P(R3("D"),U,16)=RMACNT,$P(R1(0),U,16)=RMACNT "RTN","RMPRPIYF",8,0) ; "RTN","RMPRPIYF",9,0) DATE S:$P(R1(1),U,8) DIR("B")=$P(R1("D"),U,8) S DIR("A")="DATE OF SERVICE",DIR(0)="660,39" D ^DIR K DIR "RTN","RMPRPIYF",10,0) G:X["^" CO^RMPRPIYE G:$D(DTOUT) EXIT I $P(R1(1),U,8)&(X="@") W !,"This field is mandatory!!!",! G DATE "RTN","RMPRPIYF",11,0) I X="" W !,"This field is mandatory!!!",! G DATE "RTN","RMPRPIYF",12,0) S $P(R1(1),U,8)=Y,Y=$P(R1(1),U,8) D DD^%DT S $P(R1("D"),U,8)=Y "RTN","RMPRPIYF",13,0) ; "RTN","RMPRPIYF",14,0) REQ S DIR(0)="660,9" S:$P(R1(0),U,11)'="" DIR("B")=$P(R1(0),U,11) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT "RTN","RMPRPIYF",15,0) I X["^" W !,"Jumping not allowed!" G REQ "RTN","RMPRPIYF",16,0) I $P(R1(0),U,11)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,11)="" G LOT "RTN","RMPRPIYF",17,0) S $P(R1(0),U,11)=X "RTN","RMPRPIYF",18,0) ; "RTN","RMPRPIYF",19,0) LOT K DIR S DIR(0)="660,21" S:$P(R1(0),U,24)'="" DIR("B")=$P(R1(0),U,24) D ^DIR G:$D(DUOUT) CO^RMPRPIYE "RTN","RMPRPIYF",20,0) I X["^" W !,"Jumping not allowed!" G LOT "RTN","RMPRPIYF",21,0) I $P(R1(0),U,24)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,24)="" G REMA "RTN","RMPRPIYF",22,0) S $P(R1(0),U,24)=X "RTN","RMPRPIYF",23,0) ; "RTN","RMPRPIYF",24,0) REMA K DIR S DIR(0)="660,16" S:$P(R1(0),U,18)'="" DIR("B")=$P(R1(0),U,18) D ^DIR G:$D(DUOUT) CO^RMPRPIYE G:$D(DTOUT) EXIT "RTN","RMPRPIYF",25,0) I X["^" W !,"Jumping not allowed!" G REMA "RTN","RMPRPIYF",26,0) I $P(R1(0),U,18)'=""&(X="@") W !?5,"Deleted..." H 1 S $P(R1(0),U,18)="" G CC "RTN","RMPRPIYF",27,0) S $P(R1(0),U,18)=X "RTN","RMPRPIYF",28,0) CC G CO^RMPRPIYE "RTN","RMPRPIYF",29,0) ; "RTN","RMPRPIYF",30,0) POST ;POSTS EDITED TRANSACTION TO 660 "RTN","RMPRPIYF",31,0) W !,"Posting...." "RTN","RMPRPIYF",32,0) K RMPR60,RMDTTIM,RMPR63 "RTN","RMPRPIYF",33,0) S RMPR60("IEN")=RMPRIEN,RMFLG=0 "RTN","RMPRPIYF",34,0) ;RMPR60 -array of data fields for 660 file record. "RTN","RMPRPIYF",35,0) D SET60^RMPRPIYE "RTN","RMPRPIYF",36,0) ;get 661.6 & 661.63 patient issue "RTN","RMPRPIYF",37,0) S (RMPR6("IEN"),RMIEN6)=$P(R1(1),U,5) "RTN","RMPRPIYF",38,0) I $G(RMIEN6),$D(^RMPR(661.6,RMIEN6,0)) D "RTN","RMPRPIYF",39,0) .S RMDAT6=$G(^RMPR(661.6,RMIEN6,0)) "RTN","RMPRPIYF",40,0) .S RMIEN63=$O(^RMPR(661.63,"B",RMIEN6,0)) "RTN","RMPRPIYF",41,0) .I $G(RMIEN63),$D(^RMPR(661.63,RMIEN63,0)) D "RTN","RMPRPIYF",42,0) ..S RMDAT63=$G(^RMPR(661.63,RMIEN63,0)),RMPR63("IEN")=RMIEN63 "RTN","RMPRPIYF",43,0) ..S (RMPRRET("DATE&TIME"),RMDTTIM)=$P(RMDAT63,U,6) "RTN","RMPRPIYF",44,0) ..S RMPRRET("QUANTITY")=$P(RMDAT63,U,12) "RTN","RMPRPIYF",45,0) ..S RMPRRET("HCPCS")=$P(RMDAT63,U,4) "RTN","RMPRPIYF",46,0) ..S RMPRRET("STATION")=$P(RMDAT63,U,7) "RTN","RMPRPIYF",47,0) ..S RMPRRET("ITEM")=$P(RMDAT63,U,5) "RTN","RMPRPIYF",48,0) ..S RMPRRET("VALUE")=$P(RMDAT63,U,10) "RTN","RMPRPIYF",49,0) ..S RMPRRET("UNIT")=$P(RMDAT63,U,11) "RTN","RMPRPIYF",50,0) ..S RMPRRET("VENDOR")=$P(RMDAT63,U,9) "RTN","RMPRPIYF",51,0) ..S RMPRRET("LOCATION")=$P(RMDAT63,U,8) "RTN","RMPRPIYF",52,0) ;only update 660 if no label scan and quantity the same. "RTN","RMPRPIYF",53,0) I '$D(RMPR7I),($P(R1BCK(0),U,7)=RMPR60("QUANTITY")) D UP660 G PCE "RTN","RMPRPIYF",54,0) ;set update flags: 1=new item/diff barcode 2=only quantity changed. "RTN","RMPRPIYF",55,0) I $G(RMDTTIM),$D(RMPR7I("DATE&TIME")),RMDTTIM'=RMPR7I("DATE&TIME") S RMFLG=1 "RTN","RMPRPIYF",56,0) I '$G(RMDTTIM),$D(RMPR7I("DATE&TIME")) S RMFLG=1 "RTN","RMPRPIYF",57,0) I $P(R1BCK(0),U,7)'=RMPR60("QUANTITY"),'$G(RMFLG) S RMFLG=2 "RTN","RMPRPIYF",58,0) ; "RTN","RMPRPIYF",59,0) API ;call API for 660, 661.7, 661.6, 661.63, 661.9 "RTN","RMPRPIYF",60,0) ; "RTN","RMPRPIYF",61,0) ;file #660, 661.6, 661.7, 661.63, 661.9 "RTN","RMPRPIYF",62,0) I RMFLG=1 D UPDATE "RTN","RMPRPIYF",63,0) I RMFLG=2 D QUAN "RTN","RMPRPIYF",64,0) D UP660 "RTN","RMPRPIYF",65,0) I $G(RMPRERR) W !!,"*** ERROR in 2319 UPDATE, Please notify your IRM..IEN = ",$G(RMPR60("IEN")),!! H 3 "RTN","RMPRPIYF",66,0) ; "RTN","RMPRPIYF",67,0) PCE ;update PCE data "RTN","RMPRPIYF",68,0) I $D(^RMPR(660,RMPR60("IEN"),10)),$P(^RMPR(660,RMPR60("IEN"),10),U,12) D "RTN","RMPRPIYF",69,0) .S RMCHK=0 "RTN","RMPRPIYF",70,0) .S RMCHK=$$SENDPCE^RMPRPCEA(RMPR60("IEN")) "RTN","RMPRPIYF",71,0) .I RMCHK'=1 W !!,"*** ERROR in PCE UPDATE, Please notify your IRM..IEN = ",RMPR60("IEN"),!! H 3 "RTN","RMPRPIYF",72,0) ; "RTN","RMPRPIYF",73,0) ;end posting (edit 2319) "RTN","RMPRPIYF",74,0) G EXIT "RTN","RMPRPIYF",75,0) ; "RTN","RMPRPIYF",76,0) DEL1 ;ENTRY POINT TO DELETE AN ISSUE FROM STOCK "RTN","RMPRPIYF",77,0) K DIR "RTN","RMPRPIYF",78,0) S DIR("A")="Are you sure you want to DELETE this entry",DIR("B")="N",DIR(0)="Y" "RTN","RMPRPIYF",79,0) D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) G EXIT "RTN","RMPRPIYF",80,0) I Y'=1 G CO^RMPRPIYE "RTN","RMPRPIYF",81,0) ; "RTN","RMPRPIYF",82,0) DEL2 ;call API for returning item to PIP "RTN","RMPRPIYF",83,0) S (RMCHK,RMERPCE)=0 "RTN","RMPRPIYF",84,0) S RMI68=$P($G(^RMPR(660,RMPRIEN,10)),U,1) I RMI68>0 D I RMERPCE W !!,"** STOCK ISSUE DELETE ABORTED",!! G EXIT "RTN","RMPRPIYF",85,0) .S RMCHK=$$DEL^RMPRPCED(RMPRIEN) "RTN","RMPRPIYF",86,0) .I RMCHK'=0 W !!,"*** ERROR in PCE DELETE, Please notify your IRM..660 IEN = ",RMPRIEN,!! S RMERPCE=1 H 3 "RTN","RMPRPIYF",87,0) S RMPR60("IEN")=RMPRIEN "RTN","RMPRPIYF",88,0) S RMCHK=$$DEL^RMPRPIU3(.RMPR60) "RTN","RMPRPIYF",89,0) I $G(RMCHK) W !,"*** Error in API RMPRPIU3, ERROR = ",RMCHK,!,"*** Please inform your IRM !!",! G EXIT "RTN","RMPRPIYF",90,0) ; "RTN","RMPRPIYF",91,0) W $C(7),!?10,"Deleted..." H 1 "RTN","RMPRPIYF",92,0) EXIT ;KILL VARIABLES AND EXIT ROUTINE "RTN","RMPRPIYF",93,0) I $G(RMPRIEN),$D(^RMPR(660,RMPRIEN)) L -^RMPR(660,RMPRIEN) "RTN","RMPRPIYF",94,0) K ^TMP($J) N RMPRSITE,RMPR D KILL^XUSCLEAN "RTN","RMPRPIYF",95,0) Q "RTN","RMPRPIYF",96,0) ; "RTN","RMPRPIYF",97,0) UP660 ;update 660 "RTN","RMPRPIYF",98,0) S RMPR60("IEN")=RMPRIEN "RTN","RMPRPIYF",99,0) S RMPRERR=0 "RTN","RMPRPIYF",100,0) S RMPRERR=$$UPD^RMPRPIX2(.RMPR60,.RMPR11I) "RTN","RMPRPIYF",101,0) I $G(RMPRERR) W !,"*** Error in API RMPRPIX2, ERROR = ",RMPRERR,!,"*** Please inform your IRM !!",! "RTN","RMPRPIYF",102,0) Q "RTN","RMPRPIYF",103,0) ; "RTN","RMPRPIYF",104,0) UPDATE ;update the new entries AND delete old data "RTN","RMPRPIYF",105,0) S RMNEWHC=RMPR11I("HCPCS") "RTN","RMPRPIYF",106,0) S RMNEWIT=RMPR11I("ITEM") "RTN","RMPRPIYF",107,0) I $G(RMPR6("IEN")) S RMPR60("IEN")=RMPR6("IEN") D "RTN","RMPRPIYF",108,0) .S RMPRERR=$$UPD^RMPRPIX6(.RMPR60,.RMPR11I) "RTN","RMPRPIYF",109,0) .I $G(RMPR63("IEN")) S RMPRERR=$$UPALL^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) "RTN","RMPRPIYF",110,0) .I '$G(RMPR63("IEN")) S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) "RTN","RMPRPIYF",111,0) I '$G(RMPR6("IEN")) D "RTN","RMPRPIYF",112,0) .S RMPRERR=$$CRE^RMPRPIX6(.RMPR60,.RMPR11I) "RTN","RMPRPIYF",113,0) .S (RMPR60("IEN6"),RMPR6("IEN"))=$G(RMPR60("IEN")) "RTN","RMPRPIYF",114,0) .S RMPRERR=$$CRE^RMPRPIX3(.RMPR60,.RMPR6,.RMPR11I) "RTN","RMPRPIYF",115,0) ;create a return stock record "RTN","RMPRPIYF",116,0) S RMPR11I("HCPCS")=$G(RMPRRET("HCPCS")) "RTN","RMPRPIYF",117,0) S RMPR11I("ITEM")=$G(RMPRRET("ITEM")) "RTN","RMPRPIYF",118,0) S RMPRRET("SEQUENCE")=1 "RTN","RMPRPIYF",119,0) S RMPRRET("TRAN TYPE")=8 "RTN","RMPRPIYF",120,0) S RMPRRET("COMMENT")="STOCK ISSUE EDIT" "RTN","RMPRPIYF",121,0) S RMPRRET("USER")=$G(DUZ) "RTN","RMPRPIYF",122,0) I '$D(RMPRRET("QUANTITY")) S RMPRRET("QUANTITY")=RMPR60("QUANTITY") "RTN","RMPRPIYF",123,0) I '$D(RMPRRET("VALUE")) S RMPRRET("VALUE")=RMPR60("COST") "RTN","RMPRPIYF",124,0) I '$D(RMPRRET("UNIT")) S RMPRRET("UNIT")=RMPR60("UNIT") "RTN","RMPRPIYF",125,0) I '$D(RMPRRET("VENDOR")) S RMPRRET("VENDOR")=RMPR60("VENDOR IEN") "RTN","RMPRPIYF",126,0) I '$D(RMPRRET("LOCATION")) S RMPRRET("LOCATION")=$G(RMLO1) "RTN","RMPRPIYF",127,0) I $D(RMPR11I) D I $G(RMPRERR) Q "RTN","RMPRPIYF",128,0) .S RMPRERR=$$CRE^RMPRPIX6(.RMPRRET,.RMPR11I) "RTN","RMPRPIYF",129,0) ;return/update 661.7 "RTN","RMPRPIYF",130,0) D BACK Q:$G(RMPRERR) "RTN","RMPRPIYF",131,0) S RMPR11I("HCPCS")=$G(RMNEWHC) "RTN","RMPRPIYF",132,0) S RMPR11I("ITEM")=$G(RMNEWIT) "RTN","RMPRPIYF",133,0) S RMPR7I("QUANTITY")=RMPR60("QUANTITY") "RTN","RMPRPIYF",134,0) S RMPR7I("VALUE")=RMPR60("COST") "RTN","RMPRPIYF",135,0) ;update or create 661.7 entry "RTN","RMPRPIYF",136,0) D UP7 "RTN","RMPRPIYF",137,0) S RMPR9("QUANTITY")=RMPR60("QUANTITY") "RTN","RMPRPIYF",138,0) S RMPR9("VALUE")=RMPR60("COST") "RTN","RMPRPIYF",139,0) ;return 661.9 entry "RTN","RMPRPIYF",140,0) I $D(RMDTTIM) D D UP9 "RTN","RMPRPIYF",141,0) .S RMPR11I("HCPCS")=RMPRRET("HCPCS") "RTN","RMPRPIYF",142,0) .S RMPR11I("ITEM")=RMPRRET("ITEM") "RTN","RMPRPIYF",143,0) .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7) "RTN","RMPRPIYF",144,0) .S RMPR9("VALUE")=$P(R1BCK(0),U,16) "RTN","RMPRPIYF",145,0) ;deduct the new HCPCS in 661.9 "RTN","RMPRPIYF",146,0) S RMPR11I("HCPCS")=RMNEWHC "RTN","RMPRPIYF",147,0) S RMPR11I("ITEM")=RMPR60("ITEM") "RTN","RMPRPIYF",148,0) S RMPR9("QUANTITY")=0-RMPR60("QUANTITY") "RTN","RMPRPIYF",149,0) S RMPR9("VALUE")=0-RMPR60("COST") "RTN","RMPRPIYF",150,0) D UP9 "RTN","RMPRPIYF",151,0) Q "RTN","RMPRPIYF",152,0) ; "RTN","RMPRPIYF",153,0) BACK ; Bring back ITEM into current stock. "RTN","RMPRPIYF",154,0) D NOW^%DTC "RTN","RMPRPIYF",155,0) S (RMPR7R("STATION"),RMST1)=RMPR11I("STATION") "RTN","RMPRPIYF",156,0) S (RMPR7R("HCPCS"),RMHC1)=RMPR11I("HCPCS") "RTN","RMPRPIYF",157,0) S (RMPR7R("ITEM"),RMIT1)=RMPR11I("ITEM") "RTN","RMPRPIYF",158,0) S (RMPR7R("LOCATION"),RMLO1)=RMPRRET("LOCATION") "RTN","RMPRPIYF",159,0) S RMPR7R("VENDOR")=RMPRRET("VENDOR") "RTN","RMPRPIYF",160,0) S RMPR7R("DATE&TIME")=% "RTN","RMPRPIYF",161,0) S RMPR7R("SEQUENCE")=1 "RTN","RMPRPIYF",162,0) S RMPR7R("QUANTITY")=RMPRRET("QUANTITY") "RTN","RMPRPIYF",163,0) S RMPR7R("VALUE")=RMPRRET("VALUE") "RTN","RMPRPIYF",164,0) S RMPR7R("UNIT")=$G(RMPRRET("UNIT")) "RTN","RMPRPIYF",165,0) I $G(RMDTTIM),$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D I RMPRERR S RMPRERR=71 Q "RTN","RMPRPIYF",166,0) .S RMPR7R("IEN")=$O(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM,1,0)) "RTN","RMPRPIYF",167,0) .I '$G(RMPR7R("IEN")) S RMPRERR=1 Q "RTN","RMPRPIYF",168,0) .S RMDA7=$G(^RMPR(661.7,RMPR7R("IEN"),0)) "RTN","RMPRPIYF",169,0) .S RMDAVAL=$P(RMDA7,U,8),RMDAQUA=$P(RMDA7,U,7) "RTN","RMPRPIYF",170,0) .S RMPR7R("QUANTITY")=RMPR7R("QUANTITY")+RMDAQUA "RTN","RMPRPIYF",171,0) .S RMPR7R("VALUE")=RMPR7R("VALUE")+RMDAVAL "RTN","RMPRPIYF",172,0) .S RMPR7R("DATE&TIME")=RMDTTIM "RTN","RMPRPIYF",173,0) .S RMPRERR=$$UPD^RMPRPIX7(.RMPR7R,.RMPR11I) "RTN","RMPRPIYF",174,0) I $G(RMDTTIM),'$D(^RMPR(661.7,"XSLHIDS",RMST1,RMLO1,RMHC1,RMIT1,RMDTTIM)) D "RTN","RMPRPIYF",175,0) .S RMPR7R("DATE&TIME")=RMDTTIM "RTN","RMPRPIYF",176,0) .S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) "RTN","RMPRPIYF",177,0) I '$G(RMDTTIM) S RMPRERR=$$CRE^RMPRPIX7(.RMPR7R,.RMPR11I) "RTN","RMPRPIYF",178,0) Q "RTN","RMPRPIYF",179,0) ; "RTN","RMPRPIYF",180,0) UP6 ;now update file 661.6 "RTN","RMPRPIYF",181,0) S RMPR6("IEN")=$G(RMIEN6) "RTN","RMPRPIYF",182,0) S RMPR6("QUANTITY")=$G(RMPR60("QUANTITY")) "RTN","RMPRPIYF",183,0) S RMPR6("VALUE")=$G(RMPR60("COST")) "RTN","RMPRPIYF",184,0) S RMPRERR=$$UPD^RMPRPIX6(.RMPR6,.RMPR11I) "RTN","RMPRPIYF",185,0) Q "RTN","RMPRPIYF",186,0) ; "RTN","RMPRPIYF",187,0) ; "RTN","RMPRPIYF",188,0) UP63 ;update file 661.63 "RTN","RMPRPIYF",189,0) S RMPR6("IEN")=$G(RMIEN6) "RTN","RMPRPIYF",190,0) S RMPR6("LOCATION")=$G(RMPR5("IEN")) "RTN","RMPRPIYF",191,0) S RMPR6("VENDOR")=$G(RMPR60("VENDOR IEN")) "RTN","RMPRPIYF",192,0) S RMPR63("IEN")=$G(RMIEN63) "RTN","RMPRPIYF",193,0) S RMPRERR=$$UPD^RMPRPIX3(.RMPR60,.RMPR63,.RMPR11I) "RTN","RMPRPIYF",194,0) Q "RTN","RMPRPIYF",195,0) ; "RTN","RMPRPIYF",196,0) UP7 ;file #661.7,deduct quantity "RTN","RMPRPIYF",197,0) Q:'$G(RMPR11I("STATION")) "RTN","RMPRPIYF",198,0) S RMPR7I("STATION IEN")=RMPR11I("STATION") "RTN","RMPRPIYF",199,0) S RMPR7I("LOCATION IEN")=$G(RMPR5("IEN")) "RTN","RMPRPIYF",200,0) S RMPR7I("HCPCS")=RMPR11I("HCPCS") "RTN","RMPRPIYF",201,0) S RMPR7I("ITEM")=RMPR11I("ITEM") "RTN","RMPRPIYF",202,0) S:$G(RMPRRET("DATE&TIME")) RMPR7I("DATE&TIME")=RMPRRET("DATE&TIME") "RTN","RMPRPIYF",203,0) S RMPR7I("ISSUED QTY")=$G(RMPR7I("QUANTITY")) "RTN","RMPRPIYF",204,0) S RMPR7I("ISSUED VALUE")=$G(RMPR7I("VALUE")) "RTN","RMPRPIYF",205,0) S RMPRERR=$$FIFO^RMPRPIUB(.RMPR7I) "RTN","RMPRPIYF",206,0) Q "RTN","RMPRPIYF",207,0) UP9 ;file 661.9 "RTN","RMPRPIYF",208,0) D NOW^%DTC "RTN","RMPRPIYF",209,0) S RMPR9("STA")=RMPR11I("STATION") "RTN","RMPRPIYF",210,0) S RMPR9("HCP")=RMPR11I("HCPCS") "RTN","RMPRPIYF",211,0) S RMPR9("ITE")=RMPR11I("ITEM") "RTN","RMPRPIYF",212,0) S RMPR9("RDT")=$P(%,".",1) "RTN","RMPRPIYF",213,0) S RMPR9("TQTY")=RMPR9("QUANTITY") "RTN","RMPRPIYF",214,0) S RMPR9("TCST")=RMPR9("VALUE") "RTN","RMPRPIYF",215,0) S RMPERR=$$UPCR^RMPRPIXJ(.RMPR9) "RTN","RMPRPIYF",216,0) Q "RTN","RMPRPIYF",217,0) ; "RTN","RMPRPIYF",218,0) QUAN ;only update quantity "RTN","RMPRPIYF",219,0) ;quit if not in PIP "RTN","RMPRPIYF",220,0) Q:'$G(RMIEN6)!'$D(RMDTTIM)!'$D(RMPRRET) "RTN","RMPRPIYF",221,0) S RMPR11I("STATION")=RMPRRET("STATION") "RTN","RMPRPIYF",222,0) S RMPR11I("HCPCS")=RMPRRET("HCPCS") "RTN","RMPRPIYF",223,0) S RMPR11I("ITEM")=RMPRRET("ITEM") "RTN","RMPRPIYF",224,0) S RMPR5("IEN")=RMPRRET("LOCATION") "RTN","RMPRPIYF",225,0) D UP6,UP63 "RTN","RMPRPIYF",226,0) I RMPR60("QUANTITY")>($P(R1BCK(0),U,7)) D D UP7,UP9 "RTN","RMPRPIYF",227,0) .S RMPR7I("QUANTITY")=RMPR60("QUANTITY")-($P(R1BCK(0),U,7)) "RTN","RMPRPIYF",228,0) .S RMPR7I("VALUE")=RMPR60("COST")-($P(R1BCK(0),U,16)) "RTN","RMPRPIYF",229,0) .S RMPR9("QUANTITY")=0-($G(RMPR60("QUANTITY"))-$P(R1BCK(0),U,7)) "RTN","RMPRPIYF",230,0) .S RMPR9("VALUE")=0-($G(RMPR60("COST"))-$P(R1BCK(0),U,16)) "RTN","RMPRPIYF",231,0) I RMPR60("QUANTITY")<($P(R1BCK(0),U,7)) D D BACK,UP9 "RTN","RMPRPIYF",232,0) .S RMPR9("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) "RTN","RMPRPIYF",233,0) .S RMPRRET("QUANTITY")=$P(R1BCK(0),U,7)-$G(RMPR60("QUANTITY")) "RTN","RMPRPIYF",234,0) .S RMPR9("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) "RTN","RMPRPIYF",235,0) .S RMPRRET("VALUE")=$P(R1BCK(0),U,16)-$G(RMPR60("COST")) "RTN","RMPRPIYF",236,0) Q "RTN","RMPRPIYF",237,0) ; "RTN","RMPRPIYF",238,0) ERR W !!,"Error encountered while posting to PIP. Patient 10-2319 not deleted!! Please check with your Application Coordinator." H 5 G EXIT "RTN","RMPRPIYG") 0^51^B51586715 "RTN","RMPRPIYG",1,0) RMPRPIYG ;HINCIO/ODJ - RC - PIP Receive Stock ;3/8/01 "RTN","RMPRPIYG",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYG",3,0) Q "RTN","RMPRPIYG",4,0) ; "RTN","RMPRPIYG",5,0) ;***** RC - Replaces RC option in old PIP "RTN","RMPRPIYG",6,0) ; RMPR INV RECEIVE "RTN","RMPRPIYG",7,0) ; cf. REC^RMPR5NOR "RTN","RMPRPIYG",8,0) ; Callable from VISTA menu, no vars required other than "RTN","RMPRPIYG",9,0) ; global VISTA vars (DUZ, etc) "RTN","RMPRPIYG",10,0) ; "RTN","RMPRPIYG",11,0) RC N RMPRERR,RMPRSTN,RMPRLCN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPROVAL "RTN","RMPRPIYG",12,0) N RMPRVEND,RMPRQTY,RMPRTVAL,RMPR4,RMPRUCST,RMPRQ,RMPRIOP,RMPRNLAB "RTN","RMPRPIYG",13,0) N RMPRBARC,RMPRITXT,RMPRBCP,RMPR41,RMPR41N,RMPRYN "RTN","RMPRPIYG",14,0) ; "RTN","RMPRPIYG",15,0) ;***** STN - prompt for Site/Station "RTN","RMPRPIYG",16,0) STN S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIYG",17,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYG",18,0) I RMPRERR G RCX "RTN","RMPRPIYG",19,0) I RMPREXC'="" G RCX "RTN","RMPRPIYG",20,0) I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11 "RTN","RMPRPIYG",21,0) S RMPR("NAME")=RMPRSTN("SITE NAME") "RTN","RMPRPIYG",22,0) ; "RTN","RMPRPIYG",23,0) ;***** HCPCS - prompt for HCPCS "RTN","RMPRPIYG",24,0) HCPCS W !!,"Receive an Item from Supply, Vendor or Veteran.",! "RTN","RMPRPIYG",25,0) K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB "RTN","RMPRPIYG",26,0) K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND,RMPR1,RMPR11,RMPRUNI "RTN","RMPRPIYG",27,0) HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIYG",28,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",29,0) I RMPREXC="P"!(RMPREXC="^") D G RCX "RTN","RMPRPIYG",30,0) . W !,"** No HCPCS selected." H 1 "RTN","RMPRPIYG",31,0) . Q "RTN","RMPRPIYG",32,0) I $G(RMPR11("IEN"))'="" G QTY "RTN","RMPRPIYG",33,0) HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC) "RTN","RMPRPIYG",34,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",35,0) I RMPREXC="P"!(RMPREXC="^") G HCPCS "RTN","RMPRPIYG",36,0) S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYG",37,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYG",38,0) ; "RTN","RMPRPIYG",39,0) ; display selected HCPCS and item and continue "RTN","RMPRPIYG",40,0) HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC")) "RTN","RMPRPIYG",41,0) W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER")) "RTN","RMPRPIYG",42,0) W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIYG",43,0) ; "RTN","RMPRPIYG",44,0) ; call module to display and select orders "RTN","RMPRPIYG",45,0) PORD D PORD^RMPRPIYY(RMPRSTN("IEN"),RMPR1("HCPCS"),RMPR11("ITEM"),.RMPR41,.RMPREXC) "RTN","RMPRPIYG",46,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIYG",47,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",48,0) I RMPREXC="",+$G(RMPR41("IEN")) D "RTN","RMPRPIYG",49,0) . S RMPRQTY=RMPR41("BALANCE QTY") "RTN","RMPRPIYG",50,0) . K RMPRVEND "RTN","RMPRPIYG",51,0) . S RMPRVEND("IEN")=RMPR41("VENDOR IEN") "RTN","RMPRPIYG",52,0) . Q "RTN","RMPRPIYG",53,0) ; "RTN","RMPRPIYG",54,0) ;***** QTY - call prompt for Quantity "RTN","RMPRPIYG",55,0) QTY K RMPR41N("ORDER QTY") "RTN","RMPRPIYG",56,0) W ! D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC) "RTN","RMPRPIYG",57,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",58,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",59,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIYG",60,0) S RMPRQTY=+$G(RMPRQTY) "RTN","RMPRPIYG",61,0) I 'RMPRQTY D G HCPCS "RTN","RMPRPIYG",62,0) . W !,"No quantity entered!" "RTN","RMPRPIYG",63,0) . H 3 "RTN","RMPRPIYG",64,0) . Q "RTN","RMPRPIYG",65,0) I +$G(RMPR41("IEN")),RMPRQTY>RMPR41("BALANCE QTY") G QTYA "RTN","RMPRPIYG",66,0) G UCST "RTN","RMPRPIYG",67,0) ; "RTN","RMPRPIYG",68,0) ; If receive quantity is greater than o/s order balance ask if "RTN","RMPRPIYG",69,0) ; changing the order qty "RTN","RMPRPIYG",70,0) QTYA D YNQTY(.RMPRYN,.RMPREXC) "RTN","RMPRPIYG",71,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",72,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",73,0) I RMPREXC="P" G QTY "RTN","RMPRPIYG",74,0) I RMPRYN="N" G QTY "RTN","RMPRPIYG",75,0) S RMPR41N("ORDER QTY")=RMPR41("ORDER QTY")+(RMPRQTY-RMPR41("BALANCE QTY")) "RTN","RMPRPIYG",76,0) ; "RTN","RMPRPIYG",77,0) ;***** UCST - call prompt for Unit Cost "RTN","RMPRPIYG",78,0) UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC) "RTN","RMPRPIYG",79,0) I RMPREXC="P" G QTY "RTN","RMPRPIYG",80,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",81,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",82,0) S RMPRUCST=+$G(RMPRUCST) "RTN","RMPRPIYG",83,0) ; "RTN","RMPRPIYG",84,0) ;***** TVAL - Total Value - use if Unit Cost not used "RTN","RMPRPIYG",85,0) TVAL I RMPRUCST D G VEND "RTN","RMPRPIYG",86,0) . S RMPRTVAL=$J(RMPRQTY*RMPRUCST,0,2) "RTN","RMPRPIYG",87,0) . W !,"TOTAL COST OF QUANTITY: "_RMPRTVAL "RTN","RMPRPIYG",88,0) . Q "RTN","RMPRPIYG",89,0) D TVAL^RMPRPIY5(.RMPRTVAL,.RMPREXC) "RTN","RMPRPIYG",90,0) I RMPREXC="P" G UCST "RTN","RMPRPIYG",91,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",92,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",93,0) ; "RTN","RMPRPIYG",94,0) ;***** VEND - prompt for Vendor "RTN","RMPRPIYG",95,0) VEND K RMPR41N("VENDOR IEN") "RTN","RMPRPIYG",96,0) D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC) "RTN","RMPRPIYG",97,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",98,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",99,0) I RMPREXC="P" G UCST "RTN","RMPRPIYG",100,0) I RMPRVEND("IEN")=$G(RMPR41("VENDOR IEN")) G UNIT "RTN","RMPRPIYG",101,0) ; "RTN","RMPRPIYG",102,0) ;***** VENDA - vendor not same as order vendor so asK if changing "RTN","RMPRPIYG",103,0) D YNVND(.RMPRYN,.RMPREXC) "RTN","RMPRPIYG",104,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",105,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",106,0) I RMPREXC="P" G VEND "RTN","RMPRPIYG",107,0) I RMPRYN="N" G UNIT "RTN","RMPRPIYG",108,0) S RMPR41N("VENDOR IEN")=RMPRVEND("IEN") "RTN","RMPRPIYG",109,0) ; "RTN","RMPRPIYG",110,0) ;***** UNIT - call prompt for UNIT OF ISSUE "RTN","RMPRPIYG",111,0) UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC) "RTN","RMPRPIYG",112,0) I RMPREXC="P" G UCST "RTN","RMPRPIYG",113,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",114,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",115,0) S RMPRUNI("UNIT")=RMPRUNI("IEN") "RTN","RMPRPIYG",116,0) ; "RTN","RMPRPIYG",117,0) ;***** LOCN - prompt for location (if more than 1) "RTN","RMPRPIYG",118,0) LOCN S RMPRLCN=$$LOC1^RMPRPIYB(RMPRSTN("IEN")) "RTN","RMPRPIYG",119,0) I RMPRLCN D G TRANS "RTN","RMPRPIYG",120,0) . K RMPR5 "RTN","RMPRPIYG",121,0) . S RMPR5("IEN")=RMPRLCN "RTN","RMPRPIYG",122,0) . S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYG",123,0) . W !,"Location: "_RMPR5("NAME") "RTN","RMPRPIYG",124,0) . Q "RTN","RMPRPIYG",125,0) D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIYG",126,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",127,0) I RMPREXC="^" D MESS G HCPCS "RTN","RMPRPIYG",128,0) I RMPREXC="P" G UCST "RTN","RMPRPIYG",129,0) ; "RTN","RMPRPIYG",130,0) ;***** TRANS - Now create receipt transaction "RTN","RMPRPIYG",131,0) TRANS S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYG",132,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYG",133,0) I '$D(^RMPR(661.4,"ASLHI",RMPRSTN("IEN"),RMPR5("IEN"),RMPR11("HCPCS"),RMPR11("ITEM"))) D "RTN","RMPRPIYG",134,0) . S RMPR4("RE-ORDER QTY")=0 "RTN","RMPRPIYG",135,0) . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5) "RTN","RMPRPIYG",136,0) . Q "RTN","RMPRPIYG",137,0) S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYG",138,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYG",139,0) S RMPR6("QUANTITY")=RMPRQTY "RTN","RMPRPIYG",140,0) S RMPR6("VALUE")=RMPRTVAL "RTN","RMPRPIYG",141,0) S RMPR6("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIYG",142,0) S RMPR6("UNIT")=RMPRUNI("UNIT") "RTN","RMPRPIYG",143,0) I $D(RMPR41N("ORDER QTY")) S RMPR41("ORDER QTY")=RMPR41N("ORDER QTY") "RTN","RMPRPIYG",144,0) I $D(RMPR41N("VENDOR IEN")) S RMPR41("VENDOR IEN")=RMPR41N("VENDOR IEN") "RTN","RMPRPIYG",145,0) S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1,.RMPR41) ;receipt API "RTN","RMPRPIYG",146,0) I RMPRERR D G RCX "RTN","RMPRPIYG",147,0) . W !!,"** Item could not be received, please contact support." "RTN","RMPRPIYG",148,0) . H 3 "RTN","RMPRPIYG",149,0) . Q "RTN","RMPRPIYG",150,0) E D "RTN","RMPRPIYG",151,0) . W !!,"** Item has been received and inventory updated." "RTN","RMPRPIYG",152,0) . W !," If you are using barcoding you should now print labels" "RTN","RMPRPIYG",153,0) . W !," for the items received.",! "RTN","RMPRPIYG",154,0) . Q "RTN","RMPRPIYG",155,0) ; "RTN","RMPRPIYG",156,0) ;***** NLAB - call prompt for number of labels to print "RTN","RMPRPIYG",157,0) NLAB S RMPRNLAB=RMPR6("QUANTITY") "RTN","RMPRPIYG",158,0) W ! D NLABP^RMPRPIYS(.RMPRNLAB,RMPR6("QUANTITY"),.RMPREXC) "RTN","RMPRPIYG",159,0) I RMPREXC="T" G RCX "RTN","RMPRPIYG",160,0) I RMPREXC="P" G RCNX "RTN","RMPRPIYG",161,0) I RMPREXC="^" G RCNX "RTN","RMPRPIYG",162,0) I RMPRNLAB=0 G RCNX "RTN","RMPRPIYG",163,0) ; "RTN","RMPRPIYG",164,0) ;***** SELP - call prompt for barcode print device "RTN","RMPRPIYG",165,0) SELP ;W ! D SELP^RMPRPI11(.RMPRBCP,.RMPREXC,.RMPRQ,.RMPRIOP) "RTN","RMPRPIYG",166,0) ;I RMPREXC'="" G NLAB "RTN","RMPRPIYG",167,0) S RMPRBARC=RMPR11("HCPCS")_"-"_$P(RMPR6("DATE&TIME"),".",1)_$P(RMPR6("DATE&TIME"),".",2) "RTN","RMPRPIYG",168,0) S RMPRITXT("DATE")=$E(RMPR6("DATE&TIME"),4,5)_"/"_$E(RMPR6("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR6("DATE&TIME"),1,3)) "RTN","RMPRPIYG",169,0) S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM") "RTN","RMPRPIYG",170,0) S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION") "RTN","RMPRPIYG",171,0) S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER") "RTN","RMPRPIYG",172,0) S RMPRITXT("UNIT PRICE")=RMPRUCST "RTN","RMPRPIYG",173,0) S RMPRITXT("VENDOR")=RMPRVEND("NAME") "RTN","RMPRPIYG",174,0) S RMPRITXT("LOCATION")=RMPR5("NAME") "RTN","RMPRPIYG",175,0) D PRINT^RMPRPIYS "RTN","RMPRPIYG",176,0) RCNX K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST,RMPRBCP,RMPRQ,RMPRIOP,RMPRNLAB "RTN","RMPRPIYG",177,0) K RMPRBARC,RMPRITXT,RMPR41N,RMPR41,RMPRVEND "RTN","RMPRPIYG",178,0) G HCPCS "RTN","RMPRPIYG",179,0) RCX D KILL^XUSCLEAN "RTN","RMPRPIYG",180,0) Q "RTN","RMPRPIYG",181,0) ; "RTN","RMPRPIYG",182,0) MESS W !!,"*** NOTHING RECEIVE !!!",! "RTN","RMPRPIYG",183,0) Q "RTN","RMPRPIYG",184,0) ; "RTN","RMPRPIYG",185,0) ; Y/N Prompt to confirm change of order qty "RTN","RMPRPIYG",186,0) YNQTY(RMPRYN,RMPREXC) ; "RTN","RMPRPIYG",187,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYG",188,0) S RMPRYN="N" "RTN","RMPRPIYG",189,0) S RMPREXC="" "RTN","RMPRPIYG",190,0) S DIR(0)="Y" "RTN","RMPRPIYG",191,0) S DIR("A",1)="The entered quantity is greater than the outstanding balance ("_RMPR41("BALANCE QTY")_")" "RTN","RMPRPIYG",192,0) S DIR("A",2)="still on order." "RTN","RMPRPIYG",193,0) S DIR("A")="Do you want to increase the original order quantity" "RTN","RMPRPIYG",194,0) D ^DIR "RTN","RMPRPIYG",195,0) I $D(DTOUT) S RMPREXC="T" G YNQTYX "RTN","RMPRPIYG",196,0) I $D(DIROUT) S RMPREXC="P" G YNQTYX "RTN","RMPRPIYG",197,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G YNQTYX "RTN","RMPRPIYG",198,0) S:Y RMPRYN="Y" "RTN","RMPRPIYG",199,0) YNQTYX Q "RTN","RMPRPIYG",200,0) ; "RTN","RMPRPIYG",201,0) ; Y/N Prompt to confirm change of order Vendor "RTN","RMPRPIYG",202,0) YNVND(RMPRYN,RMPREXC) ; "RTN","RMPRPIYG",203,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYG",204,0) S RMPRYN="N" "RTN","RMPRPIYG",205,0) S RMPREXC="" "RTN","RMPRPIYG",206,0) S DIR(0)="Y" "RTN","RMPRPIYG",207,0) S DIR("A",1)="The entered Vendor is not the same as on the original order" "RTN","RMPRPIYG",208,0) S DIR("A")="Do you want to change the Vendor on the order" "RTN","RMPRPIYG",209,0) D ^DIR "RTN","RMPRPIYG",210,0) I $D(DTOUT) S RMPREXC="T" G YNVNDX "RTN","RMPRPIYG",211,0) I $D(DIROUT) S RMPREXC="P" G YNVNDX "RTN","RMPRPIYG",212,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G YNVNDX "RTN","RMPRPIYG",213,0) S:Y RMPRYN="Y" "RTN","RMPRPIYG",214,0) YNVNDX Q "RTN","RMPRPIYH") 0^52^B16728879 "RTN","RMPRPIYH",1,0) RMPRPIYH ;HINCIO/ODJ - PIP Stock Receipt Prompts ;3/8/01 "RTN","RMPRPIYH",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYH",3,0) Q "RTN","RMPRPIYH",4,0) ; "RTN","RMPRPIYH",5,0) ;***** LOCNM - Prompt for receiving location "RTN","RMPRPIYH",6,0) ; must be in 661.5 and active "RTN","RMPRPIYH",7,0) LOCNM(RMPRSTN,RMPR5,RMPREXC) ; "RTN","RMPRPIYH",8,0) N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT "RTN","RMPRPIYH",9,0) D NOW^%DTC S RMPRTDT=X ;today's date "RTN","RMPRPIYH",10,0) S RMPREXC="" "RTN","RMPRPIYH",11,0) S RMPRERR=0 "RTN","RMPRPIYH",12,0) S DIR(0)="FOA" "RTN","RMPRPIYH",13,0) S DIR("A")="Enter Receiving Location: " "RTN","RMPRPIYH",14,0) S DIR("?")="^D QM^RMPRPIYB" "RTN","RMPRPIYH",15,0) S DIR("??")="^D QM2^RMPRPIYB" "RTN","RMPRPIYH",16,0) LOCNM1 D ^DIR "RTN","RMPRPIYH",17,0) I $D(DTOUT) S RMPREXC="T" G LOCNMX "RTN","RMPRPIYH",18,0) I $D(DIROUT) S RMPREXC="P" G LOCNMX "RTN","RMPRPIYH",19,0) I X=""!(X["^") S RMPREXC="^" G LOCNMX "RTN","RMPRPIYH",20,0) K RMPR5 "RTN","RMPRPIYH",21,0) S RMPR5("STATION")=RMPRSTN "RTN","RMPRPIYH",22,0) S RMPR5("STATION IEN")=RMPRSTN "RTN","RMPRPIYH",23,0) D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5) "RTN","RMPRPIYH",24,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIYH",25,0) I $G(RMPR5("IEN"))="" D G LOCNM1 "RTN","RMPRPIYH",26,0) . W !,"Please enter a valid Location" "RTN","RMPRPIYH",27,0) . Q "RTN","RMPRPIYH",28,0) ; "RTN","RMPRPIYH",29,0) ; exit "RTN","RMPRPIYH",30,0) LOCNMX Q RMPRERR "RTN","RMPRPIYH",31,0) ; "RTN","RMPRPIYH",32,0) ; Get OK "RTN","RMPRPIYH",33,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYH",34,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYH",35,0) S RMPREXC="" "RTN","RMPRPIYH",36,0) S DIR("A")=" ...OK" "RTN","RMPRPIYH",37,0) S DIR("B")="Yes" "RTN","RMPRPIYH",38,0) S DIR(0)="Y" "RTN","RMPRPIYH",39,0) D ^DIR "RTN","RMPRPIYH",40,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYH",41,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYH",42,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIYH",43,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYH",44,0) OKX Q "RTN","RMPRPIYH",45,0) ; "RTN","RMPRPIYH",46,0) ;***** HCPCS - Get a HCPCS code from 661.4 "RTN","RMPRPIYH",47,0) HCPCS(RMPR5,RMPR1,RMPREXC) ; "RTN","RMPRPIYH",48,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DIC,DA,RMPRSTN,RMPRLCN,RMPR1N "RTN","RMPRPIYH",49,0) S DIR("A")="Select HCPCS to RECEIVE: " "RTN","RMPRPIYH",50,0) S RMPRERR=0 "RTN","RMPRPIYH",51,0) S RMPREXC="" "RTN","RMPRPIYH",52,0) S RMPR1("HCPCS")=$G(RMPR1("HCPCS")) "RTN","RMPRPIYH",53,0) S RMPRSTN=RMPR5("STATION") "RTN","RMPRPIYH",54,0) S RMPRLCN=RMPR5("IEN") "RTN","RMPRPIYH",55,0) S DIR(0)="FOA" "RTN","RMPRPIYH",56,0) S DIR("?")="^D QM^RMPRPIYC" "RTN","RMPRPIYH",57,0) S DIR("??")="^D QM2^RMPRPIYC" "RTN","RMPRPIYH",58,0) HCPCS1 K RMPR1N D ^DIR "RTN","RMPRPIYH",59,0) I $D(DTOUT) S RMPREXC="T" G HCPCSX "RTN","RMPRPIYH",60,0) I $D(DIROUT) S RMPREXC="P" G HCPCSX "RTN","RMPRPIYH",61,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX "RTN","RMPRPIYH",62,0) D LIKE^RMPRPIYC(RMPRSTN,RMPRLCN,X,.RMPREXC,.RMPR1N) "RTN","RMPRPIYH",63,0) I RMPREXC'="" G HCPCS1 "RTN","RMPRPIYH",64,0) I $G(RMPR1N("IEN"))'="" G HCPCSU "RTN","RMPRPIYH",65,0) G HCPCS1 "RTN","RMPRPIYH",66,0) HCPCSU K RMPR1 M RMPR1=RMPR1N "RTN","RMPRPIYH",67,0) HCPCSX Q RMPRERR "RTN","RMPRPIYH",68,0) ; "RTN","RMPRPIYH",69,0) ;***** ITEM - Get an Item - restrict choice to Location and HCPC "RTN","RMPRPIYH",70,0) ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ; "RTN","RMPRPIYH",71,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN "RTN","RMPRPIYH",72,0) S RMPRERR=0 "RTN","RMPRPIYH",73,0) S RMPREXC="" "RTN","RMPRPIYH",74,0) I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX "RTN","RMPRPIYH",75,0) I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX "RTN","RMPRPIYH",76,0) I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX "RTN","RMPRPIYH",77,0) K RMPR11,RMPR4 "RTN","RMPRPIYH",78,0) S DIR(0)="FOA^1:50" "RTN","RMPRPIYH",79,0) S DIR("A")="Enter Item to RECEIVE: " "RTN","RMPRPIYH",80,0) S DIR("?")="^D QM^RMPRPIY8" "RTN","RMPRPIYH",81,0) S DIR("??")="^D QQM^RMPRPIY8" "RTN","RMPRPIYH",82,0) ITEMA1 D ^DIR "RTN","RMPRPIYH",83,0) I $D(DTOUT) S RMPREXC="T" G ITEMX "RTN","RMPRPIYH",84,0) I $D(DIROUT) S RMPREXC="P" G ITEMX "RTN","RMPRPIYH",85,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX "RTN","RMPRPIYH",86,0) D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4) "RTN","RMPRPIYH",87,0) I RMPREXC="T" G ITEMX "RTN","RMPRPIYH",88,0) I RMPREXC="P" G ITEMX "RTN","RMPRPIYH",89,0) I RMPREXC="^" G ITEMA1 "RTN","RMPRPIYH",90,0) I RMPR4("IEN")="" D G ITEMA1 "RTN","RMPRPIYH",91,0) . W !,"Cannot locate ITEM with this sequence NUMBER" "RTN","RMPRPIYH",92,0) . Q "RTN","RMPRPIYH",93,0) W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION") "RTN","RMPRPIYH",94,0) D OK(.RMPRYN,.RMPREXC) "RTN","RMPRPIYH",95,0) I RMPRYN'="Y" G ITEMA1 "RTN","RMPRPIYH",96,0) G ITEMX "RTN","RMPRPIYH",97,0) ITEMX Q RMPRERR "RTN","RMPRPIYH",98,0) ; "RTN","RMPRPIYH",99,0) ; Get Quantity "RTN","RMPRPIYH",100,0) QTY(RMPRQTY,RMPREXC) ; "RTN","RMPRPIYH",101,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIYH",102,0) S RMPRQTY=$G(RMPRQTY) "RTN","RMPRPIYH",103,0) S RMPRERR=0 "RTN","RMPRPIYH",104,0) S DIR(0)="NA^1:99999:0" "RTN","RMPRPIYH",105,0) S DIR("A")="Quantity to Receive: " "RTN","RMPRPIYH",106,0) S:RMPRQTY'="" DIR("B")=RMPRQTY "RTN","RMPRPIYH",107,0) D ^DIR "RTN","RMPRPIYH",108,0) I $D(DTOUT) S RMPREXC="T" G QTYX "RTN","RMPRPIYH",109,0) I $D(DIROUT) S RMPREXC="P" G QTYX "RTN","RMPRPIYH",110,0) I X=""!(X["^") S RMPREXC="^" G QTYX "RTN","RMPRPIYH",111,0) S RMPRQTY=Y "RTN","RMPRPIYH",112,0) QTYX Q RMPRERR "RTN","RMPRPIYH",113,0) ; "RTN","RMPRPIYH",114,0) ; Get total $ value "RTN","RMPRPIYH",115,0) TVAL(RMPRTVAL,RMPREXC) ; "RTN","RMPRPIYH",116,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIYH",117,0) S RMPRTVAL=$G(RMPRTVAL) "RTN","RMPRPIYH",118,0) S RMPRERR=0 "RTN","RMPRPIYH",119,0) S DIR(0)="NOA^0:999999:2" "RTN","RMPRPIYH",120,0) S DIR("A")="Total Cost of Item: " "RTN","RMPRPIYH",121,0) D ^DIR "RTN","RMPRPIYH",122,0) I $D(DTOUT) S RMPREXC="T" G TVALX "RTN","RMPRPIYH",123,0) I $D(DIROUT) S RMPREXC="P" G TVALX "RTN","RMPRPIYH",124,0) I X["^" S RMPREXC="^" G TVALX "RTN","RMPRPIYH",125,0) I X="" G TVALX "RTN","RMPRPIYH",126,0) S RMPRTVAL=Y "RTN","RMPRPIYH",127,0) TVALX Q RMPRERR "RTN","RMPRPIYI") 0^53^B60353445 "RTN","RMPRPIYI",1,0) RMPRPIYI ;HINCIO/RVD-ISSUE FROM STOCK ;6/16/04 08:18 "RTN","RMPRPIYI",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYI",3,0) ; RVD #61 - phase IIIa of PIP "RTN","RMPRPIYI",4,0) ; "RTN","RMPRPIYI",5,0) S RMPR699("AMIS GROUPER")="" "RTN","RMPRPIYI",6,0) S (RMPRG,RMPRF)="" D HOME^%ZIS W @IOF "RTN","RMPRPIYI",7,0) I '$D(RMPR) D DIV4^RMPRSIT G:$D(X) EXIT^RMPRPIYJ "RTN","RMPRPIYI",8,0) I $D(RMPRDFN),$D(^TMP($J,"RMPRPCE")) D LINK^RMPRS "RTN","RMPRPIYI",9,0) I $D(RMPRDFN),'$D(^TMP($J,"RMPRPCE")) G EXIT^RMPRPIYJ "RTN","RMPRPIYI",10,0) K ^TMP($J,"RMPRPCE") "RTN","RMPRPIYI",11,0) D GETPAT^RMPRUTIL G:'$D(RMPRDFN) EXIT^RMPRPIYJ "RTN","RMPRPIYI",12,0) VIEW ; "RTN","RMPRPIYI",13,0) N RMPRBAC1,RMDES "RTN","RMPRPIYI",14,0) S (RSTCK,RMPRBAC1)=1 D ^RMPRPAT K RMPRBAC1 "RTN","RMPRPIYI",15,0) I $D(RMPRKILL)!($D(DTOUT)) W $C(7),!,"Deleted..." G EXIT^RMPRPIYJ "RTN","RMPRPIYI",16,0) S CK="W:$D(DUOUT) @IOF,!!!?28,$C(7),""Deleted..."" G EXIT^RMPRPIYJ" "RTN","RMPRPIYI",17,0) S CK2="W @IOF,!!!?28,$C(7),""Deleted..."" H 2" "RTN","RMPRPIYI",18,0) S CK1="W $C(7),!,""Timed-Out, Deleted..."" G EXIT^RMPRPIYJ" "RTN","RMPRPIYI",19,0) S R3("D")="" "RTN","RMPRPIYI",20,0) ; "RTN","RMPRPIYI",21,0) RES ;ENTRY POINT TO ADD ADDITIONAL ITEMS FOR ISSUE FROM STOCK "RTN","RMPRPIYI",22,0) Q:$G(RMPRDFN)<1 "RTN","RMPRPIYI",23,0) K DA,DD,DIC,PRC,X,Y,RMSO,RMQTY,RMDAHC,RMLACO,RMITDA,RMHCOLD,RMPRVEN "RTN","RMPRPIYI",24,0) K RMPR11IS,RMPR5SA,RMPR6SA "RTN","RMPRPIYI",25,0) S (R1(1),R1(0),R3("D"),R4("D"),R1("AM"),RMPRI("AMS"),R1("D"),RMLOC)="" "RTN","RMPRPIYI",26,0) S RMLODES="" "RTN","RMPRPIYI",27,0) S (RMLOCOLD,R1,RMIT,RMHCNEW,RMHCOLD,RMITDESC,RMITIEN,R1(2))="",REDIT=0 "RTN","RMPRPIYI",28,0) S R1(0)=DT_U_RMPRDFN_U_DT,$P(R1(0),U,10)=RMPR("STA"),$P(R1(0),U,27)=DUZ "RTN","RMPRPIYI",29,0) ; "RTN","RMPRPIYI",30,0) 1 ;ENTRY POINT TO EDIT ITEM ON ISSUE FROM STOCK "RTN","RMPRPIYI",31,0) S (RMHCNEW,RMHCOLD)=$P(R1(1),U,4),RMLOCOLD=RMLOC,RMITOLD=RMIT "RTN","RMPRPIYI",32,0) K RQUIT S RMHCFLG=0 "RTN","RMPRPIYI",33,0) W @IOF,!?30,RMPRNAM,! "RTN","RMPRPIYI",34,0) W:$G(REDIT) !!,"Editing a Stock Item!!!" "RTN","RMPRPIYI",35,0) W:'$G(REDIT) !!,"Entering a Stock Item!!!" "RTN","RMPRPIYI",36,0) ; "RTN","RMPRPIYI",37,0) TRAN ;TYPE OF TRANSACTION "RTN","RMPRPIYI",38,0) W ! "RTN","RMPRPIYI",39,0) ;S DIR(0)="660,2" "RTN","RMPRPIYI",40,0) K DIR "RTN","RMPRPIYI",41,0) S:$P(R1(0),U,4)?.E&($P(R3("D"),U,4)'="") DIR("B")=$P(R3("D"),U,4) "RTN","RMPRPIYI",42,0) S DIR(0)="SO^I:INITIAL ISSUE;X:REPAIR;R:REPLACE;S:SPARE" "RTN","RMPRPIYI",43,0) S DIR("A")="TYPE OF TRANSACTION" "RTN","RMPRPIYI",44,0) D ^DIR "RTN","RMPRPIYI",45,0) I (Y=""),($P(R3("D"),U,4)="") G ^RMPRPIYI "RTN","RMPRPIYI",46,0) I $P(R3("D"),U,4)'=""&($D(DUOUT)) G LIST^RMPRPIYJ "RTN","RMPRPIYI",47,0) I $D(DTOUT) X CK1 Q "RTN","RMPRPIYI",48,0) I $D(DUOUT) G ^RMPRPIYI "RTN","RMPRPIYI",49,0) S $P(R1(0),U,4)=Y K DIR "RTN","RMPRPIYI",50,0) S $P(R3("D"),U,4)=$S(Y="I":"INITIAL ISSUE",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",1:"") "RTN","RMPRPIYI",51,0) ; "RTN","RMPRPIYI",52,0) PCAT ; "RTN","RMPRPIYI",53,0) S DIR(0)="660,62" S:$P(R1("AM"),U,3)?1N.N DIR("B")=$P(R4("D"),U,3) "RTN","RMPRPIYI",54,0) D ^DIR I $P(R1("AM"),U,3)'=""&($D(DUOUT)) G LIST^RMPRPIYJ "RTN","RMPRPIYI",55,0) I $D(DTOUT) X CK1 Q "RTN","RMPRPIYI",56,0) I $D(DUOUT) X CK2 G ^RMPRPIYI "RTN","RMPRPIYI",57,0) S $P(R1("AM"),U,3)=Y,$P(R4("D"),U,3)=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"") K DIR "RTN","RMPRPIYI",58,0) I Y<4 S $P(R1("AM"),U,4)="",$P(R4("D"),U,4)="" G 2 "RTN","RMPRPIYI",59,0) ; "RTN","RMPRPIYI",60,0) SPE I Y=4 S DIR(0)="660,63" S:$P(R1("AM"),U,4)?1N.N DIR("B")=$P(R4("D"),U,4) D ^DIR I $D(DTOUT) X CK1 Q "RTN","RMPRPIYI",61,0) I $G(REDIT)&($D(DUOUT)) G LIST^RMPRPIYJ "RTN","RMPRPIYI",62,0) I $D(DUOUT) X CK2 G ^RMPRPIYI "RTN","RMPRPIYI",63,0) I $P(R1("AM"),U,3)=4 S $P(R1("AM"),U,4)=Y,$P(R4("D"),U,4)=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"") "RTN","RMPRPIYI",64,0) ; "RTN","RMPRPIYI",65,0) ; prompt for and scan barcode label "RTN","RMPRPIYI",66,0) ; if scan is successful then all vars will be set and go to Edit prompt "RTN","RMPRPIYI",67,0) 2 I $G(REDIT),$D(RMPR11I) M RMPR11IS=RMPR11I,RMPR5SA=RMPR5,RMPR6SA=RMPR6 "RTN","RMPRPIYI",68,0) W ! D SCAN^RMPRPIYS "RTN","RMPRPIYI",69,0) I $P(R3("D"),U,6)&((RMPREXC="^")!(RMPREXC="P")) G LIST^RMPRPIYJ "RTN","RMPRPIYI",70,0) I (RMPREXC="^"),$G(REDIT) G LIST^RMPRPIYJ "RTN","RMPRPIYI",71,0) I RMPREXC="^" X CK2 G ^RMPRPIYI "RTN","RMPRPIYI",72,0) I RMPREXC="P" G PCAT "RTN","RMPRPIYI",73,0) I RMPREXC="T" X CK1 Q "RTN","RMPRPIYI",74,0) I RMPRBARC="",$G(REDIT) M RMPR11I=RMPR11IS,RMPR5=RMPR5SA,RMPR6=RMPR6SA G ^RMPRPIYJ "RTN","RMPRPIYI",75,0) I RMPRBARC="" G 2 "RTN","RMPRPIYI",76,0) D HCPCS3^RMPRPIY1 "RTN","RMPRPIYI",77,0) G ^RMPRPIYJ "RTN","RMPRPIYI",78,0) HCPCS ;HCPCS code "RTN","RMPRPIYI",79,0) S (RMITFLG,RMHCFLG,RMHCDA,RMITDA,RMAV,RMAVA,RMCO,RMBAL)=0 "RTN","RMPRPIYI",80,0) S RMPRHCPC="" I $D(RMHCPC) S RMPRHCPC=RMHCPC "RTN","RMPRPIYI",81,0) D HCPCS^RMPRPIY1(RMPR("STA"),RMPRHCPC,.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIYI",82,0) I RMPREXC="T" X CK1 Q "RTN","RMPRPIYI",83,0) I RMPREXC="P" G 2 "RTN","RMPRPIYI",84,0) I $G(REDIT),(RMPREXC="^") G LIST^RMPRPIYJ "RTN","RMPRPIYI",85,0) I RMPREXC="^" X CK2 G ^RMPRPIYI "RTN","RMPRPIYI",86,0) W ! "RTN","RMPRPIYI",87,0) S RMITNO=RMPR11("ITEM") "RTN","RMPRPIYI",88,0) S RMHCPC=RMPR1("HCPCS") "RTN","RMPRPIYI",89,0) S (RMHCNEW,RMDAHC,RMHCDA)=RMPR1("IEN") "RTN","RMPRPIYI",90,0) S RDESC=RMPR1("SHORT DESC") "RTN","RMPRPIYI",91,0) K RMPR11I "RTN","RMPRPIYI",92,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I) "RTN","RMPRPIYI",93,0) I RMPR11I("ITEM MASTER IEN")="" D G 2 "RTN","RMPRPIYI",94,0) . W !,"This item is not associated with an IFCAP Item.",! "RTN","RMPRPIYI",95,0) . W "Please use the Edit Inventory option before trying to issue this item." "RTN","RMPRPIYI",96,0) . W ! "RTN","RMPRPIYI",97,0) . Q "RTN","RMPRPIYI",98,0) I '$D(^RMPR(661.7,"XSHIDS",RMPR("STA"),RMHCPC,RMITNO)) D G 2 "RTN","RMPRPIYI",99,0) . W !,"This HCPCS-ITEM is not associated with any Location." "RTN","RMPRPIYI",100,0) . W !,"Please update your inventory!!.",! "RTN","RMPRPIYI",101,0) . W ! "RTN","RMPRPIYI",102,0) . Q "RTN","RMPRPIYI",103,0) S $P(R1(0),U,6)=RMPR11I("ITEM MASTER IEN") "RTN","RMPRPIYI",104,0) S $P(R1(0),U,8)=$G(RMPR11("UNIT")) "RTN","RMPRPIYI",105,0) S $P(R3("D"),U,6)=RMPR11("ITEM MASTER") "RTN","RMPRPIYI",106,0) ;check for location if multiple then ask for LOCATION "RTN","RMPRPIYI",107,0) S RMLCNT=0 "RTN","RMPRPIYI",108,0) F I=0:0 S I=$O(^RMPR(661.7,"XSLHIDS",RMPR("STA"),I)) Q:I'>0 I $D(^(I,RMHCPC)) S RMLCNT=RMLCNT+1,(RMPR5("IEN"),RMLOC)=I "RTN","RMPRPIYI",109,0) I RMLCNT<2 G ITEM "RTN","RMPRPIYI",110,0) ; "RTN","RMPRPIYI",111,0) ASKLOC ;ask for location "RTN","RMPRPIYI",112,0) K DIC,Y,X,RQUIT,RMPR5 "RTN","RMPRPIYI",113,0) S DZ="??",D="B" "RTN","RMPRPIYI",114,0) S DIC("S")="I ($P(^RMPR(661.5,+Y,0),U,2)=RMPR(""STA"")),($P(^(0),U,4)=""A""),($D(^RMPR(661.7,""XSLHIDS"",RMPR(""STA""),+Y,RMHCPC,RMITNO)))" "RTN","RMPRPIYI",115,0) S:RMLOCOLD'="" DIC("B")=RMLOCOLD "RTN","RMPRPIYI",116,0) S DIC="^RMPR(661.5,",DIC(0)="AEQMN" "RTN","RMPRPIYI",117,0) S DIC("A")="Enter Pros Location: " D MIX^DIC1 "RTN","RMPRPIYI",118,0) I $G(REDIT)&$D(DUOUT) G LIST^RMPRPIYJ "RTN","RMPRPIYI",119,0) I $D(DUOUT) G 2^RMPRPIYI "RTN","RMPRPIYI",120,0) I $D(DTOUT) X CK1 Q "RTN","RMPRPIYI",121,0) I X="" W !,"This is a mandatory field!!!",! G ASKLOC "RTN","RMPRPIYI",122,0) S RMLOC=+Y "RTN","RMPRPIYI",123,0) S RMPR5("IEN")=RMLOC "RTN","RMPRPIYI",124,0) G:'$D(^RMPR(661.5,RMLOC,0)) ASKLOC "RTN","RMPRPIYI",125,0) ; "RTN","RMPRPIYI",126,0) ITEM ;PSAS Item details. "RTN","RMPRPIYI",127,0) K RMPR11I "RTN","RMPRPIYI",128,0) S RMCHCK=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I) "RTN","RMPRPIYI",129,0) I RMCHCK W !,"*** ERROR IN API RMPRPIX1 !!!!",! X CK1 Q "RTN","RMPRPIYI",130,0) S RMIT=RMPR11("HCPCS-ITEM") "RTN","RMPRPIYI",131,0) S $P(R1(2),U,1)=RMIT S $P(R1(2),U,2)=RMPR11("DESCRIPTION") "RTN","RMPRPIYI",132,0) I RMDAHC=RMHCOLD S DIR("B")=$G(RMIT) "RTN","RMPRPIYI",133,0) ; "RTN","RMPRPIYI",134,0) ;call stock record in 661.7 "RTN","RMPRPIYI",135,0) S RMR("STATION IEN")=RMPR("STA") "RTN","RMPRPIYI",136,0) S RMR("LOCATION IEN")=RMLOC "RTN","RMPRPIYI",137,0) S RMR("HCPCS")=RMHCPC "RTN","RMPRPIYI",138,0) S RMR("ITEM")=RMPR11("ITEM") "RTN","RMPRPIYI",139,0) S RMR("VENDOR IEN")=$P(R1(0),U,9) "RTN","RMPRPIYI",140,0) S RMCHCK=$$STOCK^RMPRPIUE(.RMR) "RTN","RMPRPIYI",141,0) I RMCHCK W !,"*** ERROR IN API RMPRPIUE !!!!",! X CK1 Q "RTN","RMPRPIYI",142,0) S (RMITDES,RMDES)=RMIT K DIC("B"),DIC("S") "RTN","RMPRPIYI",143,0) S RMUBA=RMR("QOH") "RTN","RMPRPIYI",144,0) I RMUBA<1 D LOWBA G 2 "RTN","RMPRPIYI",145,0) ; "RTN","RMPRPIYI",146,0) I $D(RMLOC),$D(RMHCDA) S RMSO=RMPR11I("SOURCE") "RTN","RMPRPIYI",147,0) I $D(RMSO),RMSO="" D MESSO G 2 "RTN","RMPRPIYI",148,0) S:$D(RMSO) $P(R1(0),U,14)=RMSO "RTN","RMPRPIYI",149,0) S $P(R3("D"),U,14)=$S(RMSO="C":"COMMERCIAL",RMSO="V":"VA",1:"") "RTN","RMPRPIYI",150,0) I $P(R1(1),U,4)'="",$D(DUOUT) G LIST^RMPRPIYJ "RTN","RMPRPIYI",151,0) ;I $G(RMLOC),'($G(RMHCDA)&$G(RMITDA)) W !,"PSAS Item was not selected!!" G 2 "RTN","RMPRPIYI",152,0) I $G(RMLOC),$G(RMHCDA) S RMPRUCST=RMR("UNIT COST") "RTN","RMPRPIYI",153,0) I '$G(RMPRUCST) D MESSI G 2 "RTN","RMPRPIYI",154,0) S:$G(REDIT) $P(R1(0),U,16)=RMPRUCST*$P(R1(0),U,7),$P(R3("D"),U,16)=RMPRUCST*$P(R1(0),U,7) "RTN","RMPRPIYI",155,0) K DIC "RTN","RMPRPIYI",156,0) ; "RTN","RMPRPIYI",157,0) CPT ;ask for CPT Modifier "RTN","RMPRPIYI",158,0) D CPT^RMPRPIYS(RMDAHC_"^"_$P(R1(0),U,4)_"^"_$P(R1(0),U,14)_"^"_660) "RTN","RMPRPIYI",159,0) I RMPREXC="T" X CK1 Q "RTN","RMPRPIYI",160,0) I RMPREXC="^" G 2 "RTN","RMPRPIYI",161,0) I RMPREXC="P" G 2 "RTN","RMPRPIYI",162,0) ; "RTN","RMPRPIYI",163,0) VEN ;vendor "RTN","RMPRPIYI",164,0) ;call routine RMPRPIYV for vendor from file 661.6. "RTN","RMPRPIYI",165,0) S $P(R1(1),U,4)=RMDAHC,$P(R1(0),U,22)=$P(^RMPR(661.1,RMDAHC,0),U,4) "RTN","RMPRPIYI",166,0) ;If there is only one vendor use it as a default. "RTN","RMPRPIYI",167,0) K RMPRVEN "RTN","RMPRPIYI",168,0) S RMERR=$$STOCK^RMPRPIUV(.RMR,.RMPRVEN) "RTN","RMPRPIYI",169,0) I RMERR W !,"*** ERROR IN API RMPRPIUV !!!!",! X CK1 Q "RTN","RMPRPIYI",170,0) I RMPRVEN=1 S DIC("B")=$O(RMPRVEN(0)) "RTN","RMPRPIYI",171,0) I $G(REDIT) S DIC("B")=$P(R1(0),U,9) "RTN","RMPRPIYI",172,0) S DIC(0)="AEQM" "RTN","RMPRPIYI",173,0) S DIC("A")="VENDOR: ",DIC=440,DIC("S")="I $D(RMPRVEN(+Y))" "RTN","RMPRPIYI",174,0) D ^DIC I $P(R3("D"),U,9)'=""&$D(DUOUT) G LIST^RMPRPIYJ "RTN","RMPRPIYI",175,0) I $D(DTOUT) X CK1 Q "RTN","RMPRPIYI",176,0) I $D(DUOUT) G 2 "RTN","RMPRPIYI",177,0) I +Y'>0 W !!,?5,$C(7),"This is a required response. Enter '^' to exit",! G VEN "RTN","RMPRPIYI",178,0) S $P(R1(0),U,9)=+Y,$P(R3("D"),U,9)=$P(Y,U,2) K DIC,Y,X "RTN","RMPRPIYI",179,0) G ^RMPRPIYJ "RTN","RMPRPIYI",180,0) ; "RTN","RMPRPIYI",181,0) ; "RTN","RMPRPIYI",182,0) MESSI ;print message if COST is not defined in the inventory (661.5) "RTN","RMPRPIYI",183,0) S:'$D(RMIT) RMIT="" "RTN","RMPRPIYI",184,0) W !!,"***ITEM COST is not define @:" "RTN","RMPRPIYI",185,0) W !," PSAS Item = ",RMIT "RTN","RMPRPIYI",186,0) W !," Location = ",$P($G(^RMPR(661.5,RMLOC,0)),U,1) "RTN","RMPRPIYI",187,0) W !,"***Fix your inventory or use a different PSAS ITEM!!",!! "RTN","RMPRPIYI",188,0) Q "RTN","RMPRPIYI",189,0) ; "RTN","RMPRPIYI",190,0) MESSO ;print message if SOURCE is not defined in the inventory (661.11) "RTN","RMPRPIYI",191,0) W !!,"***PSAS ITEM has no SOURCE at this location..." "RTN","RMPRPIYI",192,0) W !,"***Fix your inventory or use a different PSAS ITEM!!",!! "RTN","RMPRPIYI",193,0) Q "RTN","RMPRPIYI",194,0) ; "RTN","RMPRPIYI",195,0) INACT ;print message if HCPCS is inactive. "RTN","RMPRPIYI",196,0) W !!,"*** You have selected an INACTIVE HCPCS..." "RTN","RMPRPIYI",197,0) W !,"*** Please REMOVE this HCPCS from inventory..." "RTN","RMPRPIYI",198,0) W !,"*** And use a different HCPCS!!!",! "RTN","RMPRPIYI",199,0) Q "RTN","RMPRPIYI",200,0) ; "RTN","RMPRPIYI",201,0) LOWBA ;print message if inventory balance is low. "RTN","RMPRPIYI",202,0) S:'$D(RMUBA) RMUBA="" S:'$D(RMIT) RMIT="" "RTN","RMPRPIYI",203,0) W !!,"*** PSAS Item ",RMIT," balance is = ",RMUBA "RTN","RMPRPIYI",204,0) W !,"*** You are unable to use this PSAS ITEM..." "RTN","RMPRPIYI",205,0) W !,"*** Please use a different HCPCS or PSAS Item !!!!",! "RTN","RMPRPIYI",206,0) Q "RTN","RMPRPIYI",207,0) ; "RTN","RMPRPIYI",208,0) LKP ;print a message if PSAS HCPCS not in PIP or invalid HCPCS. "RTN","RMPRPIYI",209,0) Q:'$G(RMF)!(X=" ") "RTN","RMPRPIYI",210,0) S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","RMPRPIYI",211,0) K RX "RTN","RMPRPIYI",212,0) I $D(RSTCK),$D(^RMPR(661.7,"XSHIDS",RMPR("STA"),X)) S RX=1 "RTN","RMPRPIYI",213,0) I '$D(RSTCK),$D(^RMPR(661.11,"ASHD",RMPR("STA"),X)) S RX=1 "RTN","RMPRPIYI",214,0) I '$G(RX),$D(^RMPR(661.1,"B",X)) D EN^DDIOL("*** Only PSAS HCPCS in PIP can be accessed. Please verify your Location and PSAS HCPCS!!","","!!") "RTN","RMPRPIYI",215,0) K RX "RTN","RMPRPIYI",216,0) Q "RTN","RMPRPIYJ") 0^54^B18204956 "RTN","RMPRPIYJ",1,0) RMPRPIYJ ;HINCIO/RVD-ISSUE FROM STOCK / CONT. ;9/18/02 07:39 "RTN","RMPRPIYJ",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYJ",3,0) ; RVD #61 - pip INVENTORY PHASE IIIa "RTN","RMPRPIYJ",4,0) ; "RTN","RMPRPIYJ",5,0) ;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","RMPRPIYJ",6,0) QTY K DIR,Y S DIR(0)="660,5",DIR("B")=1 S:$P(R1(0),U,7) DIR("B")=$P(R1(0),U,7) "RTN","RMPRPIYJ",7,0) D ^DIR I $P(R1(0),U,7)'=""&$D(DUOUT) G LIST "RTN","RMPRPIYJ",8,0) I $D(DTOUT) X CK2 G ^RMPRPIYI "RTN","RMPRPIYJ",9,0) I $D(DIRUT) G ^RMPRPIYI "RTN","RMPRPIYJ",10,0) I $G(RMUBA),((RMUBA-Y)<0) D LOWBA^RMPRPIYI G 2^RMPRPIYI "RTN","RMPRPIYJ",11,0) S $P(R1(0),U,7)=Y,$P(R1(0),U,16)=Y*RMPRUCST K DIR "RTN","RMPRPIYJ",12,0) ; "RTN","RMPRPIYJ",13,0) DATE ;delivery date is set to today's date "RTN","RMPRPIYJ",14,0) S $P(R1(0),U,12)=DT,Y=DT D DD^%DT S $P(R3("D"),U,12)=Y "RTN","RMPRPIYJ",15,0) ; "RTN","RMPRPIYJ",16,0) SERV ;date of service "RTN","RMPRPIYJ",17,0) S Y=DT D DD^%DT S DIR("B")=Y,DIR("A")="DATE OF SERVICE",DIR(0)="660,39" "RTN","RMPRPIYJ",18,0) I $G(REDIT) S DIR("B")=$P(R1("D"),U,8) "RTN","RMPRPIYJ",19,0) D ^DIR K DIR I $D(DTOUT) X CK2 G ^RMPRPIYI "RTN","RMPRPIYJ",20,0) I $D(DUOUT),$G(REDIT) G LIST "RTN","RMPRPIYJ",21,0) I (X="")!(X="@") W !,"This field is mandatory!!!",! G SERV "RTN","RMPRPIYJ",22,0) S $P(R1(1),U,8)=Y D DD^%DT S $P(R1("D"),U,8)=Y "RTN","RMPRPIYJ",23,0) ; "RTN","RMPRPIYJ",24,0) LI S DIR(0)="660,9" S:$P(R1(0),U,11)'="" DIR("B")=$P(R1(0),U,11) "RTN","RMPRPIYJ",25,0) D ^DIR I $D(DTOUT) X CK1 Q "RTN","RMPRPIYJ",26,0) G:$D(DUOUT) LIST "RTN","RMPRPIYJ",27,0) I X["^" W !,"Jumping not allowed" G LI "RTN","RMPRPIYJ",28,0) I $P(R1(0),U,11)'=""&(X="@") S $P(R1(0),U,11)="" W $C(7),!?5,"Deleted..." H 1 G LOT "RTN","RMPRPIYJ",29,0) S $P(R1(0),U,11)=X "RTN","RMPRPIYJ",30,0) ; "RTN","RMPRPIYJ",31,0) LOT ; "RTN","RMPRPIYJ",32,0) ; "RTN","RMPRPIYJ",33,0) K DIR S DIR(0)="660,21" S:$P(R1(0),U,24)'="" DIR("B")=$P(R1(0),U,24) "RTN","RMPRPIYJ",34,0) D ^DIR I $D(DTOUT) X CK1 Q "RTN","RMPRPIYJ",35,0) G:$D(DUOUT) LIST "RTN","RMPRPIYJ",36,0) I X["^" W !,"Jumping not allowed" G LOT "RTN","RMPRPIYJ",37,0) I $P(R1(0),U,24)'=""&(X="@") S $P(R1(0),U,24)="" W $C(7),!?5,"Deleted..." H 1 G REMA "RTN","RMPRPIYJ",38,0) S $P(R1(0),U,24)=X "RTN","RMPRPIYJ",39,0) ; "RTN","RMPRPIYJ",40,0) REMA ; "RTN","RMPRPIYJ",41,0) ; "RTN","RMPRPIYJ",42,0) K DIR S DIR(0)="660,16" S:$P(R1(0),U,18)'="" DIR("B")=$P(R1(0),U,18) "RTN","RMPRPIYJ",43,0) D ^DIR I $D(DTOUT) X CK1 Q "RTN","RMPRPIYJ",44,0) G:$D(DUOUT) LIST "RTN","RMPRPIYJ",45,0) I X["^" W !,"Jumping not allowed" G REMA "RTN","RMPRPIYJ",46,0) I $P(R1(0),U,18)'=""&(X="@") S $P(R1(0),U,18)="" W $C(7),!?5,"Deleted..." H 1 G LIST "RTN","RMPRPIYJ",47,0) S $P(R1(0),U,18)=X "RTN","RMPRPIYJ",48,0) ; "RTN","RMPRPIYJ",49,0) LIST ;ENTRY POINT FOR STOCK ISSUE ROUTINES TO DISPLAY TRANSACTION DATA "RTN","RMPRPIYJ",50,0) S RMDAHC=$P(R1(1),U,4) "RTN","RMPRPIYJ",51,0) D:$D(RMCPT) CHK^RMPRED5 "RTN","RMPRPIYJ",52,0) D ^RMPRPIYK "RTN","RMPRPIYJ",53,0) K DIR,RQUIT "RTN","RMPRPIYJ",54,0) S DIR(0)="SBO^P:POST;E:EDIT;D:DELETE" "RTN","RMPRPIYJ",55,0) S DIR("A")="Would you like to POST/EDIT/DELETE this entry" "RTN","RMPRPIYJ",56,0) S DIR("B")="P" "RTN","RMPRPIYJ",57,0) S DIR("?")="Answer `P` to post the transaction, `E` to edit the transaction,'D' to delete the transaction" "RTN","RMPRPIYJ",58,0) D ^DIR K DIR G:Y="P" POST G:Y="D" DEA "RTN","RMPRPIYJ",59,0) I Y="E" S REDIT=1 G 1^RMPRPIYI "RTN","RMPRPIYJ",60,0) I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) G ^RMPRPIYI "RTN","RMPRPIYJ",61,0) ; "RTN","RMPRPIYJ",62,0) DEA ; "RTN","RMPRPIYJ",63,0) K DIR "RTN","RMPRPIYJ",64,0) S DIR("A")="Are you sure you want to DELETE this entry" "RTN","RMPRPIYJ",65,0) S DIR("B")="N",DIR(0)="Y" "RTN","RMPRPIYJ",66,0) D ^DIR I $D(DTOUT)!$D(DUOUT)!$D(DIRUT) X CK Q "RTN","RMPRPIYJ",67,0) I Y=1 W !!,$C(7),?50," Deleted..." H 2 K DIR G RES^RMPRPIYI "RTN","RMPRPIYJ",68,0) G LIST "RTN","RMPRPIYJ",69,0) ; "RTN","RMPRPIYJ",70,0) POST ; "RTN","RMPRPIYJ",71,0) I RMPR699("AMIS GROUPER")'="" G GGC "RTN","RMPRPIYJ",72,0) S RMPRAMIS=0 "RTN","RMPRPIYJ",73,0) S RMPR699("IEN")=RMPRSITE "RTN","RMPRPIYJ",74,0) S RMPRAMIS=$$AMGR^RMPRPIX2(.RMPR699) "RTN","RMPRPIYJ",75,0) I RMPRAMIS X CK Q "RTN","RMPRPIYJ",76,0) GGC ; "RTN","RMPRPIYJ",77,0) D SETARR(.RMPR60) "RTN","RMPRPIYJ",78,0) S RMPRERR=$$ISS^RMPRPIU6(.RMPR60,.RMPR11I,.RMPR5) "RTN","RMPRPIYJ",79,0) I RMPRERR=9 D LOWBA^RMPRPIYI G 2^RMPRPIYI "RTN","RMPRPIYJ",80,0) I RMPRERR W !,"*** ERROR in API RMPRPIU6, ERROR = ",RMPRERR," !!!" G EXIT "RTN","RMPRPIYJ",81,0) S ^TMP($J,"RMPRPCE",660,RMPR60("IEN"))=RMPR699("AMIS GROUPER")_"^"_$G(RMPRDFN) "RTN","RMPRPIYJ",82,0) ; "RTN","RMPRPIYJ",83,0) W !,"Posted to 2319..." H 3 "RTN","RMPRPIYJ",84,0) G RES^RMPRPIYI "RTN","RMPRPIYJ",85,0) ; "RTN","RMPRPIYJ",86,0) EXIT ;EXIT FOR STOCK ISSUES "RTN","RMPRPIYJ",87,0) N RMPRSITE,RMPR D KILL^XUSCLEAN "RTN","RMPRPIYJ",88,0) Q "RTN","RMPRPIYJ",89,0) ; "RTN","RMPRPIYJ",90,0) INV1 I $P(R1(0),U,14)="C" S $P(R1(0),U,16)=RMPRUCST*$P(R1(0),U,7) "RTN","RMPRPIYJ",91,0) G QTY "RTN","RMPRPIYJ",92,0) ; "RTN","RMPRPIYJ",93,0) ; Set up arrays for Stock Issue Transaction "RTN","RMPRPIYJ",94,0) SETARR(RMPR60) ; "RTN","RMPRPIYJ",95,0) K RMPR60 "RTN","RMPRPIYJ",96,0) S RMPR60("ENTRY DATE")=$P(R1(0),U,1) "RTN","RMPRPIYJ",97,0) S RMPR60("PATIENT IEN")=$P(R1(0),U,2) "RTN","RMPRPIYJ",98,0) S RMPR60("ISSUE TYPE")=$P(R1(0),U,4) "RTN","RMPRPIYJ",99,0) S RMPR60("QUANTITY")=$P(R1(0),U,7) "RTN","RMPRPIYJ",100,0) S RMPR60("IFCAP ITEM")=$P(R1(0),U,6) "RTN","RMPRPIYJ",101,0) S RMPR60("UNIT")=$P(R1(0),U,8) "RTN","RMPRPIYJ",102,0) S RMPR60("VENDOR IEN")=$P(R1(0),U,9) "RTN","RMPRPIYJ",103,0) S RMPR60("SERIAL NUM")=$P(R1(0),U,11) "RTN","RMPRPIYJ",104,0) S RMPR60("DELIV DATE")=$P(R1(0),U,12) "RTN","RMPRPIYJ",105,0) S RMPR60("DATE OF SERVICE")=$P(R1(1),U,8) "RTN","RMPRPIYJ",106,0) S RMPR60("SOURCE")=$P(R1(0),U,14) "RTN","RMPRPIYJ",107,0) S RMPR60("COST")=$P(R1(0),U,16) "RTN","RMPRPIYJ",108,0) S RMPR60("REMARKS")=$P(R1(0),U,18) "RTN","RMPRPIYJ",109,0) S RMPR60("LOT NUM")=$P(R1(0),U,24) "RTN","RMPRPIYJ",110,0) S RMPR60("HCPCS")=$P(R1(1),U,4) "RTN","RMPRPIYJ",111,0) S RMPR60("CPT IEN")=$P(R1(0),U,22) "RTN","RMPRPIYJ",112,0) S RMPR60("CPT MOD")=$P(R1(1),U,6) "RTN","RMPRPIYJ",113,0) S RMPR60("PAT CAT")=$P(R1("AM"),U,3) "RTN","RMPRPIYJ",114,0) S RMPR60("SPEC CAT")=$P(R1("AM"),U,4) "RTN","RMPRPIYJ",115,0) S RMPR60("USER")=$P(R1(0),U,27) "RTN","RMPRPIYJ",116,0) S RMPR60("SITE IEN")=RMPRSITE "RTN","RMPRPIYJ",117,0) S RMPR60("GROUPER")=RMPR699("AMIS GROUPER") "RTN","RMPRPIYJ",118,0) S RMPR60("DATE&TIME")=R1("DATE&TIME") "RTN","RMPRPIYJ",119,0) Q "RTN","RMPRPIYK") 0^55^B4220635 "RTN","RMPRPIYK",1,0) RMPRPIYK ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;2/10/03 08:41 "RTN","RMPRPIYK",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYK",3,0) ; RVD - patch #61 - pip phase III "RTN","RMPRPIYK",4,0) ; "RTN","RMPRPIYK",5,0) ;DBIA # 800 - global read of file #440. "RTN","RMPRPIYK",6,0) ;DBIA # 801 - global read of file #441. "RTN","RMPRPIYK",7,0) ; "RTN","RMPRPIYK",8,0) W @IOF S $P(HL,"=",IOM-1)="" W !,HL "RTN","RMPRPIYK",9,0) W:'$D(RMPRHISD) !?31,"***STOCK ISSUE***" W:$D(RMPRHISD) !!?31,"***HISTORICAL DATA***" W !!?5,"PATIENT NAME: ",RMPRNAM,?50,"SSN: ",RMPRSSN "RTN","RMPRPIYK",10,0) W !!?5,"TYPE OF TRANSACTION: ",$P(R3("D"),U,4),?43,"SOURCE: ",$P(R3("D"),U,14) "RTN","RMPRPIYK",11,0) W !!?5,"PATIENT CATEGORY: ",$P(R4("D"),U,3),?43,"SPECIAL CATEGORY: ",$P(R4("D"),U,4) "RTN","RMPRPIYK",12,0) W !!?5,"ITEM: ",$E($P(^PRC(441,$P(^RMPR(661,$P(R1(0),U,6),0),U,1),0),U,2),1,30),?43,"VENDOR: " I +$P(R1(0),U,9) W $E($P(^PRC(440,+$P(R1(0),U,9),0),U,1),1,29) "RTN","RMPRPIYK",13,0) I $D(R1(1)),$P(R1(1),U,4)>0 W !!?5,"PSAS HCPCS: ",$P(^RMPR(661.1,$P(R1(1),U,4),0),U,1)," ",$P(^(0),U,2),!!?5,"CPT MODIFIER: ",$P(R1(1),U,6) "RTN","RMPRPIYK",14,0) I $D(R1(2)) W !!?5,"HCPCS/ITEM: ",$P(R1(2),U,1)," ",$P(R1(2),U,2) "RTN","RMPRPIYK",15,0) S:'$D(RMLACO) RMLACO=0 "RTN","RMPRPIYK",16,0) S RUNICOST=$P(R1(0),U,16)/$P(R1(0),U,7) "RTN","RMPRPIYK",17,0) S RTOTCOST=$P(R1(0),U,16)+RMLACO "RTN","RMPRPIYK",18,0) W !!?5,"QUANTITY: ",$P(R1(0),U,7),?23,"UNIT COST: ",$J(RUNICOST,0,2),?43,"TOTAL COST: ",$J(RTOTCOST,0,2) "RTN","RMPRPIYK",19,0) W !!?5,"SERIAL NUMBER: ",$P(R1(0),U,11),?43,"LOT NUMBER: ",$P(R1(0),U,24),!?5,"REMARKS: ",$P(R1(0),U,18) "RTN","RMPRPIYK",20,0) W !?5,"DATE OF SERVICE: ",$P($G(R1("D")),U,8) "RTN","RMPRPIYK",21,0) W ?43,"Inventory Location: " "RTN","RMPRPIYK",22,0) I $G(RMLOC) W $P($G(^RMPR(661.5,RMLOC,0)),U,1) "RTN","RMPRPIYK",23,0) W !,HL "RTN","RMPRPIYK",24,0) K RUNICOST,RTOTCOST "RTN","RMPRPIYK",25,0) Q "RTN","RMPRPIYL") 0^75^B28707505 "RTN","RMPRPIYL",1,0) RMPRPIYL ;HINES OIFO/ODJ - PIP - DL - DEACTIVATE LOCATION ;9/19/02 08:22 "RTN","RMPRPIYL",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYL",3,0) Q "RTN","RMPRPIYL",4,0) ; "RTN","RMPRPIYL",5,0) ;***** DL - Replaces DL option in old PIP (cf RMPR5NDL) "RTN","RMPRPIYL",6,0) ; Callable from VISTA menu, no vars required other than "RTN","RMPRPIYL",7,0) ; global VISTA vars (DUZ, etc) "RTN","RMPRPIYL",8,0) ; "RTN","RMPRPIYL",9,0) DL N RMPRERR,RMPRSTN,RMPRLCN,RMPREXC,RMPR5,RMPR5U,DIR,X,Y,DA "RTN","RMPRPIYL",10,0) I '$D(DUZ) W !,"VISTA User parameter (DUZ) does not exist, can't continue with this option" R RMPRERR:3 G DLX "RTN","RMPRPIYL",11,0) ; "RTN","RMPRPIYL",12,0) ;***** STN - prompt for Site/Station "RTN","RMPRPIYL",13,0) STN S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYL",14,0) I RMPRERR G DLX "RTN","RMPRPIYL",15,0) I RMPREXC'="" G DLX "RTN","RMPRPIYL",16,0) ; "RTN","RMPRPIYL",17,0) ;***** LOCN - prompt for Location "RTN","RMPRPIYL",18,0) LOCN W @IOF,!!,"Deactivate an Inventory Location.....",! "RTN","RMPRPIYL",19,0) W !,"This option requires the electronic signatures of 2 users" "RTN","RMPRPIYL",20,0) W !,"holding the RMPRMANAGER key to be entered before a location" "RTN","RMPRPIYL",21,0) W !,"will be deactivated.",! "RTN","RMPRPIYL",22,0) ; "RTN","RMPRPIYL",23,0) D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIYL",24,0) I RMPREXC="T"!(RMPREXC="^") G DLX "RTN","RMPRPIYL",25,0) I RMPREXC="P" G STN "RTN","RMPRPIYL",26,0) ; "RTN","RMPRPIYL",27,0) ; display stock position and get esigs. to confirm deactivation "RTN","RMPRPIYL",28,0) CHK D STOCK(RMPRSTN("IEN"),RMPR5("IEN")) ;display stock position "RTN","RMPRPIYL",29,0) OSIG I '$$GETO(DUZ) G DLX ;get other signature, exit if not OK "RTN","RMPRPIYL",30,0) ESIG I $D(XQUSER) D "RTN","RMPRPIYL",31,0) . W !!,XQUSER," please..." "RTN","RMPRPIYL",32,0) . Q "RTN","RMPRPIYL",33,0) E D "RTN","RMPRPIYL",34,0) . W !!,$$GETUSR^RMPRPIU0(DUZ)," please..." "RTN","RMPRPIYL",35,0) . Q "RTN","RMPRPIYL",36,0) D SIG^XUSESIG G:X1="" DLX ;get electronic sig. of main user "RTN","RMPRPIYL",37,0) DEL ;delete a location "RTN","RMPRPIYL",38,0) S DIR(0)="Y",DIR("B")="N" "RTN","RMPRPIYL",39,0) W ! "RTN","RMPRPIYL",40,0) S DIR("A")="Are you sure you want to DEACTIVATE this LOCATION (Y/N) " "RTN","RMPRPIYL",41,0) D ^DIR "RTN","RMPRPIYL",42,0) I $D(DTOUT)!$D(DUOUT)!(Y="^")!(Y=0) W !,"Nothing Deactivated.." H 2 G DLX "RTN","RMPRPIYL",43,0) ; "RTN","RMPRPIYL",44,0) ZERO ;***** zeroed all item in a location. "RTN","RMPRPIYL",45,0) ; "RTN","RMPRPIYL",46,0) N RI,RH,RD,RV,R6 "RTN","RMPRPIYL",47,0) S RS=RMPRSTN("IEN") "RTN","RMPRPIYL",48,0) S RL=RMPR5("IEN") "RTN","RMPRPIYL",49,0) S RH="" "RTN","RMPRPIYL",50,0) F S RH=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH)) Q:RH="" F RI=0:0 S RI=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI)) Q:RI'>0 F RD=0:0 S RD=$O(^RMPR(661.7,"XSLHIDS",RS,RL,RH,RI,RD)) Q:RD'>0 D "RTN","RMPRPIYL",51,0) .S RMPR11("STATION")=RS "RTN","RMPRPIYL",52,0) .S RMPR11("STATION IEN")=RS "RTN","RMPRPIYL",53,0) .S RMPR6("QUANTITY")=0 "RTN","RMPRPIYL",54,0) .Q:'$G(RD)!(RD="") "RTN","RMPRPIYL",55,0) .Q:'$D(^RMPR(661.6,"ASLD",RS,RL,RD)) "RTN","RMPRPIYL",56,0) .S R6=$O(^RMPR(661.6,"ASLD",RS,RL,RD,0)) I $D(^RMPR(661.6,R6,0)) S RV=$P(^RMPR(661.6,R6,0),U,12) "RTN","RMPRPIYL",57,0) .Q:'$G(RV) "RTN","RMPRPIYL",58,0) .S RMPR6("VENDOR")=RV "RTN","RMPRPIYL",59,0) .S RMPR6("VENDOR IEN")=RV "RTN","RMPRPIYL",60,0) .S RMPR11("HCPCS")=RH,RMPR11("ITEM")=RI,RMPR5("IEN")=RL "RTN","RMPRPIYL",61,0) .S RMPRERR=$$REC^RMPRPIU9(.RMPR6,.RMPR11,.RMPR5) "RTN","RMPRPIYL",62,0) .I RMPRERR=1 W !!,"*** ERROR IN API RMPRPIU9 ***",! "RTN","RMPRPIYL",63,0) .K R6,RV "RTN","RMPRPIYL",64,0) ; "RTN","RMPRPIYL",65,0) ;***** TRANS - Now deactivate the location "RTN","RMPRPIYL",66,0) TRANS K RMPR5U "RTN","RMPRPIYL",67,0) S RMPR5U("IEN")=RMPR5("IEN") "RTN","RMPRPIYL",68,0) S RMPR5U("STATUS")="I" "RTN","RMPRPIYL",69,0) D NOW^%DTC "RTN","RMPRPIYL",70,0) S RMPR5U("STATUS DATE")=$P(%,".",1) "RTN","RMPRPIYL",71,0) S RMPRERR=$$UPD^RMPRPIX5(.RMPR5U) "RTN","RMPRPIYL",72,0) I 'RMPRERR D "RTN","RMPRPIYL",73,0) . W !,"Location is deactivated" H 2 "RTN","RMPRPIYL",74,0) . Q "RTN","RMPRPIYL",75,0) E D "RTN","RMPRPIYL",76,0) . W !,"There was a problem deactivating the location" H 2 "RTN","RMPRPIYL",77,0) . Q "RTN","RMPRPIYL",78,0) DLX D KILL^XUSCLEAN "RTN","RMPRPIYL",79,0) Q "RTN","RMPRPIYL",80,0) ; "RTN","RMPRPIYL",81,0) ;***** STOCK - get and display the total number of items "RTN","RMPRPIYL",82,0) ; quantity and cost at a location "RTN","RMPRPIYL",83,0) ; "RTN","RMPRPIYL",84,0) STOCK(RMPRSTN,RMPRLCN) ; "RTN","RMPRPIYL",85,0) N RMPRQ,RMPRH,RMPRI,RMPRERR,RMPRIC,RMPRTQ,RMPRTC "RTN","RMPRPIYL",86,0) S RMPRIC=0 ;item count "RTN","RMPRPIYL",87,0) S RMPRTC=0 ;total cost "RTN","RMPRPIYL",88,0) S RMPRTQ=0 ;total quantity "RTN","RMPRPIYL",89,0) S RMPRH="" "RTN","RMPRPIYL",90,0) F S RMPRH=$O(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRLCN,RMPRH)) Q:RMPRH="" D "RTN","RMPRPIYL",91,0) . S RMPRI="" "RTN","RMPRPIYL",92,0) . F S RMPRI=$O(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRLCN,RMPRH,RMPRI)) Q:RMPRI="" D "RTN","RMPRPIYL",93,0) .. K RMPRQ "RTN","RMPRPIYL",94,0) .. S RMPRQ("STATION IEN")=RMPRSTN "RTN","RMPRPIYL",95,0) .. S RMPRQ("LOCATION IEN")=RMPRLCN "RTN","RMPRPIYL",96,0) .. S RMPRQ("HCPCS")=RMPRH "RTN","RMPRPIYL",97,0) .. S RMPRQ("ITEM")=RMPRI "RTN","RMPRPIYL",98,0) .. S RMPRQ("VENDOR IEN")="" "RTN","RMPRPIYL",99,0) .. S RMPRERR=$$STOCK^RMPRPIUE(.RMPRQ) "RTN","RMPRPIYL",100,0) .. S RMPRIC=RMPRIC+1 "RTN","RMPRPIYL",101,0) .. S RMPRTQ=RMPRTQ+RMPRQ("QOH") "RTN","RMPRPIYL",102,0) .. S RMPRTC=RMPRTC+(RMPRQ("QOH")*RMPRQ("UNIT COST")) "RTN","RMPRPIYL",103,0) .. Q "RTN","RMPRPIYL",104,0) . Q "RTN","RMPRPIYL",105,0) W !,"The above location contains "_RMPRIC_" types of items" "RTN","RMPRPIYL",106,0) I RMPRIC=0 D "RTN","RMPRPIYL",107,0) . W "." "RTN","RMPRPIYL",108,0) . Q "RTN","RMPRPIYL",109,0) E D "RTN","RMPRPIYL",110,0) . W ", ",!,"with a total quantity of ",RMPRTQ "RTN","RMPRPIYL",111,0) . W " and cost of $",RMPRTC,"." "RTN","RMPRPIYL",112,0) . Q "RTN","RMPRPIYL",113,0) W ! "RTN","RMPRPIYL",114,0) Q "RTN","RMPRPIYL",115,0) ; "RTN","RMPRPIYL",116,0) ;***** GETO - prompt for a 2nd user's electronic signature "RTN","RMPRPIYL",117,0) GETO(RMPRDUZ) ; "RTN","RMPRPIYL",118,0) N RMPRMGR,RMPROK,RMPRUSR1,RMPRUSR2,X,X1,DUZ,RMPRKEYS "RTN","RMPRPIYL",119,0) W !!,"Pease ask another user with the RMPRMANAGER key to" "RTN","RMPRPIYL",120,0) W !,"enter their user name and electronic signature.",! "RTN","RMPRPIYL",121,0) S RMPROK=0 "RTN","RMPRPIYL",122,0) S RMPRKEYS("RMPRMANAGER")="" "RTN","RMPRPIYL",123,0) S RMPRUSR1("DUZ")=RMPRDUZ "RTN","RMPRPIYL",124,0) I $$GETUSR2(.RMPRUSR2,.RMPRKEYS,.RMPRUSR1)'="" G GETOKX "RTN","RMPRPIYL",125,0) S DUZ=RMPRUSR2("DUZ") "RTN","RMPRPIYL",126,0) W !,RMPRUSR2("NAME")," please..." "RTN","RMPRPIYL",127,0) D SIG^XUSESIG I X1="" G GETOKX "RTN","RMPRPIYL",128,0) S RMPROK=1 "RTN","RMPRPIYL",129,0) GETOKX Q RMPROK "RTN","RMPRPIYL",130,0) ; "RTN","RMPRPIYL",131,0) ; Get 2nd User and ensure they have RMPRMANAGER key "RTN","RMPRPIYL",132,0) GETUSR2(RMPRUSR2,RMPRKEYS,RMPRUSR1) ; "RTN","RMPRPIYL",133,0) N DIC,X,Y,DLAYGO,DTOUT,DUOUT,RMPREXC,RMPRKEY,DUZ "RTN","RMPRPIYL",134,0) S DUZ=RMPRUSR1("DUZ") "RTN","RMPRPIYL",135,0) USR2E K RMPRUSR2 "RTN","RMPRPIYL",136,0) S DIC="^VA(200," "RTN","RMPRPIYL",137,0) S DIC(0)="ABEQ" "RTN","RMPRPIYL",138,0) S DIC("A")="Enter user name of 2nd manager:" "RTN","RMPRPIYL",139,0) D ^DIC "RTN","RMPRPIYL",140,0) I Y=-1 S RMPREXC="^" G USR2X "RTN","RMPRPIYL",141,0) S RMPRUSR2("DUZ")=$P(Y,U,1) "RTN","RMPRPIYL",142,0) ; "RTN","RMPRPIYL",143,0) ; User 2 can't be same as user 1 "RTN","RMPRPIYL",144,0) I RMPRUSR2("DUZ")=RMPRUSR1("DUZ") D G USR2E "RTN","RMPRPIYL",145,0) . W !,"The 2nd manager must be different to the manager logged on." "RTN","RMPRPIYL",146,0) . Q "RTN","RMPRPIYL",147,0) ; "RTN","RMPRPIYL",148,0) ; User 2 must have defined security keys "RTN","RMPRPIYL",149,0) S RMPRKEY="" "RTN","RMPRPIYL",150,0) F S RMPRKEY=$O(RMPRKEYS(RMPRKEY)) Q:RMPRKEY="" Q:$D(^XUSEC(RMPRKEY,RMPRUSR2("DUZ"))) "RTN","RMPRPIYL",151,0) I RMPRKEY="" D G USR2E "RTN","RMPRPIYL",152,0) . W !,"The 2nd manager does not have the correct security key set up." "RTN","RMPRPIYL",153,0) . Q "RTN","RMPRPIYL",154,0) ; "RTN","RMPRPIYL",155,0) ; User 2 verified "RTN","RMPRPIYL",156,0) S RMPRUSR2("NAME")=$P(Y,U,2) "RTN","RMPRPIYL",157,0) S RMPREXC="" "RTN","RMPRPIYL",158,0) USR2X Q RMPREXC "RTN","RMPRPIYM") 0^81^B3660364 "RTN","RMPRPIYM",1,0) RMPRPIYM ;HINCIO/ODJ - PIP RECONCILE OPTION PROMPTS ;3/8/01 "RTN","RMPRPIYM",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYM",3,0) Q "RTN","RMPRPIYM",4,0) ; The following subroutines are a series of prompts called "RTN","RMPRPIYM",5,0) ; by RECONCILE option (UP^RMPRPIYA) "RTN","RMPRPIYM",6,0) ; "RTN","RMPRPIYM",7,0) ;***** OK - Prompt for an OK "RTN","RMPRPIYM",8,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYM",9,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYM",10,0) S RMPREXC="" "RTN","RMPRPIYM",11,0) S RMPRYN="N" "RTN","RMPRPIYM",12,0) S DIR("A")=" ...OK" "RTN","RMPRPIYM",13,0) S DIR("B")="Yes" "RTN","RMPRPIYM",14,0) S DIR(0)="Y" "RTN","RMPRPIYM",15,0) D ^DIR "RTN","RMPRPIYM",16,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYM",17,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYM",18,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIYM",19,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYM",20,0) OKX Q "RTN","RMPRPIYM",21,0) ; "RTN","RMPRPIYM",22,0) ;***** ITEM - Prompt for Item - restrict choice to Location and HCPC "RTN","RMPRPIYM",23,0) ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ; "RTN","RMPRPIYM",24,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN "RTN","RMPRPIYM",25,0) S RMPRERR=0 "RTN","RMPRPIYM",26,0) S RMPREXC="" "RTN","RMPRPIYM",27,0) I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX "RTN","RMPRPIYM",28,0) I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX "RTN","RMPRPIYM",29,0) I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX "RTN","RMPRPIYM",30,0) K RMPR11,RMPR4 "RTN","RMPRPIYM",31,0) S DIR(0)="FOA^1:50" "RTN","RMPRPIYM",32,0) S DIR("A")="Enter ITEM to Reconcile: " "RTN","RMPRPIYM",33,0) S DIR("?")="^D QM^RMPRPIY8" "RTN","RMPRPIYM",34,0) S DIR("??")="^D QQM^RMPRPIY8" "RTN","RMPRPIYM",35,0) ITEMA1 D ^DIR "RTN","RMPRPIYM",36,0) I $D(DTOUT) S RMPREXC="T" G ITEMX "RTN","RMPRPIYM",37,0) I $D(DIROUT) S RMPREXC="P" G ITEMX "RTN","RMPRPIYM",38,0) I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX "RTN","RMPRPIYM",39,0) D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4) "RTN","RMPRPIYM",40,0) I RMPREXC="T" G ITEMX "RTN","RMPRPIYM",41,0) I RMPREXC="P" G ITEMX "RTN","RMPRPIYM",42,0) I RMPREXC="^" G ITEMA1 "RTN","RMPRPIYM",43,0) I RMPR4("IEN")="" D G ITEMA1 "RTN","RMPRPIYM",44,0) . W !,"Cannot locate ITEM with this sequence NUMBER" "RTN","RMPRPIYM",45,0) . Q "RTN","RMPRPIYM",46,0) W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION") "RTN","RMPRPIYM",47,0) D OK(.RMPRYN,.RMPREXC) "RTN","RMPRPIYM",48,0) I RMPRYN'="Y" G ITEMA1 "RTN","RMPRPIYM",49,0) G ITEMX "RTN","RMPRPIYM",50,0) ITEMX Q RMPRERR "RTN","RMPRPIYN") 0^79^B9341297 "RTN","RMPRPIYN",1,0) RMPRPIYN ;HINCIO/ODJ - EL - Edit Location ;3/8/01 "RTN","RMPRPIYN",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYN",3,0) Q "RTN","RMPRPIYN",4,0) ; "RTN","RMPRPIYN",5,0) ;***** EL - Edit Inventory LOCATION "RTN","RMPRPIYN",6,0) ; no inputs required "RTN","RMPRPIYN",7,0) ; other than standard VISTA vars. (DUZ, etc) "RTN","RMPRPIYN",8,0) ; "RTN","RMPRPIYN",9,0) EL N RMPRERR,RMPRSTN,RMPREXC,RMPR5 "RTN","RMPRPIYN",10,0) ; "RTN","RMPRPIYN",11,0) ;***** STN - call prompt for Site/Station "RTN","RMPRPIYN",12,0) STN S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYN",13,0) I RMPRERR G ELX "RTN","RMPRPIYN",14,0) I RMPREXC'="" G ELX "RTN","RMPRPIYN",15,0) ; "RTN","RMPRPIYN",16,0) ;***** LOCN - call prompt for Location "RTN","RMPRPIYN",17,0) LOCN W @IOF,!!,"Editing an Inventory Location.....",! "RTN","RMPRPIYN",18,0) LOCN1 D LOCNM^RMPRPIY7(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIYN",19,0) I RMPREXC="T"!(RMPREXC="^") G ELX "RTN","RMPRPIYN",20,0) I RMPREXC="P" G STN "RTN","RMPRPIYN",21,0) S RMPR5("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYN",22,0) S RMPR5("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYN",23,0) ; "RTN","RMPRPIYN",24,0) ;***** LOCN2 - call prompt to change Location name "RTN","RMPRPIYN",25,0) LOCN2 W ! D EDLOC(.RMPR5,.RMPREXC) "RTN","RMPRPIYN",26,0) I RMPREXC="T" G ELX "RTN","RMPRPIYN",27,0) I RMPREXC'="" G LOCN "RTN","RMPRPIYN",28,0) G ELX "RTN","RMPRPIYN",29,0) ; "RTN","RMPRPIYN",30,0) ;***** exit points "RTN","RMPRPIYN",31,0) ELX D KILL^XUSCLEAN "RTN","RMPRPIYN",32,0) Q "RTN","RMPRPIYN",33,0) ; "RTN","RMPRPIYN",34,0) ;***** EDLOC - prompt for change of Location name "RTN","RMPRPIYN",35,0) EDLOC(RMPR5,RMPREXC) ; "RTN","RMPRPIYN",36,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRNEWN,RMPR5N,RMPRERR "RTN","RMPRPIYN",37,0) S RMPREXC="" "RTN","RMPRPIYN",38,0) S DIR(0)="FOA^3:30" "RTN","RMPRPIYN",39,0) S DIR("A")="LOCATION: " "RTN","RMPRPIYN",40,0) S DIR("B")=RMPR5("NAME") "RTN","RMPRPIYN",41,0) S DIR("?")="Answer must be 3-30 characters in length." "RTN","RMPRPIYN",42,0) S DIR("??")="^D ELQQM^RMPRPIY6" "RTN","RMPRPIYN",43,0) EDLOC1 D ^DIR "RTN","RMPRPIYN",44,0) I $D(DTOUT) S RMPREXC="T" G EDLOCX "RTN","RMPRPIYN",45,0) I $D(DIROUT) S RMPREXC="P" G EDLOCX "RTN","RMPRPIYN",46,0) I X=""!(X["^") S RMPREXC="^" G EDLOCX "RTN","RMPRPIYN",47,0) I X=RMPR5("NAME") G EDLOCX "RTN","RMPRPIYN",48,0) L +^RMPR(661.5,RMPR5("IEN")):0 E D G EDLOCX "RTN","RMPRPIYN",49,0) . W !,"Location being edited by another user, cannot continue." "RTN","RMPRPIYN",50,0) . H 2 "RTN","RMPRPIYN",51,0) . S RMPREXC="P" "RTN","RMPRPIYN",52,0) . Q "RTN","RMPRPIYN",53,0) I $D(^RMPR(661.5,"XSL",RMPR5("STATION"),X)) D G EDLOCU "RTN","RMPRPIYN",54,0) . W !,"Location name already in use, cannot continue.",! "RTN","RMPRPIYN",55,0) . H 2 "RTN","RMPRPIYN",56,0) . S RMPREXC="P" "RTN","RMPRPIYN",57,0) . Q "RTN","RMPRPIYN",58,0) S RMPRNEWN=X "RTN","RMPRPIYN",59,0) D ELOK(.RMPRYN,.RMPREXC) "RTN","RMPRPIYN",60,0) I RMPREXC="T" G EDLOCU "RTN","RMPRPIYN",61,0) I RMPREXC'=""!(RMPRYN="N") S RMPREXC="" L -^RMPR(661.5,RMPR5("IEN")) G EDLOC1 "RTN","RMPRPIYN",62,0) S RMPR5N("IEN")=RMPR5("IEN") "RTN","RMPRPIYN",63,0) S RMPR5N("NAME")=RMPRNEWN "RTN","RMPRPIYN",64,0) S RMPRERR=$$UPD^RMPRPIX5(.RMPR5N) "RTN","RMPRPIYN",65,0) W ! "RTN","RMPRPIYN",66,0) W "Location has been edited from '"_RMPR5("NAME")_"'" "RTN","RMPRPIYN",67,0) W " to '"_RMPRNEWN_"' !!!" "RTN","RMPRPIYN",68,0) H 2 "RTN","RMPRPIYN",69,0) EDLOCU L -^RMPR(661.5,RMPR5("IEN")) "RTN","RMPRPIYN",70,0) EDLOCX Q "RTN","RMPRPIYN",71,0) ELQQM W !,"This is a location of an item or stock being tracked for inventory." "RTN","RMPRPIYN",72,0) Q "RTN","RMPRPIYN",73,0) ; "RTN","RMPRPIYN",74,0) ; Y/N Prompt to confirm change of Location Name "RTN","RMPRPIYN",75,0) ELOK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYN",76,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT "RTN","RMPRPIYN",77,0) S RMPRYN="N" "RTN","RMPRPIYN",78,0) S RMPREXC="" "RTN","RMPRPIYN",79,0) S DIR(0)="Y" "RTN","RMPRPIYN",80,0) S DIR("B")="N" "RTN","RMPRPIYN",81,0) S DIR("A")="Are you sure you want to change the name of this location" "RTN","RMPRPIYN",82,0) D ^DIR "RTN","RMPRPIYN",83,0) I $D(DTOUT) S RMPREXC="T" G ELOKX "RTN","RMPRPIYN",84,0) I $D(DIROUT) S RMPREXC="P" G ELOKX "RTN","RMPRPIYN",85,0) I X=""!(X["^") S RMPREXC="^" G ELOKX "RTN","RMPRPIYN",86,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYN",87,0) ELOKX Q "RTN","RMPRPIYO") 0^56^B24383227 "RTN","RMPRPIYO",1,0) RMPRPIYO ;HIN/RVD-PROS INVENTORY ORDER/RE-ORDER ;5/7/01 "RTN","RMPRPIYO",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYO",3,0) D DIV4^RMPRSIT I $D(Y),(Y<0) K DIC("B") Q "RTN","RMPRPIYO",4,0) S X="NOW" D ^%DT D DD^%DT S RMDAT=Y "RTN","RMPRPIYO",5,0) ; "RTN","RMPRPIYO",6,0) W @IOF "RTN","RMPRPIYO",7,0) ;ask for location "RTN","RMPRPIYO",8,0) W !!,"Ordering ITEM from Supply or Vendor....",! "RTN","RMPRPIYO",9,0) ; "RTN","RMPRPIYO",10,0) HCPC ;ask for HCPCS "RTN","RMPRPIYO",11,0) S RMF=1 "RTN","RMPRPIYO",12,0) K DTOUT,DUOUT,DIC "RTN","RMPRPIYO",13,0) S DIC("A")="Select HCPCS to ORDER: " "RTN","RMPRPIYO",14,0) ; "RTN","RMPRPIYO",15,0) S DIC="^RMPR(661.11,",DIC(0)="AEMNQ" "RTN","RMPRPIYO",16,0) S DIC("S")="S RZ=^RMPR(661.11,+Y,0),RH=$P(RZ,U,1),RI=$P(RZ,U,2),RT=$P(RZ,U,9),RE=$O(^RMPR(661.1,""B"",RH,0)) I $P(^RMPR(661.1,RE,0),U,5),RT'=1,($P(RZ,U,4)=RMPR(""STA""))" "RTN","RMPRPIYO",17,0) S DIC("W")="I $D(^RMPR(661.11,+Y,0)) S RMZ=^RMPR(661.11,+Y,0) W "" "",$P(RMZ,U,7),"" "",$P(RMZ,U,3)" "RTN","RMPRPIYO",18,0) W ! D ^DIC I $D(DUOUT)!$D(DTOUT)!(Y<0) G EXIT "RTN","RMPRPIYO",19,0) S RMHCPC=$P(^RMPR(661.11,+Y,0),U,1) "RTN","RMPRPIYO",20,0) S RMIDA=$P(^RMPR(661.11,+Y,0),U,2) "RTN","RMPRPIYO",21,0) S RMHCDA=$O(^RMPR(661.1,"B",RMHCPC,0)) "RTN","RMPRPIYO",22,0) S RMPR11("HCPCS")=RMHCPC "RTN","RMPRPIYO",23,0) S RMPR11("ITEM")=RMIDA "RTN","RMPRPIYO",24,0) S RMPR11("STATION")=RMPR("STA") "RTN","RMPRPIYO",25,0) ; "RTN","RMPRPIYO",26,0) VEN ;order item from vendor. "RTN","RMPRPIYO",27,0) K DIR,Y S DIR(0)="661.41,4",DIR("A")="Enter Vendor" D ^DIR "RTN","RMPRPIYO",28,0) I $D(DUOUT)!$D(DTOUT) W !,"*** Item was not ordered...." H 1 G HCPC "RTN","RMPRPIYO",29,0) I X="" W $C(7),!,"Enter Vendor from the Vendor file.." G VEN "RTN","RMPRPIYO",30,0) S RMVEN=+Y K DIR,Y "RTN","RMPRPIYO",31,0) ; "RTN","RMPRPIYO",32,0) ; "RTN","RMPRPIYO",33,0) ORDER ;order QUANTITY from vendor or supply. "RTN","RMPRPIYO",34,0) K DIR,Y S DIR(0)="661.41,7",DIR("A")="Quantity to Order" D ^DIR "RTN","RMPRPIYO",35,0) I $D(DUOUT)!$D(DTOUT) W !,"*** Item was not ordered...." H 1 G HCPC "RTN","RMPRPIYO",36,0) I X="" W $C(7),!,"Enter quantity 1 to 99999.." G ORDER "RTN","RMPRPIYO",37,0) S (RMPR6("QUANTITY"),RMORDER)=Y K DIR,Y "RTN","RMPRPIYO",38,0) ; "RTN","RMPRPIYO",39,0) COM ;comments "RTN","RMPRPIYO",40,0) K DIR,Y S DIR(0)="661.41,9",DIR("A")="Enter Comment" D ^DIR "RTN","RMPRPIYO",41,0) I $D(DUOUT)!$D(DTOUT) G HCPC "RTN","RMPRPIYO",42,0) S (RMPR6("COMMENT"),RMCOM)=Y "RTN","RMPRPIYO",43,0) SET6 ;set-up 661.6 data "RTN","RMPRPIYO",44,0) S RMPR6("VENDOR")=$G(RMVEN) "RTN","RMPRPIYO",45,0) S RMPR6("TRAN TYPE")=2 "RTN","RMPRPIYO",46,0) S RMPR6("LOCATION")="" "RTN","RMPRPIYO",47,0) S RMPR6("USER")=$G(DUZ) "RTN","RMPRPIYO",48,0) S RMPR6("VALUE")="" "RTN","RMPRPIYO",49,0) UP6 ;create file 661.6 "RTN","RMPRPIYO",50,0) S RMERR=$$CRE^RMPRPIX6(.RMPR6,.RMPR11) "RTN","RMPRPIYO",51,0) I $G(RMERR) W !,"*** Error in file 661.6 update!!!",! H 2 G HCPC "RTN","RMPRPIYO",52,0) UPD ;update file 661.41 "RTN","RMPRPIYO",53,0) ; "RTN","RMPRPIYO",54,0) ;D UPDATE^DIE("","RMDAT","","RMERR") "RTN","RMPRPIYO",55,0) ;call API for 661.41 "RTN","RMPRPIYO",56,0) L +^RMPR(661.41,"ASSHID",RMPR("STA"),"O",RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIYO",57,0) K RMERR,RMERROR "RTN","RMPRPIYO",58,0) S DIE="^RMPR(661.41," "RTN","RMPRPIYO",59,0) S RMDAT(661.41,"+1,",.01)=DT "RTN","RMPRPIYO",60,0) S RMDAT(661.41,"+1,",1)=RMPR11("ITEM") "RTN","RMPRPIYO",61,0) S RMDAT(661.41,"+1,",2)=RMPR("STA") "RTN","RMPRPIYO",62,0) S RMDAT(661.41,"+1,",4)=RMVEN "RTN","RMPRPIYO",63,0) S RMDAT(661.41,"+1,",5)=RMPR11("HCPCS") "RTN","RMPRPIYO",64,0) S RMDAT(661.41,"+1,",7)=RMORDER "RTN","RMPRPIYO",65,0) S RMDAT(661.41,"+1,",9)=RMCOM "RTN","RMPRPIYO",66,0) S RMDAT(661.41,"+1,",10)="O" "RTN","RMPRPIYO",67,0) D UPDATE^DIE("","RMDAT","","RMERR") I $D(RMERR) S RMERROR=1 "RTN","RMPRPIYO",68,0) L -^RMPR(661.41,"ASSHID",RMPR("STA"),"O",RMPR11("HCPCS"),RMPR11("ITEM")) "RTN","RMPRPIYO",69,0) I $G(RMERROR) W !,"*** Error in file 661.41 update!!!",! "RTN","RMPRPIYO",70,0) I '$G(RMERROR) W !,"*** Item was ordered...." "RTN","RMPRPIYO",71,0) H 1 G HCPC "RTN","RMPRPIYO",72,0) ; "RTN","RMPRPIYO",73,0) ; Prompt if adding a new HCPCS Item "RTN","RMPRPIYO",74,0) OKADD(RMPR11,RMPRYN,RMPREXC) ; "RTN","RMPRPIYO",75,0) N DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYO",76,0) S RMPREXC="",DIR(0)="Y" "RTN","RMPRPIYO",77,0) S DIR("A")="Are you adding '"_RMPR11("DESCRIPTION")_"' as a new ITEM for this HCPCS" "RTN","RMPRPIYO",78,0) D ^DIR "RTN","RMPRPIYO",79,0) I $D(DTOUT) S RMPREXC="T" G ADDNMX "RTN","RMPRPIYO",80,0) I $D(DIROUT) S RMPREXC="P" G ADDNMX "RTN","RMPRPIYO",81,0) I X=""!(X["^") S RMPREXC="^" G ADDNMX "RTN","RMPRPIYO",82,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYO",83,0) S RMPREXC="" "RTN","RMPRPIYO",84,0) ADDNMX Q "RTN","RMPRPIYO",85,0) ; "RTN","RMPRPIYO",86,0) LIKE(RMPRSTN,RMPRHCPC,RMPRTXT,RMPREXC,RMPR11) ; "RTN","RMPRPIYO",87,0) N RMPRMAX,RMPRLIN,RMPRGBL,DIR,X,Y,DA,DTOUT,DIROUT,DIRUT,DUOUT,RMPRA "RTN","RMPRPIYO",88,0) N RMPRERR,RMPRN "RTN","RMPRPIYO",89,0) S RMPREXC="",RMPRMAX=19 "RTN","RMPRPIYO",90,0) S RMPRGBL="^RMPR(661.11,"_"""ASHD"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRTXT_""")" "RTN","RMPRPIYO",91,0) I $D(^RMPR(661.11,"ASHI",RMPRSTN,RMPRHCPC,RMPRTXT)) D G LIKEA "RTN","RMPRPIYO",92,0) . S RMPRA(1)=$O(^RMPR(661.11,"ASHI",RMPR("STA"),RMPRHCPC,RMPRTXT,"")) "RTN","RMPRPIYO",93,0) . W !?5,1,?9,$P(^RMPR(661.11,RMPRA(1),0),"^",2) "RTN","RMPRPIYO",94,0) . Q "RTN","RMPRPIYO",95,0) LIKEA1 K RMPRA S RMPRLIN=0 "RTN","RMPRPIYO",96,0) LIKEA S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYO",97,0) I '$D(RMPRLIN) S RMPRLIN=0 "RTN","RMPRPIYO",98,0) I RMPRGBL="" G LIKEB "RTN","RMPRPIYO",99,0) I $QS(RMPRGBL,1)'=661.11 G LIKEB "RTN","RMPRPIYO",100,0) I $QS(RMPRGBL,2)'="ASHD" G LIKEB "RTN","RMPRPIYO",101,0) I $QS(RMPRGBL,3)'=RMPR("STA") G LIKEB "RTN","RMPRPIYO",102,0) I $QS(RMPRGBL,4)'=RMPRHCPC G LIKEB "RTN","RMPRPIYO",103,0) I $E($QS(RMPRGBL,5),1,$L(RMPRTXT))'=RMPRTXT G LIKEB "RTN","RMPRPIYO",104,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYO",105,0) W !?4,$J(RMPRLIN,2),?9,$QS(RMPRGBL,5) "RTN","RMPRPIYO",106,0) S RMPRA(RMPRLIN)=$QS(RMPRGBL,6) "RTN","RMPRPIYO",107,0) I RMPRLIN'RMPRMAX) D G ITEMP "RTN","RMPRPIYP",50,0) . S DIR("A",1)="Press to see more, '^' to exit this list, or" "RTN","RMPRPIYP",51,0) . Q "RTN","RMPRPIYP",52,0) ITEML2 ; "RTN","RMPRPIYP",53,0) S RMPR11("IEN")=$QS(RMPRGBL,6) "RTN","RMPRPIYP",54,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYP",55,0) I RMPR11("STATUS")="INACTIVE" G ITEML1 "RTN","RMPRPIYP",56,0) S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYP",57,0) I RMPRIMA'=$QS(RMPRGBL,5) D "RTN","RMPRPIYP",58,0) . S RMPRIMAD=RMPR11("ITEM MASTER") "RTN","RMPRPIYP",59,0) . S RMPRIMA=$QS(RMPRGBL,5) "RTN","RMPRPIYP",60,0) . I RMPRLIN=1 Q "RTN","RMPRPIYP",61,0) . W !!,"IFCAP Item: ",RMPRIMAD "RTN","RMPRPIYP",62,0) .; S RMPRLIN=RMPRLIN+2,RMLINE=RMLINE+3 "RTN","RMPRPIYP",63,0) . S RMLINE=RMLINE+3 "RTN","RMPRPIYP",64,0) . Q "RTN","RMPRPIYP",65,0) I RMPRLIN=1 D ITEMH "RTN","RMPRPIYP",66,0) W !,$J(RMPRLIN,2)," ",RMPR11("HCPCS-ITEM") "RTN","RMPRPIYP",67,0) W ?16,$E(RMPR11("SOURCE"))_" "_RMPR11("DESCRIPTION") "RTN","RMPRPIYP",68,0) S RMPRA(RMPRLIN)=RMPR11("IEN") "RTN","RMPRPIYP",69,0) K RMPR11 "RTN","RMPRPIYP",70,0) G ITEML1 "RTN","RMPRPIYP",71,0) ; "RTN","RMPRPIYP",72,0) ; Prompt for selection "RTN","RMPRPIYP",73,0) ITEMP S DIR(0)="NAO" "RTN","RMPRPIYP",74,0) S DIR("A")="Choose 1 - "_RMPRLIN_" : " "RTN","RMPRPIYP",75,0) S (RMPRFLG,RMLINE)=0 "RTN","RMPRPIYP",76,0) D ^DIR "RTN","RMPRPIYP",77,0) I $D(DTOUT) S RMPREXC="T" G ITEMX "RTN","RMPRPIYP",78,0) I $D(DIROUT) S RMPREXC="P" G ITEMX "RTN","RMPRPIYP",79,0) I X="",$D(DIR("A",1)) K DIR("A",1) D ITEMH G ITEML2 "RTN","RMPRPIYP",80,0) ;I X="" S RMPREXC="^" G ITEMX "RTN","RMPRPIYP",81,0) I X["^"!($D(DUOUT)) S RMPREXC="^" G ITEMX "RTN","RMPRPIYP",82,0) I X'="",'$D(RMPRA(X)) S RMPRFLG=1 "RTN","RMPRPIYP",83,0) I X="?"!X="??"!X="???" K RMPRA G REDO "RTN","RMPRPIYP",84,0) I (X="")!(RMPRFLG) D G ITEMP "RTN","RMPRPIYP",85,0) . W !,"Please select an item by entering a line number in range 1 - " "RTN","RMPRPIYP",86,0) . W RMPRLIN_" or '^' to EXIT" "RTN","RMPRPIYP",87,0) . S RMPRFLG=0 "RTN","RMPRPIYP",88,0) . Q "RTN","RMPRPIYP",89,0) S RMPR11("IEN")=RMPRA(X) "RTN","RMPRPIYP",90,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYP",91,0) ITEMX Q "RTN","RMPRPIYP",92,0) ITEME() ; "RTN","RMPRPIYP",93,0) Q:$QS(RMPRGBL,1)'=661.11 1 "RTN","RMPRPIYP",94,0) Q:$QS(RMPRGBL,2)'="ASHI" 1 "RTN","RMPRPIYP",95,0) Q:$QS(RMPRGBL,3)'=RMPRSTN 1 "RTN","RMPRPIYP",96,0) Q:$QS(RMPRGBL,4)'=RMPRHCPC 1 "RTN","RMPRPIYP",97,0) Q 0 "RTN","RMPRPIYP",98,0) ITEMH W !!,"HCPCS: "_RMPRHCPC_" "_RMPR1("SHORT DESC") "RTN","RMPRPIYP",99,0) W !," is associated with more than 1 item, please select one..." "RTN","RMPRPIYP",100,0) W !!,"IFCAP Item: ",RMPRIMAD "RTN","RMPRPIYP",101,0) Q "RTN","RMPRPIYQ") 0^83^B8888131 "RTN","RMPRPIYQ",1,0) RMPRPIYQ ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01 "RTN","RMPRPIYQ",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYQ",3,0) Q "RTN","RMPRPIYQ",4,0) ; The following subroutines are for selecting HCPCS "RTN","RMPRPIYQ",5,0) ; and Inventory Item "RTN","RMPRPIYQ",6,0) ; "RTN","RMPRPIYQ",7,0) ;***** OK - Prompt for an OK "RTN","RMPRPIYQ",8,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYQ",9,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYQ",10,0) S RMPREXC="" "RTN","RMPRPIYQ",11,0) S RMPRYN="N" "RTN","RMPRPIYQ",12,0) S DIR("A")=" ...OK" "RTN","RMPRPIYQ",13,0) S DIR("B")="Yes" "RTN","RMPRPIYQ",14,0) S DIR(0)="Y" "RTN","RMPRPIYQ",15,0) D ^DIR "RTN","RMPRPIYQ",16,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYQ",17,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYQ",18,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIYQ",19,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYQ",20,0) OKX Q "RTN","RMPRPIYQ",21,0) ; "RTN","RMPRPIYQ",22,0) ;***** LOCN - Prompt for Inventory Location based on 661.4 file "RTN","RMPRPIYQ",23,0) ; and a given HCPCS and PIP Item "RTN","RMPRPIYQ",24,0) LOCN(RMPRSTN,RMPR11,RMPR5,RMPREXC) ; "RTN","RMPRPIYQ",25,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR,RMPR4 "RTN","RMPRPIYQ",26,0) N RMPRMAX,RMPRLIN,RMPRGBL,RMPRHCPC,RMPRITEM "RTN","RMPRPIYQ",27,0) S RMPRERR=0 "RTN","RMPRPIYQ",28,0) S RMPREXC="" "RTN","RMPRPIYQ",29,0) S RMPRHCPC=RMPR11("HCPCS") "RTN","RMPRPIYQ",30,0) S RMPRITEM=RMPR11("ITEM") "RTN","RMPRPIYQ",31,0) K RMPR5 "RTN","RMPRPIYQ",32,0) S RMPRMAX=15 "RTN","RMPRPIYQ",33,0) S RMPRLIN=0 "RTN","RMPRPIYQ",34,0) ; "RTN","RMPRPIYQ",35,0) ; See if just 1 location - no need to list if there is "RTN","RMPRPIYQ",36,0) S RMPRGBLR="^RMPR(661.4,""XSHIL"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITEM_""")" "RTN","RMPRPIYQ",37,0) S RMPRGBL=$Q(@RMPRGBLR) "RTN","RMPRPIYQ",38,0) I $$LOCNE() G LOCNX "RTN","RMPRPIYQ",39,0) S RMPR5("IEN")=$QS(RMPRGBL,6) "RTN","RMPRPIYQ",40,0) S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYQ",41,0) I $$LOCNE() S RMPRERR=$$GET^RMPRPIX5(.RMPR5) G LOCNX "RTN","RMPRPIYQ",42,0) ; "RTN","RMPRPIYQ",43,0) ; Selection list of items if more than 1 "RTN","RMPRPIYQ",44,0) S RMPRGBL=RMPRGBLR "RTN","RMPRPIYQ",45,0) LOCNL1 S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYQ",46,0) I $$LOCNE G:'RMPRLIN LOCNX G LOCNP "RTN","RMPRPIYQ",47,0) I RMPRLIN,'(RMPRLIN#RMPRMAX) D G LOCNP "RTN","RMPRPIYQ",48,0) . S DIR("A",1)="Press to see more, '^' to exit this list, or" "RTN","RMPRPIYQ",49,0) . Q "RTN","RMPRPIYQ",50,0) LOCNL2 S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYQ",51,0) I RMPRLIN=1 D LOCNH "RTN","RMPRPIYQ",52,0) S RMPR5("IEN")=$QS(RMPRGBL,6) "RTN","RMPRPIYQ",53,0) S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYQ",54,0) K RMPR4 "RTN","RMPRPIYQ",55,0) S RMPR4("IEN")=$QS(RMPRGBL,7) "RTN","RMPRPIYQ",56,0) I RMPR4("IEN")'="" S RMPRERR=$$GET^RMPRPIX4(.RMPR4) "RTN","RMPRPIYQ",57,0) W !,$J(RMPRLIN,2)," ",$E(RMPR5("NAME"),1,20) "RTN","RMPRPIYQ",58,0) W ?24,$J($G(RMPR4("RE-ORDER QTY")),5) "RTN","RMPRPIYQ",59,0) S RMPRA(RMPRLIN)=RMPR5("IEN") "RTN","RMPRPIYQ",60,0) K RMPR5 "RTN","RMPRPIYQ",61,0) G LOCNL1 "RTN","RMPRPIYQ",62,0) ; "RTN","RMPRPIYQ",63,0) ; Prompt for selection "RTN","RMPRPIYQ",64,0) LOCNP S DIR(0)="FAO" "RTN","RMPRPIYQ",65,0) S DIR("A")="Choose 1 - "_RMPRLIN_" : " "RTN","RMPRPIYQ",66,0) D ^DIR "RTN","RMPRPIYQ",67,0) I $D(DTOUT) S RMPREXC="T" G LOCNX "RTN","RMPRPIYQ",68,0) I $D(DIROUT) S RMPREXC="P" G LOCNX "RTN","RMPRPIYQ",69,0) I X="",$D(DIR("A",1)) K DIR("A",1) D LOCNH G LOCNL2 "RTN","RMPRPIYQ",70,0) I X="" S RMPREXC="^" G LOCNX "RTN","RMPRPIYQ",71,0) I X["^"!($D(DUOUT)) S RMPREXC="^" G LOCNX "RTN","RMPRPIYQ",72,0) I '$D(RMPRA(X)) D G LOCNP "RTN","RMPRPIYQ",73,0) . W !,"Please select a Location by entering a line number in range 1 - " "RTN","RMPRPIYQ",74,0) . W RMPRLIN "RTN","RMPRPIYQ",75,0) . Q "RTN","RMPRPIYQ",76,0) S RMPR5("IEN")=RMPRA(X) "RTN","RMPRPIYQ",77,0) S RMPRERR=$$GET^RMPRPIX5(.RMPR5) "RTN","RMPRPIYQ",78,0) LOCNX Q "RTN","RMPRPIYQ",79,0) LOCNE() ; "RTN","RMPRPIYQ",80,0) Q:$QS(RMPRGBL,1)'=661.4 1 "RTN","RMPRPIYQ",81,0) Q:$QS(RMPRGBL,2)'="XSHIL" 1 "RTN","RMPRPIYQ",82,0) Q:$QS(RMPRGBL,3)'=RMPRSTN 1 "RTN","RMPRPIYQ",83,0) Q:$QS(RMPRGBL,4)'=RMPRHCPC 1 "RTN","RMPRPIYQ",84,0) Q:$QS(RMPRGBL,5)'=RMPRITEM 1 "RTN","RMPRPIYQ",85,0) Q 0 "RTN","RMPRPIYQ",86,0) LOCNH W ! "RTN","RMPRPIYQ",87,0) W !,"Select a Location...",! "RTN","RMPRPIYQ",88,0) W ?3,"Location",?24,"Re-Order Qty." "RTN","RMPRPIYQ",89,0) Q "RTN","RMPRPIYR") 0^84^B13064179 "RTN","RMPRPIYR",1,0) RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01 "RTN","RMPRPIYR",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYR",3,0) Q "RTN","RMPRPIYR",4,0) ; The following subroutines are for selecting HCPCS "RTN","RMPRPIYR",5,0) ; and Inventory Item "RTN","RMPRPIYR",6,0) ; "RTN","RMPRPIYR",7,0) ;***** OK - Prompt for an OK "RTN","RMPRPIYR",8,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYR",9,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYR",10,0) S RMPREXC="" "RTN","RMPRPIYR",11,0) S RMPRYN="N" "RTN","RMPRPIYR",12,0) S DIR("A")=" ...OK" "RTN","RMPRPIYR",13,0) S DIR("B")="Yes" "RTN","RMPRPIYR",14,0) S DIR(0)="Y" "RTN","RMPRPIYR",15,0) D ^DIR "RTN","RMPRPIYR",16,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYR",17,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYR",18,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIYR",19,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYR",20,0) OKX Q "RTN","RMPRPIYR",21,0) ; "RTN","RMPRPIYR",22,0) ;***** PVEN - Prompt for current Stock Record "RTN","RMPRPIYR",23,0) PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ; "RTN","RMPRPIYR",24,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR "RTN","RMPRPIYR",25,0) N RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS "RTN","RMPRPIYR",26,0) S RMPRERR=0 "RTN","RMPRPIYR",27,0) S RMPREXC="" "RTN","RMPRPIYR",28,0) S RMPRMAX=15 "RTN","RMPRPIYR",29,0) S RMPRLIN=0 "RTN","RMPRPIYR",30,0) K RMPR7,RMPR6 "RTN","RMPRPIYR",31,0) S RMPRLCN=$G(RMPRLCN) "RTN","RMPRPIYR",32,0) ; "RTN","RMPRPIYR",33,0) ; See if just 1 record - no need to list if there is "RTN","RMPRPIYR",34,0) S RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")" "RTN","RMPRPIYR",35,0) S RMPRGBL=$Q(@RMPRGBLR) "RTN","RMPRPIYR",36,0) I $$PVENE() G PVENX "RTN","RMPRPIYR",37,0) S RMPR7("IEN")=$QS(RMPRGBL,8) "RTN","RMPRPIYR",38,0) S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYR",39,0) I $$PVENE() G PVENG "RTN","RMPRPIYR",40,0) ; "RTN","RMPRPIYR",41,0) ; Selection list of current stock records "RTN","RMPRPIYR",42,0) S RMPRGBL=RMPRGBLR "RTN","RMPRPIYR",43,0) PVENL1 S RMPRGBL=$Q(@RMPRGBL) "RTN","RMPRPIYR",44,0) I $$PVENE G:'RMPRLIN PVENX G PVENP "RTN","RMPRPIYR",45,0) K RMPR7,RMPR7I "RTN","RMPRPIYR",46,0) S RMPR7("IEN")=$QS(RMPRGBL,8) "RTN","RMPRPIYR",47,0) S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIYR",48,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYR",49,0) I RMPRLCN'="",RMPRLCN'=RMPR7I("LOCATION") G PVENL1 "RTN","RMPRPIYR",50,0) I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PVENP "RTN","RMPRPIYR",51,0) . S DIR("A",1)="Press to see more, '^' to exit this list, or" "RTN","RMPRPIYR",52,0) . Q "RTN","RMPRPIYR",53,0) PVENL2 S RMPRLIN=RMPRLIN+1 "RTN","RMPRPIYR",54,0) I RMPRLIN=1 D PVENH "RTN","RMPRPIYR",55,0) S RMPRS=$P(RMPR7I("DATE&TIME"),".",1) "RTN","RMPRPIYR",56,0) W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3) "RTN","RMPRPIYR",57,0) W ?11,$J(RMPR7("QUANTITY"),5,0) "RTN","RMPRPIYR",58,0) I +RMPR7("QUANTITY") D "RTN","RMPRPIYR",59,0) . W ?18,$J(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2) "RTN","RMPRPIYR",60,0) . Q "RTN","RMPRPIYR",61,0) W ?26,$J(RMPR7("VALUE"),10,2) "RTN","RMPRPIYR",62,0) S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME") "RTN","RMPRPIYR",63,0) S RMPR6("HCPCS")=RMPRHCPC "RTN","RMPRPIYR",64,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIYR",65,0) W ?38,$E(RMPR6("VENDOR"),1,30) "RTN","RMPRPIYR",66,0) W ?69,$E(RMPR7("LOCATION"),1,10) "RTN","RMPRPIYR",67,0) S RMPRA(RMPRLIN)=RMPR7("IEN") "RTN","RMPRPIYR",68,0) K RMPR7,RMPR7I,RMPR6 "RTN","RMPRPIYR",69,0) G PVENL1 "RTN","RMPRPIYR",70,0) ; "RTN","RMPRPIYR",71,0) ; Prompt for selection "RTN","RMPRPIYR",72,0) PVENP S DIR(0)="FAO" "RTN","RMPRPIYR",73,0) S DIR("A")="Choose 1 - "_RMPRLIN_" : " "RTN","RMPRPIYR",74,0) D ^DIR "RTN","RMPRPIYR",75,0) I $D(DTOUT) S RMPREXC="T" G PVENX "RTN","RMPRPIYR",76,0) I $D(DIROUT) S RMPREXC="P" G PVENX "RTN","RMPRPIYR",77,0) I X="",$D(DIR("A",1)) K DIR("A",1) D PVENH G PVENL2 "RTN","RMPRPIYR",78,0) I X="" S RMPREXC="^" G PVENX "RTN","RMPRPIYR",79,0) I X["^"!($D(DUOUT)) S RMPREXC="^" G PVENX "RTN","RMPRPIYR",80,0) I '$D(RMPRA(X)) D G PVENP "RTN","RMPRPIYR",81,0) . W !,"Please select a current stock record" "RTN","RMPRPIYR",82,0) . W !,"by entering a line number in range 1 - " "RTN","RMPRPIYR",83,0) . W RMPRLIN "RTN","RMPRPIYR",84,0) . Q "RTN","RMPRPIYR",85,0) S RMPR7("IEN")=RMPRA(X) "RTN","RMPRPIYR",86,0) PVENG S RMPRERR=$$GET^RMPRPIX7(.RMPR7) "RTN","RMPRPIYR",87,0) K RMPR7I "RTN","RMPRPIYR",88,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYR",89,0) S RMPRLCN=RMPR7I("LOCATION") "RTN","RMPRPIYR",90,0) S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME") "RTN","RMPRPIYR",91,0) S RMPR6("HCPCS")=RMPRHCPC "RTN","RMPRPIYR",92,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIYR",93,0) PVENX Q "RTN","RMPRPIYR",94,0) PVENE() ; "RTN","RMPRPIYR",95,0) Q:$QS(RMPRGBL,1)'=661.7 1 "RTN","RMPRPIYR",96,0) Q:$QS(RMPRGBL,2)'="XSHIDS" 1 "RTN","RMPRPIYR",97,0) Q:$QS(RMPRGBL,3)'=RMPRSTN 1 "RTN","RMPRPIYR",98,0) Q:$QS(RMPRGBL,4)'=RMPRHCPC 1 "RTN","RMPRPIYR",99,0) Q:$QS(RMPRGBL,5)'=RMPRITM 1 "RTN","RMPRPIYR",100,0) Q 0 "RTN","RMPRPIYR",101,0) PVENH W ! "RTN","RMPRPIYR",102,0) W !,"Select a current stock record...",! "RTN","RMPRPIYR",103,0) W ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor" "RTN","RMPRPIYR",104,0) I RMPRLCN="" W ?69,"Location" "RTN","RMPRPIYR",105,0) Q "RTN","RMPRPIYS") 0^85^B84402639 "RTN","RMPRPIYS",1,0) RMPRPIYS ;HINCIO/ODJ - RC - PIP Receive Stock ;10/8/02 13:11 "RTN","RMPRPIYS",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYS",3,0) Q "RTN","RMPRPIYS",4,0) ; "RTN","RMPRPIYS",5,0) ;***** PB - Print Bar Code labels "RTN","RMPRPIYS",6,0) ; RMPR INV BAR CODE "RTN","RMPRPIYS",7,0) ; Callable from VISTA menu, no vars required other than "RTN","RMPRPIYS",8,0) ; global VISTA vars (DUZ, etc) "RTN","RMPRPIYS",9,0) ; "RTN","RMPRPIYS",10,0) PB N RMPRERR,RMPRSTN,RMPRLCN,RMPREXC,RMPR1,RMPR11,RMPROVAL,RMPRNLAB "RTN","RMPRPIYS",11,0) N RMPR6,RMPR7,RMPR7I,RMPRBARC,RMPRITXT,RMPRBCP,RMPRQ,RMPRIOP "RTN","RMPRPIYS",12,0) ; "RTN","RMPRPIYS",13,0) ;***** STN - prompt for Site/Station "RTN","RMPRPIYS",14,0) STN S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIYS",15,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYS",16,0) I RMPRERR G PBX "RTN","RMPRPIYS",17,0) I RMPREXC'="" G PBX "RTN","RMPRPIYS",18,0) I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11 "RTN","RMPRPIYS",19,0) ; "RTN","RMPRPIYS",20,0) ;***** HCPCS - prompt for HCPCS and Item "RTN","RMPRPIYS",21,0) HCPCS W !!,"Print Bar code Labels for current inventory...",! "RTN","RMPRPIYS",22,0) HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIYS",23,0) I RMPREXC="T" G PBX "RTN","RMPRPIYS",24,0) I RMPREXC="P" G STN "RTN","RMPRPIYS",25,0) I RMPREXC="^" D G PBX "RTN","RMPRPIYS",26,0) . W !,"** No HCPCS selected..." H 1 "RTN","RMPRPIYS",27,0) . Q "RTN","RMPRPIYS",28,0) I $G(RMPR11("IEN"))'="" G HCPCS3A "RTN","RMPRPIYS",29,0) HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC) "RTN","RMPRPIYS",30,0) I RMPREXC="T" G PBX "RTN","RMPRPIYS",31,0) I RMPREXC="P"!(RMPREXC="^") G HCPCS "RTN","RMPRPIYS",32,0) HCPCS3A S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYS",33,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYS",34,0) ; "RTN","RMPRPIYS",35,0) ; display selected HCPCS and item and continue "RTN","RMPRPIYS",36,0) HCPCS4 W !!,"HCPCS: "_RMPR1("HCPCS")_" "_RMPR1("SHORT DESC") "RTN","RMPRPIYS",37,0) W !!,"IFCAP Item: ",RMPR11("ITEM MASTER") "RTN","RMPRPIYS",38,0) W !!,"PIP Item desc.: ",RMPR11("DESCRIPTION") "RTN","RMPRPIYS",39,0) ; "RTN","RMPRPIYS",40,0) ;***** CURST - call prompt for current stock record "RTN","RMPRPIYS",41,0) CURST S RMPRLCN="" "RTN","RMPRPIYS",42,0) D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC) "RTN","RMPRPIYS",43,0) I RMPREXC="T" G PBX "RTN","RMPRPIYS",44,0) I RMPREXC="P" G HCPCS3 "RTN","RMPRPIYS",45,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYS",46,0) I '+$G(RMPR7("QUANTITY")) D G HCPCS2 "RTN","RMPRPIYS",47,0) . W !,"This item is not currently in stock.",!! "RTN","RMPRPIYS",48,0) . Q "RTN","RMPRPIYS",49,0) K RMPR7I "RTN","RMPRPIYS",50,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYS",51,0) S RMPRBARC=RMPR11("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2) "RTN","RMPRPIYS",52,0) S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3)) "RTN","RMPRPIYS",53,0) S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM") "RTN","RMPRPIYS",54,0) S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER") "RTN","RMPRPIYS",55,0) S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION") "RTN","RMPRPIYS",56,0) S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2) "RTN","RMPRPIYS",57,0) S RMPRITXT("VENDOR")=RMPR6("VENDOR") "RTN","RMPRPIYS",58,0) S RMPRITXT("LOCATION")=RMPR7("LOCATION") "RTN","RMPRPIYS",59,0) ; "RTN","RMPRPIYS",60,0) ;***** NLAB - call prompt for number of labels to print "RTN","RMPRPIYS",61,0) NLAB S RMPRNLAB=RMPR7("QUANTITY") "RTN","RMPRPIYS",62,0) W ! D NLABP(.RMPRNLAB,RMPR7("QUANTITY"),.RMPREXC) "RTN","RMPRPIYS",63,0) I RMPREXC="T" G PBX "RTN","RMPRPIYS",64,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIYS",65,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYS",66,0) ; "RTN","RMPRPIYS",67,0) ;***** SELP - call prompt for bar code print device "RTN","RMPRPIYS",68,0) SELP D PRINT G HCPCS "RTN","RMPRPIYS",69,0) G HCPCS "RTN","RMPRPIYS",70,0) PBX D KILL^XUSCLEAN "RTN","RMPRPIYS",71,0) Q "RTN","RMPRPIYS",72,0) ; "RTN","RMPRPIYS",73,0) ;***** PRINT - print bar code labels "RTN","RMPRPIYS",74,0) ; requires RMPRNLAB (number of labels) and "RTN","RMPRPIYS",75,0) ; RMPRBCP (bar code printer name) to be set "RTN","RMPRPIYS",76,0) ; RMPRBARC (bar code to print) "RTN","RMPRPIYS",77,0) ; RMPRIOP (the device to open) "RTN","RMPRPIYS",78,0) PRINT I '$D(RMPRNLAB) S RMPRNLAB=1 "RTN","RMPRPIYS",79,0) ;allows queing of bar code labels "RTN","RMPRPIYS",80,0) SELD S %ZIS("A")="Select Bar Code Printer: " "RTN","RMPRPIYS",81,0) S %ZIS("B")="ZEBRA PROSTHETIC" "RTN","RMPRPIYS",82,0) S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX "RTN","RMPRPIYS",83,0) I $G(IOST)'["P-ZEBRA" D ^%ZISC W !!,"** NOT a Zebra Bar Code Printer!!",!! G SELD "RTN","RMPRPIYS",84,0) I '$D(IO("Q")) U IO G PNOW "RTN","RMPRPIYS",85,0) K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYS" "RTN","RMPRPIYS",86,0) S ZTIO=ION,ZTSAVE("RMPRBARC")="",ZTSAVE("RMPRITXT(")="" "RTN","RMPRPIYS",87,0) S ZTSAVE("RMPRNLAB")="",ZTSAVE("RMPR(")="",ZTSAVE("RMPRSTN(")="" "RTN","RMPRPIYS",88,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC "RTN","RMPRPIYS",89,0) ; "RTN","RMPRPIYS",90,0) PNOW ;jump here if not queued. "RTN","RMPRPIYS",91,0) D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB) "RTN","RMPRPIYS",92,0) S IONOFF=1 "RTN","RMPRPIYS",93,0) PRINTC D ^%ZISC K IONOFF "RTN","RMPRPIYS",94,0) PRINTX Q "RTN","RMPRPIYS",95,0) ; "RTN","RMPRPIYS",96,0) ;***** NLABP - Number of labels prompt "RTN","RMPRPIYS",97,0) NLABP(RMPRNLAB,RMPRMAX,RMPREXC) ; "RTN","RMPRPIYS",98,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIYS",99,0) S RMPRNLAB=$G(RMPRNLAB) "RTN","RMPRPIYS",100,0) S RMPRERR=0 "RTN","RMPRPIYS",101,0) S DIR(0)="NAO^1:"_RMPRMAX_":0" "RTN","RMPRPIYS",102,0) S DIR("A")="Number of Labels to print: " "RTN","RMPRPIYS",103,0) S:RMPRNLAB'="" DIR("B")=RMPRNLAB "RTN","RMPRPIYS",104,0) S DIR("??")="^D NLABPH2^RMPRPIYS" "RTN","RMPRPIYS",105,0) D ^DIR "RTN","RMPRPIYS",106,0) I $D(DTOUT) S RMPREXC="T" G NLABPX "RTN","RMPRPIYS",107,0) I $D(DIROUT) S RMPREXC="P" G NLABPX "RTN","RMPRPIYS",108,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G NLABPX "RTN","RMPRPIYS",109,0) S RMPREXC="" "RTN","RMPRPIYS",110,0) S RMPRNLAB=+Y "RTN","RMPRPIYS",111,0) NLABPX Q "RTN","RMPRPIYS",112,0) NLABPH2 W "Type in the number of bar code labels you want to print for the",! "RTN","RMPRPIYS",113,0) W "inventory item you have selected.",! "RTN","RMPRPIYS",114,0) Q "RTN","RMPRPIYS",115,0) ; "RTN","RMPRPIYS",116,0) ;***** BARC - bar code prompt "RTN","RMPRPIYS",117,0) BARC(RMPRBARC,RMPREXC) ; "RTN","RMPRPIYS",118,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA "RTN","RMPRPIYS",119,0) S RMPRBARC="" "RTN","RMPRPIYS",120,0) S RMPREXC="" "RTN","RMPRPIYS",121,0) S RMPRERR=0 "RTN","RMPRPIYS",122,0) S DIR(0)="FAO" "RTN","RMPRPIYS",123,0) S DIR("A")="Scan in item bar code: " "RTN","RMPRPIYS",124,0) S DIR("?")="^D BARCH^RMPRPIYS" "RTN","RMPRPIYS",125,0) BARC1 D ^DIR "RTN","RMPRPIYS",126,0) I $D(DTOUT) S RMPREXC="T" G BARCX "RTN","RMPRPIYS",127,0) I $D(DIROUT) S RMPREXC="P" G BARCX "RTN","RMPRPIYS",128,0) I X["^"!($D(DUOUT)) S RMPREXC="^" G BARCX "RTN","RMPRPIYS",129,0) I X="",$G(REDIT) G BARCX "RTN","RMPRPIYS",130,0) I X="" G BARC1 "RTN","RMPRPIYS",131,0) S RMPRBARC=X "RTN","RMPRPIYS",132,0) BARCX Q "RTN","RMPRPIYS",133,0) BARCH W "If you have access to a bar code scanner, use it to scan the item bar code now.",! "RTN","RMPRPIYS",134,0) W "Don't press the [Enter] key as the scanner should do this automatically.",! "RTN","RMPRPIYS",135,0) W "If the scanner cannot read the bar code, type in the character sequence",! "RTN","RMPRPIYS",136,0) W "immediately below the bar code.",! "RTN","RMPRPIYS",137,0) ;W "If there is no bar code or you prefer to enter the transaction manually",! "RTN","RMPRPIYS",138,0) ;W "leave this prompt blank.",! "RTN","RMPRPIYS",139,0) Q "RTN","RMPRPIYS",140,0) ; "RTN","RMPRPIYS",141,0) ;***** SCAN - scan bar code and set up stock issue vars. "RTN","RMPRPIYS",142,0) ; (to be called by RMPRPIYI (too big)) "RTN","RMPRPIYS",143,0) SCAN K RMPR7,RMPR7I,RMPR1,RMPR1I,RMPR11,RMPR11I,RMPR6,RMDAHC "RTN","RMPRPIYS",144,0) SCAN1 D BARC(.RMPRBARC,.RMPREXC) "RTN","RMPRPIYS",145,0) I RMPREXC'="" S RMPRBARC="" G SCANX "RTN","RMPRPIYS",146,0) I RMPRBARC="" G SCANX "RTN","RMPRPIYS",147,0) S RMPRBARC=$$UPCASE(RMPRBARC) "RTN","RMPRPIYS",148,0) ; "RTN","RMPRPIYS",149,0) ; If we get a good bar code then populate all the fields and go "RTN","RMPRPIYS",150,0) ; straight to the Post/Edit prompt "RTN","RMPRPIYS",151,0) K RMPR7 "RTN","RMPRPIYS",152,0) S (RMPR7("STATION"),RMPRSTN)=RMPR("STA") "RTN","RMPRPIYS",153,0) S RMPR7("HCPCS")=$P(RMPRBARC,"-",1) "RTN","RMPRPIYS",154,0) S RMDAHC=$O(^RMPR(661.1,"B",RMPR7("HCPCS"),0)) "RTN","RMPRPIYS",155,0) I $G(RMDAHC),$D(^RMPR(661.1,RMDAHC,0)),($P(^RMPR(661.1,RMDAHC,0),U,5)'=1) S RMDAHC=$P(^RMPR(661.1,RMDAHC,0),U,3) "RTN","RMPRPIYS",156,0) I '$G(RMDAHC) W !,"** No HCPCS Selected or Unable to Select Inactive HCPCS..." G SCAN "RTN","RMPRPIYS",157,0) S RMPR7("DATE&TIME")=$E($P(RMPRBARC,"-",2),1,7)_"."_$E($P(RMPRBARC,"-",2),8,$L(RMPRBARC)) "RTN","RMPRPIYS",158,0) ; "RTN","RMPRPIYS",159,0) ; look up current stock record with bar coded key fields "RTN","RMPRPIYS",160,0) S RMPRERR=$$SCAN^RMPRPIUA(.RMPR7,.RMPREXC) "RTN","RMPRPIYS",161,0) I $G(RMPR7("IEN"))="" W !,"*** The Item scanned is not available, please update your inventory !!!" G SCAN1 "RTN","RMPRPIYS",162,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",163,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYS",164,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",165,0) S R1("DATE&TIME")=$G(RMPR7I("DATE&TIME")) "RTN","RMPRPIYS",166,0) S $P(R1(0),U,8)=$G(RMPR7I("UNIT")) "RTN","RMPRPIYS",167,0) ; "RTN","RMPRPIYS",168,0) ; set vars. for HCPCS "RTN","RMPRPIYS",169,0) K RMPR1,RMPR1I "RTN","RMPRPIYS",170,0) S RMPR1("HCPCS")=RMPR7("HCPCS") "RTN","RMPRPIYS",171,0) S RMPRERR=$$HPACT^RMPRPIX1(.RMPR1) "RTN","RMPRPIYS",172,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",173,0) S RMPRERR=$$HPETOI^RMPRPIX1(.RMPR1,.RMPR1I) "RTN","RMPRPIYS",174,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",175,0) ; "RTN","RMPRPIYS",176,0) ; set vars. for Item "RTN","RMPRPIYS",177,0) K RMPR11,RMPR11I "RTN","RMPRPIYS",178,0) S RMPR11("STATION")=RMPR("STA") "RTN","RMPRPIYS",179,0) S RMPR11("HCPCS")=RMPR7("HCPCS") "RTN","RMPRPIYS",180,0) S RMPR11("ITEM")=RMPR7("ITEM") "RTN","RMPRPIYS",181,0) S RMPRERR=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYS",182,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",183,0) S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I) "RTN","RMPRPIYS",184,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",185,0) I RMPR11I("ITEM MASTER IEN")="" D G SCAN1 "RTN","RMPRPIYS",186,0) . W !,"This item is not associated with an IFCAP Item.",! "RTN","RMPRPIYS",187,0) . W "Please use the Edit Inventory option before trying to issue this item." "RTN","RMPRPIYS",188,0) . W ! "RTN","RMPRPIYS",189,0) . Q "RTN","RMPRPIYS",190,0) ;S RMDAHC=RMPR1("IEN") "RTN","RMPRPIYS",191,0) D CPT(RMDAHC_"^"_$P(R1(0),U,4)_"^"_RMPR11I("SOURCE")_"^660") "RTN","RMPRPIYS",192,0) I RMPREXC="T" G SCANX "RTN","RMPRPIYS",193,0) I RMPREXC'="" G SCAN1 "RTN","RMPRPIYS",194,0) ; "RTN","RMPRPIYS",195,0) ; get Vendor "RTN","RMPRPIYS",196,0) S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME") "RTN","RMPRPIYS",197,0) S RMPR6("HCPCS")=RMPR7("HCPCS") "RTN","RMPRPIYS",198,0) S RMPR6("SEQUENCE")=RMPR7("SEQUENCE") "RTN","RMPRPIYS",199,0) S RMPRERR=$$GET^RMPRPIX6(.RMPR6) "RTN","RMPRPIYS",200,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",201,0) S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIYS",202,0) I RMPRERR D SCANE G SCAN1 "RTN","RMPRPIYS",203,0) S $P(R1(0),U,9)=RMPR6("VENDOR IEN") "RTN","RMPRPIYS",204,0) S $P(R3("D"),U,9)=RMPR6("VENDOR") "RTN","RMPRPIYS",205,0) ; "RTN","RMPRPIYS",206,0) ; set vars for issue "RTN","RMPRPIYS",207,0) S RMCPTC="" "RTN","RMPRPIYS",208,0) I $G(RMDAHC),$D(^RMPR(661.1,RMDAHC,0)) S RMCPTC=$P(^RMPR(661.1,RMDAHC,0),U,4) "RTN","RMPRPIYS",209,0) S $P(R1(1),U,4)=RMDAHC "RTN","RMPRPIYS",210,0) S $P(R1(0),U,22)=$G(RMCPTC) "RTN","RMPRPIYS",211,0) S $P(R1(0),U,6)=RMPR11I("ITEM MASTER IEN") "RTN","RMPRPIYS",212,0) S (RMHCNEW,RMHCDA)=RMDAHC "RTN","RMPRPIYS",213,0) S RMITDA=RMPR11("IEN") "RTN","RMPRPIYS",214,0) S RMHCPC=RMPR11("HCPCS") "RTN","RMPRPIYS",215,0) S RMIT=RMPR11("HCPCS-ITEM") "RTN","RMPRPIYS",216,0) S RDESC=RMPR1("SHORT DESC") "RTN","RMPRPIYS",217,0) S $P(R3("D"),U,14)=RMPR11("SOURCE") "RTN","RMPRPIYS",218,0) S RMSO=RMPR11I("SOURCE") "RTN","RMPRPIYS",219,0) S $P(R1(0),U,14)=RMSO "RTN","RMPRPIYS",220,0) S $P(R3("D"),U,6)=RMPR11("ITEM MASTER") "RTN","RMPRPIYS",221,0) S $P(R1(0),U,6)=RMPR11I("ITEM MASTER IEN") "RTN","RMPRPIYS",222,0) S $P(R1(2),U,1)=RMIT "RTN","RMPRPIYS",223,0) S $P(R1(2),U,2)=RMPR11("DESCRIPTION") "RTN","RMPRPIYS",224,0) S RMLOC=RMPR7I("LOCATION"),RMUBA=0,RMPR11("ITEM")=$P(RMIT,"-",2) "RTN","RMPRPIYS",225,0) S RMPR11("LOCATION")=RMLOC,RMPR11("STATION")=RMPRSTN "RTN","RMPRPIYS",226,0) I '$G(RMPR11("LOCATION")) S RMUBA=RMPR7("QUANTITY") "RTN","RMPRPIYS",227,0) S:'$G(RMUBA) RMUBA=$$BAL^RMPRPIX7(.RMPR11) "RTN","RMPRPIYS",228,0) K RMPR5 "RTN","RMPRPIYS",229,0) S RMPR5("IEN")=RMLOC "RTN","RMPRPIYS",230,0) S RMPRUCST=RMPR7("VALUE")/RMPR7("QUANTITY") "RTN","RMPRPIYS",231,0) S $P(R1(0),U,16)=$J(RMPRUCST,0,2) "RTN","RMPRPIYS",232,0) S $P(R3("D"),U,16)=$J(RMPRUCST,0,2) "RTN","RMPRPIYS",233,0) S $P(R1(0),U,7)=1 ;qty. "RTN","RMPRPIYS",234,0) S $P(R1(0),U,11)="" ;serial num "RTN","RMPRPIYS",235,0) S $P(R1(0),U,24)="" ;lot num "RTN","RMPRPIYS",236,0) S $P(R1(0),U,18)="" ;remarks "RTN","RMPRPIYS",237,0) SCANX Q "RTN","RMPRPIYS",238,0) SCANE W !,"A problem has occurred with the scan, please try again.",! "RTN","RMPRPIYS",239,0) Q "RTN","RMPRPIYS",240,0) ; "RTN","RMPRPIYS",241,0) ;***** CPT - prompt for CPT modifier "RTN","RMPRPIYS",242,0) ; (extension of RMPRPIYI and to be used only by that routine) "RTN","RMPRPIYS",243,0) CPT(RDA) ; "RTN","RMPRPIYS",244,0) N DIC,Y,RQUIT,X,DA,DIR,DUOUT,DTOUT "RTN","RMPRPIYS",245,0) N RMPR1,RMPR11,RMPR11I,RMPR7,RMPR7I "RTN","RMPRPIYS",246,0) S RMPREXC="" "RTN","RMPRPIYS",247,0) D:$D(RMCPT) CHK^RMPRED5 "RTN","RMPRPIYS",248,0) W:$G(REDIT) !,"OLD CPT MODIFIER: ",$P(R1(1),U,6) "RTN","RMPRPIYS",249,0) I RMHCOLD'=RMDAHC D CPT^RMPRCPTU(RDA) "RTN","RMPRPIYS",250,0) I $D(DUOUT) S RMPREXC="^" G CPTX "RTN","RMPRPIYS",251,0) I $D(DTOUT) S RMPREXC="T" G CPTX "RTN","RMPRPIYS",252,0) S $P(R1(1),U,6)=$G(RMCPT) "RTN","RMPRPIYS",253,0) W:$G(REDIT) !,"NEW CPT MODIFIER: ",$G(RMCPT) "RTN","RMPRPIYS",254,0) I RMHCOLD'="",(RMHCOLD=RMDAHC),$G(REDIT) D "RTN","RMPRPIYS",255,0) .S DIR(0)="Y",DIR("A")="Would you like to Edit CPT MODIFIER Entry ",DIR("B")="N" D ^DIR Q:$D(DTOUT)!$D(DUOUT) "RTN","RMPRPIYS",256,0) .I $G(Y) D "RTN","RMPRPIYS",257,0) ..D CPT^RMPRCPTU(RDA) "RTN","RMPRPIYS",258,0) ..I $D(DUOUT) S RMPREXC="^" "RTN","RMPRPIYS",259,0) ..I $D(DTOUT) S RMPREXC="T" "RTN","RMPRPIYS",260,0) ..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",! "RTN","RMPRPIYS",261,0) ..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",$G(RMCPT) "RTN","RMPRPIYS",262,0) ..S $P(R1(1),U,6)=$G(RMCPT) "RTN","RMPRPIYS",263,0) CPTX Q "RTN","RMPRPIYS",264,0) UPCASE(RMPRSTR) ; "RTN","RMPRPIYS",265,0) Q $TR(RMPRSTR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","RMPRPIYT") 0^57^B12442922 "RTN","RMPRPIYT",1,0) RMPRPIYT ;HINCIO/ODJ - TR - Transfer Items ;3/8/01 "RTN","RMPRPIYT",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYT",3,0) Q "RTN","RMPRPIYT",4,0) ; "RTN","RMPRPIYT",5,0) ;***** TR - Replaces TR option in old PIP (RMPR5NTU) "RTN","RMPRPIYT",6,0) ; Callable from VISTA menu, no vars required other than "RTN","RMPRPIYT",7,0) ; global VISTA vars (DUZ, etc) "RTN","RMPRPIYT",8,0) TR N RMPRERR,RMPRSTN,RMPREXC,RMPR5F,RMPR5T,RMPR1,RMPR11,RMPR,RMPRQTY "RTN","RMPRPIYT",9,0) N RMPRVI,RMPRVO,RMPRVNDR,RMPROVAL,RMPRLCN,RMPR6,RMPR7 "RTN","RMPRPIYT",10,0) ; "RTN","RMPRPIYT",11,0) ;***** STN - Prompt for Station "RTN","RMPRPIYT",12,0) STN S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIYT",13,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYT",14,0) I RMPRERR G TRX "RTN","RMPRPIYT",15,0) I RMPREXC'="" G TRX "RTN","RMPRPIYT",16,0) I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11 "RTN","RMPRPIYT",17,0) ; "RTN","RMPRPIYT",18,0) ;***** HCPCS - prompt for HCPCS and Item "RTN","RMPRPIYT",19,0) HCPCS W !!,"Transfer item quantity to another location.",! "RTN","RMPRPIYT",20,0) HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC) "RTN","RMPRPIYT",21,0) I RMPREXC="T" G TRX "RTN","RMPRPIYT",22,0) I RMPREXC="P" G STN "RTN","RMPRPIYT",23,0) I RMPREXC="^" D G TRX "RTN","RMPRPIYT",24,0) . W !,"** No HCPCS selected." H 1 "RTN","RMPRPIYT",25,0) . Q "RTN","RMPRPIYT",26,0) ;I $G(RMPR11("IEN"))'="" D G QTY "RTN","RMPRPIYT",27,0) HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC) "RTN","RMPRPIYT",28,0) I RMPREXC="T" G TRX "RTN","RMPRPIYT",29,0) I RMPREXC="P"!(RMPREXC="^") G HCPCS "RTN","RMPRPIYT",30,0) S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYT",31,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYT",32,0) ; "RTN","RMPRPIYT",33,0) ; display selected HCPCS and item and continue "RTN","RMPRPIYT",34,0) HCPCS4 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC")) "RTN","RMPRPIYT",35,0) W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER")) "RTN","RMPRPIYT",36,0) W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIYT",37,0) ; "RTN","RMPRPIYT",38,0) ;***** CURST - call prompt for current stock record "RTN","RMPRPIYT",39,0) CURST S RMPRLCN="" "RTN","RMPRPIYT",40,0) D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC) "RTN","RMPRPIYT",41,0) I RMPREXC="T" G TRX "RTN","RMPRPIYT",42,0) I RMPREXC="P" W ! G HCPCS2 "RTN","RMPRPIYT",43,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYT",44,0) S RMPR5F("IEN")=RMPRLCN "RTN","RMPRPIYT",45,0) S RMPRERR=$$GET^RMPRPIX5(.RMPR5F) "RTN","RMPRPIYT",46,0) S RMPR5F("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYT",47,0) S RMPR5T("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIYT",48,0) S RMPR5F("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYT",49,0) W ! "RTN","RMPRPIYT",50,0) ; "RTN","RMPRPIYT",51,0) ;***** QTY - Prompt for Quantity "RTN","RMPRPIYT",52,0) QTY S RMPRERR=$$QTY^RMPRPIYU(.RMPRQTY,.RMPREXC,.RMPR5F,.RMPR11) "RTN","RMPRPIYT",53,0) I RMPREXC="T" G TRX "RTN","RMPRPIYT",54,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYT",55,0) I RMPREXC="P" G CURST "RTN","RMPRPIYT",56,0) ; "RTN","RMPRPIYT",57,0) ;***** TLOCN - Prompt for 'TO' Location "RTN","RMPRPIYT",58,0) TLOCN D LOCNM^RMPRPIYU(RMPRSTN("IEN"),.RMPR5T,.RMPREXC) "RTN","RMPRPIYT",59,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIYT",60,0) I RMPREXC="T" D G TRX "RTN","RMPRPIYT",61,0) . W !,"*** Nothing transferred." "RTN","RMPRPIYT",62,0) . H 1 "RTN","RMPRPIYT",63,0) . Q "RTN","RMPRPIYT",64,0) I RMPREXC="P" G QTY "RTN","RMPRPIYT",65,0) S RMPR5T("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYT",66,0) I RMPR5F("IEN")=RMPR5T("IEN") D G TLOCN "RTN","RMPRPIYT",67,0) . W ! "RTN","RMPRPIYT",68,0) . W "*** Forwarding and Receiving Location is the same!!!!" "RTN","RMPRPIYT",69,0) . Q "RTN","RMPRPIYT",70,0) ; "RTN","RMPRPIYT",71,0) ;***** TRANS - Now create a transfer transaction "RTN","RMPRPIYT",72,0) TRANS S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIYT",73,0) S RMPR("QUANTITY")=RMPRQTY "RTN","RMPRPIYT",74,0) S RMPR("USER")=$G(DUZ) "RTN","RMPRPIYT",75,0) S RMPR("IEN")=$G(RMPR5T("IEN")) "RTN","RMPRPIYT",76,0) S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYT",77,0) S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6) "RTN","RMPRPIYT",78,0) I RMPRERR=1 G HCPCS "RTN","RMPRPIYT",79,0) S RMPR("VENDOR IEN")=RMPR6("VENDOR IEN") "RTN","RMPRPIYT",80,0) S RMPR5F("UNIT")=RMPR7I("UNIT") "RTN","RMPRPIYT",81,0) S RMPR5T("UNIT")=RMPR7I("UNIT") "RTN","RMPRPIYT",82,0) S RMPRERR=$$TRNF^RMPRPIUT(.RMPR,.RMPR5F,.RMPR5T,.RMPR11) "RTN","RMPRPIYT",83,0) I RMPRERR=1 D G QTY "RTN","RMPRPIYT",84,0) . W ! "RTN","RMPRPIYT",85,0) . W "Quantity to transfer is greater than current balance: " "RTN","RMPRPIYT",86,0) . W RMPR("QOH") "RTN","RMPRPIYT",87,0) . Q "RTN","RMPRPIYT",88,0) I RMPRERR D G TRX "RTN","RMPRPIYT",89,0) . W ! "RTN","RMPRPIYT",90,0) . W "There were problems with the transfer, please contact support" "RTN","RMPRPIYT",91,0) . H 3 "RTN","RMPRPIYT",92,0) . Q "RTN","RMPRPIYT",93,0) W ! "RTN","RMPRPIYT",94,0) W "QTY "_RMPRQTY_" transferred from "_RMPR5F("NAME")_" to "_RMPR5T("NAME") "RTN","RMPRPIYT",95,0) H 1 "RTN","RMPRPIYT",96,0) K RMPR5F,RMPR5T,RMPRQTY,RMPR,RMPR6,RMPR7 "RTN","RMPRPIYT",97,0) G HCPCS "RTN","RMPRPIYT",98,0) TRX D KILL^XUSCLEAN "RTN","RMPRPIYT",99,0) Q "RTN","RMPRPIYU") 0^58^B8685929 "RTN","RMPRPIYU",1,0) RMPRPIYU ;HINCIO/ODJ - PIP Data Prompts;3/8/01 "RTN","RMPRPIYU",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYU",3,0) ;DBIA #800 "RTN","RMPRPIYU",4,0) Q "RTN","RMPRPIYU",5,0) ; "RTN","RMPRPIYU",6,0) ;***** QTY - Prompt for Quantity (Transfer Option RMPRPIYT) "RTN","RMPRPIYU",7,0) QTY(RMPRQTY,RMPREXC,RMPR5,RMPR11) ; "RTN","RMPRPIYU",8,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA,RMPRSTK "RTN","RMPRPIYU",9,0) S RMPRQTY=$G(RMPRQTY) "RTN","RMPRPIYU",10,0) S RMPREXC="" "RTN","RMPRPIYU",11,0) S RMPRERR=0 "RTN","RMPRPIYU",12,0) S RMPRSTK("STATION IEN")=RMPR11("STATION IEN") "RTN","RMPRPIYU",13,0) S RMPRSTK("HCPCS")=RMPR11("HCPCS") "RTN","RMPRPIYU",14,0) S RMPRSTK("ITEM")=RMPR11("ITEM") "RTN","RMPRPIYU",15,0) S RMPRSTK("LOCATION IEN")=RMPR5("IEN") "RTN","RMPRPIYU",16,0) S RMPRSTK("VENDOR IEN")="" "RTN","RMPRPIYU",17,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPRSTK) "RTN","RMPRPIYU",18,0) I +RMPRSTK("QOH")<1 S RMPRERR=99 G QTYX "RTN","RMPRPIYU",19,0) S DIR(0)="NAO^1:"_+RMPRSTK("QOH")_":0" "RTN","RMPRPIYU",20,0) S DIR("A")="Enter Quantity to transfer: " "RTN","RMPRPIYU",21,0) S DIR("?")="^D QM^RMPRPIYU" "RTN","RMPRPIYU",22,0) D ^DIR "RTN","RMPRPIYU",23,0) I $D(DTOUT) S RMPREXC="T" G QTYX "RTN","RMPRPIYU",24,0) I $D(DIROUT) S RMPREXC="P" G QTYX "RTN","RMPRPIYU",25,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G QTYX "RTN","RMPRPIYU",26,0) S RMPRQTY=Y "RTN","RMPRPIYU",27,0) S RMPREXC="" "RTN","RMPRPIYU",28,0) QTYX Q RMPRERR "RTN","RMPRPIYU",29,0) ; "RTN","RMPRPIYU",30,0) ; On help get current stock and display "RTN","RMPRPIYU",31,0) ; only call from QTY^RMPRPIYU "RTN","RMPRPIYU",32,0) QM N RMPRERR "RTN","RMPRPIYU",33,0) S RMPRERR=$$STOCK^RMPRPIUE(.RMPRSTK) "RTN","RMPRPIYU",34,0) W !,"Current balance is = "_RMPRSTK("QOH") "RTN","RMPRPIYU",35,0) W !,"Enter quantity 1 to "_RMPRSTK("QOH")_" or enter '^' to QUIT?" "RTN","RMPRPIYU",36,0) Q "RTN","RMPRPIYU",37,0) ; "RTN","RMPRPIYU",38,0) ;***** VEND - prompt for Vendor (Transfer option RMPRPIYT) "RTN","RMPRPIYU",39,0) VEND(RMPRV,RMPRVNDR,RMPREXC) ; "RTN","RMPRPIYU",40,0) N DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYU",41,0) S RMPREXC="" "RTN","RMPRPIYU",42,0) S DIC(0)="AEQM" "RTN","RMPRPIYU",43,0) S DIC("A")="Vendor: " "RTN","RMPRPIYU",44,0) S DIC=440 "RTN","RMPRPIYU",45,0) S DIC("S")="I $D(RMPRV(+Y))" "RTN","RMPRPIYU",46,0) D ^DIC "RTN","RMPRPIYU",47,0) I $D(DTOUT) S RMPREXC="T" G VENDX "RTN","RMPRPIYU",48,0) I $D(DIROUT) S RMPREXC="P" G VENDX "RTN","RMPRPIYU",49,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G VENDX "RTN","RMPRPIYU",50,0) S RMPRVNDR=+Y "RTN","RMPRPIYU",51,0) VENDX Q "RTN","RMPRPIYU",52,0) ; "RTN","RMPRPIYU",53,0) ;***** LOCNM - Prompt for transfer 'To' location "RTN","RMPRPIYU",54,0) ; must be in 661.5 and active "RTN","RMPRPIYU",55,0) LOCNM(RMPRSTN,RMPR5,RMPREXC) ; "RTN","RMPRPIYU",56,0) N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT "RTN","RMPRPIYU",57,0) S RMPREXC="" "RTN","RMPRPIYU",58,0) S RMPRERR=0 "RTN","RMPRPIYU",59,0) S DIR(0)="FOA" "RTN","RMPRPIYU",60,0) S DIR("A")="Enter Receiving Location: " "RTN","RMPRPIYU",61,0) S DIR("?")="^D QM^RMPRPIYB" "RTN","RMPRPIYU",62,0) S DIR("??")="^D QM2^RMPRPIYB" "RTN","RMPRPIYU",63,0) S RMPR5("IEN")="" "RTN","RMPRPIYU",64,0) LOCNM1 D ^DIR "RTN","RMPRPIYU",65,0) I $G(RMPR5("IEN"))'="" S RMPREXC="" G LOCNMX "RTN","RMPRPIYU",66,0) I $D(DTOUT) S RMPREXC="T" G LOCNMX "RTN","RMPRPIYU",67,0) I $D(DIROUT) S RMPREXC="P" G LOCNMX "RTN","RMPRPIYU",68,0) I X=""!(X["^") S RMPREXC="^" G LOCNMX "RTN","RMPRPIYU",69,0) K RMPR5 "RTN","RMPRPIYU",70,0) S RMPR5("STATION")=RMPRSTN "RTN","RMPRPIYU",71,0) S RMPR5("STATION IEN")=RMPRSTN "RTN","RMPRPIYU",72,0) D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5) "RTN","RMPRPIYU",73,0) I RMPREXC'="" G LOCNM1 "RTN","RMPRPIYU",74,0) I $G(RMPR5("IEN"))="" D G LOCNM1 "RTN","RMPRPIYU",75,0) . W !,"Please enter a valid Location" "RTN","RMPRPIYU",76,0) . Q "RTN","RMPRPIYU",77,0) ; "RTN","RMPRPIYU",78,0) ; exit "RTN","RMPRPIYU",79,0) LOCNMX Q "RTN","RMPRPIYU",80,0) ; "RTN","RMPRPIYU",81,0) ;***** OK - Prompt for an OK "RTN","RMPRPIYU",82,0) OK(RMPRYN,RMPREXC) ; "RTN","RMPRPIYU",83,0) N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT "RTN","RMPRPIYU",84,0) S RMPREXC="" "RTN","RMPRPIYU",85,0) S RMPRYN="N" "RTN","RMPRPIYU",86,0) S DIR("A")=" ...OK" "RTN","RMPRPIYU",87,0) S DIR("B")="Yes" "RTN","RMPRPIYU",88,0) S DIR(0)="Y" "RTN","RMPRPIYU",89,0) D ^DIR "RTN","RMPRPIYU",90,0) I $D(DTOUT) S RMPREXC="T" G OKX "RTN","RMPRPIYU",91,0) I $D(DIROUT) S RMPREXC="P" G OKX "RTN","RMPRPIYU",92,0) I X=""!(X["^") S RMPREXC="^" G OKX "RTN","RMPRPIYU",93,0) S RMPRYN="N" S:Y RMPRYN="Y" "RTN","RMPRPIYU",94,0) OKX Q "RTN","RMPRPIYV") 0^59^B3926586 "RTN","RMPRPIYV",1,0) RMPRPIYV ;HINCIO/ODJ - PIP Data Entry - HCPCS;3/8/01 "RTN","RMPRPIYV",2,0) ;;3.0;PROSTHETICS;**61**;Feb 09, 1996 "RTN","RMPRPIYV",3,0) Q "RTN","RMPRPIYV",4,0) ; "RTN","RMPRPIYV",5,0) ;***** HCPCS - Prompt for HCPCS code to TRANSFER "RTN","RMPRPIYV",6,0) ; called by Transfer option RMPRPIYT "RTN","RMPRPIYV",7,0) ; "RTN","RMPRPIYV",8,0) ; Inputs: "RTN","RMPRPIYV",9,0) ; RMPR5 - Location array (from 661.5) must contain... "RTN","RMPRPIYV",10,0) ; RMPR5("IEN") - ien of Location "RTN","RMPRPIYV",11,0) ; RMPR5("STATION") - ien of location's Station "RTN","RMPRPIYV",12,0) ; "RTN","RMPRPIYV",13,0) ; RMPR1("HCPCS") - (optional) Default HCPCS code "RTN","RMPRPIYV",14,0) ; "RTN","RMPRPIYV",15,0) ; Outputs: "RTN","RMPRPIYV",16,0) ; RMPREXC - Exit condition "RTN","RMPRPIYV",17,0) ; RMPR1 - array of HCPCS data fields from 661.1 "RTN","RMPRPIYV",18,0) ; RMPR1("IEN") - ien of HCPCS in 661.1 "RTN","RMPRPIYV",19,0) ; RMPR1("HCPCS") - HCPCS code "RTN","RMPRPIYV",20,0) ; RMPR1("SHORT DESC") - HCPCS short description "RTN","RMPRPIYV",21,0) ; "RTN","RMPRPIYV",22,0) HCPCS(RMPR5,RMPR1,RMPREXC) ; "RTN","RMPRPIYV",23,0) N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA,RMPRSTN,RMPRLCN,RMPR1N "RTN","RMPRPIYV",24,0) S DIR("A")="Enter HCPCS to Transfer: " "RTN","RMPRPIYV",25,0) S RMPRERR=0 "RTN","RMPRPIYV",26,0) S RMPREXC="" "RTN","RMPRPIYV",27,0) S RMPR1("HCPCS")=$G(RMPR1("HCPCS")) "RTN","RMPRPIYV",28,0) S RMPRSTN=RMPR5("STATION") "RTN","RMPRPIYV",29,0) S RMPRLCN=RMPR5("IEN") "RTN","RMPRPIYV",30,0) S DIR(0)="FOA" "RTN","RMPRPIYV",31,0) S DIR("?")="^D QM^RMPRPIYC" "RTN","RMPRPIYV",32,0) S DIR("??")="^D QM2^RMPRPIYC" "RTN","RMPRPIYV",33,0) HCPCS1 K RMPR1N D ^DIR "RTN","RMPRPIYV",34,0) I $D(DTOUT) S RMPREXC="T" G HCPCSX "RTN","RMPRPIYV",35,0) I $D(DIROUT) S RMPREXC="P" G HCPCSX "RTN","RMPRPIYV",36,0) I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX "RTN","RMPRPIYV",37,0) D LIKE^RMPRPIYC(RMPRSTN,RMPRLCN,X,.RMPREXC,.RMPR1N) "RTN","RMPRPIYV",38,0) I RMPREXC'="" G HCPCS1 "RTN","RMPRPIYV",39,0) I $G(RMPR1N("IEN"))'="" G HCPCSU "RTN","RMPRPIYV",40,0) G HCPCS1 "RTN","RMPRPIYV",41,0) HCPCSU K RMPR1 M RMPR1=RMPR1N "RTN","RMPRPIYV",42,0) HCPCSX Q RMPRERR "RTN","RMPRPIYV",43,0) ; "RTN","RMPRPIYV",44,0) ; Help System (NOT IN USE) "RTN","RMPRPIYV",45,0) HLP N RMPRMAXL,RMPRH,RMPRL,RMPRERR,RMPR "RTN","RMPRPIYV",46,0) S RMPRMAXL=9 "RTN","RMPRPIYV",47,0) W ?4,"Answer with HCPCS" "RTN","RMPRPIYV",48,0) W !?3,"Choose from:" "RTN","RMPRPIYV",49,0) S RMPRL=0 "RTN","RMPRPIYV",50,0) S RMPRH="" "RTN","RMPRPIYV",51,0) F S RMPRH=$O(^RMPR(661.7,"XSLHIDS",RMPR5("STATION IEN"),RMPR5("IEN"),RMPRH)) Q:RMPRH="" D Q:RMPRL'0 S RMDAT=$G(^RMPR(661.7,RI,0)) S RMSTN=$P(RMDAT,U,5) I RMSTN=RS D PROC "RTN","RMPRPIYZ",43,0) ;exit/done printing bar code labels "RTN","RMPRPIYZ",44,0) G PRINTC "RTN","RMPRPIYZ",45,0) ; "RTN","RMPRPIYZ",46,0) PROC ;process bar code for printing. "RTN","RMPRPIYZ",47,0) S (RMPRNLAB,RME)=0,RMPR11("DESCRIPTION")="" "RTN","RMPRPIYZ",48,0) S RMPR6("VENDOR")="",RMLOCNA="" "RTN","RMPRPIYZ",49,0) K RMPR7I,RM441,RM661 "RTN","RMPRPIYZ",50,0) S RMPR7("IEN")=RI,RMPR7("HCPCS")=$P(RMDAT,U,1) "RTN","RMPRPIYZ",51,0) S RMPR7("ITEM")=$P(RMDAT,U,4),RH=$P(RMDAT,U,1) "RTN","RMPRPIYZ",52,0) S RD=$P(RMDAT,U,2) "RTN","RMPRPIYZ",53,0) S (RMPR7("LOCATION"),RMLOC)=$P(RMDAT,U,6) "RTN","RMPRPIYZ",54,0) S RMPR7("VALUE")=$P(RMDAT,U,8),RMPR7("QUANTITY")=$P(RMDAT,U,7) "RTN","RMPRPIYZ",55,0) I $G(RMLOC),$D(^RMPR(661.5,RMLOC,0)) D "RTN","RMPRPIYZ",56,0) .S RMLOCNA=$P(^RMPR(661.5,RMLOC,0),U,1) "RTN","RMPRPIYZ",57,0) ; "RTN","RMPRPIYZ",58,0) ITEM ;get 661.11 record "RTN","RMPRPIYZ",59,0) S RMPR11("IEN")=$O(^RMPR(661.11,"ASHI",RS,RH,RMPR7("ITEM"),0)) "RTN","RMPRPIYZ",60,0) S RME=$$GET^RMPRPIX1(.RMPR11) "RTN","RMPRPIYZ",61,0) I RME=1 Q "RTN","RMPRPIYZ",62,0) ; "RTN","RMPRPIYZ",63,0) VEND ;get vendor from 661.6. "RTN","RMPRPIYZ",64,0) S RMV="",RMPR6("VENDOR")="",RMPR11("ITEM MSTER")="" "RTN","RMPRPIYZ",65,0) F K=0:0 S K=$O(^RMPR(661.6,"C",RD,K)) Q:K'>0 S RM6=$G(^RMPR(661.6,K,0)) D "RTN","RMPRPIYZ",66,0) .Q:RH'=$P(RM6,U,1) "RTN","RMPRPIYZ",67,0) .I (RH=$P(RM6,U,1)),(RMLOC=$P(RM6,U,14)) S RMV=$P(RM6,U,12) "RTN","RMPRPIYZ",68,0) .S:$G(RMV) RMPR6("VENDOR")=$$GETVEN^RMPRPIU0(RMV) "RTN","RMPRPIYZ",69,0) ; "RTN","RMPRPIYZ",70,0) ;external format of items at #661.7 "RTN","RMPRPIYZ",71,0) S RME=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I) "RTN","RMPRPIYZ",72,0) I RME=1 Q "RTN","RMPRPIYZ",73,0) ; "RTN","RMPRPIYZ",74,0) ;set variables for printing bar code. "RTN","RMPRPIYZ",75,0) S RMPRBARC=RMPR7I("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2) "RTN","RMPRPIYZ",76,0) S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3)) "RTN","RMPRPIYZ",77,0) S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM") "RTN","RMPRPIYZ",78,0) S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER") "RTN","RMPRPIYZ",79,0) S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION") "RTN","RMPRPIYZ",80,0) S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2) "RTN","RMPRPIYZ",81,0) S RMPRITXT("VENDOR")=RMPR6("VENDOR") "RTN","RMPRPIYZ",82,0) S RMPRITXT("LOCATION")=RMLOCNA "RTN","RMPRPIYZ",83,0) S RMPRNLAB=RMPR7("QUANTITY") "RTN","RMPRPIYZ",84,0) ;call bar code routine "RTN","RMPRPIYZ",85,0) D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB) "RTN","RMPRPIYZ",86,0) Q "RTN","RMPRPIYZ",87,0) ; "RTN","RMPRPIYZ",88,0) PRINTC ; "RTN","RMPRPIYZ",89,0) D ^%ZISC K IONOFF "RTN","RMPRPIYZ",90,0) ; "RTN","RMPRPIYZ",91,0) PBX D KILL^XUSCLEAN "RTN","RMPRPIYZ",92,0) PRINTX Q "RTN","RMPRST2") 0^96^B4091043 "RTN","RMPRST2",1,0) RMPRST2 ;PHX/RFM,RVD-DISPLAY ISSUE FROM STOCK ;3/8/05 08:07 "RTN","RMPRST2",2,0) ;;3.0;PROSTHETICS;**12,28,33,41,53,61**;Feb 09, 1996 "RTN","RMPRST2",3,0) ; DBIA #800 - Read Access to file 440. "RTN","RMPRST2",4,0) ; DBIA #801 - Read Access to file 441. "RTN","RMPRST2",5,0) ; "RTN","RMPRST2",6,0) W @IOF S $P(HL,"=",IOM-1)="" W !,HL "RTN","RMPRST2",7,0) W:'$D(RMPRHISD) !?31,"***STOCK ISSUE***" W:$D(RMPRHISD) !!?31,"***HISTORICAL DATA***" W !!?5,"PATIENT NAME: ",RMPRNAM,?50,"SSN: ",RMPRSSN "RTN","RMPRST2",8,0) W !!?5,"TYPE OF TRANSACTION: ",$P(R3("D"),U,4),?43,"SOURCE: ",$P(R3("D"),U,14) "RTN","RMPRST2",9,0) W !!?5,"PATIENT CATEGORY: ",$P(R4("D"),U,3),?43,"SPECIAL CATEGORY: ",$P(R4("D"),U,4) "RTN","RMPRST2",10,0) W !!?5,"ITEM: ",$E($P(^PRC(441,$P(^RMPR(661,$P(R1(0),U,6),0),U,1),0),U,2),1,30),?43,"VENDOR: " I +$P(R1(0),U,9) W $E($P(^PRC(440,+$P(R1(0),U,9),0),U,1),1,29) "RTN","RMPRST2",11,0) I $D(R1(1)),$P(R1(1),U,4)>0 W !!?5,"PSAS HCPCS: ",$P(^RMPR(661.1,$P(R1(1),U,4),0),U,1)," ",$P(^(0),U,2),!!?5,"CPT MODIFIER: ",$P(R1(1),U,6) "RTN","RMPRST2",12,0) I $D(R1(2)) W !!?5,"HCPCS/ITEM: ",$P(R1(2),U,1)," ",$P(R1(2),U,2) "RTN","RMPRST2",13,0) S:'$D(RMLACO) RMLACO=0 "RTN","RMPRST2",14,0) S RUNICOST=$P(R1(0),U,16)/$P(R1(0),U,7) "RTN","RMPRST2",15,0) S RTOTCOST=$P(R1(0),U,16)+RMLACO "RTN","RMPRST2",16,0) W !!?5,"QUANTITY: ",$P(R1(0),U,7),?23,"UNIT COST: ",$J(RUNICOST,0,2),?43,"TOTAL COST: ",$J(RTOTCOST,0,2) "RTN","RMPRST2",17,0) W !!?5,"SERIAL NUMBER: ",$P(R1(0),U,11),?43,"LOT NUMBER: ",$P(R1(0),U,24),!?5,"REMARKS: ",$P(R1(0),U,18) "RTN","RMPRST2",18,0) W !?5,"DATE OF SERVICE: ",$P($G(R1("D")),U,8) "RTN","RMPRST2",19,0) W ?43,"Inventory Location: " "RTN","RMPRST2",20,0) ;I $G(RMLOC) W $P($G(^RMPR(661.3,RMLOC,0)),U,1) "RTN","RMPRST2",21,0) I $G(RMLOC) W $P($G(^RMPR(661.5,RMLOC,0)),U,1) "RTN","RMPRST2",22,0) W !,HL "RTN","RMPRST2",23,0) K RUNICOST,RTOTCOST "RTN","RMPRST2",24,0) Q "SEC","^DIC",661.11,661.11,0,"AUDIT") @ "SEC","^DIC",661.11,661.11,0,"DD") @ "SEC","^DIC",661.11,661.11,0,"DEL") @ "SEC","^DIC",661.11,661.11,0,"LAYGO") "SEC","^DIC",661.11,661.11,0,"RD") "SEC","^DIC",661.11,661.11,0,"WR") "SEC","^DIC",661.4,661.4,0,"AUDIT") @ "SEC","^DIC",661.4,661.4,0,"DD") @ "SEC","^DIC",661.4,661.4,0,"DEL") @ "SEC","^DIC",661.4,661.4,0,"LAYGO") "SEC","^DIC",661.4,661.4,0,"RD") "SEC","^DIC",661.4,661.4,0,"WR") "SEC","^DIC",661.41,661.41,0,"AUDIT") @ "SEC","^DIC",661.41,661.41,0,"DD") @ "SEC","^DIC",661.41,661.41,0,"DEL") @ "SEC","^DIC",661.41,661.41,0,"LAYGO") "SEC","^DIC",661.41,661.41,0,"RD") "SEC","^DIC",661.41,661.41,0,"WR") "SEC","^DIC",661.5,661.5,0,"AUDIT") @ "SEC","^DIC",661.5,661.5,0,"DD") @ "SEC","^DIC",661.5,661.5,0,"DEL") @ "SEC","^DIC",661.6,661.6,0,"AUDIT") @ "SEC","^DIC",661.6,661.6,0,"DD") @ "SEC","^DIC",661.6,661.6,0,"DEL") @ "SEC","^DIC",661.63,661.63,0,"AUDIT") @ "SEC","^DIC",661.63,661.63,0,"DD") @ "SEC","^DIC",661.63,661.63,0,"DEL") @ "SEC","^DIC",661.69,661.69,0,"AUDIT") @ "SEC","^DIC",661.69,661.69,0,"DD") @ "SEC","^DIC",661.69,661.69,0,"DEL") @ "SEC","^DIC",661.7,661.7,0,"AUDIT") @ "SEC","^DIC",661.7,661.7,0,"DD") @ "SEC","^DIC",661.7,661.7,0,"DEL") @ "SEC","^DIC",661.8,661.8,0,"AUDIT") @ "SEC","^DIC",661.8,661.8,0,"DD") @ "SEC","^DIC",661.8,661.8,0,"DEL") @ "SEC","^DIC",661.8,661.8,0,"LAYGO") "SEC","^DIC",661.8,661.8,0,"RD") "SEC","^DIC",661.8,661.8,0,"WR") "SEC","^DIC",661.9,661.9,0,"AUDIT") "SEC","^DIC",661.9,661.9,0,"DD") @ "SEC","^DIC",661.9,661.9,0,"DEL") @ "VER") 8.0^22 "^DD",660,660,4.6,0) STOCK ISSUE^P661.6^RMPR(661.6,^1;5^Q "^DD",660,660,4.6,3) "^DD",660,660,4.6,21,0) ^^1^1^3010926^ "^DD",660,660,4.6,21,1,0) This is a pointer to file #661.6. "^DD",660,660,4.6,"DT") 3010620 "^DD",660,660,39,0) DATE OF SERVICE^D^^1;8^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",660,660,39,1,0) ^.1 "^DD",660,660,39,1,1,0) 660^AF "^DD",660,660,39,1,1,1) S ^RMPR(660,"AF",$E(X,1,30),DA)="" "^DD",660,660,39,1,1,2) K ^RMPR(660,"AF",$E(X,1,30),DA) "^DD",660,660,39,1,1,"%D",0) ^^1^1^3040402^ "^DD",660,660,39,1,1,"%D",1,0) Cross-reference for Shipment date to be used for Billing. "^DD",660,660,39,1,1,"DT") 3040402 "^DD",660,660,39,21,0) ^^1^1^3030203^ "^DD",660,660,39,21,1,0) This is the date when an item is issued to the patient. "^DD",660,660,39,"DT") 3040402 "^DD",661.11,661.11,0) FIELD^^9^10 "^DD",661.11,661.11,0,"DDA") N "^DD",661.11,661.11,0,"DT") 3021211 "^DD",661.11,661.11,0,"IX","B",661.11,.01) "^DD",661.11,661.11,0,"IX","C",661.11,6) "^DD",661.11,661.11,0,"IX","D",661.11,2) "^DD",661.11,661.11,0,"NM","PROSTHETICS HCPCS ITEM MASTER FILE") "^DD",661.11,661.11,0,"VRPK") RMPR "^DD",661.11,661.11,.01,0) HCPCS^RF^^0;1^K:$L(X)>10!($L(X)<5)!'(X'?1P.E) X "^DD",661.11,661.11,.01,1,0) ^.1 "^DD",661.11,661.11,.01,1,1,0) 661.11^B "^DD",661.11,661.11,.01,1,1,1) S ^RMPR(661.11,"B",$E(X,1,30),DA)="" "^DD",661.11,661.11,.01,1,1,2) K ^RMPR(661.11,"B",$E(X,1,30),DA) "^DD",661.11,661.11,.01,3) Answer must be 5-10 characters in length "^DD",661.11,661.11,.01,7.5) D LKP^RMPRPIYI "^DD",661.11,661.11,.01,21,0) ^^1^1^3010126^ "^DD",661.11,661.11,.01,21,1,0) This is the HCPCS name as it shows in file #661.1. "^DD",661.11,661.11,.01,"DT") 3010815 "^DD",661.11,661.11,1,0) HCPCS ITEM^RNJ10,0^^0;2^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",661.11,661.11,1,3) Type a Number between 1 and 9999999999, 0 Decimal Digits "^DD",661.11,661.11,1,21,0) ^.001^1^1^3010215^^ "^DD",661.11,661.11,1,21,1,0) This is the item number for a HCPCS item. "^DD",661.11,661.11,1,"DT") 3010815 "^DD",661.11,661.11,2,0) DESCRIPTION^F^^0;3^K:$L(X)>60!($L(X)<1) X "^DD",661.11,661.11,2,1,0) ^.1 "^DD",661.11,661.11,2,1,1,0) 661.11^D "^DD",661.11,661.11,2,1,1,1) S ^RMPR(661.11,"D",$E(X,1,30),DA)="" "^DD",661.11,661.11,2,1,1,2) K ^RMPR(661.11,"D",$E(X,1,30),DA) "^DD",661.11,661.11,2,1,1,"DT") 3010411 "^DD",661.11,661.11,2,3) Answer must be 1-60 characters in length. "^DD",661.11,661.11,2,21,0) ^.001^1^1^3010809^^ "^DD",661.11,661.11,2,21,1,0) This is the description of an item. "^DD",661.11,661.11,2,"DT") 3010815 "^DD",661.11,661.11,3,0) STATION^P4^DIC(4,^0;4^Q "^DD",661.11,661.11,3,"DT") 3010815 "^DD",661.11,661.11,4,0) SOURCE^S^V:VA;C:COMMERCIAL;^0;5^Q "^DD",661.11,661.11,4,21,0) ^^5^5^3010815^ "^DD",661.11,661.11,4,21,1,0) This is the source of an item: "^DD",661.11,661.11,4,21,2,0) 'V' stands for VA or USED items and "^DD",661.11,661.11,4,21,3,0) 'C' for COMMERCIAL or NEW items. "^DD",661.11,661.11,4,21,4,0) NEW and USED items are tracked seperately so that seperate "^DD",661.11,661.11,4,21,5,0) inventory records should be maintained for each source. "^DD",661.11,661.11,4,"DT") 3010815 "^DD",661.11,661.11,5,0) UNIT OF ISSUE^P420.5'^PRCD(420.5,^0;6^Q "^DD",661.11,661.11,5,21,0) ^^1^1^3010605^ "^DD",661.11,661.11,5,21,1,0) This field is a pointer to Unit of Issue file (#420.5). "^DD",661.11,661.11,5,"DT") 3010605 "^DD",661.11,661.11,6,0) PSAS ITEM^RF^^0;7^K:$L(X)>12!($L(X)<7) X "^DD",661.11,661.11,6,1,0) ^.1 "^DD",661.11,661.11,6,1,1,0) 661.11^C "^DD",661.11,661.11,6,1,1,1) S ^RMPR(661.11,"C",$E(X,1,30),DA)="" "^DD",661.11,661.11,6,1,1,2) K ^RMPR(661.11,"C",$E(X,1,30),DA) "^DD",661.11,661.11,6,1,1,"DT") 3010411 "^DD",661.11,661.11,6,3) Answer must be 7-12 characters in length. "^DD",661.11,661.11,6,21,0) ^^3^3^3010605^ "^DD",661.11,661.11,6,21,1,0) PSAS Items are items used by PROSTHETICS SENSORY and AIDS "^DD",661.11,661.11,6,21,2,0) SERVICE (PSAS) and are based from the HCPCS concatenated with the HCPCS "^DD",661.11,661.11,6,21,3,0) ITEM NUMBER. "^DD",661.11,661.11,6,"DT") 3010815 "^DD",661.11,661.11,7,0) ITEM MASTER^P661'^RMPR(661,^0;8^Q "^DD",661.11,661.11,7,21,0) ^^1^1^3010809^ "^DD",661.11,661.11,7,21,1,0) POINTER TO 661 "^DD",661.11,661.11,7,"DT") 3010815 "^DD",661.11,661.11,8,0) STATUS^S^0:ACTIVE;1:INACTIVE;^0;9^Q "^DD",661.11,661.11,8,21,0) ^^4^4^3021211^ "^DD",661.11,661.11,8,21,1,0) This field represent if an ITEM is ACTIVE OR INACTIVE. If the STATUS is "^DD",661.11,661.11,8,21,2,0) INACTIVE, an Item will not be printed in PROSTHETICS INVENTORY BALANCE BY "^DD",661.11,661.11,8,21,3,0) HCPCS and PROSTHETICS INVENTORY BALANCE BY LOCATION reports for the "^DD",661.11,661.11,8,21,4,0) station selected. "^DD",661.11,661.11,8,"DT") 3021211 "^DD",661.11,661.11,9,0) INACTIVATION DATE^D^^0;10^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",661.11,661.11,9,21,0) ^^1^1^3021211^ "^DD",661.11,661.11,9,21,1,0) This is the Date the item is put INACTIVE status. "^DD",661.11,661.11,9,"DT") 3021211 "^DD",661.4,661.4,0) FIELD^^7^6 "^DD",661.4,661.4,0,"DDA") N "^DD",661.4,661.4,0,"DT") 3010216 "^DD",661.4,661.4,0,"IX","B",661.4,.01) "^DD",661.4,661.4,0,"IX","C",661.4,7) "^DD",661.4,661.4,0,"NM","HCPCS INVENTORY") "^DD",661.4,661.4,0,"VRPK") RMPR "^DD",661.4,661.4,.01,0) HCPCS^RF^^0;1^K:$L(X)>10!($L(X)<1) X "^DD",661.4,661.4,.01,1,0) ^.1 "^DD",661.4,661.4,.01,1,1,0) 661.4^B "^DD",661.4,661.4,.01,1,1,1) S ^RMPR(661.4,"B",$E(X,1,30),DA)="" "^DD",661.4,661.4,.01,1,1,2) K ^RMPR(661.4,"B",$E(X,1,30),DA) "^DD",661.4,661.4,.01,3) Answer must be 1-10 characters in length. "^DD",661.4,661.4,.01,21,0) ^.001^1^1^3010216^^ "^DD",661.4,661.4,.01,21,1,0) This is the HCPCS code "^DD",661.4,661.4,.01,23,0) ^.001^1^1^3010216^^ "^DD",661.4,661.4,.01,23,1,0) This is a pointer field to the HCPC file (661.1) "^DD",661.4,661.4,.01,"DT") 3010508 "^DD",661.4,661.4,2,0) HCPCS ITEM^RNJ10,0^^0;2^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",661.4,661.4,2,3) Type a Number between 1 and 9999999999, 0 Decimal Digits "^DD",661.4,661.4,2,21,0) ^.001^6^6^3010216^^ "^DD",661.4,661.4,2,21,1,0) This field is a pointer to the HCPCS ITEM sub-file (661.12) of the "^DD",661.4,661.4,2,21,2,0) PROSTHETIC HCPCS file (661.1). "^DD",661.4,661.4,2,21,3,0) "^DD",661.4,661.4,2,21,4,0) ********* S I T E I N T E G R A T O R S B E W A R E ********* "^DD",661.4,661.4,2,21,5,0) It is defined as free text as FM does not allow sub-file pointers to be "^DD",661.4,661.4,2,21,6,0) defined explicitly. "^DD",661.4,661.4,2,23,0) ^.001^5^5^3010216^^ "^DD",661.4,661.4,2,23,1,0) This field is a pointer to the HCPC Item sub-file (661.12). Although "^DD",661.4,661.4,2,23,2,0) classified as free text any application code responsible for maintaining "^DD",661.4,661.4,2,23,3,0) this file must ensure that given a HCPC pointer in 661.1 the HCPC item "^DD",661.4,661.4,2,23,4,0) correctly points to a node in the sub-file (661.12) beneath the HCPC "^DD",661.4,661.4,2,23,5,0) pointer. "^DD",661.4,661.4,2,"DT") 3010508 "^DD",661.4,661.4,3,0) STATION^RP4'^DIC(4,^0;3^Q "^DD",661.4,661.4,3,21,0) ^^1^1^3010116^ "^DD",661.4,661.4,3,21,1,0) This field is a pointer to the INSTITUTION file (4). "^DD",661.4,661.4,3,"DT") 3010508 "^DD",661.4,661.4,4,0) RE-ORDER QUANTITY^NJ9,0^^0;4^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1.N) X "^DD",661.4,661.4,4,3) Type a number between 0 and 999999999, 0 Decimal Digits "^DD",661.4,661.4,4,21,0) ^^2^2^3010116^ "^DD",661.4,661.4,4,21,1,0) This field is the re-order quantity for a HCPCS item at a Station and is "^DD",661.4,661.4,4,21,2,0) used to drive reports which alert sites to the need to re-order. "^DD",661.4,661.4,4,"DT") 3010116 "^DD",661.4,661.4,5,0) QUANTITY ON ORDER^NJ9,0^^0;5^K:+X'=X!(X>999999999)!(X<0)!(X?.E1"."1.N) X "^DD",661.4,661.4,5,3) Type a number between 0 and 999999999, 0 Decimal Digits "^DD",661.4,661.4,5,21,0) ^^10^10^3010116^ "^DD",661.4,661.4,5,21,1,0) This field is the current quantity on order for a HCPCS Item at a Station. "^DD",661.4,661.4,5,21,2,0) It is used to inform sites that although a stock item might be below the "^DD",661.4,661.4,5,21,3,0) proscribed re-order level, orders have been placed to re-stock. "^DD",661.4,661.4,5,21,4,0) A distinction should be made on low stock warning type reports between the "^DD",661.4,661.4,5,21,5,0) situation where the current on-hand quantity + on-order quantity is below "^DD",661.4,661.4,5,21,6,0) the re-order level, and that where it is not. "^DD",661.4,661.4,5,21,7,0) This field will be updated for any receipt or order type transaction "^DD",661.4,661.4,5,21,8,0) recorded in the PROSTHETIC INVENTORY TRANSACTION file (661.6):- "^DD",661.4,661.4,5,21,9,0) for receipt type transactions subtract the receipt quantity, "^DD",661.4,661.4,5,21,10,0) for order type transactions add the order quantity. "^DD",661.4,661.4,5,"DT") 3010116 "^DD",661.4,661.4,7,0) LOCATION^RP661.5'^RMPR(661.5,^0;7^Q "^DD",661.4,661.4,7,1,0) ^.1 "^DD",661.4,661.4,7,1,1,0) 661.4^C "^DD",661.4,661.4,7,1,1,1) S ^RMPR(661.4,"C",$E(X,1,30),DA)="" "^DD",661.4,661.4,7,1,1,2) K ^RMPR(661.4,"C",$E(X,1,30),DA) "^DD",661.4,661.4,7,1,1,"DT") 3020320 "^DD",661.4,661.4,7,21,0) ^.001^1^1^3020320^^^ "^DD",661.4,661.4,7,21,1,0) This field is a pointer to the Prosthetic Stock Location file (661.5). "^DD",661.4,661.4,7,"DT") 3020320 "^DD",661.41,661.41,0) FIELD^^10^10 "^DD",661.41,661.41,0,"DDA") N "^DD",661.41,661.41,0,"DT") 3010425 "^DD",661.41,661.41,0,"IX","B",661.41,.01) "^DD",661.41,661.41,0,"NM","HCPCS INVENTORY ORDER AND REORDER") "^DD",661.41,661.41,0,"VRPK") RMPR "^DD",661.41,661.41,.01,0) DATE ORDERED^RD^^0;1^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",661.41,661.41,.01,1,0) ^.1 "^DD",661.41,661.41,.01,1,1,0) 661.41^B "^DD",661.41,661.41,.01,1,1,1) S ^RMPR(661.41,"B",$E(X,1,30),DA)="" "^DD",661.41,661.41,.01,1,1,2) K ^RMPR(661.41,"B",$E(X,1,30),DA) "^DD",661.41,661.41,.01,3) "^DD",661.41,661.41,.01,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,.01,21,1,0) This is the date when an item is ordered. "^DD",661.41,661.41,.01,"DT") 3010425 "^DD",661.41,661.41,1,0) HCPCS ITEM^NJ4,0^^0;2^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1N.N) X "^DD",661.41,661.41,1,3) Type a Number between 1 and 9999, 0 Decimal Digits "^DD",661.41,661.41,1,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,1,21,1,0) This is the Item number of an HCPCS Item. "^DD",661.41,661.41,1,"DT") 3010425 "^DD",661.41,661.41,2,0) STATION^P4'^DIC(4,^0;3^Q "^DD",661.41,661.41,2,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,2,21,1,0) This is the staton where an HCPCS belong to. "^DD",661.41,661.41,2,"DT") 3010425 "^DD",661.41,661.41,4,0) VENDOR^P440'^PRC(440,^0;5^Q "^DD",661.41,661.41,4,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,4,21,1,0) A pointer to Vendor file in IFCAP. "^DD",661.41,661.41,4,"DT") 3010423 "^DD",661.41,661.41,5,0) HCPCS^F^^0;6^K:$L(X)>10!($L(X)<5) X "^DD",661.41,661.41,5,3) Answer must be 5-10 characters in length. "^DD",661.41,661.41,5,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,5,21,1,0) This is the PSAS HCPCS as entered in 01 field of file # 661.1. "^DD",661.41,661.41,5,"DT") 3010425 "^DD",661.41,661.41,6,0) DATE RECIEVED^D^^0;7^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",661.41,661.41,6,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,6,21,1,0) The date date when an Item is recieved. "^DD",661.41,661.41,6,"DT") 3010423 "^DD",661.41,661.41,7,0) QTY ORDERED^NJ5,0^^0;8^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."1N.N) X "^DD",661.41,661.41,7,3) Type a Number between 0 and 99999, 0 Decimal Digits "^DD",661.41,661.41,7,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,7,21,1,0) A number that signifies the quantity being being ordered. "^DD",661.41,661.41,7,"DT") 3010423 "^DD",661.41,661.41,8,0) QTY RECIEVED^NJ5,0^^0;9^K:+X'=X!(X>99999)!(X<0)!(X?.E1"."1N.N) X "^DD",661.41,661.41,8,3) Type a Number between 0 and 99999, 0 Decimal Digits "^DD",661.41,661.41,8,21,0) ^^1^1^3010423^ "^DD",661.41,661.41,8,21,1,0) A number that signifies the quatity recieved. "^DD",661.41,661.41,8,"DT") 3010423 "^DD",661.41,661.41,9,0) COMMENTS^F^^0;10^K:$L(X)>50!($L(X)<3) X "^DD",661.41,661.41,9,3) Answer must be 3-50 characters in length. "^DD",661.41,661.41,9,21,0) ^^2^2^3010423^ "^DD",661.41,661.41,9,21,1,0) This is a free text field that can be used for comments or any description "^DD",661.41,661.41,9,21,2,0) of an item being ordered. "^DD",661.41,661.41,9,"DT") 3010423 "^DD",661.41,661.41,10,0) STATUS^S^C:CANCELLED;O:OPEN;R:RECEIVED;^0;11^Q "^DD",661.41,661.41,10,"DT") 3010425 "^DD",661.5,661.5,0) FIELD^^6^6 "^DD",661.5,661.5,0,"DDA") N "^DD",661.5,661.5,0,"DT") 3010118 "^DD",661.5,661.5,0,"IX","B",661.5,.01) "^DD",661.5,661.5,0,"NM","PROSTHETIC STOCK LOCATION") "^DD",661.5,661.5,0,"PT",661.4,7) "^DD",661.5,661.5,0,"PT",661.6,14) "^DD",661.5,661.5,0,"PT",661.63,8) "^DD",661.5,661.5,0,"PT",661.7,5) "^DD",661.5,661.5,0,"VRPK") RMPR "^DD",661.5,661.5,.01,0) NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",661.5,661.5,.01,1,0) ^.1 "^DD",661.5,661.5,.01,1,1,0) 661.5^B "^DD",661.5,661.5,.01,1,1,1) S ^RMPR(661.5,"B",$E(X,1,30),DA)="" "^DD",661.5,661.5,.01,1,1,2) K ^RMPR(661.5,"B",$E(X,1,30),DA) "^DD",661.5,661.5,.01,3) Answer must be 3-30 characters in length "^DD",661.5,661.5,.01,21,0) ^^1^1^3001129^ "^DD",661.5,661.5,.01,21,1,0) This is the name of the stock location. "^DD",661.5,661.5,.01,"DT") 3010116 "^DD",661.5,661.5,2,0) STATION^P4'^DIC(4,^0;2^Q "^DD",661.5,661.5,2,21,0) ^^1^1^3001129^ "^DD",661.5,661.5,2,21,1,0) This field points to the Institution file (4). "^DD",661.5,661.5,2,"DT") 3010118 "^DD",661.5,661.5,3,0) ADDRESS^F^^0;3^K:$L(X)>30!($L(X)<3) X "^DD",661.5,661.5,3,3) Answer must be 3-30 characters in length "^DD",661.5,661.5,3,21,0) ^^1^1^3001129^ "^DD",661.5,661.5,3,21,1,0) This is an address for the stock location. "^DD",661.5,661.5,3,"DT") 3001129 "^DD",661.5,661.5,4,0) STATUS^S^A:ACTIVE;I:INACTIVE;^0;4^Q "^DD",661.5,661.5,4,21,0) ^^10^10^3010116^ "^DD",661.5,661.5,4,21,1,0) This field indicates whether a stock location is active (A) or inactive "^DD",661.5,661.5,4,21,2,0) (I). "^DD",661.5,661.5,4,21,3,0) Stock locations should not be deleted once they have participated in "^DD",661.5,661.5,4,21,4,0) inventory transactions because other inventory files will inevitably point "^DD",661.5,661.5,4,21,5,0) to the Stock Location file. Instead stock locations should be marked as "^DD",661.5,661.5,4,21,6,0) inactive when no longer in use (due to stock room re-organisation or any "^DD",661.5,661.5,4,21,7,0) other reason). "^DD",661.5,661.5,4,21,8,0) The system will not allow receipts into inactive locations, but issues and "^DD",661.5,661.5,4,21,9,0) outward transfers will be permitted (although ideally all stock should be "^DD",661.5,661.5,4,21,10,0) transferred to other active locations before deactivation). "^DD",661.5,661.5,4,"DT") 3010116 "^DD",661.5,661.5,5,0) STATUS CHANGE DATE^D^^0;5^S %DT="EX" D ^%DT S X=Y K:X<1 X "^DD",661.5,661.5,5,3) (No range limit on date) "^DD",661.5,661.5,5,21,0) ^^2^2^3010116^ "^DD",661.5,661.5,5,21,1,0) This fields records the date when the status of a stock location is "^DD",661.5,661.5,5,21,2,0) changed. "^DD",661.5,661.5,5,"DT") 3010116 "^DD",661.5,661.5,6,0) USER^P200'^VA(200,^0;6^Q "^DD",661.5,661.5,6,21,0) ^^2^2^3010116^ "^DD",661.5,661.5,6,21,1,0) This field records the pointer of the user who last updated the stock "^DD",661.5,661.5,6,21,2,0) location record. "^DD",661.5,661.5,6,"DT") 3010116 "^DD",661.6,661.6,0) FIELD^^14^12 "^DD",661.6,661.6,0,"DDA") N "^DD",661.6,661.6,0,"DT") 3010426 "^DD",661.6,661.6,0,"IX","B",661.6,.01) "^DD",661.6,661.6,0,"IX","C",661.6,2) "^DD",661.6,661.6,0,"NM","PROSTHETIC INVENTORY TRANSACTION") "^DD",661.6,661.6,0,"PT",660,4.6) "^DD",661.6,661.6,0,"PT",661.63,.01) "^DD",661.6,661.6,0,"PT",661.69,.01) "^DD",661.6,661.6,0,"VRPK") RMPR "^DD",661.6,661.6,.01,0) HCPCS^RFD^^0;1^K:$L(X)>6!($L(X)<1) X "^DD",661.6,661.6,.01,1,0) ^.1 "^DD",661.6,661.6,.01,1,1,0) 661.6^B "^DD",661.6,661.6,.01,1,1,1) S ^RMPR(661.6,"B",$E(X,1,30),DA)="" "^DD",661.6,661.6,.01,1,1,2) K ^RMPR(661.6,"B",$E(X,1,30),DA) "^DD",661.6,661.6,.01,3) Answer must be 1-6 characters in length "^DD",661.6,661.6,.01,21,0) ^^2^2^3010112^ "^DD",661.6,661.6,.01,21,1,0) This field is the HCPCS code as defined by the .01 field in the "^DD",661.6,661.6,.01,21,2,0) PROSTHETIC HCPCS file (661.1). "^DD",661.6,661.6,.01,"DT") 3010212 "^DD",661.6,661.6,2,0) DATE&TIME STAMP^RD^^0;2^S %DT="ESTXR" D ^%DT S X=Y K:Y<1 X "^DD",661.6,661.6,2,1,0) ^.1 "^DD",661.6,661.6,2,1,1,0) 661.6^C "^DD",661.6,661.6,2,1,1,1) S ^RMPR(661.6,"C",$E(X,1,30),DA)="" "^DD",661.6,661.6,2,1,1,2) K ^RMPR(661.6,"C",$E(X,1,30),DA) "^DD",661.6,661.6,2,1,1,"DT") 3020320 "^DD",661.6,661.6,2,3) "^DD",661.6,661.6,2,21,0) ^.001^10^10^3010118^^^^ "^DD",661.6,661.6,2,21,1,0) This field is the date and time stamp (fileman standard format) of the "^DD",661.6,661.6,2,21,2,0) transaction. This field will be automatically generated by the system and "^DD",661.6,661.6,2,21,3,0) assumes users will record inventory transactions in a timely manner. "^DD",661.6,661.6,2,21,4,0) It is one of the primary key fields and is also recorded on the barcode. "^DD",661.6,661.6,2,21,5,0) It is a requirement that the date@time stamp should have a unique value "^DD",661.6,661.6,2,21,6,0) for any given HCPCS. The reason for this is that HCPCS will also be "^DD",661.6,661.6,2,21,7,0) recorded on an item's barcode and it is important that barcodes will not "^DD",661.6,661.6,2,21,8,0) need changing if a site is integrated at some time in the future. "^DD",661.6,661.6,2,21,9,0) Given the date&time stamp and HCPCS fields it is possible to generate a "^DD",661.6,661.6,2,21,10,0) transactions IEN using the appropriate cross-reference. "^DD",661.6,661.6,2,"DT") 3020320 "^DD",661.6,661.6,3,0) SEQUENCE^NJ9,0^RMPR(661.4,^0;3^K:+X'=X!(X>999999999)!(X<1)!(X?.E1"."1.N) X "^DD",661.6,661.6,3,3) Type a number between 1 and 999999999, 0 Decimal Digits "^DD",661.6,661.6,3,21,0) ^^13^13^3010112^ "^DD",661.6,661.6,3,21,1,0) This field is a sequence number starting at 1 and incremented by 1 for "^DD",661.6,661.6,3,21,2,0) each transaction which has the same HCPCS and DATE&TIME STAMP fields. This "^DD",661.6,661.6,3,21,3,0) situation should be very rare and only occurs at all after site "^DD",661.6,661.6,3,21,4,0) integrations. The HCPCS, DATE&TIME STAMP and SEQUENCE fields together make "^DD",661.6,661.6,3,21,5,0) up the primary key for this file. "^DD",661.6,661.6,3,21,6,0) The rationale behind this design is to allow the HCPCS and DATE&TIME STAMP "^DD",661.6,661.6,3,21,7,0) to be printed as a barcode for automated data entry on a stock issue form. "^DD",661.6,661.6,3,21,8,0) Fileman IENs will be derived from appropriate cross-references and, of "^DD",661.6,661.6,3,21,9,0) course, these IENs can all change if a site is integrated. "^DD",661.6,661.6,3,21,10,0) On the rare occasions where there is more than 1 SEQUENCE number "^DD",661.6,661.6,3,21,11,0) associated with a HCPCS and DATE&TIME STAMP the user will have to be "^DD",661.6,661.6,3,21,12,0) prompted to select from a list of transactions. We see no way round this "^DD",661.6,661.6,3,21,13,0) inconvenience but hopefully it will be extremely rare! "^DD",661.6,661.6,3,"DT") 3010117 "^DD",661.6,661.6,4,0) TRANSACTION TYPE^S^1:RECEIPT;2:ORDER;3:PATIENT ISSUE;4:ISSUE TO LAB;5:RETURN TO VENDOR;6:WRITE OFF;7:TRANSFER;8:RETURN IN;9:RECONCILE;^0;4^Q "^DD",661.6,661.6,4,21,0) ^^27^27^3001129^ "^DD",661.6,661.6,4,21,1,0) This field records the transaction type, which can be one of the "^DD",661.6,661.6,4,21,2,0) following... "^DD",661.6,661.6,4,21,3,0) "^DD",661.6,661.6,4,21,4,0) Receipt - for receiving items into stock. "^DD",661.6,661.6,4,21,5,0) "^DD",661.6,661.6,4,21,6,0) Order - for when a stock item has been ordered from the vendor. "^DD",661.6,661.6,4,21,7,0) "^DD",661.6,661.6,4,21,8,0) Patient Issue - for when a stock item is issued to a veteran. "^DD",661.6,661.6,4,21,9,0) "^DD",661.6,661.6,4,21,10,0) Issue to Lab - this transaction should be used for those items which are "^DD",661.6,661.6,4,21,11,0) used by the labs to fabricate items. An example would be a "^DD",661.6,661.6,4,21,12,0) bag of plaster which could be used for treating several "^DD",661.6,661.6,4,21,13,0) patients. "^DD",661.6,661.6,4,21,14,0) "^DD",661.6,661.6,4,21,15,0) Return to Vendor - if an item has been received into stock but is later "^DD",661.6,661.6,4,21,16,0) returned to the vendor for some reason, then this "^DD",661.6,661.6,4,21,17,0) transaction type should be used. "^DD",661.6,661.6,4,21,18,0) "^DD",661.6,661.6,4,21,19,0) Write Off - use this transaction type when an item is removed from stock "^DD",661.6,661.6,4,21,20,0) and scrapped. "^DD",661.6,661.6,4,21,21,0) "^DD",661.6,661.6,4,21,22,0) Transfer - for transferring stock between locations. The transaction "^DD",661.6,661.6,4,21,23,0) quantity will be -ve for the 'transfer from' location. "^DD",661.6,661.6,4,21,24,0) "^DD",661.6,661.6,4,21,25,0) Return In - for when a veteran returns a stock item previously issued. "^DD",661.6,661.6,4,21,26,0) "^DD",661.6,661.6,4,21,27,0) Reconcile - for when a stock check is done. "^DD",661.6,661.6,4,"DT") 3010515 "^DD",661.6,661.6,5,0) QUANTITY^NJ8,0^^0;5^K:+X'=X!(X>99999999)!(X<-999999)!(X?.E1"."1N.N) X "^DD",661.6,661.6,5,3) Type a Number between -999999 and 99999999, 0 Decimal Digits "^DD",661.6,661.6,5,21,0) ^.001^1^1^3010426^^ "^DD",661.6,661.6,5,21,1,0) The number of items associated with the transaction. "^DD",661.6,661.6,5,"DT") 3010426 "^DD",661.6,661.6,6,0) VALUE^NJ11,2^^0;6^S:X["$" X=$P(X,"$",2) K:X'?."-".N.1".".2N!(X>99999999)!(X<-999999) X "^DD",661.6,661.6,6,3) Type a Dollar Amount between -999999 and 99999999, 2 Decimal Digits "^DD",661.6,661.6,6,21,0) ^.001^1^1^3010426^^ "^DD",661.6,661.6,6,21,1,0) The dollar value of the transaction. "^DD",661.6,661.6,6,"DT") 3010426 "^DD",661.6,661.6,8,0) COMMENT^F^^0;8^K:$L(X)>40!($L(X)<1) X "^DD",661.6,661.6,8,3) Answer must be 1-40 characters in length "^DD",661.6,661.6,8,21,0) ^^1^1^3001129^ "^DD",661.6,661.6,8,21,1,0) A short comment can be entered, if required for a particular transaction. "^DD",661.6,661.6,8,"DT") 3001129 "^DD",661.6,661.6,9,0) USER^P200'^VA(200,^0;9^Q "^DD",661.6,661.6,9,21,0) ^^2^2^3001129^ "^DD",661.6,661.6,9,21,1,0) This field points to the New Person file (200) and identifies the person "^DD",661.6,661.6,9,21,2,0) responsible for creating the transaction on the system. "^DD",661.6,661.6,9,"DT") 3001129 "^DD",661.6,661.6,11,0) HCPCS ITEM^RNJ10,0^^0;11^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",661.6,661.6,11,3) Type a Number between 1 and 9999999999, 0 Decimal Digits "^DD",661.6,661.6,11,21,0) ^.001^3^3^3010220^^ "^DD",661.6,661.6,11,21,1,0) This field is the HCPCS ITEM field held on the 661.12 sub field of the "^DD",661.6,661.6,11,21,2,0) PROSTHETIC HCPCS file (661.1). "^DD",661.6,661.6,11,21,3,0) The value held is the sub file's IEN not the ITEM text field. "^DD",661.6,661.6,11,"DT") 3010220 "^DD",661.6,661.6,12,0) VENDOR^P440'^PRC(440,^0;12^Q "^DD",661.6,661.6,12,3) Answer must be 1-30 characters in length "^DD",661.6,661.6,12,21,0) ^^4^4^3010112^ "^DD",661.6,661.6,12,21,1,0) This field is the FMS VENDOR CODE held on the VENDOR file (440). This "^DD",661.6,661.6,12,21,2,0) field is guaranteed to be unique irrespective of where a database is "^DD",661.6,661.6,12,21,3,0) located. The Vendor IEN should be derived from the 'D' cross-reference of "^DD",661.6,661.6,12,21,4,0) the Vendor file. "^DD",661.6,661.6,12,"DT") 3010118 "^DD",661.6,661.6,13,0) STATION^P4'^DIC(4,^0;13^Q "^DD",661.6,661.6,13,21,0) ^^1^1^3010116^ "^DD",661.6,661.6,13,21,1,0) This field is a pointer to the INSTITUTION file (4). "^DD",661.6,661.6,13,"DT") 3010515 "^DD",661.6,661.6,14,0) LOCATION^P661.5'^RMPR(661.5,^0;14^Q "^DD",661.6,661.6,14,21,0) ^^1^1^3010116^ "^DD",661.6,661.6,14,21,1,0) This field is a pointer to the PROSTHETIC STOCK LOCATION file (661.5). "^DD",661.6,661.6,14,"DT") 3010419 "^DD",661.63,661.63,0) FIELD^^12^12 "^DD",661.63,661.63,0,"DDA") N "^DD",661.63,661.63,0,"DT") 3030108 "^DD",661.63,661.63,0,"IX","B",661.63,.01) "^DD",661.63,661.63,0,"NM","PROSTHETIC TRANSACTION PATIENT ISSUE") "^DD",661.63,661.63,0,"VRPK") RMPR "^DD",661.63,661.63,.01,0) INVENTORY TRANSACTION^RP661.6'^RMPR(661.6,^0;1^Q "^DD",661.63,661.63,.01,1,0) ^.1 "^DD",661.63,661.63,.01,1,1,0) 661.63^B "^DD",661.63,661.63,.01,1,1,1) S ^RMPR(661.63,"B",$E(X,1,30),DA)="" "^DD",661.63,661.63,.01,1,1,2) K ^RMPR(661.63,"B",$E(X,1,30),DA) "^DD",661.63,661.63,.01,3) "^DD",661.63,661.63,.01,21,0) ^^1^1^3001122^ "^DD",661.63,661.63,.01,21,1,0) This field points to the Prosthetic Inventory Transaction file (661.6). "^DD",661.63,661.63,.01,"DT") 3001122 "^DD",661.63,661.63,2,0) PATIENT TRANSACTION^P660'^RMPR(660,^0;2^Q "^DD",661.63,661.63,2,21,0) ^^1^1^3001122^^ "^DD",661.63,661.63,2,21,1,0) This field points to the patient 2319 file (660). "^DD",661.63,661.63,2,"DT") 3001122 "^DD",661.63,661.63,3,0) CONVERSION POINTER^P661.2'^RMPR(661.2,^0;3^Q "^DD",661.63,661.63,3,.1) SAVED POINTER TO OLD 661.2 FILE "^DD",661.63,661.63,3,21,0) ^^5^5^3010611^ "^DD",661.63,661.63,3,21,1,0) This field is only updated by the Old to New PIP file conversion utility "^DD",661.63,661.63,3,21,2,0) (RMPRPIUG). It saves the pointer to the old 661.2 Inventory Transaction "^DD",661.63,661.63,3,21,3,0) file which is held in file 660. "^DD",661.63,661.63,3,21,4,0) Should a conversion ever need to be reversed then the 660 file should be "^DD",661.63,661.63,3,21,5,0) re-populated with this value (see RMPRPIXZ). "^DD",661.63,661.63,3,"DT") 3010611 "^DD",661.63,661.63,4,0) HCPCS^F^^0;4^K:$L(X)>10!($L(X)<5) X "^DD",661.63,661.63,4,3) Answer must be 5-10 characters in length "^DD",661.63,661.63,4,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,4,21,1,0) The HCPCS that is being issued to patient. "^DD",661.63,661.63,4,"DT") 3030108 "^DD",661.63,661.63,5,0) HCPCS ITEM^NJ10,0^^0;5^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1.N) X "^DD",661.63,661.63,5,3) Type a number between 1 and 9999999999, 0 Decimal Digits "^DD",661.63,661.63,5,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,5,21,1,0) This is an HCPCS item issued to patient. "^DD",661.63,661.63,5,"DT") 3030108 "^DD",661.63,661.63,6,0) DATE&TIME^D^^0;6^S %DT="ESTR" D ^%DT S X=Y K:X<1 X "^DD",661.63,661.63,6,3) (No range limit on date) "^DD",661.63,661.63,6,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,6,21,1,0) This is the date and time the item was received in the inventory. "^DD",661.63,661.63,6,"DT") 3030108 "^DD",661.63,661.63,7,0) STATION^P4'^DIC(4,^0;7^Q "^DD",661.63,661.63,7,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,7,21,1,0) This is the station where the patient belongs. "^DD",661.63,661.63,7,"DT") 3030108 "^DD",661.63,661.63,8,0) LOCATION^P661.5'^RMPR(661.5,^0;8^Q "^DD",661.63,661.63,8,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,8,21,1,0) This is where the HCPCS/ITEM was located prior to issueing to patient. "^DD",661.63,661.63,8,"DT") 3030108 "^DD",661.63,661.63,9,0) VENDOR^P440'^PRC(440,^0;9^Q "^DD",661.63,661.63,9,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,9,21,1,0) This is a pointer to the Vendor file #440. "^DD",661.63,661.63,9,"DT") 3030108 "^DD",661.63,661.63,10,0) COST^NJ11,2^^0;10^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999999)!(X<0)!(X?.E1"."3.N) X "^DD",661.63,661.63,10,3) Type a Dollar amount between 0 and 99999999, 2 Decimal Digits "^DD",661.63,661.63,10,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,10,21,1,0) This is the cost of an item being issued to patient. "^DD",661.63,661.63,10,"DT") 3030108 "^DD",661.63,661.63,11,0) UNIT OF ISSUE^P420.5'^PRCD(420.5,^0;11^Q "^DD",661.63,661.63,11,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,11,21,1,0) This is a pointer to Unit of Issue file #420.5. "^DD",661.63,661.63,11,"DT") 3030108 "^DD",661.63,661.63,12,0) QUANTITY^NJ4,0^^0;12^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1.N) X "^DD",661.63,661.63,12,3) Type a number between 1 and 9999, 0 Decimal Digits "^DD",661.63,661.63,12,21,0) ^^1^1^3030108^ "^DD",661.63,661.63,12,21,1,0) This is a quantity of item issued to patient. "^DD",661.63,661.63,12,"DT") 3030108 "^DD",661.69,661.69,0) FIELD^^3^3 "^DD",661.69,661.69,0,"DT") 3010510 "^DD",661.69,661.69,0,"IX","B",661.69,.01) "^DD",661.69,661.69,0,"NM","PROSTHETIC INVENTORY GAIN/LOSS") "^DD",661.69,661.69,0,"VRPK") RMPR "^DD",661.69,661.69,.01,0) TRANSACTION POINTER^RP661.6'^RMPR(661.6,^0;1^Q "^DD",661.69,661.69,.01,1,0) ^.1 "^DD",661.69,661.69,.01,1,1,0) 661.69^B "^DD",661.69,661.69,.01,1,1,1) S ^RMPR(661.69,"B",$E(X,1,30),DA)="" "^DD",661.69,661.69,.01,1,1,2) K ^RMPR(661.69,"B",$E(X,1,30),DA) "^DD",661.69,661.69,.01,3) POINTER TO 661.6 "^DD",661.69,661.69,.01,21,0) ^^2^2^3010510^ "^DD",661.69,661.69,.01,21,1,0) This field is the back pointer to the reconciliation transaction in file "^DD",661.69,661.69,.01,21,2,0) 661.6 "^DD",661.69,661.69,.01,"DT") 3010510 "^DD",661.69,661.69,2,0) GAIN/LOSS^NJ5,0^^0;2^K:+X'=X!(X>99999)!(X<-99999)!(X?.E1"."1.N) X "^DD",661.69,661.69,2,3) Type a number between -99999 and 99999, 0 Decimal Digits "^DD",661.69,661.69,2,21,0) ^^5^5^3010510^ "^DD",661.69,661.69,2,21,1,0) This records the quantity gained or lost after a reconciliation (stock "^DD",661.69,661.69,2,21,2,0) count) transaction has been posted for a HCPCS Item (for a given Station, "^DD",661.69,661.69,2,21,3,0) Location and Vendor). "^DD",661.69,661.69,2,21,4,0) The transaction record in file 661.6 will "^DD",661.69,661.69,2,21,5,0) record the actual quantity counted. "^DD",661.69,661.69,2,"DT") 3010510 "^DD",661.69,661.69,3,0) GAIN/LOSS VALUE^NJ9,2^^0;3^S:X["$" X=$P(X,"$",2) K:X'?."-".N.1".".2N!(X>999999.99)!(X<-999999.99)!(X?.E1"."3.N) X "^DD",661.69,661.69,3,3) Type a Dollar amount between -999999.99 and 999999.99, 2 Decimal Digits "^DD",661.69,661.69,3,21,0) ^^2^2^3010510^ "^DD",661.69,661.69,3,21,1,0) See comments for filed 2 - GAIN/LOSS. This is the dollar value associated "^DD",661.69,661.69,3,21,2,0) with the gain or loss. "^DD",661.69,661.69,3,"DT") 3010510 "^DD",661.7,661.7,0) FIELD^^8^9 "^DD",661.7,661.7,0,"DDA") N "^DD",661.7,661.7,0,"DT") 3010327 "^DD",661.7,661.7,0,"IX","B",661.7,.01) "^DD",661.7,661.7,0,"IX","C",661.7,5) "^DD",661.7,661.7,0,"IX","D",661.7,3) "^DD",661.7,661.7,0,"NM","PROSTHETIC CURRENT STOCK") "^DD",661.7,661.7,0,"VRPK") RMPR "^DD",661.7,661.7,.01,0) HCPCS^RF^^0;1^K:$L(X)>10!($L(X)<1) X "^DD",661.7,661.7,.01,1,0) ^.1 "^DD",661.7,661.7,.01,1,1,0) 661.7^B "^DD",661.7,661.7,.01,1,1,1) S ^RMPR(661.7,"B",$E(X,1,30),DA)="" "^DD",661.7,661.7,.01,1,1,2) K ^RMPR(661.7,"B",$E(X,1,30),DA) "^DD",661.7,661.7,.01,3) Answer must be 1-10 characters in length. "^DD",661.7,661.7,.01,21,0) ^.001^1^1^3010327^^ "^DD",661.7,661.7,.01,21,1,0) This field is a pointer to the Prosthetic HCPCs file (661.1). "^DD",661.7,661.7,.01,"DT") 3010328 "^DD",661.7,661.7,1,0) DATE&TIME STAMP^D^^0;2^S %DT="ESTXR" D ^%DT S X=Y K:X<1 X "^DD",661.7,661.7,1,3) (No range limit on date) "^DD",661.7,661.7,1,"DT") 3010328 "^DD",661.7,661.7,2,0) SEQUENCE^NJ2,0^^0;3^K:+X'=X!(X>99)!(X<1)!(X?.E1"."1.N) X "^DD",661.7,661.7,2,3) Type a number between 1 and 99, 0 Decimal Digits "^DD",661.7,661.7,2,21,0) ^^1^1^3010117^ "^DD",661.7,661.7,2,21,1,0) This is the same SEQUENCE as in the PROSTHETIC TRANSACTION file (661.6) "^DD",661.7,661.7,2,"DT") 3010328 "^DD",661.7,661.7,3,0) HCPCS ITEM^RNJ10,0^^0;4^K:+X'=X!(X>9999999999)!(X<1)!(X?.E1"."1N.N) X "^DD",661.7,661.7,3,1,0) ^.1 "^DD",661.7,661.7,3,1,1,0) 661.7^D "^DD",661.7,661.7,3,1,1,1) S ^RMPR(661.7,"D",$E(X,1,30),DA)="" "^DD",661.7,661.7,3,1,1,2) K ^RMPR(661.7,"D",$E(X,1,30),DA) "^DD",661.7,661.7,3,1,1,"DT") 3010406 "^DD",661.7,661.7,3,3) Type a Number between 1 and 9999999999, 0 Decimal Digits "^DD",661.7,661.7,3,21,0) ^.001^2^2^3010223^^ "^DD",661.7,661.7,3,21,1,0) This field is a pointer to the 661.12 sub-file of the PROSTHETIC HCPCS "^DD",661.7,661.7,3,21,2,0) file (661.1). "^DD",661.7,661.7,3,"DT") 3010406 "^DD",661.7,661.7,4,0) STATION^P4'^DIC(4,^0;5^Q "^DD",661.7,661.7,4,21,0) ^^1^1^3010117^ "^DD",661.7,661.7,4,21,1,0) This field is a pointer to the INSTITUTION file (4). "^DD",661.7,661.7,4,"DT") 3010328 "^DD",661.7,661.7,5,0) LOCATION^P661.5'^RMPR(661.5,^0;6^Q "^DD",661.7,661.7,5,1,0) ^.1 "^DD",661.7,661.7,5,1,1,0) 661.7^C "^DD",661.7,661.7,5,1,1,1) S ^RMPR(661.7,"C",$E(X,1,30),DA)="" "^DD",661.7,661.7,5,1,1,2) K ^RMPR(661.7,"C",$E(X,1,30),DA) "^DD",661.7,661.7,5,1,1,"DT") 3010406 "^DD",661.7,661.7,5,21,0) ^^1^1^3010117^ "^DD",661.7,661.7,5,21,1,0) This field points to the PROSTHETIC STOCK LOCATION file (661.5). "^DD",661.7,661.7,5,"DT") 3010406 "^DD",661.7,661.7,6,0) QUANTITY^NJ9,0^^0;7^K:+X'=X!(X>999999999)!(X<-999999999)!(X?.E1"."1.N) X "^DD",661.7,661.7,6,3) Type a number between -999999999 and 999999999, 0 Decimal Digits "^DD",661.7,661.7,6,21,0) ^^1^1^3010117^ "^DD",661.7,661.7,6,21,1,0) This field is the quantity of stock. "^DD",661.7,661.7,6,"DT") 3010117 "^DD",661.7,661.7,7,0) VALUE^NJ12,2^^0;8^S:X["$" X=$P(X,"$",2) K:X'?."-".N.1".".2N!(X>999999999)!(X<-999999999)!(X?.E1"."3.N) X "^DD",661.7,661.7,7,3) Type a Dollar amount between -999999999 and 999999999, 2 Decimal Digits "^DD",661.7,661.7,7,21,0) ^^2^2^3010117^ "^DD",661.7,661.7,7,21,1,0) This field is the total dollar value of the stock item held on this "^DD",661.7,661.7,7,21,2,0) record. "^DD",661.7,661.7,7,"DT") 3010117 "^DD",661.7,661.7,8,0) UNIT OF ISSUE^P420.5^PRCD(420.5,^0;9^Q "^DD",661.7,661.7,8,21,0) ^^1^1^3021118^ "^DD",661.7,661.7,8,21,1,0) This field is a pointer to Unit of Issue file (#420.5). "^DD",661.7,661.7,8,"DT") 3021118 "^DD",661.8,661.8,0) FIELD^^5^5 "^DD",661.8,661.8,0,"DDA") N "^DD",661.8,661.8,0,"DT") 3001129 "^DD",661.8,661.8,0,"IX","B",661.8,.01) "^DD",661.8,661.8,0,"NM","VENDOR PRODUCT HCPCS MAP") "^DD",661.8,661.8,0,"VRPK") RMPR "^DD",661.8,661.8,.01,0) VENDOR UCC CODE^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E) X "^DD",661.8,661.8,.01,1,0) ^.1 "^DD",661.8,661.8,.01,1,1,0) 661.8^B "^DD",661.8,661.8,.01,1,1,1) S ^RMPR(661.8,"B",$E(X,1,30),DA)="" "^DD",661.8,661.8,.01,1,1,2) K ^RMPR(661.8,"B",$E(X,1,30),DA) "^DD",661.8,661.8,.01,3) Answer must be 3-30 characters in length "^DD",661.8,661.8,.01,21,0) ^^3^3^3001129^ "^DD",661.8,661.8,.01,21,1,0) This is a unique code assigned by the Uniform Code Council (UCC) to "^DD",661.8,661.8,.01,21,2,0) product vendors. This code is obtained from scanning in the bar code found "^DD",661.8,661.8,.01,21,3,0) with a vendor's products. "^DD",661.8,661.8,.01,"DT") 3001129 "^DD",661.8,661.8,2,0) PRODUCT UCC CODE^F^^0;2^K:$L(X)>30!($L(X)<3) X "^DD",661.8,661.8,2,3) Answer must be 3-30 characters in length "^DD",661.8,661.8,2,21,0) ^^2^2^3001129^ "^DD",661.8,661.8,2,21,1,0) This is the unique UCC product code used by a given vendor. This code is "^DD",661.8,661.8,2,21,2,0) obtained by scanning the UPC barcode associated with an item. "^DD",661.8,661.8,2,"DT") 3001129 "^DD",661.8,661.8,3,0) VENDOR VA CODE^P440'^PRC(440,^0;3^Q "^DD",661.8,661.8,3,21,0) ^^1^1^3001129^ "^DD",661.8,661.8,3,21,1,0) This field points to the Vendor file (440). "^DD",661.8,661.8,3,"DT") 3001129 "^DD",661.8,661.8,4,0) HCPCS CODE^P661.1'^RMPR(661.1,^0;4^Q "^DD",661.8,661.8,4,21,0) ^^1^1^3001129^ "^DD",661.8,661.8,4,21,1,0) This field points to the Prosthetic HCPCS file (661.1). "^DD",661.8,661.8,4,"DT") 3001129 "^DD",661.8,661.8,5,0) HCPCS ITEM^F^^0;5^K:$L(X)>30!($L(X)<1) X "^DD",661.8,661.8,5,3) Answer must be 1-30 characters in length "^DD",661.8,661.8,5,21,0) ^^3^3^3010605^ "^DD",661.8,661.8,5,21,1,0) This field is the HCPCS ITEM field held on the 661.12 sub "^DD",661.8,661.8,5,21,2,0) field of the PROSTHETIC HCPCS file (661.1). "^DD",661.8,661.8,5,21,3,0) The value held is the sub file's IEN not the ITEM text field. "^DD",661.8,661.8,5,"DT") 3010605 "^DD",661.9,661.9,0) FIELD^^8^6 "^DD",661.9,661.9,0,"DDA") N "^DD",661.9,661.9,0,"DT") 3010214 "^DD",661.9,661.9,0,"IX","B",661.9,.01) "^DD",661.9,661.9,0,"NM","PROSTHETICS HCPCS RUNNING BALANCE") "^DD",661.9,661.9,0,"VRPK") RMPR "^DD",661.9,661.9,.01,0) DATE^RD^^0;1^S %DT="E" D ^%DT S X=Y K:X<1 X "^DD",661.9,661.9,.01,1,0) ^.1 "^DD",661.9,661.9,.01,1,1,0) 661.9^B "^DD",661.9,661.9,.01,1,1,1) S ^RMPR(661.9,"B",$E(X,1,30),DA)="" "^DD",661.9,661.9,.01,1,1,2) K ^RMPR(661.9,"B",$E(X,1,30),DA) "^DD",661.9,661.9,.01,3) (No range limit on date) "^DD",661.9,661.9,.01,"DT") 3010222 "^DD",661.9,661.9,1,0) HCPCS^RF^^0;2^K:$L(X)>10!($L(X)<5) X "^DD",661.9,661.9,1,3) Answer must be 5-10 characters in length. "^DD",661.9,661.9,1,21,0) ^^1^1^3010214^ "^DD",661.9,661.9,1,21,1,0) This is the HCPCS name as it shows in file #661.1. "^DD",661.9,661.9,1,"DT") 3010222 "^DD",661.9,661.9,2,0) HCPCS ITEM^RNJ9,0^^0;3^K:+X'=X!(X>999999999)!(X<1)!(X?.E1"."1.N) X "^DD",661.9,661.9,2,3) Type a number between 1 and 999999999, 0 Decimal Digits "^DD",661.9,661.9,2,21,0) ^^1^1^3010116^ "^DD",661.9,661.9,2,21,1,0) This is a pointer to ITEM sub-record (#661.12) in file (#661.1). "^DD",661.9,661.9,2,"DT") 3010222 "^DD",661.9,661.9,4,0) STATION^P4'^DIC(4,^0;5^Q "^DD",661.9,661.9,4,21,0) ^^1^1^3010116^ "^DD",661.9,661.9,4,21,1,0) This is a pointer to Institution file (#4). "^DD",661.9,661.9,4,"DT") 3010222 "^DD",661.9,661.9,7,0) TOTAL QUANTITY^NJ7,0^^0;8^K:+X'=X!(X>9999999)!(X<0)!(X?.E1"."1N.N) X "^DD",661.9,661.9,7,3) Type a Number between 0 and 9999999, 0 Decimal Digits "^DD",661.9,661.9,7,21,0) ^^2^2^3010116^ "^DD",661.9,661.9,7,21,1,0) This is the total quantity of an item for only one location and "^DD",661.9,661.9,7,21,2,0) station. "^DD",661.9,661.9,7,"DT") 3010116 "^DD",661.9,661.9,8,0) TOTAL VALUE^NJ10,2^^0;9^S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>9999999)!(X<0) X "^DD",661.9,661.9,8,3) Type a Dollar Amount between 0 and 9999999, 2 Decimal Digits "^DD",661.9,661.9,8,21,0) ^^2^2^3010116^ "^DD",661.9,661.9,8,21,1,0) This is the total value or cost of an item for only one location and "^DD",661.9,661.9,8,21,2,0) station. "^DD",661.9,661.9,8,"DT") 3010116 "^DIC",661.11,661.11,0) PROSTHETICS HCPCS ITEM MASTER FILE^661.11 "^DIC",661.11,661.11,0,"GL") ^RMPR(661.11, "^DIC",661.11,661.11,"%",0) ^1.005^^0 "^DIC",661.11,661.11,"%D",0) ^1.001^2^2^3021211^^ "^DIC",661.11,661.11,"%D",1,0) This file contains all unique (Prosthetics Sensory and Aids Service) PSAS "^DIC",661.11,661.11,"%D",2,0) HCPCS Items for all stations or divisions under one computer system. "^DIC",661.11,"B","PROSTHETICS HCPCS ITEM MASTER FILE",661.11) "^DIC",661.4,661.4,0) HCPCS INVENTORY^661.4 "^DIC",661.4,661.4,0,"GL") ^RMPR(661.4, "^DIC",661.4,661.4,"%",0) ^1.005^^0 "^DIC",661.4,661.4,"%D",0) ^^2^2^3020423^ "^DIC",661.4,661.4,"%D",1,0) This file holds the re-order quantity for a given HCPCS item at a given "^DIC",661.4,661.4,"%D",2,0) LOCATION and STATION. "^DIC",661.4,"B","HCPCS INVENTORY",661.4) "^DIC",661.41,661.41,0) HCPCS INVENTORY ORDER AND REORDER^661.41 "^DIC",661.41,661.41,0,"GL") ^RMPR(661.41, "^DIC",661.41,661.41,"%",0) ^1.005^^0 "^DIC",661.41,661.41,"%D",0) ^^2^2^3010806^ "^DIC",661.41,661.41,"%D",1,0) This file holds the PSAS HCPCS order and reorder entries. An entry is "^DIC",661.41,661.41,"%D",2,0) created when an order is entered or created by the user. "^DIC",661.41,"B","HCPCS INVENTORY ORDER AND REORDER",661.41) "^DIC",661.5,661.5,0) PROSTHETIC STOCK LOCATION^661.5 "^DIC",661.5,661.5,0,"GL") ^RMPR(661.5, "^DIC",661.5,661.5,"%",0) ^1.005^^0 "^DIC",661.5,661.5,"%D",0) ^^2^2^3001129^ "^DIC",661.5,661.5,"%D",1,0) This file holds the name, address and station number of each stock "^DIC",661.5,661.5,"%D",2,0) location. There will be an index by Station Number and Location Name. "^DIC",661.5,"B","PROSTHETIC STOCK LOCATION",661.5) "^DIC",661.6,661.6,0) PROSTHETIC INVENTORY TRANSACTION^661.6 "^DIC",661.6,661.6,0,"GL") ^RMPR(661.6, "^DIC",661.6,661.6,"%",0) ^1.005^^0 "^DIC",661.6,661.6,"%D",0) ^^1^1^3001129^ "^DIC",661.6,661.6,"%D",1,0) This file records each transaction as it pertains to inventory. "^DIC",661.6,"B","PROSTHETIC INVENTORY TRANSACTION",661.6) "^DIC",661.63,661.63,0) PROSTHETIC TRANSACTION PATIENT ISSUE^661.63 "^DIC",661.63,661.63,0,"GL") ^RMPR(661.63, "^DIC",661.63,661.63,"%",0) ^1.005^^0 "^DIC",661.63,661.63,"%D",0) ^^16^16^3001129^ "^DIC",661.63,661.63,"%D",1,0) This file is used to hold pointers to the patient 2319 file (660). "^DIC",661.63,661.63,"%D",2,0) Each time a stock item is issued to a veteran the following files will be "^DIC",661.63,661.63,"%D",3,0) updated... "^DIC",661.63,661.63,"%D",4,0) "^DIC",661.63,661.63,"%D",5,0) 660 - Create record of Prosthetic Appliance/Repair (patient's 2319) "^DIC",661.63,661.63,"%D",6,0) "^DIC",661.63,661.63,"%D",7,0) 661.6 - Create Prosthetic Inventory Transaction record "^DIC",661.63,661.63,"%D",8,0) "^DIC",661.63,661.63,"%D",9,0) 661.4 - reduce stock on-hand quantity and value by issued amounts for "^DIC",661.63,661.63,"%D",10,0) HCPC item, vendor, location and unit of measure. "^DIC",661.63,661.63,"%D",11,0) "^DIC",661.63,661.63,"%D",12,0) 661.63 - record pointers to the 660 and 661.6 file records just created. "^DIC",661.63,661.63,"%D",13,0) "^DIC",661.63,661.63,"%D",14,0) 661.7 - reduce stock quantity and value by issued quantity and value. "^DIC",661.63,661.63,"%D",15,0) If the new stock quantity for the stock date and location is "^DIC",661.63,661.63,"%D",16,0) 0 then delete the record. "^DIC",661.63,"B","PROSTHETIC TRANSACTION PATIENT ISSUE",661.63) "^DIC",661.69,661.69,0) PROSTHETIC INVENTORY GAIN/LOSS^661.69 "^DIC",661.69,661.69,0,"GL") ^RMPR(661.69, "^DIC",661.69,"B","PROSTHETIC INVENTORY GAIN/LOSS",661.69) "^DIC",661.7,661.7,0) PROSTHETIC CURRENT STOCK^661.7 "^DIC",661.7,661.7,0,"GL") ^RMPR(661.7, "^DIC",661.7,661.7,"%",0) ^1.005^^0 "^DIC",661.7,661.7,"%D",0) ^^17^17^3001122^ "^DIC",661.7,661.7,"%D",1,0) This file implements the concept of 'First In First Out' (FIFO) stock "^DIC",661.7,661.7,"%D",2,0) accounting. "^DIC",661.7,661.7,"%D",3,0) "^DIC",661.7,661.7,"%D",4,0) Whenever stock items are brought into stock on a given date an entry will "^DIC",661.7,661.7,"%D",5,0) be created for that date for the relevant HCPC item, location, vendor and "^DIC",661.7,661.7,"%D",6,0) unit of measure. The date will include time to cater for the rare instance "^DIC",661.7,661.7,"%D",7,0) where the same stock item with the same vendor, location and unit of "^DIC",661.7,661.7,"%D",8,0) measure is brought into stock on the same day but with a different cost. "^DIC",661.7,661.7,"%D",9,0) "^DIC",661.7,661.7,"%D",10,0) This file can then be used to look up locations containing the oldest "^DIC",661.7,661.7,"%D",11,0) stock for any given HCPC item. "^DIC",661.7,661.7,"%D",12,0) "^DIC",661.7,661.7,"%D",13,0) When items are removed from stock the associated vendor and location will "^DIC",661.7,661.7,"%D",14,0) be identified by scanning a bar code (or manual entry in case of equipment "^DIC",661.7,661.7,"%D",15,0) problems). The system will then assume that the oldest item for the vendor "^DIC",661.7,661.7,"%D",16,0) and location has been issued and will reduce the stock quantity. If the "^DIC",661.7,661.7,"%D",17,0) quantity becomes 0 or -ve the record will be deleted. "^DIC",661.7,"B","PROSTHETIC CURRENT STOCK",661.7) "^DIC",661.8,661.8,0) VENDOR PRODUCT HCPCS MAP^661.8 "^DIC",661.8,661.8,0,"GL") ^RMPR(661.8, "^DIC",661.8,661.8,"%",0) ^1.005^^0 "^DIC",661.8,661.8,"%D",0) ^^2^2^3010605^ "^DIC",661.8,661.8,"%D",1,0) This file is not being used at present. It will be used for barcode "^DIC",661.8,661.8,"%D",2,0) implementation. "^DIC",661.8,"B","VENDOR PRODUCT HCPCS MAP",661.8) "^DIC",661.9,661.9,0) PROSTHETICS HCPCS RUNNING BALANCE^661.9 "^DIC",661.9,661.9,0,"GL") ^RMPR(661.9, "^DIC",661.9,661.9,"%",0) ^1.005^1^1 "^DIC",661.9,661.9,"%",1,0) RMPR "^DIC",661.9,661.9,"%","B","RMPR",1) "^DIC",661.9,661.9,"%D",0) ^^5^5^3010214^ "^DIC",661.9,661.9,"%D",1,0) This file holds the running balance of an inventory for every HCPCS and "^DIC",661.9,661.9,"%D",2,0) HCPCS ITEM for a particular station. All transactions created using "^DIC",661.9,661.9,"%D",3,0) the Stock Issue options and Prosthetics Inventory Program (PIP) will have "^DIC",661.9,661.9,"%D",4,0) an entry in this file in chronological order indexed by Station, HCPCS and "^DIC",661.9,661.9,"%D",5,0) date. "^DIC",661.9,"B","PROSTHETICS HCPCS RUNNING BALANCE",661.9) **END** **END**