89 lines
3.7 KiB
Mathematica
89 lines
3.7 KiB
Mathematica
IMRLAB1 ;ISC-SF/JLI,HCIOFO/FT-LABORATORY DATA EXTRACT CD4,VIRAL LOAD ;9/9/97 16:34
|
|
;;2.1;IMMUNOLOGY CASE REGISTRY;**8**;Feb 09, 1998
|
|
CD4 ; Update CD4 Actual Levels. Called from IMRLAB.
|
|
K IMRCD,IMRCD4
|
|
S X="CD4 or T4 (ACTUAL LEVEL)" D GETVALS^IMRCD4
|
|
F I=0:0 S I=$O(IMRCD(I)) Q:I'>0 D
|
|
.I $P(IMRCD(I),U)=0!(+$P(IMRCD(I),U)) Q
|
|
.K IMRCD(I) ;get rid of canceled results
|
|
.Q
|
|
S IMRLOOP=$O(IMRCD(0))
|
|
I 'IMRLOOP D KILL Q ;quit if no CD4 values found
|
|
S IMRCDX=+$P(IMRCD(IMRLOOP),U,1)
|
|
S IMRCDXD=+$P(IMRCD(IMRLOOP),U,2)
|
|
S Y=$P($G(^IMR(158,IMRFN,102)),U,2)
|
|
I IMRCDXD>Y S DR=DR_"102.01////"_+IMRCDX_";102.02////"_+IMRCDXD_";" ;last CD4 value and date
|
|
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
|
|
S IMRLOOP=0
|
|
F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D
|
|
.S IMRESULT=$P(IMRCD(IMRLOOP),U,1)
|
|
.S IMRESULT=+$$RESULT^IMRUTL(IMRESULT) ;massage lab result to get number
|
|
.I IMRESULT<Y S (IMRCDX,Y)=IMRESULT,IMRCDXD=+$P(IMRCD(IMRLOOP),U,2) ;check for lowest CD4 value & store it
|
|
.Q
|
|
I IMRCDX'="" S DR=DR_"102.05////"_+IMRCDX_";102.06////"_+IMRCDXD_";"
|
|
D KILL
|
|
Q
|
|
CD4P ; Update CD4 Percentage. Called from IMRLAB
|
|
K IMRCD,IMRCD4
|
|
S X="CD4 or T4 (PERCENTAGE)" D GETVALS^IMRCD4
|
|
F I=0:0 S I=$O(IMRCD(I)) Q:I'>0 D
|
|
.I $P(IMRCD(I),U)=0!(+$P(IMRCD(I),U)) Q
|
|
.K IMRCD(I) ;get rid of canceled results
|
|
.Q
|
|
S IMRLOOP=$O(IMRCD(0))
|
|
I 'IMRLOOP D KILL Q ;quit if no CD4 percentages found
|
|
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
|
|
S IMRLOOP=0
|
|
F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D
|
|
.S IMRESULT=+$P(IMRCD(IMRLOOP),U,1)
|
|
.S IMRESULT=+$$RESULT^IMRUTL(IMRESULT) ;massage lab result to get number
|
|
.I IMRESULT<Y S (IMRCDX,Y)=IMRESULT,IMRCDXD=+$P(IMRCD(IMRLOOP),U,2) ;check for lowest CD4 percentage & store it
|
|
I IMRCDX'="" S DR=DR_"112.09////"_+IMRCDX_";112.1////"_+IMRCDXD_";"
|
|
D KILL
|
|
Q
|
|
VL ; Update VIRAL LOAD values. Called from IMRLAB
|
|
K IMRCD,IMRCD4
|
|
S X="VIRAL LOAD" D GETVALS^IMRCD4
|
|
F I=0:0 S I=$O(IMRCD(I)) Q:'I D
|
|
.S IMRESULT=$P(IMRCD(I),U,1)
|
|
.S IMRESULT=$$RESULT^IMRUTL(IMRESULT)
|
|
.I IMRESULT S $P(IMRCD(I),U,1)=IMRESULT Q
|
|
.K IMRCD(I)
|
|
.Q
|
|
S IMRLOOP=$O(IMRCD(0))
|
|
I 'IMRLOOP D KILL Q ;quit if no viral load results
|
|
S IMRLOOP=0
|
|
F S IMRLOOP=$O(IMRCD(IMRLOOP)) Q:'IMRLOOP D STORE
|
|
D KILL
|
|
K IMRLDATE,IMRLNODE,IMRLTEST,IMRVALUE,IMRVLIEN
|
|
Q
|
|
STORE ; Store viral load data in 113 nodes
|
|
S IMRLTEST=$P(IMRCD(IMRLOOP),U,3)
|
|
I '$D(^IMR(158,IMRFN,113,"B",IMRLTEST)) D ;add viral test results if that test not in field 113
|
|
.K DA,DD,DO
|
|
.S:'$D(^IMR(158,IMRFN,113,0)) DIC("P")=$P(^DD(158,122,0),U,2)
|
|
.S X=IMRLTEST,DA(1)=IMRFN,DIC="^IMR(158,IMRFN,113,",DIC(0)="L"
|
|
.D FILE^DICN
|
|
.K DD,DO
|
|
.Q:Y'>0
|
|
.S DA=+Y
|
|
.S IMRLDATE=+$P(IMRCD(IMRLOOP),U,2) Q:'IMRLDATE
|
|
.S IMRVALUE=$P(IMRCD(IMRLOOP),U,1)
|
|
.S IMRVALUE=$$RESULT^IMRUTL(IMRVALUE) ;massage result into a number
|
|
.S DA(1)=IMRFN,DIE="^IMR(158,IMRFN,113,",DR="1///"_IMRVALUE_";2///"_IMRLDATE_";3///"_IMRVALUE_";4///"_IMRLDATE
|
|
.D ^DIE
|
|
.K IMRLDATE,IMRVALUE
|
|
.Q
|
|
S IMRVLIEN=$O(^IMR(158,IMRFN,113,"B",IMRLTEST,0)) Q:'IMRVLIEN
|
|
S IMRLNODE=$G(^IMR(158,IMRFN,113,IMRVLIEN,0)) Q:IMRLNODE=""
|
|
S IMRLDATE=$P(IMRCD(IMRLOOP),U,2) Q:'IMRLDATE
|
|
S IMRVALUE=$P(IMRCD(IMRLOOP),U,1)
|
|
S IMRVALUE=$$RESULT^IMRUTL(IMRVALUE)
|
|
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
|
|
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
|
|
S ^IMR(158,IMRFN,113,IMRVLIEN,0)=IMRLNODE ;update global node
|
|
Q
|
|
KILL ; kill variables
|
|
K I,IMRCD,IMRCD4,IMRCD4D,IMRCD4E,IMRCD4X,IMRCDX,IMRCDXD,IMREDIT,IMRESULT,IMRLOOP,IMRPN,X,Y
|
|
Q
|