source: FOIAVistA/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPPRT1.m@ 1751

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

initial load of FOIAVistA 6/30/08 version
File size: 2.7 KB
Line 
1PPPPRT1 ;ALB/DMB - PRINT FOREIGN PROFILE ROUTINES ; 3/3/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5VFM(PATDFN,PHRMARRY) ; View/print foreign medication for 1 patient.
6 ;
7 N %ZIS,PPPARRY,PPPDOB,PPPNAME,PPPSSN,PPPTMP
8 N DA,DIC,DIR,DOB,DR,ERR,LKUPERR,NAME,ND,NODE,NODELEN,OPENERR
9 N OUT,PARMERR,POP,QUEERR,SSN,TMP,DIQ
10 N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
11 ;
12 S PARMERR=-9001
13 S LKUPERR=-9003
14 S OPENERR=-9011
15 S QUEERR=-9012
16 S ERR=0
17 ;
18 S DIC=2,DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP"
19 D EN^DIQ1
20 I '$D(PPPTMP) Q LKUPERR
21 S NAME=PPPTMP(2,DA,.01)
22 S DOB=PPPTMP(2,DA,.03)
23 S SSN=PPPTMP(2,DA,.09)
24 ;
25PWHERE ; Ask where to send the listing
26 ;
27 S %ZIS="QM",%ZIS("A")="Print Profile On What Device? "
28 D ^%ZIS
29 I POP D Q OPENERR
30 .W !,*7,"Error Opening Print Device."
31 .R !,"Press <RETURN> To Continue...",TMP:DTIME
32QTSK I IO'=IO(0) D
33 .I '$D(IO("Q")) S ZTDTH=$H
34 .S ZTRTN="START^PPPPRT1"
35 .S ZTIO=ION
36 .S ZTDESC="FOREIGN MEDICATION PRINT"
37 .S ZTSAVE("PPPNAME")=NAME
38 .S ZTSAVE("PPPDOB")=DOB
39 .S ZTSAVE("PPPSSN")=SSN
40 .S ZTSAVE("PPPARRY")=PHRMARRY
41 .D ^%ZTLOAD
42QERR .I '$D(ZTSK) D Q
43 ..D HOME^%ZIS
44 ..W !!,*7,"Error... Print task was not started successfully"
45 ..R !,"Press <RETURN> To Continue...",TMP:DTIME
46 ..S ERR=QUEERR
47 .I $D(IO("Q")) W !!,"Request Queued On ",ION
48 E D
49 .S PPPNAME=NAME
50 .S PPPDOB=DOB
51 .S PPPSSN=SSN
52 .S PPPARRY=PHRMARRY
53 .D START
54 Q ERR
55 ;
56START ;
57 ;
58 N PAGE,OUT,BNR1,BNR2,DIR,I,X,Y
59 ;
60 S BNR1="Pharmacy Prscription Practices"
61 S BNR2="Foreign Medication Profile"
62 S PAGE=1
63 S OUT=""
64 ;
65 D HEADING,QUERY
66 W @IOF
67 I $D(ZTQUEUED) S ZTREQ="@"
68 D ^%ZISC
69 K @PPPARRY,PPPNAME,PPPSSN,PPPDOB,PPPARRY
70 Q
71 ;
72HEADING ; Write the page heading, Pause if a crt.
73 ;
74 I PAGE>1,$E(IOST,1,2)="C-" D Q:OUT["^"
75 .S DIR(0)="E" D ^DIR
76 .I +Y=0 S OUT="^"
77 W @IOF,!
78 W ?((IOM-$L(BNR1))\2),BNR1,?(IOM-15),"Page ",PAGE,!
79 W ?((IOM-$L(BNR2))\2),BNR2,!
80 W !,"Patient: ",PPPNAME_" ("_PPPSSN_")",?60,"DOB: ",PPPDOB
81 W !!,"RX #",?9,"DRUG",?41,"ST",?45,"QTY",?51,"ISSUED",?65,"LAST FILLED"
82 W ! F I=1:1:IOM-1 W "-"
83 S PAGE=PAGE+1
84 Q
85 ;
86QUERY ; Query through the array and print the data
87 ;
88 S NODE=PPPARRY
89 S NODELEN=$L(PPPARRY)
90 F I=0:0 D Q:($E(NODE,1,NODELEN-1)'=$E(PPPARRY,1,NODELEN-1))!(OUT["^")
91 .S NODE=$Q(@NODE) Q:($E(NODE,1,NODELEN-1)'=$E(PPPARRY,1,NODELEN-1))
92 .S ND=@NODE
93 .I $Y+5>IOSL D HEADING Q:OUT["^"
94 .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))
95 .W !,?9,"SIG: ",$E($P(ND,"^",7),1,25),?40,"ISSUED AT ",$P(ND,"^",8)," (",$P(ND,"^",9),")"
96 I $E(IOST,1,2)="C-"&(OUT'["^") D
97 .W !!,*7,"Listing Complete."
98 .R !,"Press <RETURN> to continue...",OUT:DTIME
99 Q
Note: See TracBrowser for help on using the repository browser.