- 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
