source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPEDT16.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.0 KB
Line 
1PPPEDT16 ;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 ;
8DEL ; -- 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 ;
28DEL1 ; -- 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 ;
44END ; -- End of code
45 Q
46 ;
Note: See TracBrowser for help on using the repository browser.