- 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 Feb 19, 2025@00:03:37 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