ECRECER.m

ECRECER ;ALB/DAN-Event Capture Encounter Report ;Nov 04, 2020@22:42:04

 ;;2.0;EVENT CAPTURE;**112,122,126,139,145,152**;8 May 96;Build 19

 ;

STRPT ;

 K ^TMP("ECRECER",$J),^TMP($J,"ECRPT")

 D GETREC

 I ECPTYP="E" D EXPORT Q

 U IO

 D PRINT

 Q

 ;

GETREC ;Find records to put on report

 N ECLI,ECDFN,ECD,ECDT,ECIEN,ECPROV,ECPATN,ECSSN,ECVOL,ECARR,ECIO,CLNODE ;122,126

 N ECLINM ;152

 S ECLI=0 F  S ECLI=$O(ECLOC1(ECLI)) Q:'+ECLI  D

 .S ECDFN=0 K ^TMP("UNI",$J) ;126

 .F  S ECDFN=+$O(^ECH("ADT",ECLI,ECDFN)) Q:'ECDFN  D

 ..S ECD=0

 ..F  S ECD=$O(ECDSSU(ECD)) Q:'ECD  D

 ...S ECDT=ECSD-.1

 ...F  S ECDT=+$O(^ECH("ADT",ECLI,ECDFN,ECD,ECDT)) Q:'ECDT!(ECDT>(ECED_.24))  D

 ....S ECIEN=0,ECVOL=0 ;145 Reset volume total

 ....F  S ECIEN=+$O(^ECH("ADT",ECLI,ECDFN,ECD,ECDT,ECIEN)) Q:'ECIEN  D

 .....I '+$G(^TMP("UNI",$J,ECDFN,ECDT,ECD)) S ^TMP("UNI",$J,ECDFN,ECDT,ECD)=ECIEN ;145 Store 1st IEN in this group

 .....S ECVOL=ECVOL+$$GET1^DIQ(721,ECIEN,9) ;145 add to total procedure volume

 ....S ECIEN=^TMP("UNI",$J,ECDFN,ECDT,ECD) ;145 Retrieve 1st record in group

 ....S ECPROV=$$GETPROV^ECRDSSA(ECIEN)

 ....K ECARR D GETS^DIQ(721,ECIEN,"1;26;29","IE","ECARR","ECERROR") ;122,145

 ....S ECIO=ECARR(721,ECIEN_",",29,"I")

 ....S ECPATN=ECARR(721,ECIEN_",",1,"E")_"~"_ECDFN

 ....S ECSSN=$$GETSSN^ECRDSSA(ECIEN)

 ....S CLNODE=$G(^ECX(728.44,+$G(ECARR(721,ECIEN_",",26,"I")),0)) ;122

 ....I ECSORT="C" S ECLINM=$S(ECARR(721,ECIEN_",",26,"E")'="":ECARR(721,ECIEN_",",26,"E"),1:"UNKNOWN") ;152 - Add Clinic to sort criteria

 ....I $G(ECSORT)="P" D

 .....S ^TMP("ECRECER",$J,ECLOC1(ECLI),ECPATN,ECPROV,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$G(ECARR(721,ECIEN_",",26,"E"))_U_$P(CLNODE,U,2)_U_$P(CLNODE,U,3)_U_$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U)_U_$P(CLNODE,U,14) ;122,139

 ....I $G(ECSORT)="D" D

 .....S ^TMP("ECRECER",$J,ECLOC1(ECLI),ECPROV,ECPATN,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$G(ECARR(721,ECIEN_",",26,"E"))_U_$P(CLNODE,U,2)_U_$P(CLNODE,U,3)_U_$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U)_U_$P(CLNODE,U,14) ;122,139

 ....I $G(ECSORT)="C" D  ;152 - Add Clinic to sort criteria

 .....S ^TMP("ECRECER",$J,ECLOC1(ECLI),ECLINM,ECPROV,ECPATN,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$G(ECARR(721,ECIEN_",",26,"E"))_U_$P(CLNODE,U,2)_U_$P(CLNODE,U,3)_U_$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U)_U_$P(CLNODE,U,14)

 Q

 ;

EXPORT ;Put in delimited format for exporting

 N CNT,LOC,PATN,PROV,IEN,DATA,MCA ;139

 N CLINIC ;152

 Q:'$D(^TMP("ECRECER",$J))

 S CNT=1,^TMP($J,"ECRPT",CNT)="LOCATION^PATIENT^SSN^I/O^DATE/TIME^PRIMARY PROVIDER^DSS UNIT^TOTAL PROCEDURE VOLUME^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE" ;122,139,145,152 - Update orivider column header

 I ECSORT="P" D

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D

 ..S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,PATN)) Q:PATN=""  D

 ...S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,PATN,PROV)) Q:PROV=""  D

 ....S IEN=0 F  S IEN=$O(^TMP("ECRECER",$J,LOC,PATN,PROV,IEN)) Q:'+IEN  D

 .....S DATA=^(IEN) ;Naked reference to above line

 .....S MCA=$$GET1^DIQ(728.442,$P(DATA,U,10),.01) ;139

 .....S CNT=CNT+1 ;139

 .....S ^TMP($J,"ECRPT",CNT)=LOC_U_$P(PATN,"~")_U_$P(DATA,U,5)_U_$P(DATA,U,1)_U_$$FMTE^XLFDT($P(DATA,U,2),2)_U_PROV_U_ECDSSU($P(DATA,U,3))_U_$P(DATA,U,4)_U_$P(DATA,U,6)_U_$P(DATA,U,7)_U_$P(DATA,U,8)_U_$P(DATA,U,9)_U_MCA ;122,139

 I ECSORT="D" D

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D

 ..S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,PROV)) Q:PROV=""  D

 ...S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,PROV,PATN)) Q:PATN=""  D

 ....S IEN=0 F  S IEN=$O(^TMP("ECRECER",$J,LOC,PROV,PATN,IEN)) Q:'+IEN  D

 .....S DATA=^(IEN) ;Naked reference to above line

 .....S MCA=$$GET1^DIQ(728.442,$P(DATA,U,10),.01) ;139

 .....S CNT=CNT+1 ;139

 .....S ^TMP($J,"ECRPT",CNT)=LOC_U_$P(PATN,"~")_U_$P(DATA,U,5)_U_$P(DATA,U,1)_U_$$FMTE^XLFDT($P(DATA,U,2),2)_U_PROV_U_ECDSSU($P(DATA,U,3))_U_$P(DATA,U,4)_U_$P(DATA,U,6)_U_$P(DATA,U,7)_U_$P(DATA,U,8)_U_$P(DATA,U,9)_U_MCA ;122,139

 I ECSORT="C" D  ;152

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D

 ..S CLINIC="" F  S CLINIC=$O(^TMP("ECRECER",$J,LOC,CLINIC)) Q:CLINIC=""  D

 ...S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,CLINIC,PROV)) Q:PROV=""  D

 ....S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,CLINIC,PROV,PATN)) Q:PATN=""  D

 .....S IEN="" F  S IEN=$O(^TMP("ECRECER",$J,LOC,CLINIC,PROV,PATN,IEN)) Q:IEN=""  D

 ......S DATA=^(IEN) ;Naked reference to above line

 ......S MCA=$$GET1^DIQ(728.442,$P(DATA,U,10),.01)

 ......S CNT=CNT+1

 ......S ^TMP($J,"ECRPT",CNT)=LOC_U_$P(PATN,"~")_U_$P(DATA,U,5)_U_$P(DATA,U,1)_U_$$FMTE^XLFDT($P(DATA,U,2),2)_U_PROV_U_ECDSSU($P(DATA,U,3))_U_$P(DATA,U,4)_U_$P(DATA,U,6)_U_$P(DATA,U,7)_U_$P(DATA,U,8)_U_$P(DATA,U,9)_U_MCA

 Q

 ;

