- 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
