source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRPIY1.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1RMPRPIY1 ;HINCIO/ODJ - PIP Data Entry - Prompts;3/8/01
2 ;;3.0;PROSTHETICS;**61**;Feb 09, 1996
3 Q
4 ;
5 ;***** STN - Prompt for Station
6STN(RMPRSTN,RMPRESC) ;
7 N X,Y,DIC,DA,DUOUT,DTOUT,DIROUT,DIRUT,RMPR,RMPRSITE
8 S RMPRERR=0
9 S RMPRSTN("IEN")=$G(RMPRSTN("IEN"))
10 I $G(DUZ)="" S RMPRERR=1 G STNX ;User must exist (ptr. to ^VA(200))
11 S RMPRESC=""
12 D DIV4^RMPRSIT ; call standard Prosthetic site look-up
13 I $G(X)="^^" S RMPREXC="P" G STNX
14 I $D(X) S RMPRESC="^" G STNX
15 S RMPRSTN("IEN")=$G(RMPR("STA"))
16 I RMPRSTN("IEN")="" S RMPRERR=99 G STNX
17 S RMPRSTN("SITE NAME")=$G(RMPR("NAME"))
18STNX Q RMPRERR
19 ;
20 ;***** ITED - Edit an Inventory Item description and update 661.11
21ITED(RMPR11,RMPREXC) ;
22 N DIR,X,Y,DA,DUOUT,DTOUT,DIRUT,DIROUT,RMPRYN,RMPR11N,RMPRERR
23 S DIR(0)="FOA^3:60"
24 S DIR("A")="PIP Item Description: "
25 S DIR("??")="^D ITEDH2^RMPRPIY1"
26 S DIR("B")=$G(RMPR11("DESCRIPTION"))
27ITED1 D ^DIR
28 I $D(DTOUT) S RMPREXC="T" G ITEDX
29 I $D(DIROUT) S RMPREXC="P" G ITEDX
30 I X["^"!($D(DUOUT)) S RMPREXC="^" G ITEDX
31 I X="" G ITEDX
32 S RMPREXC=""
33 I X=$G(RMPR11("DESCRIPTION")) G ITEDX
34 L +^RMPR(661.11,RMPR11("IEN")):0 E D G ITEDX
35 . W !,"Item being edited by another user, cannot continue."
36 . H 2
37 . S RMPREXC="^"
38 . Q
39 S RMPR11N("DESCRIPTION")=X
40 D ITEDO(.RMPRYN,.RMPREXC)
41 I RMPREXC="T" G ITEDU
42 I RMPREXC'=""!(RMPRYN="N") D G ITED1
43 . S RMPREXC=""
44 . L -^RMPR(661.11,RMPR11("IEN"))
45 . Q
46 S RMPR11N("IEN")=RMPR11("IEN")
47 S RMPRERR=$$UPD^RMPRPIX1(.RMPR11N)
48 W !
49 S RMPR11("DESCRIPTION")=$G(RMPR11N("DESCRIPTION"))
50ITEDU L -^RMPR(661.11,RMPR11("IEN"))
51ITEDX Q
52 ;
53 ; (??) Help text for item desc.
54ITEDH2 W "Enter a description for this item which will be used locally by",!
55 W "your Prosthetics Service.",!
56 W "You may want to use the Item Master description with additional",!
57 W "text specifying things like size, volume, etc."
58 Q
59 ;
60 ; Y/N Prompt to confirm change of Item Description
61ITEDO(RMPRYN,RMPREXC) ;
62 N DIR,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
63 S RMPRYN="N"
64 S RMPREXC=""
65 S DIR(0)="Y"
66 S DIR("B")="N"
67 S DIR("A")="Are you sure you want to change this Item's Description"
68 D ^DIR
69 I $D(DTOUT) S RMPREXC="T" G ITEDOX
70 I $D(DIROUT) S RMPREXC="P" G ITEDOX
71 I X=""!(X["^")!($D(DUOUT)) S RMPREXC="^" G ITEDOX
72 S:Y RMPRYN="Y"
73ITEDOX Q
74 ;
75 ;***** MASIT - prompt for Item Master
76MASIT(RMPR1,RMPREXC) ;
77 N DIC,X,Y,DA,DUOUT,DTOUT,DIROUT,DIRUT
78 S DIC(0)="AEQM"
79 S DIC=661
80 S DIC("A")="IFCAP ITEM: "
81 I $G(RMPR1("ITEM MASTER IEN"))'="" S DIC("B")=RMPR1("ITEM MASTER IEN")
82 W !
83 D ^DIC
84 I $D(DTOUT) S RMPREXC="T" G MASITX
85 I $D(DUOUT) S RMPREXC=$S(X="^^":"P",1:"^") G MASITX
86 I +Y=-1 S RMPREXC="^" G MASITX
87 S RMPREXC=""
88 S RMPR1("IEN")=$P(Y,"^",1)
89MASITX Q
90 ;
91 ;***** HCPCS - select HCPCS and inventory item
92HCPCS(RMPRSTN,RMPRHCPC,RMPR1,RMPR11,RMPREXC) ;
93HCPCS1 D HCPCS^RMPRPIY7(RMPRSTN,$G(RMPRHCPC),.RMPR1,.RMPR11,.RMPREXC)
94 I RMPREXC="T" G HCPCSX
95 I RMPREXC="P"!(RMPREXC="^") G HCPCSX
96 I $G(RMPR11("IEN"))'="" G HCPCSX
97HCPCS2 D ITEM^RMPRPIYP(RMPRSTN,RMPR1("HCPCS"),.RMPR11,.RMPREXC)
98 I RMPREXC="T" G HCPCSX
99 I RMPREXC="P" G HCPCS1
100 I RMPREXC="^" G HCPCSX
101 S RMPR11("STATION")=RMPRSTN
102 S RMPR11("STATION IEN")=RMPRSTN
103 ;
104 ; display selected HCPCS and item and continue
105HCPCS3 W !!,"HCPCS: "_$G(RMPR1("HCPCS"))_" "_$G(RMPR1("SHORT DESC"))
106 W !!,"IFCAP Item: ",$G(RMPR11("ITEM MASTER"))
107 W !!,"PIP Item desc.: ",$G(RMPR11("DESCRIPTION"))
108HCPCSX Q
Note: See TracBrowser for help on using the repository browser.