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

AMERREP1.m

Go to the documentation of this file.
AMERREP1 ; IHS/OIT/SCR - SUB-ROUTINE FOR PREDEFINED REPORT INTERFACE;
 ;;3.0;ER VISIT SYSTEM;**5,8**;MAR 03, 2009;Build 23
 ; 
TRIAGCAT() ; EP from AMERREPT
 N AMERX1,AMERX2,AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,DIC,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X
 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)
 S DIR(0)="SO^1:SORT BY TRIAGE CATEGORY;"
 S DIR(0)=DIR(0)_"2:SORT BY PATIENT LAST NAME;"
 S DIR(0)=DIR(0)_"3:SORT BY ADMIT TIME;"
 S DIR("A")="Select sort option",DIR("?")="Select one choice or '^' to leave."
 D ^DIR K DIR
 I Y=""!(Y="^") Q 0
 S AMERSORT=Y
 D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
 D EN^DDIOL("End Date: "_AMERD2,"","?40")
 D EN^DDIOL("Sort by: "_AMERSORT,"","!!")
 S L=0
 S FLDS=".24;""TRGE CAT"";C1;L10,.02;C12;L15,.13;""CNO"";C29;L10,.12;C41;L13,.01;""ARRIVAL TIME"";C57"
 S DIC="^AMERVSIT("
 ;
 ;AMER*3.0*5
 D LOG^AMERBUSA("P","P","AMERREP1","AMER: Printed ER Visit Triage Category Report from "_AMERD1_" to "_AMERD2,"")
 ;
 D:AMERSORT=1
 .S AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY CATEGORY"
 .S FLDS="!.24;""TRGE CAT"";C1;L10,.02;C12;L15,.13;""CNO"";C29;L10,.12;C41;L13,.01;""ARRIVAL TIME"";C57"
 .S BY="+@.24;2,@.01"
 .S FR="@,"_AMERD1X
 .S TO="5,"_AMERD2X
 .Q
 D:AMERSORT=2
 .S AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY PATIENT NAME"
 .S BY="@.02,'.01"
 .S FR="@,"_AMERD1X
 .S TO="Z,"_AMERD2X
 .Q
 D:AMERSORT=3
 .S AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY ARRIVAL TIME"
 .S BY="+@.01"
 .S FR=AMERD1X
 .S TO=AMERD2X
 .Q
 S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
 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
 S DIPCRIT=1  ; Print the sort criteria
 D EN1^DIP
 I $G(IOST)["C-" S DIR(0)="E" D ^DIR
 K AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,DIC,AMERCLMS,AMERCLM2
 Q 1
 ; 
TRIAGNRS() ; EP from AMERREPT
 N AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X
 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)
 S DIR(0)="SO^1:SORT BY TRIAGE NURSE;"
 S DIR(0)=DIR(0)_"2:SORT BY PATIENT LAST NAME;"
 S DIR(0)=DIR(0)_"3:SORT BY TRIAGE CATEGORY;"
 S DIR("A")="Select sort option",DIR("?")="Select one choice or '^' to leave."
 D ^DIR K DIR
 I Y=""!(Y="^") Q 0
 S AMERSORT=Y
 D EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
 D EN^DDIOL("End Date: "_AMERD2,"","?40")
 D EN^DDIOL("Sort by: "_AMERSORT,"","!!")
 S L=0
 S FLDS=".07;""TRGE NURSE"";C2;L15,.02;C20;L15,.13;""CNO"";C38;L10,.01;""ARRIVAL TIME"";C49;L15"
 S FLDS=FLDS_",1;C10;L240;W60,.24;""TRGE CAT"";C75"
 S DIC="^AMERVSIT("
 ;
 ;AMER*3.0*5
 D LOG^AMERBUSA("P","P","AMERREP1","AMER: Printed ER Visit Triage Nurse Report from "_AMERD1_" to "_AMERD2,"")
 ;
 D:AMERSORT=1
 .S AMERHDR="ER VISIT TRIAGE NURSE REPORT BY NURSE"
 .S FLDS=".02;C2;L15,.13;""CNO"";C18;L10,.01;""ARRIVAL TIME"";C29;L15"
 .S FLDS=FLDS_",1;C10;L240;W60,.24;""TRGE CAT"";C75"
 .S BY="+.07;S1,.02,'.01"
 .S FR="@,@,"_AMERD1X
 .S TO="Z,Z,"_AMERD2X
 .Q
 D:AMERSORT=2
 .S AMERHDR="ER VISIT TRIAGE NURSE REPORT BY PATIENT LAST NAME"
 .S BY="@.02,'.01"
 .S FR="@,"_AMERD1X
 .S TO="Z,"_AMERD2X
 .Q
 D:AMERSORT=3
 .S AMERHDR="ER VISIT TRIAGE NURSE REPORT BY TRIAGE CATEGORY"
 .S BY="@.24,'.01"
 .S FR="@,"_AMERD1X
 .S TO="5,"_AMERD2X
 .Q
 D:AMERSORT=4
 .S AMERHDR="ER VISIT TRIAGE NURSE REPORT BY ADMIT DATE"
 .S BY="@.01"
 .S FR=AMERD1X
 .S TO=AMERD2X
 .Q
 S DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
 I '$D(POP) S POP=0
 ;AMER*3.0*8;Added 0 to 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
 I $G(IOST)["C-" S DIR(0)="E" D ^DIR
 K AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2
 Q 1
 ; 
REFERALS() ; EP from AMERREPT
 N AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X,BY,DIC,DIR
 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 VISIT TRANSFERS FROM OUTSIDE FACILITIES"
 S FLDS="!17.2;""TRANSFERED FROM"";C1;L15;N,.02;C20;L15,17.3;C39;L15,.13;""CNO"";C65;L10"
 S FLDS=FLDS_",1;C5;L240;W50,.01;""ARRIVAL TIME"";C62;L15"
 S BY="+17.2;S1,.01"
 S FR="A,"_AMERD1X
 S TO="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 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","AMERREP1","AMER: Printed ER Visit Transfers From Outside Facilities Report from "_AMERD1_" to "_AMERD2,"")
 ;
 I $G(IOST)["C-" S DIR(0)="E" D ^DIR
 N AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2
 Q 1