| 1 | ECPCER ;BIR/JPW-Event Capture PCE Data Summary ;21 Jan 97
|
---|
| 2 | ;;2.0; EVENT CAPTURE ;**4,18,23,47,72**;8 May 96
|
---|
| 3 | EN ; entry point
|
---|
| 4 | 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)
|
---|
| 5 | 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
|
---|
| 6 | S ECDATE=$$FMTE^XLFDT(ECSD)_"^"_$$FMTE^XLFDT(ECED),ECSD=ECSD-.0001,ECED=ECED+.9999
|
---|
| 7 | 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
|
---|
| 8 | 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
|
---|
| 9 | SUM ; entry when queued
|
---|
| 10 | S %H=$H D YX^%DTC S ECRDT=Y
|
---|
| 11 | 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
|
---|
| 12 | S ECFN=+$O(^ECH("APAT",ECDFN,DATE,0)),ECL=+$P(^ECH(ECFN,0),"^",4) D HDR1
|
---|
| 13 | 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
|
---|
| 14 | END I $D(ECGUI) D ^ECKILL Q
|
---|
| 15 | W ! I $E(IOST,1,2)="C-" W !!,"Press <RET> to continue " R X:DTIME
|
---|
| 16 | W @IOF D ^%ZISC D ^ECKILL S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 17 | Q
|
---|
| 18 | PAGE ; end of page
|
---|
| 19 | 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
|
---|
| 20 | I X["?" W !!,"If you want to continue with this report, press <RET>. Entering an ^ will",!,"exit you from this option." G PAGE
|
---|
| 21 | D HDR1
|
---|
| 22 | Q
|
---|
| 23 | HDR1 ; print heading without categories
|
---|
| 24 | W:$Y @IOF
|
---|
| 25 | ;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,"CPT CODE (DIAGNOSIS)",!?78,"PROCEDURE (CPT) MODIFIER"
|
---|
| 26 | 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"
|
---|
| 27 | ;W !,"LOCATION",?25,"CLINIC (DSS ID)",?78,"PROVIDER",!
|
---|
| 28 | W !,"LOCATION",?25,"CLINIC (DSS ID)",?78,"CPT CODE"
|
---|
| 29 | W !,?25,"DIAGNOSIS",?78,"PROCEDURE (CPT) MODIFIER",!
|
---|
| 30 | F LINE=1:1:132 W "-"
|
---|
| 31 | W !
|
---|
| 32 | Q
|
---|
| 33 | SET ; set data
|
---|
| 34 | I $Y+7>IOSL D PAGE I ECOUT Q
|
---|
| 35 | Q:'$D(^ECH(ECFN,"PCE")) S ECEC=$G(^ECH(ECFN,"PCE"))
|
---|
| 36 | I '$P($G(^ECH(ECFN,"P")),"^",7) Q
|
---|
| 37 | 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,"~")
|
---|
| 38 | S ECDN=$S($P($G(^SC(ECD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 39 | S ECPS=$$CPT^ICPTCOD(ECCPT,$P(ECEC,"~")),ECCPT=$S(+ECPS>0:$P(ECPS,"^",2),1:""),ECPS=$S(+ECPS>0:$P(ECPS,"^",2)_" "_$P(ECPS,"^",3),1:"CPT NAME UNKNOWN")
|
---|
| 40 | S ECLN=$S($P($G(^DIC(4,ECL,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
---|
| 41 | S ECID=$S($P($G(^DIC(40.7,ECID,0)),"^",2)]"":$P(^(0),"^",2),1:"DSS ID UNKNOWN")
|
---|
| 42 | S ECDXN=$P($$ICDDX^ICDCODE(ECDX,$P(ECEC,"~")),U,2) S:ECDXN="" ECDXN="UNKNOWN"
|
---|
| 43 | S ECPN=$S($P(ECEC,"~",16)]"":$P(ECEC,"~",16),1:ECPS)
|
---|
| 44 | S ECU=$$GETPPRV^ECPRVMUT(ECFN,.ECUN),ECUN=$S(ECU:"UNKNOWN",1:$P(ECUN,"^",2))
|
---|
| 45 | S ECUN=$S(ECUN'="UNKNOWN":$P(ECUN,",",2)_" "_$P(ECUN,","),1:"UNKNOWN")
|
---|
| 46 | S ECDT=$$FMTE^XLFDT(ECDT)
|
---|
| 47 | ;get secondary diagnosis codes, ALB/JAM
|
---|
| 48 | S DXS=0,ECI=2 F S DXS=$O(^ECH(ECFN,"DX",DXS)) Q:'DXS D
|
---|
| 49 | . S DXSIEN=+$G(^ECH(ECFN,"DX",DXS,0)) I DXSIEN="" Q
|
---|
| 50 | . S ECDXSN=$P($$ICDDX^ICDCODE(DXSIEN,$P(ECEC,"~")),"^",2) I ECDXSN="" Q
|
---|
| 51 | . I $L($G(ECDXS(ECI)))+$L(ECDXSN)>52 S ECI=ECI+1
|
---|
| 52 | . I $G(ECDXS(ECI))="" S ECDXS(ECI)="Secondary Dx: "
|
---|
| 53 | . S ECDXS(ECI)=ECDXS(ECI)_$S($L(ECDXS(ECI))=14:"",1:", ")_ECDXSN
|
---|
| 54 | S ECMOD="" I $D(^ECH(ECFN,"PCE1")) S ECMOD=^("PCE1")
|
---|
| 55 | PRT W !,ECDT,?25,ECPN_" ("_ECV_")",?78,ECUN,!
|
---|
| 56 | W $E(ECLN,1,22),?25,ECDN_" ("_ECID_")",?78,ECCPT,!
|
---|
| 57 | W ?25,"Primary DX: ",ECDXN
|
---|
| 58 | ;ALB/JAM print CPT modifiers and secondary diagnosis code
|
---|
| 59 | F I=1:1 S MOD=$P(ECMOD,";",I) Q:MOD="" D I ECOUT Q
|
---|
| 60 | . S MODESC=$$MODP^ICPTMOD(ECCPT,MOD,"E",$P(ECEC,"~")) I +MODESC'>0 Q
|
---|
| 61 | . W ?25,$S(I>1:$G(ECDXS(I)),1:""),?79,"- ",MOD," ",$P(MODESC,"^",2),!
|
---|
| 62 | . K ECDXS(I) I ($Y+3)>IOSL D PAGE I ECOUT Q
|
---|
| 63 | W:ECMOD="" ! S DXS=""
|
---|
| 64 | F S DXS=$O(ECDXS(DXS)) Q:DXS="" W ?25,ECDXS(DXS),!
|
---|
| 65 | K I,MOD,MODESC,ECI,DXS,DXSIEN,ECDXS,ECDXN,ECDXSN
|
---|
| 66 | Q
|
---|