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 ---[H[J[2J[HECRECER 8643 printed Apr 09, 2024@21:00:45 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)
+7 ;152 Added Clinic
SET SORT=$SELECT(ECSORT="P":"Patient Name",ECSORT="D":"Provider",1:"Clinic")
+8 WRITE !,?(132-(9+$LENGTH(SORT))\2),"Sorted by ",SORT,!
+9 ;145,152 - Update provider header
WRITE !,"Patient",?32,"SSN",?38,"I/O",?43,"Date/Time",?59," Primary Provider",?91,"DSS Unit",?123,"Total"
+10 ;122,139,145
WRITE !,?4,"Clinic",?36,"Stop Code",?47,"Credit Stop",?60,"CHAR4",?68,"MCA Labor Code",?123,"Proc Vol"
+11 WRITE !,$$REPEAT^XLFSTR("-",132)
+12 QUIT
SUB ;Print totals
+1 NEW ARR,DISP
+2 IF ECSORT="P"
Begin DoDot:1
+3 WRITE !
+4 ;145
SET ARR=""
FOR
SET ARR=$ORDER(PROTOT(ARR))
if ARR=""
QUIT
SET DISP="Encounter subtotal for provider "_ARR
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PROTOT(ARR),4)
+5 WRITE !,?128,"===="
+6 ;145
SET DISP="Encounter total for patient "_$PIECE(PATN,"~")
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PTOT,4),!
End DoDot:1
+7 IF ECSORT="D"
Begin DoDot:1
+8 WRITE !
+9 ;145
SET ARR=""
FOR
SET ARR=$ORDER(PTOT(ARR))
if ARR=""
QUIT
SET DISP="Encounter subtotal for patient "_$PIECE(ARR,"~")
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PTOT(ARR),4)
+10 WRITE !,?128,"===="
+11 ;145
SET DISP="Encounter total for provider "_PROV
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PROTOT,4),!
End DoDot:1
+12 ;152
IF ECSORT="C"
Begin DoDot:1
+13 WRITE !
+14 SET ARR=""
FOR
SET ARR=$ORDER(PTOT(ARR))
if ARR=""
QUIT
SET DISP="Encounter subtotal for patient "_$PIECE(ARR,"~")
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PTOT(ARR),4)
+15 WRITE !,?128,"===="
+16 FOR
SET ARR=$ORDER(PROTOT(ARR))
if ARR=""
QUIT
SET DISP="Encounter subtotal for provider "_ARR
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(PROTOT(ARR),4)
+17 WRITE !,?128,"===="
+18 SET DISP="Encounter total for Clinic "_CLIN
WRITE !,$JUSTIFY(DISP,128),$JUSTIFY(CLINTOT,4),!
End DoDot:1
+19 QUIT
