108 lines
2.1 KiB
Mathematica
108 lines
2.1 KiB
Mathematica
PPPEDT1 ;ALB/DMB - PPP EDIT ROUTINES ; 2/13/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
EDITFFX(FFIFN) ; Edit an FFX entry
|
|
;
|
|
N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
|
|
;
|
|
S PARMERR=-9001
|
|
S FINDERR=-9003
|
|
S LOCKERR=-9004
|
|
S USRABORT=-1001
|
|
;
|
|
I '$D(FFIFN) Q PARMERR
|
|
I FFIFN'>0 Q PARMERR
|
|
I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
|
|
;
|
|
S DIE=1020.2
|
|
S DA=FFIFN
|
|
S DR="2Enter Last Date Of Visit;1Place of visit"
|
|
L +(^PPP(1020.2,FFIFN)):5
|
|
I '$T Q LOCKERR
|
|
D ^DIE
|
|
L -(^PPP(1020.2,FFIFN)):5
|
|
I $D(DTOUT)!($D(Y)'=0) Q USRABORT
|
|
Q 0
|
|
;
|
|
EDTFFX(FFIFN) ; Edit an FFX entry
|
|
;
|
|
N PARMERR,FINDERR,LOCKERR,USRABORT,DIE,DA,DR,DUOUT,DTOUT
|
|
;
|
|
S PARMERR=-9001
|
|
S FINDERR=-9003
|
|
S LOCKERR=-9004
|
|
S USRABORT=-1001
|
|
;
|
|
I '$D(FFIFN) Q PARMERR
|
|
I FFIFN'>0 Q PARMERR
|
|
I '$D(^PPP(1020.2,FFIFN)) Q FINDERR
|
|
;
|
|
S DIE=1020.2
|
|
S DA=FFIFN
|
|
S DR="2Enter Last Date Of Visit"
|
|
L +(^PPP(1020.2,FFIFN)):5
|
|
I '$T Q LOCKERR
|
|
D ^DIE
|
|
L -(^PPP(1020.2,FFIFN)):5
|
|
I $D(DTOUT)!($D(Y)'=0) Q USRABORT
|
|
Q 0
|
|
;
|
|
NEWFFX(PATDFN,SNIFN,SRC) ; Create a new FFX entry
|
|
;
|
|
N PARMERR,FINDERR,LOCLERR,DIC,X,Y,TMP,ERR,DTOUT,DUOUT,FFIFN
|
|
;
|
|
S PARMERR=-9001
|
|
S FINDERR=-9003
|
|
S LOCKERR=-9004
|
|
S ERR=0
|
|
;
|
|
; Check Input Parameters
|
|
;
|
|
I '$D(PATDFN) Q PARMERR
|
|
I '$D(SNIFN) Q PARMERR
|
|
I '$D(SRC) Q PARMERR
|
|
I SRC<0!(SRC>1) Q PARMERR
|
|
;
|
|
; Set up FileMan For New Entry
|
|
;
|
|
S DIC="^PPP(1020.2,"
|
|
S DIC(0)=""
|
|
S X=PATDFN
|
|
S DIC("DR")="1////"_SNIFN_";7////"_SRC
|
|
L +(^PPP(1020.2)):5
|
|
I '$T D
|
|
.S ERR=LOCKERR
|
|
E D
|
|
.K DD,DO D FILE^DICN
|
|
.L -(^PPP(1020.2)):5
|
|
;
|
|
; If the entry was added successfully, add the remaining fields
|
|
;
|
|
I 'ERR D
|
|
.I $P(Y,"^",3)=1 D
|
|
..S FFIFN=$P(Y,"^",1)
|
|
..S TMP=$$EDITFFX(FFIFN)
|
|
..I TMP<0 S ERR=TMP
|
|
.E S ERR=FINDERR
|
|
Q ERR
|
|
;
|
|
AED ; Create/Edit/Delete an entry in the FFX file
|
|
;
|
|
N PPPMRT,BANNER,IX1,TMP,PATIENT,PATDFN,STOP
|
|
;
|
|
S PPPMRT="AED"
|
|
S BANNER="FOREIGN FACILITY XREF ADD/EDIT UTILITY"
|
|
S STOP=0
|
|
;
|
|
; -- Patient Prompt
|
|
S PATDFN=0
|
|
F IX1=0:0 D Q:PATIENT&(STOP)
|
|
.S TMP=$$BANNER^PPPDSP1(BANNER) W !!
|
|
.S PATIENT=$$GETDFN^PPPGET1("",1)
|
|
.S PATDFN=$P(PATIENT,"^")
|
|
.I PATDFN<0 S STOP=1 Q
|
|
.D DSPFF^PPPEDT12(PATDFN)
|
|
Q
|
|
;
|