ABMCPTCK ; IHS/SD/SDR - Claim Summary-CPT check ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p9 - task 2
; Created routine to check for existance of CPT codes
; in V files. Visit DFN (ABMVDFN) and list of CPTs (ABMLIST) must be passed
; IHS/SD/SDR - v2.5 p10 - IM20329
; Added Published Entry Point to return list of CPTs on visit
;
; IHS/SD/SDR - v2.6 CSV
;
CPTCHK(ABMVDFN,ABMLIST) ;PEP-Check if CPT codes exist on visit
Q:$G(ABMVDFN)=""
S ABMCFLG=0
D VISIT Q:ABMCFLG=1 ABMCFLG
D PROC Q:ABMCFLG=1 ABMCFLG
D PATED Q:ABMCFLG=1 ABMCFLG
D CPT Q:ABMCFLG=1 ABMCFLG
D TRANS Q:ABMCFLG=1 ABMCFLG
D LINEITEM Q:ABMCFLG=1 ABMCFLG
Q ABMCFLG
CPTLIST(ABMPCDFN) ;PEP-create list of CPTs on visit
S ABMCPTS=1
K ABMLIST
S ABMVDFN=0
F S ABMVDFN=$O(^ABMDCLM(DUZ(2),ABMPCDFN,11,ABMVDFN)) Q:+ABMVDFN=0 D
.D VISIT
.D PROC
.D PATED
.D CPT
.D TRANS
.D LINEITEM
Q ABMCPTS
VISIT ; note: must be in range 99201-99499 (E&M codes)
S ABMCFLG=0
Q:$P($G(^AUPNVSIT(ABMVDFN,0)),U,17)=""
S ABMICPT=$P($G(^AUPNVSIT(ABMVDFN,0)),U,17)
I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
PROC ;
S ABMCFLG=0
S ABMIEN=0
F S ABMIEN=$O(^AUPNVPRC("AD",ABMVDFN,ABMIEN)) Q:+ABMIEN=0 D Q:ABMCFLG=1
.Q:$P($G(^AUPNVPRC(ABMIEN,0)),U,16)=""
.S ABMICPT=$P($G(^AUPNVPRC(ABMIEN,0)),U,16)
.I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
.I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
PATED ;
S ABMCFLG=0
S ABMIEN=0
F S ABMIEN=$O(^AUPNVPED("AD",ABMVDFN,ABMIEN)) Q:+ABMIEN=0 D Q:ABMCFLG=1
.Q:$P($G(^AUPNVPED(ABMIEN,0)),U,9)=""
.S ABMICPT=$P($G(^AUPNVPED(ABMIEN,0)),U,9)
.I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
.I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
CPT ;
S ABMCFLG=0
S ABMIEN=0
F S ABMIEN=$O(^AUPNVCPT("AD",ABMVDFN,ABMIEN)) Q:+ABMIEN=0 D Q:ABMCFLG=1
.Q:$P($G(^AUPNVCPT(ABMIEN,0)),U)=""
.S ABMICPT=$P($G(^AUPNVCPT(ABMIEN,0)),U)
.I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
.I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
TRANS ;
S ABMCFLG=0
S ABMIEN=0
F S ABMIEN=$O(^AUPNVTC("AD",ABMVDFN,ABMIEN)) Q:+ABMIEN=0 D Q:ABMCFLG=1
.Q:$P($G(^AUPNVTC(ABMIEN,0)),U,7)=""
.S ABMICPT=$P($G(^AUPNVTC(ABMIEN,0)),U,7)
.I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
.I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
LINEITEM ;
S ABMCFLG=0
S ABMIEN=0
F S ABMIEN=$O(^AUPNVLI("AD",ABMVDFN,ABMIEN)) Q:+ABMIEN=0 D Q:ABMCFLG=1
.Q:$P($G(^AUPNVLI(ABMIEN,0)),U,15)=""
.S ABMICPT=$P($G(^AUPNVLI(ABMIEN,0)),U,15)
.I $D(ABMLIST($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))) S ABMCFLG=1 ;CSV-c
.I $G(ABMCPTS)=1 S ABMCPTS($P($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))="" ;CSV-c
Q
ABMCPTCK ; IHS/SD/SDR - Claim Summary-CPT check ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p9 - task 2
+4 ; Created routine to check for existance of CPT codes
+5 ; in V files. Visit DFN (ABMVDFN) and list of CPTs (ABMLIST) must be passed
+6 ; IHS/SD/SDR - v2.5 p10 - IM20329
+7 ; Added Published Entry Point to return list of CPTs on visit
+8 ;
+9 ; IHS/SD/SDR - v2.6 CSV
+10 ;
CPTCHK(ABMVDFN,ABMLIST) ;PEP-Check if CPT codes exist on visit
+1 IF $GET(ABMVDFN)=""
QUIT
+2 SET ABMCFLG=0
+3 DO VISIT
IF ABMCFLG=1
QUIT ABMCFLG
+4 DO PROC
IF ABMCFLG=1
QUIT ABMCFLG
+5 DO PATED
IF ABMCFLG=1
QUIT ABMCFLG
+6 DO CPT
IF ABMCFLG=1
QUIT ABMCFLG
+7 DO TRANS
IF ABMCFLG=1
QUIT ABMCFLG
+8 DO LINEITEM
IF ABMCFLG=1
QUIT ABMCFLG
+9 QUIT ABMCFLG
CPTLIST(ABMPCDFN) ;PEP-create list of CPTs on visit
+1 SET ABMCPTS=1
+2 KILL ABMLIST
+3 SET ABMVDFN=0
+4 FOR
SET ABMVDFN=$ORDER(^ABMDCLM(DUZ(2),ABMPCDFN,11,ABMVDFN))
IF +ABMVDFN=0
QUIT
Begin DoDot:1
+5 DO VISIT
+6 DO PROC
+7 DO PATED
+8 DO CPT
+9 DO TRANS
+10 DO LINEITEM
End DoDot:1
+11 QUIT ABMCPTS
VISIT ; note: must be in range 99201-99499 (E&M codes)
+1 SET ABMCFLG=0
+2 IF $PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,17)=""
QUIT
+3 SET ABMICPT=$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,17)
+4 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+5 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
+6 QUIT
PROC ;
+1 SET ABMCFLG=0
+2 SET ABMIEN=0
+3 FOR
SET ABMIEN=$ORDER(^AUPNVPRC("AD",ABMVDFN,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVPRC(ABMIEN,0)),U,16)=""
QUIT
+5 SET ABMICPT=$PIECE($GET(^AUPNVPRC(ABMIEN,0)),U,16)
+6 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+7 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
End DoDot:1
IF ABMCFLG=1
QUIT
+8 QUIT
PATED ;
+1 SET ABMCFLG=0
+2 SET ABMIEN=0
+3 FOR
SET ABMIEN=$ORDER(^AUPNVPED("AD",ABMVDFN,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVPED(ABMIEN,0)),U,9)=""
QUIT
+5 SET ABMICPT=$PIECE($GET(^AUPNVPED(ABMIEN,0)),U,9)
+6 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+7 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
End DoDot:1
IF ABMCFLG=1
QUIT
+8 QUIT
CPT ;
+1 SET ABMCFLG=0
+2 SET ABMIEN=0
+3 FOR
SET ABMIEN=$ORDER(^AUPNVCPT("AD",ABMVDFN,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVCPT(ABMIEN,0)),U)=""
QUIT
+5 SET ABMICPT=$PIECE($GET(^AUPNVCPT(ABMIEN,0)),U)
+6 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+7 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
End DoDot:1
IF ABMCFLG=1
QUIT
+8 QUIT
TRANS ;
+1 SET ABMCFLG=0
+2 SET ABMIEN=0
+3 FOR
SET ABMIEN=$ORDER(^AUPNVTC("AD",ABMVDFN,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVTC(ABMIEN,0)),U,7)=""
QUIT
+5 SET ABMICPT=$PIECE($GET(^AUPNVTC(ABMIEN,0)),U,7)
+6 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+7 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
End DoDot:1
IF ABMCFLG=1
QUIT
+8 QUIT
LINEITEM ;
+1 SET ABMCFLG=0
+2 SET ABMIEN=0
+3 FOR
SET ABMIEN=$ORDER(^AUPNVLI("AD",ABMVDFN,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^AUPNVLI(ABMIEN,0)),U,15)=""
QUIT
+5 SET ABMICPT=$PIECE($GET(^AUPNVLI(ABMIEN,0)),U,15)
+6 ;CSV-c
IF $DATA(ABMLIST($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2)))
SET ABMCFLG=1
+7 ;CSV-c
IF $GET(ABMCPTS)=1
SET ABMCPTS($PIECE($$CPT^ABMCVAPI(ABMICPT,ABMP("VDT")),U,2))=""
End DoDot:1
IF ABMCFLG=1
QUIT
+8 QUIT