PRINT ;Display results

 N LOC,PATN,PROV,IEN,DATA,PAGE,PTOT,PROTOT

 N CLIN,CLINTOT ;152

 I '$D(^TMP("ECRECER",$J)) S LOC=$S($G(ECL0)="ALL":ECL0,1:ECLOC1(ECL0)) D HDR W !,"No Data found" Q  ;152 - Added location name or "ALL" on  line 2 when report has no data

 S PAGE=0

 I ECSORT="P" D

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D HDR D

 ..S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,PATN)) Q:PATN=""  K PTOT,PROTOT D  D SUB

 ...S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,PATN,PROV)) Q:PROV=""  D

 ....S IEN=0 F  S IEN=$O(^TMP("ECRECER",$J,LOC,PATN,PROV,IEN)) Q:'+IEN  D

 .....S DATA=^(IEN) ;Naked reference to above line

 .....D WRTLN ;152 - Added this tag to write out the report lines

 .....S PTOT=+$G(PTOT)+1,PROTOT(PROV)=+$G(PROTOT(PROV))+1

 I ECSORT="D" D

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D HDR D

 ..S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,PROV)) Q:PROV=""  K PROTOT,PTOT D  D SUB

 ...S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,PROV,PATN)) Q:PATN=""  D

 ....S IEN=0 F  S IEN=$O(^TMP("ECRECER",$J,LOC,PROV,PATN,IEN)) Q:'+IEN  D

 .....S DATA=^(IEN) ;Naked reference to above line

 .....D WRTLN ;152 - Added this tag to write out the report lines

 .....S PTOT(PATN)=+$G(PTOT(PATN))+1,PROTOT=+$G(PROTOT)+1

 I ECSORT="C" D  ;152 - sorted by Clinic, track the total by patient, by provider and by clinic

 .S LOC="" F  S LOC=$O(^TMP("ECRECER",$J,LOC)) Q:LOC=""  D HDR D

 ..S CLIN="" F  S CLIN=$O(^TMP("ECRECER",$J,LOC,CLIN)) Q:CLIN=""  K PTOT,PROTOT,CLINTOT D  D SUB

 ...S PROV="" F  S PROV=$O(^TMP("ECRECER",$J,LOC,CLIN,PROV)) Q:PROV=""  D

 ....S PATN="" F  S PATN=$O(^TMP("ECRECER",$J,LOC,CLIN,PROV,PATN)) Q:PATN=""  D

 .....S IEN=0 F  S IEN=$O(^TMP("ECRECER",$J,LOC,CLIN,PROV,PATN,IEN)) Q:IEN=""  S DATA=^(IEN) D

 .....D WRTLN

 .....S PTOT(PATN)=$G(PTOT(PATN))+1,PROTOT(PROV)=$G(PROTOT(PROV))+1,CLINTOT=$G(CLINTOT)+1

 Q

