RAIPS204 ;WOIFO/KLM - Post-init Driver, patch 204 ; Aug 31, 2023@13:34:20
;;5.0;Radiology/Nuclear Medicine;**204**;Mar 16, 1998;Build 2
;
;Post-Init will add LIRADS, PIRADS and TIRADS to file 78.3. Filing errors are stored in ^XTMP
;It will also make updates to LUNGRADS and PR codes.
;
Q:'$D(^XTMP("RA*5.0*204 DIAGNOSTIC CODES FILE UPDATE BACKUP OF 78.3",78.3)) ;data not backed up
N RACHX1 S RACHX1=$$NEWCP^XPDUTL("POST1","LIPITI^RAIPS204")
N RACHX2 S RACHX2=$$NEWCP^XPDUTL("POST2","LUNG^RAIPS204")
N RACHX3 S RACHX3=$$NEWCP^XPDUTL("POST3","PR^RAIPS204")
Q
LIPITI ; Adding LI-RADS, PI-RADS & TI-RADS to Diagnosis Code File 78.3
N RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA2,RA3,RA4,RAMSG
N RADIERR S RADIERR="RA*5.0*204 ERRORS FILING/UPDATING DATA - JOB #"_$J
I '$D(^XTMP(RADIERR,0)) D
.N X,Y S X=DT,Y=180
.S ^XTMP(RADIERR,0)=$$FMADD^XLFDT(X,Y,0,0,0)_U_$G(DT)_U_"Errors filing/updating data - post init RA204"
.Q
F RAI=1:1 S RADX=$T(CODES+RAI) Q:RADX=" ;;" D
.S RA001=$P($P(RADX,";",3),"^"),RA01=$P($P(RADX,";",3),"^",2),RA2=$P($P(RADX,";",3),"^",3),RA3=$P($P(RADX,";",3),"^",4),RA4=$P($P(RADX,";",3),"^",5)
.Q:RA001=""
.S RAFDA(78.3,"+1,",.01)=RA01 ; DIAG CODE
.S RAFDA(78.3,"+1,",2)=RA2 ; DIAG DESC
.S RAFDA(78.3,"+1,",3)=RA3 ; PRINT ON ABN REPORT
.S RAFDA(78.3,"+1,",4)=RA4 ; GENERATE ALERT
.S RADNUM(1)=RA001
.D UPDATE^DIE("","RAFDA","RADNUM","RAMSG")
.;Capture any "DIERR" messages - they will tell us if an IEN already existed. They shouldn't but you never know.
.I $D(RAMSG("DIERR")) D
..S ^XTMP(RADIERR,"DIERR",RA001)=RAMSG("DIERR",1,"TEXT",1)
..Q
.K RAMSG
.Q
I $D(^XTMP(RADIERR,"DIERR")) D MES^XPDUTL("There were errors filing data. Contact the radiology developement team.")
Q
;
LUNG ;update LUNGRADS
N RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA3,RAERR,RATXT,RASAVE,RAE
N RADIERR S RADIERR="RA*5.0*204 ERRORS FILING/UPDATING DATA - JOB #"_$J
I '$D(^XTMP(RADIERR,0)) D
.N X,Y S X=DT,Y=180
.S ^XTMP(RADIERR,0)=$$FMADD^XLFDT(X,Y,0,0,0)_U_$G(DT)_U_"Errors fileing/updating data - post init RA204"
.Q
F RAI=1:1 S RADX=$T(LUNGRADS+RAI) Q:RADX="" D
.S RAE=0
.S RA001=$P($P(RADX,";",3),"^"),RA01=$P($P(RADX,";",3),"^",2),RA3=$P($P(RADX,";",3),"^",4)
.S RAIENS=RA001_","
.I $G(RA01)]"" D ;.01 field is uneditable - will hard set it.
..S RASAVE=$P(^RA(78.3,RA001,0),U)
..Q:RA01=RASAVE ;Already a match - no update needed
..I $P(RA01,":")'=$P(RASAVE,":") D Q
...S RATXT(1)="Error updating LUNGRAD code "_RA001 D BMES^XPDUTL(.RATXT)
...S ^XTMP(RADIERR,"DIERR",RA001)="Code doesn't match",RAE=1
...Q
..S $P(^RA(78.3,RA001,0),U)=RA01
..;Set/kill "B" x-ref (no other x-refs to worry about)
..S ^RA(78.3,"B",$E(RA01,1,30),RA001)="" ;XREF has 30c limit
..K ^RA(78.3,"B",$E(RASAVE,1,30),RA001)
..S RATXT(1)=RA001_" Updated" D BMES^XPDUTL(.RATXT)
..K RATXT
..Q
.I $G(RA3)]"" D
..S RAFDA(78.3,RAIENS,3)=RA3 ; PRINT ON ABN REPORT
..K RAERR D FILE^DIE("E","RAFDA","RAERR")
..I $D(RAERR("DIERR")) S RATXT(1)="Error updating LUNRAD code "_RA001
..I $G(RATXT(1))="" S RATXT(1)=RA001_" Updated"
..D BMES^XPDUTL(.RATXT)
..K RAERR,RATXT
..Q
.Q
I $G(RAE)=1 D MES^XPDUTL("There were errors updating data. Contact the radiology developement team.")
Q
PR ;Inactivate Peer Review (PR) codes
N RAFDA,RAI,RAIENS,RAERR,RATXT
F RAI=1250,1251,1252,1253,1254,1255,1256 D
.I $E($P(^RA(78.3,RAI,0),U),1,2)'="PR" D Q
..S RATXT(1)="Code "_RAI_" does not appear to be a 'PR' code"
..D BMES^XPDUTL(.RATXT)
.S RAIENS=RAI_","
.;check if they're already inactive
.I $P(^RA(78.3,RAI,0),U,5)="Y" D Q
..K RATXT S RATXT(1)=RAI_" is already inactive."
..D BMES^XPDUTL(.RATXT)
.E S RAFDA(78.3,RAIENS,5)="Y" ;Inactive
.D FILE^DIE("E","RAFDA","RAERR")
.K RATXT
.I $D(RAERR("DIERR")) S RATXT(1)="Error inactivating PR code "_RAI
.I $G(RATXT(1))="" S RATXT(1)=RAI_" Inactivated"
.D BMES^XPDUTL(.RATXT)
.K RAERR,RATXT
.Q
Q
CODES ; NUMBER^CODE^DESC^PRINT^ALERT
;;1400^LI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
;;1410^LI-RADS NO OBS^No observations^Y^n
;;1411^LI-RADS 1^Definitely benign^Y^n
;;1412^LI-RADS 2^Probably benign^Y^n
;;1413^LI-RADS 3^Intermediate probability of malignancy^Y^y
;;1414^LI-RADS 4^Probably HCC^Y^y
;;1415^LI-RADS 5^Definitely HCC^Y^y
;;1416^LI-RADS TIV^Tumor in vein (TIV)^Y^y
;;1417^LI-RADS M^Probably or definitely malignant, not necessarily HCC^Y^y
;;1421^LI-RADS TR NONEVALUABLE^Treated, response not evaluable due image omission or degradation^Y^y
;;1422^LI-RADS TR NONVIABLE^Treated, probably or definitely not viable^Y^y
;;1423^LI-RADS TR EQUIVOCAL^Treated, equivocally viable^Y^y
;;1424^LI-RADS TR VIABLE^Treated, probably or definitely viable^Y^y
;;1450^US LI-RADS 1A^No/Benign Observation(s) -- no/minimal visualization limitations^Y^n
;;1451^US LI-RADS 1B^No/Benign Observation(s) -- moderate visualization limitations^Y^y
;;1452^US LI-RADS 1C^No/Benign Observation(s) -- severe visualization limitations^Y^y
;;1453^US LI-RADS 2A^Observation(s) <10mm (not benign) -- no/minimal visualization limitations^Y^y
;;1454^US LI-RADS 2B^Observation(s) <10mm (not benign) -- moderate visualization limitations^Y^y
;;1455^US LI-RADS 2C^Observation(s) <10mm (not benign) -- severe visualization limitations^Y^y
;;1456^US LI-RADS 3A^Observation(s) >= 10mm (not benign) -- no/minimal visualization limitations^Y^y
;;1457^US LI-RADS 3B^Observation(s) >= 10mm (not benign) -- moderate visualization limitations^Y^y
;;1458^US LI-RADS 3C^Observation(s) >= 10mm (not benign) -- severe visualization limitations^Y^y
;;1500^PI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
;;1511^PI-RADS 1^Very low (clinically significant cancer highly unlikely to be present)^Y^n
;;1512^PI-RADS 2^Low (clinically significant cancer is unlikely to be present)^Y^n
;;1513^PI-RADS 3^Intermediate (the presence of clinically significant cancer is equivocal)^Y^y
;;1514^PI-RADS 4^High (clinically significant cancer is likely to be present)^Y^y
;;1515^PI-RADS 5^Very high (clinically significant cancer highly likely to be present)^Y^y
;;1600^TI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
;;1611^TI-RADS 1^Benign -- No FNA or follow-up^Y^n
;;1612^TI-RADS 2^Not suspicious -- No FNA or follow-up^Y^n
;;1613^TI-RADS 3^Mildly suspicious -- FNA if >= 2.5 cm, follow-up if >= 1.5 cm^Y^y
;;1614^TI-RADS 4^Moderately suspicious -- FNA if >= 1.5 cm, follow-up if >= 1 cm^Y^y
;;1615^TI-RADS 5^Highly suspicious -- FNA if >= 1 cm, follow-up if >= 0.5 cm^Y^y
;;
LUNGRADS ;Updates. Remove the word "NODULE". Update 'print on report' field
;;1211^^^Y^
;;1212^LUNGRADS 2: BENIGN APPEARANCE OR BEHAVIOR^^Y^
;;1213^LUNGRADS 3: PROBABLY BENIGN^^Y^
;;1214^LUNGRADS 4A: SUSPICIOUS^^^
;;1215^LUNGRADS 4B: SUSPICIOUS^^^
;;1216^LUNGRADS 4X: SUSPICIOUS WITH ADDITIONAL FEATURES^^^
;;1218^^^Y^
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAIPS204 6961 printed Dec 13, 2024@02:36:22 Page 2
RAIPS204 ;WOIFO/KLM - Post-init Driver, patch 204 ; Aug 31, 2023@13:34:20
+1 ;;5.0;Radiology/Nuclear Medicine;**204**;Mar 16, 1998;Build 2
+2 ;
+3 ;Post-Init will add LIRADS, PIRADS and TIRADS to file 78.3. Filing errors are stored in ^XTMP
+4 ;It will also make updates to LUNGRADS and PR codes.
+5 ;
+6 ;data not backed up
if '$DATA(^XTMP("RA*5.0*204 DIAGNOSTIC CODES FILE UPDATE BACKUP OF 78.3",78.3))
QUIT
+7 NEW RACHX1
SET RACHX1=$$NEWCP^XPDUTL("POST1","LIPITI^RAIPS204")
+8 NEW RACHX2
SET RACHX2=$$NEWCP^XPDUTL("POST2","LUNG^RAIPS204")
+9 NEW RACHX3
SET RACHX3=$$NEWCP^XPDUTL("POST3","PR^RAIPS204")
+10 QUIT
LIPITI ; Adding LI-RADS, PI-RADS & TI-RADS to Diagnosis Code File 78.3
+1 NEW RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA2,RA3,RA4,RAMSG
+2 NEW RADIERR
SET RADIERR="RA*5.0*204 ERRORS FILING/UPDATING DATA - JOB #"_$JOB
+3 IF '$DATA(^XTMP(RADIERR,0))
Begin DoDot:1
+4 NEW X,Y
SET X=DT
SET Y=180
+5 SET ^XTMP(RADIERR,0)=$$FMADD^XLFDT(X,Y,0,0,0)_U_$GET(DT)_U_"Errors filing/updating data - post init RA204"
+6 QUIT
End DoDot:1
+7 FOR RAI=1:1
SET RADX=$TEXT(CODES+RAI)
if RADX=" ;;"
QUIT
Begin DoDot:1
+8 SET RA001=$PIECE($PIECE(RADX,";",3),"^")
SET RA01=$PIECE($PIECE(RADX,";",3),"^",2)
SET RA2=$PIECE($PIECE(RADX,";",3),"^",3)
SET RA3=$PIECE($PIECE(RADX,";",3),"^",4)
SET RA4=$PIECE($PIECE(RADX,";",3),"^",5)
+9 if RA001=""
QUIT
+10 ; DIAG CODE
SET RAFDA(78.3,"+1,",.01)=RA01
+11 ; DIAG DESC
SET RAFDA(78.3,"+1,",2)=RA2
+12 ; PRINT ON ABN REPORT
SET RAFDA(78.3,"+1,",3)=RA3
+13 ; GENERATE ALERT
SET RAFDA(78.3,"+1,",4)=RA4
+14 SET RADNUM(1)=RA001
+15 DO UPDATE^DIE("","RAFDA","RADNUM","RAMSG")
+16 ;Capture any "DIERR" messages - they will tell us if an IEN already existed. They shouldn't but you never know.
+17 IF $DATA(RAMSG("DIERR"))
Begin DoDot:2
+18 SET ^XTMP(RADIERR,"DIERR",RA001)=RAMSG("DIERR",1,"TEXT",1)
+19 QUIT
End DoDot:2
+20 KILL RAMSG
+21 QUIT
End DoDot:1
+22 IF $DATA(^XTMP(RADIERR,"DIERR"))
DO MES^XPDUTL("There were errors filing data. Contact the radiology developement team.")
+23 QUIT
+24 ;
LUNG ;update LUNGRADS
+1 NEW RAFDA,RADNUM,RAI,RADX,RA001,RA01,RA3,RAERR,RATXT,RASAVE,RAE
+2 NEW RADIERR
SET RADIERR="RA*5.0*204 ERRORS FILING/UPDATING DATA - JOB #"_$JOB
+3 IF '$DATA(^XTMP(RADIERR,0))
Begin DoDot:1
+4 NEW X,Y
SET X=DT
SET Y=180
+5 SET ^XTMP(RADIERR,0)=$$FMADD^XLFDT(X,Y,0,0,0)_U_$GET(DT)_U_"Errors fileing/updating data - post init RA204"
+6 QUIT
End DoDot:1
+7 FOR RAI=1:1
SET RADX=$TEXT(LUNGRADS+RAI)
if RADX=""
QUIT
Begin DoDot:1
+8 SET RAE=0
+9 SET RA001=$PIECE($PIECE(RADX,";",3),"^")
SET RA01=$PIECE($PIECE(RADX,";",3),"^",2)
SET RA3=$PIECE($PIECE(RADX,";",3),"^",4)
+10 SET RAIENS=RA001_","
+11 ;.01 field is uneditable - will hard set it.
IF $GET(RA01)]""
Begin DoDot:2
+12 SET RASAVE=$PIECE(^RA(78.3,RA001,0),U)
+13 ;Already a match - no update needed
if RA01=RASAVE
QUIT
+14 IF $PIECE(RA01,":")'=$PIECE(RASAVE,":")
Begin DoDot:3
+15 SET RATXT(1)="Error updating LUNGRAD code "_RA001
DO BMES^XPDUTL(.RATXT)
+16 SET ^XTMP(RADIERR,"DIERR",RA001)="Code doesn't match"
SET RAE=1
+17 QUIT
End DoDot:3
QUIT
+18 SET $PIECE(^RA(78.3,RA001,0),U)=RA01
+19 ;Set/kill "B" x-ref (no other x-refs to worry about)
+20 ;XREF has 30c limit
SET ^RA(78.3,"B",$EXTRACT(RA01,1,30),RA001)=""
+21 KILL ^RA(78.3,"B",$EXTRACT(RASAVE,1,30),RA001)
+22 SET RATXT(1)=RA001_" Updated"
DO BMES^XPDUTL(.RATXT)
+23 KILL RATXT
+24 QUIT
End DoDot:2
+25 IF $GET(RA3)]""
Begin DoDot:2
+26 ; PRINT ON ABN REPORT
SET RAFDA(78.3,RAIENS,3)=RA3
+27 KILL RAERR
DO FILE^DIE("E","RAFDA","RAERR")
+28 IF $DATA(RAERR("DIERR"))
SET RATXT(1)="Error updating LUNRAD code "_RA001
+29 IF $GET(RATXT(1))=""
SET RATXT(1)=RA001_" Updated"
+30 DO BMES^XPDUTL(.RATXT)
+31 KILL RAERR,RATXT
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 IF $GET(RAE)=1
DO MES^XPDUTL("There were errors updating data. Contact the radiology developement team.")
+35 QUIT
PR ;Inactivate Peer Review (PR) codes
+1 NEW RAFDA,RAI,RAIENS,RAERR,RATXT
+2 FOR RAI=1250,1251,1252,1253,1254,1255,1256
Begin DoDot:1
+3 IF $EXTRACT($PIECE(^RA(78.3,RAI,0),U),1,2)'="PR"
Begin DoDot:2
+4 SET RATXT(1)="Code "_RAI_" does not appear to be a 'PR' code"
+5 DO BMES^XPDUTL(.RATXT)
End DoDot:2
QUIT
+6 SET RAIENS=RAI_","
+7 ;check if they're already inactive
+8 IF $PIECE(^RA(78.3,RAI,0),U,5)="Y"
Begin DoDot:2
+9 KILL RATXT
SET RATXT(1)=RAI_" is already inactive."
+10 DO BMES^XPDUTL(.RATXT)
End DoDot:2
QUIT
+11 ;Inactive
IF '$TEST
SET RAFDA(78.3,RAIENS,5)="Y"
+12 DO FILE^DIE("E","RAFDA","RAERR")
+13 KILL RATXT
+14 IF $DATA(RAERR("DIERR"))
SET RATXT(1)="Error inactivating PR code "_RAI
+15 IF $GET(RATXT(1))=""
SET RATXT(1)=RAI_" Inactivated"
+16 DO BMES^XPDUTL(.RATXT)
+17 KILL RAERR,RATXT
+18 QUIT
End DoDot:1
+19 QUIT
CODES ; NUMBER^CODE^DESC^PRINT^ALERT
+1 ;;1400^LI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
+2 ;;1410^LI-RADS NO OBS^No observations^Y^n
+3 ;;1411^LI-RADS 1^Definitely benign^Y^n
+4 ;;1412^LI-RADS 2^Probably benign^Y^n
+5 ;;1413^LI-RADS 3^Intermediate probability of malignancy^Y^y
+6 ;;1414^LI-RADS 4^Probably HCC^Y^y
+7 ;;1415^LI-RADS 5^Definitely HCC^Y^y
+8 ;;1416^LI-RADS TIV^Tumor in vein (TIV)^Y^y
+9 ;;1417^LI-RADS M^Probably or definitely malignant, not necessarily HCC^Y^y
+10 ;;1421^LI-RADS TR NONEVALUABLE^Treated, response not evaluable due image omission or degradation^Y^y
+11 ;;1422^LI-RADS TR NONVIABLE^Treated, probably or definitely not viable^Y^y
+12 ;;1423^LI-RADS TR EQUIVOCAL^Treated, equivocally viable^Y^y
+13 ;;1424^LI-RADS TR VIABLE^Treated, probably or definitely viable^Y^y
+14 ;;1450^US LI-RADS 1A^No/Benign Observation(s) -- no/minimal visualization limitations^Y^n
+15 ;;1451^US LI-RADS 1B^No/Benign Observation(s) -- moderate visualization limitations^Y^y
+16 ;;1452^US LI-RADS 1C^No/Benign Observation(s) -- severe visualization limitations^Y^y
+17 ;;1453^US LI-RADS 2A^Observation(s) <10mm (not benign) -- no/minimal visualization limitations^Y^y
+18 ;;1454^US LI-RADS 2B^Observation(s) <10mm (not benign) -- moderate visualization limitations^Y^y
+19 ;;1455^US LI-RADS 2C^Observation(s) <10mm (not benign) -- severe visualization limitations^Y^y
+20 ;;1456^US LI-RADS 3A^Observation(s) >= 10mm (not benign) -- no/minimal visualization limitations^Y^y
+21 ;;1457^US LI-RADS 3B^Observation(s) >= 10mm (not benign) -- moderate visualization limitations^Y^y
+22 ;;1458^US LI-RADS 3C^Observation(s) >= 10mm (not benign) -- severe visualization limitations^Y^y
+23 ;;1500^PI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
+24 ;;1511^PI-RADS 1^Very low (clinically significant cancer highly unlikely to be present)^Y^n
+25 ;;1512^PI-RADS 2^Low (clinically significant cancer is unlikely to be present)^Y^n
+26 ;;1513^PI-RADS 3^Intermediate (the presence of clinically significant cancer is equivocal)^Y^y
+27 ;;1514^PI-RADS 4^High (clinically significant cancer is likely to be present)^Y^y
+28 ;;1515^PI-RADS 5^Very high (clinically significant cancer highly likely to be present)^Y^y
+29 ;;1600^TI-RADS NC^Noncategorizable due to image omission or degradation^Y^y
+30 ;;1611^TI-RADS 1^Benign -- No FNA or follow-up^Y^n
+31 ;;1612^TI-RADS 2^Not suspicious -- No FNA or follow-up^Y^n
+32 ;;1613^TI-RADS 3^Mildly suspicious -- FNA if >= 2.5 cm, follow-up if >= 1.5 cm^Y^y
+33 ;;1614^TI-RADS 4^Moderately suspicious -- FNA if >= 1.5 cm, follow-up if >= 1 cm^Y^y
+34 ;;1615^TI-RADS 5^Highly suspicious -- FNA if >= 1 cm, follow-up if >= 0.5 cm^Y^y
+35 ;;
LUNGRADS ;Updates. Remove the word "NODULE". Update 'print on report' field
+1 ;;1211^^^Y^
+2 ;;1212^LUNGRADS 2: BENIGN APPEARANCE OR BEHAVIOR^^Y^
+3 ;;1213^LUNGRADS 3: PROBABLY BENIGN^^Y^
+4 ;;1214^LUNGRADS 4A: SUSPICIOUS^^^
+5 ;;1215^LUNGRADS 4B: SUSPICIOUS^^^
+6 ;;1216^LUNGRADS 4X: SUSPICIOUS WITH ADDITIONAL FEATURES^^^
+7 ;;1218^^^Y^
