source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPEDT1.m@ 1245

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1PPPEDT1 ;ALB/DMB - PPP EDIT ROUTINES ; 2/13/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EDITFFX(FFIFN) ; Edit an FFX entry
6 ;
7 N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
8 ;
9 S PARMERR=-9001
10 S FINDERR=-9003
11 S LOCKERR=-9004
12 S USRABORT=-1001
13 ;
14 I '$D(FFIFN) Q PARMERR
15 I FFIFN'>0 Q PARMERR
16 I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
17 ;
18 S DIE=1020.2
19 S DA=FFIFN
20 S DR="2Enter Last Date Of Visit;1Place of visit"
21 L +(^PPP(1020.2,FFIFN)):5
22 I '$T Q LOCKERR
23 D ^DIE
24 L -(^PPP(1020.2,FFIFN)):5
25 I $D(DTOUT)!($D(Y)'=0) Q USRABORT
26 Q 0
27 ;
28EDTFFX(FFIFN) ; Edit an FFX entry
29 ;
30 N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
31 ;
32 S PARMERR=-9001
33 S FINDERR=-9003
34 S LOCKERR=-9004
35 S USRABORT=-1001
36 ;
37 I '$D(FFIFN) Q PARMERR
38 I FFIFN'>0 Q PARMERR
39 I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
40 ;
41 S DIE=1020.2
42 S DA=FFIFN
43 S DR="2Enter Last Date Of Visit"
44 L +(^PPP(1020.2,FFIFN)):5
45 I '$T Q LOCKERR
46 D ^DIE
47 L -(^PPP(1020.2,FFIFN)):5
48 I $D(DTOUT)!($D(Y)'=0) Q USRABORT
49 Q 0
50 ;
51NEWFFX(PATDFN,SNIFN,SRC) ; Create a new FFX entry
52 ;
53 N PARMERR,FINDERR,LOCLERR,DIC,X,Y,TMP,ERR,DTOUT,DUOUT,FFIFN
54 ;
55 S PARMERR=-9001
56 S FINDERR=-9003
57 S LOCKERR=-9004
58 S ERR=0
59 ;
60 ; Check Input Parameters
61 ;
62 I '$D(PATDFN) Q PARMERR
63 I '$D(SNIFN) Q PARMERR
64 I '$D(SRC) Q PARMERR
65 I SRC<0!(SRC>1) Q PARMERR
66 ;
67 ; Set up FileMan For New Entry
68 ;
69 S DIC="^PPP(1020.2,"
70 S DIC(0)=""
71 S X=PATDFN
72 S DIC("DR")="1////"_SNIFN_";7////"_SRC
73 L +(^PPP(1020.2)):5
74 I '$T D
75 .S ERR=LOCKERR
76 E D
77 .K DD,DO D FILE^DICN
78 .L -(^PPP(1020.2)):5
79 ;
80 ; If the entry was added successfully, add the remaining fields
81 ;
82 I 'ERR D
83 .I $P(Y,"^",3)=1 D
84 ..S FFIFN=$P(Y,"^",1)
85 ..S TMP=$$EDITFFX(FFIFN)
86 ..I TMP<0 S ERR=TMP
87 .E S ERR=FINDERR
88 Q ERR
89 ;
90AED ; Create/Edit/Delete an entry in the FFX file
91 ;
92 N PPPMRT,BANNER,IX1,TMP,PATIENT,PATDFN,STOP
93 ;
94 S PPPMRT="AED"
95 S BANNER="FOREIGN FACILITY XREF ADD/EDIT UTILITY"
96 S STOP=0
97 ;
98 ; -- Patient Prompt
99 S PATDFN=0
100 F IX1=0:0 D Q:PATIENT&(STOP)
101 .S TMP=$$BANNER^PPPDSP1(BANNER) W !!
102 .S PATIENT=$$GETDFN^PPPGET1("",1)
103 .S PATDFN=$P(PATIENT,"^")
104 .I PATDFN<0 S STOP=1 Q
105 .D DSPFF^PPPEDT12(PATDFN)
106 Q
107 ;
Note: See TracBrowser for help on using the repository browser.