84 lines
2.9 KiB
Mathematica
84 lines
2.9 KiB
Mathematica
XDRDPRE1 ;SF-IRMFO.SEA/JLI - GENERATE LISTS OF PATIENTS IDENTIFIED BY THE PRELIMINARY SCAN ;02/23/2000 08:48
|
|
;;7.3;TOOLKIT;**23,46**;Apr 25, 1995
|
|
;;
|
|
EN ;
|
|
S XDRFL=+$$FILE^XDRDPICK() G:XDRFL'>0 EXIT S XDRFNAM=$P(^DIC(XDRFL,0),U)
|
|
I '$D(^XTMP("XDRDPREL",XDRFL," DONE")) D Q:XDRFL=0
|
|
. I $D(^XTMP("XDRDPREL",XDRFL," TIME")) D Q:XDRFL=0
|
|
. . I $$HDIFF^XLFDT($H,^XTMP("XDRDPREL",XDRFL," TIME"),2)>300 Q
|
|
. . W !!,"There appears to be a job already running. You may either"
|
|
. . W !,"view those data or check back in about 5 minutes.",!!
|
|
. . S XDRFL=0
|
|
. W !!,$C(7),"There is no available data to generate a list from. You will need to accumulate",!,"the data.",!!
|
|
. D ^XDRDPREL
|
|
. S XDRFL=0
|
|
D SELECT I XDRSELEC="" Q
|
|
S %ZIS="Q" D ^%ZIS Q:POP
|
|
I $D(IO("Q")) S ZTSAVE("XDRFL")="",ZTSAVE("XDRSELEC")="",ZTIO=ION,ZTRTN="DQ^XDRDPRE1",ZTDESC="XDRDPRE1 LIST OF PROBLEMS" D ^%ZTLOAD W:$D(ZTSK) !,"Queued as task "_ZTSK,! Q
|
|
;
|
|
DQ ;
|
|
U IO W @IOF
|
|
S XDRTMP="^XTMP(""XDRDPREL"",XDRFL,XDRSELEC,XDRDA)"
|
|
S XDRGLB=^DIC(XDRFL,0,"GL")_"XDRDA)"
|
|
S XDRDR=".01;"
|
|
F XDRI=0:0 S XDRI=$O(^DD(XDRFL,0,"ID",XDRI)) Q:XDRI'>0 S XDRDR=XDRDR_XDRI_";"
|
|
I XDRSELEC'="NO ZERO NODE" D SIZE
|
|
D HEADER
|
|
F XDRDA=0:0 S XDRDA=$O(@XDRTMP) Q:XDRDA'>0 D Q:$D(DIRUT)
|
|
. I (IOSL-$Y)<6 D:IOST["C-" Q:$D(DIRUT) W @IOF,!!
|
|
. . W ! S DIR(0)="E" D ^DIR
|
|
. W !,$J(XDRDA,10)
|
|
. I XDRSELEC="NO ZERO NODE" Q
|
|
. S DR=XDRDR
|
|
. S DA=XDRDA,DIC=XDRFL,DIQ(0)="I",DIQ="XDRX" K XDRX
|
|
. D EN^DIQ1
|
|
. S X=XDRX(XDRFL,XDRDA,.01,"I")
|
|
. F Q:X'["MERGING INTO" S X=$P(X,"(",2,99),X=$E(X,1,$L(X)-1)
|
|
. W " ",$E(X,1,28),?40
|
|
. F I=0:0 S I=$O(XDRX(XDRFL,XDRDA,I)) Q:I'>0 I I'=.01 D
|
|
. . S Y=$P(^DD(XDRFL,I,0),U,2)
|
|
. . S X=XDRX(XDRFL,XDRDA,I,"I")
|
|
. . I Y["D" S N=10 I X'="" S X=$$FMTE^XLFDT(X,"2D") W $J(X,N)
|
|
. . I Y'["D",$D(NSIZE(I)) S N=NSIZE(I)+2 W $J(X,N)
|
|
D ^%ZISC
|
|
Q
|
|
;
|
|
SIZE ;
|
|
N XDRDA,NC,DR,DA,DIC,DIQ,I,L
|
|
S NC=0
|
|
F XDRDA=0:0 S XDRDA=$O(@XDRGLB) Q:XDRDA'>0 S NC=NC+1 Q:NC>50 D
|
|
. S DR=XDRDR
|
|
. S DA=XDRDA,DIC=XDRFL,DIQ(0)="I",DIQ="XDRX" K XDRX
|
|
. D EN^DIQ1
|
|
. F I=0:0 S I=$O(XDRX(XDRFL,XDRDA,I)) Q:I'>0 D
|
|
. . S L=$L(XDRX(XDRFL,XDRDA,I,"I")) I L>$G(NSIZE(I)) S NSIZE(I)=L
|
|
Q
|
|
;
|
|
HEADER ;
|
|
W "LISTING OF ENTRIES IN FILE ",XDRFL," WITH IDENTIFIER OR OTHER PROBLEMS"
|
|
W ?10,"SELECTED LISTING: ",XDRSELEC
|
|
W !!!,"DATA LISTED ACROSS THE PAGE IN THE FOLLOWING ORDER:",!!,"INTERNAL ENTRY NUMBER"
|
|
I XDRSELEC="NO ZERO NODE" W !! Q
|
|
F I=0:0 S I=$O(NSIZE(I)) Q:I'>0 W !,$P(^DD(XDRFL,I,0),U)
|
|
W !!,"XXXXXXXXXX XXXXXXXXXXXXXXXXXXXXXXXXXXX",?40
|
|
F I=.01:0 S I=$O(NSIZE(I)) Q:I'>0 D
|
|
. S X=$P(^DD(XDRFL,I,0),U,2) I X["D" S NSIZE(I)=8
|
|
. S X=$E("XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",1,NSIZE(I))
|
|
. W $J(X,NSIZE(I)+2)
|
|
W !
|
|
Q
|
|
;
|
|
SELECT ;
|
|
N NC,N,XDRX,I,DIR,Y
|
|
S NC=0
|
|
S N="A" F S N=$O(^XTMP("XDRDPREL",XDRFL,N)) Q:N="" S NC=NC+1,XDRX(NC)=N
|
|
W !!,"Enter the number of the desired list to output:",!
|
|
F I=0:0 S I=$O(XDRX(I)) Q:I'>0 W !,$J(I,2)," ",XDRX(I)
|
|
W !! S DIR(0)="N^1:"_NC,DIR("A")="List number" D ^DIR
|
|
S XDRSELEC=""
|
|
I Y>0 S XDRSELEC=XDRX(+Y)
|
|
Q
|
|
;
|
|
EXIT ;
|
|
Q
|