| 1 | PPPPDX2 ;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 | ;
|
|---|
| 5 | PDXFFX(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
|
|---|
