source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHPIV2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1VAFHPIV2 ;ALB/CM PIVOT FILE UTILITY FUNCTIONS ;5/5/95
2 ;;5.3;Registration;**91**;Jun 06, 1996
3 ;
4SETTRAN(PIVOT) ;
5 ;sets TRANSMITTED field in pivot file
6 I '$D(PIVOT) Q "-1^Missing Parameter for SETTRAN function"
7 N ERR,ENT,DIE,DR,DA,X,Y,CROSS
8 S ENT=$O(^VAT(391.71,"D",PIVOT,""))
9 I +ENT<1 S ERR="-1^NO D CROSS REFERENCE"
10 I +ENT>0 D
11 .S $P(^VAT(391.71,ENT,0),"^",6)=1,CROSS=0,DA=ENT
12 .F S CROSS=$O(^DD(391.71,.06,1,CROSS)) Q:'CROSS D
13 ..S X=0 X ^DD(391.71,.06,1,CROSS,2) ;kill cross reference
14 ..S X=1 X ^DD(391.71,.06,1,CROSS,1) ;set cross reference
15 I $D(ERR) Q ERR
16 Q 0
17 ;
18CLNTRAN(PIVOT) ;
19 ;resets TRANSMITTED field in pivot file
20 I '$D(PIVOT) Q "-1^Missing Parameter for CLNTRAN function"
21 N ERR,ENTRY,DA,CROSS
22 S ENTRY=$O(^VAT(391.71,"D",PIVOT,"")),DA=ENTRY
23 I +ENTRY<0 S ERR="-1^NO D CROSS REFERENCE"
24 I +ENTRY>0 D
25 .S $P(^VAT(391.71,ENTRY,0),"^",6)="",CROSS=0
26 .F S CROSS=$O(^DD(391.71,.06,1,CROSS)) Q:'CROSS D
27 ..S X=1 X ^DD(391.71,.06,1,CROSS,2) ;kill cross reference
28 ..S X=0 X ^DD(391.71,.06,1,CROSS,1) ;set cross reference
29 I $D(ERR) Q ERR
30 Q 0
31 ;
32GETPIV() ;
33 ;gets next available pivot number. Get entry from MAS PARAMETER file
34 ;quit returning new pivot number
35 N ERR,VAR1,NEXT,FOUND
36 S VAR1=$O(^DG(43,0)) I 'VAR1 Q "-1^Unable to Find Parameter One"
37 F Q:$D(FOUND)!($D(ERR)) D
38 .L +^DG(43,VAR1,"HL7"):5 I '$T S ERR="-1^Unable to get next pivot number" Q
39 .S NEXT=$G(^DG(43,VAR1,"HL7"))+1
40 .I '$D(^VAT(391.71,NEXT)) S FOUND=""
41 I $D(ERR) Q ERR
42 S $P(^DG(43,VAR1,"HL7"),"^")=NEXT
43 L -^DG(43,VAR1,"HL7")
44 Q NEXT
Note: See TracBrowser for help on using the repository browser.