51 lines
1.4 KiB
Mathematica
51 lines
1.4 KiB
Mathematica
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
|