AMEROUT ; IHS/ANMC/GIS - REPORT GENERATOR ;
;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
;
D HOME^%ZIS W @IOF
K ^TMP("AMER",$J),AMERQUIT
RUN D TEMP I $D(AMERQUIT) G EXIT
D FIN I $D(AMERQUIT) G EXIT
D TIME I $D(AMERQUIT) G EXIT
;IHS/OIT/SCR 12/29/08 - synch ERS data with PCC data for the time frame selected
D SYNCHERS^AMERERS($P(AMERD1,".",1),$P(AMERD2,".",1))
I $G(AMERRTYP)="H" D ^AMEROUT4 G EXIT
D PSET,SORT,^AMEROUT1 I $D(AMERQUIT) G EXIT
EXIT D EXIT^AMER
K AMERQUIT,AMERRTYP,AMERD1,AMERD2,AMERDISP,AMERQUIT,X,Y,AMERBRK,AMERCON,AMERINC,AMERTOT,AMERSTRT,AMERX,AMERZ,%DT,%X,AMERSTAT,%Y
K AMERVTOT,B,DIJ,DIRUT,DISYS,DP,DIC,DIE,P,AMERPTOT,AMERBY,AMERFR,AMERTO,AMERATNM,AMERSCR,AMERGBL,AMERCAT,FR,TO,BY,L,FLDS,AMERA1,AMERA2,AMERSFL
Q
;
OUT ;ENTRY POINT FROM AMERBSET
; QUIT
I '$D(POP) S POP=0
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT S AMERQUIT="" W !!,"Session terminated...." H 2 W @IOF
Q
;
TEMP ; SELECT TEMPLATE TYPE
W !!,?20,"***** REPORT OPTIONS *****"
S DIR(0)="SO^1:STANDARD ER LOG REPORT;2:BRIEF ER LOG REPORT;3:STATISTICAL REPORTS;4:HOURLY WORKLOAD REPORT",DIR("A")="Report type",DIR("?")="",DIR("B")=1 D ^DIR K DIR
D OUT I $D(AMERQUIT) Q
S AMERRTYP=$S(Y<3:"V",Y=3:"S",Y=4:"H",1:"")
I Y=1 S AMERHDR="STANDARD ER LOG REPORT"
I Y=2 S AMERHDR="BRIEF ER LOG REPORT"
I Y=3 S AMERHDR="ER STATISTICAL REPORT"
S FLDS=$S(Y=1:"[AMER DETAIL",2:"[AMER BRIEF",3:"[AMER AGE ",4:".01",1:"")
I FLDS="" S AMERQUIT="" Q
Q
;
FIN ; FINISHING TOUCHES
I AMERRTYP="H" Q
K AMERSTAT I AMERRTYP="S" S AMERSTAT="",AMERRTYP="V",AMERDISP=3 Q
I AMERRTYP="A" D ^AMERBSET
I AMERRTYP'="V" S AMERDISP=3 Q
W !!!!,?20,"***** DISPLAY OPTIONS *****"
S DIR(0)="SO^1:VISITS IN INVERSE ORDER OF DATES;2:PATIENTS IN ALPHABETICAL ORDER;3:VISITS IN CHRONOLOGICAL ORDER",DIR("A")="Your choice",DIR("B")="3",DIR("?")="" D ^DIR K DIR
D OUT I $D(AMERQUIT) Q
S AMERDISP=Y
Q
;
TIME ; TIME FRAME
W !!!!,?20,"***** TIME FRAME *****"
T1 S DIR(0)="D"_$S(AMERRTYP="H":"",1:"O"),DIR("A")="Enter starting date",DIR("?")="" D ^DIR K DIR
D OUT I $D(AMERQUIT) Q
I X="" W " (start at first ER visit)" S AMERD1=2950101.0001 G T2
S AMERD1=Y X ^DD("DD") W " (",Y,")"
T2 S DIR(0)="D"_$S(AMERRTYP="H":"",1:"O"),DIR("A")="Enter ending date",DIR("?")="" D ^DIR K DIR
D OUT I $D(AMERQUIT) Q
I X="" W " (end at last ER visit)" S AMERD2=DT+.2359 Q
I Y=Y\1 S Y=Y+.2359
I Y<AMERD1 W " ??",*7," Ending date must follow starting date" G T2
S AMERD2=Y X ^DD("DD") W " (",Y,")"
I AMERRTYP="H" N X1,X2,X S X2=AMERD1,X1=AMERD2 D ^%DTC I X>30 W *7,!," The maximum time span for this report is 30 days. Try again...",! K AMERD1,AMERD2 G T1
S:$G(AMERHDR)'="" AMERDHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
Q
;
SORT ; SORT OPTIONS
K ^TMP("AMER",$J)
W !!!!,?20,"***** SORT OPTIONS *****",!!
S1 ; ENTRY POINT FROM AMEROUT1
S X="",AMERVTOT=0,AMERPTOT=0
F L=0:0 S X=$O(^AMER(2.2,"B",X)) Q:X="" F Y=0:0 S Y=$O(^AMER(2.2,"B",X,Y)) Q:'Y S Z=^AMER(2.2,Y,0) I $P(Z,U,2)=AMERRTYP S ^TMP("AMER",$J,5,$P(Z,U,5),X)=Y
S I=0 F Z="P","V" S X="" F L=0:0 S X=$O(^TMP("AMER",$J,5,Z,X)) Q:X="" S Y=^(X),I=I+1,^TMP("AMER",$J,6,Z,I)=X,^TMP("AMER",$J,7,I)=Y S:Z="P" AMERPTOT=AMERPTOT+1 S:Z="V" AMERVTOT=AMERVTOT+1
EN1 S AMERCON="P",AMERSTRT=0,(AMERBRK,AMERINC)=(+$G(AMERPTOT)+1)\2 W "Patient attributes =>" D OPT ; ENTRY POINT TO LIST SORT OPTIONS
S AMERCON="V",AMERSTRT=AMERPTOT,AMERINC=((AMERVTOT+1)\2),AMERBRK=AMERINC+AMERPTOT W !!,"Visit attributes =>" D OPT
Q
;
OPT ; LIST SORT OPTIONS
S I=AMERSTRT
INCI S I=I+1 I I>AMERBRK Q
W !?3,I,")",?8,^TMP("AMER",$J,6,AMERCON,I)
I $D(^TMP("AMER",$J,6,AMERCON,I+AMERINC)) W ?43,(I+AMERINC),")",?48,^(I+AMERINC)
G INCI
;
EN2 ; RECENT ER VISITS
W !! S DIR(0)="DO^::ET",DIR("A")="Starting date (time optional)" D ^DIR K DIR
D OUT I $D(AMERQUIT) K AMERQUIT Q
I X="" S X=2000101 W " (Start with first visit)"
S FR=Y
S DIR(0)="DO^::ET",DIR("A")="Ending date (time optional)",DIR("B")="NOW" D ^DIR K DIR
D OUT I $D(AMERQUIT) K AMERQUIT Q
S TO=Y
I FR>TO W " ??",*7,!!! G EN2
S DIR(0)="SO^B:BRIEF REPORT;S:STANDARD REPORT",DIR("A")="Report type",DIR("B")="BRIEF" D ^DIR K DIR
D OUT I $D(AMERQUIT) K AMERQUIT Q
S FLDS=$S(Y="B":"[AMER BRIEF",1:"[AMER DETAIL")
S DIC="^AMERVSIT(",BY="@.01"
I $G(AMERHDR)'="" S DHD=AMERHDR
E S DHD="ER VISIT REPORT"
D EN1^DIP,EXIT1^AMER
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q
;
EN3 ; Recent ER Visits with Insurance Information for Business Office people
W !! S DIR(0)="DO^::ET",DIR("A")="Starting date (time optional)" D ^DIR K DIR
D OUT I $D(AMERQUIT) K AMERQUIT Q
I X="" S X=2000101 W " (Start with first visit)"
S FR=Y
S DIR(0)="DO^::ET",DIR("A")="Ending date (time optional)",DIR("B")="NOW" D ^DIR K DIR
D OUT I $D(AMERQUIT) K AMERQUIT Q
S TO=Y
I FR>TO W " ??",*7,!!! G EN3
D OUT I $D(AMERQUIT) K AMERQUIT Q
S FLDS="[AMER WITH INSINFO"
S DIC="^AMERVSIT(",BY="@.01",DHD="ER VISIT REPORT WITH INSURANCE INFORMATION"
D EN1^DIP,EXIT1^AMER
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q
;
PSET ; PRLIMINARY SET
I AMERRTYP="A" Q
S (BY,FR,TO)=""
Q
;
I AMERDISP>1 S BY="@.01",FR=AMERD1,TO=AMERD2 S:$D(AMERSTAT) BY="'.01" Q
S BY="@.16",FR=9999999.9999-AMERD2,TO=9999999.9999-AMERD1
Q
AMEROUT ; IHS/ANMC/GIS - REPORT GENERATOR ;
+1 ;;3.0;ER VISIT SYSTEM;;FEB 23, 2009
+2 ;
+3 DO HOME^%ZIS
WRITE @IOF
+4 KILL ^TMP("AMER",$JOB),AMERQUIT
RUN DO TEMP
IF $DATA(AMERQUIT)
GOTO EXIT
+1 DO FIN
IF $DATA(AMERQUIT)
GOTO EXIT
+2 DO TIME
IF $DATA(AMERQUIT)
GOTO EXIT
+3 ;IHS/OIT/SCR 12/29/08 - synch ERS data with PCC data for the time frame selected
+4 DO SYNCHERS^AMERERS($PIECE(AMERD1,".",1),$PIECE(AMERD2,".",1))
+5 IF $GET(AMERRTYP)="H"
DO ^AMEROUT4
GOTO EXIT
+6 DO PSET
DO SORT
DO ^AMEROUT1
IF $DATA(AMERQUIT)
GOTO EXIT
EXIT DO EXIT^AMER
+1 KILL AMERQUIT,AMERRTYP,AMERD1,AMERD2,AMERDISP,AMERQUIT,X,Y,AMERBRK,AMERCON,AMERINC,AMERTOT,AMERSTRT,AMERX,AMERZ,%DT,%X,AMERSTAT,%Y
+2 KILL AMERVTOT,B,DIJ,DIRUT,DISYS,DP,DIC,DIE,P,AMERPTOT,AMERBY,AMERFR,AMERTO,AMERATNM,AMERSCR,AMERGBL,AMERCAT,FR,TO,BY,L,FLDS,AMERA1,AMERA2,AMERSFL
+3 QUIT
+4 ;
OUT ;ENTRY POINT FROM AMERBSET
+1 ; QUIT
+2 IF '$DATA(POP)
SET POP=0
+3 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
SET AMERQUIT=""
WRITE !!,"Session terminated...."
HANG 2
WRITE @IOF
+4 QUIT
+5 ;
TEMP ; SELECT TEMPLATE TYPE
+1 WRITE !!,?20,"***** REPORT OPTIONS *****"
+2 SET DIR(0)="SO^1:STANDARD ER LOG REPORT;2:BRIEF ER LOG REPORT;3:STATISTICAL REPORTS;4:HOURLY WORKLOAD REPORT"
SET DIR("A")="Report type"
SET DIR("?")=""
SET DIR("B")=1
DO ^DIR
KILL DIR
+3 DO OUT
IF $DATA(AMERQUIT)
QUIT
+4 SET AMERRTYP=$SELECT(Y<3:"V",Y=3:"S",Y=4:"H",1:"")
+5 IF Y=1
SET AMERHDR="STANDARD ER LOG REPORT"
+6 IF Y=2
SET AMERHDR="BRIEF ER LOG REPORT"
+7 IF Y=3
SET AMERHDR="ER STATISTICAL REPORT"
+8 SET FLDS=$SELECT(Y=1:"[AMER DETAIL",2:"[AMER BRIEF",3:"[AMER AGE ",4:".01",1:"")
+9 IF FLDS=""
SET AMERQUIT=""
QUIT
+10 QUIT
+11 ;
FIN ; FINISHING TOUCHES
+1 IF AMERRTYP="H"
QUIT
+2 KILL AMERSTAT
IF AMERRTYP="S"
SET AMERSTAT=""
SET AMERRTYP="V"
SET AMERDISP=3
QUIT
+3 IF AMERRTYP="A"
DO ^AMERBSET
+4 IF AMERRTYP'="V"
SET AMERDISP=3
QUIT
+5 WRITE !!!!,?20,"***** DISPLAY OPTIONS *****"
+6 SET DIR(0)="SO^1:VISITS IN INVERSE ORDER OF DATES;2:PATIENTS IN ALPHABETICAL ORDER;3:VISITS IN CHRONOLOGICAL ORDER"
SET DIR("A")="Your choice"
SET DIR("B")="3"
SET DIR("?")=""
DO ^DIR
KILL DIR
+7 DO OUT
IF $DATA(AMERQUIT)
QUIT
+8 SET AMERDISP=Y
+9 QUIT
+10 ;
TIME ; TIME FRAME
+1 WRITE !!!!,?20,"***** TIME FRAME *****"
T1 SET DIR(0)="D"_$SELECT(AMERRTYP="H":"",1:"O")
SET DIR("A")="Enter starting date"
SET DIR("?")=""
DO ^DIR
KILL DIR
+1 DO OUT
IF $DATA(AMERQUIT)
QUIT
+2 IF X=""
WRITE " (start at first ER visit)"
SET AMERD1=2950101.0001
GOTO T2
+3 SET AMERD1=Y
XECUTE ^DD("DD")
WRITE " (",Y,")"
T2 SET DIR(0)="D"_$SELECT(AMERRTYP="H":"",1:"O")
SET DIR("A")="Enter ending date"
SET DIR("?")=""
DO ^DIR
KILL DIR
+1 DO OUT
IF $DATA(AMERQUIT)
QUIT
+2 IF X=""
WRITE " (end at last ER visit)"
SET AMERD2=DT+.2359
QUIT
+3 IF Y=Y\1
SET Y=Y+.2359
+4 IF Y<AMERD1
WRITE " ??",*7," Ending date must follow starting date"
GOTO T2
+5 SET AMERD2=Y
XECUTE ^DD("DD")
WRITE " (",Y,")"
+6 IF AMERRTYP="H"
NEW X1,X2,X
SET X2=AMERD1
SET X1=AMERD2
DO ^%DTC
IF X>30
WRITE *7,!," The maximum time span for this report is 30 days. Try again...",!
KILL AMERD1,AMERD2
GOTO T1
+7 IF $GET(AMERHDR)'=""
SET AMERDHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+8 QUIT
+9 ;
SORT ; SORT OPTIONS
+1 KILL ^TMP("AMER",$JOB)
+2 WRITE !!!!,?20,"***** SORT OPTIONS *****",!!
S1 ; ENTRY POINT FROM AMEROUT1
+1 SET X=""
SET AMERVTOT=0
SET AMERPTOT=0
+2 FOR L=0:0
SET X=$ORDER(^AMER(2.2,"B",X))
IF X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(^AMER(2.2,"B",X,Y))
IF 'Y
QUIT
SET Z=^AMER(2.2,Y,0)
IF $PIECE(Z,U,2)=AMERRTYP
SET ^TMP("AMER",$JOB,5,$PIECE(Z,U,5),X)=Y
+3 SET I=0
FOR Z="P","V"
SET X=""
FOR L=0:0
SET X=$ORDER(^TMP("AMER",$JOB,5,Z,X))
IF X=""
QUIT
SET Y=^(X)
SET I=I+1
SET ^TMP("AMER",$JOB,6,Z,I)=X
SET ^TMP("AMER",$JOB,7,I)=Y
IF Z="P"
SET AMERPTOT=AMERPTOT+1
IF Z="V"
SET AMERVTOT=AMERVTOT+1
EN1 ; ENTRY POINT TO LIST SORT OPTIONS
SET AMERCON="P"
SET AMERSTRT=0
SET (AMERBRK,AMERINC)=(+$GET(AMERPTOT)+1)\2
WRITE "Patient attributes =>"
DO OPT
+1 SET AMERCON="V"
SET AMERSTRT=AMERPTOT
SET AMERINC=((AMERVTOT+1)\2)
SET AMERBRK=AMERINC+AMERPTOT
WRITE !!,"Visit attributes =>"
DO OPT
+2 QUIT
+3 ;
OPT ; LIST SORT OPTIONS
+1 SET I=AMERSTRT
INCI SET I=I+1
IF I>AMERBRK
QUIT
+1 WRITE !?3,I,")",?8,^TMP("AMER",$JOB,6,AMERCON,I)
+2 IF $DATA(^TMP("AMER",$JOB,6,AMERCON,I+AMERINC))
WRITE ?43,(I+AMERINC),")",?48,^(I+AMERINC)
+3 GOTO INCI
+4 ;
EN2 ; RECENT ER VISITS
+1 WRITE !!
SET DIR(0)="DO^::ET"
SET DIR("A")="Starting date (time optional)"
DO ^DIR
KILL DIR
+2 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+3 IF X=""
SET X=2000101
WRITE " (Start with first visit)"
+4 SET FR=Y
+5 SET DIR(0)="DO^::ET"
SET DIR("A")="Ending date (time optional)"
SET DIR("B")="NOW"
DO ^DIR
KILL DIR
+6 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+7 SET TO=Y
+8 IF FR>TO
WRITE " ??",*7,!!!
GOTO EN2
+9 SET DIR(0)="SO^B:BRIEF REPORT;S:STANDARD REPORT"
SET DIR("A")="Report type"
SET DIR("B")="BRIEF"
DO ^DIR
KILL DIR
+10 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+11 SET FLDS=$SELECT(Y="B":"[AMER BRIEF",1:"[AMER DETAIL")
+12 SET DIC="^AMERVSIT("
SET BY="@.01"
+13 IF $GET(AMERHDR)'=""
SET DHD=AMERHDR
+14 IF '$TEST
SET DHD="ER VISIT REPORT"
+15 DO EN1^DIP
DO EXIT1^AMER
+16 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+17 QUIT
+18 ;
EN3 ; Recent ER Visits with Insurance Information for Business Office people
+1 WRITE !!
SET DIR(0)="DO^::ET"
SET DIR("A")="Starting date (time optional)"
DO ^DIR
KILL DIR
+2 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+3 IF X=""
SET X=2000101
WRITE " (Start with first visit)"
+4 SET FR=Y
+5 SET DIR(0)="DO^::ET"
SET DIR("A")="Ending date (time optional)"
SET DIR("B")="NOW"
DO ^DIR
KILL DIR
+6 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+7 SET TO=Y
+8 IF FR>TO
WRITE " ??",*7,!!!
GOTO EN3
+9 DO OUT
IF $DATA(AMERQUIT)
KILL AMERQUIT
QUIT
+10 SET FLDS="[AMER WITH INSINFO"
+11 SET DIC="^AMERVSIT("
SET BY="@.01"
SET DHD="ER VISIT REPORT WITH INSURANCE INFORMATION"
+12 DO EN1^DIP
DO EXIT1^AMER
+13 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+14 QUIT
+15 ;
PSET ; PRLIMINARY SET
+1 IF AMERRTYP="A"
QUIT
+2 SET (BY,FR,TO)=""
+3 QUIT
+4 ;
+5 IF AMERDISP>1
SET BY="@.01"
SET FR=AMERD1
SET TO=AMERD2
IF $DATA(AMERSTAT)
SET BY="'.01"
QUIT
+6 SET BY="@.16"
SET FR=9999999.9999-AMERD2
SET TO=9999999.9999-AMERD1
+7 QUIT