source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRSCNT.m@ 1459

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IMRSCNT ;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)
13ASK 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 ;
19DQ ;
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
31KILL 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 ;
36ASKEM 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
40BEDSEC 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
Note: See TracBrowser for help on using the repository browser.