| [613] | 1 | PPPEDT1 ;ALB/DMB - PPP EDIT ROUTINES ; 2/13/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 | EDITFFX(FFIFN) ; Edit an FFX entry
|
|---|
| 6 | ;
|
|---|
| 7 | N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
|
|---|
| 8 | ;
|
|---|
| 9 | S PARMERR=-9001
|
|---|
| 10 | S FINDERR=-9003
|
|---|
| 11 | S LOCKERR=-9004
|
|---|
| 12 | S USRABORT=-1001
|
|---|
| 13 | ;
|
|---|
| 14 | I '$D(FFIFN) Q PARMERR
|
|---|
| 15 | I FFIFN'>0 Q PARMERR
|
|---|
| 16 | I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
|
|---|
| 17 | ;
|
|---|
| 18 | S DIE=1020.2
|
|---|
| 19 | S DA=FFIFN
|
|---|
| 20 | S DR="2Enter Last Date Of Visit;1Place of visit"
|
|---|
| 21 | L +(^PPP(1020.2,FFIFN)):5
|
|---|
| 22 | I '$T Q LOCKERR
|
|---|
| 23 | D ^DIE
|
|---|
| 24 | L -(^PPP(1020.2,FFIFN)):5
|
|---|
| 25 | I $D(DTOUT)!($D(Y)'=0) Q USRABORT
|
|---|
| 26 | Q 0
|
|---|
| 27 | ;
|
|---|
| 28 | EDTFFX(FFIFN) ; Edit an FFX entry
|
|---|
| 29 | ;
|
|---|
| 30 | N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
|
|---|
| 31 | ;
|
|---|
| 32 | S PARMERR=-9001
|
|---|
| 33 | S FINDERR=-9003
|
|---|
| 34 | S LOCKERR=-9004
|
|---|
| 35 | S USRABORT=-1001
|
|---|
| 36 | ;
|
|---|
| 37 | I '$D(FFIFN) Q PARMERR
|
|---|
| 38 | I FFIFN'>0 Q PARMERR
|
|---|
| 39 | I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
|
|---|
| 40 | ;
|
|---|
| 41 | S DIE=1020.2
|
|---|
| 42 | S DA=FFIFN
|
|---|
| 43 | S DR="2Enter Last Date Of Visit"
|
|---|
| 44 | L +(^PPP(1020.2,FFIFN)):5
|
|---|
| 45 | I '$T Q LOCKERR
|
|---|
| 46 | D ^DIE
|
|---|
| 47 | L -(^PPP(1020.2,FFIFN)):5
|
|---|
| 48 | I $D(DTOUT)!($D(Y)'=0) Q USRABORT
|
|---|
| 49 | Q 0
|
|---|
| 50 | ;
|
|---|
| 51 | NEWFFX(PATDFN,SNIFN,SRC) ; Create a new FFX entry
|
|---|
| 52 | ;
|
|---|
| 53 | N PARMERR,FINDERR,LOCLERR,DIC,X,Y,TMP,ERR,DTOUT,DUOUT,FFIFN
|
|---|
| 54 | ;
|
|---|
| 55 | S PARMERR=-9001
|
|---|
| 56 | S FINDERR=-9003
|
|---|
| 57 | S LOCKERR=-9004
|
|---|
| 58 | S ERR=0
|
|---|
| 59 | ;
|
|---|
| 60 | ; Check Input Parameters
|
|---|
| 61 | ;
|
|---|
| 62 | I '$D(PATDFN) Q PARMERR
|
|---|
| 63 | I '$D(SNIFN) Q PARMERR
|
|---|
| 64 | I '$D(SRC) Q PARMERR
|
|---|
| 65 | I SRC<0!(SRC>1) Q PARMERR
|
|---|
| 66 | ;
|
|---|
| 67 | ; Set up FileMan For New Entry
|
|---|
| 68 | ;
|
|---|
| 69 | S DIC="^PPP(1020.2,"
|
|---|
| 70 | S DIC(0)=""
|
|---|
| 71 | S X=PATDFN
|
|---|
| 72 | S DIC("DR")="1////"_SNIFN_";7////"_SRC
|
|---|
| 73 | L +(^PPP(1020.2)):5
|
|---|
| 74 | I '$T D
|
|---|
| 75 | .S ERR=LOCKERR
|
|---|
| 76 | E D
|
|---|
| 77 | .K DD,DO D FILE^DICN
|
|---|
| 78 | .L -(^PPP(1020.2)):5
|
|---|
| 79 | ;
|
|---|
| 80 | ; If the entry was added successfully, add the remaining fields
|
|---|
| 81 | ;
|
|---|
| 82 | I 'ERR D
|
|---|
| 83 | .I $P(Y,"^",3)=1 D
|
|---|
| 84 | ..S FFIFN=$P(Y,"^",1)
|
|---|
| 85 | ..S TMP=$$EDITFFX(FFIFN)
|
|---|
| 86 | ..I TMP<0 S ERR=TMP
|
|---|
| 87 | .E S ERR=FINDERR
|
|---|
| 88 | Q ERR
|
|---|
| 89 | ;
|
|---|
| 90 | AED ; Create/Edit/Delete an entry in the FFX file
|
|---|
| 91 | ;
|
|---|
| 92 | N PPPMRT,BANNER,IX1,TMP,PATIENT,PATDFN,STOP
|
|---|
| 93 | ;
|
|---|
| 94 | S PPPMRT="AED"
|
|---|
| 95 | S BANNER="FOREIGN FACILITY XREF ADD/EDIT UTILITY"
|
|---|
| 96 | S STOP=0
|
|---|
| 97 | ;
|
|---|
| 98 | ; -- Patient Prompt
|
|---|
| 99 | S PATDFN=0
|
|---|
| 100 | F IX1=0:0 D Q:PATIENT&(STOP)
|
|---|
| 101 | .S TMP=$$BANNER^PPPDSP1(BANNER) W !!
|
|---|
| 102 | .S PATIENT=$$GETDFN^PPPGET1("",1)
|
|---|
| 103 | .S PATDFN=$P(PATIENT,"^")
|
|---|
| 104 | .I PATDFN<0 S STOP=1 Q
|
|---|
| 105 | .D DSPFF^PPPEDT12(PATDFN)
|
|---|
| 106 | Q
|
|---|
| 107 | ;
|
|---|
