112 lines
4.1 KiB
Mathematica
112 lines
4.1 KiB
Mathematica
ECNTPCE ;ALB/JAM-Event Capture Records failing transmission to PCE;14 Jan 04
|
|
;;2.0; EVENT CAPTURE ;**61,72**;8 May 96
|
|
EN ; entry point
|
|
K %DT S %DT="AEX",%DT("A")="Start with Date: " D ^%DT I Y<0 G 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 EN
|
|
S ECDATE=$$FMTE^XLFDT(ECSD)_U_$$FMTE^XLFDT(ECED)
|
|
S ECSD=ECSD-.0001,ECED=ECED+.9999
|
|
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Device: ",%ZIS="QM"
|
|
D ^%ZIS G:POP END
|
|
I $D(IO("Q")) K IO("Q") D G END
|
|
.S (ZTSAVE("ECDFN"),ZTSAVE("ECDATE"),ZTSAVE("ECED"),ZTSAVE("ECSD"))=""
|
|
.S ZTDESC="ECS RECORDS FAILING TRANSMISSION TO PCE REPORT",ZTRTN="START^ECNTPCE"
|
|
.S ZTIO=ION D ^%ZTLOAD,HOME^%ZIS
|
|
W !,?5,"Please be patient, this may take a few moments..."
|
|
;
|
|
START ; entry when queued
|
|
N ECOUT,X,Y,DIR,LINE,ECPG,ECRDT,%H
|
|
S ECOUT=0,ECPG=1
|
|
S %H=$H D YX^%DTC S ECRDT=Y
|
|
U IO
|
|
D GET
|
|
D END
|
|
Q
|
|
GET ; start processing or records
|
|
N DATE,ECL,ECNT,ECFN,ECEC,ECPX,ECSTR,ECD
|
|
K ^TMP("ECNTPCE",$J)
|
|
S DATE=ECSD,ECNT=0
|
|
F S DATE=$O(^ECH("AC",DATE)) Q:('DATE)!(DATE>ECED) D
|
|
.S ECFN=0 F S ECFN=$O(^ECH("AC",DATE,ECFN)) Q:'ECFN D
|
|
..Q:'$D(^ECH(ECFN,"R")) S ECEC=$G(^ECH(ECFN,0)) Q:ECEC=""
|
|
..S ECL=$P(ECEC,U,4),ECD=$P(ECEC,U,7),ECPX=$P(ECEC,U,9)
|
|
..S ECDFN=$P(ECEC,U,2)
|
|
..I (ECL="")!(ECD="")!(ECPX="")!(ECDFN="") Q
|
|
..S ECSTR=ECFN_U_$P(ECEC,U,8)_U_ECPX
|
|
..S ECNT=ECNT+1,^TMP("ECNTPCE",$J,DATE,ECL,ECD,ECDFN,ECNT)=ECSTR
|
|
..K ECPRV S ECPRV=$$GETPRV^ECPRVMUT(ECFN,.ECPRV) I 'ECPRV D K ECPRV
|
|
...M ^TMP("ECNTPCE",$J,DATE,ECL,ECD,ECDFN,ECNT,"PRV")=ECPRV
|
|
D HDR
|
|
I '$O(^TMP("ECNTPCE",$J,0)) D Q
|
|
.W !!,?10,"No Data found during the time selected."
|
|
D PRT
|
|
Q
|
|
;
|
|
END K ECSD,ECED
|
|
I $D(ECGUI) D ^ECKILL Q
|
|
W !
|
|
I $E(IOST,1,2)="C-",$G(ECOUT)=0 W !!,"Press <RET> to continue" R X:DTIME
|
|
;W @IOF
|
|
D ^%ZISC D ^ECKILL S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
PAGE ; end of page
|
|
I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S ECOUT=1 Q
|
|
D HDR
|
|
Q
|
|
HDR ; print header
|
|
W @IOF
|
|
W ECRDT,?70,"Page: ",ECPG,!
|
|
W !,?17,"ECS RECORDS FAILING TRANSMISSION TO PCE REPORT",!,?24
|
|
W "FROM "_$P(ECDATE,U)_" TO "_$P(ECDATE,U,2),!!
|
|
W "DATE/TIME",?16,"PATIENT",?39,"SSN",?44,"PROVIDER(S)",?61,"REASONS"
|
|
W !,"LOCATION",?16,"PROCEDURE",!,"DSS UNIT",?16,"CATEGORY",!
|
|
F LINE=1:1:80 W "-"
|
|
W !
|
|
S ECPG=ECPG+1
|
|
Q
|
|
;
|
|
PRT N ECLN,ECDN,ECPAT,ECEC,ECPS,ECDFN,ECUN,ECUN1,ECUN2,ECDTE,ECDT,ECRS,ECDE
|
|
N ECX,ECAT,ECSSN,DFN,VA,VADM
|
|
S ECDTE=0 F S ECDTE=$O(^TMP("ECNTPCE",$J,ECDTE)) Q:'ECDTE D Q:ECOUT
|
|
.S ECDT=$$FMTE^XLFDT(ECDTE,2),ECL=0
|
|
.F S ECL=$O(^TMP("ECNTPCE",$J,ECDTE,ECL)) Q:'ECL D Q:ECOUT
|
|
..S ECLN=$P($G(^DIC(4,ECL,0)),U),ECLN=$S(ECLN="":"UNKNOWN",1:ECLN),ECD=0
|
|
..F S ECD=$O(^TMP("ECNTPCE",$J,ECDTE,ECL,ECD)) Q:'ECD D Q:ECOUT
|
|
...S ECDN=$P($G(^ECD(ECD,0)),U),ECDN=$S(ECDN="":"UNKNOWN",1:ECDN)
|
|
...S ECDFN=0
|
|
...F S ECDFN=$O(^TMP("ECNTPCE",$J,ECDTE,ECL,ECD,ECDFN)) Q:'ECDFN D Q:ECOUT
|
|
....S DFN=ECDFN D DEM^VADPT
|
|
....S ECPAT=VADM(1),ECSSN=$P($P(VADM(2),U,2),"-",3),ECNT=0
|
|
....F S ECNT=$O(^TMP("ECNTPCE",$J,ECDTE,ECL,ECD,ECDFN,ECNT)) Q:'ECNT D PR2 Q:ECOUT
|
|
Q
|
|
;
|
|
PR2 S ECEC=$G(^TMP("ECNTPCE",$J,ECDTE,ECL,ECD,ECDFN,ECNT))
|
|
S ECPS="",ECFN=$P(ECEC,U)
|
|
D PROV
|
|
S ECAT=$S($P(ECEC,U,2):$P($G(^EC(726,$P(ECEC,U,2),0)),U),1:"")
|
|
I $P(ECEC,U,3)'="" S ECDE=+$P(ECEC,U,3) D
|
|
.I $P(ECEC,U,3)[";EC" D Q
|
|
..S ECPS=$G(^EC(725,+ECDE,0)),ECPS=$P(ECPS,U,2)_" "_$P(ECPS,U)
|
|
.S ECPS=$$CPT^ICPTCOD(ECDE,ECDTE)
|
|
.S ECPS=$S(+ECPS>0:$P(ECPS,U,2)_" "_$P(ECPS,U,3),1:"CPT NAME UNKNOWN")
|
|
S ECRS=^ECH(ECFN,"R")
|
|
W ECDT,?16,$E(ECPAT,1,20),?39,ECSSN,?44,$E(ECUN1,1,16),?61,$E($P(ECRS,";"),1,19),!
|
|
W $E(ECLN,1,15),?16,$E(ECPS,1,27),?44,$E(ECUN2,1,16)
|
|
W ?61,$E($P(ECRS,";",2),1,19),!
|
|
W $E(ECDN,1,15),?16,$E(ECAT,1,27),?44,$E(ECUN3,1,16)
|
|
W ?61,$E($P(ECRS,";",3),1,198)
|
|
S ECUN=0 F ECX=4:1 S ECUN=$O(ECPRV(ECUN)) Q:(ECUN="")&($P(ECRS,";",ECX)="") D I ECOUT Q
|
|
.W !
|
|
.I ($Y+6)>IOSL D PAGE I ECOUT Q
|
|
.I ECUN'="" W ?44,$E($P(ECPRV(ECUN),"^",2),1,16) K ECPRV(ECUN)
|
|
.W ?61,$E($P(ECRS,";",ECX),1,19)
|
|
W !!
|
|
I ($Y+6)>IOSL D PAGE I ECOUT Q
|
|
Q
|
|
PROV ;Set provider 1-3 in variables
|
|
M ECPRV=^TMP("ECNTPCE",$J,ECDTE,ECL,ECD,ECDFN,ECNT,"PRV")
|
|
S ECUN=0,ECUN1="UNKNOWN",(ECUN2,ECUN3)=""
|
|
F I=1:1:3 S ECUN=$O(ECPRV(ECUN)) Q:'ECUN D
|
|
.S @("ECUN"_I)=$P(ECPRV(ECUN),"^",2) K ECPRV(ECUN)
|
|
Q
|