WRTLN ;Write report line

 W !,$P(PATN,"~"),?32,$P(DATA,U,5),?38,$P(DATA,U,1),?43,$$FMTE^XLFDT($P(DATA,U,2),2),?59,PROV,?91,ECDSSU($P(DATA,U,3)),?123,$P(DATA,U,4)

 W !,?4,$P(DATA,U,6),?36,$P(DATA,U,7),?47,$P(DATA,U,8),?60,$P(DATA,U,9),?68,$$GET1^DIQ(728.442,$P(DATA,U,10),.01) ;122,139

 Q

HDR ;Print Header

 N SORT

 W @IOF

 S PAGE=+$G(PAGE)+1

 W ?51,"Event Capture Encounters Report",?123,"Page: ",PAGE

 W !,?(132-(12+$L(LOC))\2),$S(LOC="ALL":"For ALL Locations",1:"For Location "_LOC) ;152

 W !,?47,"From ",$$FMTE^XLFDT(ECSD)," through ",$$FMTE^XLFDT(ECED)

 S SORT=$S(ECSORT="P":"Patient Name",ECSORT="D":"Provider",1:"Clinic") ;152 Added Clinic

 W !,?(132-(9+$L(SORT))\2),"Sorted by ",SORT,!

 W !,"Patient",?32,"SSN",?38,"I/O",?43,"Date/Time",?59," Primary Provider",?91,"DSS Unit",?123,"Total" ;145,152 - Update provider header

 W !,?4,"Clinic",?36,"Stop Code",?47,"Credit Stop",?60,"CHAR4",?68,"MCA Labor Code",?123,"Proc Vol" ;122,139,145

 W !,$$REPEAT^XLFSTR("-",132)

 Q

