AMERREP2 ; IHS/OIT/SCR - SUB-ROUTINE FOR PREDEFINED REPORT INTERFACE;
;;3.0;ER VISIT SYSTEM;**1,5,8**;MAR 03, 2009;Build 23
;
AMBULAN() ; EP from AMERREPT
; AMBULANCE ARRIVAL PRESENTING TRIAGE
; NAME PATIENT CNO DATE TIME COMPLIANT CATEGORY
N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
;IHS/OIT/SCR 12/29/08 check selected records for PCC update
D SYNCHERS^AMERERS(AMERD1,AMERD2)
D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
D EN^DDIOL("End Date: "_AMERD2,"","?40")
S AMERHDR="ARRIVE TO ER BY AMBULANCE"
S FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
S FLDS=FLDS_",1;C5;L240;W75"
S BY=".25,+@.21;S1,.02,.01"
S FR="AMBULANCE,@,@,"_AMERD1X
S TO="AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
S L=0
S DIC="^AMERVSIT("
I '$D(POP) S POP=0
;AMER*3.0*8;Added 0 to the quit
;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
;
;AMER*3.0*5
D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive by Ambulance Report from "_AMERD1_" to "_AMERD2,"")
;
D EN1^DIP
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q 1
;
AIRAMBU() ; EP from AMERREPT
; FLIGHT ARRIVAL PRESENTING TRIAGE
; SERVICE PATIENT CNO DATE TIME COMPLIANT CATEGORY
N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
;IHS/OIT/SCR 12/29/08 check selected records for PCC update
D SYNCHERS^AMERERS(AMERD1,AMERD2)
D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
D EN^DDIOL("End Date: "_AMERD2,"","?40")
S AMERHDR="ARRIVE TO ER BY AIR AMBULANCE"
S FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
S FLDS=FLDS_",1;C5;L240;W75"
S BY=".25,+@.21;S1,.02,.01"
S FR="AIR AMBULANCE,@,@,"_AMERD1X
S TO="AIR AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
S L=0
S DIC="^AMERVSIT("
I '$D(POP) S POP=0
;AMER*3.0*8;Added 0 to the quit
;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
D EN1^DIP
;
;AMER*3.0*5
D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive to ER by Air Ambulance Report from "_AMERD1_" to "_AMERD2,"")
;
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q 1
;
CONSLTN() ; EP from AMERREPT
; CONSULTANT CONSUTANT TIME CONSULTANT NAME ARRIVAL DATE/TIME PATIENT CNO
N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
;IHS/OIT/SCR 12/29/08 check selected records for PCC update
D SYNCHERS^AMERERS(AMERD1,AMERD2)
D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
D EN^DDIOL("End Date: "_AMERD2,"","?40")
S AMERHDR="ER VISITS BY ER CONSULTANT TYPE"
S FLDS="[AMER CONSULTANT PRINT]"
S BY="19,.01,'.01"
S FR="A,"_AMERD1X
S TO="Z,"_AMERD2X
S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
S L=0
S DIC="^AMERVSIT(",DIS(0)="I $P($G(^AMERVSIT(D0,0)),U,22)=1"
I '$D(POP) S POP=0
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
;
;AMER*3.0*5
D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Consultant Type Report from "_AMERD1_" to "_AMERD2,"")
;
D EN1^DIP
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q 1
TRANSTO() ;EP FROM AMERREPT
; TRANSFERED TO PATIENT ARRIVAL TIME CNO PRESENTING COMPLAINT TRIAGE CAT
N AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE,AMERD1X,AMERD2X
S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2)=""
I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
;IHS/OIT/SCR 12/29/08 check selected records for PCC update
D SYNCHERS^AMERERS(AMERD1,AMERD2)
D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
D EN^DDIOL("End Date: "_AMERD2,"","?40")
S AMERHDR="TRANSFERRED TO OTHER FACILITIES"
S FLDS="!.02;C1;L30,.13;""CNO"";C32;L10,.01;C44;L15,.24;""TRIAG CAT"";C63"
S FLDS=FLDS_",1;C5;L240;W75"
S BY="6.6;""TRANSFERED TO: "",.02,.01"
S FR(1)="A",FR(2)="@",FR(3)=AMERD1X
S TO(1)="Zz",TO(2)="Zz",TO(3)=AMERD2X
;S FR="A,@,"_AMERD1X
;S TO="Z,ZZZZZZZZ"_AMERD2X
S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
S L=0
S DIC="^AMERVSIT("
I '$D(POP) S POP=0
I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
D EN1^DIP
;
;AMER*3.0*5
D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Transferred to Other Facilities Report from "_AMERD1_" to "_AMERD2,"")
;
I $G(IOST)["C-" S DIR(0)="E" D ^DIR
Q 1
AMERREP2 ; IHS/OIT/SCR - SUB-ROUTINE FOR PREDEFINED REPORT INTERFACE;
+1 ;;3.0;ER VISIT SYSTEM;**1,5,8**;MAR 03, 2009;Build 23
+2 ;
AMBULAN() ; EP from AMERREPT
+1 ; AMBULANCE ARRIVAL PRESENTING TRIAGE
+2 ; NAME PATIENT CNO DATE TIME COMPLIANT CATEGORY
+3 NEW AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
+4 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+5 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+6 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+7 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+8 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+9 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+10 SET AMERHDR="ARRIVE TO ER BY AMBULANCE"
+11 SET FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
+12 SET FLDS=FLDS_",1;C5;L240;W75"
+13 SET BY=".25,+@.21;S1,.02,.01"
+14 SET FR="AMBULANCE,@,@,"_AMERD1X
+15 SET TO="AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
+16 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+17 SET L=0
+18 SET DIC="^AMERVSIT("
+19 IF '$DATA(POP)
SET POP=0
+20 ;AMER*3.0*8;Added 0 to the quit
+21 ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
+22 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+23 ;
+24 ;AMER*3.0*5
+25 DO LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive by Ambulance Report from "_AMERD1_" to "_AMERD2,"")
+26 ;
+27 DO EN1^DIP
+28 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+29 QUIT 1
+30 ;
AIRAMBU() ; EP from AMERREPT
+1 ; FLIGHT ARRIVAL PRESENTING TRIAGE
+2 ; SERVICE PATIENT CNO DATE TIME COMPLIANT CATEGORY
+3 NEW AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
+4 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+5 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+6 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+7 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+8 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+9 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+10 SET AMERHDR="ARRIVE TO ER BY AIR AMBULANCE"
+11 SET FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
+12 SET FLDS=FLDS_",1;C5;L240;W75"
+13 SET BY=".25,+@.21;S1,.02,.01"
+14 SET FR="AIR AMBULANCE,@,@,"_AMERD1X
+15 SET TO="AIR AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
+16 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+17 SET L=0
+18 SET DIC="^AMERVSIT("
+19 IF '$DATA(POP)
SET POP=0
+20 ;AMER*3.0*8;Added 0 to the quit
+21 ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
+22 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+23 DO EN1^DIP
+24 ;
+25 ;AMER*3.0*5
+26 DO LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive to ER by Air Ambulance Report from "_AMERD1_" to "_AMERD2,"")
+27 ;
+28 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+29 QUIT 1
+30 ;
CONSLTN() ; EP from AMERREPT
+1 ; CONSULTANT CONSUTANT TIME CONSULTANT NAME ARRIVAL DATE/TIME PATIENT CNO
+2 NEW AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
+3 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+4 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+5 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+6 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+7 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+8 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+9 SET AMERHDR="ER VISITS BY ER CONSULTANT TYPE"
+10 SET FLDS="[AMER CONSULTANT PRINT]"
+11 SET BY="19,.01,'.01"
+12 SET FR="A,"_AMERD1X
+13 SET TO="Z,"_AMERD2X
+14 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+15 SET L=0
+16 SET DIC="^AMERVSIT("
SET DIS(0)="I $P($G(^AMERVSIT(D0,0)),U,22)=1"
+17 IF '$DATA(POP)
SET POP=0
+18 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+19 ;
+20 ;AMER*3.0*5
+21 DO LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Consultant Type Report from "_AMERD1_" to "_AMERD2,"")
+22 ;
+23 DO EN1^DIP
+24 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+25 QUIT 1
TRANSTO() ;EP FROM AMERREPT
+1 ; TRANSFERED TO PATIENT ARRIVAL TIME CNO PRESENTING COMPLAINT TRIAGE CAT
+2 NEW AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE,AMERD1X,AMERD2X
+3 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2)=""
+4 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+5 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+6 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+7 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+8 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+9 SET AMERHDR="TRANSFERRED TO OTHER FACILITIES"
+10 SET FLDS="!.02;C1;L30,.13;""CNO"";C32;L10,.01;C44;L15,.24;""TRIAG CAT"";C63"
+11 SET FLDS=FLDS_",1;C5;L240;W75"
+12 SET BY="6.6;""TRANSFERED TO: "",.02,.01"
+13 SET FR(1)="A"
SET FR(2)="@"
SET FR(3)=AMERD1X
+14 SET TO(1)="Zz"
SET TO(2)="Zz"
SET TO(3)=AMERD2X
+15 ;S FR="A,@,"_AMERD1X
+16 ;S TO="Z,ZZZZZZZZ"_AMERD2X
+17 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+18 SET L=0
+19 SET DIC="^AMERVSIT("
+20 IF '$DATA(POP)
SET POP=0
+21 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+22 DO EN1^DIP
+23 ;
+24 ;AMER*3.0*5
+25 DO LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Transferred to Other Facilities Report from "_AMERD1_" to "_AMERD2,"")
+26 ;
+27 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+28 QUIT 1
