source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPDSP3.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PPPDSP3 ;ALB/DMB - MEDICATION PROFILE DISPLAY ROUTINE ;5/19/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**1,17**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; These routines control the display of the pharmacy medication
6 ; profiles via the list processor from scheduling.
7 ;
8DSPMED(PATDFN,ARRAYNM,OBFLAG) ; List processor entry point
9 ;
10 ; This is the main entry point for calling the list processor.
11 ;
12 ; Parameters:
13 ; PATDFN - The patient internal entry number
14 ; ARRAYNM - An array containing the visit info (see GETVIS^PPPGET7).
15 ; OBFLAG - A flag containing "O" for profiles form only the other
16 ; facilities or "B" for profiles from both local and other.
17 ;
18 ;K XQORS,VALMEVL
19 D EN^VALM("PPP PROFILE")
20 Q
21 ;
22INIT ; Collect all of the data and build the display array
23 ;
24 S VALMMENU=0
25 S VALMCNT=$$PRPROFIL(ARRAYNM)
26 I VALMCNT<1 D NUL
27 I OBFLAG="O" S VALM("TITLE")="Medication Profile - Other"
28 I OBFLAG="B" S VALM("TITLE")="Medication Profile - Both"
29INITQ Q
30 ;
31HDR ; Get header data and build it.
32 ;
33 N DIC,DA,DR,DIQ,DUOUT,DTOUT,PPPTMP
34 S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
35 S VALMHDR(1)=""
36 S VALMHDR(2)="Patient: "_PPPTMP(2,PATDFN,.01)_" ("_PPPTMP(2,PATDFN,.09)_") DOB: "_PPPTMP(2,PATDFN,.03)
37HDRQ Q
38 ;
39NUL ; Set null message
40 ;
41 ;I '$O(@ARRAYNM@(0)) S @ARRAYNM@(1,0)=" ",@ARRAYNM@(2,0)=" No Data Available.",VALMCNT=2
42 S @ARRAYNM@(1,0)=" ",@ARRAYNM@(2,0)=" No Data Available.",VALMCNT=2
43 Q
44 ;
45FNL ; Clean Up
46 ;
47 K ^TMP("PPP",$J,"LIST")
48 Q
49 ;
50PRPROFIL(ARRAYNM) ; Print the med profile
51 ;
52 ; This function collects the medication profile data and formats it
53 ; for display.
54 ;
55 ; Parameters:
56 ; ARRAYNM - An array containing the visit info (see GETVIS^PPPGET7).
57 ;
58 N ND,PHRMARRY,RVRSDT,RXIDX,STANAME,STAPTR,TMP,Y,LSTARRAY
59 N TEXT,TXTLINE,U,LINE
60 ;
61 S PHRMARRY="^TMP(""PPP"",$J,""PHR"")"
62 S LSTARRAY="^TMP(""PPP"",$J,""LIST"")"
63 S U="^"
64 S LINE=0
65 ;
66 ; Get the prescription data
67 ;
68 I OBFLAG="B" S TMP=$$GLPHRM^PPPGET8(PATDFN,PHRMARRY)
69 S TMP=$$GETPDX^PPPGET2(ARRAYNM,PHRMARRY)
70 ;
71 ; If there is anything to print... print it.
72 ;
73 I $D(@PHRMARRY) D NARRATIV
74 K @PHRMARRY
75 Q LINE
76 ;
77NARRATIV ; Print the narratives
78 ;
79 S LINE=0
80 S TEXT=""
81 S STANAME=""
82 I $D(@PHRMARRY@(0)) D
83 .F S STANAME=$O(@PHRMARRY@(0,STANAME)) Q:STANAME="" D
84 ..S LINE=LINE+1
85 ..S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1("NARRATIVE FROM "_STANAME,TEXT,1,80)
86 ..S LINE=LINE+1
87 ..I $L(@PHRMARRY@(0,STANAME))<70 D
88 ...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1(" => "_@PHRMARRY@(0,STANAME),TEXT,1,80)
89 ..E D
90 ...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1(" => "_$E(@PHRMARRY@(0,STANAME),1,70)_"...",TEXT,1,80)
91 ..S LINE=LINE+1,@LSTARRAY@(LINE,0)=""
92 ;
93 S RVRSDT=0
94 F S RVRSDT=$O(@PHRMARRY@(RVRSDT)) Q:RVRSDT'>0 D
95 .S STAPTR=0
96 .F S STAPTR=$O(@PHRMARRY@(RVRSDT,STAPTR)) Q:STAPTR="" D
97 ..S RXIDX=-1
98 ..F S RXIDX=$O(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:RXIDX=""!(RXIDX="PID") D
99 ...S ND=$G(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:ND=""
100 ...S LINE=LINE+1
101 ...S TXTLINE=$$SETFLD^VALM1($P(ND,U),TEXT,"RX#")
102 ...S TXTLINE=$$SETFLD^VALM1($P(ND,U,2),TXTLINE,"DRUG")
103 ...S TXTLINE=$$SETFLD^VALM1($P(ND,U,3),TXTLINE,"STATUS")
104 ...S TXTLINE=$$SETFLD^VALM1($P(ND,U,4),TXTLINE,"QTY")
105 ...S TXTLINE=$$SETFLD^VALM1($$SLASHDT^PPPCNV1($P(ND,U,5)),TXTLINE,"ISSUED")
106 ...S TXTLINE=$$SETFLD^VALM1($$SLASHDT^PPPCNV1($P(ND,U,6)),TXTLINE,"LAST FILLED")
107 ...S @LSTARRAY@(LINE,0)=TXTLINE
108 ...S LINE=LINE+1
109 ...S TXTLINE=$$SETSTR^VALM1("SIG: "_$E($P(ND,U,7),1,25),TEXT,9,30)
110 ...S TXTLINE=$$SETSTR^VALM1("ISSUED AT "_$P(ND,U,8)_" ("_$P(ND,U,9)_")",TXTLINE,40,39)
111 ...S @LSTARRAY@(LINE,0)=TXTLINE
112 ...S LINE=LINE+1
113 ...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1("PROVIDER: "_$P(ND,U,10),TEXT,9,70)
114 K @PHRMARRY
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.