PXCOMPACTBKGRND ;ALB/BPA,CMC - Background job routine for COMPACT Act administrative eligibility ;12/23/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**240,246**;Aug 12, 1996;Build 14
; *246* Background routine for COMPACT Act administrative eligibility
; Reference to $$ELIG^DGCOMPACTELIG in ICR #7462
;
Q
;
CHECKELG ;
N DFN,MESSAGE,PXCURELG,PXENDDT,PXEOCNUM,PXEOCSEQ,PXLSTELG
S DFN=""
; Loop through the "B" level of the episode of care file (#818)
F S DFN=$O(^PXCOMP(818,"B",DFN)) Q:DFN="" D
. S (PXCURELG,PXENDDT,PXEOCNUM,PXEOCSEQ,PXLSTELG)=""
. I $$ASC^PXCOMPACT(DFN)="N" Q
. ; Check the current administrative eligibility
. S PXCURELG=$$ELIG^DGCOMPACTELIG(DFN,"PXCOMPACTBKGRND")
. ; Convert the web service value to compare to the stored values in EoC
. S PXCURELG=$S(PXCURELG="ELIGIBLE":"E",PXCURELG="NOT ELIGIBLE":"N",1:"U")
. ; Get the episode of care number and sequence
. S PXEOCNUM=$$GETEOC^PXCOMPACT(DFN),PXEOCSEQ=$$GETEOCSEQ^PXCOMPACT(DFN)
. S PXENDDT=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)
. ; If the episode has ended, this would not need to be checked
. I PXENDDT'="" Q
. S PXLSTELG=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)
. I PXCURELG'=PXLSTELG D
. . S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)=PXCURELG
. . ; If current eligibility is N (Not Eligible) close the episode by calling the end episode API
. . I PXCURELG="N" D
. . . D SETENDDT^PXCOMPACT(DFN,DT,"PR")
. . . S $P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",6)="R",$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)="A"
Q
;
BCKGRDJOB ;
N DFN,ENDDT,PXLASTSEQ,PXEOCNUM,PXTY
;this is a background job that will identify episodes of care that have expired and end them
S DFN=""
F S DFN=$O(^PXCOMP(818,"B",DFN)) Q:DFN="" D
. S PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
. ;check EOC OPEN/CLOSE flag (1 = open, 0 = closed)
. I $P(^PXCOMP(818,PXEOCNUM,0),"^",2)=0 Q
. ;check if episode is Inpatient or Outpatient
. S PXTY=$P(^PXCOMP(818,PXEOCNUM,0),"^",3)
. I PXTY="" Q
. ;get latest episode of care sequence
. S PXLASTSEQ=$$GETEOCSEQ^PXCOMPACT(DFN)
. ;now verify the corresponding Inpatient/Outpatient benefit end date and compare to today
. I PXTY="I" S ENDDT=$P($G(^PXCOMP(818,PXEOCNUM,10,PXLASTSEQ,0)),"^",4)
. I PXTY="O" S ENDDT=$P($G(^PXCOMP(818,PXEOCNUM,10,PXLASTSEQ,0)),"^",5)
. I ENDDT="" Q
. I DT>ENDDT D
. . D SETENDDT^PXCOMPACT(DFN,ENDDT,"TE",,"Time expired")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCOMPACTBKGRND 2441 printed Apr 22, 2026@14:25:28 Page 2
PXCOMPACTBKGRND ;ALB/BPA,CMC - Background job routine for COMPACT Act administrative eligibility ;12/23/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**240,246**;Aug 12, 1996;Build 14
+2 ; *246* Background routine for COMPACT Act administrative eligibility
+3 ; Reference to $$ELIG^DGCOMPACTELIG in ICR #7462
+4 ;
+5 QUIT
+6 ;
CHECKELG ;
+1 NEW DFN,MESSAGE,PXCURELG,PXENDDT,PXEOCNUM,PXEOCSEQ,PXLSTELG
+2 SET DFN=""
+3 ; Loop through the "B" level of the episode of care file (#818)
+4 FOR
SET DFN=$ORDER(^PXCOMP(818,"B",DFN))
if DFN=""
QUIT
Begin DoDot:1
+5 SET (PXCURELG,PXENDDT,PXEOCNUM,PXEOCSEQ,PXLSTELG)=""
+6 IF $$ASC^PXCOMPACT(DFN)="N"
QUIT
+7 ; Check the current administrative eligibility
+8 SET PXCURELG=$$ELIG^DGCOMPACTELIG(DFN,"PXCOMPACTBKGRND")
+9 ; Convert the web service value to compare to the stored values in EoC
+10 SET PXCURELG=$SELECT(PXCURELG="ELIGIBLE":"E",PXCURELG="NOT ELIGIBLE":"N",1:"U")
+11 ; Get the episode of care number and sequence
+12 SET PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
SET PXEOCSEQ=$$GETEOCSEQ^PXCOMPACT(DFN)
+13 SET PXENDDT=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)
+14 ; If the episode has ended, this would not need to be checked
+15 IF PXENDDT'=""
QUIT
+16 SET PXLSTELG=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)
+17 IF PXCURELG'=PXLSTELG
Begin DoDot:2
+18 SET $PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)=PXCURELG
+19 ; If current eligibility is N (Not Eligible) close the episode by calling the end episode API
+20 IF PXCURELG="N"
Begin DoDot:3
+21 DO SETENDDT^PXCOMPACT(DFN,DT,"PR")
+22 SET $PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",6)="R"
SET $PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)="A"
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
BCKGRDJOB ;
+1 NEW DFN,ENDDT,PXLASTSEQ,PXEOCNUM,PXTY
+2 ;this is a background job that will identify episodes of care that have expired and end them
+3 SET DFN=""
+4 FOR
SET DFN=$ORDER(^PXCOMP(818,"B",DFN))
if DFN=""
QUIT
Begin DoDot:1
+5 SET PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
+6 ;check EOC OPEN/CLOSE flag (1 = open, 0 = closed)
+7 IF $PIECE(^PXCOMP(818,PXEOCNUM,0),"^",2)=0
QUIT
+8 ;check if episode is Inpatient or Outpatient
+9 SET PXTY=$PIECE(^PXCOMP(818,PXEOCNUM,0),"^",3)
+10 IF PXTY=""
QUIT
+11 ;get latest episode of care sequence
+12 SET PXLASTSEQ=$$GETEOCSEQ^PXCOMPACT(DFN)
+13 ;now verify the corresponding Inpatient/Outpatient benefit end date and compare to today
+14 IF PXTY="I"
SET ENDDT=$PIECE($GET(^PXCOMP(818,PXEOCNUM,10,PXLASTSEQ,0)),"^",4)
+15 IF PXTY="O"
SET ENDDT=$PIECE($GET(^PXCOMP(818,PXEOCNUM,10,PXLASTSEQ,0)),"^",5)
+16 IF ENDDT=""
QUIT
+17 IF DT>ENDDT
Begin DoDot:2
+18 DO SETENDDT^PXCOMPACT(DFN,ENDDT,"TE",,"Time expired")
End DoDot:2
End DoDot:1
+19 QUIT
