ABMCVAPI ; IHS/SD/SDR - 3PB CPT/ICD/MODIFIER API
;;2.6;IHS 3P BILLING SYSTEM;**4,9,10,14,27**;NOV 12, 2009;Build 486
;
; New routine - v2.6
;IHS/SD/SDR 2.6*14 002F - replaced ICDDX^ICDCODE with ICDDX^ICDEX for ICD-10
;IHS/SD/SDR 2.6*14 009 - made it so API can be called without a date for reports
;IHS/SD/SDR 2.6*14 HEAT165197 (CR3109) - Added NUM tag to return numeric, comparable value; also added COD tag to reverse NUM
;IHS/SD/SDR 2.6*27 CR8894 Updated to call CPT^ICPTCOD as many times as necessary to find the active CPT based on the CODE sent;
; currently the CPT can be in the CPT file multiple times with different IENs. If the CPT is DINUMed, CPT^ICPTCOD will return
; the DINUMed entry which may not be the active entry.
;
CPT(CODE,CDT,SRC,DFN) ;PEP - returns info about requested CPT entry
I $$VERSION^XPDUTL("BCSV")>0 S A=$$CPT^ICPTCOD(CODE,CDT,"","") Q A ;abm*2.6*27 IHS/SD/SDR CR8894
E S A=$$PRCSVCPT(CODE,CDT) Q A ;abm*2.6*27 IHS/SD/SDR CR8894
;start new abm*2.6*27 IHS/SD/SDR CR8894
;S A=0
;I $$VERSION^XPDUTL("BCSV")>0 D
;.S A=$$CPT^ICPTCOD(CODE,CDT,"","")
;.I $P(A,U,7)'=0 Q ;found entry is active, use it
;.N B
;.S B=0
;.S A=0
;.F S B=$O(^ICPT("B",CODE,B)) Q:'B D Q:A
;..S A=$$CPT^ICPTCOD(B,CDT,"","")
;..I $P(A,U,7)=0 S A=0
;I +A Q A ;an active CPT entry was found in the above method; stop here
;I $$VERSION^XPDUTL("BCSV")'>0 S A=$$PRCSVCPT(CODE,CDT) Q A
;Q A
;end new abm*2.6*27 IHS/SD/SDR CR8894
;****************************************************************
PRCSVCPT(CODE,CDT) ;EP - build Pre-CSV IHS CPT string
N ABMZCPT,ABMCPT
;D GETS^DIQ(81,CODE,"*","IE","ABMZCPT") ;abm*2.6*9 NOHEAT
D GETS^DIQ(81,+CODE,"*","IE","ABMZCPT") ;abm*2.6*9 NOHEAT
S ABMCPT=CODE
;start old code abm*2.6*9
;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",.01,"E")) ;IEN and code
;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",2,"E")) ;Short desc.
;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",3,"I")) ;CPT category IEN
;S ABMCPT=ABMCPT_"^^"_$G(ABMZCPT(81,CODE_",",7,"I")) ;Source (null) and Eff. date
;S ABMCPT=ABMCPT_"^^"_$G(ABMZCPT(81,CODE_",",8,"I")) ;Status (null) and inact. date
;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",7,"I")) ;Activation date
;end old code start new code
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,+CODE_",",.01,"E")) ;IEN and code
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,+CODE_",",2,"E")) ;Short desc.
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,+CODE_",",3,"I")) ;CPT category IEN
S ABMCPT=ABMCPT_"^^"_$G(ABMZCPT(81,+CODE_",",7,"I")) ;Source (null) and Eff. date
S ABMCPT=ABMCPT_"^1^"_$G(ABMZCPT(81,+CODE_",",8,"I")) ;Status (null) and inact. date
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,+CODE_",",7,"I")) ;Activation date
;end new code
Q ABMCPT
IHSCPT(CODE,CDT) ;EP - return IHS-numberspaced fields in string
N ABMCPT
I CDT="" S CDT=DT
D GETS^DIQ(81,CODE,"9999999.01:9999999.04","IE","ABMZCPT")
S ABMCPT=CODE ;CPT code (p1)
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",9999999.01,"E")) ;starred procedure (p2)
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",9999999.02,"E")) ;default revenue code (p3)
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",9999999.03,"E")) ;relative value (p4)
S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",9999999.04,"E")) ;global surgical procedure (p5)
;
I $$VERSION^XPDUTL("BCSV")>0 D Q ABMCPT
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.05,"E") ;ASC payment group (p6)
.;start old code abm*2.6*10 HEAT59419
.;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.06,"E") ;date added (p7)
.;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.07,"E") ;date deleted (p8)
.;end old code start new code HEAT59419
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.06,"I") ;date added (p7)
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.07,"I") ;date deleted (p8)
.;end new code HEAT59419
I $$VERSION^XPDUTL("BCSV")'>0 D
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",6,"E") ;ASC payment group (p6)
.;start old code abm*2.6*10 HEAT59419
.;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",7,"E") ;date added (p7)
.;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",8,"E") ;date deleted (p8)
.;end old code start new code HEAT59419
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",7,"I") ;date added (p7)
.S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",8,"I") ;date deleted (p8)
.;end new code HEAT59419
Q ABMCPT
IHSCPTD(CODE,OUTARR,DFN,CDT) ;PEP - returns info about requested ICD entry
I $$VERSION^XPDUTL("BCSV")>0 D CPTD^ICPTCOD(CODE,OUTARR,DFN,CDT) Q OUTARR
E D Q OUTARR
.D GET1^DIQ(81,CODE,50,"IE",OUTARR,"ABMZE")
;****************************************************************
;
DX(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD DX entry
I $D(^DIC(9.8,"B","ICDEX")) S A=$$ICDDX^ICDEX(CODE,$S($G(CDT):CDT,1:""),"","I") Q A ;API call for ICD-10 ;abm*2.6*14 ICD10 002F and 009
;I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDDX^ICDCODE(CODE,CDT,"","") Q A ;abm*2.6*14 ICD10 002F
I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDDX^ICDCODE(CODE,$S($G(CDT):CDT,1:""),"","") Q A ;abm*2.6*14 ICD10 009
E S A=$$PRCSVDX(CODE,CDT) Q A
;
PRCSVDX(CODE,CDT) ;EP - build Pre-CSV IHS ICD DX string
N ABMZDX,ABMDX
D GETS^DIQ(80,CODE,"*","IE","ABMZDX")
S ABMDX=CODE
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",.01,"E")) ;IEN and DX code
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",2,"E")) ;Identifier
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",3,"I")) ;Diagnosis (short desc.)
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",101,"I")) ;Unacceptable as Principal DX
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",5,"I")) ;MDC
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",5.5,"I")) ;MDC13
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",70,"I")) ;Compl/Comorb
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",5.5,"I")) ;MDC13
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",8,"I")) ;ICD expanded
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",100,"I")) ;Inactive flag
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",9.5,"I")) ;Sex
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",102,"I")) ;Inactive Date
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",5.7,"I")) ;MDC24
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",5.9,"I")) ;MDC25
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",9999999.01,"I")) ;Lower Age
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",9999999.02,"I")) ;Upper Age
S ABMDX=ABMDX_"^"_$G(ABMZDX(80,CODE_",",9999999.04,"I")) ;Date Added
Q ABMDX
ICDDX(IEN,CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD entry
;I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDD^ICDCODE(CODE,CDT) Q A ;abm*2.6*4 HEAT19688
I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDD^ICDCODE(CODE,"ABMZCPTD",CDT) Q A ;abm*2.6*4 HEAT19688
E D Q A
.S A=$$GET1^DIQ(80,IEN,10,"IE","","ABMZDX")
;************************************************************************
ICDOP(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD PX entry
I $D(^DIC(9.8,"B","ICDEX")) S A=$$ICDOP^ICDEX(CODE,CDT,"","I") Q A ;API call for ICD-10 ;abm*2.6*14 ICD10 002H
I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDOP^ICDCODE(CODE,CDT,"","") Q A
E S A=$$PRCSVOP(CODE,CDT) Q A
;****************************************************************
PRCSVOP(CODE,CDT) ;EP - build Pre-CSV IHS ICD PX string
N ABMZOP,ABMOP
D GETS^DIQ(80.1,CODE,"*","IE","ABMZOP")
S ABMOP=CODE
S ABMOP=ABMOP_"^"_$G(ABMZOP(80.1,CODE_",",.01,"E")) ;IEN and PX code
S ABMOP=ABMOP_"^"_$G(ABMZOP(80.1,CODE_",",2,"E")) ;Identifier
S ABMOP=ABMOP_"^"_$G(ABMZOP(80.1,CODE_",",5,"I")) ;MDC24
S ABMOP=ABMOP_"^"_$G(ABMZOP(80.1,CODE_",",4,"I")) ;Oper/Proc. (short desc.)
Q ABMOP
ICDDOP(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD entry
I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDD^ICDCODE(CODE,CDT) Q A
E D Q A
.S A=$$GET1^DIQ(80.1,CODE,10,"IE","","ABMZDX")
;*********************************************************************
CAT(CAT,DFN) ;PEP - returns CPT Category info
I $$VERSION^XPDUTL("BCSV")>0 S A=$$CAT^ICPTAPIU(CAT,DFN) Q A
E S A=$$PRCSVCAT(CAT,DFN) Q A
PRCSVCAT(CAT,DFN) ;EP - build pre-CSV IHS CPT Category string
N ABMZCAT,ABMCAT
D GETS^DIQ(81.1,CODE,"*","IE","ABMZCAT")
S ABMCAT=$G(ABMZCAT(81.1,CODE_",",.01,"E")) ;CAT name
S ABMCAT=ABMCAT_"^^"_$G(ABMZCAT(81.1,CODE_",",3,"I")) ;Source and Major IEN
S ABMCAT=ABMCAT_"^^"_$G(ABMZCAT(81.1,CODE_",",3,"E")) ;Major Category Name
Q ABMCAT
IHSCAT(CAT,DFN) ;PEP - returns IHS specific CPT Category fields
N ABMCAT
D GETS^DIQ(81.1,CAT,"9999999.01:9999999.03","IE","ABMZCAT")
S ABMCAT=$G(ABMZCAT(81,CAT_",",9999999.01,"E")) ;default rev code (p1)
S ABMCAT=ABMCAT_"^"_$G(ABMZCAT(81,CAT_",",9999999.02,"E")) ;previous modifier prompt (p2)
S ABMCAT=ABMCAT_"^"_$G(ABMZCAT(81,CAT_",",9999999.03,"E")) ;first CPT code (p3)
Q ABMCAT
;*********************************************************************
MOD(MOD,MFT,MDT,SRC,DFN) ;PEP - returns Modifier array
I $$VERSION^XPDUTL("BCSV")>0 S A=$$MOD^ICPTMOD(MOD,MFT,MDT,"","") Q A
E S A=$$PRCSVMOD(MOD) Q A
PRCSVMOD(MOD) ;EP - build pre-CSV Modifer array
N ABMZMOD,ABMMOD
D GETS^DIQ(9999999.88,MOD,"*","IE","ABMZMOD")
Q:'$D(ABMZMOD) 0
S ABMMOD=MOD
S ABMMOD=ABMMOD_"^"_$G(ABMZMOD(9999999.88,MOD_",",.01,"E")) ;MOD code
S ABMMOD=ABMMOD_"^"_$G(ABMZMOD(9999999.88,MOD_",",.02,"E")) ;MOD name
Q ABMMOD
;start new abm*2.6*14 HEAT165197 (CR3109)
NUM(CODE) ;EP - returns numeric value for ICD DX
I $D(^DIC(9.8,"B","ICDEX")) S A=$$NUM^ICDEX(CODE) Q A
S CODE=$G(CODE) Q:'$L($G(CODE)) 0
N PSN,OUT,CHR,ERR S ERR=0,OUT="" F PSN=1:1:9 D
.S CHR=$E(CODE,PSN) S CHR=$S($L(CHR):$A(CHR),1:32),CHR=CHR-30
.S:CHR'>0 ERR=1 F Q:$L(CHR)>1 S CHR="0"_CHR
.S:$L(CHR)'=2 ERR=1 S OUT=OUT_CHR
Q:ERR -1 S:+OUT>0 OUT="1"_OUT
Q OUT
;end new HEAT165197
ABMCVAPI ; IHS/SD/SDR - 3PB CPT/ICD/MODIFIER API
+1 ;;2.6;IHS 3P BILLING SYSTEM;**4,9,10,14,27**;NOV 12, 2009;Build 486
+2 ;
+3 ; New routine - v2.6
+4 ;IHS/SD/SDR 2.6*14 002F - replaced ICDDX^ICDCODE with ICDDX^ICDEX for ICD-10
+5 ;IHS/SD/SDR 2.6*14 009 - made it so API can be called without a date for reports
+6 ;IHS/SD/SDR 2.6*14 HEAT165197 (CR3109) - Added NUM tag to return numeric, comparable value; also added COD tag to reverse NUM
+7 ;IHS/SD/SDR 2.6*27 CR8894 Updated to call CPT^ICPTCOD as many times as necessary to find the active CPT based on the CODE sent;
+8 ; currently the CPT can be in the CPT file multiple times with different IENs. If the CPT is DINUMed, CPT^ICPTCOD will return
+9 ; the DINUMed entry which may not be the active entry.
+10 ;
CPT(CODE,CDT,SRC,DFN) ;PEP - returns info about requested CPT entry
+1 ;abm*2.6*27 IHS/SD/SDR CR8894
IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$CPT^ICPTCOD(CODE,CDT,"","")
QUIT A
+2 ;abm*2.6*27 IHS/SD/SDR CR8894
IF '$TEST
SET A=$$PRCSVCPT(CODE,CDT)
QUIT A
+3 ;start new abm*2.6*27 IHS/SD/SDR CR8894
+4 ;S A=0
+5 ;I $$VERSION^XPDUTL("BCSV")>0 D
+6 ;.S A=$$CPT^ICPTCOD(CODE,CDT,"","")
+7 ;.I $P(A,U,7)'=0 Q ;found entry is active, use it
+8 ;.N B
+9 ;.S B=0
+10 ;.S A=0
+11 ;.F S B=$O(^ICPT("B",CODE,B)) Q:'B D Q:A
+12 ;..S A=$$CPT^ICPTCOD(B,CDT,"","")
+13 ;..I $P(A,U,7)=0 S A=0
+14 ;I +A Q A ;an active CPT entry was found in the above method; stop here
+15 ;I $$VERSION^XPDUTL("BCSV")'>0 S A=$$PRCSVCPT(CODE,CDT) Q A
+16 ;Q A
+17 ;end new abm*2.6*27 IHS/SD/SDR CR8894
+18 ;****************************************************************
PRCSVCPT(CODE,CDT) ;EP - build Pre-CSV IHS CPT string
+1 NEW ABMZCPT,ABMCPT
+2 ;D GETS^DIQ(81,CODE,"*","IE","ABMZCPT") ;abm*2.6*9 NOHEAT
+3 ;abm*2.6*9 NOHEAT
DO GETS^DIQ(81,+CODE,"*","IE","ABMZCPT")
+4 SET ABMCPT=CODE
+5 ;start old code abm*2.6*9
+6 ;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",.01,"E")) ;IEN and code
+7 ;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",2,"E")) ;Short desc.
+8 ;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",3,"I")) ;CPT category IEN
+9 ;S ABMCPT=ABMCPT_"^^"_$G(ABMZCPT(81,CODE_",",7,"I")) ;Source (null) and Eff. date
+10 ;S ABMCPT=ABMCPT_"^^"_$G(ABMZCPT(81,CODE_",",8,"I")) ;Status (null) and inact. date
+11 ;S ABMCPT=ABMCPT_"^"_$G(ABMZCPT(81,CODE_",",7,"I")) ;Activation date
+12 ;end old code start new code
+13 ;IEN and code
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,+CODE_",",.01,"E"))
+14 ;Short desc.
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,+CODE_",",2,"E"))
+15 ;CPT category IEN
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,+CODE_",",3,"I"))
+16 ;Source (null) and Eff. date
SET ABMCPT=ABMCPT_"^^"_$GET(ABMZCPT(81,+CODE_",",7,"I"))
+17 ;Status (null) and inact. date
SET ABMCPT=ABMCPT_"^1^"_$GET(ABMZCPT(81,+CODE_",",8,"I"))
+18 ;Activation date
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,+CODE_",",7,"I"))
+19 ;end new code
+20 QUIT ABMCPT
IHSCPT(CODE,CDT) ;EP - return IHS-numberspaced fields in string
+1 NEW ABMCPT
+2 IF CDT=""
SET CDT=DT
+3 DO GETS^DIQ(81,CODE,"9999999.01:9999999.04","IE","ABMZCPT")
+4 ;CPT code (p1)
SET ABMCPT=CODE
+5 ;starred procedure (p2)
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,CODE_",",9999999.01,"E"))
+6 ;default revenue code (p3)
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,CODE_",",9999999.02,"E"))
+7 ;relative value (p4)
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,CODE_",",9999999.03,"E"))
+8 ;global surgical procedure (p5)
SET ABMCPT=ABMCPT_"^"_$GET(ABMZCPT(81,CODE_",",9999999.04,"E"))
+9 ;
+10 IF $$VERSION^XPDUTL("BCSV")>0
Begin DoDot:1
+11 ;ASC payment group (p6)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.05,"E")
+12 ;start old code abm*2.6*10 HEAT59419
+13 ;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.06,"E") ;date added (p7)
+14 ;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.07,"E") ;date deleted (p8)
+15 ;end old code start new code HEAT59419
+16 ;date added (p7)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.06,"I")
+17 ;date deleted (p8)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",9999999.07,"I")
+18 ;end new code HEAT59419
End DoDot:1
QUIT ABMCPT
+19 IF $$VERSION^XPDUTL("BCSV")'>0
Begin DoDot:1
+20 ;ASC payment group (p6)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",6,"E")
+21 ;start old code abm*2.6*10 HEAT59419
+22 ;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",7,"E") ;date added (p7)
+23 ;S ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",8,"E") ;date deleted (p8)
+24 ;end old code start new code HEAT59419
+25 ;date added (p7)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",7,"I")
+26 ;date deleted (p8)
SET ABMCPT=ABMCPT_"^"_$$GET1^DIQ(81,CODE_",",8,"I")
+27 ;end new code HEAT59419
End DoDot:1
+28 QUIT ABMCPT
IHSCPTD(CODE,OUTARR,DFN,CDT) ;PEP - returns info about requested ICD entry
+1 IF $$VERSION^XPDUTL("BCSV")>0
DO CPTD^ICPTCOD(CODE,OUTARR,DFN,CDT)
QUIT OUTARR
+2 IF '$TEST
Begin DoDot:1
+3 DO GET1^DIQ(81,CODE,50,"IE",OUTARR,"ABMZE")
End DoDot:1
QUIT OUTARR
+4 ;****************************************************************
+5 ;
DX(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD DX entry
+1 ;API call for ICD-10 ;abm*2.6*14 ICD10 002F and 009
IF $DATA(^DIC(9.8,"B","ICDEX"))
SET A=$$ICDDX^ICDEX(CODE,$SELECT($GET(CDT):CDT,1:""),"","I")
QUIT A
+2 ;I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDDX^ICDCODE(CODE,CDT,"","") Q A ;abm*2.6*14 ICD10 002F
+3 ;abm*2.6*14 ICD10 009
IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$ICDDX^ICDCODE(CODE,$SELECT($GET(CDT):CDT,1:""),"","")
QUIT A
+4 IF '$TEST
SET A=$$PRCSVDX(CODE,CDT)
QUIT A
+5 ;
PRCSVDX(CODE,CDT) ;EP - build Pre-CSV IHS ICD DX string
+1 NEW ABMZDX,ABMDX
+2 DO GETS^DIQ(80,CODE,"*","IE","ABMZDX")
+3 SET ABMDX=CODE
+4 ;IEN and DX code
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",.01,"E"))
+5 ;Identifier
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",2,"E"))
+6 ;Diagnosis (short desc.)
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",3,"I"))
+7 ;Unacceptable as Principal DX
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",101,"I"))
+8 ;MDC
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",5,"I"))
+9 ;MDC13
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",5.5,"I"))
+10 ;Compl/Comorb
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",70,"I"))
+11 ;MDC13
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",5.5,"I"))
+12 ;ICD expanded
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",8,"I"))
+13 ;Inactive flag
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",100,"I"))
+14 ;Sex
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",9.5,"I"))
+15 ;Inactive Date
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",102,"I"))
+16 ;MDC24
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",5.7,"I"))
+17 ;MDC25
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",5.9,"I"))
+18 ;Lower Age
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",9999999.01,"I"))
+19 ;Upper Age
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",9999999.02,"I"))
+20 ;Date Added
SET ABMDX=ABMDX_"^"_$GET(ABMZDX(80,CODE_",",9999999.04,"I"))
+21 QUIT ABMDX
ICDDX(IEN,CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD entry
+1 ;I $$VERSION^XPDUTL("BCSV")>0 S A=$$ICDD^ICDCODE(CODE,CDT) Q A ;abm*2.6*4 HEAT19688
+2 ;abm*2.6*4 HEAT19688
IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$ICDD^ICDCODE(CODE,"ABMZCPTD",CDT)
QUIT A
+3 IF '$TEST
Begin DoDot:1
+4 SET A=$$GET1^DIQ(80,IEN,10,"IE","","ABMZDX")
End DoDot:1
QUIT A
+5 ;************************************************************************
ICDOP(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD PX entry
+1 ;API call for ICD-10 ;abm*2.6*14 ICD10 002H
IF $DATA(^DIC(9.8,"B","ICDEX"))
SET A=$$ICDOP^ICDEX(CODE,CDT,"","I")
QUIT A
+2 IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$ICDOP^ICDCODE(CODE,CDT,"","")
QUIT A
+3 IF '$TEST
SET A=$$PRCSVOP(CODE,CDT)
QUIT A
+4 ;****************************************************************
PRCSVOP(CODE,CDT) ;EP - build Pre-CSV IHS ICD PX string
+1 NEW ABMZOP,ABMOP
+2 DO GETS^DIQ(80.1,CODE,"*","IE","ABMZOP")
+3 SET ABMOP=CODE
+4 ;IEN and PX code
SET ABMOP=ABMOP_"^"_$GET(ABMZOP(80.1,CODE_",",.01,"E"))
+5 ;Identifier
SET ABMOP=ABMOP_"^"_$GET(ABMZOP(80.1,CODE_",",2,"E"))
+6 ;MDC24
SET ABMOP=ABMOP_"^"_$GET(ABMZOP(80.1,CODE_",",5,"I"))
+7 ;Oper/Proc. (short desc.)
SET ABMOP=ABMOP_"^"_$GET(ABMZOP(80.1,CODE_",",4,"I"))
+8 QUIT ABMOP
ICDDOP(CODE,CDT,SRC,DFN) ;PEP - returns info about requested ICD entry
+1 IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$ICDD^ICDCODE(CODE,CDT)
QUIT A
+2 IF '$TEST
Begin DoDot:1
+3 SET A=$$GET1^DIQ(80.1,CODE,10,"IE","","ABMZDX")
End DoDot:1
QUIT A
+4 ;*********************************************************************
CAT(CAT,DFN) ;PEP - returns CPT Category info
+1 IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$CAT^ICPTAPIU(CAT,DFN)
QUIT A
+2 IF '$TEST
SET A=$$PRCSVCAT(CAT,DFN)
QUIT A
PRCSVCAT(CAT,DFN) ;EP - build pre-CSV IHS CPT Category string
+1 NEW ABMZCAT,ABMCAT
+2 DO GETS^DIQ(81.1,CODE,"*","IE","ABMZCAT")
+3 ;CAT name
SET ABMCAT=$GET(ABMZCAT(81.1,CODE_",",.01,"E"))
+4 ;Source and Major IEN
SET ABMCAT=ABMCAT_"^^"_$GET(ABMZCAT(81.1,CODE_",",3,"I"))
+5 ;Major Category Name
SET ABMCAT=ABMCAT_"^^"_$GET(ABMZCAT(81.1,CODE_",",3,"E"))
+6 QUIT ABMCAT
IHSCAT(CAT,DFN) ;PEP - returns IHS specific CPT Category fields
+1 NEW ABMCAT
+2 DO GETS^DIQ(81.1,CAT,"9999999.01:9999999.03","IE","ABMZCAT")
+3 ;default rev code (p1)
SET ABMCAT=$GET(ABMZCAT(81,CAT_",",9999999.01,"E"))
+4 ;previous modifier prompt (p2)
SET ABMCAT=ABMCAT_"^"_$GET(ABMZCAT(81,CAT_",",9999999.02,"E"))
+5 ;first CPT code (p3)
SET ABMCAT=ABMCAT_"^"_$GET(ABMZCAT(81,CAT_",",9999999.03,"E"))
+6 QUIT ABMCAT
+7 ;*********************************************************************
MOD(MOD,MFT,MDT,SRC,DFN) ;PEP - returns Modifier array
+1 IF $$VERSION^XPDUTL("BCSV")>0
SET A=$$MOD^ICPTMOD(MOD,MFT,MDT,"","")
QUIT A
+2 IF '$TEST
SET A=$$PRCSVMOD(MOD)
QUIT A
PRCSVMOD(MOD) ;EP - build pre-CSV Modifer array
+1 NEW ABMZMOD,ABMMOD
+2 DO GETS^DIQ(9999999.88,MOD,"*","IE","ABMZMOD")
+3 IF '$DATA(ABMZMOD)
QUIT 0
+4 SET ABMMOD=MOD
+5 ;MOD code
SET ABMMOD=ABMMOD_"^"_$GET(ABMZMOD(9999999.88,MOD_",",.01,"E"))
+6 ;MOD name
SET ABMMOD=ABMMOD_"^"_$GET(ABMZMOD(9999999.88,MOD_",",.02,"E"))
+7 QUIT ABMMOD
+8 ;start new abm*2.6*14 HEAT165197 (CR3109)
NUM(CODE) ;EP - returns numeric value for ICD DX
+1 IF $DATA(^DIC(9.8,"B","ICDEX"))
SET A=$$NUM^ICDEX(CODE)
QUIT A
+2 SET CODE=$GET(CODE)
IF '$LENGTH($GET(CODE))
QUIT 0
+3 NEW PSN,OUT,CHR,ERR
SET ERR=0
SET OUT=""
FOR PSN=1:1:9
Begin DoDot:1
+4 SET CHR=$EXTRACT(CODE,PSN)
SET CHR=$SELECT($LENGTH(CHR):$ASCII(CHR),1:32)
SET CHR=CHR-30
+5 IF CHR'>0
SET ERR=1
FOR
IF $LENGTH(CHR)>1
QUIT
SET CHR="0"_CHR
+6 IF $LENGTH(CHR)'=2
SET ERR=1
SET OUT=OUT_CHR
End DoDot:1
+7 IF ERR
QUIT -1
IF +OUT>0
SET OUT="1"_OUT
+8 QUIT OUT
+9 ;end new HEAT165197
