source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT9.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: 3.2 KB
Line 
1PPPPRT9 ;ALB/DMB - MEDICATION PROFILE PRINT ROUTINE ; 6/25/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**10,17**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PLP(PATDFN) ; Print Label Profile
6 ;
7 N VISARRY,DI
8 S VISARRY="^TMP(""PPP"",$J,""VISIT"")"
9 ;
10 Q:$$GETVIS^PPPGET7(PATDFN,VISARRY)<1
11 D PRPROFIL(PATDFN,VISARRY)
12 K @VISARRY
13 Q
14 ;
15PRPROFIL(PATDFN,ARRAYNM,OBFLAG) ; Print the med profile
16 ;
17 N PPPDOB,PPPNAME,PPPSSN,PPPTMP,BNR1,BNR3,DA,DIC,DIQ,DIR,DR,DI,D0
18 N DTOUT,DUOUT,I,NARRATIV,ND,OUT,PAGE,PARMERR,PHRMARRY,RVRSDT,RXIDX
19 N STANAME,STAPTR,TMP,Y
20 ;
21 S PARMERR=-9001
22 ;
23 I '$D(ARRAYNM) Q PARMERR
24 I '$D(OBFLAG) S OBFLAG="O"
25 I OBFLAG="" S OBFLAG="O"
26 S PHRMARRY="^TMP(""PPP"",$J,""PHR"")"
27 S PAGE=1,OUT=""
28 S BNR1="PPP - Medication Profile from other VAMC(s)"
29 S BNR3="Date Printed: "_$$DTE^PPPUTL1(DT,0)
30 ;
31 ; Get the local name, SSN and DOB
32 ;
33 S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
34 S PPPNAME=PPPTMP(2,PATDFN,.01)
35 S PPPDOB=PPPTMP(2,PATDFN,.03)
36 S PPPSSN=PPPTMP(2,PATDFN,.09)
37 K PPPTMP,DIC,DR,DA,DTOUT,DUOUT
38 ;
39 ; Get the prescription data
40 ;
41 I OBFLAG="B" S TMP=$$GLPHRM^PPPGET8(PATDFN,PHRMARRY)
42 S TMP=$$GETPDX^PPPGET2(ARRAYNM,PHRMARRY)
43 ;
44 ; If there is anything to print... print it.
45 ;
46 I $D(@PHRMARRY) D
47 .D HEADING1,NARRATIV
48 K @PHRMARRY
49 Q
50 ;
51HEADING1 ; Write the page heading, Pause if a crt.
52 ;
53 I PAGE>1,$E(IOST,1,2)="C-" D Q:OUT["^"
54 .S DIR(0)="E" D ^DIR
55 .I +Y=0 S OUT="^"
56 W @IOF,!
57 W ?((IOM-$L(BNR1))\2),BNR1,?(IOM-15),"Page ",PAGE,!
58 W ?((IOM-$L(BNR3))\2),BNR3,!!
59 W !,"Patient: ",PPPNAME_" ("_PPPSSN_")",?60,"DOB: ",PPPDOB
60 W ! F I=1:1:IOM W "="
61 Q
62 ;
63HEADING2 ; Write the page heading, Pause if a crt.
64 ;
65 I PAGE>1,($E(IOST,1,2)="C-"),($D(NARRATIV)) D Q:OUT["^"
66 .S DIR(0)="E" D ^DIR
67 .I +Y=0 S OUT="^"
68 W !,"RX #",?9,"DRUG",?41,"ST",?45,"QTY",?51,"ISSUED",?65,"LAST FILLED"
69 W ! F I=1:1:IOM W "="
70 Q
71 ;
72NARRATIV ; Print the narratives.
73 ; If PSTYPE is defined then this is part of the info/action profile
74 ; and we don't want to print the narrative.
75 ;
76 S NARRATIV=1
77 S STANAME=""
78 I $D(@PHRMARRY@(0))&('$D(PSTYPE)) D
79 .F S STANAME=$O(@PHRMARRY@(0,STANAME)) Q:STANAME=""!(OUT["^") D
80 ..I $Y+5>IOSL S PAGE=PAGE+1 D HEADING1 Q:OUT["^"
81 ..W !!,"NARRATIVE FROM ",STANAME
82 ..W !," => ",@PHRMARRY@(0,STANAME)
83 .W !
84 K NARRATIV
85 ;
86DRUGS I $Y+8<IOSL D HEADING2
87 S RVRSDT=0
88 F S RVRSDT=$O(@PHRMARRY@(RVRSDT)) Q:RVRSDT'>0!(OUT["^") D
89 .S STAPTR=""
90 .F S STAPTR=$O(@PHRMARRY@(RVRSDT,STAPTR)) Q:STAPTR=""!(OUT["^") D
91 ..S RXIDX=-1
92 ..F S RXIDX=$O(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:RXIDX=""!(OUT["^")!(RXIDX="PID") D
93 ...I $Y+6>IOSL S PAGE=PAGE+1 D HEADING1 Q:OUT["^" D HEADING2
94 ...S ND=$G(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:ND=""
95 ...I $P(ND,"^",8)'="",$D(^TMP("PPP",$J,"VISIT",$P(ND,"^",8),1)),$P(^TMP("PPP",$J,"VISIT",$P(ND,"^",8),1),"^",1)'=PPPNAME W !,?9," ** WARNING ** Patient is identified as : ",$P(^TMP("PPP",$J,"VISIT",$P(ND,"^",8),1),"^",1)," not ",PPPNAME
96 ...W !!,$P(ND,"^"),?9,$E($P(ND,"^",2),1,30),?41,$E($P(ND,"^",3),1),?45,$P(ND,"^",4),?51,$$SLASHDT^PPPCNV1($P(ND,"^",5)),?65,$$SLASHDT^PPPCNV1($P(ND,"^",6))
97 ...W !,?9,"SIG: ",$E($P(ND,"^",7),1,25),?40,"ISSUED AT ",$P(ND,"^",8)," (",$P(ND,"^",9),")"
98 ...W !,?9,"PROVIDER: ",$P(ND,"^",10)
99 K @PHRMARRY
100 Q
Note: See TracBrowser for help on using the repository browser.