BQIUL3 ;APTIV/HC/DB-BQI utilities for Code Set Versioning ; 16 Apr 2008 6:00 PM
;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
;
ICD9(VAL,IDT,PC) ; EP - Return value of CSV pc of the ICD DIAGNOSIS file (#80)
;
;Input Parameter Description:
;VAL ICD DIAGNOSIS internal entry number
;IDT ICD DIAGNOSIS date
;PC piece of the string returned by $$ICDDX^ICDCODE that is being
; requested
N STR
S IDT=$G(IDT)
I $$VERSION^XPDUTL("AICD")>3.51 D
. S SYS=$$CSI^ICDEX(80,VAL)
. S STR=$$ICDDX^ICDEX(VAL,IDT,SYS,"I")
I $$VERSION^XPDUTL("AICD")<4.0 D
. S STR=$S(IDT="":$$ICDDX^ICDCODE(VAL),1:$$ICDDX^ICDCODE(VAL,IDT))
I $P(STR,U)=-1 Q ""
Q $P(STR,U,PC)
;
ICD0(VAL,IDT,PC) ; EP - Return value of CSV pc of the ICD OPERATION/PROCEDURE file (#80.1)
;
;Input Parameter Description:
;VAL ICD OPERATION/PROCEDURE internal entry number
;IDT ICD OPERATION/PROCEDURE date
;PC piece of the string returned by $$ICDOP^ICDCODE that is being
; requested
N STR
S IDT=$G(IDT)
I $$VERSION^XPDUTL("AICD")>3.51 D
. S SYS=$$CSI^ICDEX(80.1,VAL)
. S STR=$$ICDOP^ICDEX(VAL,IDT,SYS,"I")
I $$VERSION^XPDUTL("AICD")<4.0 D
. S STR=$S(IDT="":$$ICDOP^ICDCODE(VAL),1:$$ICDOP^ICDCODE(VAL,IDT))
I $P(STR,U)=-1 Q ""
Q $P(STR,U,PC)
;
ICPT(VAL,IDT,PC) ; EP - Return value of CSV pc of the CPT file (#81)
;
;Input Parameter Description:
;VAL CPT internal entry number
;IDT CPT date
;PC piece of the string returned by $$CPT^ICPTCOD that is being
; requested
N STR
S IDT=$G(IDT)
S STR=$S(IDT="":$$CPT^ICPTCOD(VAL),1:$$CPT^ICPTCOD(VAL,IDT))
I $P(STR,U)=-1 Q ""
Q $P(STR,U,PC)
;
ICDD(FILE,VAL,IDT) ;EP - Return description for ^ICD9 or ^ICD0
; FILE is 80 or 80.1
; VAL is internal entry number
; IDT is the date
;
N EXEC,CODE,OK,ARRAY,DESC,I,QFL,CSYS
S IDT=$G(IDT,""),QFL=0
I $$VERSION^XPDUTL("AICD")<4.0 D I QFL Q ""
. S EXEC="S CODE=$$"_FILE_"("_VAL_","_IDT_",2)"
. X EXEC
. I CODE="" S QFL=1 Q
. S OK=$$ICDD^ICDCODE(CODE,"ARRAY",IDT)
. I OK=-1 S QFL=1
I $$VERSION^XPDUTL("AICD")>3.51 D I OK=-1 Q ""
. S CSYS=$$CSI^ICDEX(FILE,VAL)
. S OK=$$ICDDESC^ICDXCODE(CSYS,VAL,IDT,.ARRAY)
;
S DESC="" F I=1:1 Q:'$D(ARRAY(I)) Q:ARRAY(I)=" " S DESC=DESC_ARRAY(I)_" "
S DESC=$$TKO^BQIUL1(DESC," ")
Q DESC
;
PUNC(X) ;EP
Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?","")
BQIUL3 ;APTIV/HC/DB-BQI utilities for Code Set Versioning ; 16 Apr 2008 6:00 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**2**;May 24, 2016;Build 14
+2 ;
ICD9(VAL,IDT,PC) ; EP - Return value of CSV pc of the ICD DIAGNOSIS file (#80)
+1 ;
+2 ;Input Parameter Description:
+3 ;VAL ICD DIAGNOSIS internal entry number
+4 ;IDT ICD DIAGNOSIS date
+5 ;PC piece of the string returned by $$ICDDX^ICDCODE that is being
+6 ; requested
+7 NEW STR
+8 SET IDT=$GET(IDT)
+9 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:1
+10 SET SYS=$$CSI^ICDEX(80,VAL)
+11 SET STR=$$ICDDX^ICDEX(VAL,IDT,SYS,"I")
End DoDot:1
+12 IF $$VERSION^XPDUTL("AICD")<4.0
Begin DoDot:1
+13 SET STR=$SELECT(IDT="":$$ICDDX^ICDCODE(VAL),1:$$ICDDX^ICDCODE(VAL,IDT))
End DoDot:1
+14 IF $PIECE(STR,U)=-1
QUIT ""
+15 QUIT $PIECE(STR,U,PC)
+16 ;
ICD0(VAL,IDT,PC) ; EP - Return value of CSV pc of the ICD OPERATION/PROCEDURE file (#80.1)
+1 ;
+2 ;Input Parameter Description:
+3 ;VAL ICD OPERATION/PROCEDURE internal entry number
+4 ;IDT ICD OPERATION/PROCEDURE date
+5 ;PC piece of the string returned by $$ICDOP^ICDCODE that is being
+6 ; requested
+7 NEW STR
+8 SET IDT=$GET(IDT)
+9 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:1
+10 SET SYS=$$CSI^ICDEX(80.1,VAL)
+11 SET STR=$$ICDOP^ICDEX(VAL,IDT,SYS,"I")
End DoDot:1
+12 IF $$VERSION^XPDUTL("AICD")<4.0
Begin DoDot:1
+13 SET STR=$SELECT(IDT="":$$ICDOP^ICDCODE(VAL),1:$$ICDOP^ICDCODE(VAL,IDT))
End DoDot:1
+14 IF $PIECE(STR,U)=-1
QUIT ""
+15 QUIT $PIECE(STR,U,PC)
+16 ;
ICPT(VAL,IDT,PC) ; EP - Return value of CSV pc of the CPT file (#81)
+1 ;
+2 ;Input Parameter Description:
+3 ;VAL CPT internal entry number
+4 ;IDT CPT date
+5 ;PC piece of the string returned by $$CPT^ICPTCOD that is being
+6 ; requested
+7 NEW STR
+8 SET IDT=$GET(IDT)
+9 SET STR=$SELECT(IDT="":$$CPT^ICPTCOD(VAL),1:$$CPT^ICPTCOD(VAL,IDT))
+10 IF $PIECE(STR,U)=-1
QUIT ""
+11 QUIT $PIECE(STR,U,PC)
+12 ;
ICDD(FILE,VAL,IDT) ;EP - Return description for ^ICD9 or ^ICD0
+1 ; FILE is 80 or 80.1
+2 ; VAL is internal entry number
+3 ; IDT is the date
+4 ;
+5 NEW EXEC,CODE,OK,ARRAY,DESC,I,QFL,CSYS
+6 SET IDT=$GET(IDT,"")
SET QFL=0
+7 IF $$VERSION^XPDUTL("AICD")<4.0
Begin DoDot:1
+8 SET EXEC="S CODE=$$"_FILE_"("_VAL_","_IDT_",2)"
+9 XECUTE EXEC
+10 IF CODE=""
SET QFL=1
QUIT
+11 SET OK=$$ICDD^ICDCODE(CODE,"ARRAY",IDT)
+12 IF OK=-1
SET QFL=1
End DoDot:1
IF QFL
QUIT ""
+13 IF $$VERSION^XPDUTL("AICD")>3.51
Begin DoDot:1
+14 SET CSYS=$$CSI^ICDEX(FILE,VAL)
+15 SET OK=$$ICDDESC^ICDXCODE(CSYS,VAL,IDT,.ARRAY)
End DoDot:1
IF OK=-1
QUIT ""
+16 ;
+17 SET DESC=""
FOR I=1:1
IF '$DATA(ARRAY(I))
QUIT
IF ARRAY(I)=" "
QUIT
SET DESC=DESC_ARRAY(I)_" "
+18 SET DESC=$$TKO^BQIUL1(DESC," ")
+19 QUIT DESC
+20 ;
PUNC(X) ;EP
+1 QUIT $TRANSLATE(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?","")
