| [613] | 1 | PPPEDT14 ;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 | ;
|
|---|
| 8 | ADD ; -- 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..."
|
|---|
| 17 | ADD1 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 | ;
|
|---|
| 53 | NEWFFX(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 | ;
|
|---|
| 92 | PATDATA(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 | ;
|
|---|
