- LEXQC2 ;ISL/KER - Query - Changes - Save ;04/21/2014
- ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; ^TMP("LEXQC") SACC 2.3.2.5.1
- ; ^TMP("LEXQCO") SACC 2.3.2.5.1
- ;
- ; External References
- ; None
- ;
- ; Local Variables NEWed in LEXQC
- ; LEXCDT Versioning Date
- ;
- EN ; Code Set Changes Main Entry Point
- Q:'$D(^TMP("LEXQC",$J)) N LEXTC S LEXTC=$$TC Q:+LEXTC'>0
- Q:$G(LEXCDT)'?7N N LEXSID,LEXT S LEXT=" "_LEXTC_" Code Set change"
- S:+LEXTC>1!(LEXTC<1) LEXT=LEXT_"s"
- S LEXT=LEXT_" found for "_$$SD^LEXQM($G(LEXCDT)) D BL,TL(LEXT)
- F LEXSID="ICD","ICC","ICP","10D","10P","CPT","CPC","MOD","RAN" D SRC
- Q
- SRC ; By Source - ICD/ICC/ICP/10D/10P/CPT/CPC/MOD/RAN
- Q:"^ICD^ICC^10D^10P^ICP^CPT^CPC^MOD^RAN^"'[("^"_$G(LEXSID)_"^")
- Q:'$D(^TMP("LEXQC",$J,LEXSID)) N LEXCHG S LEXCHG=""
- F S LEXCHG=$O(^TMP("LEXQC",$J,LEXSID,LEXCHG)) Q:'$L(LEXCHG) D CHG
- Q
- CHG ; By Change - ACT/INA/REV/REU/REA
- Q:"^ICD^ICP^10D^10P^CPT^CPC^MOD^RAN^"'[("^"_$G(LEXSID)_"^")
- Q:'$L($G(LEXCHG)) N LEXCNAM,LEXSCT,LEXSNAM S LEXSNAM=""
- S LEXSNAM=$$NAM(LEXSID) Q:'$L($G(LEXSNAM)) S LEXCNAM=$$CHT(LEXCHG)
- Q:'$L(LEXCNAM) S LEXSCT=+($G(^TMP("LEXQC",$J,LEXSID,LEXCHG,0)))
- Q:LEXSCT'>0 S:LEXSCT>1 LEXSNAM=LEXSNAM_"s" S LEXT=LEXSNAM_" "_LEXCNAM
- S LEXT=LEXT_$J(" ",(67-$L(LEXT)))_$J(LEXSCT,5) D BL,TL((" "_LEXT))
- D LST
- Q
- LST ; List Codes
- Q:'$L($G(LEXSID)) Q:'$L($G(LEXCHG))
- Q:'$D(^TMP("LEXQC",$J,LEXSID,LEXCHG,1))
- N LEXS,LEXSC,LEXSO,LEXSOE,LEXLC,LEXSTR,LEXMAX,LEXLEN
- S LEXLEN=8 S:LEXSID="10D"!(LEXSID="10P") LEXLEN=10
- S (LEXLC,LEXSC)=0,(LEXS,LEXSTR)="",LEXMAX=10 S:LEXLEN=10 LEXMAX=8
- F S LEXS=$O(^TMP("LEXQC",$J,LEXSID,LEXCHG,1,LEXS)) Q:'$L(LEXS) D
- . N LEXN S LEXN=$G(^TMP("LEXQC",$J,LEXSID,LEXCHG,1,LEXS))
- . S LEXSO=$$TM^LEXQM($P(LEXN,"^",2)) Q:'$L(LEXSO)
- . S LEXSOE=$$FM(LEXSO,LEXLEN) S LEXSC=LEXSC+1
- . I LEXSC<LEXMAX S LEXSTR=LEXSTR_LEXSOE Q
- . I LEXSC'<LEXMAX D Q
- . . S LEXSTR=$$TM^LEXQM(LEXSTR)
- . . S LEXLC=+LEXLC+1 D:LEXLC=1 BL D TL((" "_LEXSTR))
- . . S LEXSC=1,LEXSTR=LEXSOE Q
- S LEXSTR=$$TM^LEXQM(LEXSTR)
- I $L(LEXSTR) S LEXLC=+LEXLC+1 D:LEXLC=1 BL D TL((" "_LEXSTR))
- Q
- ;
- ; Miscellaneous
- FM(X,Y) ; Format
- S X=$G(X),Y=+($G(Y)) Q:+Y'>0 X S X=X_$J(" ",(Y-$L(X)))
- Q X
- BL ; Blank Line
- D TL(" ") Q
- TL(X) ; Text Line
- N LEXI S LEXI=+($O(^TMP("LEXQCO",$J," "),-1))+1
- S ^TMP("LEXQCO",$J,LEXI)=$G(X),^TMP("LEXQCO",$J,0)=LEXI
- Q
- TC(X) ; Total Changes Found
- N LEXNN,LEXNC,LEXT S LEXT=0 S LEXNN="^TMP(""LEXQC"","_$J_")"
- S LEXNC="^TMP(""LEXQC"","_$J_","
- F S LEXNN=$Q(@LEXNN) Q:'$L(LEXNN)!(LEXNN'[LEXNC) D
- . I LEXNN[",0)" S LEXT=LEXT+($G(@LEXNN))
- S X=LEXT
- Q X
- SH ; Show Temp Global
- N NN,NC W !! S NN="^TMP(""LEXQC"","_$J_")",NC="^TMP(""LEXQC"","_$J_","
- F S NN=$Q(@NN) Q:'$L(NN)!(NN'[NC) W !,NN,"=",@NN
- Q
- NAM(X) ; Source Name
- Q:$G(X)="ICD" "ICD-9 Diagnosis Code"
- Q:$G(X)="ICP" "ICD-9 Procedure Code"
- Q:$G(X)="ICC" "ICD Complication/Comorbidity (CC) Flag"
- Q:$G(X)="10D" "ICD-10 Diagnosis Code"
- Q:$G(X)="10P" "ICD-10 Procedure Code"
- Q:$G(X)="CPT" "CPT-4 Procedure Code"
- Q:$G(X)="CPC" "HCPCS Procedure Code"
- Q:$G(X)="MOD" "CPT Modifier Code"
- Q:$G(X)="RAN" "CPT Modifier Range"
- Q ""
- CHT(X) ; Change Text
- Q:$G(X)="ACT" "Added"
- Q:$G(X)="INA" "Inactivated"
- Q:$G(X)="REV" "Revised"
- Q:$G(X)="UPD" "Updated"
- Q:$G(X)="REU" "Re-used"
- Q:$G(X)="REA" "Re-Activated"
- Q ""
- LEXQC2 ;ISL/KER - Query - Changes - Save ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; ^TMP("LEXQC") SACC 2.3.2.5.1
- +5 ; ^TMP("LEXQCO") SACC 2.3.2.5.1
- +6 ;
- +7 ; External References
- +8 ; None
- +9 ;
- +10 ; Local Variables NEWed in LEXQC
- +11 ; LEXCDT Versioning Date
- +12 ;
- EN ; Code Set Changes Main Entry Point
- +1 IF '$DATA(^TMP("LEXQC",$JOB))
- QUIT
- NEW LEXTC
- SET LEXTC=$$TC
- IF +LEXTC'>0
- QUIT
- +2 IF $GET(LEXCDT)'?7N
- QUIT
- NEW LEXSID,LEXT
- SET LEXT=" "_LEXTC_" Code Set change"
- +3 IF +LEXTC>1!(LEXTC<1)
- SET LEXT=LEXT_"s"
- +4 SET LEXT=LEXT_" found for "_$$SD^LEXQM($GET(LEXCDT))
- DO BL
- DO TL(LEXT)
- +5 FOR LEXSID="ICD","ICC","ICP","10D","10P","CPT","CPC","MOD","RAN"
- DO SRC
- +6 QUIT
- SRC ; By Source - ICD/ICC/ICP/10D/10P/CPT/CPC/MOD/RAN
- +1 IF "^ICD^ICC^10D^10P^ICP^CPT^CPC^MOD^RAN^"'[("^"_$GET(LEXSID)_"^")
- QUIT
- +2 IF '$DATA(^TMP("LEXQC",$JOB,LEXSID))
- QUIT
- NEW LEXCHG
- SET LEXCHG=""
- +3 FOR
- SET LEXCHG=$ORDER(^TMP("LEXQC",$JOB,LEXSID,LEXCHG))
- IF '$LENGTH(LEXCHG)
- QUIT
- DO CHG
- +4 QUIT
- CHG ; By Change - ACT/INA/REV/REU/REA
- +1 IF "^ICD^ICP^10D^10P^CPT^CPC^MOD^RAN^"'[("^"_$GET(LEXSID)_"^")
- QUIT
- +2 IF '$LENGTH($GET(LEXCHG))
- QUIT
- NEW LEXCNAM,LEXSCT,LEXSNAM
- SET LEXSNAM=""
- +3 SET LEXSNAM=$$NAM(LEXSID)
- IF '$LENGTH($GET(LEXSNAM))
- QUIT
- SET LEXCNAM=$$CHT(LEXCHG)
- +4 IF '$LENGTH(LEXCNAM)
- QUIT
- SET LEXSCT=+($GET(^TMP("LEXQC",$JOB,LEXSID,LEXCHG,0)))
- +5 IF LEXSCT'>0
- QUIT
- IF LEXSCT>1
- SET LEXSNAM=LEXSNAM_"s"
- SET LEXT=LEXSNAM_" "_LEXCNAM
- +6 SET LEXT=LEXT_$JUSTIFY(" ",(67-$LENGTH(LEXT)))_$JUSTIFY(LEXSCT,5)
- DO BL
- DO TL((" "_LEXT))
- +7 DO LST
- +8 QUIT
- LST ; List Codes
- +1 IF '$LENGTH($GET(LEXSID))
- QUIT
- IF '$LENGTH($GET(LEXCHG))
- QUIT
- +2 IF '$DATA(^TMP("LEXQC",$JOB,LEXSID,LEXCHG,1))
- QUIT
- +3 NEW LEXS,LEXSC,LEXSO,LEXSOE,LEXLC,LEXSTR,LEXMAX,LEXLEN
- +4 SET LEXLEN=8
- IF LEXSID="10D"!(LEXSID="10P")
- SET LEXLEN=10
- +5 SET (LEXLC,LEXSC)=0
- SET (LEXS,LEXSTR)=""
- SET LEXMAX=10
- IF LEXLEN=10
- SET LEXMAX=8
- +6 FOR
- SET LEXS=$ORDER(^TMP("LEXQC",$JOB,LEXSID,LEXCHG,1,LEXS))
- IF '$LENGTH(LEXS)
- QUIT
- Begin DoDot:1
- +7 NEW LEXN
- SET LEXN=$GET(^TMP("LEXQC",$JOB,LEXSID,LEXCHG,1,LEXS))
- +8 SET LEXSO=$$TM^LEXQM($PIECE(LEXN,"^",2))
- IF '$LENGTH(LEXSO)
- QUIT
- +9 SET LEXSOE=$$FM(LEXSO,LEXLEN)
- SET LEXSC=LEXSC+1
- +10 IF LEXSC<LEXMAX
- SET LEXSTR=LEXSTR_LEXSOE
- QUIT
- +11 IF LEXSC'<LEXMAX
- Begin DoDot:2
- +12 SET LEXSTR=$$TM^LEXQM(LEXSTR)
- +13 SET LEXLC=+LEXLC+1
- IF LEXLC=1
- DO BL
- DO TL((" "_LEXSTR))
- +14 SET LEXSC=1
- SET LEXSTR=LEXSOE
- QUIT
- End DoDot:2
- QUIT
- End DoDot:1
- +15 SET LEXSTR=$$TM^LEXQM(LEXSTR)
- +16 IF $LENGTH(LEXSTR)
- SET LEXLC=+LEXLC+1
- IF LEXLC=1
- DO BL
- DO TL((" "_LEXSTR))
- +17 QUIT
- +18 ;
- +19 ; Miscellaneous
- FM(X,Y) ; Format
- +1 SET X=$GET(X)
- SET Y=+($GET(Y))
- IF +Y'>0
- QUIT X
- SET X=X_$JUSTIFY(" ",(Y-$LENGTH(X)))
- +2 QUIT X
- BL ; Blank Line
- +1 DO TL(" ")
- QUIT
- TL(X) ; Text Line
- +1 NEW LEXI
- SET LEXI=+($ORDER(^TMP("LEXQCO",$JOB," "),-1))+1
- +2 SET ^TMP("LEXQCO",$JOB,LEXI)=$GET(X)
- SET ^TMP("LEXQCO",$JOB,0)=LEXI
- +3 QUIT
- TC(X) ; Total Changes Found
- +1 NEW LEXNN,LEXNC,LEXT
- SET LEXT=0
- SET LEXNN="^TMP(""LEXQC"","_$JOB_")"
- +2 SET LEXNC="^TMP(""LEXQC"","_$JOB_","
- +3 FOR
- SET LEXNN=$QUERY(@LEXNN)
- IF '$LENGTH(LEXNN)!(LEXNN'[LEXNC)
- QUIT
- Begin DoDot:1
- +4 IF LEXNN[",0)"
- SET LEXT=LEXT+($GET(@LEXNN))
- End DoDot:1
- +5 SET X=LEXT
- +6 QUIT X
- SH ; Show Temp Global
- +1 NEW NN,NC
- WRITE !!
- SET NN="^TMP(""LEXQC"","_$JOB_")"
- SET NC="^TMP(""LEXQC"","_$JOB_","
- +2 FOR
- SET NN=$QUERY(@NN)
- IF '$LENGTH(NN)!(NN'[NC)
- QUIT
- WRITE !,NN,"=",@NN
- +3 QUIT
- NAM(X) ; Source Name
- +1 IF $GET(X)="ICD"
- QUIT "ICD-9 Diagnosis Code"
- +2 IF $GET(X)="ICP"
- QUIT "ICD-9 Procedure Code"
- +3 IF $GET(X)="ICC"
- QUIT "ICD Complication/Comorbidity (CC) Flag"
- +4 IF $GET(X)="10D"
- QUIT "ICD-10 Diagnosis Code"
- +5 IF $GET(X)="10P"
- QUIT "ICD-10 Procedure Code"
- +6 IF $GET(X)="CPT"
- QUIT "CPT-4 Procedure Code"
- +7 IF $GET(X)="CPC"
- QUIT "HCPCS Procedure Code"
- +8 IF $GET(X)="MOD"
- QUIT "CPT Modifier Code"
- +9 IF $GET(X)="RAN"
- QUIT "CPT Modifier Range"
- +10 QUIT ""
- CHT(X) ; Change Text
- +1 IF $GET(X)="ACT"
- QUIT "Added"
- +2 IF $GET(X)="INA"
- QUIT "Inactivated"
- +3 IF $GET(X)="REV"
- QUIT "Revised"
- +4 IF $GET(X)="UPD"
- QUIT "Updated"
- +5 IF $GET(X)="REU"
- QUIT "Re-used"
- +6 IF $GET(X)="REA"
- QUIT "Re-Activated"
- +7 QUIT ""
