source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIFGG2.m@ 1154

Last change on this file since 1154 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1DIFGG2 ;SFISC/XAK,EDE(OHPRD)-FILEGRAM FIELDS ;2/4/93 10:59 AM
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4START K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"))
5 D DRS
6 K S,V,X,DIFG2
7 Q
8 ;
9DRS S DR=""
10 I $P(^DIPT(DIFGT,1,DIFGI,0),U,8) F DIFG2=.001:0 S DIFG2=$O(^DD(DIFG(DILL,"FILE"),DIFG2)) Q:DIFG2'>0 S %=$P(^(DIFG2,0),U,2) I $S('%:%'["C",1:$P(^DD(+%,.01,0),U,2)["W") S DR=DR_DIFG2_";" I $L(DR)>200 D DR S DR=""
11 F DIFG2=0:0 S DIFG2=$O(^DIPT(DIFGT,1,DIFGI,"F",DIFG2)) Q:DIFG2'=+DIFG2 I $D(^(DIFG2,0)) S DR=DR_^(0)_";" I $L(DR)>200 D DR S DR=""
12 D DR:DR]"" Q
13 ;
14EN ;
15DR I '$D(DIFG(DILL,"MUL")) S DIC=DIFG(DILL,"FILE"),DA=DIFG(DILL,"FE")
16 S DIQ(0)="N" D EN^DIQ1 K DIQ
17 I $D(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"))) F DIFG2(DILL,"FLD")=0:0 S DIFG2(DILL,"FLD")=$O(DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:'DIFG2(DILL,"FLD") D
18 . NEW VAL
19 . S VAL=DIFGGF(DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))
20 . S ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))=$S(VAL]"":VAL,1:"^")
21 . Q
22 F DIFG2(DILL,"FLD")=0:0 D DR2 Q:DIFG2(DILL,"FLD")'=+DIFG2(DILL,"FLD") S V=^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD")) D FIELD
23 I '$D(DIFG(DILL,"MUL")) K DA,DIC,DR
24 K ^UTILITY("DIQ1",$J,DIFG(DILL,"FILE")),DIFGGF(DIFG(DILL,"FILE"))
25 Q
26 ;
27DR2 S DIFG2(DILL,"FLD")=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))) Q:DIFG2(DILL,"FLD")=""
28 I $O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),0)) S V("WP")=0,^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"))="wp"
29 Q
30 ;
31EN2 ;
32FIELD Q:V=""
33 D SETXY
34 K F,N,P,W
35 S V=$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,1)_U_$S(DIFG("PARM")["N":DIFG2(DILL,"FLD"),1:"")_"="_X
36 D INCSET^DIFGGU
37 D:Y'="" PTRCHK
38 D:$D(V)>9 WP
39 K X,Y,V
40 Q
41 ;
42WP NEW I
43 S DITAB=DITAB+2
44 S DIFG("WP")=""
45 F I=0:0 S I=$O(^UTILITY("DIQ1",$J,DIFG(DILL,"FILE"),DIFG(DILL,"FE"),DIFG2(DILL,"FLD"),I)) Q:I="" S V=""""_^(I)_"""" D INCSET^DIFGGU
46 S V="." D INCSET^DIFGGU
47 K DIFG("WP")
48 S DITAB=DITAB-2
49 Q
50 ;
51SETXY S X=V
52 S Y=""
53 Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
54 S F=+$P($P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2),"P",2),W=$P(^(0),U,4),N=$P(W,";",1),P=$P(W,";",2)
55 S Y=$P(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",N)"),U,P)
56 I $D(^UTILITY("DIFGLINK",$J,F,Y)) S X="@"_^UTILITY("DIFGLINK",$J,F,Y),Y="" Q
57 S ^UTILITY("DIFGLINK",$J)=$S($D(^UTILITY("DIFGLINK",$J))#2:^UTILITY("DIFGLINK",$J)+1,1:1)
58 S ^UTILITY("DIFGLINK",$J,F,Y)=^UTILITY("DIFGLINK",$J)
59 S Y="@"_^UTILITY("DIFGLINK",$J)
60 Q
61 ;
62PTRCHK Q:$P(^DD(DIFG(DILL,"FILE"),DIFG2(DILL,"FLD"),0),U,2)'["P"
63 S DITAB=DITAB+2
64 S DILL=DILL+1
65 D POINTER
66 S DITAB=DITAB-2
67 K DIFG(DILL)
68 S DILL=DILL-1
69 Q
70 ;
71POINTER S DIFG(DILL,"FILE")=+$P($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2),"P",2),X=$P(^(0),U,4) S:$P(X,";")'=+X X=""""_$P(X,";")_""";"_$P(X,";",2)
72 S DIFG(DILL,"FE")=$P(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$P(X,";",1)_")"),U,$P(X,";",2))
73 I '$D(^DIC(DIFG(DILL,"FILE"),0)) D KILLLL^DIFGGU Q
74 S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")
75 I '$D(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)")) D KILLLL^DIFGGU Q
76 S DIFG(DILL,"FNAME")=$P(^DIC(DIFG(DILL,"FILE"),0),U,1)
77 I $D(Y),Y'="" S Z=Y,Y=""
78 I $D(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD")))!($P(^DD(DIFG(DILL-1,"FILE"),DIFG2(DILL-1,"FLD"),0),U,2)'["'") S DIFG(DILL,"NOKEY")=""
79 D ^DIFGGSB
80 Q
Note: See TracBrowser for help on using the repository browser.