RMPRPIYM ;HINCIO/ODJ - PIP RECONCILE OPTION PROMPTS ;3/8/01
;;3.0;PROSTHETICS;**61**;Feb 09, 1996
Q
; The following subroutines are a series of prompts called
; by RECONCILE option (UP^RMPRPIYA)
;
;***** 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
;
;***** 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 ITEM to Reconcile: "
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRPIYM 1530 printed Dec 13, 2024@02:37:10 Page 2
RMPRPIYM ;HINCIO/ODJ - PIP RECONCILE OPTION PROMPTS ;3/8/01
+1 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
+2 QUIT
+3 ; The following subroutines are a series of prompts called
+4 ; by RECONCILE option (UP^RMPRPIYA)
+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 ;***** ITEM - Prompt for Item - 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 Reconcile: "
+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(.RMPRYN,.RMPREXC)
+13 IF RMPRYN'="Y"
GOTO ITEMA1
+14 GOTO ITEMX
ITEMX QUIT RMPRERR
