AMHRNSIG.m

AMHRNSIG ; IHS/CMI/LAB - report of visits with no esig ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 ;

 ;

START ;EP - called from option

 D XIT

 W:$D(IOF) @IOF

 S X="BEHAVIORAL HEALTH UNSIGNED PROGRESS NOTES" W !,$$CTR^AMHLEIN(X,80)

 W !!,"This report will display a list of all encounter records containing"

 W !,"unsigned SOAP/Progress Notes in a date range specified by the user.  After"

 W !,"the report is displayed, the user will have the option of affixing an"

 W !,"electronic signature to an unsigned SOAP/Progress Note."

 ;I '$P($G(^AMHSITE(DUZ(2),18)),U,6) W !!,"Electronic Signature is not turned on at your facilty.  You",!,"cannot run this report.",! D PAUSE^AMHLEA Q

 ;I '$P($G(^AMHSITE(DUZ(2),18)),U,7) W !!,"An Electronic Signature start date has not been recorded.  You",!,"cannot run this report.",! D PAUSE^AMHLEA Q

 S D=$$DATE^AMHESIG()

 W !!,"ESIG was implemented on ",$$FMTE^XLFDT(D),".  Only visits after this date will"

 W !,"display on this report.",!

 D DBHUSR^AMHUTIL

GETDATES ;

 W !!,"Please enter the range of dates for the Unsigned visits"

BD ;get beginning date

 S DIR(0)="D^"_$$DATE^AMHESIG()_",:DT:EP",DIR("A")="Enter Beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter Ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AMHED=Y

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

PROG ;

 S AMHPROG=""

 S DIR(0)="S^O:ONE Program;A:ALL Programs",DIR("A")="Run the Report for which PROGRAM",DIR("B")="A" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) GETDATES

 I Y="A" G PROV

 S DIR(0)="9002011,.02",DIR("A")="Which PROGRAM" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) PROG

 I X="" G PROG

 S AMHPROG=Y

PROV ;

 S AMHPROV=""

 S DIR(0)="S^A:All Providers;O:One Provider",DIR("A")="Include cases opened by",DIR("B")="A" K DA D ^DIR K DIR

 G:$D(DIRUT) PROG

 I Y="A" G SORT

 S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC

 K DIC,DA

 I Y=-1 G PROV

 S AMHPROV=+Y

SORT ;

 S AMHSORT=""

 S DIR(0)="S^P:Patient Name;D:Date of Visit;R:Primary Provider",DIR("A")="How would you like the report sorted",DIR("B")="P" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) PROV

 S AMHSORT=Y

DEMO ;

 D DEMOCHK^AMHUTIL1(.AMHDEMO)

 I AMHDEMO=-1 G SORT

ZIS ;

 S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 I $G(Y)="B" D BROWSE,XIT Q

 W !! S XBRP="PRINT^AMHRNSIG",XBRC="PROC^AMHRNSIG",XBNS="AMH*",XBRX="XIT^AMHRNSIG"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^AMHRNSIG"")"

 S XBNS="AMH",XBRC="PROC^AMHRNSIG",XBRX="XIT^AMHRNSIG",XBIOP=0 D ^XBDBQUE

 Q

 ;

PROC ;EP - called from xbdbque

 ;loop through all visits in date range and look for problem 8-8.9 or visit type of N

 S AMHJOB=$J,AMHTOT=0,AMHBT=$H,AMHPTOT=0

 D XTMP^AMHUTIL("AMHRNSIG","BH - NO ESIG")

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X

 S AMHODAT=AMHSD_".9999" F  S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED)  D

 .S AMHR=0 F  S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR  D

 ..I AMHPROG]"",$P(^AMHREC(AMHR,0),U,2)'=AMHPROG Q

 ..Q:$P($G(^AMHREC(AMHR,11)),U,10)  ;EHR VISITS EXCLUDED

 ..I AMHPROV,$$PPINT^AMHUTIL(AMHR)'=AMHPROV Q

 ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)

 ..S DFN=$P(^AMHREC(AMHR,0),U,8) Q:'DFN

 ..Q:'$$ALLOWP^AMHUTIL(DUZ,DFN)

 ..Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO))

 ..;if any dx is 8 then do set and q

 ..Q:$P($G(^AMHREC(AMHR,11)),U,12)]""  ;already signed

 ..S ^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",$$SORTVAL(AMHR,AMHSORT),AMHR)="",AMHTOT=AMHTOT+1

 ..Q

 .Q

 Q

 ;

