source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRUTST.m@ 1073

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

initial load of WorldVistAEHR
File size: 6.5 KB
RevLine 
[613]1IMRUTST ;HCIOFO/FAI-UPDATE LAB TEST VALUES ;08/31/00 09:48;
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
3 ; Category logic below
4 ;CATEGORY 1 SET TO 2 - CD4 COUNT IS 200 - 499
5 ;CATEGORY 1 SET TO 3 - CD4 COUNT IS LESS THAN 200
6 ;CATEGORY 2 SET TO 3 - CD4 COUNT IS LESS THAN 200
7 ;CATEGORY 1 SET TO 3 - CD4 % IS LESS THAN 14
8 ;CATEGORY 2 SET TO 3 - CD4 % IS LESS THAN 14
9 ;
10BGIN D ICRPT,KILL
11 Q
12ICRPT F IMRFN=0:0 S IMRFN=$O(^IMR(158,IMRFN)) Q:IMRFN'>0 S X=+^(IMRFN,0),IMRCAT=$P($G(^(0)),U,42) D ^IMRXOR S DFN=X I $D(^DPT(DFN,0)) D DEMOG,SETLR
13 Q
14DEMOG D DEM^VADPT S IMRDOD=$P(VADM(6),U),(IMRRACE,X)=$P(VADM(8),U)
15 I X>0 S X=$S($D(^DIC(10,X,0)):$P(^(0),U,2),1:0) I X>0 S $P(^IMR(158,IMRFN,0),U,2)=$S(X=1:3,X=2:3,X=3:5,X=4:2,X=5:4,X=6:1,1:9) K VA,VADM,X
16 S IMRXCAT=$P($G(^IMR(158,IMRFN,0)),U,42)
17 I IMRXCAT="" S $P(^IMR(158,IMRFN,0),U,42)=1,$P(^IMR(158,IMRFN,0),U,36)=DT
18 I (IMRXCAT="1")!(IMRXCAT="2")!(IMRXCAT="3") S $P(^IMR(158,IMRFN,0),U,23)=""
19 Q:$P($G(^IMR(158,IMRFN,5)),U,19)'=""
20 S:$G(IMRDOD)="" $P(^IMR(158,IMRFN,1),U,34)="1"
21 S:$G(IMRDOD)'="" $P(^IMR(158,IMRFN,1),U,34)="2",$P(^IMR(158,IMRFN,5),U,19)=IMRDOD,$P(^IMR(158,IMRFN,5),U,20)="1"
22 ;patient status above [1;34]=(1:alive,2:dead,9:unknown)
23 K IMRDOD,IMRRACE
24 Q
25SETLR S PNAM=$P($G(^DPT(DFN,0)),U,1),SSN=$P($G(^DPT(DFN,0)),U,9),IMRTSTLR=$P($G(^DPT(DFN,"LR")),U,1) D DATA
26 Q
27DATA K IMRCD
28 Q:$G(IMRTSTLR)=""
29 S (IMRTSTI,IMRTSTII)="",ILR=IMRTSTLR
30 S LGN="" F S LGN=$O(^IMR(158.95,"B",LGN)),LIG="" Q:LGN="" S LIG=$O(^IMR(158.95,"B",LGN,LIG)) Q:LIG="" D LOCAL,LOCAL2
31 Q
32LOCAL Q:LGN'="CD4"
33 S IMRCD="" F S IMRCD=$O(^IMR(158.9,1,3,"B",LIG,IMRCD)),IMS="" Q:IMRCD="" F S IMS=$O(^IMR(158.9,1,3,IMRCD,1,"B",IMS)),IMLM="" Q:IMS="" F S IMLM=$O(^IMR(158.9,1,3,IMRCD,1,"B",IMS,IMLM)) Q:IMLM="" D LLT
34 Q
35LOCAL2 Q:LGN'="VIRAL LOAD"
36 S IMRCD="" F S IMRCD=$O(^IMR(158.9,1,3,"B",LIG,IMRCD)),IMS="" Q:IMRCD="" F S IMS=$O(^IMR(158.9,1,3,IMRCD,1,"B",IMS)),IMLM="" Q:IMS="" F S IMLM=$O(^IMR(158.9,1,3,IMRCD,1,"B",IMS,IMLM)) Q:IMLM="" D LLT
37 Q
38LLT S IMLO="" F S IMLO=$O(^IMR(158.9,1,3,IMRCD,1,IMLM,1,"B",IMLO)),TNN="" Q:IMLO="" F S TNN=$O(^IMR(158.9,1,3,IMRCD,1,IMLM,1,"B",IMLO,TNN)) Q:TNN="" D LWK
39 Q
40LWK S IMWK=$P($G(^IMR(158.9,1,3,IMRCD,1,IMLM,1,TNN,0)),U,2),LNM=$P($G(^LAB(60,IMLO,0)),U,1),LLOC=$P($G(^LAB(60,IMLO,0)),U,5)
41 I LLOC'="" S UNN=$P($G(^LAB(60,IMLO,1,0)),U,3),LDAT=$P(LLOC,";",2) S:UNN'="" UNS=$P($G(^LAB(60,IMLO,1,UNN,0)),U,7) D CHEMS Q
42 I LLOC="" D PANEL Q
43 Q
44PANEL F PN=0:0 S PN=$O(^LAB(60,IMLO,2,PN)) Q:PN'>0 S LPN=$P($G(^LAB(60,IMLO,2,PN,0)),U,1),LNM=$P($G(^LAB(60,LPN,0)),U,1),LLOC=$P($G(^LAB(60,LPN,0)),U,5) D PAN2
45 Q
46PAN2 S UNN=$P($G(^LAB(60,LPN,1,0)),U,3)
47 S:UNN'="" UNS=$P($G(^LAB(60,LPN,1,UNN,0)),U,7)
48 S:LLOC'="" LDAT=$P(LLOC,";",2)
49 D CHEMS
50 Q
51CHEMS S LDT="" F S LDT=$O(^LR(ILR,"CH",LDT)),DNAM="" Q:LDT="" F S DNAM=$O(^LR(ILR,"CH",LDT,DNAM)) Q:DNAM="" S LRES=$P($G(^LR(ILR,"CH",LDT,LDAT)),U,1),DTRC=$P($G(^LR(ILR,"CH",LDT,0)),U,1),Y=DTRC D DD^%DT S DTAA=Y D PLBS,CDTWO,VIRONE
52 Q
53PLBS Q:(LRES["CANC")!(LRES["canc")
54 Q:(DTRC["CANC")!(DTRC["canc")
55 S DTR1=$E(DTAA,1,3),DTR2=$E(DTAA,9,12),DTRD=DTR1_","_DTR2,DTAA=$E(DTAA,1,12),LDO=$E(LDT,1,7)
56 I LGN="CD4" Q:DNAM'=LDAT Q:UNS["%" D CHRG,CHLV
57 Q
58CDTWO Q:(LRES["CANC")!(LRES["canc")
59 Q:(DTRC["CANC")!(DTRC["canc")
60 S DTR1=$E(DTAA,1,3),DTR2=$E(DTAA,9,12),DTRD=DTR1_","_DTR2,DTAA=$E(DTAA,1,12),LDO=$E(LDT,1,7)
61 I LGN="CD4" Q:DNAM'=LDAT Q:UNS'["%" D CHPR
62 Q
63VIRONE Q:(LRES["CANC")!(LRES["canc")
64 Q:(DTRC["CANC")!(DTRC["canc")
65 S DTR1=$E(DTAA,1,3),DTR2=$E(DTAA,9,12),DTRD=DTR1_","_DTR2,DTAA=$E(DTAA,1,12),LDO=$E(LDT,1,7)
66 I LGN="VIRAL LOAD" Q:DNAM'=LDAT D STORE
67 Q
68CHRG ; Update CD4
69 Q:(LRES["CANC")!(LRES["canc")
70 Q:(LRES["COMMENT")!(LRES["comment")
71 Q:LRES=""
72 Q:(DTRC["CANC")!(DTRC["canc")
73 S IMRXCAT=$P($G(^IMR(158,IMRFN,0)),U,42)
74 I $D(IMRXCAT),LRES>199,LRES<500,IMRXCAT=1 S $P(^IMR(158,IMRFN,0),U,42)=2,$P(^IMR(158,IMRFN,0),U,44)=DT
75 I $D(IMRXCAT),LRES<200,IMRXCAT=1 S $P(^IMR(158,IMRFN,0),U,42)=3,$P(^IMR(158,IMRFN,0),U,35)=DT
76 I $D(IMRXCAT),LRES<200,IMRXCAT=2 S $P(^IMR(158,IMRFN,0),U,42)=3,$P(^IMR(158,IMRFN,0),U,35)=DT
77 S LCDD=$P($G(^IMR(158,IMRFN,102)),U,2)
78 S:(LCDD'="")&(DTRC>LCDD) $P(^IMR(158,IMRFN,102),U,2)=DTRC,$P(^IMR(158,IMRFN,102),U,1)=LRES
79 S:LCDD="" $P(^IMR(158,IMRFN,102),U,2)=DTRC,$P(^IMR(158,IMRFN,102),U,1)=LRES
80 Q
81 ; lowest CD4 value and date
82CHLV Q:(LRES["CANC")!(LRES["canc")
83 Q:(LRES["COMMENT")!(LRES["comment")
84 Q:LRES=""
85 Q:(DTRC["CANC")!(DTRC["canc")
86 S PLOW=$P($G(^IMR(158,IMRFN,102)),U,5) ;get lowest CD4 value in File 158 for comparison
87 S:(PLOW'="")&(LRES<PLOW) $P(^IMR(158,IMRFN,102),U,5)=LRES,$P(^IMR(158,IMRFN,102),U,6)=DTRC
88 S:PLOW="" $P(^IMR(158,IMRFN,102),U,5)=LRES,$P(^IMR(158,IMRFN,102),U,6)=DTRC
89 Q
90CHPR ; Update CD4 Percentage & Current Category if Applicable
91 Q:(LRES["CANC")!(LRES["canc")
92 Q:(LRES["COMMENT")!(LRES["comment")
93 Q:LRES=""
94 Q:(DTRC["CANC")!(DTRC["canc")
95 S IMRXCAT=$P($G(^IMR(158,IMRFN,0)),U,42)
96 I $D(IMRXCAT),LRES<14,IMRXCAT=1 S $P(^IMR(158,IMRFN,0),U,42)=3,$P(^IMR(158,IMRFN,0),U,35)=DT
97 I $D(IMRXCAT),LRES<14,IMRXCAT=2 S $P(^IMR(158,IMRFN,0),U,42)=3,$P(^IMR(158,IMRFN,0),U,35)=DT
98 S LOWP=$P($G(^IMR(158,IMRFN,112)),U,9)
99 S:(LOWP'="")&(LRES<LOWP) $P(^IMR(158,IMRFN,112),U,9)=LRES,$P(^IMR(158,IMRFN,112),U,10)=DTRC
100 S:LOWP="" $P(^IMR(158,IMRFN,112),U,9)=LRES,$P(^IMR(158,IMRFN,112),U,10)=DTRC
101 Q
102STORE ; Store viral load data in 113 nodes
103 Q:(LRES["CANC")!(LRES["canc")
104 Q:(LRES["COMMENT")!(LRES["comment")
105 Q:LRES=""
106 S:LRES["C" LRES=$P(LRES,"C",1)
107 S:LRES["c" LRES=$P(LRES,"c",1)
108 S:LRES["<" LRES=$P(LRES,"<",2)
109 S:LRES[">" LRES=$P(LRES,">",2)
110 S:LRES["(" LRES=$P(LRES,"(",1)
111 Q:(DTRC["CANC")!(DTRC["canc")
112 Q:$G(IMLO)="" S IMRLTEST=IMLO
113 I '$D(^IMR(158,IMRFN,113,"B",IMRLTEST)) D ;add viral test results if that test not in field 113
114 .K DA,DD,DO
115 .S:'$D(^IMR(158,IMRFN,113,0)) DIC("P")=$P(^DD(158,122,0),U,2)
116 .S X=IMRLTEST,DA(1)=IMRFN,DIC="^IMR(158,IMRFN,113,",DIC(0)="L"
117 .D FILE^DICN
118 .K DD,DO
119 .Q:Y'>0
120 .S DA=+Y
121 .S DA(1)=IMRFN,DIE="^IMR(158,IMRFN,113,",DR="1////"_LRES_";2////"_DTRC_";3////"_LRES_";4////"_DTRC
122 .D ^DIE
123 .Q
124 S IMRVLIEN=$O(^IMR(158,IMRFN,113,"B",IMRLTEST,0)) Q:'IMRVLIEN
125 S IMRLNODE=$G(^IMR(158,IMRFN,113,IMRVLIEN,0)) Q:IMRLNODE=""
126 I LRES>$P(IMRLNODE,U,2) S $P(IMRLNODE,U,2)=LRES,$P(IMRLNODE,U,3)=DTRC ;save the highest score and its date/time
127 I DTRC>$P(IMRLNODE,U,5) S $P(IMRLNODE,U,4)=LRES,$P(IMRLNODE,U,5)=DTRC ;save most recent date/time and its value
128 S ^IMR(158,IMRFN,113,IMRVLIEN,0)=IMRLNODE ;update global node
129 Q
130KILL ; kill variables
131 K CDAR,CDP,HVR,IMDATE,IMRCD4,IMRCD4D,IMRCD4E,IMRCD4X,IMRCDX,IMRCDXD,IMREDIT,IMRESULT,IMRLOOP,IMRPN,X,Y
132 K IMRLNODE,IMRLTEST,IMRP103,IMRSTN,IMRTSTI,IMRTSTII,IMRVLIEN,IMRXCAT,LCDD,LLOC,MDT,PLOW,RC
133 Q
Note: See TracBrowser for help on using the repository browser.