| 1 | PPPPDX3 ;ALB/DMB/DAD - ppp pdx routines ; 6/30/92
|
|---|
| 2 | ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**1,2,21,32,39**;APR 7,1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | PDXFFX(SSN,DOMAIN) ; 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 | ; DOMAIN - The Domain name 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 Domain
|
|---|
| 17 | ; name.
|
|---|
| 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 | ; -- Check Input
|
|---|
| 30 | Q:'$D(DOMAIN) FMERR
|
|---|
| 31 | Q:DOMAIN="" FMERR
|
|---|
| 32 | Q:'$D(^PPP(1020.8,"C",DOMAIN)) FMERR
|
|---|
| 33 | ;
|
|---|
| 34 | ; Look up the patient IFN
|
|---|
| 35 | ;
|
|---|
| 36 | S PATDFN=$O(^DPT("SSN",SSN,""))
|
|---|
| 37 | S:PATDFN<1 ERR=LKUPERR
|
|---|
| 38 | ;PPP*1*32 (Dave B - Check B & C xref for domain name)
|
|---|
| 39 | S SNIFN=$$FIND1^DIC(4.2,"","MX",DOMAIN,"B^C","","EMSG")
|
|---|
| 40 | S SNIFN=+$P(^DIC(4.2,SNIFN,0),"^",13)
|
|---|
| 41 | ;VMP OIFO BAY PINES;VGF;PPP*1.0*39
|
|---|
| 42 | S SNIFN=$O(^DIC(4,"D",SNIFN,0))
|
|---|
| 43 | S:SNIFN<1 ERR=LKUPERR
|
|---|
| 44 | DAVE ;
|
|---|
| 45 | ; If the INPUTS are good then see if there is an entry in the FFX file.
|
|---|
| 46 | I 'ERR D
|
|---|
| 47 | .S FFXIFN=$O(^PPP(1020.2,"AC",PATDFN,DOMAIN,""))
|
|---|
| 48 | .;
|
|---|
| 49 | .; If the entry isn't there then create a new one
|
|---|
| 50 | .;
|
|---|
| 51 | .I FFXIFN'>0 D
|
|---|
| 52 | ..S X=PATDFN
|
|---|
| 53 | ..S DIC="^PPP(1020.2,"
|
|---|
| 54 | ..S DLAYGO="1020.2"
|
|---|
| 55 | ..S DIC(0)="L"
|
|---|
| 56 | ..S DIC("DR")="1////"_SNIFN_";7////0;8////"_$G(DT)
|
|---|
| 57 | ..K DD,DO D FILE^DICN K DIC,DLAYGO,DO,DD
|
|---|
| 58 | ..;(PPP*1*32 Fix Quit without return value on next line - Dave B)
|
|---|
| 59 | ..I $P(Y,U,3)'=1 S ERR=LKUPERR
|
|---|
| 60 | Q:ERR ERR
|
|---|
| 61 | Q $P(Y,U,1)
|
|---|
