| 1 | IMRLUTIL ;HCIOFO/FAI-LOCAL UTILIZATION SUMMARY ;05/18/00  17:26
 | 
|---|
| 2 |  ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
 | 
|---|
| 3 | ENTRY ;[IMR PATIENT LIST] - Local Registry List - ICR Patients
 | 
|---|
| 4 |  W !,?10,"####################################################"
 | 
|---|
| 5 |  W !,?10,"#",?20,"Summary Utilization Data",?61,"#"
 | 
|---|
| 6 |  W !,?10,"####################################################"
 | 
|---|
| 7 |  D ^IMRDATE
 | 
|---|
| 8 |  S IMR2C=1,IMRRMAX=50,IMRN2=10,IMRN1=2
 | 
|---|
| 9 |  S IMRSD=IMRHNBEG,IMRED=IMRHNEND
 | 
|---|
| 10 | CAT S DIR(0)="Y",DIR("A")="Do you want the list sorted by Category (Y/N)?",DIR("B")="NO",DIR("?")="Answer YES to sort by HIV CATEGORY." D ^DIR K DIR S IMR2C=Y
 | 
|---|
| 11 |  I IMR2C'=0 G DEV
 | 
|---|
| 12 |  ;  IF LISTING BY CATEGORY IS NO GIVE THE FOLLOWING PROMPT 
 | 
|---|
| 13 | REIM S REIM="N" R !!,"Do you want the list sorted by Reimbursement Level (Y/N)? N// ",X:DTIME G:'$T!(X[U) KILL S:X="" X="N" I "Yy"[$E(X) S REIM="Y"
 | 
|---|
| 14 |  I "YyNn"'[$E(X) W $C(7),"  ??",!!,"Enter YES or NO" G REIM
 | 
|---|
| 15 | DEV D IMRDEV^IMREDIT
 | 
|---|
| 16 |  G:POP KILL
 | 
|---|
| 17 |  I '$D(IO("Q")) D DQ Q
 | 
|---|
| 18 |  I $D(IO("Q")) D  G KILL
 | 
|---|
| 19 |  .S ZTRTN="DQ^IMRLUTIL",IOP="Q",ZTDESC="Immunology Summary Utilization Data"
 | 
|---|
| 20 |  .S ZTSAVE("*")="",ZTIO=ION_";"_IOM_";"_IOSL
 | 
|---|
| 21 |  .D ^%ZTLOAD K ZTRTN,ZTDESC,ZTSAVE,ZTSK
 | 
|---|
| 22 |  .Q
 | 
|---|
| 23 | DQ D ^IMRSUDRX,^IMRSUDOP,^IMRSUDLB,^IMRSUDRA,KILL
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 | KILL D ^%ZISC K IMRSD,IMRK,IMRED,IMREDP1,IMRX,IMRD,IMRAD,IMRDD,IMRBS,IMRCS,IMRCSN,IMRD1,IMRDAYS,IMRDFN,IMRI,IMRJ,IMRK,IMRN,IMRUT,IMRRMAX,IMR0C,IMR1C,IMR2C,IMRLBL,IMRAD1,IMRDX,IMRFLG,IMRL,IMRNAM,IMRSDV,IMRSDVA,IMRSSN,IMRZ,IMRDY
 | 
|---|
| 26 |  K IMRFLG,IMRDTH,IMRBSO,%I,%T,I,J,K,K1,L,POP,V,X,X1,X2,Y,Z,Z1,DIR,^TMP($J),VAERR,D,IMRPG,DIRUT,DTOUT,DUOUT,DIROUT,IMRALOS,DISYS,IMRDISP,IMRDSP,IMRDTE,IMREC,IMRFB,IMROUT,IMRPTF,IMRST,IMRSUF
 | 
|---|
| 27 |  D ^%ZISC
 | 
|---|
| 28 |  Q
 | 
|---|