SUB ;Print totals

 N ARR,DISP

 I ECSORT="P" D

 .W !

 .S ARR="" F  S ARR=$O(PROTOT(ARR)) Q:ARR=""  S DISP="Encounter subtotal for provider "_ARR W !,$J(DISP,128),$J(PROTOT(ARR),4) ;145

 .W !,?128,"===="

 .S DISP="Encounter total for patient "_$P(PATN,"~") W !,$J(DISP,128),$J(PTOT,4),! ;145

 I ECSORT="D" D

 .W !

 .S ARR="" F  S ARR=$O(PTOT(ARR)) Q:ARR=""  S DISP="Encounter subtotal for patient "_$P(ARR,"~") W !,$J(DISP,128),$J(PTOT(ARR),4) ;145

 .W !,?128,"===="

 .S DISP="Encounter total for provider "_PROV W !,$J(DISP,128),$J(PROTOT,4),! ;145

  I ECSORT="C" D  ;152

 .W !

 .S ARR="" F  S ARR=$O(PTOT(ARR)) Q:ARR=""  S DISP="Encounter subtotal for patient "_$P(ARR,"~") W !,$J(DISP,128),$J(PTOT(ARR),4)

 .W !,?128,"===="

 .F  S ARR=$O(PROTOT(ARR)) Q:ARR=""  S DISP="Encounter subtotal for provider "_ARR W !,$J(DISP,128),$J(PROTOT(ARR),4)

 .W !,?128,"===="

 .S DISP="Encounter total for Clinic "_CLIN W !,$J(DISP,128),$J(CLINTOT,4),!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECRECER   8643     printed  Mar 13, 2025@21:03:25                                                                                                                                                                                                     Page 2

ECRECER   ;ALB/DAN-Event Capture Encounter Report ;Nov 04, 2020@22:42:04

 +1       ;;2.0;EVENT CAPTURE;**112,122,126,139,145,152**;8 May 96;Build 19

 +2       ;

STRPT     ;

 +1        KILL ^TMP("ECRECER",$JOB),^TMP($JOB,"ECRPT")

 +2        DO GETREC

 +3        IF ECPTYP="E"

               DO EXPORT

               QUIT 

 +4        USE IO

 +5        DO PRINT

 +6        QUIT 

 +7       ;

