source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYQ.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1RMPRPIYQ ;HINCIO/ODJ - PIP EDIT - PROMPTS ;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ; The following subroutines are for selecting HCPCS
5 ; and Inventory Item
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 ;***** LOCN - Prompt for Inventory Location based on 661.4 file
23 ; and a given HCPCS and PIP Item
24LOCN(RMPRSTN,RMPR11,RMPR5,RMPREXC) ;
25 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR,RMPR4
26 N RMPRMAX,RMPRLIN,RMPRGBL,RMPRHCPC,RMPRITEM
27 S RMPRERR=0
28 S RMPREXC=""
29 S RMPRHCPC=RMPR11("HCPCS")
30 S RMPRITEM=RMPR11("ITEM")
31 K RMPR5
32 S RMPRMAX=15
33 S RMPRLIN=0
34 ;
35 ; See if just 1 location - no need to list if there is
36 S RMPRGBLR="^RMPR(661.4,""XSHIL"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITEM_""")"
37 S RMPRGBL=$Q(@RMPRGBLR)
38 I $$LOCNE() G LOCNX
39 S RMPR5("IEN")=$QS(RMPRGBL,6)
40 S RMPRGBL=$Q(@RMPRGBL)
41 I $$LOCNE() S RMPRERR=$$GET^RMPRPIX5(.RMPR5) G LOCNX
42 ;
43 ; Selection list of items if more than 1
44 S RMPRGBL=RMPRGBLR
45LOCNL1 S RMPRGBL=$Q(@RMPRGBL)
46 I $$LOCNE G:'RMPRLIN LOCNX G LOCNP
47 I RMPRLIN,'(RMPRLIN#RMPRMAX) D G LOCNP
48 . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
49 . Q
50LOCNL2 S RMPRLIN=RMPRLIN+1
51 I RMPRLIN=1 D LOCNH
52 S RMPR5("IEN")=$QS(RMPRGBL,6)
53 S RMPRERR=$$GET^RMPRPIX5(.RMPR5)
54 K RMPR4
55 S RMPR4("IEN")=$QS(RMPRGBL,7)
56 I RMPR4("IEN")'="" S RMPRERR=$$GET^RMPRPIX4(.RMPR4)
57 W !,$J(RMPRLIN,2)," ",$E(RMPR5("NAME"),1,20)
58 W ?24,$J($G(RMPR4("RE-ORDER QTY")),5)
59 S RMPRA(RMPRLIN)=RMPR5("IEN")
60 K RMPR5
61 G LOCNL1
62 ;
63 ; Prompt for selection
64LOCNP S DIR(0)="FAO"
65 S DIR("A")="Choose 1 - "_RMPRLIN_" : "
66 D ^DIR
67 I $D(DTOUT) S RMPREXC="T" G LOCNX
68 I $D(DIROUT) S RMPREXC="P" G LOCNX
69 I X="",$D(DIR("A",1)) K DIR("A",1) D LOCNH G LOCNL2
70 I X="" S RMPREXC="^" G LOCNX
71 I X["^"!($D(DUOUT)) S RMPREXC="^" G LOCNX
72 I '$D(RMPRA(X)) D G LOCNP
73 . W !,"Please select a Location by entering a line number in range 1 - "
74 . W RMPRLIN
75 . Q
76 S RMPR5("IEN")=RMPRA(X)
77 S RMPRERR=$$GET^RMPRPIX5(.RMPR5)
78LOCNX Q
79LOCNE() ;
80 Q:$QS(RMPRGBL,1)'=661.4 1
81 Q:$QS(RMPRGBL,2)'="XSHIL" 1
82 Q:$QS(RMPRGBL,3)'=RMPRSTN 1
83 Q:$QS(RMPRGBL,4)'=RMPRHCPC 1
84 Q:$QS(RMPRGBL,5)'=RMPRITEM 1
85 Q 0
86LOCNH W !
87 W !,"Select a Location...",!
88 W ?3,"Location",?24,"Re-Order Qty."
89 Q
Note: See TracBrowser for help on using the repository browser.