BSTSVICD ;GDIT/HS/BEE-Standard Terminology API Program - ICD Checking ; 5 Nov 2012 9:53 AM
;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
;
Q
;
VRSN(ICD,VDT,PARMS) ;Evaluate whether ICD10 code is active on date
;
NEW RET,DIEN,EFFDT
;
I $G(ICD)="" Q 0
;
;If no VDT, get from PARMS
I $G(VDT)="",$G(PARMS)]"" D
. NEW PC,PRM,VST
. S VST=""
. F PC=1:1:$L(PARMS) S PRM=$P(PARMS,";",PC) X:PRM["VST=" ("S "_PRM) I VST]"" Q
. S VDT=$$GET1^DIQ(9000010,VST_",",.01,"I") S:VDT="" VDT=DT ;Get visit date
I $G(VDT)="" S VDT=DT
;
;Locate the ICD entry
S DIEN=$O(^ICD9("AB",ICD_" ","")) Q:DIEN="" 0
;
;Loop through status multiple to try to find effective range
S RET=1,EFFDT=$O(^ICD9(DIEN,66,"B",VDT),-1) I EFFDT]"" D
. NEW EIEN,STATUS,IENS,DA
. ;
. S EIEN=$O(^ICD9(DIEN,66,"B",EFFDT,"")) Q:EIEN=""
. ;
. ;Get the status
. S DA(1)=DIEN,DA=EIEN,IENS=$$IENS^DILF(.DA)
. S STATUS=$$GET1^DIQ(80.066,IENS,.02,"I")
. I 'STATUS S RET=0
;
Q RET
BSTSVICD ;GDIT/HS/BEE-Standard Terminology API Program - ICD Checking ; 5 Nov 2012 9:53 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
+2 ;
+3 QUIT
+4 ;
VRSN(ICD,VDT,PARMS) ;Evaluate whether ICD10 code is active on date
+1 ;
+2 NEW RET,DIEN,EFFDT
+3 ;
+4 IF $GET(ICD)=""
QUIT 0
+5 ;
+6 ;If no VDT, get from PARMS
+7 IF $GET(VDT)=""
IF $GET(PARMS)]""
Begin DoDot:1
+8 NEW PC,PRM,VST
+9 SET VST=""
+10 FOR PC=1:1:$LENGTH(PARMS)
SET PRM=$PIECE(PARMS,";",PC)
IF PRM["VST="
XECUTE ("S "_PRM)
IF VST]""
QUIT
+11 ;Get visit date
SET VDT=$$GET1^DIQ(9000010,VST_",",.01,"I")
IF VDT=""
SET VDT=DT
End DoDot:1
+12 IF $GET(VDT)=""
SET VDT=DT
+13 ;
+14 ;Locate the ICD entry
+15 SET DIEN=$ORDER(^ICD9("AB",ICD_" ",""))
IF DIEN=""
QUIT 0
+16 ;
+17 ;Loop through status multiple to try to find effective range
+18 SET RET=1
SET EFFDT=$ORDER(^ICD9(DIEN,66,"B",VDT),-1)
IF EFFDT]""
Begin DoDot:1
+19 NEW EIEN,STATUS,IENS,DA
+20 ;
+21 SET EIEN=$ORDER(^ICD9(DIEN,66,"B",EFFDT,""))
IF EIEN=""
QUIT
+22 ;
+23 ;Get the status
+24 SET DA(1)=DIEN
SET DA=EIEN
SET IENS=$$IENS^DILF(.DA)
+25 SET STATUS=$$GET1^DIQ(80.066,IENS,.02,"I")
+26 IF 'STATUS
SET RET=0
End DoDot:1
+27 ;
+28 QUIT RET