Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRCAPPH1

LRCAPPH1.m

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