Routine: BEDDMREC

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

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

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)

 ;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 !

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

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

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

BEDDMREC.m