RMPRPIYX ;HINCIO/ODJ - PIP Data Entry - HCPCS Item;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
;
;***** Prompt for HCPCS Item - called by Transfer option
; 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 Item to transfer: "
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^RMPRPIY7(.RMPRYN,.RMPREXC)
I RMPRYN'="Y" G ITEMA1
G ITEMX
ITEMX Q RMPRERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYX 1128 printed Dec 13, 2024@02:37:20 Page 2
RMPRPIYX ;HINCIO/ODJ - PIP Data Entry - HCPCS Item;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ;
+4 ;***** Prompt for HCPCS Item - called by Transfer option
+5 ; restrict choice to Location and HCPC
ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ;
+1 NEW RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
+2 SET RMPRERR=0
+3 SET RMPREXC=""
+4 IF $GET(RMPRSTN)=""
SET RMPRERR=1
GOTO ITEMX
+5 IF $GET(RMPRLCN)=""
SET RMPRERR=2
GOTO ITEMX
+6 IF $GET(RMPRHCPC)=""
SET RMPRERR=3
GOTO ITEMX
+7 KILL RMPR11,RMPR4
+8 SET DIR(0)="FOA^1:50"
+9 SET DIR("A")="Enter Item to transfer: "
+10 SET DIR("?")="^D QM^RMPRPIY8"
+11 SET DIR("??")="^D QQM^RMPRPIY8"
ITEMA1 DO ^DIR
+1 IF $DATA(DTOUT)
SET RMPREXC="T"
GOTO ITEMX
+2 IF $DATA(DIROUT)
SET RMPREXC="P"
GOTO ITEMX
+3 IF X=""!(X["^")!$DATA(DUOUT)
SET RMPREXC="^"
GOTO ITEMX
+4 DO LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
+5 IF RMPREXC="T"
GOTO ITEMX
+6 IF RMPREXC="P"
GOTO ITEMX
+7 IF RMPREXC="^"
GOTO ITEMA1
+8 IF RMPR4("IEN")=""
Begin DoDot:1
+9 WRITE !,"Cannot locate ITEM with this sequence NUMBER"
+10 QUIT
End DoDot:1
GOTO ITEMA1
+11 WRITE " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION")
+12 DO OK^RMPRPIY7(.RMPRYN,.RMPREXC)
+13 IF RMPRYN'="Y"
GOTO ITEMA1
+14 GOTO ITEMX
ITEMX QUIT RMPRERR
