RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
; The following subroutines are for selecting HCPCS
; and Inventory Item
;
;***** 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
;
;***** PVEN - Prompt for current Stock Record
PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
N RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
S RMPRERR=0
S RMPREXC=""
S RMPRMAX=15
S RMPRLIN=0
K RMPR7,RMPR6
S RMPRLCN=$G(RMPRLCN)
;
; See if just 1 record - no need to list if there is
S RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
S RMPRGBL=$Q(@RMPRGBLR)
I $$PVENE() G PVENX
S RMPR7("IEN")=$QS(RMPRGBL,8)
S RMPRGBL=$Q(@RMPRGBL)
I $$PVENE() G PVENG
;
; Selection list of current stock records
S RMPRGBL=RMPRGBLR
PVENL1 S RMPRGBL=$Q(@RMPRGBL)
I $$PVENE G:'RMPRLIN PVENX G PVENP
K RMPR7,RMPR7I
S RMPR7("IEN")=$QS(RMPRGBL,8)
S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
I RMPRLCN'="",RMPRLCN'=RMPR7I("LOCATION") G PVENL1
I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PVENP
. S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
. Q
PVENL2 S RMPRLIN=RMPRLIN+1
I RMPRLIN=1 D PVENH
S RMPRS=$P(RMPR7I("DATE&TIME"),".",1)
W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
W ?11,$J(RMPR7("QUANTITY"),5,0)
I +RMPR7("QUANTITY") D
. W ?18,$J(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
. Q
W ?26,$J(RMPR7("VALUE"),10,2)
S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
S RMPR6("HCPCS")=RMPRHCPC
S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
W ?38,$E(RMPR6("VENDOR"),1,30)
W ?69,$E(RMPR7("LOCATION"),1,10)
S RMPRA(RMPRLIN)=RMPR7("IEN")
K RMPR7,RMPR7I,RMPR6
G PVENL1
;
; Prompt for selection
PVENP S DIR(0)="FAO"
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="",$D(DIR("A",1)) K DIR("A",1) D PVENH G PVENL2
I X="" S RMPREXC="^" G PVENX
I X["^"!($D(DUOUT)) S RMPREXC="^" G PVENX
I '$D(RMPRA(X)) D G PVENP
. W !,"Please select a current stock record"
. W !,"by entering a line number in range 1 - "
. W RMPRLIN
. Q
S RMPR7("IEN")=RMPRA(X)
PVENG S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
K RMPR7I
S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
S RMPRLCN=RMPR7I("LOCATION")
S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
S RMPR6("HCPCS")=RMPRHCPC
S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
PVENX Q
PVENE() ;
Q:$QS(RMPRGBL,1)'=661.7 1
Q:$QS(RMPRGBL,2)'="XSHIDS" 1
Q:$QS(RMPRGBL,3)'=RMPRSTN 1
Q:$QS(RMPRGBL,4)'=RMPRHCPC 1
Q:$QS(RMPRGBL,5)'=RMPRITM 1
Q 0
PVENH W !
W !,"Select a current stock record...",!
W ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
I RMPRLCN="" W ?69,"Location"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYR 3130 printed Sep 23, 2025@20:13:24 Page 2
RMPRPIYR ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ; The following subroutines are for selecting HCPCS
+4 ; and Inventory Item
+5 ;
+6 ;***** OK - Prompt for an OK
OK(RMPRYN,RMPREXC) ;
+1 NEW DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
+2 SET RMPREXC=""
+3 SET RMPRYN="N"
+4 SET DIR("A")=" ...OK"
+5 SET DIR("B")="Yes"
+6 SET DIR(0)="Y"
+7 DO ^DIR
+8 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO OKX
+9 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO OKX
+10 IF X=""!(X["^")
SET RMPREXC="^"
GOTO OKX
+11 SET RMPRYN="N"
if Y
SET RMPRYN="Y"
OKX QUIT
+1 ;
+2 ;***** PVEN - Prompt for current Stock Record
PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
+1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
+2 NEW RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
+3 SET RMPRERR=0
+4 SET RMPREXC=""
+5 SET RMPRMAX=15
+6 SET RMPRLIN=0
+7 KILL RMPR7,RMPR6
+8 SET RMPRLCN=$GET(RMPRLCN)
+9 ;
+10 ; See if just 1 record - no need to list if there is
+11 SET RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
+12 SET RMPRGBL=$QUERY(@RMPRGBLR)
+13 IF $$PVENE()
GOTO PVENX
+14 SET RMPR7("IEN")=$QSUBSCRIPT(RMPRGBL,8)
+15 SET RMPRGBL=$QUERY(@RMPRGBL)
+16 IF $$PVENE()
GOTO PVENG
+17 ;
+18 ; Selection list of current stock records
+19 SET RMPRGBL=RMPRGBLR
PVENL1 SET RMPRGBL=$QUERY(@RMPRGBL)
+1 IF $$PVENE
if 'RMPRLIN
GOTO PVENX
GOTO PVENP
+2 KILL RMPR7,RMPR7I
+3 SET RMPR7("IEN")=$QSUBSCRIPT(RMPRGBL,8)
+4 SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+5 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+6 IF RMPRLCN'=""
IF RMPRLCN'=RMPR7I("LOCATION")
GOTO PVENL1
+7 IF RMPRLIN
IF '(RMPRLIN#RMPRMAX)
Begin DoDot:1
+8 SET DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
+9 QUIT
End DoDot:1
GOTO PVENP
PVENL2 SET RMPRLIN=RMPRLIN+1
+1 IF RMPRLIN=1
DO PVENH
+2 SET RMPRS=$PIECE(RMPR7I("DATE&TIME"),".",1)
+3 WRITE !,$JUSTIFY(RMPRLIN,2)," ",$EXTRACT(RMPRS,4,5)_"/"_$EXTRACT(RMPRS,6,7)_"/"_$EXTRACT(RMPRS,2,3)
+4 WRITE ?11,$JUSTIFY(RMPR7("QUANTITY"),5,0)
+5 IF +RMPR7("QUANTITY")
Begin DoDot:1
+6 WRITE ?18,$JUSTIFY(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
+7 QUIT
End DoDot:1
+8 WRITE ?26,$JUSTIFY(RMPR7("VALUE"),10,2)
+9 SET RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
+10 SET RMPR6("HCPCS")=RMPRHCPC
+11 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
+12 WRITE ?38,$EXTRACT(RMPR6("VENDOR"),1,30)
+13 WRITE ?69,$EXTRACT(RMPR7("LOCATION"),1,10)
+14 SET RMPRA(RMPRLIN)=RMPR7("IEN")
+15 KILL RMPR7,RMPR7I,RMPR6
+16 GOTO PVENL1
+17 ;
+18 ; Prompt for selection
PVENP SET DIR(0)="FAO"
+1 SET DIR("A")="Choose 1 - "_RMPRLIN_" : "
+2 DO ^DIR
+3 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO PVENX
+4 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO PVENX
+5 IF X=""
IF $DATA(DIR("A",1))
KILL DIR("A",1)
DO PVENH
GOTO PVENL2
+6 IF X=""
SET RMPREXC="^"
GOTO PVENX
+7 IF X["^"!($DATA(DUOUT))
SET RMPREXC="^"
GOTO PVENX
+8 IF '$DATA(RMPRA(X))
Begin DoDot:1
+9 WRITE !,"Please select a current stock record"
+10 WRITE !,"by entering a line number in range 1 - "
+11 WRITE RMPRLIN
+12 QUIT
End DoDot:1
GOTO PVENP
+13 SET RMPR7("IEN")=RMPRA(X)
PVENG SET RMPRERR=$$GET^RMPRPIX7(.RMPR7)
+1 KILL RMPR7I
+2 SET RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
+3 SET RMPRLCN=RMPR7I("LOCATION")
+4 SET RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
+5 SET RMPR6("HCPCS")=RMPRHCPC
+6 SET RMPRERR=$$GET^RMPRPIX6(.RMPR6)
PVENX QUIT
PVENE() ;
+1 if $QSUBSCRIPT(RMPRGBL,1)'=661.7
QUIT 1
+2 if $QSUBSCRIPT(RMPRGBL,2)'="XSHIDS"
QUIT 1
+3 if $QSUBSCRIPT(RMPRGBL,3)'=RMPRSTN
QUIT 1
+4 if $QSUBSCRIPT(RMPRGBL,4)'=RMPRHCPC
QUIT 1
+5 if $QSUBSCRIPT(RMPRGBL,5)'=RMPRITM
QUIT 1
+6 QUIT 0
PVENH WRITE !
+1 WRITE !,"Select a current stock record...",!
+2 WRITE ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
+3 IF RMPRLCN=""
WRITE ?69,"Location"
+4 QUIT
