source: FOIAVistA/tag/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPFMA1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PPPFMA1 ;ALB/DMB - FOREIGN MEDICATION ALERT TEST ROUTINE ; 3/2/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5FMA(PATDFN) ; Foreign Medication Alert Call
6 ;
7 I $$DFL^PPPDSP2(PATDFN,"PPPPDX") K PPPPDX Q $$FMA1(PATDFN)
8 Q 0
9 ;
10FMA1(PATDFN) ; Foreign Medication Alert
11 ;
12 ; This function determines if the patient has been to other hospitals
13 ; and whether there is any prescription information in the PDX
14 ; data file for the patient. If there is data, the user is given the
15 ; option of viewing it.
16 ;
17 ; Parameters: PATDFN - The patient DFN from the patient file.
18 ;
19 ; Return: 0 - Normal Termination
20 ; -9001 - Input Parameter Format Error
21 ; -9003 - Invalid Patient DFN
22 ;
23 N DIR,DUOUT,DTOUT,DIRUT,DIROUT,ERR,LKUPERR,PARMERR
24 N TMP,PPPPDX,XTRCTERR,X,Y,ALRTIGND
25 ;
26 ; Note: ^TMP("PPP",$J) is killed in PPPPRT1
27 ;
28 S PARMERR=-9001
29 S LKUPERR=-9003
30 S XTRCTERR=-9010
31 S ALRTIGND=1010
32 S ERR=0
33 ;
34 I $G(PATDFN)<1 Q PARMERR
35 I '$D(^DPT(PATDFN)) Q LKUPERR
36 ;
37 I $D(^PPP(1020.2,"B",PATDFN)) D
38 .S ERR=$$DFL^PPPDSP2(PATDFN,"PPPPDX","V")
39 .I ERR=1 D
40 ..;
41 ..;Increment alert issued statistic
42 ..;
43 ..S TMP=$$STATUPDT^PPPMSC1(3,1)
44 ..W !
45 ..S DIR(0)="Y"
46 ..S DIR("A")="Do you wish to view the foreign profiles"
47 ..S DIR("B")="YES"
48 ..S DIR("?")="Answer YES to view the short form drug profiles from each facility."
49 ..D ^DIR
50 ..I Y D
51 ...;
52 ...; Get the PDX data and display it for the user
53 ...;
54 ...S ERR=$$GETPDX^PPPGET2("PPPPDX","^TMP(""PPP"","_$J_")")
55 ...I ERR<0 D Q
56 ....W !,*7,"An unexpected error occurred while extracting the PDX data."
57 ....W !,"Please contact your IRM representative and report this problem."
58 ....R !,"Press <RETURN> to continue...",TMP:DTIME
59 ....S TMP=$$LOGEVNT^PPPMSC1(XTRCTERR,"FMA1_PPPFMA1")
60 ...S TMP=$$VFM^PPPPRT1(PATDFN,"^TMP(""PPP"","_$J_")")
61 ...S TMP=$$STATUPDT^PPPMSC1(9,1)
62 ..E D
63 ...S TMP=$$LOGEVNT^PPPMSC1(ALRTIGND,"FMA1_PPPFMA1","PATIENT = "_$$GETPATNM^PPPGET1(PATDFN))
64 ...S TMP=$$STATUPDT^PPPMSC1(4,1)
65 E S ERR=LKUPERR
66 Q ERR
67 ;
68FMAI ; Get foreign visit information interactively
69 ;
70 N TMP
71 ;
72 W @IOF
73 S TMP=$$FMA1(+$$GETDFN^PPPGET1("",1))
74 I TMP<1 D
75 .W !,*7,"There is no foreign visit information available for this patient."
76 .R !,"Press <RETURN> to continue...",TMP:DTIME
77 W @IOF
78 Q
Note: See TracBrowser for help on using the repository browser.