PXCOMPACTAPI ;ALB/BPA,CMC - API to extract COMPACT Act Episode of Care file (818);05/03/2024@10:58
;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
; API will meet the needs / approved by VistA Scheduling May 1, 2023 and will meet the
; needs of data sharing with VA Enrollment System for Episode of Care Start and End Dates
;
Q
;
BATCH(DFNARRAY,ARRAY) ;
; Input: DFNARARY array
; Output: ARRAY array
; ARRAY(DFN,"EPISODE",episodeSequence,"INFO")=Episode Start Date^Episode End Date^Administrative Eligibility^EOC OPEN/CLOSE Y/N
; ARRAY(DFN,"EPISODE",episodeSequence,"VISIT",visitSequence)="Visit^Treatment Related to Compact"
; ARRAY(DFN,"EPISODE",episodeSequence,"PTF",ptfSequence)="PTF^Treatment Related to Compact"
; accept an array of DFNs to get COMPACT status
N ADMIN,ASC,DFN,ENDDT,PTF,PXEOCNUM,PXIEN,PXPTFSQ,PXSEQ,PXVSTSQ,STARTDT,VISIT
S DFN=""
F S DFN=$O(DFNARRAY(DFN)) Q:DFN="" D
. ;verify if they're in the COMPACT file first
. I '$D(^PXCOMP(818,"B",DFN)) S ARRAY(DFN,"NOEPISODES")="" Q
. S PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
. S PXIEN=$O(^PXCOMP(818,"B",DFN,""))
. S ASC=$$GET1^DIQ(818,PXIEN,2)
. I $D(^PXCOMP(818,PXEOCNUM,10,0)) D
. . ;start gathering all episode data
. . S PXIEN="",PXSEQ=0
. . F S PXSEQ=$O(^PXCOMP(818,PXEOCNUM,10,PXSEQ)) Q:(PXSEQ="B")!(PXSEQ="") D
. . . S PXIEN=PXSEQ_","_PXEOCNUM
. . . S STARTDT=$$GET1^DIQ(818.01,PXIEN,.01)
. . . S ENDDT=$$GET1^DIQ(818.01,PXIEN,2)
. . . S ADMIN=$$GET1^DIQ(818.01,PXIEN,8)
. . . S PXIEN=PXSEQ_","_PXEOCNUM
. . . I $D(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,0)) D
. . . . S PXPTFSQ=0
. . . . F S PXPTFSQ=$O(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,PXPTFSQ)) Q:(PXPTFSQ="")!(PXPTFSQ="B") D
. . . . . S PTF=$P(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,PXPTFSQ,0),"^"),ARRAY(DFN,"EPISODE",PXSEQ,"PTF",PXPTFSQ)=PTF_"^"_$P($G(^DGPT(PTF,70)),"^",33)
. . . I $D(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,0)) D
. . . . S PXVSTSQ=0
. . . . F S PXVSTSQ=$O(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,PXVSTSQ)) Q:(PXVSTSQ="")!(PXVSTSQ="B") D
. . . . . S VISIT=$P(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,PXVSTSQ,0),"^"),ARRAY(DFN,"EPISODE",PXSEQ,"VISIT",PXVSTSQ)=VISIT_"^"_$P($G(^AUPNVSIT(VISIT,800)),"^",19)
. . . S ARRAY(DFN,"EPISODE",PXSEQ,"INFO")=STARTDT_"^"_ENDDT_"^"_ADMIN_"^"_ASC
Q
;
N PXEOCNUM,PXEOCSEQ,PXIENS,PXIPXSQ,PXMOVSEQ,PXNMEP,PXNUMIPX,PXNUMOPX,PXNUMPTF,PXNUMVST,PXPTFSQ,PXOPXSQ,PXVSTSQ
S (PXEOCNUM,PXEOCSEQ)=""
I $G(DFN)="" S PXCOMPACT("COMPACTMSG")="DFN cannot be null" Q
I '$D(^PXCOMP(818,"B",DFN)) S PXCOMPACT("COMPACTMSG")="Patient is not in the COMPACT Episode of Care file" Q
;
K PXCOMPACT
S PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
S PXCOMPACT("PATIENT ID")=DFN
S PXCOMPACT("PATIENT NAME")=$P(^DPT(DFN,0),"^")
I PXEOCNUM="" S PXCOMPACT("NOEPISODES")=""
S PXCOMPACT("EOC OPEN/CLOSE FLAG")=$P(^PXCOMP(818,PXEOCNUM,0),"^",2)
S PXCOMPACT("BENEFIT TYPE")=$P(^PXCOMP(818,PXEOCNUM,0),"^",3)
S PXCOMPACT("EPISODE OF CARE NUMBER")=PXEOCNUM
I $D(^PXCOMP(818,PXEOCNUM,10,0)) D
. S (PXIENS,PXIPXSQ,PXNMEP,PXNUMPTF,PXNUMIPX,PXNUMOPX,PXNUMVST,PXPTFSQ,PXOPXSQ,PXVSTSQ)=""
. ;S PXNMEP=$$GETEOCSEQ^PXCOMPACT(DFN)
. S PXEOCSEQ=""
. F S PXEOCSEQ=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ)) Q:PXEOCSEQ="B" D
. . I PXEOCSEQ=0 Q
. . ;F PXEOCSEQ=1:1:PXNMEP D
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE START DATE")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^")
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE END DATE")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"SOURCE OF CRISIS END")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",3)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"INPATIENT BENEFIT END DATE")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"OUTPATIENT BENEFIT END DATE")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE FINAL STATUS")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",6)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE SOURCE")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"LAST COMPACT ACT ADMIN ELIG")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)
. . ; Gather information from the 10,PXEOCSEQ,1 node
. . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1)) D
. . . S PXCOMPACT("EPISODE",PXEOCSEQ,"CRISIS END AUTHORIZED BY")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^")
. . . S PXCOMPACT("EPISODE",PXEOCSEQ,"CRISIS END OTHER COMMENT")=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^",2)
. . ; Get calculated fields
. . S PXIENS=PXEOCSEQ_","_PXEOCNUM_","
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"REMAINING INPATIENT DAYS")=$$GET1^DIQ(818.01,PXIENS,42)
. . S PXCOMPACT("EPISODE",PXEOCSEQ,"REMAINING OUTPATIENT DAYS")=$$GET1^DIQ(818.01,PXIENS,43)
. . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,0)) D
. . . S PXNUMPTF=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,"B"),-1)
. . . F PXPTFSQ=1:1:PXNUMPTF D
. . . . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ)) D
. . . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"PTF",PXPTFSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,0),"^")
. . . . . S PXMOVSEQ=0
. . . . . F S PXMOVSEQ=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,1,PXMOVSEQ)) Q:(PXMOVSEQ="")!(PXMOVSEQ'?.N) D
. . . . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"PTF",PXPTFSQ,"MOVEMENT",PXMOVSEQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,1,PXMOVSEQ,0),"^")
. . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,0)) D
. . . S PXNUMVST=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,"B"),-1)
. . . F PXVSTSQ=1:1:PXNUMVST D
. . . . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ)) D
. . . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"VISIT",PXVSTSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ,0),"^")
. . . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"VISIT TREATMENT FOR FLAG",PXVSTSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ,0),"^",2)
. I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,0)) D
. . ;Logic for IP extension
. . S PXNUMIPX=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,"B"),-1)
. . F PXIPXSQ=1:1:PXNUMIPX D
. . . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0)) D
. . . . S PXIENS=PXIPXSQ_","_PXEOCSEQ_","_PXEOCNUM
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START DATE",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^")
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN BENEFIT END DATE",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",4)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN REMAINING DAYS",PXIPXSQ)=$$GET1^DIQ(818.02,PXIENS,5)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN DATE TIME CREATED",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",5)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START CREATED BY",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",6)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START AUTHORIZED BY",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",7)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN TYPE OF CARE",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",8)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN COMMENT",PXIPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",9)
. I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,0)) D
. . ;Logic for OP extension
. . S PXNUMOPX=$O(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,"B"),-1)
. . F PXOPXSQ=1:1:PXNUMOPX D
. . . I $D(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0)) D
. . . . S PXIENS=PXOPXSQ_","_PXEOCSEQ_","_PXEOCNUM
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START DATE",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^")
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN BENEFIT END DATE",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",4)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN REMAINING DAYS",PXOPXSQ)=$$GET1^DIQ(818.03,PXIENS,5)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN DATE TIME CREATED",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",5)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START CREATED BY",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",6)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START AUTHORIZED BY",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",7)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN TYPE OF CARE",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",8)
. . . . S PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN COMMENT",PXOPXSQ)=$P(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",9)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCOMPACTAPI 8501 printed Jan 29, 2026@15:26:59 Page 2
PXCOMPACTAPI ;ALB/BPA,CMC - API to extract COMPACT Act Episode of Care file (818);05/03/2024@10:58
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
+2 ; API will meet the needs / approved by VistA Scheduling May 1, 2023 and will meet the
+3 ; needs of data sharing with VA Enrollment System for Episode of Care Start and End Dates
+4 ;
+5 QUIT
+6 ;
BATCH(DFNARRAY,ARRAY) ;
+1 ; Input: DFNARARY array
+2 ; Output: ARRAY array
+3 ; ARRAY(DFN,"EPISODE",episodeSequence,"INFO")=Episode Start Date^Episode End Date^Administrative Eligibility^EOC OPEN/CLOSE Y/N
+4 ; ARRAY(DFN,"EPISODE",episodeSequence,"VISIT",visitSequence)="Visit^Treatment Related to Compact"
+5 ; ARRAY(DFN,"EPISODE",episodeSequence,"PTF",ptfSequence)="PTF^Treatment Related to Compact"
+6 ; accept an array of DFNs to get COMPACT status
+7 NEW ADMIN,ASC,DFN,ENDDT,PTF,PXEOCNUM,PXIEN,PXPTFSQ,PXSEQ,PXVSTSQ,STARTDT,VISIT
+8 SET DFN=""
+9 FOR
SET DFN=$ORDER(DFNARRAY(DFN))
if DFN=""
QUIT
Begin DoDot:1
+10 ;verify if they're in the COMPACT file first
+11 IF '$DATA(^PXCOMP(818,"B",DFN))
SET ARRAY(DFN,"NOEPISODES")=""
QUIT
+12 SET PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
+13 SET PXIEN=$ORDER(^PXCOMP(818,"B",DFN,""))
+14 SET ASC=$$GET1^DIQ(818,PXIEN,2)
+15 IF $DATA(^PXCOMP(818,PXEOCNUM,10,0))
Begin DoDot:2
+16 ;start gathering all episode data
+17 SET PXIEN=""
SET PXSEQ=0
+18 FOR
SET PXSEQ=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXSEQ))
if (PXSEQ="B")!(PXSEQ="")
QUIT
Begin DoDot:3
+19 SET PXIEN=PXSEQ_","_PXEOCNUM
+20 SET STARTDT=$$GET1^DIQ(818.01,PXIEN,.01)
+21 SET ENDDT=$$GET1^DIQ(818.01,PXIEN,2)
+22 SET ADMIN=$$GET1^DIQ(818.01,PXIEN,8)
+23 SET PXIEN=PXSEQ_","_PXEOCNUM
+24 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,0))
Begin DoDot:4
+25 SET PXPTFSQ=0
+26 FOR
SET PXPTFSQ=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,PXPTFSQ))
if (PXPTFSQ="")!(PXPTFSQ="B")
QUIT
Begin DoDot:5
+27 SET PTF=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXSEQ,40,PXPTFSQ,0),"^")
SET ARRAY(DFN,"EPISODE",PXSEQ,"PTF",PXPTFSQ)=PTF_"^"_$PIECE($GET(^DGPT(PTF,70)),"^",33)
End DoDot:5
End DoDot:4
+28 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,0))
Begin DoDot:4
+29 SET PXVSTSQ=0
+30 FOR
SET PXVSTSQ=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,PXVSTSQ))
if (PXVSTSQ="")!(PXVSTSQ="B")
QUIT
Begin DoDot:5
+31 SET VISIT=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXSEQ,41,PXVSTSQ,0),"^")
SET ARRAY(DFN,"EPISODE",PXSEQ,"VISIT",PXVSTSQ)=VISIT_"^"_$PIECE($GET(^AUPNVSIT(VISIT,800)),"^",19)
End DoDot:5
End DoDot:4
+32 SET ARRAY(DFN,"EPISODE",PXSEQ,"INFO")=STARTDT_"^"_ENDDT_"^"_ADMIN_"^"_ASC
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
+1 NEW PXEOCNUM,PXEOCSEQ,PXIENS,PXIPXSQ,PXMOVSEQ,PXNMEP,PXNUMIPX,PXNUMOPX,PXNUMPTF,PXNUMVST,PXPTFSQ,PXOPXSQ,PXVSTSQ
+2 SET (PXEOCNUM,PXEOCSEQ)=""
+3 IF $GET(DFN)=""
SET PXCOMPACT("COMPACTMSG")="DFN cannot be null"
QUIT
+4 IF '$DATA(^PXCOMP(818,"B",DFN))
SET PXCOMPACT("COMPACTMSG")="Patient is not in the COMPACT Episode of Care file"
QUIT
+5 ;
+6 KILL PXCOMPACT
+7 SET PXEOCNUM=$$GETEOC^PXCOMPACT(DFN)
+8 SET PXCOMPACT("PATIENT ID")=DFN
+9 SET PXCOMPACT("PATIENT NAME")=$PIECE(^DPT(DFN,0),"^")
+10 IF PXEOCNUM=""
SET PXCOMPACT("NOEPISODES")=""
+11 SET PXCOMPACT("EOC OPEN/CLOSE FLAG")=$PIECE(^PXCOMP(818,PXEOCNUM,0),"^",2)
+12 SET PXCOMPACT("BENEFIT TYPE")=$PIECE(^PXCOMP(818,PXEOCNUM,0),"^",3)
+13 SET PXCOMPACT("EPISODE OF CARE NUMBER")=PXEOCNUM
+14 IF $DATA(^PXCOMP(818,PXEOCNUM,10,0))
Begin DoDot:1
+15 SET (PXIENS,PXIPXSQ,PXNMEP,PXNUMPTF,PXNUMIPX,PXNUMOPX,PXNUMVST,PXPTFSQ,PXOPXSQ,PXVSTSQ)=""
+16 ;S PXNMEP=$$GETEOCSEQ^PXCOMPACT(DFN)
+17 SET PXEOCSEQ=""
+18 FOR
SET PXEOCSEQ=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ))
if PXEOCSEQ="B"
QUIT
Begin DoDot:2
+19 IF PXEOCSEQ=0
QUIT
+20 ;F PXEOCSEQ=1:1:PXNMEP D
+21 SET PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE START DATE")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^")
+22 SET PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE END DATE")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",2)
+23 SET PXCOMPACT("EPISODE",PXEOCSEQ,"SOURCE OF CRISIS END")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",3)
+24 SET PXCOMPACT("EPISODE",PXEOCSEQ,"INPATIENT BENEFIT END DATE")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",4)
+25 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OUTPATIENT BENEFIT END DATE")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",5)
+26 SET PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE FINAL STATUS")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",6)
+27 SET PXCOMPACT("EPISODE",PXEOCSEQ,"EPISODE SOURCE")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",7)
+28 SET PXCOMPACT("EPISODE",PXEOCSEQ,"LAST COMPACT ACT ADMIN ELIG")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,0),"^",8)
+29 ; Gather information from the 10,PXEOCSEQ,1 node
+30 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1))
Begin DoDot:3
+31 SET PXCOMPACT("EPISODE",PXEOCSEQ,"CRISIS END AUTHORIZED BY")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^")
+32 SET PXCOMPACT("EPISODE",PXEOCSEQ,"CRISIS END OTHER COMMENT")=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,1),"^",2)
End DoDot:3
+33 ; Get calculated fields
+34 SET PXIENS=PXEOCSEQ_","_PXEOCNUM_","
+35 SET PXCOMPACT("EPISODE",PXEOCSEQ,"REMAINING INPATIENT DAYS")=$$GET1^DIQ(818.01,PXIENS,42)
+36 SET PXCOMPACT("EPISODE",PXEOCSEQ,"REMAINING OUTPATIENT DAYS")=$$GET1^DIQ(818.01,PXIENS,43)
+37 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,0))
Begin DoDot:3
+38 SET PXNUMPTF=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,"B"),-1)
+39 FOR PXPTFSQ=1:1:PXNUMPTF
Begin DoDot:4
+40 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ))
Begin DoDot:5
+41 SET PXCOMPACT("EPISODE",PXEOCSEQ,"PTF",PXPTFSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,0),"^")
+42 SET PXMOVSEQ=0
+43 FOR
SET PXMOVSEQ=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,1,PXMOVSEQ))
if (PXMOVSEQ="")!(PXMOVSEQ'?.N)
QUIT
Begin DoDot:6
+44 SET PXCOMPACT("EPISODE",PXEOCSEQ,"PTF",PXPTFSQ,"MOVEMENT",PXMOVSEQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,40,PXPTFSQ,1,PXMOVSEQ,0),"^")
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+45 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,0))
Begin DoDot:3
+46 SET PXNUMVST=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,"B"),-1)
+47 FOR PXVSTSQ=1:1:PXNUMVST
Begin DoDot:4
+48 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ))
Begin DoDot:5
+49 SET PXCOMPACT("EPISODE",PXEOCSEQ,"VISIT",PXVSTSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ,0),"^")
+50 SET PXCOMPACT("EPISODE",PXEOCSEQ,"VISIT TREATMENT FOR FLAG",PXVSTSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,41,PXVSTSQ,0),"^",2)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+51 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,0))
Begin DoDot:2
+52 ;Logic for IP extension
+53 SET PXNUMIPX=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,"B"),-1)
+54 FOR PXIPXSQ=1:1:PXNUMIPX
Begin DoDot:3
+55 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0))
Begin DoDot:4
+56 SET PXIENS=PXIPXSQ_","_PXEOCSEQ_","_PXEOCNUM
+57 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START DATE",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^")
+58 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN BENEFIT END DATE",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",4)
+59 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN REMAINING DAYS",PXIPXSQ)=$$GET1^DIQ(818.02,PXIENS,5)
+60 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN DATE TIME CREATED",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",5)
+61 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START CREATED BY",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",6)
+62 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN START AUTHORIZED BY",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",7)
+63 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN TYPE OF CARE",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",8)
+64 SET PXCOMPACT("EPISODE",PXEOCSEQ,"IP EXTN COMMENT",PXIPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,20,PXIPXSQ,0),"^",9)
End DoDot:4
End DoDot:3
End DoDot:2
+65 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,0))
Begin DoDot:2
+66 ;Logic for OP extension
+67 SET PXNUMOPX=$ORDER(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,"B"),-1)
+68 FOR PXOPXSQ=1:1:PXNUMOPX
Begin DoDot:3
+69 IF $DATA(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0))
Begin DoDot:4
+70 SET PXIENS=PXOPXSQ_","_PXEOCSEQ_","_PXEOCNUM
+71 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START DATE",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^")
+72 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN BENEFIT END DATE",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",4)
+73 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN REMAINING DAYS",PXOPXSQ)=$$GET1^DIQ(818.03,PXIENS,5)
+74 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN DATE TIME CREATED",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",5)
+75 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START CREATED BY",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",6)
+76 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN START AUTHORIZED BY",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",7)
+77 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN TYPE OF CARE",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",8)
+78 SET PXCOMPACT("EPISODE",PXEOCSEQ,"OP EXTN COMMENT",PXOPXSQ)=$PIECE(^PXCOMP(818,PXEOCNUM,10,PXEOCSEQ,30,PXOPXSQ,0),"^",9)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+79 QUIT
