1 | IMRSRCH ;ISC-SF/JLI,HCIOFO/FT-CREATE SEARCH LIST FOR IMR MEMBERS IN PT FILE ;10/16/97 16:20
|
---|
2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
---|
3 | ;[IMR SEARCH TEMPLATE] - Create Search Template Containing Study Members
|
---|
4 | I '$D(^XUSEC("IMRA",DUZ)) S IMRLOC="IMRSRCH" D ACESSERR^IMRERR,H^XUS
|
---|
5 | TOP S IMRTNAM="",IMROUT=0,IMRDONE=0
|
---|
6 | F I=0:0 Q:IMROUT!IMRDONE S IMRTNAM=$O(^DIBT("F158.90",IMRTNAM)) Q:IMRTNAM="" F J=0:0 S J=$O(^DIBT("F158.90",IMRTNAM,J)) Q:J'>0 I $D(^DIBT(J,0)),$P(^(0),U,5)=DUZ S X=$P(^(0),U,2) D CHEK Q:IMROUT I "Yy"[X S IMRDONE=1 Q
|
---|
7 | G:IMROUT EXIT S DA=$S(IMRTNAM="":-1,1:J)
|
---|
8 | ASK I DA'>0 W !,"Enter a non-descriptive sort template name that will contain the patient",!,"identities: " R X:DTIME G:'$T!(X[U)!(X="") EXIT S IMRTNAM=X I X["?" D QUERY G ASK
|
---|
9 | I $D(^DIBT("F2",IMRTNAM)),'IMRDONE S DA=$O(^DIBT("F2",IMRTNAM,0)) W !,$C(7),"THERE IS ALREADY DATA STORED IN THAT TEMPLATE -- REPLACE ?? NO// " R Y:DTIME G:'$T!(Y[U) EXIT S:Y="" Y="N" S Y=$E(Y),IMRDONE=1 I "Yy"'[Y S DA=-1,IMRDONE=0 G ASK
|
---|
10 | I DA'>0 S X=""""_IMRTNAM_"""",DIC=.401,DIC(0)="L",DLAYGO=.401 D ^DIC G:Y'>0 EXIT S DA=+Y
|
---|
11 | W:'$D(ZTQUEUED) ! S DIE=.401,DR="2///T;"_$S(IMRDONE:"",1:"4///2;")_"5///"_DUZ_";7///T;" D ^DIE
|
---|
12 | K ^DIBT(DA,1) S ^DIBT("F158.90",IMRTNAM,DA)=""
|
---|
13 | K DIR S DIR(0)="Y",DIR("A")="Do you want to Queue this task (it may take a while) ",DIR("B")="YES" D ^DIR K DIR
|
---|
14 | I Y S ZTRTN="DQSRCH^IMRSRCH",ZTIO="",ZTDESC="Generate Search List",ZTSAVE("DA")="",ZTSAVE("IMRSTN")="",ZTSAVE("IMRTNAM")="" D ^%ZTLOAD K ZTRTN,ZTSK,ZTIO,ZTDESC,ZTSAVE G EXIT
|
---|
15 | W !,"Well, All right.... I'm working as fast as I can...",!
|
---|
16 | DQSRCH ;
|
---|
17 | F I=0:0 S I=$O(^IMR(158,I)) Q:I'>0 S X=$P(^(I,0),U) D ^IMRXOR S ^DIBT(DA,1,X)="" W:'$D(ZTQUEUED) "."
|
---|
18 | I '$D(ZTQUEUED) W !!,"The entries are now stored in the template [",IMRTNAM,"]",!,"for use with the FileMan PRINT option",!
|
---|
19 | ;
|
---|
20 | EXIT K %,%DT,DQ,DA,DIE,DIC,DR,I,DLAYGO,IMRLOC,IMROUT,IMRDONE,IMRTNAM,DIK,IMRX,J,Y,IMRSTN,D,D0,DI,X,X1,DISYS,POP,DIR,DIROUT,DIRUT,DTOUT,DUOUT
|
---|
21 | Q
|
---|
22 | QUERY ;
|
---|
23 | W !!,"Enter a Name by which the search template for the PATIENT file can be",!,"identified. This should probably not include HIV or other HIV specific",!,"text.",!
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | CHEK ;
|
---|
27 | W !!,"You already have the search template [",IMRTNAM,"]",!,"from ",$E(X,4,5),"-",$E(X,6,7),"-",$E(X,2,3),!!,"Do you wish to UPDATE it? YES// "
|
---|
28 | S IMROUT=0 R Z:DTIME S:'$T!(Z[U) IMROUT=1 Q:IMROUT S:Z="" Z="Y" S Z=$E(Z) I "YyNn"'[Z W:Z'="?" $C(7)," ??" W !?10,"Enter YES to update the template, NO to keep it as is, ^ to exit" G CHEK
|
---|
29 | S X=Z K Z
|
---|
30 | Q
|
---|
31 | ;
|
---|
32 | SHOW ;[IMR TEMPLATE LIST] - List Search Templates for Package
|
---|
33 | ; Show search templates for IMR file, with user, date created,
|
---|
34 | ; last date used
|
---|
35 | S IMRDONE=0,IMRTNAM="",IMROUT=0
|
---|
36 | W:$Y>0 @IOF
|
---|
37 | W !,"Template List as of ",$$FMTE^XLFDT($$NOW^XLFDT(),1),!
|
---|
38 | F I=0:0 S IMRTNAM=$O(^DIBT("F158.90",IMRTNAM)) Q:IMRTNAM=""!(IMROUT) F J=0:0 S J=$O(^DIBT("F158.90",IMRTNAM,J)) Q:J'>0!(IMROUT) D SHOW1
|
---|
39 | I 'IMROUT D PRTC
|
---|
40 | W ! D EXIT
|
---|
41 | Q
|
---|
42 | ;
|
---|
43 | SHOW1 I '$D(^DIBT(J,0)) K ^DIBT(J),^DIBT("F158.90",IMRTNAM,J),^DIBT("F2",IMRTNAM,J) Q
|
---|
44 | I 'IMRDONE W !!,"TEMPLATE NAME",?30,"CREATED BY",?60,"CREATED",?69,"LAST USED",! S IMRDONE=1
|
---|
45 | S X=^DIBT(J,0),X1=$P(X,U,2),X2=$P(X,U,7),X3=$P(X,U,5),X3=$S('$D(^VA(200,+X3,0)):"UNKNOWN",1:$P(^(0),U))
|
---|
46 | I $Y>(IOSL-4) D PRTC Q:IMROUT W @IOF
|
---|
47 | W !,$P(X,U),?30,X3,?60,$E(X1,4,5),"-",$E(X1,6,7),"-",$E(X1,2,3),?70,$E(X2,4,5),"-",$E(X2,6,7),"-",$E(X2,2,3)
|
---|
48 | K X,X1,X2,X3
|
---|
49 | Q
|
---|
50 | ;
|
---|
51 | DELETE ;[IMR TEMPLATE DELETE] - Delete a Package Search Template
|
---|
52 | R !!,"Enter Template Name containing Immunology Study Patients: ",X:DTIME
|
---|
53 | G:'$T!(X="")!(X[U) EXIT
|
---|
54 | K DA S DA=0
|
---|
55 | I $D(^DIBT("F158.90",X)) S DA=DA+1,DA(DA,+$O(^(X,0)))=X
|
---|
56 | S X1=X
|
---|
57 | F I=0:0 S X=$O(^DIBT("F158.90",X)) Q:X=""!($E(X,1,$L(X1))'=X1) S DA=DA+1,DA(DA,+$O(^(X,0)))=X
|
---|
58 | I DA'>0 W:$E(X1)'="?" $C(7)," ??" W !,"Select from:" D SHOW G DELETE
|
---|
59 | I DA=1 S J=$O(DA(1,0)),X=DA(1,J) S X=$E(X,$L(X1)+1,$L(X)) W:X'="" X,!
|
---|
60 | ASKDEL I DA>1 W !!,"Select from:" F I=1:1:DA S J=$O(DA(I,0)),X=DA(I,J) W !?10,$J(I,2)," ",X
|
---|
61 | I DA>1 W !!,"Select from 1 to ",DA,": " R X:DTIME Q:'$T!(X="")!(X[U) G:X'=+X!(X<1)!(X>DA) ASKDEL S J=$O(DA(X,0)),DA(1,J)=DA(X,J),DA=1
|
---|
62 | S J=$O(DA(1,0)),IMRX=DA(1,J)
|
---|
63 | W !!,"Ready to DELETE the template ",IMRX," (Y/N)? N//" R X:DTIME
|
---|
64 | Q:'$T!(X[U)
|
---|
65 | S:X="" X="N" S X=$E(X)
|
---|
66 | W:"YyNn"'[X $C(7),!,"Enter YES or NO or '^' to exit"
|
---|
67 | G:"YyNn"'[X ASKDEL
|
---|
68 | I "Nn"[X W $C(7),!!?20,"NOTHING DELETED" G DELETE
|
---|
69 | K DA S DA=J,DIK="^DIBT(" D ^DIK
|
---|
70 | K ^DIBT("F158.90",IMRX)
|
---|
71 | G DELETE
|
---|
72 | PRTC ; press return to continue
|
---|
73 | Q:$E(IOST)'="C"
|
---|
74 | Q:$D(IO("S"))
|
---|
75 | K DIR S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT)!(Y=0) IMROUT=1
|
---|
76 | Q
|
---|