SORTVAL(R,V) ;

 NEW G

 I V="P" D  Q G

 .S G=$P(^AMHREC(R,0),U,8) I G S G=$P($G(^DPT(G,0)),U)

 .I G="" S G="--"

 I V="R" S G=$$PPNAME^AMHUTIL(R) S:G="" G="--" Q G

 I V="D" Q $P(^AMHREC(R,0),U)

 Q ""

PRINT ;EP - called from xbdbque

 D PRINT1

 K ^XTMP("AMHRNSIG",AMHJOB,AMHBT)

 Q

PRINT1 ;

 K AMHQ S AMHPG=0

 I '$D(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS")) D HEADER W !!,"There were no Unsigned Encounter Records during the time period.",! Q

 D HEADER

 S AMHSORT="" F  S AMHSORT=$O(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",AMHSORT)) Q:AMHSORT=""!($D(AMHQ))  D

 .S AMHR=0 F  S AMHR=$O(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",AMHSORT,AMHR)) Q:AMHR'=+AMHR!($D(AMHQ))  D

 ..I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)

 ..S DFN=$P(^AMHREC(AMHR,0),U,8)

 ..W !,$E($P(^DPT(DFN,0),U),1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$FMTE^XLFDT($P(^AMHREC(AMHR,0),U)),?53,$E($$PPNAME^AMHUTIL(AMHR),1,18)

 ..W ?73,$E($$VAL^XBDIQ1(9002011,AMHR,.02),1,1)

 ..W ?76,$E($$VAL^XBDIQ1(9002011,AMHR,.34),1,1)

 .Q

 Q:$D(AMHQ)

 I $Y>(IOSL-4) D HEADER Q:$D(AMHQ)

 W !!,"Total # of Unsigned Visits: ",AMHTOT,!

 Q

XIT ;

 D EN^XBVK("AMH")

 D KILL^AUPNPAT

 Q

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

HEADER ;EP

 I 'AMHPG G HEADER1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q

HEADER1 ;

 W:$D(IOF) @IOF S AMHPG=AMHPG+1

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),?($S(80=132:120,1:72)),"Page ",AMHPG,!

 S AMHTEXT="UNSIGNED ENCOUNTER RECORDS"

 W !?(80-$L(AMHTEXT)/2),AMHTEXT,!

 S AMHTEXT="Date Range:  "_AMHBDD_" and "_AMHEDD

 W ?(80-$L(AMHTEXT)/2),AMHTEXT,!

 I AMHPROG]"" S X="Program: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG) W $$CTR^AMHLEIN(X,80),!

 I AMHPROV S X="Provider: "_$P(^VA(200,AMHPROV,0),U) W $$CTR^AMHLEIN(X,80),!

 W !,"PATIENT NAME",?27,"HRN",?34,"DATE/TIME",?53,"PROVIDER",?73,"PG",?76,"GRP"

 W !,$TR($J(" ",80)," ","-")

 Q

AMHRNSIG  ; IHS/CMI/LAB - report of visits with no esig ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**2**;JUN 18, 2010;Build 23

 +2       ;

 +3       ;

START     ;EP - called from option

 +1        DO XIT

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        SET X="BEHAVIORAL HEALTH UNSIGNED PROGRESS NOTES"

           WRITE !,$$CTR^AMHLEIN(X,80)

 +4        WRITE !!,"This report will display a list of all encounter records containing"

 +5        WRITE !,"unsigned SOAP/Progress Notes in a date range specified by the user.  After"

 +6        WRITE !,"the report is displayed, the user will have the option of affixing an"

 +7        WRITE !,"electronic signature to an unsigned SOAP/Progress Note."

 +8       ;I '$P($G(^AMHSITE(DUZ(2),18)),U,6) W !!,"Electronic Signature is not turned on at your facilty.  You",!,"cannot run this report.",! D PAUSE^AMHLEA Q

 +9       ;I '$P($G(^AMHSITE(DUZ(2),18)),U,7) W !!,"An Electronic Signature start date has not been recorded.  You",!,"cannot run this report.",! D PAUSE^AMHLEA Q

 +10       SET D=$$DATE^AMHESIG()

 +11       WRITE !!,"ESIG was implemented on ",$$FMTE^XLFDT(D),".  Only visits after this date will"

 +12       WRITE !,"display on this report.",!

 +13       DO DBHUSR^AMHUTIL

