| 1 | IMRSCNT ;HCIOFO/FT/FAI-LOCAL COUNT OF PTS, STATUS, OP VISITS, IP STAYS, ETC. ;07/17/00 17:50
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
|---|
| 3 | ;[IMR SPECFC IP/OP ACTIVITY LIST] - Specific Inpatient/Outpatient
|
|---|
| 4 | ; Utilization
|
|---|
| 5 | ;
|
|---|
| 6 | ; Naked global references on lines ASKEM+1 and ASKEM+2 are in a screen
|
|---|
| 7 | ; input as part of the calls to routine DIC. The naked references are
|
|---|
| 8 | ; to the zero node of the current potential selection.
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | I '$D(^XUSEC("IMRMGR",DUZ)) S IMRLOC="IMRSCNT" D ACESSERR^IMRERR,H^XUS K IMRLOC
|
|---|
| 12 | K ^TMP($J)
|
|---|
| 13 | ASK D ^IMRDATE Q:$G(IMRHNBEG)=""
|
|---|
| 14 | S IMRSD=IMRHNBEG,IMRED=IMRHNEND
|
|---|
| 15 | I IMRED<IMRSD W !,$C(7),"END CAN NOT BE BEFORE START",! G ASK
|
|---|
| 16 | D ASKEM G:'$D(^TMP($J))!IMRUT KILL D IMRDEV^IMREDIT G:POP KILL
|
|---|
| 17 | I $D(IO("Q")) S ZTRTN="DQ^IMRSCNT",ZTIO=ION_";"_IOM_";"_IOSL,ZTSAVE("IMRSD")="",ZTSAVE("IMRED")="",ZTSAVE("^TMP($J,")="",ZTDESC="Selected IP/OP Activty" D ^%ZTLOAD K ZTRTN,ZTIO,ZTSAVE,ZTDESC,ZTSK G KILL
|
|---|
| 18 | ;
|
|---|
| 19 | DQ ;
|
|---|
| 20 | U IO D GETNOW^IMRACESS
|
|---|
| 21 | S X1=IMRED,X2=1 D C^%DTC S IMREDP1=X,IMRPG=0
|
|---|
| 22 | F IMRL=0:0 S IMRL=$O(^IMR(158,IMRL)) Q:IMRL'>0 S X=+^(IMRL,0) D ^IMRXOR S IMRDFN=X I $D(^DPT(IMRDFN,0)) S DFN=IMRDFN D NS^IMRCALL K DFN S IMR1C="CT" D C1^IMRLCNT
|
|---|
| 23 | K VADM,VA
|
|---|
| 24 | D ^IMRLCNT1,^IMRSCNT1
|
|---|
| 25 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 26 | I 'IMRUT D
|
|---|
| 27 | .Q:$E(IOST)'="C"
|
|---|
| 28 | .Q:$D(IO("S"))
|
|---|
| 29 | .K DIR S DIR(0)="E" D ^DIR
|
|---|
| 30 | .Q
|
|---|
| 31 | KILL D ^%ZISC
|
|---|
| 32 | K IMRSD,IMRK,IMRED,IMRX,IMRD,IMRAD,IMRDD,IMRBS,IMRCS,IMRCSN,IMRD1,IMRDAYS,IMRDFN,IMRI,IMRJ,HIKK,IMRN,IMRUT,IMRRMAX,IMR0C,IMR1C,IMRAD1,IMRDX,IMREDP1,IMRFLG,IMRI1,IMRII,IMRL,IRMNAM,IMRSC,IMRSDV,IMRSDVA,IMRSS,IMRSSI,IMRSSN,IMRSTN,IMRV
|
|---|
| 33 | K A,DIC,K1,N,N1,ND,V,VAERR,I,J,K,L,POP,X,X1,X2,Y,Z,Z1,DIR,^TMP($J),IMRDY,IMRNAM,%T,DISYS,IMRDTE,IMRPG,%I,%Y,IMRBSO,IMRDISP,IMRDSP,IMRDTH,IMREC,IMRFB,IMROUT,IMRPTF,IMRST,IMRSUF
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | ASKEM K DIC S IMRUT=0 R !!,?5,"Select a CLINIC STOP NAME (or C.CLINIC NAME): ",X:DTIME S:'$T!(X[U) IMRUT=1 Q:IMRUT
|
|---|
| 37 | I X'="","C.c."'[$E(X,1,2) S X1=X,DIC("S")="I $P(^(0),U,3)=""""!(IMRSD<$P(^(0),U,3))",DIC(0)="ME",DIC=40.7 D ^DIC I Y>0 S ^TMP($J,"SOP",$P(^DIC(40.7,+Y,0),U,2))=0 G ASKEM ;Naked reference is to 0 node of potential selection
|
|---|
| 38 | I X'="" S:"C.c."[$E(X,1,2) X=$E(X,3,$L(X)) S DIC(0)="MEZ",DIC=44,DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC I Y>0 S Y=+$P(Y(0),U,7) I Y>0 S Y=^DIC(40.7,Y,0),^TMP($J,"SOP",$P(Y,U,2))=0 W !,"Stop Code: ",$P(Y,U,2)," ",$P(Y,U),! G ASKEM
|
|---|
| 39 | I X'="" W $C(7)," ??",!!,"Enter a desired stop code or specify a clinic name preceded by C. to select",!,"the stop code which includes the specified clinic.",! G ASKEM
|
|---|
| 40 | BEDSEC K DIC S DIC(0)="AMEQ",DIC=42.4 D ^DIC
|
|---|
| 41 | I $D(DTOUT)!($D(DUOUT)) S IMRUT=1 Q
|
|---|
| 42 | I Y>0 S ^TMP($J,"SBS",$P(Y,U,2))="" G BEDSEC
|
|---|
| 43 | Q
|
|---|
