source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHPIVT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1VAFHPIVT ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
2 ;;5.3;Registration;**91,179,575**;Jun 06, 1996
3 ;
4PIVNW(DFN,EVDT,EVTY,PTR) ;
5 ;function will return 0 node of pivot file and pivot file entry number
6 ;if no entry in pivot file, create one and return #:0 node
7 ;
8 Q:$G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") "-1^Missing Parameters for PIVNW function"
9 I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
10 N CROSS,DA,NODE,NEW,PIVOT,ERR,TNODE,NNODE,FCNT,FIELDS,FLD,X,STOP
11 I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
12 .;not in pivot file
13 .S PIVOT=$$GETPIV^VAFHPIV2() ;get next pivot file number
14 .I +PIVOT=-1 S ERR="Y"
15 .I '$D(ERR) S NEW="Y"
16 ;
17 I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
18 .;check if it's been marked as deleted
19 .S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
20 .I $P(^VAT(391.71,DA,0),"^",7)'="" D
21 ..S STOP="N"
22 ..F S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA)) Q:DA="" I $D(^VAT(391.71,DA)) S:$P(^VAT(391.71,DA,0),"^",7)="" STOP="Y" Q:STOP="Y"
23 ..I DA="" S PIVOT=$$GETPIV^VAFHPIV2() I +PIVOT>0 S NEW="Y"
24 .I '$D(PIVOT) S PIVOT=$P(^VAT(391.71,DA,0),"^",2)
25 .I $D(PIVOT) S:+PIVOT=-1 ERR="Y"
26 I $D(ERR) Q "-1^Can't get new pivot number"
27 I $D(NEW) D
28 .;Set up initial entry, get next internal entry number
29 .L +^VAT(391.71,0):5 I '$T S ERR="-1^Unable to lock Pivot file" Q
30 .S DA=$P(^VAT(391.71,0),"^",3)
31 .F S DA=DA+1 Q:'$D(^VAT(391.71,DA))
32 .S ^VAT(391.71,DA,0)="" L +^VAT(391.71,DA,0):5 I '$T S ERR="-1^Unable to lock Pivot file entry" L -^VAT(391.71,0) Q
33 .S $P(^VAT(391.71,0),"^",3)=DA,$P(^VAT(391.71,0),"^",4)=$P(^VAT(391.71,0),"^",4)+1 L -^VAT(391.71,0)
34 .S ^VAT(391.71,DA,0)=EVDT,CROSS=0
35 .;Set cross references for .01
36 .F S CROSS=$O(^DD(391.71,.01,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
37 ..S X=EVDT X ^DD(391.71,.01,1,CROSS,2) ;kill cross reference
38 ..S X=EVDT X ^DD(391.71,.01,1,CROSS,1) ;set cross reference
39 .L -^VAT(391.71,DA,0)
40 ;
41 I '$D(ERR) D
42 .L +^VAT(391.71,DA,0):5 I '$T S ERR="-1^Unable to lock Pivot file entry" Q
43 .S TNODE=$G(^VAT(391.71,DA,0))
44 .I '$D(DGUSER) S DGUSER=DUZ
45 .S ^VAT(391.71,DA,0)=EVDT_"^"_PIVOT_"^"_DFN_"^"_EVTY_"^"_PTR_"^^^^"_$G(DGUSER)
46 .S NNODE=$G(^VAT(391.71,DA,0))
47 .;set cross references for all fields .01,.02,.03,.04,.05
48 .S FIELDS=".01,.02,.03,.04,.05",FCNT=0
49 .F S FCNT=FCNT+1,FLD=$P(FIELDS,",",FCNT) Q:FLD="" D
50 ..S CROSS=0
51 ..F S CROSS=$O(^DD(391.71,FLD,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
52 ...I TNODE'="" S X=$P(TNODE,"^",FCNT) I X'="" X ^DD(391.71,FLD,1,CROSS,2) ;kill cross reference
53 ...S X=$P(NNODE,"^",FCNT) X ^DD(391.71,FLD,1,CROSS,1) ;set cross reference
54 .L -^VAT(391.71,DA,0)
55 I $D(ERR) Q ERR
56 I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
57 .;have entry in pivot file
58 .S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,"")) I DA="" S ERR="-1^Bad AKY Cross Reference"
59 .I '$D(ERR) S STOP="N" F Q:DA=""!(STOP="Y") D
60 ..I $D(^VAT(391.71,DA,0)) D
61 ...I $P(^VAT(391.71,DA,0),"^",7)'=1 S NODE=$G(^VAT(391.71,DA,0)),PIVOT=$P(NODE,"^",2),STOP="Y"
62 ...I $P(^VAT(391.71,DA,0),"^",7)=1 S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
63 I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) S ERR="-1^ERROR NO AKY CROSS REFERENCE"
64 I $D(ERR) Q ERR
65 Q PIVOT_":"_NODE
66 ;
67PIVX(PIVOT,DFN,EVDT) ;
68 ;given pivot #, check for existence and compare the data in file to
69 ;parameters, return pivot number:0 node
70 I $G(PIVOT)="" Q "-1^Missing Parameters for PIVX function"
71 I '$D(^VAT(391.71,"D",PIVOT)) Q "-1^No entry in Pivot file"
72 N ENT,ERR S ENT=$O(^VAT(391.71,"D",PIVOT,""))
73 I ENT="" Q "-1^BAD 'D' CROSS REFERENCE"
74 S NODE=$G(^VAT(391.71,ENT,0))
75 I $D(DFN) I $P(NODE,"^",3)'=DFN S ERR="-1^PATIENTS DON'T MATCH"
76 I $D(EVDT) I $P(NODE,"^")'=EVDT S ERR="-1^DATE/TIME DOESN'T MATCH"
77 I $P(NODE,"^",7)'="" S ERR="-1^No entry in Pivot file"
78 I $D(ERR) Q ERR
79 Q PIVOT_":"_NODE
80 ;
81PIVCHK(DFN,EVDT,EVTY,PTR) ;
82 ;check for existence of pivot file entry.
83 ;If exist, return pivot number:0 node. If not exist, return 0
84 I $G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") Q "-1^Missing parameter for PIVCHK function"
85 I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
86 ;
87 I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) Q "-1^No Entry in Pivot File"
88 I $O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))="" Q "-1^Bad AKY Cross Reference"
89 N DA,EVENT,NODE
90 S (DA,NODE,EVENT)=0
91 F S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA)) Q:'DA DO Q:EVENT
92 . S NODE=$G(^VAT(391.71,DA,0))
93 . I $P(NODE,"^",7)=1 Q
94 . S EVENT=$P(NODE,"^",2)
95 ;
96 I 'EVENT Q "-1^NO Entry in Pivot File"
97 I $P(NODE,"^",3)'=DFN Q "-1^DFN DOES NOT MATCH PIVOT DFN"
98 Q EVENT_":"_NODE
99 ;
100 Q
Note: See TracBrowser for help on using the repository browser.