source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICATTD8.m@ 757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1DICATTD8 ;SFISC/GFT;12:19 PM 13 Dec 2001;VARIABLE POINTER FIELDS
2 ;;22.0;VA FileMan;**44,42,83**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GET ;
6 K DICATTVP
7 F DA=0:0 S DA=$O(^DD(DICATTA,DICATTF,"V",DA)) Q:'DA I $D(^(DA,0)) D
8 .F DR=1:1:6 S DICATTVP(DA,DR)=$P(^(0),U,DR)
9 .I $G(^(1))]"" S DICATTVP(DA,7)=^(1)
10 .I $G(^(2))]"" S DICATTVP(DA,8)=^(2)
11 Q
12 ;
13Y(I,J) ;defaults for Page 2.8
14 S Y=$G(DICATTVP(I,J)) Q
15 ;
16PRE8 ;PRE-ACTION for Page 8
17 F I=1:1:5 D P(I)
18 I $P($G(^DD(+$$GET^DDSVALF(DICATTVP+90,"DICATT8",2.8,""),0,"DI")),U,2)["Y" D PUT(3,"n"),UNED^DDSUTL(3,,,1,"") ;ARCHIVE File can't be LAYGO'd
19 Q
20 ;
21P(FLD) ;
22 D PUT(FLD,$G(DICATTVP(DICATTVP,$$V(FLD)))) Q
23 ;
24V(FLD) Q $E(24678,FLD) ;Field 1 is .02, etc
25 ;
26DICS ;
27 I DUZ(0)'="@" S DIC("S")="I Y-1.1 Q:'$L($G(^(0,""RD""))) I $TR(DUZ(0),^(""RD""))'=DUZ(0)" Q
28 S DIC("S")="I Y-1.1"
29 Q
30 ;
31POST8 ;POST-ACTION for Page 8
32 N I,Y
33 F I=1:1:5 S Y=$$GET^DDSVALF(I,"DICATTVP",8,"",""),DICATTVP(DICATTVP,$$V(I))=Y
34 I DICATTVP(DICATTVP,7)="" S DICATTVP(DICATTVP,8)="" ;if no SCREEN, no EXPLANATION
35 F I=1:1:5 D PUT(I,"") ;clean out the screen
36 S DICATTLN=18 ;so 'IS THIS FIELD MULTIPLE' will be asked -- a V-P field can be expected to take up 18 bytes of storage
37 Q
38 ;
39G(I) Q $$GET^DDSVALF(I,"DICATT8",2.8,"I","")
40 ;
41PUT(I,VAL) D PUT^DDSVALF(I,"DICATTVP",8,VAL,"I","") Q
42 ;
43POSTVP ;
44 N I,S,ERR
45 D RECALL^DILFD(1,DICATTB_",",DUZ) ;we've looked up other files, so remember this one
46 S DICATTMN="",DICATT2N="V",DICATT3N="",DICATT5N=""
47 F I=91:1:97 S DICATTVP(I-90,1)=$$G(I)
48 F I=91.1:1:97.1 S S=$$G(I) I S]""!$D(DICATTVP(I-90.1,3)) S DICATTVP(I-90.1,3)=S ;ORDER
49 F I=0:0 S I=$O(DICATTVP(I)) Q:'I D I $D(ERR) Q
50 .I '$G(DICATTVP(I,1)) K DICATTVP(I) Q
51 .I $D(I(1,DICATTVP(I,1))) S ERR="DUPLICATE FILE NUMBER" Q
52 .S I(1,DICATTVP(I,1))=""
53 .I $G(DICATTVP(I,2))="" S ERR="MESSAGE REQUIRED" Q
54 .I '$G(DICATTVP(I,3)) S ERR="ORDER NUMBER REQUIRED" Q
55 .I $D(I(3,DICATTVP(I,3))) S ERR="DUPLICATE ORDER NUMBER" Q
56 .S I(3,DICATTVP(I,3))=""
57 .I $G(DICATTVP(I,4))="" S ERR="PREFIX REQUIRED" Q
58 .I DICATTVP(I,4)["""" S ERR="BAD PREFIX" Q
59 .I $D(I(4,DICATTVP(I,4))) S ERR="DUPLICATE PREFIX" Q
60 .S I(4,DICATTVP(I,4))=""
61 .S S=$G(DICATTVP(I,7))]"",DICATTVP(I,5)=$E("ny",S+1)
62 .I S,$G(DICATTVP(I,8))="" S ERR="SCREEN MUST HAVE EXPLANATION" Q
63 I '$D(ERR) Q
64 S DDSBR=90+I,S(1)="ERROR IN VARIABLE-POINTER SPECIFICATIONS, FILE "_$G(DICATTVP(I,1)),S(2)=ERR,S(3)="$$EOP"
65 D HLP^DDSUTL(.S)
66 Q
67 ;
68FILE ;come here from ^DICATTDE
69 N I,DIK,DA
70 F I=0:0 S I=$O(^DD(DICATTA,DICATTF,"V","B",I)) Q:'I K ^DD(+I,0,"PT",DICATTA,DICATTF) ;delete old POINTED-TOs
71 K ^DD(DICATTA,DICATTF,"V") ;all other cross_references are with the subfile
72 I $G(DICATT2N)'["V" Q ;stop now if field is no longer V-P!
73 S DA=0 F I=1:1 S DA=$O(DICATTVP(DA)) Q:'DA D
74 .S DICATTVP(DA,5)=$E("ny",$G(DICATTVP(DA,7))]""+1)
75 .F DIK=1:1:6 S $P(^DD(DICATTA,DICATTF,"V",I,0),U,DIK)=$G(DICATTVP(DA,DIK))
76 .F DIK=7,8 I $D(DICATTVP(DA,DIK)) S ^(DIK-6)=DICATTVP(DA,DIK)
77 S ^DD(DICATTA,DICATTF,"V",0)="^.12P^",DA(2)=DICATTA,DA(1)=DICATTF
78 S DIK="^DD("_DICATTA_","_DICATTF_",""V""," D IXALL^DIK
79 Q
Note: See TracBrowser for help on using the repository browser.