GETREC    ;Find records to put on report

 +1       ;122,126

           NEW ECLI,ECDFN,ECD,ECDT,ECIEN,ECPROV,ECPATN,ECSSN,ECVOL,ECARR,ECIO,CLNODE

 +2       ;152

           NEW ECLINM

 +3        SET ECLI=0

           FOR 

               SET ECLI=$ORDER(ECLOC1(ECLI))

               if '+ECLI

                   QUIT 

               Begin DoDot:1

 +4       ;126

                   SET ECDFN=0

                   KILL ^TMP("UNI",$JOB)

 +5                FOR 

                       SET ECDFN=+$ORDER(^ECH("ADT",ECLI,ECDFN))

                       if 'ECDFN

                           QUIT 

                       Begin DoDot:2

 +6                        SET ECD=0

 +7                        FOR 

                               SET ECD=$ORDER(ECDSSU(ECD))

                               if 'ECD

                                   QUIT 

                               Begin DoDot:3

 +8                                SET ECDT=ECSD-.1

 +9                                FOR 

                                       SET ECDT=+$ORDER(^ECH("ADT",ECLI,ECDFN,ECD,ECDT))

                                       if 'ECDT!(ECDT>(ECED_.24))

                                           QUIT 

                                       Begin DoDot:4

 +10      ;145 Reset volume total

                                           SET ECIEN=0

                                           SET ECVOL=0

 +11                                       FOR 

                                               SET ECIEN=+$ORDER(^ECH("ADT",ECLI,ECDFN,ECD,ECDT,ECIEN))

                                               if 'ECIEN

                                                   QUIT 

                                               Begin DoDot:5

 +12      ;145 Store 1st IEN in this group

                                                   IF '+$GET(^TMP("UNI",$JOB,ECDFN,ECDT,ECD))

                                                       SET ^TMP("UNI",$JOB,ECDFN,ECDT,ECD)=ECIEN

 +13      ;145 add to total procedure volume

                                                   SET ECVOL=ECVOL+$$GET1^DIQ(721,ECIEN,9)

                                               End DoDot:5

 +14      ;145 Retrieve 1st record in group

                                           SET ECIEN=^TMP("UNI",$JOB,ECDFN,ECDT,ECD)

 +15                                       SET ECPROV=$$GETPROV^ECRDSSA(ECIEN)

 +16      ;122,145

                                           KILL ECARR

                                           DO GETS^DIQ(721,ECIEN,"1;26;29","IE","ECARR","ECERROR")

 +17                                       SET ECIO=ECARR(721,ECIEN_",",29,"I")

 +18                                       SET ECPATN=ECARR(721,ECIEN_",",1,"E")_"~"_ECDFN

 +19                                       SET ECSSN=$$GETSSN^ECRDSSA(ECIEN)

 +20      ;122

                                           SET CLNODE=$GET(^ECX(728.44,+$GET(ECARR(721,ECIEN_",",26,"I")),0))

 +21      ;152 - Add Clinic to sort criteria

                                           IF ECSORT="C"

                                               SET ECLINM=$SELECT(ECARR(721,ECIEN_",",26,"E")'="":ECARR(721,ECIEN_",",26,"E"),1:"UNKNOWN")

 +22                                       IF $GET(ECSORT)="P"

                                               Begin DoDot:5

 +23      ;122,139

                                                   SET ^TMP("ECRECER",$JOB,ECLOC1(ECLI),ECPATN,ECPROV,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$GET(ECARR(721,ECIEN_",",26,"E"))_U_$PIECE(CLNODE,U,2)_U_$PIECE(CLNODE,U,3)_U_$PIECE($GET(^ECX(728.441,+$PIECE

(CLNODE,U,8),0)),U)_U_$PIECE(CLNODE,U,14)

                                               End DoDot:5

 +24                                       IF $GET(ECSORT)="D"

                                               Begin DoDot:5

 +25      ;122,139

                                                   SET ^TMP("ECRECER",$JOB,ECLOC1(ECLI),ECPROV,ECPATN,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$GET(ECARR(721,ECIEN_",",26,"E"))_U_$PIECE(CLNODE,U,2)_U_$PIECE(CLNODE,U,3)_U_$PIECE($GET(^ECX(728.441,+$PIECE

(CLNODE,U,8),0)),U)_U_$PIECE(CLNODE,U,14)

                                               End DoDot:5

 +26      ;152 - Add Clinic to sort criteria

                                           IF $GET(ECSORT)="C"

                                               Begin DoDot:5

 +27                                               SET ^TMP("ECRECER",$JOB,ECLOC1(ECLI),ECLINM,ECPROV,ECPATN,ECIEN)=ECIO_U_ECDT_U_ECD_U_ECVOL_U_ECSSN_U_$GET(ECARR(721,ECIEN_",",26,"E"))_U_$PIECE(CLNODE,U,2)_U_$PIECE(CLNODE,U,3)_U_$PIECE($GET(^ECX(728.441,

+$PIECE(CLNODE,U,8),0)),U)_U_$PIECE(CLNODE,U,14)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +28       QUIT 

 +29      ;

EXPORT    ;Put in delimited format for exporting

 +1       ;139

           NEW CNT,LOC,PATN,PROV,IEN,DATA,MCA

 +2       ;152

           NEW CLINIC

 +3        if '$DATA(^TMP("ECRECER",$JOB))

               QUIT 

 +4       ;122,139,145,152 - Update orivider column header

           SET CNT=1

           SET ^TMP($JOB,"ECRPT",CNT)="LOCATION^PATIENT^SSN^I/O^DATE/TIME^PRIMARY PROVIDER^DSS UNIT^TOTAL PROCEDURE VOLUME^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE"

 +5        IF ECSORT="P"

               Begin DoDot:1

 +6                SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET PATN=""

                           FOR 

                               SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN))

                               if PATN=""

                                   QUIT 

                               Begin DoDot:3

 +8                                SET PROV=""

                                   FOR 

                                       SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN,PROV))

                                       if PROV=""

                                           QUIT 

                                       Begin DoDot:4

 +9                                        SET IEN=0

                                           FOR 

                                               SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN,PROV,IEN))

                                               if '+IEN

                                                   QUIT 

                                               Begin DoDot:5

 +10      ;Naked reference to above line

                                                   SET DATA=^(IEN)

 +11      ;139

                                                   SET MCA=$$GET1^DIQ(728.442,$PIECE(DATA,U,10),.01)

 +12      ;139

                                                   SET CNT=CNT+1

 +13      ;122,139

                                                  SET ^TMP($JOB,"ECRPT",CNT)=LOC_U_$PIECE(PATN,"~")_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,1)_U_$$FMTE^XLFDT($PIECE(DATA,U,2),2)_U_PROV_U_ECDSSU($PIECE(DATA,U,3))_U_$PIECE(DATA,U,4)_U_$PIECE(DATA,U,6)_U_$PIECE(D

ATA,U,7)_U_$PIECE(DATA,U,8)_U_...

                                                   ... $PIECE(DATA,U,9)_U_MCA

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       IF ECSORT="D"

               Begin DoDot:1

 +15               SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       Begin DoDot:2

 +16                       SET PROV=""

                           FOR 

                               SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV))

                               if PROV=""

                                   QUIT 

                               Begin DoDot:3

 +17                               SET PATN=""

                                   FOR 

                                       SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV,PATN))

                                       if PATN=""

                                           QUIT 

                                       Begin DoDot:4

 +18                                       SET IEN=0

                                           FOR 

                                               SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV,PATN,IEN))

                                               if '+IEN

                                                   QUIT 

                                               Begin DoDot:5

 +19      ;Naked reference to above line

                                                   SET DATA=^(IEN)

 +20      ;139

                                                   SET MCA=$$GET1^DIQ(728.442,$PIECE(DATA,U,10),.01)

 +21      ;139

                                                   SET CNT=CNT+1

 +22      ;122,139

                                                  SET ^TMP($JOB,"ECRPT",CNT)=LOC_U_$PIECE(PATN,"~")_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,1)_U_$$FMTE^XLFDT($PIECE(DATA,U,2),2)_U_PROV_U_ECDSSU($PIECE(DATA,U,3))_U_$PIECE(DATA,U,4)_U_$PIECE(DATA,U,6)_U_$PIECE(D

ATA,U,7)_U_$PIECE(DATA,U,8)_U_...

                                                   ... $PIECE(DATA,U,9)_U_MCA

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +23      ;152

           IF ECSORT="C"

               Begin DoDot:1

 +24               SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       Begin DoDot:2

 +25                       SET CLINIC=""

                           FOR 

                               SET CLINIC=$ORDER(^TMP("ECRECER",$JOB,LOC,CLINIC))

                               if CLINIC=""

                                   QUIT 

                               Begin DoDot:3

 +26                               SET PROV=""

                                   FOR 

                                       SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,CLINIC,PROV))

                                       if PROV=""

                                           QUIT 

                                       Begin DoDot:4

 +27                                       SET PATN=""

                                           FOR 

                                               SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,CLINIC,PROV,PATN))

                                               if PATN=""

                                                   QUIT 

                                               Begin DoDot:5

 +28                                               SET IEN=""

                                                   FOR 

                                                       SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,CLINIC,PROV,PATN,IEN))

                                                       if IEN=""

                                                           QUIT 

                                                       Begin DoDot:6

 +29      ;Naked reference to above line

                                                           SET DATA=^(IEN)

 +30                                                       SET MCA=$$GET1^DIQ(728.442,$PIECE(DATA,U,10),.01)

 +31                                                       SET CNT=CNT+1

 +32                                                      SET ^TMP($JOB,"ECRPT",CNT)=LOC_U_$PIECE(PATN,"~")_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,1)_U_$$FMTE^XLFDT($PIECE(DATA,U,2),2)_U_PROV_U_ECDSSU($PIECE(DATA,U,3))_U_$PIECE(DATA,U,4)_U_$PIECE(DATA,U,6)_U_

