PXCOMPACTDISP ;ALB/BPA,CMC - API to display COMPACT Act Episode of Care file (818);08/06/2024@10:58
;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
; API will display multiple data elements from the COMPACT Act Episode of Care file
;
Q
EN ;
N AUTHBY,DFN,DIC,ENDSOURCE,EPSEQ,LASTFLAG,LASTSTAT,MOVEMENT,MOVESEQ,PTF,PTFSEQ,PXCOMPACT,PXEOCNUM,SOURCE,VISIT,VISITSEQ,Y,%
W ! S DIC="^PXCOMP(818,",DIC(0)="AEQMZ" D ^DIC
Q:Y=-1
S DFN=$P(Y,"^",2)
D EXTRACT^PXCOMPACTAPI(DFN,.PXCOMPACT)
W !!!,"Patient Name: "_$G(PXCOMPACT("PATIENT NAME"))
W !,"Patient Id: "_$G(PXCOMPACT("PATIENT ID"))
W !,"Benefit Type: "_$S($G(PXCOMPACT("BENEFIT TYPE"))="O":"Outpatient",$G(PXCOMPACT("BENEFIT TYPE"))="I":"Inpatient",1:"")
W !,"Episode of Care Open/Closed: "_$S($G(PXCOMPACT("EOC OPEN/CLOSE FLAG"))=1:"Open",1:"Closed")
W !
D LOOP
W !,"Would you like to view another patient" S %=2 D YN^DICN I %=1 G EN
Q
;
LOOP ;
S EPSEQ=""
F S EPSEQ=$O(PXCOMPACT("EPISODE",EPSEQ)) Q:EPSEQ="" D
. W !,"Episode Start Date: "_$$FMTE^XLFDT($G(PXCOMPACT("EPISODE",EPSEQ,"EPISODE START DATE")))
. W !,"Episode End Date: "_$$FMTE^XLFDT($G(PXCOMPACT("EPISODE",EPSEQ,"EPISODE END DATE")))
. W !,"Outpatient Benefit End Date: "_$$FMTE^XLFDT($G(PXCOMPACT("EPISODE",EPSEQ,"OUTPATIENT BENEFIT END DATE")))
. W !,"Inpatient Benefit End Date: "_$$FMTE^XLFDT($G(PXCOMPACT("EPISODE",EPSEQ,"INPATIENT BENEFIT END DATE")))
. W !,"Remaining Inpatient Days: "_$G(PXCOMPACT("EPISODE",EPSEQ,"REMAINING INPATIENT DAYS"))
. W !,"Remaining Outpatient Days: "_$G(PXCOMPACT("EPISODE",EPSEQ,"REMAINING OUTPATIENT DAYS"))
. S ENDSOURCE=$G(PXCOMPACT("EPISODE",EPSEQ,"SOURCE OF CRISIS END"))
. W !,"Source of Crisis End: "_$S(ENDSOURCE="PR":"Provider",ENDSOURCE="PA":"Patient","TE":"Time Expired",1:"")
. S SOURCE=$G(PXCOMPACT("EPISODE",EPSEQ,"EPISODE SOURCE"))
. W !,"Episode Source: "_$S(SOURCE="A":"Auto Adjudication",SOURCE="V":"VistA",1:"")
. S LASTFLAG=$G(PXCOMPACT("EPISODE",EPSEQ,"LAST COMPACT ACT ADMIN ELIG"))
. W !,"Last COMPACT Act Admin Eligibility Flag: "_$S(LASTFLAG="E":"Eligible",LASTFLAG="N":"Not Eligible",LASTFLAG="U":"Undetermined",1:"")
. S LASTSTAT=$G(PXCOMPACT("EPISODE",EPSEQ,"EPISODE FINAL STATUS"))
. W !,"Episode Final Status: "_$S(LASTSTAT="R":"Rollback",LASTSTAT="E":"Entered in Error",1:"")
. S AUTHBY=$G(PXCOMPACT("EPISODE",EPSEQ,"CRISIS END AUTHORIZED BY"))
. I AUTHBY'="" W !,"Crisis End Authorized By: "_$P($G(^VA(200,AUTHBY,0)),"^")
. W !,"Crisis End Other Comment: "_$G(PXCOMPACT("EPISODE",EPSEQ,"CRISIS END OTHER COMMENT"))
. S PTFSEQ=""
. F S PTFSEQ=$O(PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ)) Q:PTFSEQ="" D
. . S PTF=PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ)
. . I PTF'="" S PTF=$P($G(^DGPT(PTF,0)),"^",2)
. . W !,"PTF: "_$$FMTE^XLFDT(PTF)
. . S MOVESEQ=""
. . F S MOVESEQ=$O(PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ,"MOVEMENT",MOVESEQ)) Q:MOVESEQ="" D
. . . S MOVEMENT=PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ,"MOVEMENT",MOVESEQ)
. . . S MOVEMENT=$P($G(^DGPM(MOVEMENT,0)),"^",1)
. . . W !,"Movement: "_$$FMTE^XLFDT(MOVEMENT)
. S VISITSEQ=""
. F S VISITSEQ=$O(PXCOMPACT("EPISODE",EPSEQ,"VISIT",VISITSEQ)) Q:VISITSEQ="" D
. . S VISIT=$P(PXCOMPACT("EPISODE",EPSEQ,"VISIT",VISITSEQ),"^",1)
. . I VISIT'="" S VISIT=$P($G(^AUPNVSIT(VISIT,0)),"^",1)
. . W !,"Visit: "_$$FMTE^XLFDT(VISIT)
. W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCOMPACTDISP 3388 printed Jan 29, 2026@15:27:01 Page 2
PXCOMPACTDISP ;ALB/BPA,CMC - API to display COMPACT Act Episode of Care file (818);08/06/2024@10:58
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
+2 ; API will display multiple data elements from the COMPACT Act Episode of Care file
+3 ;
+4 QUIT
EN ;
+1 NEW AUTHBY,DFN,DIC,ENDSOURCE,EPSEQ,LASTFLAG,LASTSTAT,MOVEMENT,MOVESEQ,PTF,PTFSEQ,PXCOMPACT,PXEOCNUM,SOURCE,VISIT,VISITSEQ,Y,%
+2 WRITE !
SET DIC="^PXCOMP(818,"
SET DIC(0)="AEQMZ"
DO ^DIC
+3 if Y=-1
QUIT
+4 SET DFN=$PIECE(Y,"^",2)
+5 DO EXTRACT^PXCOMPACTAPI(DFN,.PXCOMPACT)
+6 WRITE !!!,"Patient Name: "_$GET(PXCOMPACT("PATIENT NAME"))
+7 WRITE !,"Patient Id: "_$GET(PXCOMPACT("PATIENT ID"))
+8 WRITE !,"Benefit Type: "_$SELECT($GET(PXCOMPACT("BENEFIT TYPE"))="O":"Outpatient",$GET(PXCOMPACT("BENEFIT TYPE"))="I":"Inpatient",1:"")
+9 WRITE !,"Episode of Care Open/Closed: "_$SELECT($GET(PXCOMPACT("EOC OPEN/CLOSE FLAG"))=1:"Open",1:"Closed")
+10 WRITE !
+11 DO LOOP
+12 WRITE !,"Would you like to view another patient"
SET %=2
DO YN^DICN
IF %=1
GOTO EN
+13 QUIT
+14 ;
LOOP ;
+1 SET EPSEQ=""
+2 FOR
SET EPSEQ=$ORDER(PXCOMPACT("EPISODE",EPSEQ))
if EPSEQ=""
QUIT
Begin DoDot:1
+3 WRITE !,"Episode Start Date: "_$$FMTE^XLFDT($GET(PXCOMPACT("EPISODE",EPSEQ,"EPISODE START DATE")))
+4 WRITE !,"Episode End Date: "_$$FMTE^XLFDT($GET(PXCOMPACT("EPISODE",EPSEQ,"EPISODE END DATE")))
+5 WRITE !,"Outpatient Benefit End Date: "_$$FMTE^XLFDT($GET(PXCOMPACT("EPISODE",EPSEQ,"OUTPATIENT BENEFIT END DATE")))
+6 WRITE !,"Inpatient Benefit End Date: "_$$FMTE^XLFDT($GET(PXCOMPACT("EPISODE",EPSEQ,"INPATIENT BENEFIT END DATE")))
+7 WRITE !,"Remaining Inpatient Days: "_$GET(PXCOMPACT("EPISODE",EPSEQ,"REMAINING INPATIENT DAYS"))
+8 WRITE !,"Remaining Outpatient Days: "_$GET(PXCOMPACT("EPISODE",EPSEQ,"REMAINING OUTPATIENT DAYS"))
+9 SET ENDSOURCE=$GET(PXCOMPACT("EPISODE",EPSEQ,"SOURCE OF CRISIS END"))
+10 WRITE !,"Source of Crisis End: "_$SELECT(ENDSOURCE="PR":"Provider",ENDSOURCE="PA":"Patient","TE":"Time Expired",1:"")
+11 SET SOURCE=$GET(PXCOMPACT("EPISODE",EPSEQ,"EPISODE SOURCE"))
+12 WRITE !,"Episode Source: "_$SELECT(SOURCE="A":"Auto Adjudication",SOURCE="V":"VistA",1:"")
+13 SET LASTFLAG=$GET(PXCOMPACT("EPISODE",EPSEQ,"LAST COMPACT ACT ADMIN ELIG"))
+14 WRITE !,"Last COMPACT Act Admin Eligibility Flag: "_$SELECT(LASTFLAG="E":"Eligible",LASTFLAG="N":"Not Eligible",LASTFLAG="U":"Undetermined",1:"")
+15 SET LASTSTAT=$GET(PXCOMPACT("EPISODE",EPSEQ,"EPISODE FINAL STATUS"))
+16 WRITE !,"Episode Final Status: "_$SELECT(LASTSTAT="R":"Rollback",LASTSTAT="E":"Entered in Error",1:"")
+17 SET AUTHBY=$GET(PXCOMPACT("EPISODE",EPSEQ,"CRISIS END AUTHORIZED BY"))
+18 IF AUTHBY'=""
WRITE !,"Crisis End Authorized By: "_$PIECE($GET(^VA(200,AUTHBY,0)),"^")
+19 WRITE !,"Crisis End Other Comment: "_$GET(PXCOMPACT("EPISODE",EPSEQ,"CRISIS END OTHER COMMENT"))
+20 SET PTFSEQ=""
+21 FOR
SET PTFSEQ=$ORDER(PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ))
if PTFSEQ=""
QUIT
Begin DoDot:2
+22 SET PTF=PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ)
+23 IF PTF'=""
SET PTF=$PIECE($GET(^DGPT(PTF,0)),"^",2)
+24 WRITE !,"PTF: "_$$FMTE^XLFDT(PTF)
+25 SET MOVESEQ=""
+26 FOR
SET MOVESEQ=$ORDER(PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ,"MOVEMENT",MOVESEQ))
if MOVESEQ=""
QUIT
Begin DoDot:3
+27 SET MOVEMENT=PXCOMPACT("EPISODE",EPSEQ,"PTF",PTFSEQ,"MOVEMENT",MOVESEQ)
+28 SET MOVEMENT=$PIECE($GET(^DGPM(MOVEMENT,0)),"^",1)
+29 WRITE !,"Movement: "_$$FMTE^XLFDT(MOVEMENT)
End DoDot:3
End DoDot:2
+30 SET VISITSEQ=""
+31 FOR
SET VISITSEQ=$ORDER(PXCOMPACT("EPISODE",EPSEQ,"VISIT",VISITSEQ))
if VISITSEQ=""
QUIT
Begin DoDot:2
+32 SET VISIT=$PIECE(PXCOMPACT("EPISODE",EPSEQ,"VISIT",VISITSEQ),"^",1)
+33 IF VISIT'=""
SET VISIT=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)
+34 WRITE !,"Visit: "_$$FMTE^XLFDT(VISIT)
End DoDot:2
+35 WRITE !
End DoDot:1
+36 QUIT
