101 lines
3.2 KiB
Mathematica
101 lines
3.2 KiB
Mathematica
PPPPRT9 ;ALB/DMB - MEDICATION PROFILE PRINT ROUTINE ; 6/25/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**10,17**;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
PLP(PATDFN) ; Print Label Profile
|
|
;
|
|
N VISARRY,DI
|
|
S VISARRY="^TMP(""PPP"",$J,""VISIT"")"
|
|
;
|
|
Q:$$GETVIS^PPPGET7(PATDFN,VISARRY)<1
|
|
D PRPROFIL(PATDFN,VISARRY)
|
|
K @VISARRY
|
|
Q
|
|
;
|
|
PRPROFIL(PATDFN,ARRAYNM,OBFLAG) ; Print the med profile
|
|
;
|
|
N PPPDOB,PPPNAME,PPPSSN,PPPTMP,BNR1,BNR3,DA,DIC,DIQ,DIR,DR,DI,D0
|
|
N DTOUT,DUOUT,I,NARRATIV,ND,OUT,PAGE,PARMERR,PHRMARRY,RVRSDT,RXIDX
|
|
N STANAME,STAPTR,TMP,Y
|
|
;
|
|
S PARMERR=-9001
|
|
;
|
|
I '$D(ARRAYNM) Q PARMERR
|
|
I '$D(OBFLAG) S OBFLAG="O"
|
|
I OBFLAG="" S OBFLAG="O"
|
|
S PHRMARRY="^TMP(""PPP"",$J,""PHR"")"
|
|
S PAGE=1,OUT=""
|
|
S BNR1="PPP - Medication Profile from other VAMC(s)"
|
|
S BNR3="Date Printed: "_$$DTE^PPPUTL1(DT,0)
|
|
;
|
|
; Get the local name, SSN and DOB
|
|
;
|
|
S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
|
|
S PPPNAME=PPPTMP(2,PATDFN,.01)
|
|
S PPPDOB=PPPTMP(2,PATDFN,.03)
|
|
S PPPSSN=PPPTMP(2,PATDFN,.09)
|
|
K PPPTMP,DIC,DR,DA,DTOUT,DUOUT
|
|
;
|
|
; Get the prescription data
|
|
;
|
|
I OBFLAG="B" S TMP=$$GLPHRM^PPPGET8(PATDFN,PHRMARRY)
|
|
S TMP=$$GETPDX^PPPGET2(ARRAYNM,PHRMARRY)
|
|
;
|
|
; If there is anything to print... print it.
|
|
;
|
|
I $D(@PHRMARRY) D
|
|
.D HEADING1,NARRATIV
|
|
K @PHRMARRY
|
|
Q
|
|
;
|
|
HEADING1 ; Write the page heading, Pause if a crt.
|
|
;
|
|
I PAGE>1,$E(IOST,1,2)="C-" D Q:OUT["^"
|
|
.S DIR(0)="E" D ^DIR
|
|
.I +Y=0 S OUT="^"
|
|
W @IOF,!
|
|
W ?((IOM-$L(BNR1))\2),BNR1,?(IOM-15),"Page ",PAGE,!
|
|
W ?((IOM-$L(BNR3))\2),BNR3,!!
|
|
W !,"Patient: ",PPPNAME_" ("_PPPSSN_")",?60,"DOB: ",PPPDOB
|
|
W ! F I=1:1:IOM W "="
|
|
Q
|
|
;
|
|
HEADING2 ; Write the page heading, Pause if a crt.
|
|
;
|
|
I PAGE>1,($E(IOST,1,2)="C-"),($D(NARRATIV)) D Q:OUT["^"
|
|
.S DIR(0)="E" D ^DIR
|
|
.I +Y=0 S OUT="^"
|
|
W !,"RX #",?9,"DRUG",?41,"ST",?45,"QTY",?51,"ISSUED",?65,"LAST FILLED"
|
|
W ! F I=1:1:IOM W "="
|
|
Q
|
|
;
|
|
NARRATIV ; Print the narratives.
|
|
; If PSTYPE is defined then this is part of the info/action profile
|
|
; and we don't want to print the narrative.
|
|
;
|
|
S NARRATIV=1
|
|
S STANAME=""
|
|
I $D(@PHRMARRY@(0))&('$D(PSTYPE)) D
|
|
.F S STANAME=$O(@PHRMARRY@(0,STANAME)) Q:STANAME=""!(OUT["^") D
|
|
..I $Y+5>IOSL S PAGE=PAGE+1 D HEADING1 Q:OUT["^"
|
|
..W !!,"NARRATIVE FROM ",STANAME
|
|
..W !," => ",@PHRMARRY@(0,STANAME)
|
|
.W !
|
|
K NARRATIV
|
|
;
|
|
DRUGS I $Y+8<IOSL D HEADING2
|
|
S RVRSDT=0
|
|
F S RVRSDT=$O(@PHRMARRY@(RVRSDT)) Q:RVRSDT'>0!(OUT["^") D
|
|
.S STAPTR=""
|
|
.F S STAPTR=$O(@PHRMARRY@(RVRSDT,STAPTR)) Q:STAPTR=""!(OUT["^") D
|
|
..S RXIDX=-1
|
|
..F S RXIDX=$O(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:RXIDX=""!(OUT["^")!(RXIDX="PID") D
|
|
...I $Y+6>IOSL S PAGE=PAGE+1 D HEADING1 Q:OUT["^" D HEADING2
|
|
...S ND=$G(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:ND=""
|
|
...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
|
|
...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))
|
|
...W !,?9,"SIG: ",$E($P(ND,"^",7),1,25),?40,"ISSUED AT ",$P(ND,"^",8)," (",$P(ND,"^",9),")"
|
|
...W !,?9,"PROVIDER: ",$P(ND,"^",10)
|
|
K @PHRMARRY
|
|
Q
|