AMERREPT ; IHS/OIT/SCR - PRIMARY ROUTINE FOR PREDEFINED REPORT INTERFACE;
;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23
;
RUN ; EP from OPTION "AMER CANNED" invoked from ERS MENU
; Provides the user interface for pre-defined reports
N AMERSEL,DIR
;AMER*3.0*8;Reset POP
S POP=0
S DIR(0)="SO^1:PATIENTS BY TRIAGE CATEGORY;"
S DIR(0)=DIR(0)_"2:PATIENTS BY TRIAGE NURSE;"
S DIR(0)=DIR(0)_"3:PATIENTS BY CONSULTANT TYPE;"
S DIR(0)=DIR(0)_"4:TRANSFERS FROM OUTSIDE FACILITIES;"
S DIR(0)=DIR(0)_"5:ARRIVE TO ER BY AMBULANCE;"
S DIR(0)=DIR(0)_"6:ARRIVE TO ER BY FLIGHT SERVICES;"
S DIR(0)=DIR(0)_"7:TRANSFERRED TO OTHER FACILITIES ;"
S DIR("A")="Select Report",DIR("?")="Select one choice or '^' to leave."
D ^DIR
Q:Y=""!(Y="^")
S AMERSEL=Y
D REPORT(AMERSEL)
K AMERSEL,DIR
D RUN
Q
;
REPORT(AMERSEL) ;
N AMERLINE,AMERBANN
S %="",$P(%,"~",80)="",AMERLINE=% K %
D EN^DDIOL(AMERLINE,"","!!")
I AMERSEL=1 D
.I '$$TRIAGCAT^AMERREP1() Q ; TRIAGE BY CATAGORY
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERSEL=2 D
.I '$$TRIAGNRS^AMERREP1() Q ; TRIAGE BY CATAGORY
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERSEL=3 D
.I '$$CONSLTN^AMERREP2() Q ; PATIENTS BY CONSULTANT TYPE
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
I AMERSEL=4 D
.I '$$REFERALS^AMERREP1() Q ; REFERALS FROM OUTSIDE FACILITIES
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERSEL=5 D
.I '$$AMBULAN^AMERREP2() Q ; ARRIVE TO ER BY AMBULANCE
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERSEL=6 D
.I '$$AIRAMBU^AMERREP2() Q ; ARRIVE TO ER BY AIR-AMBULANCE
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
I AMERSEL=7 D
.I '$$TRANSTO^AMERREP2() Q ; TRANSFERRED TO OTHER FACILITIES
.D EN^DDIOL(AMERLINE,"","!!")
.D EN^DDIOL("","","!")
.Q
K AMERLINE,AMERBANN,AMERD1X,AMERD2X
Q
;
TIME(AMERD1,AMERD2,AMERD1X,AMERD2X) ; EP from AMEREXPT and AMERREP* routines
; Provides interface for identifying TIME FRAME
N DIR,AMERX1,AMERX2,X1,X2,X,AMERQUIT
S AMERQUIT=0
D EN^DDIOL("***** TIME FRAME *****","","!!,?20,!!")
S:$D(AMERD2) DIR(0)="DO",DIR("A")="Start Date",DIR("?")="leave blank to start with first ER VISIT"
I '$D(AMERD2) D
.S DIR(0)="DO"
.S DIR("A")="Report for what day"
.S DIR("?")="Enter the day for the daily report"
.S Y=DT
.X ^DD("DD")
.S DIR("B")=Y
D ^DIR
I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q 0
I $D(AMERD2) D
.I X="" D EN^DDIOL("Start at First ER VISIT","","") S Y=2950101.0001
.S (AMERX1,AMERD1X)=Y
.X ^DD("DD") S AMERD1=Y
.S DIR(0)="DO",DIR("A")="End Date",DIR("?")="leave blank to go to last ER VISIT"
.D ^DIR K DIR
.I $D(DUOUT)!$D(DTOUT) K DUOUT,DTOUT Q
.I X="" D EN^DDIOL("end at last ER Visit","","") S Y=DT+.2359
.I Y\1=0 S Y=Y+.2359
.S (AMERX2,AMERD2X)=Y
.X ^DD("DD") S AMERD2=Y
.I AMERD1=""!AMERD2="" S AMERQUIT=1
.; If AMERD1 compared to AMERD2 is after
.I '$$TCOMP^AMERTIME(AMERX1,AMERX2,0) D
..D EN^DDIOL("Ending date must follow starting date","","!!")
..S AMERQUIT=1
I '$D(AMERD2) D
.I X="" D EN^DDIOL("No date selected","","") Q
.S (AMERX1,AMERD1X)=Y
.X ^DD("DD") S AMERD1=Y
I AMERQUIT Q 0
Q 1
;
AMERDHD(AMERHDR,AMERD1,AMERD2) ; EP from multiple AMER reporting routines
N AMERDHD
S AMERDHD="*********************** CONFIDENTIAL PATIENT INFORMATION ***********************"
S AMERDHD=AMERDHD_AMERHDR
S:AMERD1'="" AMERDHD=AMERDHD_" FROM: "_AMERD1
S:AMERD2'="" AMERDHD=AMERDHD_" TO: "_AMERD2
Q AMERDHD
AMERREPT ; IHS/OIT/SCR - PRIMARY ROUTINE FOR PREDEFINED REPORT INTERFACE;
+1 ;;3.0;ER VISIT SYSTEM;**8**;MAR 03, 2009;Build 23
+2 ;
RUN ; EP from OPTION "AMER CANNED" invoked from ERS MENU
+1 ; Provides the user interface for pre-defined reports
+2 NEW AMERSEL,DIR
+3 ;AMER*3.0*8;Reset POP
+4 SET POP=0
+5 SET DIR(0)="SO^1:PATIENTS BY TRIAGE CATEGORY;"
+6 SET DIR(0)=DIR(0)_"2:PATIENTS BY TRIAGE NURSE;"
+7 SET DIR(0)=DIR(0)_"3:PATIENTS BY CONSULTANT TYPE;"
+8 SET DIR(0)=DIR(0)_"4:TRANSFERS FROM OUTSIDE FACILITIES;"
+9 SET DIR(0)=DIR(0)_"5:ARRIVE TO ER BY AMBULANCE;"
+10 SET DIR(0)=DIR(0)_"6:ARRIVE TO ER BY FLIGHT SERVICES;"
+11 SET DIR(0)=DIR(0)_"7:TRANSFERRED TO OTHER FACILITIES ;"
+12 SET DIR("A")="Select Report"
SET DIR("?")="Select one choice or '^' to leave."
+13 DO ^DIR
+14 IF Y=""!(Y="^")
QUIT
+15 SET AMERSEL=Y
+16 DO REPORT(AMERSEL)
+17 KILL AMERSEL,DIR
+18 DO RUN
+19 QUIT
+20 ;
REPORT(AMERSEL) ;
+1 NEW AMERLINE,AMERBANN
+2 SET %=""
SET $PIECE(%,"~",80)=""
SET AMERLINE=%
KILL %
+3 DO EN^DDIOL(AMERLINE,"","!!")
+4 IF AMERSEL=1
Begin DoDot:1
+5 ; TRIAGE BY CATAGORY
IF '$$TRIAGCAT^AMERREP1()
QUIT
+6 DO EN^DDIOL(AMERLINE,"","!!")
+7 DO EN^DDIOL("","","!")
+8 QUIT
End DoDot:1
+9 IF AMERSEL=2
Begin DoDot:1
+10 ; TRIAGE BY CATAGORY
IF '$$TRIAGNRS^AMERREP1()
QUIT
+11 DO EN^DDIOL(AMERLINE,"","!!")
+12 DO EN^DDIOL("","","!")
+13 QUIT
End DoDot:1
+14 IF AMERSEL=3
Begin DoDot:1
+15 ; PATIENTS BY CONSULTANT TYPE
IF '$$CONSLTN^AMERREP2()
QUIT
+16 DO EN^DDIOL(AMERLINE,"","!!")
+17 DO EN^DDIOL("","","!")
End DoDot:1
+18 IF AMERSEL=4
Begin DoDot:1
+19 ; REFERALS FROM OUTSIDE FACILITIES
IF '$$REFERALS^AMERREP1()
QUIT
+20 DO EN^DDIOL(AMERLINE,"","!!")
+21 DO EN^DDIOL("","","!")
+22 QUIT
End DoDot:1
+23 IF AMERSEL=5
Begin DoDot:1
+24 ; ARRIVE TO ER BY AMBULANCE
IF '$$AMBULAN^AMERREP2()
QUIT
+25 DO EN^DDIOL(AMERLINE,"","!!")
+26 DO EN^DDIOL("","","!")
+27 QUIT
End DoDot:1
+28 IF AMERSEL=6
Begin DoDot:1
+29 ; ARRIVE TO ER BY AIR-AMBULANCE
IF '$$AIRAMBU^AMERREP2()
QUIT
+30 DO EN^DDIOL(AMERLINE,"","!!")
+31 DO EN^DDIOL("","","!")
+32 QUIT
End DoDot:1
+33 IF AMERSEL=7
Begin DoDot:1
+34 ; TRANSFERRED TO OTHER FACILITIES
IF '$$TRANSTO^AMERREP2()
QUIT
+35 DO EN^DDIOL(AMERLINE,"","!!")
+36 DO EN^DDIOL("","","!")
+37 QUIT
End DoDot:1
+38 KILL AMERLINE,AMERBANN,AMERD1X,AMERD2X
+39 QUIT
+40 ;
TIME(AMERD1,AMERD2,AMERD1X,AMERD2X) ; EP from AMEREXPT and AMERREP* routines
+1 ; Provides interface for identifying TIME FRAME
+2 NEW DIR,AMERX1,AMERX2,X1,X2,X,AMERQUIT
+3 SET AMERQUIT=0
+4 DO EN^DDIOL("***** TIME FRAME *****","","!!,?20,!!")
+5 IF $DATA(AMERD2)
SET DIR(0)="DO"
SET DIR("A")="Start Date"
SET DIR("?")="leave blank to start with first ER VISIT"
+6 IF '$DATA(AMERD2)
Begin DoDot:1
+7 SET DIR(0)="DO"
+8 SET DIR("A")="Report for what day"
+9 SET DIR("?")="Enter the day for the daily report"
+10 SET Y=DT
+11 XECUTE ^DD("DD")
+12 SET DIR("B")=Y
End DoDot:1
+13 DO ^DIR
+14 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT 0
+15 IF $DATA(AMERD2)
Begin DoDot:1
+16 IF X=""
DO EN^DDIOL("Start at First ER VISIT","","")
SET Y=2950101.0001
+17 SET (AMERX1,AMERD1X)=Y
+18 XECUTE ^DD("DD")
SET AMERD1=Y
+19 SET DIR(0)="DO"
SET DIR("A")="End Date"
SET DIR("?")="leave blank to go to last ER VISIT"
+20 DO ^DIR
KILL DIR
+21 IF $DATA(DUOUT)!$DATA(DTOUT)
KILL DUOUT,DTOUT
QUIT
+22 IF X=""
DO EN^DDIOL("end at last ER Visit","","")
SET Y=DT+.2359
+23 IF Y\1=0
SET Y=Y+.2359
+24 SET (AMERX2,AMERD2X)=Y
+25 XECUTE ^DD("DD")
SET AMERD2=Y
+26 IF AMERD1=""!AMERD2=""
SET AMERQUIT=1
+27 ; If AMERD1 compared to AMERD2 is after
+28 IF '$$TCOMP^AMERTIME(AMERX1,AMERX2,0)
Begin DoDot:2
+29 DO EN^DDIOL("Ending date must follow starting date","","!!")
+30 SET AMERQUIT=1
End DoDot:2
End DoDot:1
+31 IF '$DATA(AMERD2)
Begin DoDot:1
+32 IF X=""
DO EN^DDIOL("No date selected","","")
QUIT
+33 SET (AMERX1,AMERD1X)=Y
+34 XECUTE ^DD("DD")
SET AMERD1=Y
End DoDot:1
+35 IF AMERQUIT
QUIT 0
+36 QUIT 1
+37 ;
AMERDHD(AMERHDR,AMERD1,AMERD2) ; EP from multiple AMER reporting routines
+1 NEW AMERDHD
+2 SET AMERDHD="*********************** CONFIDENTIAL PATIENT INFORMATION ***********************"
+3 SET AMERDHD=AMERDHD_AMERHDR
+4 IF AMERD1'=""
SET AMERDHD=AMERDHD_" FROM: "_AMERD1
+5 IF AMERD2'=""
SET AMERDHD=AMERDHD_" TO: "_AMERD2
+6 QUIT AMERDHD
