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