source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPDX2.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1PPPPDX2 ;ALB/DMB/DAD - PPP PDX ROUTINES ; 6/30/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**8**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PDXFFX(SSN,STATION) ; Get the FFX IFN or create a new entry for PDX
6 ;
7 ; This function is called by the PDX trigger to lookup or create
8 ; an entry in the foreign facility cross-reference.
9 ;
10 ; Parameters:
11 ; SSN - The Patient SSN
12 ; STATION - The Station Number the patient visited
13 ;
14 ; Returns:
15 ; Normal Termination - The Internal File Number of the entry.
16 ; Error - -9002 = could not find SSN in patient file or Station
17 ; number in institution file.
18 ; -9003 = An error occurred while creating the new entry.
19 ;
20 N LKUPERR,FMERR,ERR,PATDFN,SNIFN,FFXIFN,X,DIC,Y,DA,HDRNODE
21 N TRECS,U,NEWREC
22 ;
23 S LOCKERR=-9004
24 S LKUPERR=-9003
25 S FMERR=-9002
26 S ERR=0
27 S U="^"
28 ;
29 ; Look up the patient and station IFN.
30 ;
31 S PATDFN=$O(^DPT("SSN",SSN,""))
32 S:PATDFN<1 ERR=LKUPERR
33 ;S SNIFN=$O(^DIC(4,"D",STATION,""))
34 S SNIFN=STATION
35 S:SNIFN<1 ERR=LKUPERR
36 ;
37 ; If the IFN's are good then see if there is an entry in the FFX file.
38 ; First lock the file. Return LOCKERR if we can't.
39 ;
40 L +(^PPP(1020.2)):5
41 S:'$T ERR=LOCKERR
42 ;
43 I 'ERR D
44 .S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,SNIFN,""))
45 .;
46 .; If the entry isn't there then create a new one
47 .;
48 .I FFXIFN'>0 D
49 ..S X=PATDFN
50 ..;
51 ..; Get the header node of the file
52 ..;
53 ..S HDRNODE=$G(^PPP(1020.2,0))
54 ..;
55 ..; Get the last record and total records values. Quit if NULL
56 ..;
57 ..S (FFXIFN,DA)=+$P(HDRNODE,U,3)+1
58 ..S TRECS=+$P(HDRNODE,U,3)
59 ..I +$P(HDRNODE,U,3)="" S ERR=FMERR Q
60 ..;
61 ..; Add the new record
62 ..;
63 ..S NEWREC=X
64 ..S $P(NEWREC,U,2)=SNIFN
65 ..S $P(NEWREC,U,4)=0
66 ..S ^PPP(1020.2,FFXIFN,0)=NEWREC
67 ..;
68 ..; Create the necessary indexes
69 ..;
70 ..S ^PPP(1020.2,"B",$E(X,1,30),FFXIFN)=""
71 ..S X=SNIFN D SDFNPOV^PPPFMX
72 ..;
73 ..; Update the header node
74 ..;
75 ..S $P(HDRNODE,U,3)=FFXIFN
76 ..S $P(HDRNODE,U,4)=TRECS+1
77 ..S ^PPP(1020.2,0)=HDRNODE
78 .L -^PPP(1020.2)
79 ;
80 ; Return the IFN or ERR
81 ;
82 Q:ERR ERR
83 Q FFXIFN
Note: See TracBrowser for help on using the repository browser.