GETDATES  ;

 +1        WRITE !!,"Please enter the range of dates for the Unsigned visits"

BD        ;get beginning date

 +1        SET DIR(0)="D^"_$$DATE^AMHESIG()_",:DT:EP"

           SET DIR("A")="Enter Beginning Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AMHBD_":DT:EP"

           SET DIR("A")="Enter Ending Date"

           SET Y=AMHBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AMHED=Y

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

PROG      ;

 +1        SET AMHPROG=""

 +2        SET DIR(0)="S^O:ONE Program;A:ALL Programs"

           SET DIR("A")="Run the Report for which PROGRAM"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO GETDATES

 +4        IF Y="A"

               GOTO PROV

 +5        SET DIR(0)="9002011,.02"

           SET DIR("A")="Which PROGRAM"

           KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO PROG

 +7        IF X=""

               GOTO PROG

 +8        SET AMHPROG=Y

PROV      ;

 +1        SET AMHPROV=""

 +2        SET DIR(0)="S^A:All Providers;O:One Provider"

           SET DIR("A")="Include cases opened by"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO PROG

 +4        IF Y="A"

               GOTO SORT

 +5        SET DIC="^VA(200,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Which PROVIDER: "

           DO ^DIC

 +6        KILL DIC,DA

 +7        IF Y=-1

               GOTO PROV

 +8        SET AMHPROV=+Y

SORT      ;

 +1        SET AMHSORT=""

 +2        SET DIR(0)="S^P:Patient Name;D:Date of Visit;R:Primary Provider"

           SET DIR("A")="How would you like the report sorted"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO PROV

 +4        SET AMHSORT=Y

DEMO      ;

 +1        DO DEMOCHK^AMHUTIL1(.AMHDEMO)

 +2        IF AMHDEMO=-1

               GOTO SORT

ZIS       ;

 +1        SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to "

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        IF $GET(Y)="B"

               DO BROWSE

               DO XIT

               QUIT 

 +4        WRITE !!

           SET XBRP="PRINT^AMHRNSIG"

           SET XBRC="PROC^AMHRNSIG"

           SET XBNS="AMH*"

           SET XBRX="XIT^AMHRNSIG"

 +5        DO ^XBDBQUE

 +6        DO XIT

 +7        QUIT 

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^AMHRNSIG"")"

 +2        SET XBNS="AMH"

           SET XBRC="PROC^AMHRNSIG"

           SET XBRX="XIT^AMHRNSIG"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

 +4       ;

PROC      ;EP - called from xbdbque

 +1       ;loop through all visits in date range and look for problem 8-8.9 or visit type of N

 +2        SET AMHJOB=$JOB

           SET AMHTOT=0

           SET AMHBT=$HOROLOG

           SET AMHPTOT=0

 +3        DO XTMP^AMHUTIL("AMHRNSIG","BH - NO ESIG")

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

 +5        SET AMHODAT=AMHSD_".9999"

           FOR 

               SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))

               IF AMHODAT=""!((AMHODAT\1)>AMHED)

                   QUIT 

               Begin DoDot:1

 +6                SET AMHR=0

                   FOR 

                       SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))

                       IF AMHR'=+AMHR

                           QUIT 

                       Begin DoDot:2

 +7                        IF AMHPROG]""

                               IF $PIECE(^AMHREC(AMHR,0),U,2)'=AMHPROG

                                   QUIT 

 +8       ;EHR VISITS EXCLUDED

                           IF $PIECE($GET(^AMHREC(AMHR,11)),U,10)

                               QUIT 

 +9                        IF AMHPROV

                               IF $$PPINT^AMHUTIL(AMHR)'=AMHPROV

                                   QUIT 

 +10                       IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)

                               QUIT 

 +11                       SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)

                           IF 'DFN

                               QUIT 

 +12                       IF '$$ALLOWP^AMHUTIL(DUZ,DFN)

                               QUIT 

 +13                       IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))

                               QUIT 

 +14      ;if any dx is 8 then do set and q

 +15      ;already signed

                           IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""

                               QUIT 

 +16                       SET ^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",$$SORTVAL(AMHR,AMHSORT),AMHR)=""

                           SET AMHTOT=AMHTOT+1

 +17                       QUIT 

                       End DoDot:2

 +18               QUIT 

               End DoDot:1

 +19       QUIT 

 +20      ;

