| [613] | 1 | IMRLCAT ;ISC-FAI/SF/JLI,HCIOFO/FT-PATIENT DEMOGRAPHICS BY CATEGORY ;06/19/00 14:54
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
|---|
| 3 | ;[IMR CATEGORY BREAKDOWN] - Local ICR Demographics by Category
|
|---|
| 4 | W !,?10,"####################################################"
|
|---|
| 5 | W !,?10,"#",?20,"Local ICR Demographics by Category",?61,"#"
|
|---|
| 6 | W !,?10,"####################################################"
|
|---|
| 7 | D ^IMRDATE
|
|---|
| 8 | Q:'$D(IMRHNEND)
|
|---|
| 9 | Q:'$D(IMRHNBEG)
|
|---|
| 10 | MISCAT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to check for entries in the ICR file without CATEGORY data" D ^DIR K DIR Q:$D(DIRUT) S IMRMC=Y
|
|---|
| 11 | I $G(IMRMC)=1 S IMRMC=0 ;initialize flag for missing category from Nat'l Registry D CHKCAT^IMRLCAT1
|
|---|
| 12 | S IMREXC=0
|
|---|
| 13 | W ! S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want a list of patients with MISSING data elements" D ^DIR K DIR Q:$D(DIRUT) S IMRTEST=Y
|
|---|
| 14 | S X=$$RX1589^IMRUTL() ;get pharmacy archive date from File 158.9
|
|---|
| 15 | D LRARC^IMRUTL ;check Lab archive date
|
|---|
| 16 | DEV D IMRDEV^IMREDIT
|
|---|
| 17 | G:POP KILL
|
|---|
| 18 | I '$D(IO("Q")) W @IOF D DQ K ^TMP($J) Q
|
|---|
| 19 | I $D(IO("Q")) D G KILL
|
|---|
| 20 | .S ZTRTN="DQ^IMRLCAT",ZTDESC="Local ICR Demographics By Category"
|
|---|
| 21 | .S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
|
|---|
| 22 | .D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
|
|---|
| 23 | .Q
|
|---|
| 24 | DQ ; Print Patients By Category
|
|---|
| 25 | U IO K ^TMP($J),IMRLAB,IMRINP,IMRSCH,IMRCHK,IMRRX S IMRMC=1
|
|---|
| 26 | S IMRHED="Patients Seen During "_IMRHRANG_" FOR "_$S(IMREXC="A":"LIVING ",IMREXC="B":"ALIVE & DECEASED ",IMREXC="D":"DECEASED ",1:"")_"PATIENTS IN THE FILE"
|
|---|
| 27 | F IMRI=0:0 K VA,VADM,VAEL S IMRI=$O(^IMR(158,IMRI)) Q:IMRI'>0 S X=$P(^(IMRI,0),U) D XOR^IMRXOR I $D(^DPT(X,0)) S (DFN,IMRDFN)=X D 2^VADPT S IMRDOD=$P(VADM(6),U) D S:IMRDOD>0 $P(^IMR(158,IMRI,1),U,34)=2 D A1^IMRLCAT2
|
|---|
| 28 | . S:IMRDOD'>0 IMRDOD=$S($D(^IMR(158,IMRI,5)):+$P(^(5),U,19),1:0)
|
|---|
| 29 | . Q
|
|---|
| 30 | D PRNT^IMRLCAT1
|
|---|
| 31 | CLOSE D ^%ZISC K %ZIS,IOP
|
|---|
| 32 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 33 | KILL D ^%ZISC K IMREXC,IMRPER,IMRED,IMRSD,IMRDFN,IMRDD,IMRAD,IMRAGE,IMRCHK,IMRD,IMRD0,IMRDDA,IMRDOB,IMREL,IMRI,IMRJ,IMRLOC,IMRLR,IMRINP,IMRLAB,IMRPOS,IMRSEX,IMRTY,IMRHED
|
|---|
| 34 | K IMRRXN,IMRDT,IMRDTE,IMRPG,IMRREC,IMRRAC,DTOUT,VAROOT,VAERR,A,DIRUT,I,J,POP,X,X0,X1,Y,Z,D,DFN,IMRUT,IMRX,IMRX1,XC0,IMRYES,IMRDL,IMRTEST,IMRMC,IMRNODE,^TMP($J)
|
|---|
| 35 | K %I,DISYS,IMRDISP,IMRDSP,IMREC,IMRFB,IMRFLG,IMRLRC,IMRMCAT,IMROUT,IMRPTF,IMRRISK,IMRSSN,IMRST,IMRSUF,IMRY,XC1,XC102,XC110,XC2,Y1,Y2,Y3,Y4,IMRDOD
|
|---|
| 36 | D HOME^%ZIS
|
|---|
| 37 | Q
|
|---|
