source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRRAD.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IMRRAD ;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
3RAD ; 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
10RA 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
16RA2 S:IMRD'<IMRRAD IMRRAD=IMRD
17 S:CPTC'="" $P(^TMP($J,"IMRX",IMRC),U,IPC)=CPTC,CPTC=""
18 D LCHK^IMRDAT
19 Q
20DENT ; 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
26DENT1 ;
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
37EXIT K IMRRAI,IMRRAJ,IMRAK,IMRX1,IMRX2,IMRX,IMRLOOP,IMRHOLD,IMRAR,^TMP($J,"RAE1"),IMRDENE,IMRDENS,IMRJRLD,IMRJRXX
38 Q
Note: See TracBrowser for help on using the repository browser.