$PIECE(DATA,U,7)_U_$PIECE(DATA,U,8)_U_...

                                                           ... $PIECE(DATA,U,9)_U_MCA

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33       QUIT 

 +34      ;

PRINT     ;Display results

 +1        NEW LOC,PATN,PROV,IEN,DATA,PAGE,PTOT,PROTOT

 +2       ;152

           NEW CLIN,CLINTOT

 +3       ;152 - Added location name or "ALL" on  line 2 when report has no data

           IF '$DATA(^TMP("ECRECER",$JOB))

               SET LOC=$SELECT($GET(ECL0)="ALL":ECL0,1:ECLOC1(ECL0))

               DO HDR

               WRITE !,"No Data found"

               QUIT 

 +4        SET PAGE=0

 +5        IF ECSORT="P"

               Begin DoDot:1

 +6                SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       DO HDR

                       Begin DoDot:2

 +7                        SET PATN=""

                           FOR 

                               SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN))

                               if PATN=""

                                   QUIT 

                               KILL PTOT,PROTOT

                               Begin DoDot:3

 +8                                SET PROV=""

                                   FOR 

                                       SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN,PROV))

                                       if PROV=""

                                           QUIT 

                                       Begin DoDot:4

 +9                                        SET IEN=0

                                           FOR 

                                               SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,PATN,PROV,IEN))

                                               if '+IEN

                                                   QUIT 

                                               Begin DoDot:5

 +10      ;Naked reference to above line

                                                   SET DATA=^(IEN)

 +11      ;152 - Added this tag to write out the report lines

                                                   DO WRTLN

 +12                                               SET PTOT=+$GET(PTOT)+1

                                                   SET PROTOT(PROV)=+$GET(PROTOT(PROV))+1

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                               DO SUB

                       End DoDot:2

               End DoDot:1

 +13       IF ECSORT="D"

               Begin DoDot:1

 +14               SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       DO HDR

                       Begin DoDot:2

 +15                       SET PROV=""

                           FOR 

                               SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV))

                               if PROV=""

                                   QUIT 

                               KILL PROTOT,PTOT

                               Begin DoDot:3

 +16                               SET PATN=""

                                   FOR 

                                       SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV,PATN))

                                       if PATN=""

                                           QUIT 

                                       Begin DoDot:4

 +17                                       SET IEN=0

                                           FOR 

                                               SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,PROV,PATN,IEN))

                                               if '+IEN

                                                   QUIT 

                                               Begin DoDot:5

 +18      ;Naked reference to above line

                                                   SET DATA=^(IEN)

 +19      ;152 - Added this tag to write out the report lines

                                                   DO WRTLN

 +20                                               SET PTOT(PATN)=+$GET(PTOT(PATN))+1

                                                   SET PROTOT=+$GET(PROTOT)+1

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                               DO SUB

                       End DoDot:2

               End DoDot:1

 +21      ;152 - sorted by Clinic, track the total by patient, by provider and by clinic

           IF ECSORT="C"

               Begin DoDot:1

 +22               SET LOC=""

                   FOR 

                       SET LOC=$ORDER(^TMP("ECRECER",$JOB,LOC))

                       if LOC=""

                           QUIT 

                       DO HDR

                       Begin DoDot:2

 +23                       SET CLIN=""

                           FOR 

                               SET CLIN=$ORDER(^TMP("ECRECER",$JOB,LOC,CLIN))

                               if CLIN=""

                                   QUIT 

                               KILL PTOT,PROTOT,CLINTOT

                               Begin DoDot:3

 +24                               SET PROV=""

                                   FOR 

                                       SET PROV=$ORDER(^TMP("ECRECER",$JOB,LOC,CLIN,PROV))

                                       if PROV=""

                                           QUIT 

                                       Begin DoDot:4

 +25                                       SET PATN=""

                                           FOR 

                                               SET PATN=$ORDER(^TMP("ECRECER",$JOB,LOC,CLIN,PROV,PATN))

                                               if PATN=""

                                                   QUIT 

                                               Begin DoDot:5

 +26                                               SET IEN=0

                                                   FOR 

                                                       SET IEN=$ORDER(^TMP("ECRECER",$JOB,LOC,CLIN,PROV,PATN,IEN))

                                                       if IEN=""

                                                           QUIT 

                                                       SET DATA=^(IEN)

                                                       Begin DoDot:6

                                                       End DoDot:6

 +27                                               DO WRTLN

 +28                                               SET PTOT(PATN)=$GET(PTOT(PATN))+1

                                                   SET PROTOT(PROV)=$GET(PROTOT(PROV))+1

                                                   SET CLINTOT=$GET(CLINTOT)+1

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                               DO SUB

                       End DoDot:2

               End DoDot:1

 +29       QUIT 

WRTLN     ;Write report line

 +1        WRITE !,$PIECE(PATN,"~"),?32,$PIECE(DATA,U,5),?38,$PIECE(DATA,U,1),?43,$$FMTE^XLFDT($PIECE(DATA,U,2),2),?59,PROV,?91,ECDSSU($PIECE(DATA,U,3)),?123,$PIECE(DATA,U,4)

 +2       ;122,139

           WRITE !,?4,$PIECE(DATA,U,6),?36,$PIECE(DATA,U,7),?47,$PIECE(DATA,U,8),?60,$PIECE(DATA,U,9),?68,$$GET1^DIQ(728.442,$PIECE(DATA,U,10),.01)

 +3        QUIT 

HDR       ;Print Header

 +1        NEW SORT

 +2        WRITE @IOF

 +3        SET PAGE=+$GET(PAGE)+1

 +4        WRITE ?51,"Event Capture Encounters Report",?123,"Page: ",PAGE

 +5       ;152

           WRITE !,?(132-(12+$LENGTH(LOC))\2),$SELECT(LOC="ALL":"For ALL Locations",1:"For Location "_LOC)

 +6        WRITE !,?47,"From ",$$FMTE^XLFDT(ECSD)," through ",$$FMTE^XLFDT(ECED)