source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYM.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1RMPRPIYM ;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
8OK(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"
20OKX Q
21 ;
22 ;***** ITEM - Prompt for Item - restrict choice to Location and HCPC
23ITEM(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"
35ITEMA1 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
50ITEMX Q RMPRERR
Note: See TracBrowser for help on using the repository browser.