VAQXRF2 ;ALB/JRP - X-REF CODES FOR PDX;01-DEC-92
;;1.5;PATIENT DATA EXCHANGE;**30**;NOV 17, 1993
AD(IFN1,IFN,SET,FNUM,OLDX) ;AD* X-REF FOR OUTGOING GROUP FILE (#394.83)
;INPUT : IFN1 - Internal file number of master record
; IFN - Internal file number of record
; SET - If 1, set cross reference
; If 0, kill cross reference (DEFAULT)
; FNUM - Only valid for KILLS
; The field number that was changed
; OLDX - Only valid for KILLS
; The previous value
;OUTPUT : 0 - Cross reference was set/killed
; -1 - Cross reference not set/killed
; -2 - Bad input
;
;CHECK INPUT & RECORD EXISTANCE
Q:($G(IFN1)="") -2
Q:($G(IFN)="") -2
S SET=+$G(SET)
Q:('$D(^VAT(394.83,IFN1,"FAC",IFN))) -2
Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
;DECLARE VARIABLES
N FACILITY,DOMAIN,ZERO
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S ZERO=$G(^VAT(394.83,IFN1,"FAC",IFN,0))
Q:(ZERO="") -1
S FACILITY=$P(ZERO,"^",1)
I ('SET) S:(FNUM=.01) FACILITY=OLDX
Q:(FACILITY="") -1
S DOMAIN=$P(ZERO,"^",2)
I ('SET) S:(FNUM=.02) DOMAIN=OLDX
Q:(DOMAIN="") -1
;SET X-REF
S:(SET) ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)
Q 0
OKDOM1(X) ; Screen for "Remote Facility" field #.01 in "Remote Facility"
; multiple 394.831 (field #10) in file 394.83
N VIEN
S VIEN=+$G(^DIC(4,X,6))
Q:$P($G(^DIC(4.2,VIEN,0)),U,2)'["C" 1
;D EN^DDIOL("Domain for this Facility is closed.")
Q 0
OKDOM2(X) ; Screen for "Remote Domain" field #.02 in "Remote Facility"
; multiple 394.831 (field #10) in file 394.83
Q:$P($G(^(0)),U,2)'["C" 1
;D EN^DDIOL("Domain is closed.")
Q 0
;
AE(IFN,SET,FNUM,OLDX) ;AE* X-REF FOR SEGMENT GROUP FILE (#394.84)
;INPUT : IFN - Internal file number of record
; SET - If 1, set cross reference
; If 0, kill cross reference (DEFAULT)
; FNUM - Only valid for KILLS
; The field number that was changed
; OLDX - Only valid for KILLS
; The previous value
;OUTPUT : 0 - Cross reference was set/killed
; -1 - Cross reference not set/killed
; -2 - Bad input
;
;CHECK INPUT & RECORD EXISTANCE
Q:($G(IFN)="") -2
S SET=+$G(SET)
Q:('$D(^VAT(394.84,IFN))) -2
Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
;DECLARE VARIABLES
N TYPE,PERSON,ZERO
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S ZERO=$G(^VAT(394.84,IFN,0))
Q:(ZERO="") -1
S TYPE=$P(ZERO,"^",2)
I ('SET) S:(FNUM=.02) TYPE=OLDX
Q:(TYPE="") -1
S PERSON=$P(ZERO,"^",3)
I ('SET) S:(FNUM=.03) PERSON=OLDX
Q:(PERSON="") -1
;SET X-REF
S:(SET) ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)
Q 0
;
BS5(IFN,SET,FNUM,OLDX) ;BS5* X-REF FOR TRANSACTION FILE (#394.61)
;INPUT : IFN - Internal file number of record
; SET - If 1, set cross reference
; If 0, kill cross reference (DEFAULT)
; FNUM - Only valid for KILLS
; The field number that was changed
; OLDX - Only valid for KILLS
; The previous value
;OUTPUT : 0 - Cross reference was set/killed
; -1 - Cross reference not set/killed
; -2 - Bad input
;
;CHECK INPUT & RECORD EXISTANCE
Q:($G(IFN)="") -2
S SET=+$G(SET)
Q:('$D(^VAT(394.61,IFN))) -2
Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
;DECLARE VARIABLES
N NAME,SSN,QRY
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S QRY=$G(^VAT(394.61,IFN,"QRY"))
Q:(QRY="") -1
S NAME=$P(QRY,"^",1)
I ('SET) S:(FNUM=10) NAME=OLDX
Q:(NAME="") -1
S SSN=$P(QRY,"^",2)
I ('SET) S:(FNUM=11) SSN=OLDX
Q:(SSN="") -1
;SET X-REF
S:(SET) ^VAT(394.61,"BS5",($E(NAME,1)_$E(SSN,6,10)),IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.61,"BS5",($E(NAME,1)_$E(SSN,6,10)),IFN)
Q 0
AUTO(VNODE) ;Auto-Numbering Logic
;INPUT : VNODE - Shows which field is being incremented
; 1 - Field .01 of file 394.61
; 2 - Field .01 of file 394.62
; 3 - Field .01 of file 394.73
;OUTPUT : N - Next available number
; -1 - Could not find auto-number record
; -2 - Bad input
N VFILE,VIEN,VNEXT
S VIEN=+$O(^VAT(394.86,"B",1,0)) ;Check for record existence
Q:'VIEN -1
S VFILE=$S($G(VNODE)=1:394.61,$G(VNODE)=2:394.62,$G(VNODE)=3:394.73,1:0)
Q:'VFILE -2
L +^VAT(394.86,VIEN,VNODE) ;Lock node to prevent simultaneous use
;Get next value for .01 of 394.61 or 394.62 or 394.73
F VNEXT=$G(^VAT(394.86,VIEN,VNODE))+1:1 S:(VNEXT>9999999999) VNEXT=100 Q:'$D(^VAT(VFILE,"B",VNEXT))
S ^VAT(394.86,VIEN,VNODE)=VNEXT ;Store new value
L -^VAT(394.86,VIEN,VNODE) ;Unlock node
; Note that we enclose the number in quotes so that ^DIC does not
; perform a lookup. Rather, it simply adds the new record to the file.
Q """"_VNEXT_"""" ;Return next available number
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQXRF2 5028 printed Sep 23, 2025@20:02:48 Page 2
VAQXRF2 ;ALB/JRP - X-REF CODES FOR PDX;01-DEC-92
+1 ;;1.5;PATIENT DATA EXCHANGE;**30**;NOV 17, 1993
AD(IFN1,IFN,SET,FNUM,OLDX) ;AD* X-REF FOR OUTGOING GROUP FILE (#394.83)
+1 ;INPUT : IFN1 - Internal file number of master record
+2 ; IFN - Internal file number of record
+3 ; SET - If 1, set cross reference
+4 ; If 0, kill cross reference (DEFAULT)
+5 ; FNUM - Only valid for KILLS
+6 ; The field number that was changed
+7 ; OLDX - Only valid for KILLS
+8 ; The previous value
+9 ;OUTPUT : 0 - Cross reference was set/killed
+10 ; -1 - Cross reference not set/killed
+11 ; -2 - Bad input
+12 ;
+13 ;CHECK INPUT & RECORD EXISTANCE
+14 if ($GET(IFN1)="")
QUIT -2
+15 if ($GET(IFN)="")
QUIT -2
+16 SET SET=+$GET(SET)
+17 if ('$DATA(^VAT(394.83,IFN1,"FAC",IFN)))
QUIT -2
+18 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+19 ;DECLARE VARIABLES
+20 NEW FACILITY,DOMAIN,ZERO
+21 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+22 SET ZERO=$GET(^VAT(394.83,IFN1,"FAC",IFN,0))
+23 if (ZERO="")
QUIT -1
+24 SET FACILITY=$PIECE(ZERO,"^",1)
+25 IF ('SET)
if (FNUM=.01)
SET FACILITY=OLDX
+26 if (FACILITY="")
QUIT -1
+27 SET DOMAIN=$PIECE(ZERO,"^",2)
+28 IF ('SET)
if (FNUM=.02)
SET DOMAIN=OLDX
+29 if (DOMAIN="")
QUIT -1
+30 ;SET X-REF
+31 if (SET)
SET ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)=""
+32 ;KILL X-REF
+33 if ('SET)
KILL ^VAT(394.83,IFN1,"FAC","A-OUTGRP",FACILITY,DOMAIN,IFN)
+34 QUIT 0
OKDOM1(X) ; Screen for "Remote Facility" field #.01 in "Remote Facility"
+1 ; multiple 394.831 (field #10) in file 394.83
+2 NEW VIEN
+3 SET VIEN=+$GET(^DIC(4,X,6))
+4 if $PIECE($GET(^DIC(4.2,VIEN,0)),U,2)'["C"
QUIT 1
+5 ;D EN^DDIOL("Domain for this Facility is closed.")
+6 QUIT 0
OKDOM2(X) ; Screen for "Remote Domain" field #.02 in "Remote Facility"
+1 ; multiple 394.831 (field #10) in file 394.83
+2 if $PIECE($GET(^(0)),U,2)'["C"
QUIT 1
+3 ;D EN^DDIOL("Domain is closed.")
+4 QUIT 0
+5 ;
AE(IFN,SET,FNUM,OLDX) ;AE* X-REF FOR SEGMENT GROUP FILE (#394.84)
+1 ;INPUT : IFN - Internal file number of record
+2 ; SET - If 1, set cross reference
+3 ; If 0, kill cross reference (DEFAULT)
+4 ; FNUM - Only valid for KILLS
+5 ; The field number that was changed
+6 ; OLDX - Only valid for KILLS
+7 ; The previous value
+8 ;OUTPUT : 0 - Cross reference was set/killed
+9 ; -1 - Cross reference not set/killed
+10 ; -2 - Bad input
+11 ;
+12 ;CHECK INPUT & RECORD EXISTANCE
+13 if ($GET(IFN)="")
QUIT -2
+14 SET SET=+$GET(SET)
+15 if ('$DATA(^VAT(394.84,IFN)))
QUIT -2
+16 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+17 ;DECLARE VARIABLES
+18 NEW TYPE,PERSON,ZERO
+19 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+20 SET ZERO=$GET(^VAT(394.84,IFN,0))
+21 if (ZERO="")
QUIT -1
+22 SET TYPE=$PIECE(ZERO,"^",2)
+23 IF ('SET)
if (FNUM=.02)
SET TYPE=OLDX
+24 if (TYPE="")
QUIT -1
+25 SET PERSON=$PIECE(ZERO,"^",3)
+26 IF ('SET)
if (FNUM=.03)
SET PERSON=OLDX
+27 if (PERSON="")
QUIT -1
+28 ;SET X-REF
+29 if (SET)
SET ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)=""
+30 ;KILL X-REF
+31 if ('SET)
KILL ^VAT(394.84,"A-SEGGRP",TYPE,PERSON,IFN)
+32 QUIT 0
+33 ;
BS5(IFN,SET,FNUM,OLDX) ;BS5* X-REF FOR TRANSACTION FILE (#394.61)
+1 ;INPUT : IFN - Internal file number of record
+2 ; SET - If 1, set cross reference
+3 ; If 0, kill cross reference (DEFAULT)
+4 ; FNUM - Only valid for KILLS
+5 ; The field number that was changed
+6 ; OLDX - Only valid for KILLS
+7 ; The previous value
+8 ;OUTPUT : 0 - Cross reference was set/killed
+9 ; -1 - Cross reference not set/killed
+10 ; -2 - Bad input
+11 ;
+12 ;CHECK INPUT & RECORD EXISTANCE
+13 if ($GET(IFN)="")
QUIT -2
+14 SET SET=+$GET(SET)
+15 if ('$DATA(^VAT(394.61,IFN)))
QUIT -2
+16 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+17 ;DECLARE VARIABLES
+18 NEW NAME,SSN,QRY
+19 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+20 SET QRY=$GET(^VAT(394.61,IFN,"QRY"))
+21 if (QRY="")
QUIT -1
+22 SET NAME=$PIECE(QRY,"^",1)
+23 IF ('SET)
if (FNUM=10)
SET NAME=OLDX
+24 if (NAME="")
QUIT -1
+25 SET SSN=$PIECE(QRY,"^",2)
+26 IF ('SET)
if (FNUM=11)
SET SSN=OLDX
+27 if (SSN="")
QUIT -1
+28 ;SET X-REF
+29 if (SET)
SET ^VAT(394.61,"BS5",($EXTRACT(NAME,1)_$EXTRACT(SSN,6,10)),IFN)=""
+30 ;KILL X-REF
+31 if ('SET)
KILL ^VAT(394.61,"BS5",($EXTRACT(NAME,1)_$EXTRACT(SSN,6,10)),IFN)
+32 QUIT 0
AUTO(VNODE) ;Auto-Numbering Logic
+1 ;INPUT : VNODE - Shows which field is being incremented
+2 ; 1 - Field .01 of file 394.61
+3 ; 2 - Field .01 of file 394.62
+4 ; 3 - Field .01 of file 394.73
+5 ;OUTPUT : N - Next available number
+6 ; -1 - Could not find auto-number record
+7 ; -2 - Bad input
+8 NEW VFILE,VIEN,VNEXT
+9 ;Check for record existence
SET VIEN=+$ORDER(^VAT(394.86,"B",1,0))
+10 if 'VIEN
QUIT -1
+11 SET VFILE=$SELECT($GET(VNODE)=1:394.61,$GET(VNODE)=2:394.62,$GET(VNODE)=3:394.73,1:0)
+12 if 'VFILE
QUIT -2
+13 ;Lock node to prevent simultaneous use
LOCK +^VAT(394.86,VIEN,VNODE)
+14 ;Get next value for .01 of 394.61 or 394.62 or 394.73
+15 FOR VNEXT=$GET(^VAT(394.86,VIEN,VNODE))+1:1
if (VNEXT>9999999999)
SET VNEXT=100
if '$DATA(^VAT(VFILE,"B",VNEXT))
QUIT
+16 ;Store new value
SET ^VAT(394.86,VIEN,VNODE)=VNEXT
+17 ;Unlock node
LOCK -^VAT(394.86,VIEN,VNODE)
+18 ; Note that we enclose the number in quotes so that ^DIC does not
+19 ; perform a lookup. Rather, it simply adds the new record to the file.
+20 ;Return next available number
QUIT """"_VNEXT_""""
