PXCOMPACTIB ;ALB/BPA,CMC - Routine for COMPACT Act API for Integrated Billing;05/01/2024@14:33
;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
; Reference to ^SCE in ICR #2065
; Reference to ^DGPT in ICR #1372
; Reference to ^DGPM in ICR #419
Q
;
REQUEST(FILENM,IEN) ;
;FILENM - FileMan File Number
;IEN - Reference in the file
N ANS
I $G(FILENM)="" S ANS="-1^Missing file number" Q ANS
I $G(IEN)="" S ANS="-1^Missing IEN number" Q ANS
;
I FILENM=409.68 D VSTCHK(IEN,.ANS)
I FILENM=45 D PTFCHK(IEN,.ANS)
I FILENM=405 D PTMVMT(IEN,.ANS)
;
I FILENM=9000010,$D(^PXCOMP(818,"COMPACTVISIT",IEN)) S ANS=1
;
I ANS'=1 S ANS=0
Q ANS
;
VSTCHK(IEN,ANS) ;
N VSTIEN
S VSTIEN="",ANS=0 ;Default value of 0 for No
I '$D(^SCE(IEN,0)) Q
S VSTIEN=$P(^SCE(IEN,0),U,5)
I VSTIEN="" Q
;This index will be valued if the visit is Y, VISIT related to COMPACT Act
I $D(^PXCOMP(818,"COMPACTVISIT",VSTIEN)) S ANS=1
Q
;
PTFCHK(IEN,ANS) ;
S ANS=0 ;Default value of 0 for No
I '$D(^DGPT(IEN)) Q
;Check the 33rd piece of the 70 node in the PTF file (TRT FOR ACUTE SUICIDAL CRISIS) for ANS value
I $D(^PXCOMP(818,"PTF",IEN)),$D(^DGPT(IEN,70)) S ANS=$P(^DGPT(IEN,70),U,33)
Q
;
PTMVMT(IEN,ANS) ;
N PTFIEN
S PTFIEN="",ANS=0 ;Default value of 0 for No
I '$D(^DGPM(IEN)) Q
;Look for piece 27 of the zero level for visit IEN
I $P(^DGPM(IEN,0),U,27)'="" D
. I $D(^PXCOMP(818,"COMPACTVISIT",$P(^DGPM(IEN,0),U,27))) S ANS=1
E D
. ;Look for the PTF value in piece 16 of the zero level of the patient movement file
. I $P(^DGPM(IEN,0),U,16)'="" D
. . I $D(^DGPT($P(^DGPM(IEN,0),U,16),70)) S ANS=$P(^DGPT($P(^DGPM(IEN,0),U,16),70),U,33)
. E D
. . ;Look for the parent patient movement record that points to the PTF record
. . I $P(^DGPM(IEN,0),U,14)'="" S PTFIEN=$P(^DGPM($P(^DGPM(IEN,0),U,14),0),U,16)
. . I $G(PTFIEN)'="",$D(^DGPT(PTFIEN,70)) S ANS=$P(^DGPT(PTFIEN,70),U,33)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCOMPACTIB 1961 printed Jan 29, 2026@15:27:05 Page 2
PXCOMPACTIB ;ALB/BPA,CMC - Routine for COMPACT Act API for Integrated Billing;05/01/2024@14:33
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**241**;Aug 12, 1996;Build 31
+2 ; Reference to ^SCE in ICR #2065
+3 ; Reference to ^DGPT in ICR #1372
+4 ; Reference to ^DGPM in ICR #419
+5 QUIT
+6 ;
REQUEST(FILENM,IEN) ;
+1 ;FILENM - FileMan File Number
+2 ;IEN - Reference in the file
+3 NEW ANS
+4 IF $GET(FILENM)=""
SET ANS="-1^Missing file number"
QUIT ANS
+5 IF $GET(IEN)=""
SET ANS="-1^Missing IEN number"
QUIT ANS
+6 ;
+7 IF FILENM=409.68
DO VSTCHK(IEN,.ANS)
+8 IF FILENM=45
DO PTFCHK(IEN,.ANS)
+9 IF FILENM=405
DO PTMVMT(IEN,.ANS)
+10 ;
+11 IF FILENM=9000010
IF $DATA(^PXCOMP(818,"COMPACTVISIT",IEN))
SET ANS=1
+12 ;
+13 IF ANS'=1
SET ANS=0
+14 QUIT ANS
+15 ;
VSTCHK(IEN,ANS) ;
+1 NEW VSTIEN
+2 ;Default value of 0 for No
SET VSTIEN=""
SET ANS=0
+3 IF '$DATA(^SCE(IEN,0))
QUIT
+4 SET VSTIEN=$PIECE(^SCE(IEN,0),U,5)
+5 IF VSTIEN=""
QUIT
+6 ;This index will be valued if the visit is Y, VISIT related to COMPACT Act
+7 IF $DATA(^PXCOMP(818,"COMPACTVISIT",VSTIEN))
SET ANS=1
+8 QUIT
+9 ;
PTFCHK(IEN,ANS) ;
+1 ;Default value of 0 for No
SET ANS=0
+2 IF '$DATA(^DGPT(IEN))
QUIT
+3 ;Check the 33rd piece of the 70 node in the PTF file (TRT FOR ACUTE SUICIDAL CRISIS) for ANS value
+4 IF $DATA(^PXCOMP(818,"PTF",IEN))
IF $DATA(^DGPT(IEN,70))
SET ANS=$PIECE(^DGPT(IEN,70),U,33)
+5 QUIT
+6 ;
PTMVMT(IEN,ANS) ;
+1 NEW PTFIEN
+2 ;Default value of 0 for No
SET PTFIEN=""
SET ANS=0
+3 IF '$DATA(^DGPM(IEN))
QUIT
+4 ;Look for piece 27 of the zero level for visit IEN
+5 IF $PIECE(^DGPM(IEN,0),U,27)'=""
Begin DoDot:1
+6 IF $DATA(^PXCOMP(818,"COMPACTVISIT",$PIECE(^DGPM(IEN,0),U,27)))
SET ANS=1
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 ;Look for the PTF value in piece 16 of the zero level of the patient movement file
+9 IF $PIECE(^DGPM(IEN,0),U,16)'=""
Begin DoDot:2
+10 IF $DATA(^DGPT($PIECE(^DGPM(IEN,0),U,16),70))
SET ANS=$PIECE(^DGPT($PIECE(^DGPM(IEN,0),U,16),70),U,33)
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 ;Look for the parent patient movement record that points to the PTF record
+13 IF $PIECE(^DGPM(IEN,0),U,14)'=""
SET PTFIEN=$PIECE(^DGPM($PIECE(^DGPM(IEN,0),U,14),0),U,16)
+14 IF $GET(PTFIEN)'=""
IF $DATA(^DGPT(PTFIEN,70))
SET ANS=$PIECE(^DGPT(PTFIEN,70),U,33)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
