ECPCER ;BIR/JPW - Event Capture PCE Data Summary ;10/11/17 11:07
;;2.0;EVENT CAPTURE;**4,18,23,47,72,95,119,114,126,139**;8 May 96;Build 7
;
; Reference to $$SINFO^ICDEX supported by ICR #5747
; Reference to $$ICDDX^ICDEX supported by ICR #5747
;
EN ; 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
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")) K IO("Q") S (ZTSAVE("ECDFN"),ZTSAVE("ECPAT"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))="",ZTDESC="ECS/PCE PATIENT SUMMARY",ZTRTN="SUM^ECPCER",ZTIO=ION D ^%ZTLOAD,HOME^%ZIS G END
SUM ; entry when queued
N ECEPN,ECPCODE,ECEXDS,ECEI,ECCSC,ECCHAR,ECMCA ;119,139
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 HDR1
S DATE=ECSD,(ECFN,ECOUT)=0 F S DATE=$O(^ECH("APAT",ECDFN,DATE)) Q:'DATE!(DATE>ECED)!(ECOUT) F S ECFN=$O(^ECH("APAT",ECDFN,DATE,ECFN)) Q:'ECFN!(ECOUT) D SET
D FOOTER ;print footer on last page
END I $D(ECGUI) D ^ECKILL Q
W ! 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
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 HDR1
Q
HDR1 ; print heading without categories
W:$Y @IOF
W !,?31,"ECS/PCE PATIENT SUMMARY FOR "_ECPAT,!,?36,"FROM "_$P(ECDATE,"^")_" TO "_$P(ECDATE,"^",2),!!,"PROCEDURE DATE/TIME",?25,"PROCEDURE NAME SENT (VOLUME)",?78,"PROVIDER"
W !,"LOCATION",?25,"CLINIC (STOP CODE/CREDIT STOP/CHAR4/MCA LABOR CODE)",?78,"CPT CODE" ;126,139
W !,?25,"DIAGNOSIS",?78,"PROCEDURE (CPT) MODIFIER",!
F LINE=1:1:132 W "-"
W !
Q
W !!?4,"Volume totals may represent days, minutes, numbers of procedures"
W !?4,"and/or a combination of these."
Q
;
SET ; set data
I $G(ECPTYP)'="E" I $Y+10>IOSL D PAGE I ECOUT Q ;119
Q:'$D(^ECH(ECFN,"PCE")) S ECEC=$G(^ECH(ECFN,"PCE"))
I '$P($G(^ECH(ECFN,"P")),"^",7) Q
S ECL=+$P(ECEC,"~",4),ECCPT=+$P(ECEC,"~",10),ECD=+$P(ECEC,"~",3),ECV=+$P(ECEC,"~",9),ECDX=+$P(ECEC,"~",11),ECID=$P(ECEC,"~",5),ECDT=+$P(ECEC,"~")
S ECDN=$S($P($G(^SC(ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECCSC=$$GET1^DIQ(728.44,ECD,2,"E") ;139 Credit Stop Code
S ECCHAR=$$GET1^DIQ(728.44,ECD,7,"E") ;139 CHAR4 Code
S ECMCA=$$GET1^DIQ(728.44,ECD,13,"E") ;139 MCA Labor Code
S ECPS=$$CPT^ICPTCOD(ECCPT,$P(ECEC,"~")),ECCPT=$S(+ECPS>0:$P(ECPS,"^",2),1:""),ECEPN=$S(+ECPS>0:$P(ECPS,U,3),1:""),ECPS=$S(+ECPS>0:$P(ECPS,"^",2)_" "_$P(ECPS,"^",3),1:"CPT NAME UNKNOWN") ;119
S ECLN=$S($P($G(^DIC(4,ECL,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S ECID=$S($P($G(^DIC(40.7,ECID,0)),"^",2)]"":$P(^(0),"^",2),1:"DSS ID UNKNOWN")
; Changes for ICD10
N ECCS
S ECCS=$$SINFO^ICDEX("DIAG",$P(ECEC,"~")) ; Supported by ICR 5747
S ECDXN=$$ICDDX^ICDEX(ECDX,$P(ECEC,"~"),+ECCS,"I") ; Supported by ICR 5747
S ECDXN=$S($P(ECDXN,U,1)=-1:"UNKNOWN",1:$P(ECDXN,U,2))
S ECPN=$S($P(ECEC,"~",16)]"":$P(ECEC,"~",16),1:ECPS)
S ECPCODE="" ;119
I $P(^ECH(ECFN,0),U,9)["EC" S:$P(ECEC,"~",16)]"" ECEPN=$$GET1^DIQ(721,ECFN,8) S ECPCODE=$P($P(ECEC,"~",16)," ") ;119
S ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN),ECUN=$S(ECU:"UNKNOWN",1:$P(ECUN,"^",2))
S ECUN=$S(ECUN'="UNKNOWN":$P(ECUN,",",2)_" "_$P(ECUN,","),1:"UNKNOWN")
S ECDT=$$FMTE^XLFDT(ECDT)
;get secondary diagnosis codes, ALB/JAM
S DXS=0,ECI=2,ECEI=1 F S DXS=$O(^ECH(ECFN,"DX",DXS)) Q:'DXS D ;119
. S DXSIEN=+$G(^ECH(ECFN,"DX",DXS,0)) I DXSIEN="" Q
. S ECDXSN=$$ICDDX^ICDEX(DXSIEN,$P(ECEC,"~"),+ECCS,"I")
. S ECDXSN=$S($P(ECDXSN,U,1)=-1:"UNKNOWN",1:$P(ECDXSN,U,2))
. I $L($G(ECDXS(ECI)))+$L(ECDXSN)>52 S ECI=ECI+1
. I $G(ECDXS(ECI))="" S ECDXS(ECI)="Secondary Dx: "
. S ECDXS(ECI)=ECDXS(ECI)_$S($L(ECDXS(ECI))=14:"",1:", ")_ECDXSN
. S ECEXDS(ECEI)=ECDXSN,ECEI=ECEI+1 ;119
S ECMOD="" I $D(^ECH(ECFN,"PCE1")) S ECMOD=^("PCE1")
I $G(ECPTYP)="E" Q ;119
PRT W !,ECDT,?25,ECPN_" ("_ECV_")",?78,ECUN,!
W $E(ECLN,1,22),?25,ECDN_" ("_ECID_"/"_ECCSC_"/"_ECCHAR_"/"_ECMCA_")",?78,ECCPT,!
W ?25,"Primary DX: ",ECDXN
;ALB/JAM print CPT modifiers and secondary diagnosis code
F I=1:1 S MOD=$P(ECMOD,";",I) Q:MOD="" D I ECOUT Q
. S MODESC=$$MODP^ICPTMOD(ECCPT,MOD,"E",$P(ECEC,"~")) I +MODESC'>0 Q
. W ?25,$S(I>1:$G(ECDXS(I)),1:""),?79,"- ",MOD," ",$P(MODESC,"^",2),!
. K ECDXS(I) I ($Y+6)>IOSL D PAGE I ECOUT Q
W:ECMOD="" ! S DXS=""
F S DXS=$O(ECDXS(DXS)) Q:DXS="" W ?25,ECDXS(DXS),!
K I,MOD,MODESC,ECI,DXS,DXSIEN,ECDXS,ECDXN,ECDXSN
Q
EXPORT ;Produce exportable version, added in patch 119
N CNT,DATE,ECFN,I,MOD,MODESC
S CNT=1
S ^TMP($J,"ECRPT",CNT)="PATIENT^PROCEDURE DATE/TIME^LOCATION^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE^CPT CODE^PROCEDURE CODE^PROCEDURE NAME" ;126,139
S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_"^PROCEDURE VOLUME^CPT MOD 1^CPT MOD 2^CPT MOD 3^PROVIDER^PRIMARY DIAGNOSIS^2ND DIAG 1^2ND DIAG 2^2ND DIAG 3^2ND DIAG 4" ;126,139
S DATE=ECSD F S DATE=$O(^ECH("APAT",ECDFN,DATE)) Q:'+DATE!(DATE>ECED) S ECFN=0 F S ECFN=$O(^ECH("APAT",ECDFN,DATE,ECFN)) Q:'+ECFN D
.Q:'$D(^ECH(ECFN,"PCE"))
.I '$P($G(^ECH(ECFN,"P")),U,7) Q
.K ECEXDS D SET
.S CNT=CNT+1
.S ^TMP($J,"ECRPT",CNT)=ECPAT_U_ECDT_U_ECLN_U_ECDN_U_ECID_U_ECCSC_U_ECCHAR_U_ECMCA_U_ECCPT_U_ECPCODE_U_ECEPN_U_ECV ;139
.F I=1:1:3 D
..S MOD=$P(ECMOD,";",I),MODESC="" I MOD'="" S MODESC=$$MODP^ICPTMOD(ECCPT,MOD,"E",$P(ECEC,"~")) S MODESC=$S(+MODESC>0:MOD_" "_$P(MODESC,U,2),1:"")
..S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_MODESC
.S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_ECUN_U_ECDXN
.F I=1:1:4 S ^TMP($J,"ECRPT",CNT)=^TMP($J,"ECRPT",CNT)_U_$G(ECEXDS(I))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECPCER 6435 printed Apr 09, 2024@21:02:30 Page 2
ECPCER ;BIR/JPW - Event Capture PCE Data Summary ;10/11/17 11:07
+1 ;;2.0;EVENT CAPTURE;**4,18,23,47,72,95,119,114,126,139**;8 May 96;Build 7
+2 ;
+3 ; Reference to $$SINFO^ICDEX supported by ICR #5747
+4 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+5 ;
EN ; 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 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
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET (ZTSAVE("ECDFN"),ZTSAVE("ECPAT"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))=""
SET ZTDESC="ECS/PCE PATIENT SUMMARY"
SET ZTRTN="SUM^ECPCER"
SET ZTIO=ION
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO END
SUM ; entry when queued
+1 ;119,139
NEW ECEPN,ECPCODE,ECEXDS,ECEI,ECCSC,ECCHAR,ECMCA
+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 HDR1
+6 SET DATE=ECSD
SET (ECFN,ECOUT)=0
FOR
SET DATE=$ORDER(^ECH("APAT",ECDFN,DATE))
if 'DATE!(DATE>ECED)!(ECOUT)
QUIT
FOR
SET ECFN=$ORDER(^ECH("APAT",ECDFN,DATE,ECFN))
if 'ECFN!(ECOUT)
QUIT
DO SET
+7 ;print footer on last page
DO FOOTER
END IF $DATA(ECGUI)
DO ^ECKILL
QUIT
+1 WRITE !
IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Press <RET> to continue "
READ X:DTIME
+2 WRITE @IOF
DO ^%ZISC
DO ^ECKILL
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 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 DO HDR1
+5 QUIT
HDR1 ; print heading without categories
+1 if $Y
WRITE @IOF
+2 WRITE !,?31,"ECS/PCE PATIENT SUMMARY FOR "_ECPAT,!,?36,"FROM "_$PIECE(ECDATE,"^")_" TO "_$PIECE(ECDATE,"^",2),!!,"PROCEDURE DATE/TIME",?25,"PROCEDURE NAME SENT (VOLUME)",?78,"PROVIDER"
+3 ;126,139
WRITE !,"LOCATION",?25,"CLINIC (STOP CODE/CREDIT STOP/CHAR4/MCA LABOR CODE)",?78,"CPT CODE"
+4 WRITE !,?25,"DIAGNOSIS",?78,"PROCEDURE (CPT) MODIFIER",!
+5 FOR LINE=1:1:132
WRITE "-"
+6 WRITE !
+7 QUIT
+1 WRITE !!?4,"Volume totals may represent days, minutes, numbers of procedures"
+2 WRITE !?4,"and/or a combination of these."
+3 QUIT
+4 ;
SET ; set data
+1 ;119
IF $GET(ECPTYP)'="E"
IF $Y+10>IOSL
DO PAGE
IF ECOUT
QUIT
+2 if '$DATA(^ECH(ECFN,"PCE"))
QUIT
SET ECEC=$GET(^ECH(ECFN,"PCE"))
+3 IF '$PIECE($GET(^ECH(ECFN,"P")),"^",7)
QUIT
+4 SET ECL=+$PIECE(ECEC,"~",4)
SET ECCPT=+$PIECE(ECEC,"~",10)
SET ECD=+$PIECE(ECEC,"~",3)
SET ECV=+$PIECE(ECEC,"~",9)
SET ECDX=+$PIECE(ECEC,"~",11)
SET ECID=$PIECE(ECEC,"~",5)
SET ECDT=+$PIECE(ECEC,"~")
+5 SET ECDN=$SELECT($PIECE($GET(^SC(ECD,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+6 ;139 Credit Stop Code
SET ECCSC=$$GET1^DIQ(728.44,ECD,2,"E")
+7 ;139 CHAR4 Code
SET ECCHAR=$$GET1^DIQ(728.44,ECD,7,"E")
+8 ;139 MCA Labor Code
SET ECMCA=$$GET1^DIQ(728.44,ECD,13,"E")
+9 ;119
SET ECPS=$$CPT^ICPTCOD(ECCPT,$PIECE(ECEC,"~"))
SET ECCPT=$SELECT(+ECPS>0:$PIECE(ECPS,"^",2),1:"")
SET ECEPN=$SELECT(+ECPS>0:$PIECE(ECPS,U,3),1:"")
SET ECPS=$SELECT(+ECPS>0:$PIECE(ECPS,"^",2)_" "_$PIECE(ECPS,"^",3),1:"CPT NAME UNKNOWN")
+10 SET ECLN=$SELECT($PIECE($GET(^DIC(4,ECL,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+11 SET ECID=$SELECT($PIECE($GET(^DIC(40.7,ECID,0)),"^",2)]"":$PIECE(^(0),"^",2),1:"DSS ID UNKNOWN")
+12 ; Changes for ICD10
+13 NEW ECCS
+14 ; Supported by ICR 5747
SET ECCS=$$SINFO^ICDEX("DIAG",$PIECE(ECEC,"~"))
+15 ; Supported by ICR 5747
SET ECDXN=$$ICDDX^ICDEX(ECDX,$PIECE(ECEC,"~"),+ECCS,"I")
+16 SET ECDXN=$SELECT($PIECE(ECDXN,U,1)=-1:"UNKNOWN",1:$PIECE(ECDXN,U,2))
+17 SET ECPN=$SELECT($PIECE(ECEC,"~",16)]"":$PIECE(ECEC,"~",16),1:ECPS)
+18 ;119
SET ECPCODE=""
+19 ;119
IF $PIECE(^ECH(ECFN,0),U,9)["EC"
if $PIECE(ECEC,"~",16)]""
SET ECEPN=$$GET1^DIQ(721,ECFN,8)
SET ECPCODE=$PIECE($PIECE(ECEC,"~",16)," ")
+20 SET ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN)
SET ECUN=$SELECT(ECU:"UNKNOWN",1:$PIECE(ECUN,"^",2))
+21 SET ECUN=$SELECT(ECUN'="UNKNOWN":$PIECE(ECUN,",",2)_" "_$PIECE(ECUN,","),1:"UNKNOWN")
+22 SET ECDT=$$FMTE^XLFDT(ECDT)
+23 ;get secondary diagnosis codes, ALB/JAM
+24 ;119
SET DXS=0
SET ECI=2
SET ECEI=1
FOR
SET DXS=$ORDER(^ECH(ECFN,"DX",DXS))
if 'DXS
QUIT
Begin DoDot:1
+25 SET DXSIEN=+$GET(^ECH(ECFN,"DX",DXS,0))
IF DXSIEN=""
QUIT
+26 SET ECDXSN=$$ICDDX^ICDEX(DXSIEN,$PIECE(ECEC,"~"),+ECCS,"I")
+27 SET ECDXSN=$SELECT($PIECE(ECDXSN,U,1)=-1:"UNKNOWN",1:$PIECE(ECDXSN,U,2))
+28 IF $LENGTH($GET(ECDXS(ECI)))+$LENGTH(ECDXSN)>52
SET ECI=ECI+1
+29 IF $GET(ECDXS(ECI))=""
SET ECDXS(ECI)="Secondary Dx: "
+30 SET ECDXS(ECI)=ECDXS(ECI)_$SELECT($LENGTH(ECDXS(ECI))=14:"",1:", ")_ECDXSN
+31 ;119
SET ECEXDS(ECEI)=ECDXSN
SET ECEI=ECEI+1
End DoDot:1
+32 SET ECMOD=""
IF $DATA(^ECH(ECFN,"PCE1"))
SET ECMOD=^("PCE1")
+33 ;119
IF $GET(ECPTYP)="E"
QUIT
PRT WRITE !,ECDT,?25,ECPN_" ("_ECV_")",?78,ECUN,!
+1 WRITE $EXTRACT(ECLN,1,22),?25,ECDN_" ("_ECID_"/"_ECCSC_"/"_ECCHAR_"/"_ECMCA_")",?78,ECCPT,!
+2 WRITE ?25,"Primary DX: ",ECDXN
+3 ;ALB/JAM print CPT modifiers and secondary diagnosis code
+4 FOR I=1:1
SET MOD=$PIECE(ECMOD,";",I)
if MOD=""
QUIT
Begin DoDot:1
+5 SET MODESC=$$MODP^ICPTMOD(ECCPT,MOD,"E",$PIECE(ECEC,"~"))
IF +MODESC'>0
QUIT
+6 WRITE ?25,$SELECT(I>1:$GET(ECDXS(I)),1:""),?79,"- ",MOD," ",$PIECE(MODESC,"^",2),!
+7 KILL ECDXS(I)
IF ($Y+6)>IOSL
DO PAGE
IF ECOUT
QUIT
End DoDot:1
IF ECOUT
QUIT
+8 if ECMOD=""
WRITE !
SET DXS=""
+9 FOR
SET DXS=$ORDER(ECDXS(DXS))
if DXS=""
QUIT
WRITE ?25,ECDXS(DXS),!
+10 KILL I,MOD,MODESC,ECI,DXS,DXSIEN,ECDXS,ECDXN,ECDXSN
+11 QUIT
EXPORT ;Produce exportable version, added in patch 119
+1 NEW CNT,DATE,ECFN,I,MOD,MODESC
+2 SET CNT=1
+3 ;126,139
SET ^TMP($JOB,"ECRPT",CNT)="PATIENT^PROCEDURE DATE/TIME^LOCATION^CLINIC^STOP CODE^CREDIT STOP CODE^CHAR4 CODE^MCA LABOR CODE^CPT CODE^PROCEDURE CODE^PROCEDURE NAME"
+4 ;126,139
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_"^PROCEDURE VOLUME^CPT MOD 1^CPT MOD 2^CPT MOD 3^PROVIDER^PRIMARY DIAGNOSIS^2ND DIAG 1^2ND DIAG 2^2ND DIAG 3^2ND DIAG 4"
+5 SET DATE=ECSD
FOR
SET DATE=$ORDER(^ECH("APAT",ECDFN,DATE))
if '+DATE!(DATE>ECED)
QUIT
SET ECFN=0
FOR
SET ECFN=$ORDER(^ECH("APAT",ECDFN,DATE,ECFN))
if '+ECFN
QUIT
Begin DoDot:1
+6 if '$DATA(^ECH(ECFN,"PCE"))
QUIT
+7 IF '$PIECE($GET(^ECH(ECFN,"P")),U,7)
QUIT
+8 KILL ECEXDS
DO SET
+9 SET CNT=CNT+1
+10 ;139
SET ^TMP($JOB,"ECRPT",CNT)=ECPAT_U_ECDT_U_ECLN_U_ECDN_U_ECID_U_ECCSC_U_ECCHAR_U_ECMCA_U_ECCPT_U_ECPCODE_U_ECEPN_U_ECV
+11 FOR I=1:1:3
Begin DoDot:2
+12 SET MOD=$PIECE(ECMOD,";",I)
SET MODESC=""
IF MOD'=""
SET MODESC=$$MODP^ICPTMOD(ECCPT,MOD,"E",$PIECE(ECEC,"~"))
SET MODESC=$SELECT(+MODESC>0:MOD_" "_$PIECE(MODESC,U,2),1:"")
+13 SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_MODESC
End DoDot:2
+14 SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_ECUN_U_ECDXN
+15 FOR I=1:1:4
SET ^TMP($JOB,"ECRPT",CNT)=^TMP($JOB,"ECRPT",CNT)_U_$GET(ECEXDS(I))
End DoDot:1
+16 QUIT
