192 lines
8.6 KiB
Mathematica
192 lines
8.6 KiB
Mathematica
LRCAPPH1 ;DALOI/SED/RKS/KLL - PROCESS PHLEBOTOMY WORKLOAD DATA CONT ;07/30/04
|
|
;;5.2;LAB SERVICE;**127,136,138,158,263,264,274,291,359,308**;Sep 27, 1994
|
|
; Reference to ^SC( Supported by DBIA #1482
|
|
; Reference to $$CODM^ICPTCOD Supported by DBIA #1995-A
|
|
; Reference to $$CPT^ICPTCOD Supported by DBIA #1995-A
|
|
; Reference to $$DATA2PCE^PXAPI Supported by DBIA #1889-A
|
|
; Reference to $$DELVFILE^PXAPI Supported by DBIA #1889-B
|
|
; Reference to ENCEVENT^PXKENC Supported by DBIA #1889-F
|
|
; Reference to $$NOW^XLFDT Supported by Reference #10103
|
|
; Reference to $$GET^XUA4A72 Supported by Reference #1625
|
|
EN3 ;LREDT = PATIENT ENCOUNTER DATE
|
|
N LREDT,LRNOP,LRBEID
|
|
K ^TMP("LRPXAPI",$J),LRXTST,LRVSITN,LRXCPT
|
|
NP ;Not perform entry
|
|
S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=""
|
|
S LREDT=$P($G(^LRO(69,LRCDT,1,LRSN,1)),U)
|
|
N LRDUZ
|
|
Q:+LREDT'>0!('$D(^LR(+NODE,0))#2)
|
|
S:$G(LRDBUG) LREDT=$$NOW^XLFDT
|
|
S EDATE=$P(LREDT,".")
|
|
S:'$P(LREDT,".",2) $P(LREDT,".",2)="1201"
|
|
S LOC=+$P(NODE,U,9),LRNINS=$P(NODE(1),U,8),LRPRO=+$P(NODE,U,6) ;CHECK
|
|
S LRDUZ=+$P(NODE,U,2)
|
|
S LRNINS=$S($P($G(^SC(LOC,0)),U,4):$P(^(0),U,4),$G(LRNINS):LRNINS,1:LRINS)
|
|
S LRPRO=$S($$GET^XUA4A72(LRPRO,EDATE)>0:LRPRO,1:LRDPRAC)
|
|
I $S('$G(LOC):1,"CMZ"'[$P($G(^SC(LOC,0)),U,3):1,1:0) Q
|
|
I $S('DFN:1,'LOC:1,1:0) S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=1 S LRNOP=1 Q
|
|
I 'LRNINS S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=2 S LRNOP=2 Q
|
|
I 'LRPRO S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=3 S LRNOP=3 Q
|
|
Q:$G(LRNP)
|
|
EN5 ;GET THE CPT CODES FOR THE TESTS
|
|
I LRCDT,LRSN,$D(^LRO(69,LRCDT,1,LRSN,2,0)) D
|
|
. S (LRTST,LRCNT,LRXAA)=0 K LRXTST S LRXTST=""
|
|
. F S LRTST=$O(^LRO(69,LRCDT,1,LRSN,2,LRTST)) Q:+LRTST'>0 D
|
|
. . Q:'($D(^LRO(69,LRCDT,1,LRSN,2,LRTST,0))#2) S LREN5=^(0)
|
|
. . Q:$S($P(LREN5,U,12):1,$P(LREN5,U,11):1,1:0) ;Don't send cancel/already sent codes
|
|
. . S LRTSTP=+$P(LREN5,U),LRAA=+$P(LREN5,U,4) Q:$S('LRTSTP:1,'LRAA:1,1:0)
|
|
. . ;Turn off old style PCE reporting for CH subscripts.
|
|
. . ;Data passed via Billing Aware API
|
|
. . I $P($G(^LRO(68,LRAA,0)),U,2)="CH" Q
|
|
. . S LRBEID=$P(^LRO(69,LRCDT,1,LRSN,2,LRTST,.3),U)
|
|
. . I '$G(LRDBUG),$P($G(^LRO(68,LRAA,0)),U,2)'="MI" S $P(^LRO(69,LRCDT,1,LRSN,2,LRTST,0),U,12)=1
|
|
. . I 'LRXAA S LRXAA=LRAA D LOC
|
|
. . Q:'$G(LRDSSID)
|
|
. . I LRXAA'=LRAA,$D(^TMP("LRPXAPI",$J,"PROCEDURE")) D SEND K ^TMP("LRPXAPI",$J) S LRXAA=LRAA D LOC Q:'$G(LRDSSID) D EN6 Q
|
|
. . D EN6
|
|
I $D(^TMP("LRPXAPI",$J,"PROCEDURE")),'$G(^LRO(69,"AA",LRCEX,LROA)) D SEND
|
|
END Q:$G(LRDBUG)
|
|
END0 K ^TMP("LRPXAPI",$J),LRINA,LRREL,LRNLT,CPT,LRPRO,LRICPT,EDATE,LRTST
|
|
K I,LOC,LRI,LRCNT,LRSTP,LRNINS,LROK,LRAA,LRXAA,LRDSSID,LREN5,LRXTST
|
|
K LRNLTN,LRIDT,LRXTSTU,LRXCPT
|
|
Q
|
|
EN6 ;Called from LRCAPPNP
|
|
;Turn off old style PCE reporting for CH subscripts.
|
|
;Data passed via Billing Aware API
|
|
I $G(LRAA),$P($G(^LRO(68,LRAA,0)),U,2)="CH" Q
|
|
S:'$D(^LRO(69,LRCDT,1,LRSN,"PCE")) ^("PCE")=""
|
|
N LRFLG
|
|
S LRNLT=+$P($G(^LAB(60,LRTSTP,64)),U),LRICPT=0
|
|
Q:+LRNLT'>0
|
|
Q:'$D(^LAM("AD",LRNLT,"CPT")) S LRNLTN=$P(^LAM(LRNLT,0),U,2)
|
|
Q:'LRNLTN
|
|
F S LRICPT=$O(^LAM("AD",LRNLT,"CPT",LRICPT)) Q:+LRICPT'>0 S CPT=+$P($G(^LAM(LRNLT,4,LRICPT,0)),U) I CPT,$P(^(0),U,2)="CPT" D
|
|
. ;CPT must be active in file #64 before edit can continue against #81
|
|
. S LRFLG=1
|
|
. S LRREL=$P(^LAM(LRNLT,4,LRICPT,0),U,3),LRINA=$P(^(0),U,4)
|
|
. I LRREL&(LRINA="") S LRFLG=0
|
|
. I LRFLG,EDATE>(LRREL-1)&((EDATE<LRINA)!(LRINA="")) S LRFLG=0
|
|
. Q:'$G(CPT)!(LRFLG)
|
|
. I '$P($$CPT^ICPTCOD(CPT,$P(LREDT,"."),,),U,7) S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=4 Q
|
|
. S LRREL=$P(^LAM(LRNLT,4,LRICPT,0),U,3),LRINA=$P(^(0),U,4)
|
|
. D:LRREL&(LRINA="") SET Q
|
|
. D:EDATE>(LRREL-1)&((EDATE<LRINA)!(LRINA="")) SET
|
|
Q
|
|
LOC ;Called from LRCAPPNP
|
|
I '$G(LRAA) S LRNOP=4 Q
|
|
S LRDSSLOC=$S($G(^LRO(68,+LRAA,.8)):+^(.8),1:LRDLOC)
|
|
I 'LRDSSLOC S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=4 S LRNOP=4 Q
|
|
S LRDSSID=+$P($G(^SC(LRDSSLOC,0)),U,7)
|
|
I 'LRDSSID S:$D(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)=5 S LRNOP=5
|
|
Q
|
|
SET ;SET IF VALID PROCEDURE
|
|
I $G(LRNP),'$D(LRNPX(CPT))#2 Q
|
|
I '$D(^TMP("LRMOD",$J,CPT)) S ^(CPT)="" D
|
|
. N X
|
|
. S X=$$CODM^ICPTCOD(CPT,"^TMP(""LRMOD"",$J,CPT)",,)
|
|
;LRCNT=CPT POSITION IN TABLE LRXCPT
|
|
;LRCCT=LOCATION POSITION IN TABLE LRXCPT
|
|
I $G(LRXCPT(CPT)) S LRCNT=LRXCPT(CPT)
|
|
I '$G(LRXCPT(CPT)) S (LRCNT,LRCCT)=$G(LRCCT)+1,LRXCPT(CPT)=LRCCT
|
|
;S LRCNT=LRXCPT(CPT)
|
|
I '$G(LRNP) S LRXCPT(CPT,"P",LRCNT)=1+$G(LRXCPT(CPT,"P",LRCNT))
|
|
I $G(LRNP) D
|
|
. S LRXCPT(CPT,"P",LRCNT)=($G(LRNPX(CPT))-1)
|
|
. S LRNPX(CPT)=(LRNPX(CPT)-1)
|
|
S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"ENC PROVIDER")=LRPRO
|
|
S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"PROCEDURE")=CPT
|
|
I $G(LRNP) D
|
|
. Q:$G(LRXCPT(CPT,"P",LRCNT))>0
|
|
. S LRXCPT(CPT,"P",LRCNT)=1
|
|
. S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"DELETE")=1
|
|
S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"QTY")=$S($G(LRXCPT(CPT,"P",LRCNT)):LRXCPT(CPT,"P",LRCNT),1:1)
|
|
Q:$G(LRNP)
|
|
I $G(LRXCPT(CPT,"P",LRCNT))>1,$D(^TMP("LRMOD",$J,CPT,59))>0 D
|
|
. S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"MODIFIERS",59)=""
|
|
;If Manual CPT coding always set modifier to 59 to force PCE to add CPT code.
|
|
I $G(LRES) S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"MODIFIERS",59)=""
|
|
I $G(LRAA) D
|
|
.S MOD=$$GMOD^LRBEBA2(LRAA,CPT)
|
|
.I MOD'="" S ^TMP("LRPXAPI",$J,"PROCEDURE",LRCNT,"MODIFIERS",MOD)="" K MOD
|
|
S LRXTST(LRTST)=LRNLTN_U_LRTSTP
|
|
I $G(LRAA),$P($G(^LRO(68,LRAA,0)),U,2)="MI" D
|
|
. Q:('$D(^TMP("LRPXAPI",$J,"PROCEDURE")))
|
|
. ;Get PCE data via Billing Aware API for Microbiology
|
|
. D MICRO1^LRBEBA3(LRCDT,LRSN,LRTST,LRCNT)
|
|
. I '$D(^TMP("LRPXAPI",$J,"PROCEDURE")) S ^LRO(69,"AA",LRCEX,LROA)=9
|
|
Q
|
|
SEND ;BUILD ENCOUNTER INFO Called from LRCAPPNP
|
|
I '$G(LRESCPT) Q:$G(^LRO(69,"AA",$G(LRCEX),$G(LROA)))
|
|
N LRENCDT ; Check for incorrect time
|
|
S LRENCDT=$J(LREDT,7,4),LRENCDT(1)=$P(LRENCDT,".",2)
|
|
S:'LRENCDT(1) LRENCDT(1)=1201
|
|
I $E(LRENCDT(1),3,4)>59 S LRENCDT(1)=$E(LRENCDT(1),1,2)_59
|
|
I $E(LRENCDT(1),1,2)>23 S LRENCDT(1)=23_$E(LRENCDT(1),3,4)
|
|
S $P(LRENCDT,".",2)=LRENCDT(1)
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"DSS ID")=LRDSSID
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=LRENCDT
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"HOS LOC")=LRDSSLOC
|
|
S:LRNINS ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"INSTITUTION")=LRNINS
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"PATIENT")=DFN
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"SERVICE CATEGORY")="X"
|
|
S ^TMP("LRPXAPI",$J,"ENCOUNTER",1,"ENCOUNTER TYPE")="A"
|
|
PCE ;SEND DATA TO PCE
|
|
N LRLNOW,LRAAX
|
|
K LRVSITN S (LROK,LRVSITN)=""
|
|
I $G(LRAA) S LRAAX=$P($G(^LRO(68,LRAA,0)),U,2)
|
|
I ($G(LRAAX)="CH") S LROK=1,LRVSITN=$G(LRBEVSIT)
|
|
I ($G(LRAAX)="MI") D
|
|
. Q:('$D(^TMP("LRPXAPI",$J,"PROCEDURE")))
|
|
. ;Get PCE data via Billing Aware API for Microbiology
|
|
. D MICRO2^LRBEBA3(LRCDT,LRSN)
|
|
. S LROK=$$DATA2PCE^PXAPI("^TMP(""LRPXAPI"",$J)",LRPKG,"LAB DATA",.LRVSITN,$G(LRDUZ))
|
|
. K ^TMP("LRBEDX",$J)
|
|
I (";AU;BB;CY;EM;SP;"[(";"_$G(LRSS)_";"))!(";AU;BB;CY;EM;SP;"[(";"_$G(LRAAX)_";")) D
|
|
.S LROK=$$DATA2PCE^PXAPI("^TMP(""LRPXAPI"",$J)",LRPKG,"LAB DATA",.LRVSITN,$G(LRDUZ))
|
|
I $G(^XTMP("LRPCELOG",0)) D ;Used to log/debug contents of ^TMP("LRPXAPI")
|
|
. F S LRLNOW=$$NOW^XLFDT Q:'$D(^XTMP("LRPCELOG",1,LRLNOW)) H 1
|
|
. S ^XTMP("LRPCELOG",1,LRLNOW,0)=U_$G(LRBEID)_U_$G(LRVSITN)
|
|
. M ^XTMP("LRPCELOG",1,LRLNOW)=^TMP("LRPXAPI",$J)
|
|
W:$G(LRDBUG) !,"LROK = ",LROK,!,$G(LRVSITN)
|
|
Q:$G(LRESCPT)
|
|
I '$G(LRNP),$D(^LRO(69,LRCDT,1,LRSN,"PCE")) S:LRVSITN ^("PCE")=$E(^("PCE")_$S(LROK>0:LRVSITN,1:LROK)_";",1,30) D
|
|
. I LROK<1,$D(^LRO(69,"AA",LRCEX,LROA)) S ^(LROA)=LROK
|
|
EN7 N LRFND,LRPCE
|
|
Q:'$G(LRNP)!(LROK<1)!('LRVSITN)
|
|
S LRPCE=$G(^LRO(69,LRCDT,1,LRSN,"PCE"))
|
|
I '$F(LRPCE,LRVSITN_"-CPT CANC") D
|
|
. S LRFND=$F(LRPCE,LRVSITN) Q:'LRFND
|
|
. I LRFND S LRPCE=$E(LRPCE,1,(LRFND-1))_"-CPT CANC"_$E(LRPCE,LRFND,$L(LRPCE))
|
|
. S ^LRO(69,LRCDT,1,LRSN,"PCE")=$E(LRPCE,1,30)
|
|
CHK ;Determine if any CPT code remain on the encounter, then delete encounter if false
|
|
K ^TMP("PXKENC",$J)
|
|
D ENCEVENT^PXKENC(LRVSITN,1)
|
|
I $O(^TMP("PXKENC",$J,LRVSITN,"CPT",0)) K ^TMP("PXKENC",$J) Q
|
|
S LROK=$$DELVFILE^PXAPI("ALL",$G(LRVSITN),LRPKG,"LAB DATA",0,0,0)
|
|
K ^TMP("PXKENC",$J) Q:LROK<1
|
|
N LRSN
|
|
S LRSN=0
|
|
F S LRSN=$O(^LRO(69,"C",LRCE,LRCDT,LRSN)) Q:LRSN<1 D DELCAN
|
|
Q
|
|
DELCAN ;Mark PCE Encounter number as '-CPT CANC-ENC DEL'
|
|
;LRVSITN = Encounter IEN
|
|
S LRPCE=$G(^LRO(69,LRCDT,1,LRSN,"PCE")) Q:'$L(LRPCE) D
|
|
. Q:'$G(LRVSITN)
|
|
. I $F(LRPCE,LRVSITN_"-CPT CANC-ENC DEL;") Q
|
|
. S LRFND=$F($G(LRPCE),LRVSITN_"-CPT CANC") I LRFND D Q
|
|
. . S LRPCE=$E(LRPCE,1,(LRFND-1))_"-ENC DEL"_$E(LRPCE,LRFND,$L(LRPCE))
|
|
. . S ^LRO(69,LRCDT,1,LRSN,"PCE")=$E(LRPCE,1,30)
|
|
. S LRFND=$F($G(LRPCE),LRVSITN) I LRFND D
|
|
. . S LRPCE=$E(LRPCE,1,(LRFND-1))_"-CPT CANC-ENC DEL"_$E(LRPCE,LRFND,$L(LRPCE))
|
|
. . S ^LRO(69,LRCDT,1,LRSN,"PCE")=$E(LRPCE,1,30)
|
|
Q
|
|
TEST ;
|
|
S:'$G(LRDPRAC) LRDPRAC=DUZ
|
|
S LRDLOC=+$G(^LAB(69.9,1,.8))
|
|
S:'$G(LRPKG) LRPKG=26 S:'$G(LRDBUG) LRDBUG=1 S LRVSIT=2
|
|
S:'$G(LRCDT) LRCDT=DT S:'$G(LRSN) LRSN=1 S NODE=^LRO(69,LRCDT,1,LRSN,0)
|
|
S NODE(1)=^LRO(69,LRCDT,1,LRSN,1)
|
|
S DFN=$P(^LR(+NODE,0),U,3)
|
|
D EN3
|
|
Q
|