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

IMRLCAT2 ;HCIOFO/FT/FAI/SPS-CONTINUATION OF DISTRIBUTION OF PATIENTS BY CATEGORY ;10/2/01  10:56
 ;;2.1;IMMUNOLOGY CASE REGISTRY;**5,13,16**;Feb 09, 1998
A1 ;
 I IMRDOD>0 Q:IMRDOD<IMRHNBEG  ;Check if died before range specified
 S IMRPER=1
 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)
 I IMRPER D PERCHK^IMRLCAT1 Q:'IMRCHK
 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)
 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))
 I IMRX'>0 S:$G(IMRTEST) ^TMP($J,"ZZTEST","NOCAT",IMRI)="" Q  ;is this node ever displayed?
 S IMRX1=$S(IMRDOD'>2000000:0,IMRDOD>IMRHNEND:0,1:1),IMRX1=$S(IMRX1=0:"ALIVE (or unknown)",1:"DEAD")
 S:'$D(^TMP($J,"A",IMRX1)) ^TMP($J,"A",IMRX1)=""
 I 'IMRPER Q:IMRX1="DEAD"&IMREXC
 S $P(^TMP($J,"A",IMRX1),U,IMRX)=$P(^TMP($J,"A",IMRX1),U,IMRX)+1
 S IMRSEX=$P(VADM(5),U),IMRSEX=$S(IMRSEX="M":"MALE",IMRSEX="F":"FEMALE",1:"UNSPECIFIED")
 I $E(IMRSEX)="U" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,1)="SEX"
 S IMRDOB=$P(VADM(3),U) I IMRDOB>0,IMRDT<IMRDOB Q
 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)
 S:IMRDOB'>0 $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,2)="DOB"
 S:'$D(^TMP($J,"S",IMRSEX)) ^TMP($J,"S",IMRSEX)=""
 S $P(^TMP($J,"S",IMRSEX),U,IMRX)=$P(^TMP($J,"S",IMRSEX),U,IMRX)+1
 S IMRRISK=$P(XC0,U,45)
 I IMRRISK="" S:$G(IMRTEST) $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,3)="RISK"
 S:IMRRISK=1 IMRRISK="GAY OR BISEXUAL MAN"
 S:IMRRISK=2 IMRRISK="IV DRUG USER"
 S:IMRRISK=3 IMRRISK="GAY OR BISEXUAL DRUG USER"
 S:IMRRISK=4 IMRRISK="HEMOPHILIAC"
 S:IMRRISK=5 IMRRISK="HETEROSEXUAL"
 S:IMRRISK=6 IMRRISK="RECV'D TRANSFUSION/TRANSPLANT"
 S:IMRRISK=7 IMRRISK="WORK-HEALTH/CLINICAL"
 S:IMRRISK=8 IMRRISK="ADULT, CONFIRMED OTHER RISK"
 S:IMRRISK=9 IMRRISK="UNKNOWN"
 S:IMRRISK="" IMRRISK="UNREPORTED"
 S:'$D(^TMP($J,"RI",IMRRISK)) ^TMP($J,"RI",IMRRISK)=""
 S $P(^TMP($J,"RI",IMRRISK),U,IMRX)=$P(^TMP($J,"RI",IMRRISK),U,IMRX)+1
 S IMRAGE=(IMRAGE\5*5)_"-"_(IMRAGE\5*5+4) D
 .S:'$D(^TMP($J,"Y",IMRAGE)) ^TMP($J,"Y",IMRAGE)=""
 .S $P(^TMP($J,"Y",IMRAGE),U,IMRX)=$P(^TMP($J,"Y",IMRAGE),U,IMRX)+1
 .Q
 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)
 . Q:IMRRAC=""  S IMRRAC=$P(^DIC(10,+IMRRAC,0),U,2) I IMRRAC>0 Q
 . 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
 . K IMRRAC1
 . Q
 S IMRRAC=$P($P($P(^DD(158,1,0),U,3),IMRRAC_":",2),";") I IMRRAC="" S IMRRAC="NOT SPECIFIED"
 I IMRTEST,IMRRAC="NOT SPECIFIED" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,4)="RACE"
 S:'$D(^TMP($J,"R",IMRRAC)) ^TMP($J,"R",IMRRAC)=""
 S $P(^TMP($J,"R",IMRRAC),U,IMRX)=$P(^TMP($J,"R",IMRRAC),U,IMRX)+1
 S IMREL=$P(VAEL(1),U,2)
 I IMREL="" S IMREL="UNSPECIFIED ELIGIBILITY" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,5)="ELIG"
 S:'$D(^TMP($J,"E",IMREL)) ^TMP($J,"E",IMREL)=""
 S $P(^TMP($J,"E",IMREL),U,IMRX)=$P(^TMP($J,"E",IMREL),U,IMRX)+1
 S IMRPOS=$P(VAEL(2),U,2)
 I IMRPOS="" S IMRPOS="UNSPECIFIED POS" S $P(^TMP($J,"ZZTEST","FIN",VADM(1),IMRSSN),U,6)="POS"
 S:'$D(^TMP($J,"P",IMRPOS)) ^TMP($J,"P",IMRPOS)=""
 S $P(^TMP($J,"P",IMRPOS),U,IMRX)=$P(^TMP($J,"P",IMRPOS),U,IMRX)+1
 I $D(IMRSCH) D
 .S:'$D(^TMP($J,"Z","SEEN AS OUTPATIENT")) ^TMP($J,"Z","SEEN AS OUTPATIENT")=""
 .S $P(^TMP($J,"Z","SEEN AS OUTPATIENT"),U,IMRX)=$P(^TMP($J,"Z","SEEN AS OUTPATIENT"),U,IMRX)+1
 .Q
 I $D(IMRINP) D
 .S:'$D(^TMP($J,"Z","SEEN AS INPATIENT")) ^TMP($J,"Z","SEEN AS INPATIENT")=""
 .S $P(^TMP($J,"Z","SEEN AS INPATIENT"),U,IMRX)=$P(^TMP($J,"Z","SEEN AS INPATIENT"),U,IMRX)+1
 .Q
 I $D(IMRLAB) D
 .S:'$D(^TMP($J,"Z","SEEN IN LABORATORY")) ^TMP($J,"Z","SEEN IN LABORATORY")=""
 .S $P(^TMP($J,"Z","SEEN IN LABORATORY"),U,IMRX)=$P(^TMP($J,"Z","SEEN IN LABORATORY"),U,IMRX)+1
 .Q
 I $D(IMRRX) D
 .S:'$D(^TMP($J,"Z","PRESCRIPTION(S) FILLED")) ^TMP($J,"Z","PRESCRIPTION(S) FILLED")=""
 .S $P(^TMP($J,"Z","PRESCRIPTION(S) FILLED"),U,IMRX)=$P(^TMP($J,"Z","PRESCRIPTION(S) FILLED"),U,IMRX)+1
 .Q
 K IMRLAB,IMRINP,IMRSCH,IMRCHK,IMRRX,IMRX,XC0,IMRX1
 Q