source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRLCAT.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1IMRLCAT ;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)
10MISCAT 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
16DEV 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
24DQ ; 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
31CLOSE D ^%ZISC K %ZIS,IOP
32 S:$D(ZTQUEUED) ZTREQ="@"
33KILL 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
Note: See TracBrowser for help on using the repository browser.