BEDDMREC ;VNGT/HS/BEE-BEDD Patient Medication Reconciliation ; 08 Nov 2011 12:00 PM
;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
;
;Adapted from BEDDMEDREC/CNHS/RPF
;
Q
;
EN(BEDDDFN,VIEN) ;EP - Patient Medication Reconciliation
;
; Input:
; BEDDDFN (Optional) - Patient DFN
; VIEN (Optional) - Visit pointer to 9000010
;
S BEDDDFN=$G(BEDDDFN,""),VIEN=$G(VIEN,"")
;
NEW %,%ZIS,AGE,AGPATDFN,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DFN,DIC,DOB
NEW REC,RHIFLAG,SEX,SSN,X,Y,EXIT,DFN,POP
;
;Select Patient
S:BEDDDFN]"" DFN=BEDDDFN
I BEDDDFN="" D PTLK^AG
Q:'$D(DFN)
;
;Select Device
S %ZIS="QA"
D ^%ZIS
I POP N IOP S IOP=ION D ^%ZIS Q
I $G(IO("Q")) D QUE D HOME^%ZIS Q
U IO
D START
D ^%ZISC
D HOME^%ZIS
Q
;
START ;Display Report
;
NEW PNAME,PSEX,PDOB,PSITE,PCHRT,RPTDTM,LINE,PAGE,APTDT,PLOC
;
S PNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
S PSEX=$$GET1^DIQ(2,DFN_",",.02,"E")
S PDOB=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.03,"I"))
S PSITE=$$GET1^DIQ(4,DUZ(2)_",",.01,"E")
S PCHRT=$$GET1^DIQ(9000001.41,DUZ(2)_","_DFN_",",.02,"E")
S APTDT="" I VIEN]"" S APTDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I") S:APTDT]"" APTDT=$$FMTE^BEDDUTIL(APTDT)
S:APTDT]"" APTDT="PATIENT APPOINTMENT: "_APTDT
S PLOC="" I VIEN]"" S PLOC=$$GET1^DIQ(9000010,VIEN_",",.08,"E")
S:PLOC]"" PLOC="LOCATION: "_PLOC
S $P(LINE,"*",78)="*"
;
S RPTDTM=$TR($$XNOW^BEDDUTIL("5FMZ"),"@"," ")
;
;PRINT THE REPORT
;
D HDR(.EXIT) G END:$G(EXIT)
;
;Display Patient Allergies
W !,LINE
W !,"ALLERGIES: ",$$PTALG^BEDDUTIL(DFN)
;
;Print Active Medications
;
NEW X,MCTR
K ^TMP("TIUMED",$J)
S X=$$LIST^TIULMED(DFN,"^TMP(""TIUMED"",$J)",1)
;
S MCTR=1
AMED S MCTR=$O(^TMP("TIUMED",$J,MCTR)) G OMED:MCTR=""
NEW DATA
S DATA=$G(^TMP("TIUMED",$J,MCTR,0))
I DATA["ACTIVE OUTPATIENT" G AMED
W !,DATA
S DATA=""
I $Y>IOSL D HDR(.EXIT) G END:$G(EXIT)
G AMED
;
;Print blank section for outside medications
;
OMED I $Y>(IOSL-5) D HDR(.EXIT) G END:$G(EXIT)
W !!,LINE
W !,"____ I am unsure of any outside medications and/or over the counter"
W !," medications and dosages. I will bring my medications on my next visit.",!
W !,LINE
I $Y>(IOSL-13) D HDR(.EXIT) G END:$G(EXIT)
W !,"OUTSIDE MEDICATIONS"
W !,"Patient: Please list any outside medications not received at any"
W !,PSITE," Pharmacy"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!
;
;Print place for over the counter medications
;
I $Y>(IOSL-14) D HDR(.EXIT) G END:$G(EXIT)
W !,LINE
W !,"OVER THE COUNTER MEDICATIONS"
W !,"Patient: Please list any OVER the Counter Medications"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!!
;
;Print place for new medications
;
I $Y>IOSL D HDR(.EXIT) G END:$G(EXIT)
W !,LINE
W !!,"NEW/CHANGE MEDICATIONS"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
W !!,"_____________________________________________________________________"
;
END ;EP - Cleanup
;
I $E(IOST)="C",'$G(EXIT) K DIR D RTRN
I $E(IOST)'="C" D CLOSE^%ZISH(IO)
;
K ^TMP("TIUMED",$J)
Q
;
;Display Header
;
HDR(EXIT) ;EP - Display Report Header
;
NEW ALERT,TITLE,PRINT
S PAGE=$G(PAGE)+1
;
;Handle Screen Printing
I PAGE>1 D RTRN(.EXIT) Q:$G(EXIT)
;
I PAGE'=1 U IO W @IOF
S ALERT="***ALERT*** PATIENT COPY *** PATIENT COPY *** ALERT ***"
S TITLE="PATIENT MEDICATION RECONCILIATION"
S PRINT="PRINTED ON "_RPTDTM
;
W !,PRINT,?70,"PAGE: ",PAGE
W !,?((80-$L(ALERT))/2),ALERT
W !!,?((80-$L(PSITE))/2),PSITE
W !,?((80-$L(TITLE))/2),TITLE
I $G(APTDT)]"" W !,?((80-$L(APTDT))/2),APTDT
I $G(PLOC)]"" W !,?((80-$L(PLOC))/2),PLOC
;
W !!,"PATIENT NAME: ",PNAME
W ?46,"SEX: ",PSEX
W !,?5,"CHART #: ",PCHRT,?46,"DOB: ",PDOB
W !
Q
;
RTRN(EXIT) ;EP - Force RETURN entry
NEW DIR,DIRUT,DUOUT,Y
S EXIT=""
;Only ask if displaying to screen
I $E(IOST)="C" D
. S DIR(0)="E"
. D ^DIR
. K DIR
. I $G(DUOUT)!$G(DIRUT) S EXIT=1
;
Q
;
QUE ;Queue Task
NEW ZTRTN,ZTSAVE,ZTDESC
K IO("Q")
S ZTRTN="START^BEDDMREC",ZTDESC="Patient Medication Reconciliation"
S ZTSAVE("*")=""
K ZTSK D ^%ZTLOAD
I $D(ZTSK)[0 W !!?5,"Report Cancelled!"
E W !!?5,"Task # ",ZTSK," queued.",!
H 3
Q
BEDDMREC ;VNGT/HS/BEE-BEDD Patient Medication Reconciliation ; 08 Nov 2011 12:00 PM
+1 ;;2.0;BEDD DASHBOARD;;Jun 04, 2014;Build 13
+2 ;
+3 ;Adapted from BEDDMEDREC/CNHS/RPF
+4 ;
+5 QUIT
+6 ;
EN(BEDDDFN,VIEN) ;EP - Patient Medication Reconciliation
+1 ;
+2 ; Input:
+3 ; BEDDDFN (Optional) - Patient DFN
+4 ; VIEN (Optional) - Visit pointer to 9000010
+5 ;
+6 SET BEDDDFN=$GET(BEDDDFN,"")
SET VIEN=$GET(VIEN,"")
+7 ;
+8 NEW %,%ZIS,AGE,AGPATDFN,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DFN,DIC,DOB
+9 NEW REC,RHIFLAG,SEX,SSN,X,Y,EXIT,DFN,POP
+10 ;
+11 ;Select Patient
+12 IF BEDDDFN]""
SET DFN=BEDDDFN
+13 IF BEDDDFN=""
DO PTLK^AG
+14 IF '$DATA(DFN)
QUIT
+15 ;
+16 ;Select Device
+17 SET %ZIS="QA"
+18 DO ^%ZIS
+19 IF POP
NEW IOP
SET IOP=ION
DO ^%ZIS
QUIT
+20 IF $GET(IO("Q"))
DO QUE
DO HOME^%ZIS
QUIT
+21 USE IO
+22 DO START
+23 DO ^%ZISC
+24 DO HOME^%ZIS
+25 QUIT
+26 ;
START ;Display Report
+1 ;
+2 NEW PNAME,PSEX,PDOB,PSITE,PCHRT,RPTDTM,LINE,PAGE,APTDT,PLOC
+3 ;
+4 SET PNAME=$$GET1^DIQ(2,DFN_",",.01,"E")
+5 SET PSEX=$$GET1^DIQ(2,DFN_",",.02,"E")
+6 SET PDOB=$$FMTE^BEDDUTIL($$GET1^DIQ(2,DFN_",",.03,"I"))
+7 SET PSITE=$$GET1^DIQ(4,DUZ(2)_",",.01,"E")
+8 SET PCHRT=$$GET1^DIQ(9000001.41,DUZ(2)_","_DFN_",",.02,"E")
+9 SET APTDT=""
IF VIEN]""
SET APTDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
IF APTDT]""
SET APTDT=$$FMTE^BEDDUTIL(APTDT)
+10 IF APTDT]""
SET APTDT="PATIENT APPOINTMENT: "_APTDT
+11 SET PLOC=""
IF VIEN]""
SET PLOC=$$GET1^DIQ(9000010,VIEN_",",.08,"E")
+12 IF PLOC]""
SET PLOC="LOCATION: "_PLOC
+13 SET $PIECE(LINE,"*",78)="*"
+14 ;
+15 SET RPTDTM=$TRANSLATE($$XNOW^BEDDUTIL("5FMZ"),"@"," ")
+16 ;
+17 ;PRINT THE REPORT
+18 ;
+19 DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+20 ;
+21 ;Display Patient Allergies
+22 WRITE !,LINE
+23 WRITE !,"ALLERGIES: ",$$PTALG^BEDDUTIL(DFN)
+24 ;
+25 ;Print Active Medications
+26 ;
+27 NEW X,MCTR
+28 KILL ^TMP("TIUMED",$JOB)
+29 SET X=$$LIST^TIULMED(DFN,"^TMP(""TIUMED"",$J)",1)
+30 ;
+31 SET MCTR=1
AMED SET MCTR=$ORDER(^TMP("TIUMED",$JOB,MCTR))
IF MCTR=""
GOTO OMED
+1 NEW DATA
+2 SET DATA=$GET(^TMP("TIUMED",$JOB,MCTR,0))
+3 IF DATA["ACTIVE OUTPATIENT"
GOTO AMED
+4 WRITE !,DATA
+5 SET DATA=""
+6 IF $Y>IOSL
DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+7 GOTO AMED
+8 ;
+9 ;Print blank section for outside medications
+10 ;
OMED IF $Y>(IOSL-5)
DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+1 WRITE !!,LINE
+2 WRITE !,"____ I am unsure of any outside medications and/or over the counter"
+3 WRITE !," medications and dosages. I will bring my medications on my next visit.",!
+4 WRITE !,LINE
+5 IF $Y>(IOSL-13)
DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+6 WRITE !,"OUTSIDE MEDICATIONS"
+7 WRITE !,"Patient: Please list any outside medications not received at any"
+8 WRITE !,PSITE," Pharmacy"
+9 WRITE !!,"_____________________________________________________________________"
+10 WRITE !!,"_____________________________________________________________________"
+11 WRITE !!,"_____________________________________________________________________"
+12 WRITE !!,"_____________________________________________________________________"
+13 WRITE !!
+14 ;
+15 ;Print place for over the counter medications
+16 ;
+17 IF $Y>(IOSL-14)
DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+18 WRITE !,LINE
+19 WRITE !,"OVER THE COUNTER MEDICATIONS"
+20 WRITE !,"Patient: Please list any OVER the Counter Medications"
+21 WRITE !!,"_____________________________________________________________________"
+22 WRITE !!,"_____________________________________________________________________"
+23 WRITE !!,"_____________________________________________________________________"
+24 WRITE !!,"_____________________________________________________________________"
+25 WRITE !!!
+26 ;
+27 ;Print place for new medications
+28 ;
+29 IF $Y>IOSL
DO HDR(.EXIT)
IF $GET(EXIT)
GOTO END
+30 WRITE !,LINE
+31 WRITE !!,"NEW/CHANGE MEDICATIONS"
+32 WRITE !!,"_____________________________________________________________________"
+33 WRITE !!,"_____________________________________________________________________"
+34 WRITE !!,"_____________________________________________________________________"
+35 WRITE !!,"_____________________________________________________________________"
+36 ;
END ;EP - Cleanup
+1 ;
+2 IF $EXTRACT(IOST)="C"
IF '$GET(EXIT)
KILL DIR
DO RTRN
+3 IF $EXTRACT(IOST)'="C"
DO CLOSE^%ZISH(IO)
+4 ;
+5 KILL ^TMP("TIUMED",$JOB)
+6 QUIT
+7 ;
+8 ;Display Header
+9 ;
HDR(EXIT) ;EP - Display Report Header
+1 ;
+2 NEW ALERT,TITLE,PRINT
+3 SET PAGE=$GET(PAGE)+1
+4 ;
+5 ;Handle Screen Printing
+6 IF PAGE>1
DO RTRN(.EXIT)
IF $GET(EXIT)
QUIT
+7 ;
+8 IF PAGE'=1
USE IO
WRITE @IOF
+9 SET ALERT="***ALERT*** PATIENT COPY *** PATIENT COPY *** ALERT ***"
+10 SET TITLE="PATIENT MEDICATION RECONCILIATION"
+11 SET PRINT="PRINTED ON "_RPTDTM
+12 ;
+13 WRITE !,PRINT,?70,"PAGE: ",PAGE
+14 WRITE !,?((80-$LENGTH(ALERT))/2),ALERT
+15 WRITE !!,?((80-$LENGTH(PSITE))/2),PSITE
+16 WRITE !,?((80-$LENGTH(TITLE))/2),TITLE
+17 IF $GET(APTDT)]""
WRITE !,?((80-$LENGTH(APTDT))/2),APTDT
+18 IF $GET(PLOC)]""
WRITE !,?((80-$LENGTH(PLOC))/2),PLOC
+19 ;
+20 WRITE !!,"PATIENT NAME: ",PNAME
+21 WRITE ?46,"SEX: ",PSEX
+22 WRITE !,?5,"CHART #: ",PCHRT,?46,"DOB: ",PDOB
+23 WRITE !
+24 QUIT
+25 ;
RTRN(EXIT) ;EP - Force RETURN entry
+1 NEW DIR,DIRUT,DUOUT,Y
+2 SET EXIT=""
+3 ;Only ask if displaying to screen
+4 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 KILL DIR
+8 IF $GET(DUOUT)!$GET(DIRUT)
SET EXIT=1
End DoDot:1
+9 ;
+10 QUIT
+11 ;
QUE ;Queue Task
+1 NEW ZTRTN,ZTSAVE,ZTDESC
+2 KILL IO("Q")
+3 SET ZTRTN="START^BEDDMREC"
SET ZTDESC="Patient Medication Reconciliation"
+4 SET ZTSAVE("*")=""
+5 KILL ZTSK
DO ^%ZTLOAD
+6 IF $DATA(ZTSK)[0
WRITE !!?5,"Report Cancelled!"
+7 IF '$TEST
WRITE !!?5,"Task # ",ZTSK," queued.",!
+8 HANG 3
+9 QUIT
