| [613] | 1 | PPPPRT1 ;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 | ;
|
|---|
| 5 | VFM(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 | ;
|
|---|
| 25 | PWHERE ; 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
|
|---|
| 32 | QTSK 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
|
|---|
| 42 | QERR .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 | ;
|
|---|
| 56 | START ;
|
|---|
| 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 | ;
|
|---|
| 72 | HEADING ; 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 | ;
|
|---|
| 86 | QUERY ; 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
|
|---|
