source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPFMX1.m@ 724

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

initial load of WorldVistAEHR

File size: 1.3 KB
Line 
1PPPFMX1 ;ALB/JP - XREF CODES FOR PPP;01-DEC-92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4AC(IFN,SET,FNUM,OLDX) ;AC* XREF FOR FFX file (#1020.2)
5 ;INPUT : IFN - Internal file number of record
6 ; SET - If 1, set cross reference
7 ; If 0, kill cross reference (DEFAULT)
8 ; FNUM - Only valid for KILLS
9 ; The field number that was changed
10 ; OLDX - Only valid for KILLS
11 ; The previous value
12 ;OUTPUT : 0 - Cross reference was set/killed
13 ; -1 - Cross reference not set/killed
14 ; -2 - Bad input
15 ;
16 ; -- CHECK INPUT & RECORD EXISTANCE
17 Q:($G(IFN)="") -2
18 S SET=+$G(SET)
19 Q:('$D(^PPP(1020.2,IFN))) -2
20 Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
21 ; -- DECLARE VARIABLES
22 N PATPTR,DOMAIN,ZERO,ONE
23 ; -- GET INFO FOR XREF & QUIT IF ANY PART IS NULL
24 S ZERO=$G(^PPP(1020.2,IFN,0))
25 Q:(ZERO="") -1
26 ;
27 S ONE=$G(^PPP(1020.2,IFN,1))
28 Q:(ONE="") -1
29 ;
30 S PATPTR=$P(ZERO,"^",1)
31 I ('SET) S:(FNUM=.01) PATPTR=OLDX
32 Q:(PATPTR="") -1
33 ;
34 S DOMAIN=$P(ONE,"^",5)
35 I ('SET) S:(FNUM=1.5) DOMAIN=OLDX
36 Q:(DOMAIN="") -1
37 ;
38 ; -- SET XREF
39 S:(SET) ^PPP(1020.2,"AC",PATPTR,DOMAIN,IFN)=""
40 ; -- KILL X-REF
41 K:('SET) ^PPP(1020.2,"AC",PATPTR,DOMAIN,IFN)
42 Q 0
43 ;
Note: See TracBrowser for help on using the repository browser.