SORTVAL(R,V) ;

 +1        NEW G

 +2        IF V="P"

               Begin DoDot:1

 +3                SET G=$PIECE(^AMHREC(R,0),U,8)

                   IF G

                       SET G=$PIECE($GET(^DPT(G,0)),U)

 +4                IF G=""

                       SET G="--"

               End DoDot:1

               QUIT G

 +5        IF V="R"

               SET G=$$PPNAME^AMHUTIL(R)

               IF G=""

                   SET G="--"

               QUIT G

 +6        IF V="D"

               QUIT $PIECE(^AMHREC(R,0),U)

 +7        QUIT ""

PRINT     ;EP - called from xbdbque

 +1        DO PRINT1

 +2        KILL ^XTMP("AMHRNSIG",AMHJOB,AMHBT)

 +3        QUIT 

PRINT1    ;

 +1        KILL AMHQ

           SET AMHPG=0

 +2        IF '$DATA(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS"))

               DO HEADER

               WRITE !!,"There were no Unsigned Encounter Records during the time period.",!

               QUIT 

 +3        DO HEADER

 +4        SET AMHSORT=""

           FOR 

               SET AMHSORT=$ORDER(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",AMHSORT))

               IF AMHSORT=""!($DATA(AMHQ))

                   QUIT 

               Begin DoDot:1

 +5                SET AMHR=0

                   FOR 

                       SET AMHR=$ORDER(^XTMP("AMHRNSIG",AMHJOB,AMHBT,"VISITS",AMHSORT,AMHR))

                       IF AMHR'=+AMHR!($DATA(AMHQ))

                           QUIT 

                       Begin DoDot:2

 +6                        IF $Y>(IOSL-4)

                               DO HEADER

                               IF $DATA(AMHQ)

                                   QUIT 

 +7                        SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)

 +8                        WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,25),?27,$$HRN^AUPNPAT(DFN,DUZ(2)),?34,$$FMTE^XLFDT($PIECE(^AMHREC(AMHR,0),U)),?53,$EXTRACT($$PPNAME^AMHUTIL(AMHR),1,18)

 +9                        WRITE ?73,$EXTRACT($$VAL^XBDIQ1(9002011,AMHR,.02),1,1)

 +10                       WRITE ?76,$EXTRACT($$VAL^XBDIQ1(9002011,AMHR,.34),1,1)

                       End DoDot:2

 +11               QUIT 

               End DoDot:1

 +12       IF $DATA(AMHQ)

               QUIT 

 +13       IF $Y>(IOSL-4)

               DO HEADER

               IF $DATA(AMHQ)

                   QUIT 

 +14       WRITE !!,"Total # of Unsigned Visits: ",AMHTOT,!

 +15       QUIT 

XIT       ;

 +1        DO EN^XBVK("AMH")

 +2        DO KILL^AUPNPAT

 +3        QUIT 

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

HEADER    ;EP

 +1        IF 'AMHPG

               GOTO HEADER1

 +2        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET AMHQ=""

                       QUIT 

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET AMHPG=AMHPG+1

 +2        WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 +3        WRITE !?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),?($SELECT(80=132:120,1:72)),"Page ",AMHPG,!

 +4        SET AMHTEXT="UNSIGNED ENCOUNTER RECORDS"

 +5        WRITE !?(80-$LENGTH(AMHTEXT)/2),AMHTEXT,!

 +6        SET AMHTEXT="Date Range:  "_AMHBDD_" and "_AMHEDD

 +7        WRITE ?(80-$LENGTH(AMHTEXT)/2),AMHTEXT,!

 +8        IF AMHPROG]""

               SET X="Program: "_$$EXTSET^XBFUNC(9002011,.02,AMHPROG)

               WRITE $$CTR^AMHLEIN(X,80),!

 +9        IF AMHPROV

               SET X="Provider: "_$PIECE(^VA(200,AMHPROV,0),U)

               WRITE $$CTR^AMHLEIN(X,80),!

 +10       WRITE !,"PATIENT NAME",?27,"HRN",?34,"DATE/TIME",?53,"PROVIDER",?73,"PG",?76,"GRP"

 +11       WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +12       QUIT