Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMERREP2

AMERREP2.m

Go to the documentation of this file.
  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
  1. ;
  1. AMBULAN() ; EP from AMERREPT
  1. ; AMBULANCE ARRIVAL PRESENTING TRIAGE
  1. ; NAME PATIENT CNO DATE TIME COMPLIANT CATEGORY
  1. N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
  1. S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
  1. I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
  1. ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
  1. D SYNCHERS^AMERERS(AMERD1,AMERD2)
  1. D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
  1. D EN^DDIOL("End Date: "_AMERD2,"","?40")
  1. S AMERHDR="ARRIVE TO ER BY AMBULANCE"
  1. S FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
  1. S FLDS=FLDS_",1;C5;L240;W75"
  1. S BY=".25,+@.21;S1,.02,.01"
  1. S FR="AMBULANCE,@,@,"_AMERD1X
  1. S TO="AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
  1. S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
  1. S L=0
  1. S DIC="^AMERVSIT("
  1. I '$D(POP) S POP=0
  1. ;AMER*3.0*8;Added 0 to the quit
  1. ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
  1. I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
  1. ;
  1. ;AMER*3.0*5
  1. D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive by Ambulance Report from "_AMERD1_" to "_AMERD2,"")
  1. ;
  1. D EN1^DIP
  1. I $G(IOST)["C-" S DIR(0)="E" D ^DIR
  1. Q 1
  1. ;
  1. AIRAMBU() ; EP from AMERREPT
  1. ; FLIGHT ARRIVAL PRESENTING TRIAGE
  1. ; SERVICE PATIENT CNO DATE TIME COMPLIANT CATEGORY
  1. N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
  1. S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
  1. I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
  1. ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
  1. D SYNCHERS^AMERERS(AMERD1,AMERD2)
  1. D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
  1. D EN^DDIOL("End Date: "_AMERD2,"","?40")
  1. S AMERHDR="ARRIVE TO ER BY AIR AMBULANCE"
  1. S FLDS="!.21;C1;L30;W15;N,.02;C17;L15,.13;""CNO"";C33;L10,.01;C45;L15,.24;""TRIAG CAT"";C69"
  1. S FLDS=FLDS_",1;C5;L240;W75"
  1. S BY=".25,+@.21;S1,.02,.01"
  1. S FR="AIR AMBULANCE,@,@,"_AMERD1X
  1. S TO="AIR AMBULANCE,ZZZZZZZZ,ZZZZZZZZ,"_AMERD2X
  1. S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
  1. S L=0
  1. S DIC="^AMERVSIT("
  1. I '$D(POP) S POP=0
  1. ;AMER*3.0*8;Added 0 to the quit
  1. ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
  1. I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
  1. D EN1^DIP
  1. ;
  1. ;AMER*3.0*5
  1. D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Arrive to ER by Air Ambulance Report from "_AMERD1_" to "_AMERD2,"")
  1. ;
  1. I $G(IOST)["C-" S DIR(0)="E" D ^DIR
  1. Q 1
  1. ;
  1. CONSLTN() ; EP from AMERREPT
  1. ; CONSULTANT CONSUTANT TIME CONSULTANT NAME ARRIVAL DATE/TIME PATIENT CNO
  1. N AMERD1,AMERD2,AMERD1X,AMERD2X,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE
  1. S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
  1. I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
  1. ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
  1. D SYNCHERS^AMERERS(AMERD1,AMERD2)
  1. D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
  1. D EN^DDIOL("End Date: "_AMERD2,"","?40")
  1. S AMERHDR="ER VISITS BY ER CONSULTANT TYPE"
  1. S FLDS="[AMER CONSULTANT PRINT]"
  1. S BY="19,.01,'.01"
  1. S FR="A,"_AMERD1X
  1. S TO="Z,"_AMERD2X
  1. S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
  1. S L=0
  1. S DIC="^AMERVSIT(",DIS(0)="I $P($G(^AMERVSIT(D0,0)),U,22)=1"
  1. I '$D(POP) S POP=0
  1. I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
  1. ;
  1. ;AMER*3.0*5
  1. D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Consultant Type Report from "_AMERD1_" to "_AMERD2,"")
  1. ;
  1. D EN1^DIP
  1. I $G(IOST)["C-" S DIR(0)="E" D ^DIR
  1. Q 1
  1. TRANSTO() ;EP FROM AMERREPT
  1. ; TRANSFERED TO PATIENT ARRIVAL TIME CNO PRESENTING COMPLAINT TRIAGE CAT
  1. N AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIC,DIR,AMERMODE,AMERD1X,AMERD2X
  1. S (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2)=""
  1. I '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X) D EN^DDIOL("Invalid Time","","!!,?20,!!") Q 0
  1. ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
  1. D SYNCHERS^AMERERS(AMERD1,AMERD2)
  1. D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
  1. D EN^DDIOL("End Date: "_AMERD2,"","?40")
  1. S AMERHDR="TRANSFERRED TO OTHER FACILITIES"
  1. S FLDS="!.02;C1;L30,.13;""CNO"";C32;L10,.01;C44;L15,.24;""TRIAG CAT"";C63"
  1. S FLDS=FLDS_",1;C5;L240;W75"
  1. S BY="6.6;""TRANSFERED TO: "",.02,.01"
  1. S FR(1)="A",FR(2)="@",FR(3)=AMERD1X
  1. S TO(1)="Zz",TO(2)="Zz",TO(3)=AMERD2X
  1. ;S FR="A,@,"_AMERD1X
  1. ;S TO="Z,ZZZZZZZZ"_AMERD2X
  1. S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
  1. S L=0
  1. S DIC="^AMERVSIT("
  1. I '$D(POP) S POP=0
  1. I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q 0
  1. D EN1^DIP
  1. ;
  1. ;AMER*3.0*5
  1. D LOG^AMERBUSA("P","P","AMERREP2","AMER: Printed ER Transferred to Other Facilities Report from "_AMERD1_" to "_AMERD2,"")
  1. ;
  1. I $G(IOST)["C-" S DIR(0)="E" D ^DIR
  1. Q 1