ECPAT ;BIR/MAM,JPW - Event Capture Patient Summary ;10/12/17 08:47
;;2.0;EVENT CAPTURE;**5,18,47,72,95,112,119,131,134,139**;8 May 96;Build 7
SET ; set ^TMP($J,"ECPAT")
N ECPXD,EC725
I $G(ECPTYP)'="E" I $Y+11>IOSL D PAGE I ECOUT Q ;119
S ECEC=$G(^ECH(ECFN,0))
S ECL=+$P(ECEC,"^",4),ECC=+$P(ECEC,"^",8),ECP=$P(ECEC,"^",9),ECD=+$P(ECEC,"^",7),ECV=+$P(ECEC,"^",10)
S ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN),ECUN=$S(ECU:"UNKNOWN",1:$P(ECUN,"^",2))
Q:ECP']""
;set default med spec and ord sect to administrative if blank
S ECM=$S($P(ECEC,"^",6)]"":+$P(ECEC,"^",6),1:108),ECO=$S($P(ECEC,"^",12)]"":+$P(ECEC,"^",12),1:108)
S ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECON=$S($P($G(^ECC(723,ECO,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECS=+$P(ECEC,"^",5),ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECCN=$S($P($G(^EC(726,ECC,0)),"^")]"":$P(^(0),"^"),1:"None")
S ECPSY=+$O(^ECJ("AP",ECL,ECD,ECC,ECP,""))
S ECPSYN=$P($G(^ECJ(ECPSY,"PRO")),"^",2)
S ECFILE=$P(ECP,";",2),ECFILE=$S($E(ECFILE)="I":81,1:725)
S ECCPT=$S(ECFILE=81:+ECP,1:$P($G(^EC(725,+ECP,0)),"^",5)),ECPXD=""
I ECCPT'="" D
. S ECPXD=$$CPT^ICPTCOD(ECCPT,$P(ECEC,"^",3)),ECCPT=$P(ECPXD,"^",2)
. I ECCPT'="" S ECCPT=ECCPT_" "
I ECFILE=81 S ECPN=$S($P(ECPXD,"^",3)]"":$P(ECPXD,"^",3),1:"UNKNOWN")
I ECFILE=725 D
.S EC725=$G(^EC(725,+ECP,0)),ECPN=$P(EC725,"^",2)_" "_$P(EC725,"^")
S ECEPN=$S(ECFILE=81:ECPN,1:$P(EC725,U))_$S(ECPSYN]"":" ["_ECPSYN_"] ",1:"") ;119 Set export version of procedure name
S ECPN=$J(ECCPT,6)_$E(ECPN,1,38)_$S(ECPSYN]"":" ["_ECPSYN_"] ",1:"")
S ECDN=$S($P($G(^ECD(ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECLN=$S($P($G(^DIC(4,ECL,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECUN=$S(ECUN'="UNKNOWN":$P(ECUN,",",2)_" "_$P(ECUN,","),1:"UNKNOWN")
S ECDT=$$FMTE^XLFDT(DATE)
;
;ALB/ESD - Add Procedure Reason to report
N ECLNK,ECRAR ;112,119
D GETS^DIQ(721,ECFN,"26;34;43;44","IE","ECRAR") ;112,134 Get associated clinics and reasons
S ECPRSN=$G(ECRAR(721,ECFN_",",34,"E")) S:ECPRSN="" ECPRSN="REASON NOT DEFINED" ;112,134
S ECPRSN2=$G(ECRAR(721,ECFN_",",43,"E")) ;112,134
S ECPRSN3=$G(ECRAR(721,ECFN_",",44,"E")) ;112,134
S ECACLN=$G(ECRAR(721,ECFN_",",26,"E")) ;134
S CLNODE=$G(^ECX(728.44,+$G(ECRAR(721,ECFN_",",26,"I")),0)) ;134
;
;Get Procedure CPT modifiers
I $G(ECPTYP)="E" Q ;119 Don't need modifiers for exportable version
S ECMODF=0 K ECMOD
I $O(^ECH(ECFN,"MOD",0))'="" S ECMODF=$$MOD^ECUTL(ECFN,"E",.ECMOD)
I $D(ECY) DO
.W !!,ECDT,?32,ECCN,?87,ECPN_" ("_ECV_")",! ;112
.I ECMODF S MD="" D K MD I ECOUT Q
..F S MD=$O(ECMOD(MD)) Q:MD="" D I ECOUT Q
...D:$Y+5>IOSL PAGE Q:ECOUT W ?91,"- ",MD," ",$P(ECMOD(MD),U,3),! ;112
.W $E(ECLN,1,22),?32,ECDN_" ("_ECD_")",!,?32,ECSN,?87,ECMN,! ;112,131
.I '$D(ECRY) W ?32,ECON,?87,ECUN ;119
.I $D(ECRY) D ;112
..W ECPRSN,?32,ECON,?87,ECUN ;112
..I $G(ECPRSN2)'="" W !,ECPRSN2 ;112
..I $G(ECPRSN3)'="" W !,ECPRSN3 ;112
I $D(ECN) DO
.W !!,ECDT,?32,ECPN_" ("_ECV_")",! ;112
.I ECMODF S MD="" D K MD I ECOUT Q
..F S MD=$O(ECMOD(MD)) Q:MD="" D I ECOUT Q
...D:$Y+5>IOSL PAGE Q:ECOUT W ?36,"- ",MD," ",$P(ECMOD(MD),U,3),! ;112
.W $E(ECLN,1,22),?32,ECDN_" ("_ECD_")",!,?32,ECACLN,?64,$P(CLNODE,U,2),?70,$P(CLNODE,U,3),?78,$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U) ;139
.W ?85,$$GET1^DIQ(728.442,$P(CLNODE,U,14),.01),!?32,ECSN,?94,ECMN,! ;139
.I '$D(ECRY) W ?32,ECON,?94,ECUN ;119,139
.I $D(ECRY) D ;112
..W ECPRSN,?32,ECON,?94,ECUN ;112,139
..I $G(ECPRSN2)'="" W !,ECPRSN2 ;112
..I $G(ECPRSN3)'="" W !,ECPRSN3 ;112
Q
PAT ; entry point
K DIC S DIC=2,DIC(0)="QEAMZ",DIC("A")="Select Patient: " D ^DIC K DIC G:Y<0 END S ECDFN=+Y,ECPAT=$P(Y,"^",2)
DATE K %DT S %DT="AEX",%DT("A")="Start with Date: " D ^%DT G:Y<0 END S ECSD=Y,%DT("A")="End with Date: " D ^%DT G:Y<0 END S ECED=Y I ECED<ECSD W !,"End date must be after start date",! G DATE
S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED),ECSD=ECSD-.0001,ECED=ECED+.9999
D REASON^ECRUTL ;* Prompt to report Procedure Reasons
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
I $D(IO("Q")) S:$D(ECRY) ZTSAVE("ECRY")=""
I $D(IO("Q")) K IO("Q") S (ZTSAVE("ECDFN"),ZTSAVE("ECPAT"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))="",ZTDESC="EVENT CAPTURE PATIENT SUMMARY",ZTRTN="SUM^ECPAT",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS G END
SUM ; entry when queued
N ECPRSN,ECPRSN2,ECPRSN3,%H,ECACLN,CLNODE ;112,119,134
I $G(ECPTYP)="E" D EXPORT,^ECKILL Q ;119
S %H=$H D YX^%DTC S ECRDT=Y
U IO S DATE=$O(^ECH("APAT",ECDFN,ECSD)) I 'DATE W:$Y @IOF W !!,"No Data for "_ECPAT_" during the time selected." G END
S ECFN=+$O(^ECH("APAT",ECDFN,DATE,0)),ECL=+$P(^ECH(ECFN,0),"^",4) D BRO D:$D(ECY) HDR D:$D(ECN) HDR1
S DATE=ECSD,(ECFN,ECOUT)=0 F I=0:0 S DATE=$O(^ECH("APAT",ECDFN,DATE)) Q:'DATE!(DATE>ECED)!(ECOUT) F I=0:0 S ECFN=$O(^ECH("APAT",ECDFN,DATE,ECFN)) Q:'ECFN!(ECOUT) D SET
D FOOTER ;for last page
END I $D(ECGUI) D ^ECKILL Q
W ! I $D(ECOUT),'ECOUT D
. I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue " R X:DTIME
W @IOF D ^%ZISC D ^ECKILL S:$D(ZTQUEUED) ZTREQ="@"
Q
HDR ; print heading
;
;ALB/ESD - Add Procedure Reason to column headings
W:$Y @IOF
W !,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?32,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!,?32,"Run Date : ",ECRDT
W !,"PROCEDURE DATE/TIME",?32,"CATEGORY",?87,"PROCEDURE",!,?87,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?32,"DSS UNIT NAME (IEN)",!,?32,"SERVICE",?87,"SECTION" ;112,131
W !
W:$D(ECRY) "PROCEDURE REASON(S)" ;112
W ?32,"ORDERING SECTION",?87,"PROVIDER",! F LINE=1:1:132 W "-" ;112
W !
Q
PAGE ; end of page
I $G(X)'["?" D FOOTER
S X="" I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue, or ^ to quit " R X:DTIME I '$T!(X="^") S ECOUT=1 Q
I X["?" W !!,"If you want to continue with this report, press <RET>. Entering an ^ will",!,"exit you from this option." G PAGE
D:$D(ECY) HDR D:$D(ECN) HDR1
Q
HDR1 ; print heading without categories
;
;ALB/ESD - Add Run Date to header
W @IOF,!!,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?36,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!,?36,"Run Date : ",ECRDT
;
;ALB/ESD - Add Procedure Reason to column headings
W !!,"PROCEDURE DATE/TIME",?32,"PROCEDURE(VOLUME)",!,?32,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?32,"DSS UNIT NAME (IEN)" ;112,131,134
W !,?32,"CLINIC",?64,"STOP",?70,"CREDIT",?78,"CHAR4",?85,"MCA",!,?32,"SERVICE",?85,"LABOR",?94,"SECTION" ;112,131,134,139
W !
W:$D(ECRY) "PROCEDURE REASON(S)" ;112
W ?32,"ORDERING SECTION",?85,"CODE",?94,"PROVIDER",! F LINE=1:1:132 W "-" ;112,139
W !
Q
;
W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
W !?4,"and/or a combination of these."
Q
;
BRO ;ask prt with category or without
S ECN=1
Q
;
EXPORT ;Section added in 119
N DATE,CNT,ECEPN
S CNT=1
S ^TMP($J,"ECRPT",CNT)="PATIENT NAME^SSN^PROCEDURE DATE/TIME^LOCATION^DSS UNIT IEN^DSS UNIT NAME^CLINIC^STOP CODE^CREDIT STOP^CHAR4^MCA LABOR CODE" ;131,134,139
S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_"^CPT CODE^PROCEDURE CODE^PROCEDURE NAME^VOLUME^"_$S($D(ECRY):"REASON #1^REASON #2^REASON #3^",1:"")_"SERVICE^SECTION^ORDERING SECTION^PROVIDER" ;131,134
S DATE=$O(^ECH("APAT",ECDFN,ECSD)) I 'DATE Q
S ECFN=+$O(^ECH("APAT",ECDFN,DATE,0)),ECL=+$P(^ECH(ECFN,0),"^",4) D BRO
S DATE=ECSD,ECFN=0 F I=0:0 S DATE=$O(^ECH("APAT",ECDFN,DATE)) Q:'DATE!(DATE>ECED) F I=0:0 S ECFN=$O(^ECH("APAT",ECDFN,DATE,ECFN)) Q:'ECFN D
.D SET
.S CNT=CNT+1 ;139
.S ^TMP($J,"ECRPT",CNT)=ECPAT_U_$E($$GET1^DIQ(2,(ECDFN_","),.09),6,9)_U_ECDT_U_ECLN_U_ECD_U_ECDN_U_ECACLN_U_$P(CLNODE,U,2)_U_$P(CLNODE,U,3)_U_$P($G(^ECX(728.441,+$P(CLNODE,U,8),0)),U)_U_$$GET1^DIQ(728.442,$P(CLNODE,U,14),.01) ;131,134,139
.S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_$E(ECCPT,1,5)_U_$S(ECFILE=725:$P($G(^EC(725,+ECP,0)),U,2),1:"")_U_ECEPN_U_ECV_U_$S($D(ECRY):ECPRSN_U_ECPRSN2_U_ECPRSN3_U,1:"")_ECSN_U_ECMN_U_ECON_U_ECUN ;139
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECPAT 8134 printed Dec 13, 2024@01:58:20 Page 2
ECPAT ;BIR/MAM,JPW - Event Capture Patient Summary ;10/12/17 08:47
+1 ;;2.0;EVENT CAPTURE;**5,18,47,72,95,112,119,131,134,139**;8 May 96;Build 7
SET ; set ^TMP($J,"ECPAT")
+1 NEW ECPXD,EC725
+2 ;119
IF $GET(ECPTYP)'="E"
IF $Y+11>IOSL
DO PAGE
IF ECOUT
QUIT
+3 SET ECEC=$GET(^ECH(ECFN,0))
+4 SET ECL=+$PIECE(ECEC,"^",4)
SET ECC=+$PIECE(ECEC,"^",8)
SET ECP=$PIECE(ECEC,"^",9)
SET ECD=+$PIECE(ECEC,"^",7)
SET ECV=+$PIECE(ECEC,"^",10)
+5 SET ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN)
SET ECUN=$SELECT(ECU:"UNKNOWN",1:$PIECE(ECUN,"^",2))
+6 if ECP']""
QUIT
+7 ;set default med spec and ord sect to administrative if blank
+8 SET ECM=$SELECT($PIECE(ECEC,"^",6)]"":+$PIECE(ECEC,"^",6),1:108)
SET ECO=$SELECT($PIECE(ECEC,"^",12)]"":+$PIECE(ECEC,"^",12),1:108)
+9 SET ECMN=$SELECT($PIECE($GET(^ECC(723,ECM,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+10 SET ECON=$SELECT($PIECE($GET(^ECC(723,ECO,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+11 SET ECS=+$PIECE(ECEC,"^",5)
SET ECSN=$SELECT($PIECE($GET(^DIC(49,ECS,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+12 SET ECCN=$SELECT($PIECE($GET(^EC(726,ECC,0)),"^")]"":$PIECE(^(0),"^"),1:"None")
+13 SET ECPSY=+$ORDER(^ECJ("AP",ECL,ECD,ECC,ECP,""))
+14 SET ECPSYN=$PIECE($GET(^ECJ(ECPSY,"PRO")),"^",2)
+15 SET ECFILE=$PIECE(ECP,";",2)
SET ECFILE=$SELECT($EXTRACT(ECFILE)="I":81,1:725)
+16 SET ECCPT=$SELECT(ECFILE=81:+ECP,1:$PIECE($GET(^EC(725,+ECP,0)),"^",5))
SET ECPXD=""
+17 IF ECCPT'=""
Begin DoDot:1
+18 SET ECPXD=$$CPT^ICPTCOD(ECCPT,$PIECE(ECEC,"^",3))
SET ECCPT=$PIECE(ECPXD,"^",2)
+19 IF ECCPT'=""
SET ECCPT=ECCPT_" "
End DoDot:1
+20 IF ECFILE=81
SET ECPN=$SELECT($PIECE(ECPXD,"^",3)]"":$PIECE(ECPXD,"^",3),1:"UNKNOWN")
+21 IF ECFILE=725
Begin DoDot:1
+22 SET EC725=$GET(^EC(725,+ECP,0))
SET ECPN=$PIECE(EC725,"^",2)_" "_$PIECE(EC725,"^")
End DoDot:1
+23 ;119 Set export version of procedure name
SET ECEPN=$SELECT(ECFILE=81:ECPN,1:$PIECE(EC725,U))_$SELECT(ECPSYN]"":" ["_ECPSYN_"] ",1:"")
+24 SET ECPN=$JUSTIFY(ECCPT,6)_$EXTRACT(ECPN,1,38)_$SELECT(ECPSYN]"":" ["_ECPSYN_"] ",1:"")
+25 SET ECDN=$SELECT($PIECE($GET(^ECD(ECD,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+26 SET ECLN=$SELECT($PIECE($GET(^DIC(4,ECL,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+27 SET ECUN=$SELECT(ECUN'="UNKNOWN":$PIECE(ECUN,",",2)_" "_$PIECE(ECUN,","),1:"UNKNOWN")
+28 SET ECDT=$$FMTE^XLFDT(DATE)
+29 ;
+30 ;ALB/ESD - Add Procedure Reason to report
+31 ;112,119
NEW ECLNK,ECRAR
+32 ;112,134 Get associated clinics and reasons
DO GETS^DIQ(721,ECFN,"26;34;43;44","IE","ECRAR")
+33 ;112,134
SET ECPRSN=$GET(ECRAR(721,ECFN_",",34,"E"))
if ECPRSN=""
SET ECPRSN="REASON NOT DEFINED"
+34 ;112,134
SET ECPRSN2=$GET(ECRAR(721,ECFN_",",43,"E"))
+35 ;112,134
SET ECPRSN3=$GET(ECRAR(721,ECFN_",",44,"E"))
+36 ;134
SET ECACLN=$GET(ECRAR(721,ECFN_",",26,"E"))
+37 ;134
SET CLNODE=$GET(^ECX(728.44,+$GET(ECRAR(721,ECFN_",",26,"I")),0))
+38 ;
+39 ;Get Procedure CPT modifiers
+40 ;119 Don't need modifiers for exportable version
IF $GET(ECPTYP)="E"
QUIT
+41 SET ECMODF=0
KILL ECMOD
+42 IF $ORDER(^ECH(ECFN,"MOD",0))'=""
SET ECMODF=$$MOD^ECUTL(ECFN,"E",.ECMOD)
+43 IF $DATA(ECY)
Begin DoDot:1
+44 ;112
WRITE !!,ECDT,?32,ECCN,?87,ECPN_" ("_ECV_")",!
+45 IF ECMODF
SET MD=""
Begin DoDot:2
+46 FOR
SET MD=$ORDER(ECMOD(MD))
if MD=""
QUIT
Begin DoDot:3
+47 ;112
if $Y+5>IOSL
DO PAGE
if ECOUT
QUIT
WRITE ?91,"- ",MD," ",$PIECE(ECMOD(MD),U,3),!
End DoDot:3
IF ECOUT
QUIT
End DoDot:2
KILL MD
IF ECOUT
QUIT
+48 ;112,131
WRITE $EXTRACT(ECLN,1,22),?32,ECDN_" ("_ECD_")",!,?32,ECSN,?87,ECMN,!
+49 ;119
IF '$DATA(ECRY)
WRITE ?32,ECON,?87,ECUN
+50 ;112
IF $DATA(ECRY)
Begin DoDot:2
+51 ;112
WRITE ECPRSN,?32,ECON,?87,ECUN
+52 ;112
IF $GET(ECPRSN2)'=""
WRITE !,ECPRSN2
+53 ;112
IF $GET(ECPRSN3)'=""
WRITE !,ECPRSN3
End DoDot:2
End DoDot:1
+54 IF $DATA(ECN)
Begin DoDot:1
+55 ;112
WRITE !!,ECDT,?32,ECPN_" ("_ECV_")",!
+56 IF ECMODF
SET MD=""
Begin DoDot:2
+57 FOR
SET MD=$ORDER(ECMOD(MD))
if MD=""
QUIT
Begin DoDot:3
+58 ;112
if $Y+5>IOSL
DO PAGE
if ECOUT
QUIT
WRITE ?36,"- ",MD," ",$PIECE(ECMOD(MD),U,3),!
End DoDot:3
IF ECOUT
QUIT
End DoDot:2
KILL MD
IF ECOUT
QUIT
+59 ;139
WRITE $EXTRACT(ECLN,1,22),?32,ECDN_" ("_ECD_")",!,?32,ECACLN,?64,$PIECE(CLNODE,U,2),?70,$PIECE(CLNODE,U,3),?78,$PIECE($GET(^ECX(728.441,+$PIECE(CLNODE,U,8),0)),U)
+60 ;139
WRITE ?85,$$GET1^DIQ(728.442,$PIECE(CLNODE,U,14),.01),!?32,ECSN,?94,ECMN,!
+61 ;119,139
IF '$DATA(ECRY)
WRITE ?32,ECON,?94,ECUN
+62 ;112
IF $DATA(ECRY)
Begin DoDot:2
+63 ;112,139
WRITE ECPRSN,?32,ECON,?94,ECUN
+64 ;112
IF $GET(ECPRSN2)'=""
WRITE !,ECPRSN2
+65 ;112
IF $GET(ECPRSN3)'=""
WRITE !,ECPRSN3
End DoDot:2
End DoDot:1
+66 QUIT
PAT ; entry point
+1 KILL DIC
SET DIC=2
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Patient: "
DO ^DIC
KILL DIC
if Y<0
GOTO END
SET ECDFN=+Y
SET ECPAT=$PIECE(Y,"^",2)
DATE KILL %DT
SET %DT="AEX"
SET %DT("A")="Start with Date: "
DO ^%DT
if Y<0
GOTO END
SET ECSD=Y
SET %DT("A")="End with Date: "
DO ^%DT
if Y<0
GOTO END
SET ECED=Y
IF ECED<ECSD
WRITE !,"End date must be after start date",!
GOTO DATE
+1 SET ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED)
SET ECSD=ECSD-.0001
SET ECED=ECED+.9999
+2 ;* Prompt to report Procedure Reasons
DO REASON^ECRUTL
+3 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Select Device: "
SET %ZIS="QM"
WRITE !!,"This report is designed to use a 132 column format.",!
DO ^%ZIS
if POP
GOTO END
+4 IF $DATA(IO("Q"))
if $DATA(ECRY)
SET ZTSAVE("ECRY")=""
+5 IF $DATA(IO("Q"))
KILL IO("Q")
SET (ZTSAVE("ECDFN"),ZTSAVE("ECPAT"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))=""
SET ZTDESC="EVENT CAPTURE PATIENT SUMMARY"
SET ZTRTN="SUM^ECPAT"
SET ZTIO=ION
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO END
SUM ; entry when queued
+1 ;112,119,134
NEW ECPRSN,ECPRSN2,ECPRSN3,%H,ECACLN,CLNODE
+2 ;119
IF $GET(ECPTYP)="E"
DO EXPORT
DO ^ECKILL
QUIT
+3 SET %H=$HOROLOG
DO YX^%DTC
SET ECRDT=Y
+4 USE IO
SET DATE=$ORDER(^ECH("APAT",ECDFN,ECSD))
IF 'DATE
if $Y
WRITE @IOF
WRITE !!,"No Data for "_ECPAT_" during the time selected."
GOTO END
+5 SET ECFN=+$ORDER(^ECH("APAT",ECDFN,DATE,0))
SET ECL=+$PIECE(^ECH(ECFN,0),"^",4)
DO BRO
if $DATA(ECY)
DO HDR
if $DATA(ECN)
DO HDR1
+6 SET DATE=ECSD
SET (ECFN,ECOUT)=0
FOR I=0:0
SET DATE=$ORDER(^ECH("APAT",ECDFN,DATE))
if 'DATE!(DATE>ECED)!(ECOUT)
QUIT
FOR I=0:0
SET ECFN=$ORDER(^ECH("APAT",ECDFN,DATE,ECFN))
if 'ECFN!(ECOUT)
QUIT
DO SET
+7 ;for last page
DO FOOTER
END IF $DATA(ECGUI)
DO ^ECKILL
QUIT
+1 WRITE !
IF $DATA(ECOUT)
IF 'ECOUT
Begin DoDot:1
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Press <RET> to continue "
READ X:DTIME
End DoDot:1
+3 WRITE @IOF
DO ^%ZISC
DO ^ECKILL
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
HDR ; print heading
+1 ;
+2 ;ALB/ESD - Add Procedure Reason to column headings
+3 if $Y
WRITE @IOF
+4 WRITE !,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?32,"FROM "_$PIECE(ECDATE,"^")_" TO "_$PIECE(ECDATE,"^",2),!,?32,"Run Date : ",ECRDT
+5 ;112,131
WRITE !,"PROCEDURE DATE/TIME",?32,"CATEGORY",?87,"PROCEDURE",!,?87,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?32,"DSS UNIT NAME (IEN)",!,?32,"SERVICE",?87,"SECTION"
+6 WRITE !
+7 ;112
if $DATA(ECRY)
WRITE "PROCEDURE REASON(S)"
+8 ;112
WRITE ?32,"ORDERING SECTION",?87,"PROVIDER",!
FOR LINE=1:1:132
WRITE "-"
+9 WRITE !
+10 QUIT
PAGE ; end of page
+1 IF $GET(X)'["?"
DO FOOTER
+2 SET X=""
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Press <RET> to continue, or ^ to quit "
READ X:DTIME
IF '$TEST!(X="^")
SET ECOUT=1
QUIT
+3 IF X["?"
WRITE !!,"If you want to continue with this report, press <RET>. Entering an ^ will",!,"exit you from this option."
GOTO PAGE
+4 if $DATA(ECY)
DO HDR
if $DATA(ECN)
DO HDR1
+5 QUIT
HDR1 ; print heading without categories
+1 ;
+2 ;ALB/ESD - Add Run Date to header
+3 WRITE @IOF,!!,?32,"EVENT CAPTURE PATIENT SUMMARY FOR "_ECPAT,!,?36,"FROM "_$PIECE(ECDATE,"^")_" TO "_$PIECE(ECDATE,"^",2),!,?36,"Run Date : ",ECRDT
+4 ;
+5 ;ALB/ESD - Add Procedure Reason to column headings
+6 ;112,131,134
WRITE !!,"PROCEDURE DATE/TIME",?32,"PROCEDURE(VOLUME)",!,?32,"PROCEDURE (CPT) MODIFIER",!,"LOCATION",?32,"DSS UNIT NAME (IEN)"
+7 ;112,131,134,139
WRITE !,?32,"CLINIC",?64,"STOP",?70,"CREDIT",?78,"CHAR4",?85,"MCA",!,?32,"SERVICE",?85,"LABOR",?94,"SECTION"
+8 WRITE !
+9 ;112
if $DATA(ECRY)
WRITE "PROCEDURE REASON(S)"
+10 ;112,139
WRITE ?32,"ORDERING SECTION",?85,"CODE",?94,"PROVIDER",!
FOR LINE=1:1:132
WRITE "-"
+11 WRITE !
+12 QUIT
+13 ;
+1 WRITE !!?4,"Volume totals may represent days, minutes, numbers of procedures"
+2 WRITE !?4,"and/or a combination of these."
+3 QUIT
+4 ;
BRO ;ask prt with category or without
+1 SET ECN=1
+2 QUIT
+3 ;
EXPORT ;Section added in 119
+1 NEW DATE,CNT,ECEPN
+2 SET CNT=1
+3 ;131,134,139
SET ^TMP($JOB,"ECRPT",CNT)="PATIENT NAME^SSN^PROCEDURE DATE/TIME^LOCATION^DSS UNIT IEN^DSS UNIT NAME^CLINIC^STOP CODE^CREDIT STOP^CHAR4^MCA LABOR CODE"
+4 ;131,134
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_"^CPT CODE^PROCEDURE CODE^PROCEDURE NAME^VOLUME^"_$SELECT($DATA(ECRY):"REASON #1^REASON #2^REASON #3^",1:"")_"SERVICE^SECTION^ORDERING SECTION^PROVIDER"
+5 SET DATE=$ORDER(^ECH("APAT",ECDFN,ECSD))
IF 'DATE
QUIT
+6 SET ECFN=+$ORDER(^ECH("APAT",ECDFN,DATE,0))
SET ECL=+$PIECE(^ECH(ECFN,0),"^",4)
DO BRO
+7 SET DATE=ECSD
SET ECFN=0
FOR I=0:0
SET DATE=$ORDER(^ECH("APAT",ECDFN,DATE))
if 'DATE!(DATE>ECED)
QUIT
FOR I=0:0
SET ECFN=$ORDER(^ECH("APAT",ECDFN,DATE,ECFN))
if 'ECFN
QUIT
Begin DoDot:1
+8 DO SET
+9 ;139
SET CNT=CNT+1
+10 ;131,134,139
SET ^TMP($JOB,"ECRPT",CNT)=ECPAT_U_$EXTRACT($$GET1^DIQ(2,(ECDFN_","),.09),6,9)_U_ECDT_U_ECLN_U_ECD_U_ECDN_U_ECACLN_U_$PIECE(CLNODE,U,2)_U_$PIECE(CLNODE,U,3)_U_$PIECE($GET(^ECX(728.441,+$PIECE(CLNODE,U,8),0)),U)_U_$$GET1^DIQ(728.442,.
..
... $PIECE(CLNODE,U,14),.01)
+11 ;139
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_$EXTRACT(ECCPT,1,5)_U_$SELECT(ECFILE=725:$PIECE($GET(^EC(725,+ECP,0)),U,2),1:"")_U_ECEPN_U_ECV_U_$SELECT($DATA(ECRY):ECPRSN_U_ECPRSN2_U_ECPRSN3_U,1:"")_ECSN_U_ECMN_U_ECON_U_ECUN
End DoDot:1
