AMERREP1.m

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