AMEROUT.m

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