| 1 | RMPRPIYS ;HINCIO/ODJ - RC - PIP Receive Stock ;10/8/02 13:11
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61,108,128**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;***** PB - Print Bar Code labels
|
|---|
| 6 | ; RMPR INV BAR CODE
|
|---|
| 7 | ; Callable from VISTA menu, no vars required other than
|
|---|
| 8 | ; global VISTA vars (DUZ, etc)
|
|---|
| 9 | ;
|
|---|
| 10 | PB N RMPRERR,RMPRSTN,RMPRLCN,RMPREXC,RMPR1,RMPR11,RMPROVAL,RMPRNLAB
|
|---|
| 11 | N RMPR6,RMPR7,RMPR7I,RMPRBARC,RMPRITXT,RMPRBCP,RMPRQ,RMPRIOP
|
|---|
| 12 | ;
|
|---|
| 13 | ;***** STN - prompt for Site/Station
|
|---|
| 14 | STN S RMPROVAL=$G(RMPRSTN("IEN"))
|
|---|
| 15 | W @IOF S RMPRERR=$$STN^RMPRPIY1(.RMPRSTN,.RMPREXC)
|
|---|
| 16 | I RMPRERR G PBX
|
|---|
| 17 | I RMPREXC'="" G PBX
|
|---|
| 18 | I RMPROVAL'=RMPRSTN("IEN") K RMPR1,RMPR11
|
|---|
| 19 | ;
|
|---|
| 20 | ;***** HCPCS - prompt for HCPCS and Item
|
|---|
| 21 | HCPCS W !!,"Print Bar code Labels for current inventory...",!
|
|---|
| 22 | HCPCS2 D HCPCS^RMPRPIY7(RMPRSTN("IEN"),$G(RMPR1("HCPCS")),.RMPR1,.RMPR11,.RMPREXC)
|
|---|
| 23 | I RMPREXC="T" G PBX
|
|---|
| 24 | I RMPREXC="P" G STN
|
|---|
| 25 | I RMPREXC="^" D G PBX
|
|---|
| 26 | . W !,"** No HCPCS selected..." H 1
|
|---|
| 27 | . Q
|
|---|
| 28 | I $G(RMPR11("IEN"))'="" G HCPCS3A
|
|---|
| 29 | HCPCS3 D ITEM^RMPRPIYP(RMPRSTN("IEN"),RMPR1("HCPCS"),.RMPR11,.RMPREXC)
|
|---|
| 30 | I RMPREXC="T" G PBX
|
|---|
| 31 | I RMPREXC="P"!(RMPREXC="^") G HCPCS
|
|---|
| 32 | HCPCS3A S RMPR11("STATION")=RMPRSTN("IEN")
|
|---|
| 33 | S RMPR11("STATION IEN")=RMPRSTN("IEN")
|
|---|
| 34 | ;
|
|---|
| 35 | ; display selected HCPCS and item and continue
|
|---|
| 36 | HCPCS4 W !!,"HCPCS: "_RMPR1("HCPCS")_" "_RMPR1("SHORT DESC")
|
|---|
| 37 | W !!,"IFCAP Item: ",RMPR11("ITEM MASTER")
|
|---|
| 38 | W !!,"PIP Item desc.: ",RMPR11("DESCRIPTION")
|
|---|
| 39 | ;
|
|---|
| 40 | ;***** CURST - call prompt for current stock record
|
|---|
| 41 | CURST S RMPRLCN=""
|
|---|
| 42 | D PVEN^RMPRPIYR(RMPRSTN("IEN"),.RMPRLCN,RMPR11("HCPCS"),RMPR11("ITEM"),.RMPR6,.RMPR7,.RMPREXC)
|
|---|
| 43 | I RMPREXC="T" G PBX
|
|---|
| 44 | I RMPREXC="P" G HCPCS3
|
|---|
| 45 | I RMPREXC="^" G HCPCS
|
|---|
| 46 | I '+$G(RMPR7("QUANTITY")) D G HCPCS2
|
|---|
| 47 | . W !,"This item is not currently in stock.",!!
|
|---|
| 48 | . Q
|
|---|
| 49 | K RMPR7I
|
|---|
| 50 | S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
|
|---|
| 51 | S RMPRBARC=RMPR11("HCPCS")_"-"_$P(RMPR7I("DATE&TIME"),".",1)_$P(RMPR7I("DATE&TIME"),".",2)
|
|---|
| 52 | S RMPRITXT("DATE")=$E(RMPR7I("DATE&TIME"),4,5)_"/"_$E(RMPR7I("DATE&TIME"),6,7)_"/"_(1700+$E(RMPR7I("DATE&TIME"),1,3))
|
|---|
| 53 | S RMPRITXT("ITEM")=RMPR11("HCPCS-ITEM")
|
|---|
| 54 | S RMPRITXT("MASTER DESC")=RMPR11("ITEM MASTER")
|
|---|
| 55 | S RMPRITXT("ITEM DESC")=RMPR11("DESCRIPTION")
|
|---|
| 56 | S RMPRITXT("UNIT PRICE")=+$J(RMPR7("VALUE")/RMPR7("QUANTITY"),0,2)
|
|---|
| 57 | S RMPRITXT("VENDOR")=RMPR6("VENDOR")
|
|---|
| 58 | S RMPRITXT("LOCATION")=RMPR7("LOCATION")
|
|---|
| 59 | ;
|
|---|
| 60 | ;***** NLAB - call prompt for number of labels to print
|
|---|
| 61 | NLAB S RMPRNLAB=RMPR7("QUANTITY")
|
|---|
| 62 | W ! D NLABP(.RMPRNLAB,RMPR7("QUANTITY"),.RMPREXC)
|
|---|
| 63 | I RMPREXC="T" G PBX
|
|---|
| 64 | I RMPREXC="P" G HCPCS
|
|---|
| 65 | I RMPREXC="^" G HCPCS
|
|---|
| 66 | ;
|
|---|
| 67 | ;***** SELP - call prompt for bar code print device
|
|---|
| 68 | SELP D PRINT G HCPCS
|
|---|
| 69 | G HCPCS
|
|---|
| 70 | PBX D KILL^XUSCLEAN
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | ;***** PRINT - print bar code labels
|
|---|
| 74 | ; requires RMPRNLAB (number of labels) and
|
|---|
| 75 | ; RMPRBCP (bar code printer name) to be set
|
|---|
| 76 | ; RMPRBARC (bar code to print)
|
|---|
| 77 | ; RMPRIOP (the device to open)
|
|---|
| 78 | PRINT I '$D(RMPRNLAB) S RMPRNLAB=1
|
|---|
| 79 | ;allows queing of bar code labels
|
|---|
| 80 | SELD S %ZIS("A")="Select Bar Code Printer: "
|
|---|
| 81 | S %ZIS="QM" K IOP W ! D ^%ZIS G:POP PRINTX
|
|---|
| 82 | I $G(IOST)'["P-ZEBRA" D
|
|---|
| 83 | . W !!,"** WARNING - This is NOT a Zebra Bar Code Printer!!",!!
|
|---|
| 84 | I '$D(IO("Q")) U IO G PNOW
|
|---|
| 85 | K IO("Q") S ZTDESC="PRINT BAR CODE LABELS",ZTRTN="PNOW^RMPRPIYS"
|
|---|
| 86 | S ZTIO=ION,ZTSAVE("RMPRBARC")="",ZTSAVE("RMPRITXT(")=""
|
|---|
| 87 | S ZTSAVE("RMPRNLAB")="",ZTSAVE("RMPR(")="",ZTSAVE("RMPRSTN(")=""
|
|---|
| 88 | D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 2 G PRINTC
|
|---|
| 89 | ;
|
|---|
| 90 | PNOW ;jump here if not queued.
|
|---|
| 91 | D ZPLII^RMPRPI11(RMPRBARC,.RMPRITXT,RMPRNLAB)
|
|---|
| 92 | S IONOFF=1
|
|---|
| 93 | PRINTC D ^%ZISC K IONOFF
|
|---|
| 94 | PRINTX Q
|
|---|
| 95 | ;
|
|---|
| 96 | ;***** NLABP - Number of labels prompt
|
|---|
| 97 | NLABP(RMPRNLAB,RMPRMAX,RMPREXC) ;
|
|---|
| 98 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
|
|---|
| 99 | S RMPRNLAB=$G(RMPRNLAB)
|
|---|
| 100 | S RMPRERR=0
|
|---|
| 101 | S DIR(0)="NAO^1:"_RMPRMAX_":0"
|
|---|
| 102 | S DIR("A")="Number of Labels to print: "
|
|---|
| 103 | S:RMPRNLAB'="" DIR("B")=RMPRNLAB
|
|---|
| 104 | S DIR("??")="^D NLABPH2^RMPRPIYS"
|
|---|
| 105 | D ^DIR
|
|---|
| 106 | I $D(DTOUT) S RMPREXC="T" G NLABPX
|
|---|
| 107 | I $D(DIROUT) S RMPREXC="P" G NLABPX
|
|---|
| 108 | I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G NLABPX
|
|---|
| 109 | S RMPREXC=""
|
|---|
| 110 | S RMPRNLAB=+Y
|
|---|
| 111 | NLABPX Q
|
|---|
| 112 | NLABPH2 W "Type in the number of bar code labels you want to print for the",!
|
|---|
| 113 | W "inventory item you have selected.",!
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
| 116 | ;***** BARC - bar code prompt
|
|---|
| 117 | BARC(RMPRBARC,RMPREXC) ;
|
|---|
| 118 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
|
|---|
| 119 | S RMPRBARC=""
|
|---|
| 120 | S RMPREXC=""
|
|---|
| 121 | S RMPRERR=0
|
|---|
| 122 | S DIR(0)="FAO"
|
|---|
| 123 | S DIR("A")="Scan in item bar code: "
|
|---|
| 124 | S DIR("?")="^D BARCH^RMPRPIYS"
|
|---|
| 125 | BARC1 D ^DIR
|
|---|
| 126 | I $D(DTOUT) S RMPREXC="T" G BARCX
|
|---|
| 127 | I $D(DIROUT) S RMPREXC="P" G BARCX
|
|---|
| 128 | I X["^"!($D(DUOUT)) S RMPREXC="^" G BARCX
|
|---|
| 129 | I X="",$G(REDIT) G BARCX
|
|---|
| 130 | I X="" G BARC1
|
|---|
| 131 | S RMPRBARC=X
|
|---|
| 132 | BARCX Q
|
|---|
| 133 | BARCH W "If you have access to a bar code scanner, use it to scan the item bar code now.",!
|
|---|
| 134 | W "Don't press the [Enter] key as the scanner should do this automatically.",!
|
|---|
| 135 | W "If the scanner cannot read the bar code, type in the character sequence",!
|
|---|
| 136 | W "immediately below the bar code.",!
|
|---|
| 137 | ;W "If there is no bar code or you prefer to enter the transaction manually",!
|
|---|
| 138 | ;W "leave this prompt blank.",!
|
|---|
| 139 | Q
|
|---|
| 140 | ;
|
|---|
| 141 | ;***** SCAN - scan bar code and set up stock issue vars.
|
|---|
| 142 | ; (to be called by RMPRPIYI (too big))
|
|---|
| 143 | SCAN K RMPR7,RMPR7I,RMPR1,RMPR1I,RMPR11,RMPR11I,RMPR6,RMDAHC,RMITQTY
|
|---|
| 144 | SCAN1 D BARC(.RMPRBARC,.RMPREXC)
|
|---|
| 145 | I RMPREXC'="" S RMPRBARC="" G SCANX
|
|---|
| 146 | I RMPRBARC="" G SCANX
|
|---|
| 147 | S RMPRBARC=$$UPCASE(RMPRBARC)
|
|---|
| 148 | ;
|
|---|
| 149 | ; If we get a good bar code then populate all the fields and go
|
|---|
| 150 | ; straight to the Post/Edit prompt
|
|---|
| 151 | K RMPR7
|
|---|
| 152 | S (RMPR7("STATION"),RMPRSTN)=RMPR("STA")
|
|---|
| 153 | S RMPR7("HCPCS")=$P(RMPRBARC,"-",1)
|
|---|
| 154 | S RMDAHC=$O(^RMPR(661.1,"B",RMPR7("HCPCS"),0))
|
|---|
| 155 | 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)
|
|---|
| 156 | I '$G(RMDAHC) W !,"** No HCPCS Selected or Unable to Select Inactive HCPCS..." G SCAN
|
|---|
| 157 | S RMPR7("DATE&TIME")=$E($P(RMPRBARC,"-",2),1,7)_"."_$E($P(RMPRBARC,"-",2),8,$L(RMPRBARC))
|
|---|
| 158 | ;
|
|---|
| 159 | ; look up current stock record with bar coded key fields
|
|---|
| 160 | S RMPRERR=$$SCAN^RMPRPIUA(.RMPR7,.RMPREXC)
|
|---|
| 161 | I $G(RMPR7("IEN"))="" W !,"*** The Item scanned is not available, please update your inventory !!!" G SCAN1
|
|---|
| 162 | I RMPRERR D SCANE G SCAN1
|
|---|
| 163 | S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
|
|---|
| 164 | I RMPRERR D SCANE G SCAN1
|
|---|
| 165 | S R1("DATE&TIME")=$G(RMPR7I("DATE&TIME"))
|
|---|
| 166 | S $P(R1(0),U,8)=$G(RMPR7I("UNIT"))
|
|---|
| 167 | ;
|
|---|
| 168 | ; set vars. for HCPCS
|
|---|
| 169 | K RMPR1,RMPR1I
|
|---|
| 170 | S RMPR1("HCPCS")=RMPR7("HCPCS")
|
|---|
| 171 | S RMPRERR=$$HPACT^RMPRPIX1(.RMPR1)
|
|---|
| 172 | I RMPRERR D SCANE G SCAN1
|
|---|
| 173 | S RMPRERR=$$HPETOI^RMPRPIX1(.RMPR1,.RMPR1I)
|
|---|
| 174 | I RMPRERR D SCANE G SCAN1
|
|---|
| 175 | ;
|
|---|
| 176 | ; set vars. for Item
|
|---|
| 177 | K RMPR11,RMPR11I
|
|---|
| 178 | S RMPR11("STATION")=RMPR("STA")
|
|---|
| 179 | S RMPR11("HCPCS")=RMPR7("HCPCS")
|
|---|
| 180 | S RMPR11("ITEM")=RMPR7("ITEM")
|
|---|
| 181 | S RMPRERR=$$GET^RMPRPIX1(.RMPR11)
|
|---|
| 182 | I RMPRERR D SCANE G SCAN1
|
|---|
| 183 | S RMPRERR=$$ETOI^RMPRPIX1(.RMPR11,.RMPR11I)
|
|---|
| 184 | I RMPRERR D SCANE G SCAN1
|
|---|
| 185 | I RMPR11I("ITEM MASTER IEN")="" D G SCAN1
|
|---|
| 186 | . W !,"This item is not associated with an IFCAP Item.",!
|
|---|
| 187 | . W "Please use the Edit Inventory option before trying to issue this item."
|
|---|
| 188 | . W !
|
|---|
| 189 | . Q
|
|---|
| 190 | ;S RMDAHC=RMPR1("IEN")
|
|---|
| 191 | D CPT(RMDAHC_"^"_$P(R1(0),U,4)_"^"_RMPR11I("SOURCE")_"^660")
|
|---|
| 192 | I RMPREXC="T" G SCANX
|
|---|
| 193 | I RMPREXC'="" G SCAN1
|
|---|
| 194 | ;
|
|---|
| 195 | ; get Vendor
|
|---|
| 196 | S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
|
|---|
| 197 | S RMPR6("HCPCS")=RMPR7("HCPCS")
|
|---|
| 198 | S RMPR6("SEQUENCE")=RMPR7("SEQUENCE")
|
|---|
| 199 | S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
|
|---|
| 200 | I RMPRERR D SCANE G SCAN1
|
|---|
| 201 | S RMPRERR=$$VNDIEN^RMPRPIX6(.RMPR6)
|
|---|
| 202 | I RMPRERR D SCANE G SCAN1
|
|---|
| 203 | S $P(R1(0),U,9)=RMPR6("VENDOR IEN")
|
|---|
| 204 | S $P(R3("D"),U,9)=RMPR6("VENDOR")
|
|---|
| 205 | ;
|
|---|
| 206 | ; set vars for issue
|
|---|
| 207 | S RMCPTC=""
|
|---|
| 208 | I $G(RMDAHC),$D(^RMPR(661.1,RMDAHC,0)) S RMCPTC=$P(^RMPR(661.1,RMDAHC,0),U,4)
|
|---|
| 209 | S $P(R1(1),U,4)=RMDAHC
|
|---|
| 210 | S $P(R1(0),U,22)=$G(RMCPTC)
|
|---|
| 211 | S $P(R1(0),U,6)=RMPR11I("ITEM MASTER IEN")
|
|---|
| 212 | S (RMHCNEW,RMHCDA)=RMDAHC
|
|---|
| 213 | S RMITDA=RMPR11("IEN")
|
|---|
| 214 | S RMHCPC=RMPR11("HCPCS")
|
|---|
| 215 | S RMIT=RMPR11("HCPCS-ITEM")
|
|---|
| 216 | S RDESC=RMPR1("SHORT DESC")
|
|---|
| 217 | S $P(R3("D"),U,14)=RMPR11("SOURCE")
|
|---|
| 218 | S RMSO=RMPR11I("SOURCE")
|
|---|
| 219 | S $P(R1(0),U,14)=RMSO
|
|---|
| 220 | S $P(R3("D"),U,6)=RMPR11("ITEM MASTER")
|
|---|
| 221 | S $P(R1(0),U,6)=RMPR11I("ITEM MASTER IEN")
|
|---|
| 222 | S $P(R1(2),U,1)=RMIT
|
|---|
| 223 | S $P(R1(2),U,2)=RMPR11("DESCRIPTION")
|
|---|
| 224 | S RMLOC=RMPR7I("LOCATION"),RMUBA=0,RMPR11("ITEM")=$P(RMIT,"-",2)
|
|---|
| 225 | S RMPR11("LOCATION")=RMLOC,RMPR11("STATION")=RMPRSTN
|
|---|
| 226 | I '$G(RMPR11("LOCATION")) S RMUBA=RMPR7("QUANTITY")
|
|---|
| 227 | S:'$G(RMUBA) RMUBA=$$BAL^RMPRPIX7(.RMPR11)
|
|---|
| 228 | S RMITQTY=RMPR7("QUANTITY")
|
|---|
| 229 | K RMPR5
|
|---|
| 230 | S RMPR5("IEN")=RMLOC
|
|---|
| 231 | S RMPRUCST=RMPR7("VALUE")/RMPR7("QUANTITY")
|
|---|
| 232 | S $P(R1(0),U,16)=$J(RMPRUCST,0,2)
|
|---|
| 233 | S $P(R3("D"),U,16)=$J(RMPRUCST,0,2)
|
|---|
| 234 | S $P(R1(0),U,7)=1 ;qty.
|
|---|
| 235 | S $P(R1(0),U,11)="" ;serial num
|
|---|
| 236 | S $P(R1(0),U,24)="" ;lot num
|
|---|
| 237 | S $P(R1(0),U,18)="" ;remarks
|
|---|
| 238 | SCANX Q
|
|---|
| 239 | SCANE W !,"A problem has occurred with the scan, please try again.",!
|
|---|
| 240 | Q
|
|---|
| 241 | ;
|
|---|
| 242 | ;***** CPT - prompt for CPT modifier
|
|---|
| 243 | ; (extension of RMPRPIYI and to be used only by that routine)
|
|---|
| 244 | CPT(RDA) ;
|
|---|
| 245 | N DIC,Y,RQUIT,X,DA,DIR,DUOUT,DTOUT
|
|---|
| 246 | N RMPR1,RMPR11,RMPR11I,RMPR7,RMPR7I
|
|---|
| 247 | S RMPREXC=""
|
|---|
| 248 | D:$D(RMCPT) CHK^RMPRED5
|
|---|
| 249 | W:$G(REDIT) !,"OLD CPT MODIFIER: ",$P(R1(1),U,6)
|
|---|
| 250 | I RMHCOLD'=RMDAHC D CPT^RMPRCPTU(RDA)
|
|---|
| 251 | I $D(DUOUT) S RMPREXC="^" G CPTX
|
|---|
| 252 | I $D(DTOUT) S RMPREXC="T" G CPTX
|
|---|
| 253 | S $P(R1(1),U,6)=$G(RMCPT)
|
|---|
| 254 | W:$G(REDIT) !,"NEW CPT MODIFIER: ",$G(RMCPT)
|
|---|
| 255 | I RMHCOLD'="",(RMHCOLD=RMDAHC),$G(REDIT) D
|
|---|
| 256 | .S DIR(0)="Y",DIR("A")="Would you like to Edit CPT MODIFIER Entry ",DIR("B")="N" D ^DIR Q:$D(DTOUT)!$D(DUOUT)
|
|---|
| 257 | .I $G(Y) D
|
|---|
| 258 | ..D CPT^RMPRCPTU(RDA)
|
|---|
| 259 | ..I $D(DUOUT) S RMPREXC="^"
|
|---|
| 260 | ..I $D(DTOUT) S RMPREXC="T"
|
|---|
| 261 | ..W:RMCPT=$P(R1(1),U,6) !!,"***Based on the information given above, CPT modifier string has not changed!!!",!
|
|---|
| 262 | ..W:RMCPT'=$P(R1(1),U,6) !,"NEW CPT MODIFIER: ",$G(RMCPT)
|
|---|
| 263 | ..S $P(R1(1),U,6)=$G(RMCPT)
|
|---|
| 264 | CPTX Q
|
|---|
| 265 | UPCASE(RMPRSTR) ;
|
|---|
| 266 | Q $TR(RMPRSTR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
