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
AMERREP1 ; IHS/OIT/SCR - SUB-ROUTINE FOR PREDEFINED REPORT INTERFACE;
+1 ;;3.0;ER VISIT SYSTEM;**5,8**;MAR 03, 2009;Build 23
+2 ;
TRIAGCAT() ; EP from AMERREPT
+1 NEW AMERX1,AMERX2,AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,DIC,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X
+2 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+3 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+4 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+5 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+6 SET DIR(0)="SO^1:SORT BY TRIAGE CATEGORY;"
+7 SET DIR(0)=DIR(0)_"2:SORT BY PATIENT LAST NAME;"
+8 SET DIR(0)=DIR(0)_"3:SORT BY ADMIT TIME;"
+9 SET DIR("A")="Select sort option"
SET DIR("?")="Select one choice or '^' to leave."
+10 DO ^DIR
KILL DIR
+11 IF Y=""!(Y="^")
QUIT 0
+12 SET AMERSORT=Y
+13 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+14 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+15 DO EN^DDIOL("Sort by: "_AMERSORT,"","!!")
+16 SET L=0
+17 SET FLDS=".24;""TRGE CAT"";C1;L10,.02;C12;L15,.13;""CNO"";C29;L10,.12;C41;L13,.01;""ARRIVAL TIME"";C57"
+18 SET DIC="^AMERVSIT("
+19 ;
+20 ;AMER*3.0*5
+21 DO LOG^AMERBUSA("P","P","AMERREP1","AMER: Printed ER Visit Triage Category Report from "_AMERD1_" to "_AMERD2,"")
+22 ;
+23 IF AMERSORT=1
Begin DoDot:1
+24 SET AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY CATEGORY"
+25 SET FLDS="!.24;""TRGE CAT"";C1;L10,.02;C12;L15,.13;""CNO"";C29;L10,.12;C41;L13,.01;""ARRIVAL TIME"";C57"
+26 SET BY="+@.24;2,@.01"
+27 SET FR="@,"_AMERD1X
+28 SET TO="5,"_AMERD2X
+29 QUIT
End DoDot:1
+30 IF AMERSORT=2
Begin DoDot:1
+31 SET AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY PATIENT NAME"
+32 SET BY="@.02,'.01"
+33 SET FR="@,"_AMERD1X
+34 SET TO="Z,"_AMERD2X
+35 QUIT
End DoDot:1
+36 IF AMERSORT=3
Begin DoDot:1
+37 SET AMERHDR="ER VISIT TRIAGE CATEGORY REPORT BY ARRIVAL TIME"
+38 SET BY="+@.01"
+39 SET FR=AMERD1X
+40 SET TO=AMERD2X
+41 QUIT
End DoDot:1
+42 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+43 IF '$DATA(POP)
SET POP=0
+44 ;AMER*3.0*8;Added 0 to the quit
+45 ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
+46 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+47 ; Print the sort criteria
SET DIPCRIT=1
+48 DO EN1^DIP
+49 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+50 KILL AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,DIC,AMERCLMS,AMERCLM2
+51 QUIT 1
+52 ;
TRIAGNRS() ; EP from AMERREPT
+1 NEW AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,DIR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X
+2 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+3 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+4 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+5 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+6 SET DIR(0)="SO^1:SORT BY TRIAGE NURSE;"
+7 SET DIR(0)=DIR(0)_"2:SORT BY PATIENT LAST NAME;"
+8 SET DIR(0)=DIR(0)_"3:SORT BY TRIAGE CATEGORY;"
+9 SET DIR("A")="Select sort option"
SET DIR("?")="Select one choice or '^' to leave."
+10 DO ^DIR
KILL DIR
+11 IF Y=""!(Y="^")
QUIT 0
+12 SET AMERSORT=Y
+13 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+14 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+15 DO EN^DDIOL("Sort by: "_AMERSORT,"","!!")
+16 SET L=0
+17 SET FLDS=".07;""TRGE NURSE"";C2;L15,.02;C20;L15,.13;""CNO"";C38;L10,.01;""ARRIVAL TIME"";C49;L15"
+18 SET FLDS=FLDS_",1;C10;L240;W60,.24;""TRGE CAT"";C75"
+19 SET DIC="^AMERVSIT("
+20 ;
+21 ;AMER*3.0*5
+22 DO LOG^AMERBUSA("P","P","AMERREP1","AMER: Printed ER Visit Triage Nurse Report from "_AMERD1_" to "_AMERD2,"")
+23 ;
+24 IF AMERSORT=1
Begin DoDot:1
+25 SET AMERHDR="ER VISIT TRIAGE NURSE REPORT BY NURSE"
+26 SET FLDS=".02;C2;L15,.13;""CNO"";C18;L10,.01;""ARRIVAL TIME"";C29;L15"
+27 SET FLDS=FLDS_",1;C10;L240;W60,.24;""TRGE CAT"";C75"
+28 SET BY="+.07;S1,.02,'.01"
+29 SET FR="@,@,"_AMERD1X
+30 SET TO="Z,Z,"_AMERD2X
+31 QUIT
End DoDot:1
+32 IF AMERSORT=2
Begin DoDot:1
+33 SET AMERHDR="ER VISIT TRIAGE NURSE REPORT BY PATIENT LAST NAME"
+34 SET BY="@.02,'.01"
+35 SET FR="@,"_AMERD1X
+36 SET TO="Z,"_AMERD2X
+37 QUIT
End DoDot:1
+38 IF AMERSORT=3
Begin DoDot:1
+39 SET AMERHDR="ER VISIT TRIAGE NURSE REPORT BY TRIAGE CATEGORY"
+40 SET BY="@.24,'.01"
+41 SET FR="@,"_AMERD1X
+42 SET TO="5,"_AMERD2X
+43 QUIT
End DoDot:1
+44 IF AMERSORT=4
Begin DoDot:1
+45 SET AMERHDR="ER VISIT TRIAGE NURSE REPORT BY ADMIT DATE"
+46 SET BY="@.01"
+47 SET FR=AMERD1X
+48 SET TO=AMERD2X
+49 QUIT
End DoDot:1
+50 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+51 IF '$DATA(POP)
SET POP=0
+52 ;AMER*3.0*8;Added 0 to quit
+53 ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
+54 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+55 DO EN1^DIP
+56 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+57 KILL AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2
+58 QUIT 1
+59 ;
REFERALS() ; EP from AMERREPT
+1 NEW AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X,BY,DIC,DIR
+2 SET (AMERD1,AMERD2,AMERHDR,AMERCLMS,AMERCLM2,AMERD1X,AMERD2X)=""
+3 IF '$$TIME^AMERREPT(.AMERD1,.AMERD2,.AMERD1X,.AMERD2X)
DO EN^DDIOL("Invalid Time","","!!,?20,!!")
QUIT 0
+4 ;IHS/OIT/SCR 12/29/08 check selected records for PCC update
+5 DO SYNCHERS^AMERERS(AMERD1,AMERD2)
+6 DO EN^DDIOL("Start Date: "_AMERD1,"","?10,!!")
+7 DO EN^DDIOL("End Date: "_AMERD2,"","?40")
+8 SET AMERHDR="ER VISIT TRANSFERS FROM OUTSIDE FACILITIES"
+9 SET FLDS="!17.2;""TRANSFERED FROM"";C1;L15;N,.02;C20;L15,17.3;C39;L15,.13;""CNO"";C65;L10"
+10 SET FLDS=FLDS_",1;C5;L240;W50,.01;""ARRIVAL TIME"";C62;L15"
+11 SET BY="+17.2;S1,.01"
+12 SET FR="A,"_AMERD1X
+13 SET TO="ZZZZZZZZ,"_AMERD2X
+14 SET DHD=$$AMERDHD^AMERREPT(AMERHDR,AMERD1,AMERD2)
+15 SET L=0
+16 SET DIC="^AMERVSIT("
+17 IF '$DATA(POP)
SET POP=0
+18 ;AMER*3.0*8;Added 0 to quit
+19 ;I ($D(DTOUT))!($D(DUOUT))!(POP)!($D(DIROUT)) K DIRUT,DTOUT,DUOUT,POP,DIROUT H 2 W @IOF Q
+20 IF ($DATA(DTOUT))!($DATA(DUOUT))!(POP)!($DATA(DIROUT))
KILL DIRUT,DTOUT,DUOUT,POP,DIROUT
HANG 2
WRITE @IOF
QUIT 0
+21 DO EN1^DIP
+22 ;
+23 ;AMER*3.0*5
+24 DO LOG^AMERBUSA("P","P","AMERREP1","AMER: Printed ER Visit Transfers From Outside Facilities Report from "_AMERD1_" to "_AMERD2,"")
+25 ;
+26 IF $GET(IOST)["C-"
SET DIR(0)="E"
DO ^DIR
+27 NEW AMERD1,AMERD2,AMERSORT,AMERHDR,FR,TO,BY,AMERCLMS,AMERCLM2
+28 QUIT 1