| 1 | DIL1 ;SFISC/GFT-STATS, NUMBER FIELD, ON-THE-FLY ;04:27 PM 26 Aug 1999
|
|---|
| 2 | ;;22.0;VA FileMan;**2**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | I $A(W)=34 D Q
|
|---|
| 5 | .N A9
|
|---|
| 6 | .S Y="" F A9=0:0 S Y=Y_""""_$P(W,"""",2)_"""",W=$P(W,"""",3,99) Q:$A(W)'=34&($A(W)'=95) S:$A(W)=95 Y=Y_$C(95),W=$P(W,"_",2,99)
|
|---|
| 7 | .S Y=" W "_Y,DLN=0,X="",DRJ=0 D DE^DIL,W^DILL:W[";" I W[";W" D WR Q
|
|---|
| 8 | .S %=$L(Y)-5 S:'DLN DLN=% S:DRJ Y=" W ?"_(DG+DLN-%)_Y D DN^DIL0,T^DIL
|
|---|
| 9 | NUMB S:DN<0 O=999 S X="",DRJ=0 I W?1"0".E D D T^DIL Q
|
|---|
| 10 | .K DPQ(DP,0)
|
|---|
| 11 | .S Y="D"_(DIL-DIL0),X=$G(^DD(DP,.001,0),"NUMBER^^^^$L(X)>12")
|
|---|
| 12 | .I $D(DCL(DP_U_0)) D DE^DIL,STATS Q
|
|---|
| 13 | .D ^DILL,DE^DIL,DN^DIL0
|
|---|
| 14 | S DN=$E(W,$L(W)),X=$P(W,";") K DLN I DM,$A(X)=94 S W=F_W G UP^DIL
|
|---|
| 15 | COMP D D T^DIL Q
|
|---|
| 16 | .N V,DILDATE,DILCUT
|
|---|
| 17 | .S DILCUT=0
|
|---|
| 18 | .I W[";d" S DILDATE="D"
|
|---|
| 19 | .I X?.E1" W X K Y" S DILCUT=8
|
|---|
| 20 | .I X?.E1" W X K DIP" S DILCUT=10
|
|---|
| 21 | .I X?.E1" D DT K DIP" S DILCUT=11,DILDATE="D"
|
|---|
| 22 | .I X?.E1" D DT K Y" S DILCUT=9,DILDATE="D"
|
|---|
| 23 | .S X=$E(X,1,$L(X)-DILCUT)_" K DIP K:DN Y"
|
|---|
| 24 | .I W[";N" S DCL=DCL+1,X=X_" S Y=X,C="_DCL_" D D S X=Y",DITTO(DCL)=""
|
|---|
| 25 | .S Y=" "_X,X="^^^^"_X,%=DN,DN=-3
|
|---|
| 26 | .I W[";m" D W D Q
|
|---|
| 27 | ..S X="D "_$E("L",W'[";w")_"^DIWP",V=$F(Y,"D ^DIWP")
|
|---|
| 28 | ..I V S Y=$E(Y,1,V-8)_X_$E(Y,V,999)
|
|---|
| 29 | ..E S Y=" S DICMX="""_X_""""_Y
|
|---|
| 30 | .I DILCUT S V=$G(DILDATE) D CLC^DILL
|
|---|
| 31 | .I 'DILCUT D W^DILL
|
|---|
| 32 | .S:'$D(DLN) DLN=9
|
|---|
| 33 | .I W[";W" D W S Y=Y_" D ^DIWP" Q
|
|---|
| 34 | .I "+#&!*"'[% D DE^DIL,DN^DIL0 Q
|
|---|
| 35 | .S X="^C"_$G(DILDATE)_"^^^"_$E(Y,2,999),W=-1_";"_$P(W,";",2,9),DCL(DP_U_-1)=%
|
|---|
| 36 | .D DE^DIL,STATS
|
|---|
| 37 | ;
|
|---|
| 38 | W D DE^DIL,WR^DIL0 S Y=Y_" "_$E(X,5,999) Q
|
|---|
| 39 | ;
|
|---|
| 40 | WR S D1=" S Y="_$P(Y,"W ",2,999),Y="" D W^DIL0
|
|---|
| 41 | F D1=D1," S X=Y D ^DIWP" S:$L(Y)+$L(D1)'>250 Y=Y_D1 I $F(Y,D1)-1'=$L(Y) D PX^DIL S Y=D1
|
|---|
| 42 | D T^DIL Q
|
|---|
| 43 | ;
|
|---|
| 44 | STATS ;
|
|---|
| 45 | N TYPE
|
|---|
| 46 | I DG<10!(DG>900) S DG=10 D DE^DIL I DE'["!" S DE=" W:$X>8 !"_DE
|
|---|
| 47 | S TYPE=$P(X,U,2),V=DP_U_+W,I=DCL(V),D=+I I D S DSUM="" G E
|
|---|
| 48 | S (D,DCL)=DCL+1,DCL(V)=D_I
|
|---|
| 49 | S DXS=$S(I["*":"C",I["#":"S",I["&":"A",I["+":"P",1:1),V=TYPE,%=":Y"_$S(TYPE["C":"'?.""*""",Y["$E":"'?."" """,1:"]""""")
|
|---|
| 50 | I DXS S DSUM=" S"_%_" N("_D_")=N("_D_")+1",N(D)=0 G E
|
|---|
| 51 | G @DXS
|
|---|
| 52 | ;
|
|---|
| 53 | C S CP(D)=""
|
|---|
| 54 | S S Q(D)=0,L(D)=9999999999,H(D)=-L(D) I $P(TYPE,"I",2) S DLN=+$P(TYPE,"I",2)
|
|---|
| 55 | P S N(D)=0
|
|---|
| 56 | A S (S(D),DRJ)=0
|
|---|
| 57 | S DSUM=",C="_D_" D "_DXS_%
|
|---|
| 58 | E I TYPE["C" D V^DILL S Y=Y_" S Y=X"_DSUM,DXS=$S($D(^DD(DP,+W,9.02)):^(9.02),1:0) G UTIL
|
|---|
| 59 | DILL S DXS=DSUM,Y=" S Y="_Y_DXS,I="",DXS="Y" D V^DILL
|
|---|
| 60 | UTIL K DSUM S ^UTILITY($J,"T",DG)=DLN_U_D_U_DRJ_U_$P(X,U,2)_U_I
|
|---|
| 61 | D D DN^DIL0 Q
|
|---|
| 62 | .I DXS?1E Q
|
|---|
| 63 | .S ^(DG)=^UTILITY($J,"T",DG)_U_DXS,DN=^DD(DP,+W,9.01)
|
|---|
| 64 | .I '$D(DNP) S V=$L(Y)+$L(DE) S:V<250 Y=DE_Y I V>249 S V=Y,Y=DE D PX^DIL S Y=V
|
|---|
| 65 | .S DE=X,V=DLN N X,DLN,DNP S X=DE,DLN=V,DNP="" ;'Do Not Print' hidden fields
|
|---|
| 66 | LOOP .F S DE="",V=$P(DN,";"),W=$P(V,U,2),DN=$P(DN,";",2,99) Q:V="" D:'$D(DCL(V))
|
|---|
| 67 | ..D PX^DIL,XDUY^DIL0,^DILL
|
|---|
| 68 | ..I $P(X,U,2)'["C" S Y=",X=$G("_DI_C_DU_"))"_$P(",Y=",U,Y'[" S Y=")_Y
|
|---|
| 69 | ..E S Y=Y_" S Y=X"
|
|---|
| 70 | ..S (D,DCL)=DCL+1,S(D)=0,DCL(DP_U_+W)=D,Y=" S C="_D_Y_" D A"
|
|---|
