source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRBPT.m@ 1093

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IMRBPT ; HCIOFO/FAI - DATA EXTRACTION ; 10/18/02 10:02am
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**13,16,18,19**;Feb 09, 1998
3 ;
4 ;***** DATA EXTRACTION FOR NEW PATIENT
5ENTRY ;
6 N IMRTRANS S U="^"
7 S IMRC=0 ; Message line counter
8 S IMRSET=0 ; Message counter
9 ;--- IMRED & IMRDT = Data extract end date/time
10 S (IMRED,IMRDT)=$$NOW^XLFDT()
11 ;--- Backpull from 01/01/1990 (instead of DT-365) for new patients
12 S IMRSD=2900101 ; IMR*2.1*18
13EN1 ;--- Entry point from post-init. The following variables must
14 ;--- be defined: IMRSD,IMRED,IMRC,IMRSET,IMRDT.
15 S IMRTRANS=1 ; Tell the system that this is a transmit to national
16 D DOMAIN^IMRUTL ; Get the domain name for ICR
17 S IMRDOMN="S.IMRHDATA@"_IMRDOMN ; Append domain to server name
18 S IMRDTT=DT,IMRM90=$$FMADD^XLFDT(DT,-90)
19 K ^TMP($J)
20 ;--- Get station number if it is not defined
21 I '$D(IMRSTN) D IMROPN^IMRXOR Q:'$D(IMRSTN)
22 ;--- Create the message
23 S X=10987654321 D XOR^IMRXOR S IMRCODE=X
24 D STARTSEG^IMRDAT1()
25 ;--- Process patient's data
26 S IMRSEND=0 D NXT,SEND^IMRDAT1(1)
27 ;--- Cleanup
28KIL K IMRDENT,IMRRAD,IMRRX,IMRLAB,IMRMI,IMRSCH,IMRCODE,IMRT1,IMRT2,IMRDFN,IMRFN,IMRED,IMRDT,IMR101,IMRNXT1,IMRNXT2,IMRSDV,IMRSET,IMRSTN,X,X1,X2,IMRC,IMRSSN,%DT,Y,%H,%,IMRTRANS
29 K ^TMP($J),%T,DIC,IMRN,IMRSCH1,J,XCNP,XMZ,VAERR,D,DISYS,POP,IMRPAD,IMRADM,IMRDIS,IMRDOMN,IMRSEND,IMR5,IMRDTT,IMRL,IMRT,IMRTEST,IMRTRAN,IMRTSTI,IMRSD,IMRAD,IMRM90
30 Q
31 ;
32 ;*****
33NXT D CLEAR
34 ;--- Node 101 contains last dates noted for various services provided
35 S IMR101=$G(^IMR(158,IMRFN,101)),IMRI=+IMR101
36 ;--- Node 5 is the date of death node
37 S IMR5=$G(^IMR(158,IMRFN,5))
38 ;--- Data transmitted for deceased (1:YES,0:NO)
39 S IMRTRAN=$P(IMR5,U,21) Q:IMRTRAN
40 S IMRDOD=$P(IMR5,U,19) ; imr date of death
41 ;--- IMRT1 is used to calculate the number of seconds needed
42 ;--- to extract data for patient
43 S IMRT1=$P($H,",",2)
44 ;--- Decode patient id; quit if not in File 2
45 S X=+^IMR(158,IMRFN,0) D XOR^IMRXOR Q:'$D(^DPT(X,0))
46 S (DFN,IMRDFN)=X
47 ;--- Piece #2 = LAST SCHEDULING DATE NOTED
48 I $P(IMR101,U,2)="" D
49 . S IMRT2="NEW" D DEMOG,CDC
50 E S IMRT2="UPD" D DEMOG
51 ;---
52 I IMR101'="" S IMRT1=$P($H,",",2)-IMRT1 D
53 . S:IMRT1<0 IMRT1=IMRT1+(24*60*60)
54 . S IMRC=IMRC+1,^TMP($J,"IMRX",IMRC)="TIME"_"^"_IMRT2_"^"_IMRT1
55 Q
56 ;
57CDC ; Get Patient Data From File 158
58 I $D(^IMR(158,IMRFN,1)),$P(^(1),"^",6)>0,$P(IMR101,"^",14)<$P(^(1),"^",6) S IMRLD=$P(^IMR(158,IMRFN,1),"^",6),$P(IMR101,"^",14)=IMRLD K IMRLD ;piece 6=date cdc form completed, piece 14=last cdc form date
59 D MOVCDC0^IMRBPT1
60 Q
61 ;
62DEMOG Q:'$D(^DPT(DFN,0))
63 D SEGS^IMRDAT1(1,1,1,.VADM)
64 ;--- Race (IMR*2.1*19)
65 D:$G(VADM(12))>0
66 . N I S I=""
67 . F S I=$O(VADM(12,I)) Q:I="" D D LCHK^IMRDAT
68 . . S IMRC=IMRC+1
69 . . S ^TMP($J,"IMRX",IMRC)="DER^"_$P(VADM(12,I),U)_"^"_$P($G(VADM(12,I,1)),U)
70 ;--- Ethnicity (IMR*2.1*19)
71 D:$G(VADM(11))>0
72 . N I S I=""
73 . F S I=$O(VADM(11,I)) Q:I="" D D LCHK^IMRDAT
74 . . S IMRC=IMRC+1
75 . . S ^TMP($J,"IMRX",IMRC)="DEE^"_$P(VADM(11,I),U)_"^"_$P($G(VADM(11,I,1)),U)
76 ;--- Cleanup
77 K VADM S IMRFLG=0
78 ;--- Inpatient Data
79IP S IMRLD=+$P(IMR101,"^",3),IMRLD1=+$P(IMR101,"^",4),IMRLD2=+$P(IMR101,"^",5) ;piece 3=LAST ADMIT DATE NOTED,piece 4=LAST DISCHARGE DATE NOTED,piece 5=LAST PTF ADMIT DATE NOTED
80 D ^IMRPTF
81 S $P(IMR101,"^",3,5)=$S(IMRADM>IMRLD:IMRADM,1:IMRLD)_"^"_$S(IMRDIS>IMRLD1:IMRDIS,1:IMRLD1)_"^"_$S(IMRPAD>IMRLD2:IMRPAD,1:IMRLD2)
82 K IMRLD,IMRLD1,IMRLD2
83 D GETDAT^IMRBPT1
84 Q
85 ;
86CLEAR ; Kill Variables
87 K IMRT1,IMRT2,DFN,IMRLD,IMRLD1,IMRLD2
88 Q
89 ;
90DQ ; Queue Data Extract
91 K ZTUCI,ZTDTH,ZTIO,ZTSAVE
92 S ZTRTN="EN1^IMRBPT"
93 S ZTSAVE("IMRSD")="",ZTSAVE("IMRED")="",ZTSAVE("IMRC")="",ZTSAVE("IMRSET")="",ZTSAVE("IMRDT")=""
94 S ZTDTH=$$NOW^XLFDT()
95 S ZTIO="",ZTDESC="Process Data Extract for a Date Range"
96 D ^%ZTLOAD
97 K ZTDESC,ZTDTH,ZTRTN,ZTSAVE,ZTIO,ZTSK
98 Q
Note: See TracBrowser for help on using the repository browser.