| 1 | RMPRPIYM ;HINCIO/ODJ - PIP RECONCILE OPTION PROMPTS ;3/8/01
|
|---|
| 2 | ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ; The following subroutines are a series of prompts called
|
|---|
| 5 | ; by RECONCILE option (UP^RMPRPIYA)
|
|---|
| 6 | ;
|
|---|
| 7 | ;***** OK - Prompt for an OK
|
|---|
| 8 | OK(RMPRYN,RMPREXC) ;
|
|---|
| 9 | N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
|
|---|
| 10 | S RMPREXC=""
|
|---|
| 11 | S RMPRYN="N"
|
|---|
| 12 | S DIR("A")=" ...OK"
|
|---|
| 13 | S DIR("B")="Yes"
|
|---|
| 14 | S DIR(0)="Y"
|
|---|
| 15 | D ^DIR
|
|---|
| 16 | I $D(DTOUT) S RMPREXC="T" G OKX
|
|---|
| 17 | I $D(DIROUT) S RMPREXC="P" G OKX
|
|---|
| 18 | I X=""!(X["^") S RMPREXC="^" G OKX
|
|---|
| 19 | S RMPRYN="N" S:Y RMPRYN="Y"
|
|---|
| 20 | OKX Q
|
|---|
| 21 | ;
|
|---|
| 22 | ;***** ITEM - Prompt for Item - restrict choice to Location and HCPC
|
|---|
| 23 | ITEM(RMPRSTN,RMPRLCN,RMPRHCPC,RMPR11,RMPR4,RMPREXC) ;
|
|---|
| 24 | N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,RMPRSRC,RMPRYN
|
|---|
| 25 | S RMPRERR=0
|
|---|
| 26 | S RMPREXC=""
|
|---|
| 27 | I $G(RMPRSTN)="" S RMPRERR=1 G ITEMX
|
|---|
| 28 | I $G(RMPRLCN)="" S RMPRERR=2 G ITEMX
|
|---|
| 29 | I $G(RMPRHCPC)="" S RMPRERR=3 G ITEMX
|
|---|
| 30 | K RMPR11,RMPR4
|
|---|
| 31 | S DIR(0)="FOA^1:50"
|
|---|
| 32 | S DIR("A")="Enter ITEM to Reconcile: "
|
|---|
| 33 | S DIR("?")="^D QM^RMPRPIY8"
|
|---|
| 34 | S DIR("??")="^D QQM^RMPRPIY8"
|
|---|
| 35 | ITEMA1 D ^DIR
|
|---|
| 36 | I $D(DTOUT) S RMPREXC="T" G ITEMX
|
|---|
| 37 | I $D(DIROUT) S RMPREXC="P" G ITEMX
|
|---|
| 38 | I X=""!(X["^")!$D(DUOUT) S RMPREXC="^" G ITEMX
|
|---|
| 39 | D LIKE^RMPRPIY8(RMPRSTN,RMPRLCN,RMPRHCPC,X,.RMPREXC,.RMPR11,.RMPR4)
|
|---|
| 40 | I RMPREXC="T" G ITEMX
|
|---|
| 41 | I RMPREXC="P" G ITEMX
|
|---|
| 42 | I RMPREXC="^" G ITEMA1
|
|---|
| 43 | I RMPR4("IEN")="" D G ITEMA1
|
|---|
| 44 | . W !,"Cannot locate ITEM with this sequence NUMBER"
|
|---|
| 45 | . Q
|
|---|
| 46 | W " ",RMPR11("HCPCS-ITEM")," ",RMPR11("DESCRIPTION")
|
|---|
| 47 | D OK(.RMPRYN,.RMPREXC)
|
|---|
| 48 | I RMPRYN'="Y" G ITEMA1
|
|---|
| 49 | G ITEMX
|
|---|
| 50 | ITEMX Q RMPRERR
|
|---|
