| [613] | 1 | IMRRAD ;HCIOFO/NCA,FT-Data Extract of Radiology and Dental to National Registry ;03/05/01  03:56 | 
|---|
|  | 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**4,11,14,15**;Feb 09, 1998 | 
|---|
|  | 3 | RAD ; Extract Radiology Data. Called from IMRDAT1 | 
|---|
|  | 4 | S IMRJRXX=IMRSD,(IMRJRLD,IMRSD)=$S(IMRLD>0:IMRLD,1:IMRSD) | 
|---|
|  | 5 | D RAD^IMRUTL S IMRSD=IMRJRXX | 
|---|
|  | 6 | S IMRRAD=0 Q:'$D(^TMP($J,"RAE1")) | 
|---|
|  | 7 | S IMRRAI="A" F  S IMRRAI=$O(^TMP($J,"RAE1",DFN,IMRRAI),-1) Q:IMRRAI=""  S IMRX1=$G(^(IMRRAI)),IMRD=9999999.9999-$P(IMRRAI,"-",1) D RA | 
|---|
|  | 8 | D EXIT | 
|---|
|  | 9 | Q | 
|---|
|  | 10 | RA Q:IMRJRLD'<IMRD | 
|---|
|  | 11 | Q:IMRD>IMRED | 
|---|
|  | 12 | Q:IMRD<IMRSD | 
|---|
|  | 13 | S IMRC=IMRC+1,IMRX="",IMRX=IMRD_"^"_$P(IMRX1,"^",1)_"^"_$P(IMRX1,"^",10) I IMRX'="" S ^TMP($J,"IMRX",IMRC)="RA"_U_IMRX S IMRSEND=1 ;IMRD=exam date, piece 1=radiology procedure,piece 10=CPT code | 
|---|
|  | 14 | S CNUM="" F  S CNUM=$O(^TMP($J,"RAE1",DFN,IMRRAI,"CMOD",CNUM)) Q:CNUM=""  S CPTREC=$G(^TMP($J,"RAE1",DFN,IMRRAI,"CMOD",CNUM)),CPTC=$P(CPTREC,U,1),IPC=CNUM+4 D RA2 ;cpt modifier starts at piece 5 | 
|---|
|  | 15 | Q | 
|---|
|  | 16 | RA2 S:IMRD'<IMRRAD IMRRAD=IMRD | 
|---|
|  | 17 | S:CPTC'="" $P(^TMP($J,"IMRX",IMRC),U,IPC)=CPTC,CPTC="" | 
|---|
|  | 18 | D LCHK^IMRDAT | 
|---|
|  | 19 | Q | 
|---|
|  | 20 | DENT ; Extract Dental Data. Called from IMRDAT1 | 
|---|
|  | 21 | S IMRJRLD=$S(IMRLD>0:IMRLD,1:IMRSD) | 
|---|
|  | 22 | S IMRDENS=9999999-IMRJRLD,IMRDENE=9999999-IMRED,IMRDENT=0 | 
|---|
|  | 23 | ; E x-ref on File 221 is patient pointer | 
|---|
|  | 24 | F IMRRAI=IMRDENE:0 S IMRRAI=$O(^DENT(221,"E",DFN,IMRRAI)) Q:IMRRAI'<IMRDENS!(IMRRAI<1)  D DENT^IMRUTL S IMRD=$G(IMRAR(221,IMRRAI_",",.01,"I")) D DENT1 | 
|---|
|  | 25 | G EXIT | 
|---|
|  | 26 | DENT1 ; | 
|---|
|  | 27 | Q:IMRD'>IMRJRLD | 
|---|
|  | 28 | Q:IMRD>IMRED | 
|---|
|  | 29 | Q:IMRD<IMRSD | 
|---|
|  | 30 | I $G(IMRAR(221,IMRRAI,61,"I"))>0 S:IMRD>IMRDENT IMRDENT=IMRD | 
|---|
|  | 31 | S IMRC=IMRC+1,IMRHOLD="" | 
|---|
|  | 32 | F IMRLOOP=6:1:8,10:1:12,38,14:1:17,19,39,21:1:25,6.7,27:1:37,7.1,6.2,6.4,6.6,6.8 S IMRHOLD=IMRHOLD_U_$G(IMRAR(221,IMRRAI_",",IMRLOOP,"I")) | 
|---|
|  | 33 | S ^TMP($J,"IMRX",IMRC)="DNT"_U_IMRD_U_$G(IMRAR(221,IMRRAI_",",5,"E"))_U_$G(IMRAR(221,IMRRAI_",",4.5,"E"))_IMRHOLD | 
|---|
|  | 34 | S IMRSEND=1 | 
|---|
|  | 35 | D LCHK^IMRDAT | 
|---|
|  | 36 | Q | 
|---|
|  | 37 | EXIT K IMRRAI,IMRRAJ,IMRAK,IMRX1,IMRX2,IMRX,IMRLOOP,IMRHOLD,IMRAR,^TMP($J,"RAE1"),IMRDENE,IMRDENS,IMRJRLD,IMRJRXX | 
|---|
|  | 38 | Q | 
|---|