| 1 | TMGDIS1 ;TMG/kst/Custom version of DIS1 ;03/25/06 ; 5/15/10 11:15pm
|
|---|
| 2 | ;;1.0;TMG-LIB;**1**;01/01/06
|
|---|
| 3 | ;----Prior header below ----------
|
|---|
| 4 | ;SFISC/GFT-BUILD DIS-ARRAY ;20MAR2005
|
|---|
| 5 | ;;22.0;VA FileMan;**6,77,97,113,144**;Mar 30, 1999;Build 5
|
|---|
| 6 | ;
|
|---|
| 7 | DIS1 ;"Purpose: BUILD DIS-ARRAY
|
|---|
| 8 | KILL DIS0
|
|---|
| 9 | IF $D(DL)#2 SET DIS0=DL
|
|---|
| 10 | SET DL(0)=""
|
|---|
| 11 | ;"W !
|
|---|
| 12 | IF $D(DE)>1!$D(DJ) GOTO 1
|
|---|
| 13 | IF DL=1 DO
|
|---|
| 14 | . SET DL(0)=DL(1),DL=0 KILL DL(1)
|
|---|
| 15 | ELSE DO
|
|---|
| 16 | . FOR P=2:1 SET Y=$P(DL(1),U,P) QUIT:Y="" DO
|
|---|
| 17 | . . SET Y=U_Y_U
|
|---|
| 18 | . . SET X=2
|
|---|
| 19 | . . DO 2
|
|---|
| 20 | FOR X=1:1 QUIT:'$D(DL(X)) DO
|
|---|
| 21 | . FOR Y=X+1:1 QUIT:'$D(DL(Y)) DO
|
|---|
| 22 | . . IF DL(X)=DL(Y)!(DL(Y)?.P) DO
|
|---|
| 23 | . . . SET DL=DL-1
|
|---|
| 24 | . . . KILL DL(Y)
|
|---|
| 25 | . . . FOR P=Y:1:DL SET DL(P)=DL(P+1) KILL DL(P+1)
|
|---|
| 26 | 1 DO ENT
|
|---|
| 27 | IF '$D(DIAR) DO DIS2^TMGDIS2 GOTO TMGDONE ;"Sets TMGRESULT
|
|---|
| 28 | DO DIS^TMGDIS2 ;"Sets TMGRESULT
|
|---|
| 29 | GOTO TMGDONE ;"quit from there
|
|---|
| 30 | ;
|
|---|
| 31 | ENT SET DK(0)=DK,Z="D0,"
|
|---|
| 32 | FOR DQ=0:1:DL DO
|
|---|
| 33 | . KILL R,M
|
|---|
| 34 | . DO
|
|---|
| 35 | . . N I SET I=""
|
|---|
| 36 | . . FOR SET I=$O(DI(I)) QUIT:'I KILL DI(I)
|
|---|
| 37 | . . QUIT
|
|---|
| 38 | . SET X=0,DQ(0)=DQ,R=-1
|
|---|
| 39 | . DO MAKE
|
|---|
| 40 | . SET %=0
|
|---|
| 41 | . FOR SET R=$O(R(R)) QUIT:R="" DO
|
|---|
| 42 | . . IF R(R)<2 SET DIS(R)=DIS(R)_" K D"
|
|---|
| 43 | SET R=-1
|
|---|
| 44 | QUIT
|
|---|
| 45 | ;
|
|---|
| 46 | ;"----------------------------------------
|
|---|
| 47 | 2 IF X'>DL QUIT:DL(X)'[Y SET X=X+1 GOTO 2
|
|---|
| 48 | SET DL(0)=U_$P(Y,U,2)_DL(0)
|
|---|
| 49 | SET P=P-1
|
|---|
| 50 | 22 SET X=X-1
|
|---|
| 51 | SET DQ=$F(DL(X),Y)
|
|---|
| 52 | SET DL(X)=$E(DL(X),1,DQ-$L(Y))_$E(DL(X),DQ,999)
|
|---|
| 53 | GOTO 22:X>1
|
|---|
| 54 | QUIT
|
|---|
| 55 | ;
|
|---|
| 56 | ;"----------------------------------------
|
|---|
| 57 | C SET Y=Y_$S(DV="'":" I 'X",1:" I "_$$XFORM("X")_DV)
|
|---|
| 58 | DO SD
|
|---|
| 59 | MAKE SET DC=DI
|
|---|
| 60 | SET DQ=+DQ
|
|---|
| 61 | SET X=X+1
|
|---|
| 62 | SET Y=$P(DL(DQ),U,X+1)
|
|---|
| 63 | QUIT:Y=""
|
|---|
| 64 | SET S=+Y
|
|---|
| 65 | SET DN=$E("'",Y["'")
|
|---|
| 66 | SET Y=DC(S),D=0,DL=0
|
|---|
| 67 | IF $D(DJ(DQ,S)) DO
|
|---|
| 68 | . SET D=$P(DJ(DQ,S),U,2),DL=+DJ(DQ,S)
|
|---|
| 69 | . IF $D(DI(DL)) SET DC=DI(DL)
|
|---|
| 70 | SET DQ=DQ(DL)
|
|---|
| 71 | SET Z=$P(Z,",",1,D+D+1)_","
|
|---|
| 72 | SET DU=$P($P(Y,U),",",DL+1,99)
|
|---|
| 73 | SET O=DK(DL)
|
|---|
| 74 | SET DV=DN_$P(Y,U,2)
|
|---|
| 75 | IF DV?1"''".E SET DV=$E(DV,3,999)
|
|---|
| 76 | LEV SET DL=DL+1
|
|---|
| 77 | SET DN=$S($D(DE(+DQ,X,DL)):DE(+DQ,X,DL),1:1)
|
|---|
| 78 | SET:$G(DI(DL-1))]"" DI(DL)=DI(DL-1)
|
|---|
| 79 | IF DU<0,$D(DY(-DU)) GOTO X
|
|---|
| 80 | IF DU<0 SET Y=DA(-DU) GOTO C
|
|---|
| 81 | SET N=$P(^DD(O,+DU,0),U,4)
|
|---|
| 82 | SET DE=$P(N,";",1)
|
|---|
| 83 | SET Y=$P(N,";",2)
|
|---|
| 84 | IF Y="" SET Y="D"_D GOTO M
|
|---|
| 85 | IF $P(^(0),U,2)["C" SET Y=$P(^(0),U,5,99) GOTO C
|
|---|
| 86 | SET:+DE'=DE DE=""""_DE_""""
|
|---|
| 87 | SET Z=Z_DE
|
|---|
| 88 | SET E="$G("_DC_Z_"))"
|
|---|
| 89 | IF Y SET Y="$P("_E_",U,"_Y_")" GOTO M
|
|---|
| 90 | IF Y'=0 SET Y=$E(Y,2,99) SET:$P(Y,",",2)=+Y Y=+Y SET Y="$E("_E_","_Y_")" GOTO M
|
|---|
| 91 | FOR Y=65:1 SET M=DQ_$C(Y) QUIT:'$D(DIS(M))
|
|---|
| 92 | SET D=D+1
|
|---|
| 93 | SET Y="S D"_D_"=+$O("_DC_Z_",0)) X DIS("""_M_""") I $T"
|
|---|
| 94 | DO SD
|
|---|
| 95 | IF $D(DIAR) SET DIAR(DIARF,DQ)="X DIS("""_M_"A"")"
|
|---|
| 96 | SET DQ=M
|
|---|
| 97 | SET DIS(DQ)="F X DIS("""_DQ_"A"") X:D"_D_"'>0 ""IF "_(DN=3)_""" Q:"_$E("'",DN>1)_"$T S D"_D_"=$O("_DC_Z_",D"_D_")) Q:D"_D_"'>0"
|
|---|
| 98 | WP SET DQ=DQ_"A"
|
|---|
| 99 | SET DQ(DL)=DQ
|
|---|
| 100 | IF DU'["," SET DIS(DQ)="I "_$$XFORM("$G(^(D"_D_",0))")_DV GOTO MAKE
|
|---|
| 101 | SET O=+$P(^(0),U,2),DK(DL)=O,Z=Z_",D"_D_","
|
|---|
| 102 | N SET DU=$P(DU,",",2,99)
|
|---|
| 103 | GOTO LEV
|
|---|
| 104 | ;
|
|---|
| 105 | M DO SET Y=Y_DV DO SD GOTO MAKE
|
|---|
| 106 | VARPOINT .IF $P(^DD(O,+DU,0),U,2)["V" SET Y="I "_$$XFORM("$$EXTERNAL^DIDU("_O_","_+DU_","""","_Y_")") QUIT
|
|---|
| 107 | OUTX .IF $D(^(2)),$P(^(0),U,2)'["D",DV'["=" SET M=0,Y="S Y="_Y_" "_$$OVFL(^(2))_" I "_$$XFORM("Y") QUIT ;**GFT 144
|
|---|
| 108 | SET .IF $D(DIS(U,S)) SET Y="S Y="_Y_" I $S(Y="""":"""",$D(DIS(U,"_S_",Y)):DIS(U,"_S_",Y),1:"""")" QUIT
|
|---|
| 109 | .SET M=Y,Y="I "_$$XFORM(Y)
|
|---|
| 110 | ;
|
|---|
| 111 | XFORM(Y) IF '$D(DIS("XFORM",S)) QUIT Y
|
|---|
| 112 | QUIT $P(DIS("XFORM",S),";")_Y_$P(DIS("XFORM",S),";",2)
|
|---|
| 113 | ;
|
|---|
| 114 | SD IF $D(R(DQ)),R(DQ)>1 SET Y="K D "_Y_" S:$T D=1"
|
|---|
| 115 | IF '$D(DIS(DQ)) SET DIS(DQ)=Y QUIT
|
|---|
| 116 | IF $L($G(DL(DQ)))*8+$L(DIS(DQ))+$L(Y)>180 DO
|
|---|
| 117 | . SET Y=$$OVFL(Y)_" I $T"
|
|---|
| 118 | . IF $L(Y)+$L(DIS(DQ))>235 SET DIS(DQ)=$$OVFL(DIS(DQ))_" IF "
|
|---|
| 119 | SET DIS(DQ)=DIS(DQ)_" "_Y
|
|---|
| 120 | QUIT
|
|---|
| 121 | ;
|
|---|
| 122 | OVFL(Y) N I,%
|
|---|
| 123 | FOR I=1:1 SET %=DQ_"@"_IF QUIT:'$D(DIS(%))
|
|---|
| 124 | SET DIS(%)=Y
|
|---|
| 125 | QUIT "X DIS("""_%_""")"
|
|---|
| 126 | ;
|
|---|
| 127 | X SET D=DY(-DU),O=+D,DC=U_$P(D,U,2) FOR %=66:1 SET M=DQ_$C(%) QUIT:'$D(DIS(M))
|
|---|
| 128 | IF $P(D,U,3) DO
|
|---|
| 129 | . SET M=DQ_U_$P(D,U,3)
|
|---|
| 130 | . SET Y="S DIXX="""_M_""" "_$P("X ""I 0"" ^I 1 ",U,DN=3+1)_$P(D,U,4,99)_" I $T"
|
|---|
| 131 | . SET R(M)=DN
|
|---|
| 132 | ELSE SET Y=$P(D,U,4,99)_" S D0=D(0) X DIS("""_M_""") S D0=I(0,0) I $T"
|
|---|
| 133 | DO SD
|
|---|
| 134 | SET DQ=M
|
|---|
| 135 | SET DI(DL)=DC
|
|---|
| 136 | SET DK(DL)=+D
|
|---|
| 137 | SET DQ(DL)=DQ
|
|---|
| 138 | SET D=0
|
|---|
| 139 | SET Z="D0,"
|
|---|
| 140 | GOTO N
|
|---|
| 141 | ;
|
|---|
| 142 | TMGDONE QUIT
|
|---|
