INHVA ;FRW ; 22 Jul 91 11:09; Misc. utilities for SAIC-Care/VA interfacing
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
IDXREF(INSYS,INDA,INKILL,INFUNC,INRECID) ;Update record ID x-ref on file #4090.1
;Called from DD of file #4090.1
;INPUT:
; INSYS - system ('VA' or 'SC') (req.)
; INDA - entry in file #4090.1 (ien) (req.)
; INKILL - flag to indicate if x-ref is being set or killed (opt.)
; 1 => kill x-ref ; 0 => set x-ref (default)
; INFUNC - mapping function (ien) (opt.)
; INRECID - appropriate record id
;
S INSYS=$G(INSYS),INKILL=$G(INKILL),INFUNC=$G(INFUNC),INRECID=$G(INRECID) Q:'$G(INDA)!(INSYS'="SC"&(INSYS'="VA"))
S:'$L(INFUNC) INFUNC=$P($G(^INVD(4090.1,INDA,0)),U,2) S:'$L(INRECID) INRECID=$E($S(INSYS="SC":$G(^(1)),1:$G(^(10))),1,100)
Q:('$L(INFUNC)!'$L(INRECID))
I 'INKILL S ^INVD(4090.1,INSYS,INFUNC,INRECID,INDA)=""
E K ^INVD(4090.1,INSYS,INFUNC,INRECID,INDA)
Q
;
TRANS(INSYS,INFUNC,INRECID,INRECNA) ;Transform from one system to another
;INPUT:
; INSYS - sending system to transform from ('VA' or 'SC') (req.)
; i.e. 'VA' implies transform VA value to SAIC-Care value
; INFUNC - mapping function from file #4090.2 (internmal or external) (req.)
; INRECID - record ID (req.)
; INRECNA - record name (opt.)
;
;OUTPUT:
; function value - data element value (ien) ^ translated record ID
; or NULL if look-up failed
;
S INSYS=$G(INSYS),INFUNC=$G(INFUNC),INRECID=$G(INRECID),INRECNA=$G(INRECNA) Q:'$L(INFUNC)!'$L(INRECID)!(INSYS'="SC"&(INSYS'="VA")) ""
N INNOID,INNONA,INNOTRNA,INNOEX,INDA,INID,POP,DIC
;Get ien of Map Function
I INFUNC'=+INFUNC S DIC="^INVD(4090.2,",DIC(0)="MNX",X=INFUNC D ^DIC Q:Y<0 "" S INFUNC=+Y
;Determine appropriate nodes in file
S INNOID=$S(INSYS="SC":1,1:10),INNONA=INNOID+1,INNOEX=$S(INSYS="SC":12,1:3),INNOTRID=$S(INSYS="SC":10,1:1),INID=$E(INRECID,1,100),INNOTRNA=INNOTRID+1
;Loop thru appropriate x-ref
S INDA="",POP=0 F S INDA=$O(^INVD(4090.1,INSYS,INFUNC,INID,INDA)) Q:'INDA S POP=1 D Q:POP
.;Verify NOT excluded
.I $P($G(^INVD(4090.1,INDA,INNOEX)),U,1) S POP=0 Q
.;Verify full record ID matches
.I INRECID'=$G(^INVD(4090.1,INDA,INNOID)) S POP=0 Q
.;Verify record name matches (if present)
.I $L(INRECNA),INRECNA'=$G(^INVD(4090.1,INDA,INNONA)) S POP=0 Q
;Construct exit value
I INDA S INDA=$G(^INVD(4090.1,INDA,INNOTRID))_U_$G(^INVD(4090.1,INDA,INNOTRNA))
Q INDA
;
INHVA ;FRW ; 22 Jul 91 11:09; Misc. utilities for SAIC-Care/VA interfacing
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
IDXREF(INSYS,INDA,INKILL,INFUNC,INRECID) ;Update record ID x-ref on file #4090.1
+1 ;Called from DD of file #4090.1
+2 ;INPUT:
+3 ; INSYS - system ('VA' or 'SC') (req.)
+4 ; INDA - entry in file #4090.1 (ien) (req.)
+5 ; INKILL - flag to indicate if x-ref is being set or killed (opt.)
+6 ; 1 => kill x-ref ; 0 => set x-ref (default)
+7 ; INFUNC - mapping function (ien) (opt.)
+8 ; INRECID - appropriate record id
+9 ;
+10 SET INSYS=$GET(INSYS)
SET INKILL=$GET(INKILL)
SET INFUNC=$GET(INFUNC)
SET INRECID=$GET(INRECID)
IF '$GET(INDA)!(INSYS'="SC"&(INSYS'="VA"))
QUIT
+11 IF '$LENGTH(INFUNC)
SET INFUNC=$PIECE($GET(^INVD(4090.1,INDA,0)),U,2)
IF '$LENGTH(INRECID)
SET INRECID=$EXTRACT($SELECT(INSYS="SC":$GET(^(1)),1:$GET(^(10))),1,100)
+12 IF ('$LENGTH(INFUNC)!'$LENGTH(INRECID))
QUIT
+13 IF 'INKILL
SET ^INVD(4090.1,INSYS,INFUNC,INRECID,INDA)=""
+14 IF '$TEST
KILL ^INVD(4090.1,INSYS,INFUNC,INRECID,INDA)
+15 QUIT
+16 ;
TRANS(INSYS,INFUNC,INRECID,INRECNA) ;Transform from one system to another
+1 ;INPUT:
+2 ; INSYS - sending system to transform from ('VA' or 'SC') (req.)
+3 ; i.e. 'VA' implies transform VA value to SAIC-Care value
+4 ; INFUNC - mapping function from file #4090.2 (internmal or external) (req.)
+5 ; INRECID - record ID (req.)
+6 ; INRECNA - record name (opt.)
+7 ;
+8 ;OUTPUT:
+9 ; function value - data element value (ien) ^ translated record ID
+10 ; or NULL if look-up failed
+11 ;
+12 SET INSYS=$GET(INSYS)
SET INFUNC=$GET(INFUNC)
SET INRECID=$GET(INRECID)
SET INRECNA=$GET(INRECNA)
IF '$LENGTH(INFUNC)!'$LENGTH(INRECID)!(INSYS'="SC"&(INSYS'="VA"))
QUIT ""
+13 NEW INNOID,INNONA,INNOTRNA,INNOEX,INDA,INID,POP,DIC
+14 ;Get ien of Map Function
+15 IF INFUNC'=+INFUNC
SET DIC="^INVD(4090.2,"
SET DIC(0)="MNX"
SET X=INFUNC
DO ^DIC
IF Y<0
QUIT ""
SET INFUNC=+Y
+16 ;Determine appropriate nodes in file
+17 SET INNOID=$SELECT(INSYS="SC":1,1:10)
SET INNONA=INNOID+1
SET INNOEX=$SELECT(INSYS="SC":12,1:3)
SET INNOTRID=$SELECT(INSYS="SC":10,1:1)
SET INID=$EXTRACT(INRECID,1,100)
SET INNOTRNA=INNOTRID+1
+18 ;Loop thru appropriate x-ref
+19 SET INDA=""
SET POP=0
FOR
SET INDA=$ORDER(^INVD(4090.1,INSYS,INFUNC,INID,INDA))
IF 'INDA
QUIT
SET POP=1
Begin DoDot:1
+20 ;Verify NOT excluded
+21 IF $PIECE($GET(^INVD(4090.1,INDA,INNOEX)),U,1)
SET POP=0
QUIT
+22 ;Verify full record ID matches
+23 IF INRECID'=$GET(^INVD(4090.1,INDA,INNOID))
SET POP=0
QUIT
+24 ;Verify record name matches (if present)
+25 IF $LENGTH(INRECNA)
IF INRECNA'=$GET(^INVD(4090.1,INDA,INNONA))
SET POP=0
QUIT
End DoDot:1
IF POP
QUIT
+26 ;Construct exit value
+27 IF INDA
SET INDA=$GET(^INVD(4090.1,INDA,INNOTRID))_U_$GET(^INVD(4090.1,INDA,INNOTRNA))
+28 QUIT INDA
+29 ;
