VAFHPIVT ;ALB/CM - PIVOT FILE UTILITY FUNCTIONS ;5/5/95
;;5.3;Registration;**91,179,575,954,965**;Jun 06, 1996;Build 7
;
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 DA="" S ERR="Y" Q
.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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHPIVT 4668 printed Oct 16, 2024@19:04:15 Page 2
VAFHPIVT ;ALB/CM - PIVOT FILE UTILITY FUNCTIONS ;5/5/95
+1 ;;5.3;Registration;**91,179,575,954,965**;Jun 06, 1996;Build 7
+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 DA=""
SET ERR="Y"
QUIT
+17 IF $PIECE(^VAT(391.71,DA,0),"^",7)'=""
Begin DoDot:2
+18 SET STOP="N"
+19 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
+20 IF DA=""
SET PIVOT=$$GETPIV^VAFHPIV2()
IF +PIVOT>0
SET NEW="Y"
End DoDot:2
+21 IF '$DATA(PIVOT)
SET PIVOT=$PIECE(^VAT(391.71,DA,0),"^",2)
+22 IF $DATA(PIVOT)
if +PIVOT=-1
SET ERR="Y"
End DoDot:1
+23 IF $DATA(ERR)
QUIT "-1^Can't get new pivot number"
+24 IF $DATA(NEW)
Begin DoDot:1
+25 ;Set up initial entry, get next internal entry number
+26 LOCK +^VAT(391.71,0):5
IF '$TEST
SET ERR="-1^Unable to lock Pivot file"
QUIT
+27 SET DA=$PIECE(^VAT(391.71,0),"^",3)
+28 FOR
SET DA=DA+1
if '$DATA(^VAT(391.71,DA))
QUIT
+29 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
+30 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)
+31 SET ^VAT(391.71,DA,0)=EVDT
SET CROSS=0
+32 ;Set cross references for .01
+33 FOR
SET CROSS=$ORDER(^DD(391.71,.01,1,CROSS))
if 'CROSS
QUIT
IF $GET(^(CROSS,0))'["TRIGGER"
Begin DoDot:2
+34 ;kill cross reference
SET X=EVDT
XECUTE ^DD(391.71,.01,1,CROSS,2)
+35 ;set cross reference
SET X=EVDT
XECUTE ^DD(391.71,.01,1,CROSS,1)
End DoDot:2
+36 LOCK -^VAT(391.71,DA,0)
End DoDot:1
+37 ;
+38 IF '$DATA(ERR)
Begin DoDot:1
+39 LOCK +^VAT(391.71,DA,0):5
IF '$TEST
SET ERR="-1^Unable to lock Pivot file entry"
QUIT
+40 SET TNODE=$GET(^VAT(391.71,DA,0))
+41 IF '$DATA(DGUSER)
SET DGUSER=DUZ
+42 SET ^VAT(391.71,DA,0)=EVDT_"^"_PIVOT_"^"_DFN_"^"_EVTY_"^"_PTR_"^^^^"_$GET(DGUSER)
+43 SET NNODE=$GET(^VAT(391.71,DA,0))
+44 ;set cross references for all fields .01,.02,.03,.04,.05
+45 SET FIELDS=".01,.02,.03,.04,.05"
SET FCNT=0
+46 FOR
SET FCNT=FCNT+1
SET FLD=$PIECE(FIELDS,",",FCNT)
if FLD=""
QUIT
Begin DoDot:2
+47 SET CROSS=0
+48 FOR
SET CROSS=$ORDER(^DD(391.71,FLD,1,CROSS))
if 'CROSS
QUIT
IF $GET(^(CROSS,0))'["TRIGGER"
Begin DoDot:3
+49 ;kill cross reference
IF TNODE'=""
SET X=$PIECE(TNODE,"^",FCNT)
IF X'=""
XECUTE ^DD(391.71,FLD,1,CROSS,2)
+50 ;set cross reference
SET X=$PIECE(NNODE,"^",FCNT)
XECUTE ^DD(391.71,FLD,1,CROSS,1)
End DoDot:3
End DoDot:2
+51 LOCK -^VAT(391.71,DA,0)
End DoDot:1
+52 IF $DATA(ERR)
QUIT ERR
+53 IF $DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
Begin DoDot:1
+54 ;have entry in pivot file
+55 SET DA=$ORDER(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
IF DA=""
SET ERR="-1^Bad AKY Cross Reference"
+56 IF '$DATA(ERR)
SET STOP="N"
FOR
if DA=""!(STOP="Y")
QUIT
Begin DoDot:2
+57 IF $DATA(^VAT(391.71,DA,0))
Begin DoDot:3
+58 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"
+59 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
+60 IF '$DATA(^VAT(391.71,"AKY",EVTY,EVDT,PTR))
SET ERR="-1^ERROR NO AKY CROSS REFERENCE"
+61 IF $DATA(ERR)
QUIT ERR
+62 QUIT PIVOT_":"_NODE
+63 ;
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
