RMPRPIY7	;HINCIO/ODJ - PIP EDIT - PROMPTS ;9/18/02  15:17
	;;3.0;PROSTHETICS;**61,118,139**;Feb 09, 1996;Build 4
	;
	;DBIA # 800 - FILEMAN read of file #440.
	Q
	; The following subroutines are a series of prompts called
	; by Edit LOCATION/HCPCS/ITEM option (EI^RMPRPIY6)
	;
	;***** LOCNM - Prompt for location
	;              must be in 661.5 and active
LOCNM(RMPRSTN,RMPR5,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,RMPRYN,RMPRTDT
	D NOW^%DTC S RMPRTDT=X ;today's date
	S RMPREXC=""
	S RMPRERR=0
	S DIR(0)="FOA"
	S DIR("A")="Enter Pros Location: "
	I $G(RMPR5("NAME"))'="" S DIR("B")=RMPR5("NAME")
	S DIR("?")="^D QM^RMPRPIYB"
	S DIR("??")="^D QM2^RMPRPIYB"
	S RMPR5("IEN")=""
LOCNM1	D ^DIR
	;Patch *139 removes upper case translation to allow access to lower
	;case entries used in location creation option
	;S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
	I $G(RMPR5("IEN"))'="" S RMPREXC="" G LOCNMX
	I $D(DTOUT) S RMPREXC="T" G LOCNMX
	I $D(DIROUT) S RMPREXC="P" G LOCNMX
	I X=""!(X["^") S RMPREXC="^" G LOCNMX
	K RMPR5
	S RMPR5("STATION")=RMPRSTN
	S RMPR5("STATION IEN")=RMPRSTN
	D LIKE^RMPRPIYB(RMPRSTN,X,.RMPREXC,.RMPR5)
	I RMPREXC'="" G LOCNM1
	I $G(RMPR5("IEN"))="" D  G LOCNM1
	. W !,"Please enter a valid Location"
	. Q
	;
	; exit
LOCNMX	Q
	;
	;***** OK - Prompt for an OK
OK(RMPRYN,RMPREXC)	;
	N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
	S RMPREXC=""
	S RMPRYN="N"
	S DIR("A")="         ...OK"
	S DIR("B")="Yes"
	S DIR(0)="Y"
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G OKX
	I $D(DIROUT) S RMPREXC="P" G OKX
	I X=""!(X["^") S RMPREXC="^" G OKX
	S RMPRYN="N" S:Y RMPRYN="Y"
OKX	Q
	;
	;***** HCPCS - Prompt for HCPCS
HCPCS(RMPRSTN,RMPRHPTX,RMPR1,RMPR11,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DIC,DA,RMPR1N,RMSTN
	N RM6610
	S DIR("A")="Select HCPCS: ",RMSTN=RMPRSTN
	S DIR("S")="I $P(^RMPR(661.11,+Y,0),U,4)=RMSTN"
	S RMPRERR=0
	S RMPREXC=""
	S RMPRHPTX=$G(RMPRHPTX)
	I RMPRHPTX'="" S DIR("B")=RMPRHPTX
	S DIR(0)="FOA"
	S DIR("?")="^D QM2^RMPRPIYC"
	S DIR("??")="^D QM2^RMPRPIYC"
	S DIR("???")="^D QM2^RMPRPIYC"
HCPCS1	K RMPR1N D ^DIR
	I $G(RMPR1N("IEN"))'="" S RMPRHPTX=RMPR1N("HCPCS") G CHECK
	I $D(DTOUT) S RMPREXC="T" G HCPCSX
	I $D(DIROUT) S RMPREXC="P" G HCPCSX
	I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G HCPCSX
	D LIKE^RMPRPIYC(RMPRSTN,X,.RMPREXC,.RMPR1N,.RMPR11)
	I RMPREXC'="" G HCPCS1
	I $G(RMPR1N("IEN"))'="",$G(RMPR1("REMOVE")) G HCPCSU
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
	I $G(RMPR1N("IEN"))'="" G HCPCSU
	G HCPCS1
HCPCSU	K RMPR1 M RMPR1=RMPR1N
HCPCSX	Q
	;
	;***** ITEM - Prompt for Item - restrict choice to Location and HCPC
ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
	S RMPRERR=0
	S RMPREXC=""
	I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX
	I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX
	I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX
	K RMPR11,RMPR4
	S DIR(0)="FOA^1:50"
	S DIR("A")="Enter PSAS Item to Edit: "
	S DIR("?")="^D QM^RMPRPIY8"
	S DIR("??")="^D QQM^RMPRPIY8"
ITEMA1	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G ITEMX
	I $D(DIROUT) S RMPREXC="P" G ITEMX
	I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX
	D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
	I RMPREXC="T" G ITEMX
	I RMPREXC="P" G ITEMX
	I RMPREXC="^" G ITEMA1
	I RMPR4("IEN")="" D  G ITEMA1
	. W !,"Cannot locate ITEM with this sequence NUMBER"
	. Q
	W "  ",RMPR11("HCPCS-ITEM"),"  ",RMPR11("DESCRIPTION")
	D OK(.RMPRYN,.RMPREXC)
	I RMPRYN'="Y" G ITEMA1
	G ITEMX
ITEMX	Q RMPRERR
	;
	;***** QTY - Prompt for Quantity
QTY(RMPRQTY,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
	S RMPRQTY=$G(RMPRQTY)
	S RMPRERR=0
	S DIR(0)="NA^1:99999:0"
	S DIR("A")="QUANTITY: "
	S:RMPRQTY'="" DIR("B")=RMPRQTY
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G QTYX
	I $D(DIROUT) S RMPREXC="P" G QTYX
	I X=""!(X["^") S RMPREXC="^" G QTYX
	S RMPRQTY=Y
QTYX	Q RMPRERR
	;
	;***** TVAL - Prompt for total $ value
TVAL(RMPRTVAL,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
	S RMPRTVAL=$G(RMPRTVAL)
	S RMPRERR=0
	S DIR(0)="NOA^0:999999:2"
	S DIR("A")="TOTAL COST OF QUANTITY: "
	S:RMPRTVAL'="" DIR("B")=RMPRTVAL
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G TVALX
	I $D(DIROUT) S RMPREXC="P" G TVALX
	I X["^" S RMPREXC="^" G TVALX
	I X="" G TVALX
	S RMPRTVAL=Y
TVALX	Q RMPRERR
	;
	;***** REO - Prompt for Re-Order Level
REO(RMPRREO,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
	S RMPRREO=$G(RMPRREO)
	S RMPRERR=0
	S DIR(0)="NOA^0::0"
	S DIR("A")="RE-ORDER LEVEL: "
	S:RMPRREO'="" DIR("B")=RMPRREO
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G REOX
	I $D(DIROUT) S RMPREXC="P" G REOX
	I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G REOX
	S RMPRREO=Y
REOX	Q RMPRERR
	;
	;***** VEND - Prompt for Vendor
VEND(RMPRVEND,RMPREXC)	;
	N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT,DA
	S RMPRVEND=$G(RMPRVEND("IEN"))
	S RMPRERR=0
	S DIR(0)="P^440:EMZ"
	S DIR("A")="VENDOR"
	S:RMPRVEND'="" DIR("B")=RMPRVEND("NAME")
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G VENDX
	I $D(DIROUT) S RMPREXC="P" G VENDX
	I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G VENDX
	S RMPRVEND("IEN")=$P(Y,"^",1)
	S RMPRVEND("NAME")=$P(Y,"^",2)
VENDX	Q RMPRERR
	;
	;***** PVEN - Pick the current stock record to edit
PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC)	;
	N DIR,X,Y,DA,RMPRGBL,RMPRLIN,RMPRA,RMPRERR,RMPRX,RMPRY,RMPRB
	N RMPR7I
	S RMPREXC=""
	S RMPRX="",RMPRY=0
	S RMPRLIN=0
	S RMPRGBL=$Q(^RMPR(661.7,"XSLHIDS",RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM))
	G PVEN1A
PVEN1	S RMPRGBL=$Q(@RMPRGBL)
PVEN1A	I $QS(RMPRGBL,1)'=661.7 G PVEN2
	I $QS(RMPRGBL,2)'="XSLHIDS" G PVEN2
	I $QS(RMPRGBL,3)'=RMPRSTN G PVEN2
	I $QS(RMPRGBL,4)'=RMPRLCN G PVEN2
	I $QS(RMPRGBL,5)'=RMPRHCPC G PVEN2
	I $QS(RMPRGBL,6)'=RMPRITM G PVEN2
	S RMPRLIN=RMPRLIN+1
	S RMPRA(RMPRLIN)=$QS(RMPRGBL,9)
	G PVEN1
PVEN2	I RMPRLIN=0 G PVENX
	I RMPRLIN=1 S X=1 G PVEN3
	W !,"Select a current Stock Record to edit...",!
	W !,?7,"Date",?21,"Quantity",?35,"Value",?42,"Vendor"
	S RMPRX="",RMPRLIN=0
	F  S RMPRX=$O(RMPRA(RMPRX)) Q:RMPRX=""  D
	. S RMPRLIN=RMPRLIN+1
	. K RMPR7
	. S RMPR7("IEN")=RMPRA(RMPRX)
	. S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
	. W !,?2,$J(RMPRLIN,2)
	. W ?7,$P(RMPR7("DATE&TIME"),"@",1)
	. W ?21,$J(RMPR7("QUANTITY"),8,0)
	. W ?30,$J(RMPR7("VALUE"),10,2)
	. K RMPR7I
	. S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
	. K RMPR6
	. S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
	. S RMPR6("HCPCS")=RMPRHCPC
	. S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
	. W ?42,RMPR6("VENDOR")
	. Q
	K RMPR7,RMPR6
	S DIR(0)="NAO^1:"_RMPRLIN_": "
	S DIR("A")="CHOOSE 1-"_RMPRLIN_": "
	D ^DIR
	I $D(DTOUT) S RMPREXC="T" G PVENX
	I $D(DIROUT) S RMPREXC="P" G PVENX
	I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G PVENX
PVEN3	S RMPR7("IEN")=RMPRA(X)
	S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
	K RMPR7I
	S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
	S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
	S RMPR6("HCPCS")=RMPRHCPC
	S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
PVENX	Q