- 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 Jan 18, 2025@04:04:24 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