Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHPIVT

VAFHPIVT.m

Go to the documentation of this file.
  1. VAFHPIVT ;ALB/CM - PIVOT FILE UTILITY FUNCTIONS ;5/5/95
  1. ;;5.3;Registration;**91,179,575,954,965**;Jun 06, 1996;Build 7
  1. ;
  1. PIVNW(DFN,EVDT,EVTY,PTR) ;
  1. ;function will return 0 node of pivot file and pivot file entry number
  1. ;if no entry in pivot file, create one and return #:0 node
  1. ;
  1. Q:$G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") "-1^Missing Parameters for PIVNW function"
  1. I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
  1. N CROSS,DA,NODE,NEW,PIVOT,ERR,TNODE,NNODE,FCNT,FIELDS,FLD,X,STOP
  1. I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
  1. .;not in pivot file
  1. .S PIVOT=$$GETPIV^VAFHPIV2() ;get next pivot file number
  1. .I +PIVOT=-1 S ERR="Y"
  1. .I '$D(ERR) S NEW="Y"
  1. ;
  1. I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
  1. .;check if it's been marked as deleted
  1. .S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))
  1. .I DA="" S ERR="Y" Q
  1. .I $P(^VAT(391.71,DA,0),"^",7)'="" D
  1. ..S STOP="N"
  1. ..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"
  1. ..I DA="" S PIVOT=$$GETPIV^VAFHPIV2() I +PIVOT>0 S NEW="Y"
  1. .I '$D(PIVOT) S PIVOT=$P(^VAT(391.71,DA,0),"^",2)
  1. .I $D(PIVOT) S:+PIVOT=-1 ERR="Y"
  1. I $D(ERR) Q "-1^Can't get new pivot number"
  1. I $D(NEW) D
  1. .;Set up initial entry, get next internal entry number
  1. .L +^VAT(391.71,0):5 I '$T S ERR="-1^Unable to lock Pivot file" Q
  1. .S DA=$P(^VAT(391.71,0),"^",3)
  1. .F S DA=DA+1 Q:'$D(^VAT(391.71,DA))
  1. .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
  1. .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)
  1. .S ^VAT(391.71,DA,0)=EVDT,CROSS=0
  1. .;Set cross references for .01
  1. .F S CROSS=$O(^DD(391.71,.01,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
  1. ..S X=EVDT X ^DD(391.71,.01,1,CROSS,2) ;kill cross reference
  1. ..S X=EVDT X ^DD(391.71,.01,1,CROSS,1) ;set cross reference
  1. .L -^VAT(391.71,DA,0)
  1. ;
  1. I '$D(ERR) D
  1. .L +^VAT(391.71,DA,0):5 I '$T S ERR="-1^Unable to lock Pivot file entry" Q
  1. .S TNODE=$G(^VAT(391.71,DA,0))
  1. .I '$D(DGUSER) S DGUSER=DUZ
  1. .S ^VAT(391.71,DA,0)=EVDT_"^"_PIVOT_"^"_DFN_"^"_EVTY_"^"_PTR_"^^^^"_$G(DGUSER)
  1. .S NNODE=$G(^VAT(391.71,DA,0))
  1. .;set cross references for all fields .01,.02,.03,.04,.05
  1. .S FIELDS=".01,.02,.03,.04,.05",FCNT=0
  1. .F S FCNT=FCNT+1,FLD=$P(FIELDS,",",FCNT) Q:FLD="" D
  1. ..S CROSS=0
  1. ..F S CROSS=$O(^DD(391.71,FLD,1,CROSS)) Q:'CROSS I $G(^(CROSS,0))'["TRIGGER" D
  1. ...I TNODE'="" S X=$P(TNODE,"^",FCNT) I X'="" X ^DD(391.71,FLD,1,CROSS,2) ;kill cross reference
  1. ...S X=$P(NNODE,"^",FCNT) X ^DD(391.71,FLD,1,CROSS,1) ;set cross reference
  1. .L -^VAT(391.71,DA,0)
  1. I $D(ERR) Q ERR
  1. I $D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) D
  1. .;have entry in pivot file
  1. .S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,"")) I DA="" S ERR="-1^Bad AKY Cross Reference"
  1. .I '$D(ERR) S STOP="N" F Q:DA=""!(STOP="Y") D
  1. ..I $D(^VAT(391.71,DA,0)) D
  1. ...I $P(^VAT(391.71,DA,0),"^",7)'=1 S NODE=$G(^VAT(391.71,DA,0)),PIVOT=$P(NODE,"^",2),STOP="Y"
  1. ...I $P(^VAT(391.71,DA,0),"^",7)=1 S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA))
  1. I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) S ERR="-1^ERROR NO AKY CROSS REFERENCE"
  1. I $D(ERR) Q ERR
  1. Q PIVOT_":"_NODE
  1. ;
  1. PIVX(PIVOT,DFN,EVDT) ;
  1. ;given pivot #, check for existence and compare the data in file to
  1. ;parameters, return pivot number:0 node
  1. I $G(PIVOT)="" Q "-1^Missing Parameters for PIVX function"
  1. I '$D(^VAT(391.71,"D",PIVOT)) Q "-1^No entry in Pivot file"
  1. N ENT,ERR S ENT=$O(^VAT(391.71,"D",PIVOT,""))
  1. I ENT="" Q "-1^BAD 'D' CROSS REFERENCE"
  1. S NODE=$G(^VAT(391.71,ENT,0))
  1. I $D(DFN) I $P(NODE,"^",3)'=DFN S ERR="-1^PATIENTS DON'T MATCH"
  1. I $D(EVDT) I $P(NODE,"^")'=EVDT S ERR="-1^DATE/TIME DOESN'T MATCH"
  1. I $P(NODE,"^",7)'="" S ERR="-1^No entry in Pivot file"
  1. I $D(ERR) Q ERR
  1. Q PIVOT_":"_NODE
  1. ;
  1. PIVCHK(DFN,EVDT,EVTY,PTR) ;
  1. ;check for existence of pivot file entry.
  1. ;If exist, return pivot number:0 node. If not exist, return 0
  1. I $G(DFN)=""!($G(EVDT)="")!($G(EVTY)="")!($G(PTR)="") Q "-1^Missing parameter for PIVCHK function"
  1. I $G(^DPT(DFN,0))="" Q "-1^PATIENT WITH PASSED DFN DOES NOT EXIST"
  1. ;
  1. I '$D(^VAT(391.71,"AKY",EVTY,EVDT,PTR)) Q "-1^No Entry in Pivot File"
  1. I $O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,""))="" Q "-1^Bad AKY Cross Reference"
  1. N DA,EVENT,NODE
  1. S (DA,NODE,EVENT)=0
  1. F S DA=$O(^VAT(391.71,"AKY",EVTY,EVDT,PTR,DA)) Q:'DA DO Q:EVENT
  1. . S NODE=$G(^VAT(391.71,DA,0))
  1. . I $P(NODE,"^",7)=1 Q
  1. . S EVENT=$P(NODE,"^",2)
  1. ;
  1. I 'EVENT Q "-1^NO Entry in Pivot File"
  1. I $P(NODE,"^",3)'=DFN Q "-1^DFN DOES NOT MATCH PIVOT DFN"
  1. Q EVENT_":"_NODE
  1. ;
  1. Q