source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLCAT2.m@ 724

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1IMRLCAT2 ;HCIOFO/FT/FAI/SPS-CONTINUATION OF DISTRIBUTION OF PATIENTS BY CATEGORY ;10/2/01 10:56
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,13,16**;Feb 09, 1998
3A1 ;
4 I IMRDOD>0 Q:IMRDOD<IMRHNBEG ;Check if died before range specified
5 S IMRPER=1
6 S XC0=^IMR(158,IMRI,0),IMRX=+$P(XC0,U,42),XC1=$G(^(1)),XC2=$G(^(2)),XC102=$G(^(102)),XC110=$G(^(110)),IMRSSN=$P(VADM(2),U,2)
7 I IMRPER D PERCHK^IMRLCAT1 Q:'IMRCHK
8 S IMRDT=$S(IMRDOD>0:IMRDOD,1:IMRHNEND),Y1=$P(XC0,U,36),Y3=$P(XC0,U,35),Y4=$P(XC0,U,23),Y2=$P(XC0,U,44)
9 I IMRPER,Y1+Y2+Y3+Y4>0 S IMRY=$S(Y4>0&(Y4'>IMRHNEND):4,Y3>0&(Y3'>IMRHNEND):3,Y2>0&(Y2'>IMRHNEND):2,Y1>0&(Y1'>IMRHNEND):1,1:$S(IMRX:IMRX,1:0))
10 I IMRX'>0 S:$G(IMRTEST) ^TMP($J,"ZZTEST","NOCAT",IMRI)="" Q ;is this node ever displayed?
11 S IMRX1=$S(IMRDOD'>2000000:0,IMRDOD>IMRHNEND:0,1:1),IMRX1=$S(IMRX1=0:"ALIVE (or unknown)",1:"DEAD")
12 S:'$D(^TMP($J,"A",IMRX1)) ^TMP($J,"A",IMRX1)=""
13 I 'IMRPER Q:IMRX1="DEAD"&IMREXC
14 S $P(^TMP($J,"A",IMRX1),U,IMRX)=$P(^TMP($J,"A",IMRX1),U,IMRX)+1
15 S IMRSEX=$P(VADM(5),U),IMRSEX=$S(IMRSEX="M":"MALE",IMRSEX="F":"FEMALE",1:"UNSPECIFIED")
16 I $E(IMRSEX)="U" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,1)="SEX"
17 S IMRDOB=$P(VADM(3),U) I IMRDOB>0,IMRDT<IMRDOB Q
18 S IMRAGE=$E(IMRDT,1,3)-$E(IMRDOB,1,3),IMRAGE=$S(IMRDOB'>0:"??",$E(IMRDOB,4,7)'>$E(IMRDT,4,7):IMRAGE,1:IMRAGE-1)
19 S:IMRDOB'>0 $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,2)="DOB"
20 S:'$D(^TMP($J,"S",IMRSEX)) ^TMP($J,"S",IMRSEX)=""
21 S $P(^TMP($J,"S",IMRSEX),U,IMRX)=$P(^TMP($J,"S",IMRSEX),U,IMRX)+1
22 S IMRRISK=$P(XC0,U,45)
23 I IMRRISK="" S:$G(IMRTEST) $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,3)="RISK"
24 S:IMRRISK=1 IMRRISK="GAY OR BISEXUAL MAN"
25 S:IMRRISK=2 IMRRISK="IV DRUG USER"
26 S:IMRRISK=3 IMRRISK="GAY OR BISEXUAL DRUG USER"
27 S:IMRRISK=4 IMRRISK="HEMOPHILIAC"
28 S:IMRRISK=5 IMRRISK="HETEROSEXUAL"
29 S:IMRRISK=6 IMRRISK="RECV'D TRANSFUSION/TRANSPLANT"
30 S:IMRRISK=7 IMRRISK="WORK-HEALTH/CLINICAL"
31 S:IMRRISK=8 IMRRISK="ADULT, CONFIRMED OTHER RISK"
32 S:IMRRISK=9 IMRRISK="UNKNOWN"
33 S:IMRRISK="" IMRRISK="UNREPORTED"
34 S:'$D(^TMP($J,"RI",IMRRISK)) ^TMP($J,"RI",IMRRISK)=""
35 S $P(^TMP($J,"RI",IMRRISK),U,IMRX)=$P(^TMP($J,"RI",IMRRISK),U,IMRX)+1
36 S IMRAGE=(IMRAGE\5*5)_"-"_(IMRAGE\5*5+4) D
37 .S:'$D(^TMP($J,"Y",IMRAGE)) ^TMP($J,"Y",IMRAGE)=""
38 .S $P(^TMP($J,"Y",IMRAGE),U,IMRX)=$P(^TMP($J,"Y",IMRAGE),U,IMRX)+1
39 .Q
40 S IMRRAC=$P(XC0,U,2) S:IMRRAC>5 IMRRAC="",$P(^IMR(158,IMRI,0),U,2)="" I IMRRAC="" S IMRRAC=$P(VADM(8),U) D S IMRRAC=$S(IMRRAC=1:3,IMRRAC=2:3,IMRRAC=3:5,IMRRAC=4:2,IMRRAC=5:4,IMRRAC=6:1,1:9)
41 . Q:IMRRAC="" S IMRRAC=$P(^DIC(10,+IMRRAC,0),U,2) I IMRRAC>0 Q
42 . S IMRRAC="",IMRRAC1=0 S IMRRAC1=$O(^DIC(10,"B",$P(VADM(8),U,2),IMRRAC1)) Q:'IMRRAC1 I $D(^DIC(10,IMRRAC1,0)),$P(^(0),U,2)>0 S IMRRAC=$P(^(0),U,2) Q
43 . K IMRRAC1
44 . Q
45 S IMRRAC=$P($P($P(^DD(158,1,0),U,3),IMRRAC_":",2),";") I IMRRAC="" S IMRRAC="NOT SPECIFIED"
46 I IMRTEST,IMRRAC="NOT SPECIFIED" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,4)="RACE"
47 S:'$D(^TMP($J,"R",IMRRAC)) ^TMP($J,"R",IMRRAC)=""
48 S $P(^TMP($J,"R",IMRRAC),U,IMRX)=$P(^TMP($J,"R",IMRRAC),U,IMRX)+1
49 S IMREL=$P(VAEL(1),U,2)
50 I IMREL="" S IMREL="UNSPECIFIED ELIGIBILITY" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,5)="ELIG"
51 S:'$D(^TMP($J,"E",IMREL)) ^TMP($J,"E",IMREL)=""
52 S $P(^TMP($J,"E",IMREL),U,IMRX)=$P(^TMP($J,"E",IMREL),U,IMRX)+1
53 S IMRPOS=$P(VAEL(2),U,2)
54 I IMRPOS="" S IMRPOS="UNSPECIFIED POS" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,6)="POS"
55 S:'$D(^TMP($J,"P",IMRPOS)) ^TMP($J,"P",IMRPOS)=""
56 S $P(^TMP($J,"P",IMRPOS),U,IMRX)=$P(^TMP($J,"P",IMRPOS),U,IMRX)+1
57 I $D(IMRSCH) D
58 .S:'$D(^TMP($J,"Z","SEEN AS OUTPATIENT")) ^TMP($J,"Z","SEEN AS OUTPATIENT")=""
59 .S $P(^TMP($J,"Z","SEEN AS OUTPATIENT"),U,IMRX)=$P(^TMP($J,"Z","SEEN AS OUTPATIENT"),U,IMRX)+1
60 .Q
61 I $D(IMRINP) D
62 .S:'$D(^TMP($J,"Z","SEEN AS INPATIENT")) ^TMP($J,"Z","SEEN AS INPATIENT")=""
63 .S $P(^TMP($J,"Z","SEEN AS INPATIENT"),U,IMRX)=$P(^TMP($J,"Z","SEEN AS INPATIENT"),U,IMRX)+1
64 .Q
65 I $D(IMRLAB) D
66 .S:'$D(^TMP($J,"Z","SEEN IN LABORATORY")) ^TMP($J,"Z","SEEN IN LABORATORY")=""
67 .S $P(^TMP($J,"Z","SEEN IN LABORATORY"),U,IMRX)=$P(^TMP($J,"Z","SEEN IN LABORATORY"),U,IMRX)+1
68 .Q
69 I $D(IMRRX) D
70 .S:'$D(^TMP($J,"Z","PRESCRIPTION(S) FILLED")) ^TMP($J,"Z","PRESCRIPTION(S) FILLED")=""
71 .S $P(^TMP($J,"Z","PRESCRIPTION(S) FILLED"),U,IMRX)=$P(^TMP($J,"Z","PRESCRIPTION(S) FILLED"),U,IMRX)+1
72 .Q
73 K IMRLAB,IMRINP,IMRSCH,IMRCHK,IMRRX,IMRX,XC0,IMRX1
74 Q
Note: See TracBrowser for help on using the repository browser.