Released RMPR*3*108 SEQ #91 Extracted from mail message **KIDS**:RMPR*3.0*108^ **INSTALL NAME** RMPR*3.0*108 "BLD",5721,0) RMPR*3.0*108^PROSTHETICS^0^3060120^y "BLD",5721,1,0) ^^4^4^3060119^ "BLD",5721,1,1,0) This patch will address three issues: "BLD",5721,1,2,0) 1. The hard coded Default Barcode Printer Name "BLD",5721,1,3,0) 2. The P-ZEBRA printer subtype requirement "BLD",5721,1,4,0) 3. Items still being added to a inactive location "BLD",5721,4,0) ^9.64PA^^ "BLD",5721,6.3) 4 "BLD",5721,"ABPKG") n "BLD",5721,"KRN",0) ^9.67PA^8989.52^19 "BLD",5721,"KRN",.4,0) .4 "BLD",5721,"KRN",.401,0) .401 "BLD",5721,"KRN",.402,0) .402 "BLD",5721,"KRN",.403,0) .403 "BLD",5721,"KRN",.5,0) .5 "BLD",5721,"KRN",.84,0) .84 "BLD",5721,"KRN",3.6,0) 3.6 "BLD",5721,"KRN",3.8,0) 3.8 "BLD",5721,"KRN",9.2,0) 9.2 "BLD",5721,"KRN",9.8,0) 9.8 "BLD",5721,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",5721,"KRN",9.8,"NM",1,0) RMPRPIY9^^0^31403024 "BLD",5721,"KRN",9.8,"NM",2,0) RMPRPIYS^^0^84190403 "BLD",5721,"KRN",9.8,"NM",3,0) RMPRPIYZ^^0^11314468 "BLD",5721,"KRN",9.8,"NM","B","RMPRPIY9",1) "BLD",5721,"KRN",9.8,"NM","B","RMPRPIYS",2) "BLD",5721,"KRN",9.8,"NM","B","RMPRPIYZ",3) "BLD",5721,"KRN",19,0) 19 "BLD",5721,"KRN",19.1,0) 19.1 "BLD",5721,"KRN",101,0) 101 "BLD",5721,"KRN",409.61,0) 409.61 "BLD",5721,"KRN",771,0) 771 "BLD",5721,"KRN",870,0) 870 "BLD",5721,"KRN",8989.51,0) 8989.51 "BLD",5721,"KRN",8989.52,0) 8989.52 "BLD",5721,"KRN",8994,0) 8994 "BLD",5721,"KRN","B",.4,.4) "BLD",5721,"KRN","B",.401,.401) "BLD",5721,"KRN","B",.402,.402) "BLD",5721,"KRN","B",.403,.403) "BLD",5721,"KRN","B",.5,.5) "BLD",5721,"KRN","B",.84,.84) "BLD",5721,"KRN","B",3.6,3.6) "BLD",5721,"KRN","B",3.8,3.8) "BLD",5721,"KRN","B",9.2,9.2) "BLD",5721,"KRN","B",9.8,9.8) "BLD",5721,"KRN","B",19,19) "BLD",5721,"KRN","B",19.1,19.1) "BLD",5721,"KRN","B",101,101) "BLD",5721,"KRN","B",409.61,409.61) "BLD",5721,"KRN","B",771,771) "BLD",5721,"KRN","B",870,870) "BLD",5721,"KRN","B",8989.51,8989.51) "BLD",5721,"KRN","B",8989.52,8989.52) "BLD",5721,"KRN","B",8994,8994) "BLD",5721,"QUES",0) ^9.62^^ "BLD",5721,"REQB",0) ^9.611^1^1 "BLD",5721,"REQB",1,0) RMPR*3.0*61^2 "BLD",5721,"REQB","B","RMPR*3.0*61",1) "MBREQ") 0 "PKG",101,-1) 1^1 "PKG",101,0) PROSTHETICS^RMPR^PROSTHETICS VERSION 3.0 ALPHA "PKG",101,20,0) ^9.402P^^0 "PKG",101,22,0) ^9.49I^1^1 "PKG",101,22,1,0) 3.0^2960209^2960214 "PKG",101,22,1,"PAH",1,0) 108^3060120 "PKG",101,22,1,"PAH",1,1,0) ^^4^4^3060120 "PKG",101,22,1,"PAH",1,1,1,0) This patch will address three issues: "PKG",101,22,1,"PAH",1,1,2,0) 1. The hard coded Default Barcode Printer Name "PKG",101,22,1,"PAH",1,1,3,0) 2. The P-ZEBRA printer subtype requirement "PKG",101,22,1,"PAH",1,1,4,0) 3. Items still being added to a inactive location "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") 3 "RTN","RMPRPIY9") 0^1^B31403024 "RTN","RMPRPIY9",1,0) RMPRPIY9 ;HINCIO/ODJ - AE - Add/Edit Locations and Items ;3/8/01 "RTN","RMPRPIY9",2,0) ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996 "RTN","RMPRPIY9",3,0) Q "RTN","RMPRPIY9",4,0) ; "RTN","RMPRPIY9",5,0) ;***** AE - Add Inventory LOCATIONS and ITEMS "RTN","RMPRPIY9",6,0) ; option RMPR INV ADD "RTN","RMPRPIY9",7,0) ; Replaces AE option in old PIP (cf ^RMPR5NAE) "RTN","RMPRPIY9",8,0) ; no inputs required "RTN","RMPRPIY9",9,0) ; other than standard VISTA vars. (DUZ, etc) "RTN","RMPRPIY9",10,0) ; "RTN","RMPRPIY9",11,0) AE N RMPRERR,RMPRSTN,RMPREXC,RMPR5,RMPR1,RMPR11,RMPRVEND,RMPRTVAL,RMPRDUP "RTN","RMPRPIY9",12,0) N RMPRQTY,RMPRREO,RMPR61,RMPRUCST,RMPROVAL,RMPRI,RMPRUPDF "RTN","RMPRPIY9",13,0) ; "RTN","RMPRPIY9",14,0) ;***** STN - call prompt for Site/Station "RTN","RMPRPIY9",15,0) STN S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIY9",16,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIY9",17,0) I RMPRERR G AEX "RTN","RMPRPIY9",18,0) I RMPREXC'="" G AEX "RTN","RMPRPIY9",19,0) I RMPROVAL'=RMPRSTN("IEN") K RMPR5 "RTN","RMPRPIY9",20,0) ; "RTN","RMPRPIY9",21,0) ;***** LOCN - call prompt for Location "RTN","RMPRPIY9",22,0) LOCN W !!,"Adding Item to a Location.",! "RTN","RMPRPIY9",23,0) S RMPROVAL=$G(RMPR5("IEN")) "RTN","RMPRPIY9",24,0) S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIY9",25,0) I RMPREXC="T"!(RMPREXC="^") G AEX "RTN","RMPRPIY9",26,0) I RMPREXC="P" G STN "RTN","RMPRPIY9",27,0) I RMPROVAL'=RMPR5("IEN") K RMPR1 "RTN","RMPRPIY9",28,0) I $P($G(^RMPR(661.5,RMPR5("IEN"),0)),U,4)="I" W !!,"LOCATION IS INACTIVE AND CANNOT BE EDITED, OR ASSOCIATED ITEMS!!" K RMPR5 G LOCN "RTN","RMPRPIY9",29,0) LOCN2 S RMPR5("STATION")=RMPRSTN("IEN") "RTN","RMPRPIY9",30,0) S RMPR5("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIY9",31,0) ; "RTN","RMPRPIY9",32,0) ;***** HCPCS - call prompt for HCPCS code "RTN","RMPRPIY9",33,0) HCPCS S RMPROVAL=$G(RMPR1("HCPCS")) "RTN","RMPRPIY9",34,0) S RMPR1("HCPCS")="" "RTN","RMPRPIY9",35,0) W ! S RMPRERR=$$HCPCS^RMPRPIY3(.RMPR5,.RMPR1,.RMPREXC) "RTN","RMPRPIY9",36,0) I RMPREXC="T"!(RMPREXC="^") G AEX "RTN","RMPRPIY9",37,0) I RMPREXC="P" G LOCN "RTN","RMPRPIY9",38,0) I RMPROVAL'=RMPR1("HCPCS") D "RTN","RMPRPIY9",39,0) . K RMPR11,RMPR61 "RTN","RMPRPIY9",40,0) . S RMPR11("HCPCS")=RMPR1("HCPCS") "RTN","RMPRPIY9",41,0) . Q "RTN","RMPRPIY9",42,0) S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIY9",43,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIY9",44,0) ; "RTN","RMPRPIY9",45,0) ;***** MASIT - call prompt for master item (in 661->441) "RTN","RMPRPIY9",46,0) MASIT S RMPROVAL=$G(RMPR61("IEN")) "RTN","RMPRPIY9",47,0) D MASIT^RMPRPIY1(.RMPR61,.RMPREXC) "RTN","RMPRPIY9",48,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",49,0) I RMPREXC="P" G HCPCS "RTN","RMPRPIY9",50,0) I RMPREXC="^" G AEX "RTN","RMPRPIY9",51,0) I RMPROVAL'=RMPR61("IEN") D "RTN","RMPRPIY9",52,0) . S RMPRERR=$$GET^RMPRPIXD(.RMPR61) "RTN","RMPRPIY9",53,0) . K RMPRSRC,RMPRREO,RMPR4 "RTN","RMPRPIY9",54,0) . S RMPR11("ITEM MASTER IEN")=RMPR61("IEN") "RTN","RMPRPIY9",55,0) . S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",56,0) . S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",57,0) . Q "RTN","RMPRPIY9",58,0) ; "RTN","RMPRPIY9",59,0) ;***** IDESC - call prompt for Item Description edit "RTN","RMPRPIY9",60,0) IDESC S RMPROVAL=$G(RMPR11("DESCRIPTION")) "RTN","RMPRPIY9",61,0) D ITED^RMPRPIY4(.RMPR11,.RMPREXC) "RTN","RMPRPIY9",62,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",63,0) I RMPREXC="P" G MASIT "RTN","RMPRPIY9",64,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",65,0) I $G(RMPR11("DESCRIPTION"))="" D "RTN","RMPRPIY9",66,0) . S RMPR11("DESCRIPTION")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",67,0) . S RMPR11("ITEM MASTER")=RMPR61("ITEM MASTER") "RTN","RMPRPIY9",68,0) . Q "RTN","RMPRPIY9",69,0) I RMPROVAL'=RMPR11("DESCRIPTION") D "RTN","RMPRPIY9",70,0) . K RMPRSRC,RMPRREO "RTN","RMPRPIY9",71,0) . Q "RTN","RMPRPIY9",72,0) ; "RTN","RMPRPIY9",73,0) ;***** SRC - call prompt for Source (Commercial or VA) "RTN","RMPRPIY9",74,0) SRC S RMPROVAL=$G(RMPRSRC) "RTN","RMPRPIY9",75,0) D SRC^RMPRPIY5(.RMPRSRC,.RMPREXC) "RTN","RMPRPIY9",76,0) I RMPREXC="P" G IDESC "RTN","RMPRPIY9",77,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",78,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",79,0) I RMPROVAL'=RMPRSRC K RMPRREO "RTN","RMPRPIY9",80,0) ; "RTN","RMPRPIY9",81,0) ; Update the inventory file (661.11) "RTN","RMPRPIY9",82,0) S RMPR11("SOURCE")=RMPRSRC "RTN","RMPRPIY9",83,0) S RMPR11("UNIT")="" "RTN","RMPRPIY9",84,0) S RMPRERR=0 "RTN","RMPRPIY9",85,0) S RMPRUPDF=1 ;update flag "RTN","RMPRPIY9",86,0) ; "RTN","RMPRPIY9",87,0) ; Only create new record if one doesn't already exist "RTN","RMPRPIY9",88,0) I $D(^RMPR(661.11,"ASHMDI",RMPRSTN("IEN"),RMPR11("HCPCS"),RMPR61("IEN"),RMPR11("DESCRIPTION"))) D "RTN","RMPRPIY9",89,0) . S RMPRI="" "RTN","RMPRPIY9",90,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",91,0) .. S RMPR11("ITEM")=RMPRI "RTN","RMPRPIY9",92,0) .. S RMPR11("IEN")="" "RTN","RMPRPIY9",93,0) .. S RMPRERR=$$DUP^RMPRPIX1(.RMPR11,.RMPRDUP) "RTN","RMPRPIY9",94,0) .. I RMPRERR S RMPRUPDF=0 Q "RTN","RMPRPIY9",95,0) .. I 'RMPRDUP S RMPRUPDF=0 Q "RTN","RMPRPIY9",96,0) .. Q "RTN","RMPRPIY9",97,0) . Q "RTN","RMPRPIY9",98,0) I RMPRUPDF D "RTN","RMPRPIY9",99,0) . S RMPR11("ITEM")="" "RTN","RMPRPIY9",100,0) . K RMPR11("IEN") "RTN","RMPRPIY9",101,0) . S RMPRERR=$$CRE^RMPRPIX1(.RMPR11) "RTN","RMPRPIY9",102,0) . S RMPR4("RE-ORDER QTY")=0 "RTN","RMPRPIY9",103,0) . S RMPRERR=$$CRE^RMPRPIX4(.RMPR4,.RMPR11,.RMPR5) "RTN","RMPRPIY9",104,0) . Q "RTN","RMPRPIY9",105,0) I RMPRERR D G AEX "RTN","RMPRPIY9",106,0) . W !,"Problem updating inventory item file, please contact support." "RTN","RMPRPIY9",107,0) . H 3 "RTN","RMPRPIY9",108,0) . Q "RTN","RMPRPIY9",109,0) ; "RTN","RMPRPIY9",110,0) ;***** REO - call prompt for Re-Order Quantity "RTN","RMPRPIY9",111,0) REO S RMPROVAL=$G(RMPRREO) "RTN","RMPRPIY9",112,0) D REO^RMPRPIY5(.RMPRREO,.RMPREXC) "RTN","RMPRPIY9",113,0) I RMPREXC="P" G SRC "RTN","RMPRPIY9",114,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",115,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",116,0) ; "RTN","RMPRPIY9",117,0) ; Update the reorder file (661.4) "RTN","RMPRPIY9",118,0) I RMPROVAL=RMPRREO G QTY "RTN","RMPRPIY9",119,0) S RMPR4("RE-ORDER QTY")=RMPRREO "RTN","RMPRPIY9",120,0) S RMPRERR=$$UPD^RMPRPIX4(.RMPR4,,) "RTN","RMPRPIY9",121,0) ; "RTN","RMPRPIY9",122,0) ; At this point the item has been added to inventory (661.11) and "RTN","RMPRPIY9",123,0) ; the re-order file (661.4) "RTN","RMPRPIY9",124,0) ; The following prompts are for receipting in a quantity of the item "RTN","RMPRPIY9",125,0) ; "RTN","RMPRPIY9",126,0) ;***** QTY - call prompt for Quantity "RTN","RMPRPIY9",127,0) QTY D QTY^RMPRPIY5(.RMPRQTY,.RMPREXC) "RTN","RMPRPIY9",128,0) I RMPREXC="P" G REO "RTN","RMPRPIY9",129,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",130,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",131,0) S RMPRQTY=+$G(RMPRQTY) "RTN","RMPRPIY9",132,0) I 'RMPRQTY G QTY "RTN","RMPRPIY9",133,0) ; "RTN","RMPRPIY9",134,0) ;***** UCST - call prompt for Unit Cost "RTN","RMPRPIY9",135,0) UCST D UCST^RMPRPIY5(.RMPRUCST,.RMPREXC) "RTN","RMPRPIY9",136,0) I RMPREXC="P" G QTY "RTN","RMPRPIY9",137,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",138,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",139,0) S RMPRUCST=+$G(RMPRUCST) "RTN","RMPRPIY9",140,0) ; "RTN","RMPRPIY9",141,0) ;***** TVAL - Total Value - use if Unit Cost not used "RTN","RMPRPIY9",142,0) TVAL I RMPRUCST D G VEND "RTN","RMPRPIY9",143,0) . S RMPRTVAL=$J(RMPRQTY*RMPRUCST,0,2) "RTN","RMPRPIY9",144,0) . W !,"TOTAL COST OF QUANTITY: "_RMPRTVAL "RTN","RMPRPIY9",145,0) . Q "RTN","RMPRPIY9",146,0) D TVAL^RMPRPIY5(.RMPRTVAL,.RMPREXC) "RTN","RMPRPIY9",147,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",148,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",149,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",150,0) ; "RTN","RMPRPIY9",151,0) ;***** VEND - call prompt for Vendor "RTN","RMPRPIY9",152,0) VEND D VEND^RMPRPIY5(.RMPRVEND,.RMPREXC) "RTN","RMPRPIY9",153,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",154,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",155,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",156,0) ; "RTN","RMPRPIY9",157,0) ; "RTN","RMPRPIY9",158,0) ;***** UNIT - call prompt for UNIT OF ISSUE "RTN","RMPRPIY9",159,0) UNIT D UNIT^RMPRPIY5(.RMPRUNI,.RMPREXC) "RTN","RMPRPIY9",160,0) I RMPREXC="P" G UCST "RTN","RMPRPIY9",161,0) I RMPREXC="^" G HCPCS "RTN","RMPRPIY9",162,0) I RMPREXC="T" G AEX "RTN","RMPRPIY9",163,0) ; "RTN","RMPRPIY9",164,0) ;***** TRANS - Create receipt record for adding an item "RTN","RMPRPIY9",165,0) TRANS S RMPR11("STATION")=RMPRSTN("IEN") "RTN","RMPRPIY9",166,0) S RMPR11("STATION IEN")=RMPRSTN("IEN") "RTN","RMPRPIY9",167,0) S RMPR6("QUANTITY")=RMPRQTY "RTN","RMPRPIY9",168,0) S RMPR6("VALUE")=RMPRTVAL "RTN","RMPRPIY9",169,0) S RMPR6("VENDOR")=RMPRVEND("IEN") "RTN","RMPRPIY9",170,0) S RMPR6("UNIT")=RMPRUNI("IEN") "RTN","RMPRPIY9",171,0) S RMPRERR=$$REC^RMPRPIU8(.RMPR6,.RMPR11,.RMPR5,1) ;receipt API "RTN","RMPRPIY9",172,0) TRANSX I RMPRERR D "RTN","RMPRPIY9",173,0) . W !!,"** Inventory could not be updated, please contact support",! "RTN","RMPRPIY9",174,0) . Q "RTN","RMPRPIY9",175,0) E D "RTN","RMPRPIY9",176,0) . W !!,"** Inventory updated.",! "RTN","RMPRPIY9",177,0) .;ask for number of labels and print barcode. "RTN","RMPRPIY9",178,0) . S RMPR11("HCPCS-ITEM")=RMPR11("HCPCS")_"-"_RMPR11("ITEM") "RTN","RMPRPIY9",179,0) . D NLAB^RMPRPIYY "RTN","RMPRPIY9",180,0) . Q "RTN","RMPRPIY9",181,0) K RMPR6,RMPRTVAL,RMPRQTY,RMPRUCST "RTN","RMPRPIY9",182,0) G HCPCS "RTN","RMPRPIY9",183,0) ; "RTN","RMPRPIY9",184,0) ;***** exit "RTN","RMPRPIY9",185,0) AEX D KILL^XUSCLEAN "RTN","RMPRPIY9",186,0) Q "RTN","RMPRPIYS") 0^2^B84190403 "RTN","RMPRPIYS",1,0) RMPRPIYS ;HINCIO/ODJ - RC - PIP Receive Stock ;10/8/02 13:11 "RTN","RMPRPIYS",2,0) ;;3.0;PROSTHETICS;**61,108**;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="QM" K IOP W ! D ^%ZIS G:POP PRINTX "RTN","RMPRPIYS",82,0) I $G(IOST)'["P-ZEBRA" D "RTN","RMPRPIYS",83,0) . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!! "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","RMPRPIYZ") 0^3^B11314468 "RTN","RMPRPIYZ",1,0) RMPRPIYZ ;HINES CIO/ODJ - Bar Code Print all label ;10/8/02 13:11 "RTN","RMPRPIYZ",2,0) ;;3.0;PROSTHETICS;**61,108**;Feb 09, 1996 "RTN","RMPRPIYZ",3,0) Q "RTN","RMPRPIYZ",4,0) ; "RTN","RMPRPIYZ",5,0) PB ;***** PB - Print ALL Bar Code labels "RTN","RMPRPIYZ",6,0) ; "RTN","RMPRPIYZ",7,0) ; "RTN","RMPRPIYZ",8,0) ;***** STN - prompt for Site/Station "RTN","RMPRPIYZ",9,0) STN ;S RMPROVAL=$G(RMPRSTN("IEN")) "RTN","RMPRPIYZ",10,0) W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC) "RTN","RMPRPIYZ",11,0) I RMPRERR G PBX "RTN","RMPRPIYZ",12,0) I RMPREXC'="" G PBX "RTN","RMPRPIYZ",13,0) S RS=RMPRSTN("IEN") K RMPR1,RMPR11 "RTN","RMPRPIYZ",14,0) ; "RTN","RMPRPIYZ",15,0) LOC ; askk for location "RTN","RMPRPIYZ",16,0) ; "RTN","RMPRPIYZ",17,0) S RMPRERR=$$LOCNM^RMPRPIY2(RMPRSTN("IEN"),.RMPR5,.RMPREXC) "RTN","RMPRPIYZ",18,0) I RMPREXC="T"!(RMPREXC="^") G PBX "RTN","RMPRPIYZ",19,0) I RMPREXC="P" G STN "RTN","RMPRPIYZ",20,0) S RL=RMPR5("IEN") K RMPR1 "RTN","RMPRPIYZ",21,0) ; "RTN","RMPRPIYZ",22,0) ;***** PRINT - print bar code labels "RTN","RMPRPIYZ",23,0) ; requires RMPRNLAB (number of labels) and "RTN","RMPRPIYZ",24,0) ; RMPRBCP (bar code printer name) to be set "RTN","RMPRPIYZ",25,0) ; RMPRBARC (bar code to print) "RTN","RMPRPIYZ",26,0) ; RMPRIOP (the device to open) "RTN","RMPRPIYZ",27,0) PRINT ;I '$D(RMPRBCP) G PRINTX "RTN","RMPRPIYZ",28,0) ;allows queing of bar code labels "RTN","RMPRPIYZ",29,0) SELD S %ZIS("A")="Select Bar Code Printer: " "RTN","RMPRPIYZ",30,0) S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX "RTN","RMPRPIYZ",31,0) I $G(IOST)'["P-ZEBRA" D "RTN","RMPRPIYZ",32,0) . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!! "RTN","RMPRPIYZ",33,0) I '$D(IO("Q")) U IO G PNOW "RTN","RMPRPIYZ",34,0) K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYZ" "RTN","RMPRPIYZ",35,0) S ZTIO=ION,ZTSAVE("RS")="",ZTSAVE("RL")="" "RTN","RMPRPIYZ",36,0) D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC "RTN","RMPRPIYZ",37,0) ; "RTN","RMPRPIYZ",38,0) PNOW ;jump here if not queued. "RTN","RMPRPIYZ",39,0) ; "RTN","RMPRPIYZ",40,0) ; "RTN","RMPRPIYZ",41,0) LOOP ;loop 661.7 for all items in a location. "RTN","RMPRPIYZ",42,0) F RI=0:0 S RI=$O(^RMPR(661.7,"C",RL,RI)) Q:RI'>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 "VER") 8.0^22.0 "BLD",5721,6) ^91 **END** **END**