1 | ENJDPL ;(WASH ISC)/JA-Display a Screen ;5-29-91
|
---|
2 | ;;7.0;ENGINEERING;;Aug 17, 1993
|
---|
3 | S:'$D(DJDPL) DJDPL="" I DJDPL'=DJNM S DJN=$O(^ENG(6910.9,"B",DJNM,0)) G ER:DJN'>0
|
---|
4 | N S:'$D(DJFF) DJFF=0
|
---|
5 | K DJJ,DJF,DJKEY,DJY S:DJN'=+DJN DJN=$O(^ENG(6910.9,"B",DJN,0)) G ER:DJN'>0 S DJ0=^ENG(6910.9,DJN,0),DJDPL=$P(DJ0,U,1),DJJ=$P(DJ0,U,2,5),DJDD=$P(DJ0,U,6),V=$O(^ENG(6910.9,DJN,1,"A",0)) S (DJL,DJF)=V
|
---|
6 | G ER:+V'>0
|
---|
7 | D:'DJFF HDH I DJDD'=+DJDD S DIC="^ENG(6910.9,DJN,1," G N1
|
---|
8 | S DJ0="",DJ1=DJDD F V=1:1 Q:'$D(^DD(DJ1,0,"UP")) S DJ1=^("UP"),DJ2=$O(^("NM",0)),DJ2=$O(^DD(DJ1,"B",DJ2,0)),DJ2=$P($P(^DD(DJ1,DJ2,0),U,4),";",1) S:DJ2'=+DJ2 DJ2=""""_DJ2_"""" S DJ0="DA("_V_"),"_DJ2_","
|
---|
9 | S DIC=^DIC(DJ1,0,"GL")_DJ0,V=DJF,DIE=DIC I $D(DJST),DJST>1 S DIC=^TMP($J,"DJST",DJST,"DIC")
|
---|
10 | S:'$D(^ENG(6910.9,DJN,1,"A",V)) (DJF,V)=$O(^(V))
|
---|
11 | N1 S DJK=$O(^ENG(6910.9,DJN,1,"A",V,0)) G ER:DJK'>0!($D(^ENG(6910.9,DJN,1,DJK,0))<0) S DJ0=^ENG(6910.9,DJN,1,DJK,0) S:$P(DJ0,U,5)=.01 DJKEY=V G:$P(DJ0,U,2)="" ER S @$P(DJ0,U,2) X XY I V#1=0 W @DJHIN X XY W $J(V,2)," ",@DJLIN
|
---|
12 | I '$P(DJ0,U,8) W $P(DJ0,U,1) W:$P(DJ0,U,5)>0 ":"
|
---|
13 | I V#1=0!(V=.5) S DJJ(V)=$P(DJ0,U,3,7)_"^"_$P(DJ0,U,12),@$P(DJ0,U,4) X XY K:$P(DJ0,U,5)<0 V(V) I $P(DJ0,U,12)]"" S DJNO=$O(^ENG(6910.9,"B",$P(DJ0,U,12),0)) S DJJ(V)=DJJ(V)_U_$P(^ENG(6910.9,DJNO,1,0),U,4)
|
---|
14 | G:V#1'=0 N2
|
---|
15 | I $D(V(V))&DJJ(V) W @DJHIN X XY S:DJJ(V)["M" V(V)=$E(V(V),1,+DJJ(V)) I V(V)]"" S $P(DJDB," ",DJJ(V)-$L(V(V)))=" " W V(V) W:$D(DJDB) DJDB K DJDB W @DJLIN
|
---|
16 | E S $P(DJDB,".",DJJ(V))="." W @DJLIN,DJDB K DJDB
|
---|
17 | N2 S V=$O(^ENG(6910.9,DJN,1,"A",V)) S:V>DJL DJL=V G N1:V>0 S V=DJF
|
---|
18 | K DJ0,DJ1,DJ2 Q
|
---|
19 | EN S DJFF=0 G N
|
---|
20 | EN1 S DJFF=1 G N
|
---|
21 | ;Q
|
---|
22 | HDH ;HEADING
|
---|
23 | S DJT=$P(DJ0,U,7) S DY=0,DX=0 X DJCP W @IOF,?(80-$L(DJT))/2-5,DJT," ",$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3)
|
---|
24 | I $D(DJST),DJST>1 F DJK=1:1:DJST-1 W !,?DJK*2,"***",^TMP($J,"DJST",DJK,"TITLE"),"***"
|
---|
25 | I $D(DJST),$P(DJJ,U,2)'="" W !,?3,"***",^TMP($J,"DJST",DJST,"TITLE"),"***"
|
---|
26 | Q
|
---|
27 | ER X DJCL W "SCREEN **",DJNM,"** HAS NOT BEEN PROPERLY CREATED. Check your 'A' XREF",*7 H 2
|
---|
28 | K DIC,DIE,DJ0,DJ1,DJDD,DJDPL,DJF,DJJ,DJK,DJKL,DJKL,DJL,DJNM,DJT,V
|
---|
29 | S DJY=-1 Q
|
---|