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