source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLAB1.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: 3.7 KB
Line 
1IMRLAB1 ;ISC-SF/JLI,HCIOFO/FT-LABORATORY DATA EXTRACT CD4,VIRAL LOAD ;9/9/97 16:34
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**8**;Feb 09, 1998
3CD4 ; Update CD4 Actual Levels. Called from IMRLAB.
4 K IMRCD,IMRCD4
5 S X="CD4 or T4 (ACTUAL LEVEL)" D GETVALS^IMRCD4
6 F I=0:0 S I=$O(IMRCD(I)) Q:I'>0 D
7 .I $P(IMRCD(I),U)=0!(+$P(IMRCD(I),U)) Q
8 .K IMRCD(I) ;get rid of canceled results
9 .Q
10 S IMRLOOP=$O(IMRCD(0))
11 I 'IMRLOOP D KILL Q ;quit if no CD4 values found
12 S IMRCDX=+$P(IMRCD(IMRLOOP),U,1)
13 S IMRCDXD=+$P(IMRCD(IMRLOOP),U,2)
14 S Y=$P($G(^IMR(158,IMRFN,102)),U,2)
15 I IMRCDXD>Y S DR=DR_"102.01////"_+IMRCDX_";102.02////"_+IMRCDXD_";" ;last CD4 value and date
16 S Y=$P($G(^IMR(158,IMRFN,102)),U,5),(IMRCDX,IMRCDXD)="" S:Y="" Y=9999999 ;get lowest CD4 value in File 158 for comparison
17 S IMRLOOP=0
18 F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D
19 .S IMRESULT=$P(IMRCD(IMRLOOP),U,1)
20 .S IMRESULT=+$$RESULT^IMRUTL(IMRESULT) ;massage lab result to get number
21 .I IMRESULT<Y S (IMRCDX,Y)=IMRESULT,IMRCDXD=+$P(IMRCD(IMRLOOP),U,2) ;check for lowest CD4 value & store it
22 .Q
23 I IMRCDX'="" S DR=DR_"102.05////"_+IMRCDX_";102.06////"_+IMRCDXD_";"
24 D KILL
25 Q
26CD4P ; Update CD4 Percentage. Called from IMRLAB
27 K IMRCD,IMRCD4
28 S X="CD4 or T4 (PERCENTAGE)" D GETVALS^IMRCD4
29 F I=0:0 S I=$O(IMRCD(I)) Q:I'>0 D
30 .I $P(IMRCD(I),U)=0!(+$P(IMRCD(I),U)) Q
31 .K IMRCD(I) ;get rid of canceled results
32 .Q
33 S IMRLOOP=$O(IMRCD(0))
34 I 'IMRLOOP D KILL Q ;quit if no CD4 percentages found
35 S Y=$P($G(^IMR(158,IMRFN,112)),U,9),(IMRCDX,IMRCDXD)="" S:Y="" Y=9999999 ;get lowest CD4 percentage in File 158 for comparison
36 S IMRLOOP=0
37 F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D
38 .S IMRESULT=+$P(IMRCD(IMRLOOP),U,1)
39 .S IMRESULT=+$$RESULT^IMRUTL(IMRESULT) ;massage lab result to get number
40 .I IMRESULT<Y S (IMRCDX,Y)=IMRESULT,IMRCDXD=+$P(IMRCD(IMRLOOP),U,2) ;check for lowest CD4 percentage & store it
41 I IMRCDX'="" S DR=DR_"112.09////"_+IMRCDX_";112.1////"_+IMRCDXD_";"
42 D KILL
43 Q
44VL ; Update VIRAL LOAD values. Called from IMRLAB
45 K IMRCD,IMRCD4
46 S X="VIRAL LOAD" D GETVALS^IMRCD4
47 F I=0:0 S I=$O(IMRCD(I)) Q:'I D
48 .S IMRESULT=$P(IMRCD(I),U,1)
49 .S IMRESULT=$$RESULT^IMRUTL(IMRESULT)
50 .I IMRESULT S $P(IMRCD(I),U,1)=IMRESULT Q
51 .K IMRCD(I)
52 .Q
53 S IMRLOOP=$O(IMRCD(0))
54 I 'IMRLOOP D KILL Q ;quit if no viral load results
55 S IMRLOOP=0
56 F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D STORE
57 D KILL
58 K IMRLDATE,IMRLNODE,IMRLTEST,IMRVALUE,IMRVLIEN
59 Q
60STORE ; Store viral load data in 113 nodes
61 S IMRLTEST=$P(IMRCD(IMRLOOP),U,3)
62 I '$D(^IMR(158,IMRFN,113,"B",IMRLTEST)) D ;add viral test results if that test not in field 113
63 .K DA,DD,DO
64 .S:'$D(^IMR(158,IMRFN,113,0)) DIC("P")=$P(^DD(158,122,0),U,2)
65 .S X=IMRLTEST,DA(1)=IMRFN,DIC="^IMR(158,IMRFN,113,",DIC(0)="L"
66 .D FILE^DICN
67 .K DD,DO
68 .Q:Y'>0
69 .S DA=+Y
70 .S IMRLDATE=+$P(IMRCD(IMRLOOP),U,2) Q:'IMRLDATE
71 .S IMRVALUE=$P(IMRCD(IMRLOOP),U,1)
72 .S IMRVALUE=$$RESULT^IMRUTL(IMRVALUE) ;massage result into a number
73 .S DA(1)=IMRFN,DIE="^IMR(158,IMRFN,113,",DR="1///"_IMRVALUE_";2///"_IMRLDATE_";3///"_IMRVALUE_";4///"_IMRLDATE
74 .D ^DIE
75 .K IMRLDATE,IMRVALUE
76 .Q
77 S IMRVLIEN=$O(^IMR(158,IMRFN,113,"B",IMRLTEST,0)) Q:'IMRVLIEN
78 S IMRLNODE=$G(^IMR(158,IMRFN,113,IMRVLIEN,0)) Q:IMRLNODE=""
79 S IMRLDATE=$P(IMRCD(IMRLOOP),U,2) Q:'IMRLDATE
80 S IMRVALUE=$P(IMRCD(IMRLOOP),U,1)
81 S IMRVALUE=$$RESULT^IMRUTL(IMRVALUE)
82 I IMRVALUE>$P(IMRLNODE,U,2) S $P(IMRLNODE,U,2)=IMRVALUE,$P(IMRLNODE,U,3)=IMRLDATE ;save the highest score and its date/time
83 I IMRLDATE>$P(IMRLNODE,U,5) S IMRVALUE=$$RESULT^IMRUTL(IMRVALUE),$P(IMRLNODE,U,4)=IMRVALUE,$P(IMRLNODE,U,5)=IMRLDATE ;save most recent date/time and its value
84 S ^IMR(158,IMRFN,113,IMRVLIEN,0)=IMRLNODE ;update global node
85 Q
86KILL ; kill variables
87 K I,IMRCD,IMRCD4,IMRCD4D,IMRCD4E,IMRCD4X,IMRCDX,IMRCDXD,IMREDIT,IMRESULT,IMRLOOP,IMRPN,X,Y
88 Q
Note: See TracBrowser for help on using the repository browser.