source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLAB1.m

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