- 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
- 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
