| 1 | MCARDPL ;WISC/TJK,FDJW,JA-DISPLAY SCREEN ;8/31/92 09:03
|
|---|
| 2 | ;;2.3;Medicine;;09/13/1996
|
|---|
| 3 | S:'$D(DJDPL) DJDPL="" I DJDPL'=DJNM S DJN=$O(^MCAR(697.3,"B",DJNM,0)) S:DJN="" DJN=-1 G ER:DJN<1
|
|---|
| 4 | N S:'$D(DJFF) DJFF=0
|
|---|
| 5 | K DJJ,DJF,DJKEY,DJY S:DJN'=+DJN DJN=$O(^MCAR(697.3,"B",DJN,0)) S:DJN="" DJN=-1 G ER:DJN<0 S DJ0=^MCAR(697.3,DJN,0),DJDPL=$P(DJ0,U,1),DJJ=$P(DJ0,U,2,5),DJDD=$P(DJ0,U,6),V=$O(^MCAR(697.3,DJN,1,"A",0)) S:V="" V=-1 S (DJL,DJF)=V
|
|---|
| 6 | G ER:+V<0
|
|---|
| 7 | D:'DJFF HDH I DJDD'=+DJDD S DIC="^MCAR(697.3,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)) S:DJ2="" DJ2=-1 S DJ2=$O(^DD(DJ1,"B",DJ2,"")) S:DJ2="" DJ2=-1 S 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 | IF '$D(^MCAR(697.3,DJN,1,"A",V)) D
|
|---|
| 11 | . S YMLH=$O(^MCAR(697.3,DJN,1,"A",V))
|
|---|
| 12 | . I YMLH="" S YMLH=-1
|
|---|
| 13 | . S (DJF,V)=YMLH
|
|---|
| 14 | . Q
|
|---|
| 15 | ;END IF
|
|---|
| 16 | ;
|
|---|
| 17 | N1 ;
|
|---|
| 18 | S DJK=$O(^MCAR(697.3,DJN,1,"A",V,0)) S:DJK="" DJK=-1
|
|---|
| 19 | G ER:DJK<0!($D(^MCAR(697.3,DJN,1,DJK,0))<0)
|
|---|
| 20 | S DJ0=^MCAR(697.3,DJN,1,DJK,0)
|
|---|
| 21 | 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
|
|---|
| 22 | I '$P(DJ0,U,8) W:(V#1<1)&(V#1>0) DJHIN W $P(DJ0,U,1) W DJLIN W:$P(DJ0,U,5)>0 ":"
|
|---|
| 23 | 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)
|
|---|
| 24 | I $P(DJ0,U,12)]"" D
|
|---|
| 25 | .S DJNO=$O(^MCAR(697.3,"B",$P(DJ0,U,12),0))
|
|---|
| 26 | .S DJJ(V)=DJJ(V)_U_$P(^MCAR(697.3,DJNO,1,0),U,4)
|
|---|
| 27 | .K DJNO
|
|---|
| 28 | I V#1=0!(V=.5) S $P(DJJ(V),U,8)=$P(DJ0,U,2)
|
|---|
| 29 | G:V#1'=0 N2
|
|---|
| 30 | ;
|
|---|
| 31 | ; Is there data in the field?
|
|---|
| 32 | IF $G(V(V))]"",DJJ(V) D ; yes, prepare it for display
|
|---|
| 33 | . W DJHIN
|
|---|
| 34 | . X XY
|
|---|
| 35 | . I DJJ(V)["M" S V(V)=$E(V(V),1,+DJJ(V))
|
|---|
| 36 | . S DJDB=""
|
|---|
| 37 | . I DJJ(V)-$L(V(V)) S $P(DJDB," ",DJJ(V)-$L(V(V)))=" "
|
|---|
| 38 | . S DJDB=V(V)_DJDB
|
|---|
| 39 | . ;W V(V)
|
|---|
| 40 | . ;I $D(DJDB) W DJDB
|
|---|
| 41 | . ;K DJDB
|
|---|
| 42 | . ;W DJLIN
|
|---|
| 43 | . Q
|
|---|
| 44 | ELSE D ; there is no data in the field, just write dots
|
|---|
| 45 | . S $P(DJDB,".",DJJ(V))="."
|
|---|
| 46 | . W DJLIN ;,DJDB
|
|---|
| 47 | . ;K DJDB
|
|---|
| 48 | . Q
|
|---|
| 49 | ;END IF
|
|---|
| 50 | ;
|
|---|
| 51 | ; Are we going to spill over to the next line?
|
|---|
| 52 | I $L(DJDB)<80 W DJDB ; no
|
|---|
| 53 | E W $E(DJDB,1,80-DX),!,$E(DJDB,80-DX+1,$L(DJDB)) ; yes
|
|---|
| 54 | K DJDB
|
|---|
| 55 | ;
|
|---|
| 56 | N2 S V=$O(^MCAR(697.3,DJN,1,"A",V)) S:V="" V=-1 S:V>DJL DJL=V G N1:V>0 S V=DJF
|
|---|
| 57 | K DJ0,DJ1,DJ2 Q
|
|---|
| 58 | EN S DJFF=0 G N
|
|---|
| 59 | EN1 S DJFF=1 G N
|
|---|
| 60 | ;Q
|
|---|
| 61 | HDH ;HEADING
|
|---|
| 62 | 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)
|
|---|
| 63 | ;I $D(DJST),DJST>1 F DJK=1:1:DJST-1 W !,?DJK*2,"***",^TMP($J,"DJST",DJK,"TITLE"),"***"
|
|---|
| 64 | ;I $D(DJST),$P(DJJ,U,2)'="" W !,?3,"***",^TMP($J,"DJST",DJST,"TITLE"),"***"
|
|---|
| 65 | Q
|
|---|
| 66 | ER ;
|
|---|
| 67 | Q
|
|---|
| 68 | X DJCL W "SCREEN **",DJNM,"** HAS NOT BEEN PROPERLY CREATED. Check your 'A' XREF",*7 H 2
|
|---|
| 69 | K DIC,DIE,DJ0,DJ1,DJDD,DJDPL,DJF,DJJ,DJK,DJKL,DJKL,DJL,DJNM,DJT,V
|
|---|
| 70 | S DJY=-1 Q
|
|---|
