LEXQC2 ;ISL/KER - Query - Changes - Save ;04/21/2014
;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 1
;
; 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 ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXQC2 3521 printed Apr 09, 2024@21:09:31 Page 2
LEXQC2 ;ISL/KER - Query - Changes - Save ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 1
+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 ""
