| [613] | 1 | PPPEDT16 ;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 | ; This routines control the deleting of entries in the foreign facility
|
|---|
| 6 | ; file.
|
|---|
| 7 | ;
|
|---|
| 8 | DEL ; -- Deletes FFX data
|
|---|
| 9 | ;
|
|---|
| 10 | N DELENTRY,PATNAME,STANO,DA,DIK
|
|---|
| 11 | N VALMY,SDI,SDAT,FFXIFN,ERR,TMP
|
|---|
| 12 | ;
|
|---|
| 13 | S DELENTRY=1003
|
|---|
| 14 | ;
|
|---|
| 15 | D EN^VALM2($G(XQORNOD(0)),"S")
|
|---|
| 16 | Q:'$D(VALMY)
|
|---|
| 17 | S SDI=""
|
|---|
| 18 | S SDI=$O(VALMY(SDI)) Q:SDI=""
|
|---|
| 19 | S SDAT=$G(@IDXARRAY@(SDI))
|
|---|
| 20 | S FFXIFN=$P(SDAT,U,2)
|
|---|
| 21 | S PATNAME=$P(SDAT,U,3)
|
|---|
| 22 | S STANO=$P(SDAT,U,4)
|
|---|
| 23 | D DEL1
|
|---|
| 24 | D INIT^PPPEDT12
|
|---|
| 25 | S VALMBCK="R"
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | DEL1 ; -- Deletes entry in FFX file
|
|---|
| 29 | S DIK="^PPP(1020.2,"
|
|---|
| 30 | S DA=FFXIFN
|
|---|
| 31 | L +(^PPP(1020.2,FFXIFN)):5
|
|---|
| 32 | I '$T D
|
|---|
| 33 | .W !,*7,"File in use. Try again later"
|
|---|
| 34 | .R !,"Press <RETURN> to continue...",TMP:DTIME
|
|---|
| 35 | E D
|
|---|
| 36 | .D ^DIK
|
|---|
| 37 | .L -(^PPP(1020.2,FFXIFN)):5
|
|---|
| 38 | .S TMP=$$STATUPDT^PPPMSC1(6,1)
|
|---|
| 39 | .S TMP=$$LOGEVNT^PPPMSC1(DELENTRY,"DEL_PPPEDT16",PATNAME_", "_STANO)
|
|---|
| 40 | .;W !,"Entry Deleted."
|
|---|
| 41 | .;R !,"Press <RETURN> to continue...",TMP:DTIME
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | END ; -- End of code
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
