VAFHPIV2 ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
;;5.3;Registration;**91**;Jun 06, 1996
;
SETTRAN(PIVOT) ;
;sets TRANSMITTED field in pivot file
I '$D(PIVOT) Q "-1^Missing Parameter for SETTRAN function"
N ERR,ENT,DIE,DR,DA,X,Y,CROSS
S ENT=$O(^VAT(391.71,"D",PIVOT,""))
I +ENT<1 S ERR="-1^NO D CROSS REFERENCE"
I +ENT>0 D
.S $P(^VAT(391.71,ENT,0),"^",6)=1,CROSS=0,DA=ENT
.F S CROSS=$O(^DD(391.71,.06,1,CROSS)) Q:'CROSS D
..S X=0 X ^DD(391.71,.06,1,CROSS,2) ;kill cross reference
..S X=1 X ^DD(391.71,.06,1,CROSS,1) ;set cross reference
I $D(ERR) Q ERR
Q 0
;
CLNTRAN(PIVOT) ;
;resets TRANSMITTED field in pivot file
I '$D(PIVOT) Q "-1^Missing Parameter for CLNTRAN function"
N ERR,ENTRY,DA,CROSS
S ENTRY=$O(^VAT(391.71,"D",PIVOT,"")),DA=ENTRY
I +ENTRY<0 S ERR="-1^NO D CROSS REFERENCE"
I +ENTRY>0 D
.S $P(^VAT(391.71,ENTRY,0),"^",6)="",CROSS=0
.F S CROSS=$O(^DD(391.71,.06,1,CROSS)) Q:'CROSS D
..S X=1 X ^DD(391.71,.06,1,CROSS,2) ;kill cross reference
..S X=0 X ^DD(391.71,.06,1,CROSS,1) ;set cross reference
I $D(ERR) Q ERR
Q 0
;
GETPIV() ;
;gets next available pivot number. Get entry from MAS PARAMETER file
;quit returning new pivot number
N ERR,VAR1,NEXT,FOUND
S VAR1=$O(^DG(43,0)) I 'VAR1 Q "-1^Unable to Find Parameter One"
F Q:$D(FOUND)!($D(ERR)) D
.L +^DG(43,VAR1,"HL7"):5 I '$T S ERR="-1^Unable to get next pivot number" Q
.S NEXT=$G(^DG(43,VAR1,"HL7"))+1
.I '$D(^VAT(391.71,NEXT)) S FOUND=""
I $D(ERR) Q ERR
S $P(^DG(43,VAR1,"HL7"),"^")=NEXT
L -^DG(43,VAR1,"HL7")
Q NEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHPIV2 1577 printed Oct 16, 2024@19:04:14 Page 2
VAFHPIV2 ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
+1 ;;5.3;Registration;**91**;Jun 06, 1996
+2 ;
SETTRAN(PIVOT) ;
+1 ;sets TRANSMITTED field in pivot file
+2 IF '$DATA(PIVOT)
QUIT "-1^Missing Parameter for SETTRAN function"
+3 NEW ERR,ENT,DIE,DR,DA,X,Y,CROSS
+4 SET ENT=$ORDER(^VAT(391.71,"D",PIVOT,""))
+5 IF +ENT<1
SET ERR="-1^NO D CROSS REFERENCE"
+6 IF +ENT>0
Begin DoDot:1
+7 SET $PIECE(^VAT(391.71,ENT,0),"^",6)=1
SET CROSS=0
SET DA=ENT
+8 FOR
SET CROSS=$ORDER(^DD(391.71,.06,1,CROSS))
if 'CROSS
QUIT
Begin DoDot:2
+9 ;kill cross reference
SET X=0
XECUTE ^DD(391.71,.06,1,CROSS,2)
+10 ;set cross reference
SET X=1
XECUTE ^DD(391.71,.06,1,CROSS,1)
End DoDot:2
End DoDot:1
+11 IF $DATA(ERR)
QUIT ERR
+12 QUIT 0
+13 ;
CLNTRAN(PIVOT) ;
+1 ;resets TRANSMITTED field in pivot file
+2 IF '$DATA(PIVOT)
QUIT "-1^Missing Parameter for CLNTRAN function"
+3 NEW ERR,ENTRY,DA,CROSS
+4 SET ENTRY=$ORDER(^VAT(391.71,"D",PIVOT,""))
SET DA=ENTRY
+5 IF +ENTRY<0
SET ERR="-1^NO D CROSS REFERENCE"
+6 IF +ENTRY>0
Begin DoDot:1
+7 SET $PIECE(^VAT(391.71,ENTRY,0),"^",6)=""
SET CROSS=0
+8 FOR
SET CROSS=$ORDER(^DD(391.71,.06,1,CROSS))
if 'CROSS
QUIT
Begin DoDot:2
+9 ;kill cross reference
SET X=1
XECUTE ^DD(391.71,.06,1,CROSS,2)
+10 ;set cross reference
SET X=0
XECUTE ^DD(391.71,.06,1,CROSS,1)
End DoDot:2
End DoDot:1
+11 IF $DATA(ERR)
QUIT ERR
+12 QUIT 0
+13 ;
GETPIV() ;
+1 ;gets next available pivot number. Get entry from MAS PARAMETER file
+2 ;quit returning new pivot number
+3 NEW ERR,VAR1,NEXT,FOUND
+4 SET VAR1=$ORDER(^DG(43,0))
IF 'VAR1
QUIT "-1^Unable to Find Parameter One"
+5 FOR
if $DATA(FOUND)!($DATA(ERR))
QUIT
Begin DoDot:1
+6 LOCK +^DG(43,VAR1,"HL7"):5
IF '$TEST
SET ERR="-1^Unable to get next pivot number"
QUIT
+7 SET NEXT=$GET(^DG(43,VAR1,"HL7"))+1
+8 IF '$DATA(^VAT(391.71,NEXT))
SET FOUND=""
End DoDot:1
+9 IF $DATA(ERR)
QUIT ERR
+10 SET $PIECE(^DG(43,VAR1,"HL7"),"^")=NEXT
+11 LOCK -^DG(43,VAR1,"HL7")
+12 QUIT NEXT
