source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIYR.m@ 789

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1RMPRPIYR ;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 ;***** PVEN - Prompt for current Stock Record
23PVEN(RMPRSTN,RMPRLCN,RMPRHCPC,RMPRITM,RMPR6,RMPR7,RMPREXC) ;
24 N RMPRERR,DIR,X,Y,DUOUT,DTOUT,DIROUT,DA,DIRUT,RMPRA,RMPRGBLR
25 N RMPRMAX,RMPRLIN,RMPRGBL,RMPR7I,RMPRS
26 S RMPRERR=0
27 S RMPREXC=""
28 S RMPRMAX=15
29 S RMPRLIN=0
30 K RMPR7,RMPR6
31 S RMPRLCN=$G(RMPRLCN)
32 ;
33 ; See if just 1 record - no need to list if there is
34 S RMPRGBLR="^RMPR(661.7,""XSHIDS"","_RMPRSTN_","""_RMPRHCPC_""","""_RMPRITM_""")"
35 S RMPRGBL=$Q(@RMPRGBLR)
36 I $$PVENE() G PVENX
37 S RMPR7("IEN")=$QS(RMPRGBL,8)
38 S RMPRGBL=$Q(@RMPRGBL)
39 I $$PVENE() G PVENG
40 ;
41 ; Selection list of current stock records
42 S RMPRGBL=RMPRGBLR
43PVENL1 S RMPRGBL=$Q(@RMPRGBL)
44 I $$PVENE G:'RMPRLIN PVENX G PVENP
45 K RMPR7,RMPR7I
46 S RMPR7("IEN")=$QS(RMPRGBL,8)
47 S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
48 S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
49 I RMPRLCN'="",RMPRLCN'=RMPR7I("LOCATION") G PVENL1
50 I RMPRLIN,'(RMPRLIN#RMPRMAX) D G PVENP
51 . S DIR("A",1)="Press <RETURN> to see more, '^' to exit this list, or"
52 . Q
53PVENL2 S RMPRLIN=RMPRLIN+1
54 I RMPRLIN=1 D PVENH
55 S RMPRS=$P(RMPR7I("DATE&TIME"),".",1)
56 W !,$J(RMPRLIN,2)," ",$E(RMPRS,4,5)_"/"_$E(RMPRS,6,7)_"/"_$E(RMPRS,2,3)
57 W ?11,$J(RMPR7("QUANTITY"),5,0)
58 I +RMPR7("QUANTITY") D
59 . W ?18,$J(RMPR7("VALUE")/RMPR7("QUANTITY"),8,2)
60 . Q
61 W ?26,$J(RMPR7("VALUE"),10,2)
62 S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
63 S RMPR6("HCPCS")=RMPRHCPC
64 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
65 W ?38,$E(RMPR6("VENDOR"),1,30)
66 W ?69,$E(RMPR7("LOCATION"),1,10)
67 S RMPRA(RMPRLIN)=RMPR7("IEN")
68 K RMPR7,RMPR7I,RMPR6
69 G PVENL1
70 ;
71 ; Prompt for selection
72PVENP S DIR(0)="FAO"
73 S DIR("A")="Choose 1 - "_RMPRLIN_" : "
74 D ^DIR
75 I $D(DTOUT) S RMPREXC="T" G PVENX
76 I $D(DIROUT) S RMPREXC="P" G PVENX
77 I X="",$D(DIR("A",1)) K DIR("A",1) D PVENH G PVENL2
78 I X="" S RMPREXC="^" G PVENX
79 I X["^"!($D(DUOUT)) S RMPREXC="^" G PVENX
80 I '$D(RMPRA(X)) D G PVENP
81 . W !,"Please select a current stock record"
82 . W !,"by entering a line number in range 1 - "
83 . W RMPRLIN
84 . Q
85 S RMPR7("IEN")=RMPRA(X)
86PVENG S RMPRERR=$$GET^RMPRPIX7(.RMPR7)
87 K RMPR7I
88 S RMPRERR=$$ETOI^RMPRPIX7(.RMPR7,.RMPR7I)
89 S RMPRLCN=RMPR7I("LOCATION")
90 S RMPR6("DATE&TIME")=RMPR7I("DATE&TIME")
91 S RMPR6("HCPCS")=RMPRHCPC
92 S RMPRERR=$$GET^RMPRPIX6(.RMPR6)
93PVENX Q
94PVENE() ;
95 Q:$QS(RMPRGBL,1)'=661.7 1
96 Q:$QS(RMPRGBL,2)'="XSHIDS" 1
97 Q:$QS(RMPRGBL,3)'=RMPRSTN 1
98 Q:$QS(RMPRGBL,4)'=RMPRHCPC 1
99 Q:$QS(RMPRGBL,5)'=RMPRITM 1
100 Q 0
101PVENH W !
102 W !,"Select a current stock record...",!
103 W ?3,"Date",?13,"Qty",?18,"Unit Cost",?31,"Value",?38,"Vendor"
104 I RMPRLCN="" W ?69,"Location"
105 Q
Note: See TracBrowser for help on using the repository browser.