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