source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPEDT14.m@ 1427

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PPPEDT14 ;ALB/JFP - EDIT FF XREF ROUTINE ;5/19/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; These routines control the adding of foreign facility
6 ; data to the FFX file (Add Entry).
7 ;
8ADD ; -- Adds new entry to FFX file
9 ;
10 N SNIFN,STATION,STANO,ERR,NEWENTRY,PATNAME,LOCKERR,STANAME
11 ;
12 S LOCKERR=-9004
13 S NEWENTRY=1001
14 ;
15 I $P(XQORNOD(0),"^",4)["=" D
16 . W !," - Add Entry action doesn't allow for numeric selection..."
17ADD1 S SNIFN=$$GETINST^PPPGET3()
18 I SNIFN<0 S VALMBCK="R" Q
19 S STATION=$$GETSNIFN^PPPGET3(SNIFN,1)
20 S SNIFN=$P(STATION,"^")
21 I SNIFN=-1001 Q ; -- user abort
22 I SNIFN<0 D G ADD1
23 .W ?35,"...No entry found"
24 S STANAME=$P(STATION,"^",2)
25 S STANO=$$GETSTANO^PPPGET1(SNIFN)
26 ;
27 D PATDATA(PATDFN) S PATNAME=$G(PPPTMP(2,PATDFN,.01)) K PPPTMP
28 S ERR=$$NEWFFX(PATDFN,SNIFN,1)
29 I ERR=-1001 D Q
30 .N DIK,DA
31 .S DIK="^PPP(1020.2,"
32 .S DA=FFIFN
33 .D ^DIK
34 ;
35 I ERR<0 D Q
36 .W !,*7,"An unexpected error occurred"
37 .S TMP=$$STATUPDT^PPPMSC1(5,1)
38 .S TMP=$$LOGEVNT^PPPMSC1(ERR,"ADD_PPPEDT14",PATNAME)
39 .R !,"Press <RETURN> to continue...",TMP:DTIME
40 ;
41 I ERR=LOCKERR D
42 .W !,"File in use. Please try again later."
43 .R !,"Press <RETURN> to continue...",TMP:DTIME
44 E D
45 .S TMP=$$LOGEVNT^PPPMSC1(NEWENTRY,"ADD_PPPEDT14",PATNAME_", "_STANO)
46 .;W !,"New entry added."
47 .;R !,"Press <RETURN> to continue...",TMP:DTIME
48 D INIT^PPPEDT12
49 S VALMBCK="R"
50 K FFIFN
51 Q
52 ;
53NEWFFX(PATDFN,SNIFN,SRC) ; Create a new FFX entry
54 ;
55 N PARMERR,FINDERR,LOCLERR,DIC,X,Y,TMP,ERR,DTOUT,DUOUT
56 ;
57 S PARMERR=-9001
58 S FINDERR=-9003
59 S LOCKERR=-9004
60 S ERR=0
61 ;
62 ; Check Input Parameters
63 ;
64 I '$D(PATDFN) Q PARMERR
65 I '$D(SNIFN) Q PARMERR
66 I '$D(SRC) Q PARMERR
67 I SRC<0!(SRC>1) Q PARMERR
68 ;
69 ; Set up FileMan For New Entry
70 ;
71 S DIC="^PPP(1020.2,"
72 S DIC(0)=""
73 S X=PATDFN
74 S DIC("DR")="1////"_SNIFN_";7////"_SRC
75 L +(^PPP(1020.2)):5
76 I '$T D
77 .S ERR=LOCKERR
78 E D
79 .K DD,DO D FILE^DICN
80 .L -(^PPP(1020.2)):5
81 ;
82 ; If the entry was added successfully, add the remaining fields
83 ;
84 I 'ERR D
85 .I $P(Y,"^",3)=1 D
86 ..S FFIFN=$P(Y,"^",1)
87 ..S TMP=$$EDTFFX^PPPEDT1(FFIFN)
88 ..I TMP<0 S ERR=TMP
89 .E S ERR=FINDERR
90 Q ERR
91 ;
92PATDATA(PATDFN) ; Pulls data from patient file
93 ;
94 ; Note: Calling routine must kill PPPTMP
95 ;
96 N DIC,DA,DR,DIQ,DUOUT,DTOUT
97 ;
98 S DIC="^DPT(",DA=PATDFN,DR=".01",DIQ="PPPTMP" D EN^DIQ1
99 Q
100 ;
Note: See TracBrowser for help on using the repository browser.