VAFHPIVT ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
;;5.3;Registration;**91,179,575,1015**;Jun 06, 1996;Build 21
;
PIVNW(DFN,EVDT,EVTY,PTR) ;
;function will return 0 node of pivot file and pivot file entry number
;if no entry in pivot file, create one and return #:0 node
;
Q:$G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") "-1^Missing Parameters for PIVNW function"
I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
N CROSS,DA,NODE,NEW,PIVOT,ERR,TNODE,NNODE,FCNT,FIELDS,FLD,X,STOP
I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
.;not in pivot file
.S PIVOT=$$GETPIV^VAFHPIV2() ;get next pivot file number
.I +PIVOT=-1 S ERR="Y"
.I '$D(ERR) S NEW="Y"
;
I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
.;check if it's been marked as deleted
.S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
.I $P(^VAT(391.71,DA,0),"^",7)'="" D
..S STOP="N"
..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"
..I DA="" S PIVOT=$$GETPIV^VAFHPIV2() I +PIVOT>0 S NEW="Y"
.I '$D(PIVOT) S PIVOT=$P(^VAT(391.71,DA,0),"^",2)
.I $D(PIVOT) S:+PIVOT=-1 ERR="Y"
I $D(ERR) Q "-1^Can't get new pivot number"
I $D(NEW) D
.;Set up initial entry, get next internal entry number
.L +^VAT(391.71,0):5 I '$T S ERR="-1^Unable to lock Pivot file" Q
.S DA=$P(^VAT(391.71,0),"^",3)
.F S DA=DA+1 Q:'$D(^VAT(391.71,DA))
.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
.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)
.S ^VAT(391.71,DA,0)=EVDT,CROSS=0
.;Set cross references for .01
.F S CROSS=$O(^DD(391.71,.01,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
..S X=EVDT X ^DD(391.71,.01,1,CROSS,2) ;kill cross reference
..S X=EVDT X ^DD(391.71,.01,1,CROSS,1) ;set cross reference
.L -^VAT(391.71,DA,0)
;
I '$D(ERR) D
.L +^VAT(391.71,DA,0):5 I '$T S ERR="-1^Unable to lock Pivot file entry" Q
.S TNODE=$G(^VAT(391.71,DA,0))
.I '$D(DGUSER) S DGUSER=DUZ
.S ^VAT(391.71,DA,0)=EVDT_"^"_PIVOT_"^"_DFN_"^"_EVTY_"^"_PTR_"^^^^"_$G(DGUSER)
.S NNODE=$G(^VAT(391.71,DA,0))
.;set cross references for all fields .01,.02,.03,.04,.05
.S FIELDS=".01,.02,.03,.04,.05",FCNT=0
.F S FCNT=FCNT+1,FLD=$P(FIELDS,",",FCNT) Q:FLD="" D
..S CROSS=0
..F S CROSS=$O(^DD(391.71,FLD,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
...I TNODE'="" S X=$P(TNODE,"^",FCNT) I X'="" X ^DD(391.71,FLD,1,CROSS,2) ;kill cross reference
...S X=$P(NNODE,"^",FCNT) X ^DD(391.71,FLD,1,CROSS,1) ;set cross reference
.L -^VAT(391.71,DA,0)
I $D(ERR) Q ERR
I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
.;have entry in pivot file
.S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,"")) I DA="" S ERR="-1^Bad AKY Cross Reference"
.I '$D(ERR) S STOP="N" F Q:DA=""!(STOP="Y") D
..I $D(^VAT(391.71,DA,0)) D
...I $P(^VAT(391.71,DA,0),"^",7)'=1 S NODE=$G(^VAT(391.71,DA,0)),PIVOT=$P(NODE,"^",2),STOP="Y"
...I $P(^VAT(391.71,DA,0),"^",7)=1 S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) S ERR="-1^ERROR NO AKY CROSS REFERENCE"
I $D(ERR) Q ERR
Q PIVOT_":"_NODE
;
PIVX(PIVOT,DFN,EVDT) ;
;given pivot #, check for existence and compare the data in file to
;parameters, return pivot number:0 node
I $G(PIVOT)="" Q "-1^Missing Parameters for PIVX function"
I '$D(^VAT(391.71,"D",PIVOT)) Q "-1^No entry in Pivot file"
N ENT,ERR S ENT=$O(^VAT(391.71,"D",PIVOT,""))
I ENT="" Q "-1^BAD 'D' CROSS REFERENCE"
S NODE=$G(^VAT(391.71,ENT,0))
I $D(DFN) I $P(NODE,"^",3)'=DFN S ERR="-1^PATIENTS DON'T MATCH"
I $D(EVDT) I $P(NODE,"^")'=EVDT S ERR="-1^DATE/TIME DOESN'T MATCH"
I $P(NODE,"^",7)'="" S ERR="-1^No entry in Pivot file"
I $D(ERR) Q ERR
Q PIVOT_":"_NODE
;
PIVCHK(DFN,EVDT,EVTY,PTR) ;
;check for existence of pivot file entry.
;If exist, return pivot number:0 node. If not exist, return 0
I $G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") Q "-1^Missing parameter for PIVCHK function"
I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
;
I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) Q "-1^No Entry in Pivot File"
I $O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))="" Q "-1^Bad AKY Cross Reference"
N DA,EVENT,NODE
S (DA,NODE,EVENT)=0
F S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA)) Q:'DA DO Q:EVENT
. S NODE=$G(^VAT(391.71,DA,0))
. I $P(NODE,"^",7)=1 Q
. S EVENT=$P(NODE,"^",2)
;
I 'EVENT Q "-1^NO Entry in Pivot File"
I $P(NODE,"^",3)'=DFN Q "-1^DFN DOES NOT MATCH PIVOT DFN"
Q EVENT_":"_NODE
;
Q
VAFHPIVT ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
+1 ;;5.3;Registration;**91,179,575,1015**;Jun 06, 1996;Build 21
+2 ;
PIVNW(DFN,EVDT,EVTY,PTR) ;
+1 ;function will return 0 node of pivot file and pivot file entry number
+2 ;if no entry in pivot file, create one and return #:0 node
+3 ;
+4 IF $GET(DFN)=""!($GET(EVDT)="")!($GET(EVTY)="")!($GET(PTR)="")
QUIT "-1^Missing Parameters for PIVNW function"
+5 IF $GET(^DPT(DFN,0))=""
QUIT "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
+6 NEW CROSS,DA,NODE,NEW,PIVOT,ERR,TNODE,NNODE,FCNT,FIELDS,FLD,X,STOP
+7 IF '$DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
Begin DoDot:1
+8 ;not in pivot file
+9 ;get next pivot file number
SET PIVOT=$$GETPIV^VAFHPIV2()
+10 IF +PIVOT=-1
SET ERR="Y"
+11 IF '$DATA(ERR)
SET NEW="Y"
End DoDot:1
+12 ;
+13 IF $DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
Begin DoDot:1
+14 ;check if it's been marked as deleted
+15 SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
+16 IF $PIECE(^VAT(391.71,DA,0),"^",7)'=""
Begin DoDot:2
+17 SET STOP="N"
+18 FOR
SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
IF DA=""
QUIT
IF $DATA(^VAT(391.71,DA))
IF $PIECE(^VAT(391.71,DA,0),"^",7)=""
SET STOP="Y"
IF STOP="Y"
QUIT
+19 IF DA=""
SET PIVOT=$$GETPIV^VAFHPIV2()
IF +PIVOT>0
SET NEW="Y"
End DoDot:2
+20 IF '$DATA(PIVOT)
SET PIVOT=$PIECE(^VAT(391.71,DA,0),"^",2)
+21 IF $DATA(PIVOT)
IF +PIVOT=-1
SET ERR="Y"
End DoDot:1
+22 IF $DATA(ERR)
QUIT "-1^Can't get new pivot number"
+23 IF $DATA(NEW)
Begin DoDot:1
+24 ;Set up initial entry, get next internal entry number
+25 LOCK +^VAT(391.71,0):5
IF '$TEST
SET ERR="-1^Unable to lock Pivot file"
QUIT
+26 SET DA=$PIECE(^VAT(391.71,0),"^",3)
+27 FOR
SET DA=DA+1
IF '$DATA(^VAT(391.71,DA))
QUIT
+28 SET ^VAT(391.71,DA,0)=""
LOCK +^VAT(391.71,DA,0):5
IF '$TEST
SET ERR="-1^Unable to lock Pivot file entry"
LOCK -^VAT(391.71,0)
QUIT
+29 SET $PIECE(^VAT(391.71,0),"^",3)=DA
SET $PIECE(^VAT(391.71,0),"^",4)=$PIECE(^VAT(391.71,0),"^",4)+1
LOCK -^VAT(391.71,0)
+30 SET ^VAT(391.71,DA,0)=EVDT
SET CROSS=0
+31 ;Set cross references for .01
+32 FOR
SET CROSS=$ORDER(^DD(391.71,.01,1,CROSS))
IF 'CROSS
QUIT
IF $GET(^(CROSS,0))'["TRIGGER"
Begin DoDot:2
+33 ;kill cross reference
SET X=EVDT
XECUTE ^DD(391.71,.01,1,CROSS,2)
+34 ;set cross reference
SET X=EVDT
XECUTE ^DD(391.71,.01,1,CROSS,1)
End DoDot:2
+35 LOCK -^VAT(391.71,DA,0)
End DoDot:1
+36 ;
+37 IF '$DATA(ERR)
Begin DoDot:1
+38 LOCK +^VAT(391.71,DA,0):5
IF '$TEST
SET ERR="-1^Unable to lock Pivot file entry"
QUIT
+39 SET TNODE=$GET(^VAT(391.71,DA,0))
+40 IF '$DATA(DGUSER)
SET DGUSER=DUZ
+41 SET ^VAT(391.71,DA,0)=EVDT_"^"_PIVOT_"^"_DFN_"^"_EVTY_"^"_PTR_"^^^^"_$GET(DGUSER)
+42 SET NNODE=$GET(^VAT(391.71,DA,0))
+43 ;set cross references for all fields .01,.02,.03,.04,.05
+44 SET FIELDS=".01,.02,.03,.04,.05"
SET FCNT=0
+45 FOR
SET FCNT=FCNT+1
SET FLD=$PIECE(FIELDS,",",FCNT)
IF FLD=""
QUIT
Begin DoDot:2
+46 SET CROSS=0
+47 FOR
SET CROSS=$ORDER(^DD(391.71,FLD,1,CROSS))
IF 'CROSS
QUIT
IF $GET(^(CROSS,0))'["TRIGGER"
Begin DoDot:3
+48 ;kill cross reference
IF TNODE'=""
SET X=$PIECE(TNODE,"^",FCNT)
IF X'=""
XECUTE ^DD(391.71,FLD,1,CROSS,2)
+49 ;set cross reference
SET X=$PIECE(NNODE,"^",FCNT)
XECUTE ^DD(391.71,FLD,1,CROSS,1)
End DoDot:3
End DoDot:2
+50 LOCK -^VAT(391.71,DA,0)
End DoDot:1
+51 IF $DATA(ERR)
QUIT ERR
+52 IF $DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
Begin DoDot:1
+53 ;have entry in pivot file
+54 SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
IF DA=""
SET ERR="-1^Bad AKY Cross Reference"
+55 IF '$DATA(ERR)
SET STOP="N"
FOR
IF DA=""!(STOP="Y")
QUIT
Begin DoDot:2
+56 IF $DATA(^VAT(391.71,DA,0))
Begin DoDot:3
+57 IF $PIECE(^VAT(391.71,DA,0),"^",7)'=1
SET NODE=$GET(^VAT(391.71,DA,0))
SET PIVOT=$PIECE(NODE,"^",2)
SET STOP="Y"
+58 IF $PIECE(^VAT(391.71,DA,0),"^",7)=1
SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
End DoDot:3
End DoDot:2
End DoDot:1
+59 IF '$DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
SET ERR="-1^ERROR NO AKY CROSS REFERENCE"
+60 IF $DATA(ERR)
QUIT ERR
+61 QUIT PIVOT_":"_NODE
+62 ;
PIVX(PIVOT,DFN,EVDT) ;
+1 ;given pivot #, check for existence and compare the data in file to
+2 ;parameters, return pivot number:0 node
+3 IF $GET(PIVOT)=""
QUIT "-1^Missing Parameters for PIVX function"
+4 IF '$DATA(^VAT(391.71,"D",PIVOT))
QUIT "-1^No entry in Pivot file"
+5 NEW ENT,ERR
SET ENT=$ORDER(^VAT(391.71,"D",PIVOT,""))
+6 IF ENT=""
QUIT "-1^BAD 'D' CROSS REFERENCE"
+7 SET NODE=$GET(^VAT(391.71,ENT,0))
+8 IF $DATA(DFN)
IF $PIECE(NODE,"^",3)'=DFN
SET ERR="-1^PATIENTS DON'T MATCH"
+9 IF $DATA(EVDT)
IF $PIECE(NODE,"^")'=EVDT
SET ERR="-1^DATE/TIME DOESN'T MATCH"
+10 IF $PIECE(NODE,"^",7)'=""
SET ERR="-1^No entry in Pivot file"
+11 IF $DATA(ERR)
QUIT ERR
+12 QUIT PIVOT_":"_NODE
+13 ;
PIVCHK(DFN,EVDT,EVTY,PTR) ;
+1 ;check for existence of pivot file entry.
+2 ;If exist, return pivot number:0 node. If not exist, return 0
+3 IF $GET(DFN)=""!($GET(EVDT)="")!($GET(EVTY)="")!($GET(PTR)="")
QUIT "-1^Missing parameter for PIVCHK function"
+4 IF $GET(^DPT(DFN,0))=""
QUIT "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
+5 ;
+6 IF '$DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
QUIT "-1^No Entry in Pivot File"
+7 IF $ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))=""
QUIT "-1^Bad AKY Cross Reference"
+8 NEW DA,EVENT,NODE
+9 SET (DA,NODE,EVENT)=0
+10 FOR
SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
IF 'DA
QUIT
Begin DoDot:1
+11 SET NODE=$GET(^VAT(391.71,DA,0))
+12 IF $PIECE(NODE,"^",7)=1
QUIT
+13 SET EVENT=$PIECE(NODE,"^",2)
End DoDot:1
IF EVENT
QUIT
+14 ;
+15 IF 'EVENT
QUIT "-1^NO Entry in Pivot File"
+16 IF $PIECE(NODE,"^",3)'=DFN
QUIT "-1^DFN DOES NOT MATCH PIVOT DFN"
+17 QUIT EVENT_":"_NODE
+18 ;
+19 QUIT
