117 lines
3.6 KiB
Mathematica
117 lines
3.6 KiB
Mathematica
PPPDSP3 ;ALB/DMB - MEDICATION PROFILE DISPLAY ROUTINE ;5/19/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**1,17**;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; These routines control the display of the pharmacy medication
|
|
; profiles via the list processor from scheduling.
|
|
;
|
|
DSPMED(PATDFN,ARRAYNM,OBFLAG) ; List processor entry point
|
|
;
|
|
; This is the main entry point for calling the list processor.
|
|
;
|
|
; Parameters:
|
|
; PATDFN - The patient internal entry number
|
|
; ARRAYNM - An array containing the visit info (see GETVIS^PPPGET7).
|
|
; OBFLAG - A flag containing "O" for profiles form only the other
|
|
; facilities or "B" for profiles from both local and other.
|
|
;
|
|
;K XQORS,VALMEVL
|
|
D EN^VALM("PPP PROFILE")
|
|
Q
|
|
;
|
|
INIT ; Collect all of the data and build the display array
|
|
;
|
|
S VALMMENU=0
|
|
S VALMCNT=$$PRPROFIL(ARRAYNM)
|
|
I VALMCNT<1 D NUL
|
|
I OBFLAG="O" S VALM("TITLE")="Medication Profile - Other"
|
|
I OBFLAG="B" S VALM("TITLE")="Medication Profile - Both"
|
|
INITQ Q
|
|
;
|
|
HDR ; Get header data and build it.
|
|
;
|
|
N DIC,DA,DR,DIQ,DUOUT,DTOUT,PPPTMP
|
|
S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
|
|
S VALMHDR(1)=""
|
|
S VALMHDR(2)="Patient: "_PPPTMP(2,PATDFN,.01)_" ("_PPPTMP(2,PATDFN,.09)_") DOB: "_PPPTMP(2,PATDFN,.03)
|
|
HDRQ Q
|
|
;
|
|
NUL ; Set null message
|
|
;
|
|
;I '$O(@ARRAYNM@(0)) S @ARRAYNM@(1,0)=" ",@ARRAYNM@(2,0)=" No Data Available.",VALMCNT=2
|
|
S @ARRAYNM@(1,0)=" ",@ARRAYNM@(2,0)=" No Data Available.",VALMCNT=2
|
|
Q
|
|
;
|
|
FNL ; Clean Up
|
|
;
|
|
K ^TMP("PPP",$J,"LIST")
|
|
Q
|
|
;
|
|
PRPROFIL(ARRAYNM) ; Print the med profile
|
|
;
|
|
; This function collects the medication profile data and formats it
|
|
; for display.
|
|
;
|
|
; Parameters:
|
|
; ARRAYNM - An array containing the visit info (see GETVIS^PPPGET7).
|
|
;
|
|
N ND,PHRMARRY,RVRSDT,RXIDX,STANAME,STAPTR,TMP,Y,LSTARRAY
|
|
N TEXT,TXTLINE,U,LINE
|
|
;
|
|
S PHRMARRY="^TMP(""PPP"",$J,""PHR"")"
|
|
S LSTARRAY="^TMP(""PPP"",$J,""LIST"")"
|
|
S U="^"
|
|
S LINE=0
|
|
;
|
|
; 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 NARRATIV
|
|
K @PHRMARRY
|
|
Q LINE
|
|
;
|
|
NARRATIV ; Print the narratives
|
|
;
|
|
S LINE=0
|
|
S TEXT=""
|
|
S STANAME=""
|
|
I $D(@PHRMARRY@(0)) D
|
|
.F S STANAME=$O(@PHRMARRY@(0,STANAME)) Q:STANAME="" D
|
|
..S LINE=LINE+1
|
|
..S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1("NARRATIVE FROM "_STANAME,TEXT,1,80)
|
|
..S LINE=LINE+1
|
|
..I $L(@PHRMARRY@(0,STANAME))<70 D
|
|
...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1(" => "_@PHRMARRY@(0,STANAME),TEXT,1,80)
|
|
..E D
|
|
...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1(" => "_$E(@PHRMARRY@(0,STANAME),1,70)_"...",TEXT,1,80)
|
|
..S LINE=LINE+1,@LSTARRAY@(LINE,0)=""
|
|
;
|
|
S RVRSDT=0
|
|
F S RVRSDT=$O(@PHRMARRY@(RVRSDT)) Q:RVRSDT'>0 D
|
|
.S STAPTR=0
|
|
.F S STAPTR=$O(@PHRMARRY@(RVRSDT,STAPTR)) Q:STAPTR="" D
|
|
..S RXIDX=-1
|
|
..F S RXIDX=$O(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:RXIDX=""!(RXIDX="PID") D
|
|
...S ND=$G(@PHRMARRY@(RVRSDT,STAPTR,RXIDX)) Q:ND=""
|
|
...S LINE=LINE+1
|
|
...S TXTLINE=$$SETFLD^VALM1($P(ND,U),TEXT,"RX#")
|
|
...S TXTLINE=$$SETFLD^VALM1($P(ND,U,2),TXTLINE,"DRUG")
|
|
...S TXTLINE=$$SETFLD^VALM1($P(ND,U,3),TXTLINE,"STATUS")
|
|
...S TXTLINE=$$SETFLD^VALM1($P(ND,U,4),TXTLINE,"QTY")
|
|
...S TXTLINE=$$SETFLD^VALM1($$SLASHDT^PPPCNV1($P(ND,U,5)),TXTLINE,"ISSUED")
|
|
...S TXTLINE=$$SETFLD^VALM1($$SLASHDT^PPPCNV1($P(ND,U,6)),TXTLINE,"LAST FILLED")
|
|
...S @LSTARRAY@(LINE,0)=TXTLINE
|
|
...S LINE=LINE+1
|
|
...S TXTLINE=$$SETSTR^VALM1("SIG: "_$E($P(ND,U,7),1,25),TEXT,9,30)
|
|
...S TXTLINE=$$SETSTR^VALM1("ISSUED AT "_$P(ND,U,8)_" ("_$P(ND,U,9)_")",TXTLINE,40,39)
|
|
...S @LSTARRAY@(LINE,0)=TXTLINE
|
|
...S LINE=LINE+1
|
|
...S @LSTARRAY@(LINE,0)=$$SETSTR^VALM1("PROVIDER: "_$P(ND,U,10),TEXT,9,70)
|
|
K @PHRMARRY
|
|
Q
|
|
;
|