- 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,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?","")
