VAQXRF1 ;ALB/JRP - X-REF CODES FOR PDX;25-NOV-92
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
AB(IFN,SET,FNUM,OLDX) ;AB* X-REF FOR ENCRYPTED FIELDS FILE (#394.73)
;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.73,IFN))) -2
Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
;DECLARE VARIABLES
N FILE,FIELD,ZERO
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S ZERO=$G(^VAT(394.73,IFN,0))
Q:(ZERO="") -1
S FILE=$P(ZERO,"^",2)
I ('SET) S:(FNUM=.02) FILE=OLDX
Q:(FILE="") -1
S FIELD=$P(ZERO,"^",3)
I ('SET) S:(FNUM=.03) FIELD=OLDX
Q:(FIELD="") -1
;SET X-REF
S:(SET) ^VAT(394.73,"A-NCRYPT",FILE,FIELD,IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.73,"A-NCRYPT",FILE,FIELD,IFN)
Q 0
;
AC(IFN,SET,FNUM,OLDX) ;AC* X-REF FOR DATA FILE (#394.62)
;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.62,IFN))) -2
Q:(('SET)&('$D(FNUM))&('$D(OLDX))) -2
;DECLARE VARIABLES
N TRANS,SEG,ZERO
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S ZERO=$G(^VAT(394.62,IFN,0))
Q:(ZERO="") -1
S SEG=$P(ZERO,"^",2)
I ('SET) S:(FNUM=.02) SEG=OLDX
Q:(SEG="") -1
S TRANS=$P($G(^VAT(394.62,IFN,"TRNS")),"^",1)
I ('SET) S:(FNUM=40) TRANS=OLDX
Q:(TRANS="") -1
;SET X-REF
S:(SET) ^VAT(394.62,"A-SEGMENT",TRANS,SEG,IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.62,"A-SEGMENT",TRANS,SEG,IFN)
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQXRF1 2276 printed Sep 23, 2025@20:02:47 Page 2
VAQXRF1 ;ALB/JRP - X-REF CODES FOR PDX;25-NOV-92
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
AB(IFN,SET,FNUM,OLDX) ;AB* X-REF FOR ENCRYPTED FIELDS FILE (#394.73)
+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.73,IFN)))
QUIT -2
+16 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+17 ;DECLARE VARIABLES
+18 NEW FILE,FIELD,ZERO
+19 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+20 SET ZERO=$GET(^VAT(394.73,IFN,0))
+21 if (ZERO="")
QUIT -1
+22 SET FILE=$PIECE(ZERO,"^",2)
+23 IF ('SET)
if (FNUM=.02)
SET FILE=OLDX
+24 if (FILE="")
QUIT -1
+25 SET FIELD=$PIECE(ZERO,"^",3)
+26 IF ('SET)
if (FNUM=.03)
SET FIELD=OLDX
+27 if (FIELD="")
QUIT -1
+28 ;SET X-REF
+29 if (SET)
SET ^VAT(394.73,"A-NCRYPT",FILE,FIELD,IFN)=""
+30 ;KILL X-REF
+31 if ('SET)
KILL ^VAT(394.73,"A-NCRYPT",FILE,FIELD,IFN)
+32 QUIT 0
+33 ;
AC(IFN,SET,FNUM,OLDX) ;AC* X-REF FOR DATA FILE (#394.62)
+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 ;
+13 ;CHECK INPUT & RECORD EXISTANCE
+14 if ($GET(IFN)="")
QUIT -2
+15 SET SET=+$GET(SET)
+16 if ('$DATA(^VAT(394.62,IFN)))
QUIT -2
+17 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+18 ;DECLARE VARIABLES
+19 NEW TRANS,SEG,ZERO
+20 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+21 SET ZERO=$GET(^VAT(394.62,IFN,0))
+22 if (ZERO="")
QUIT -1
+23 SET SEG=$PIECE(ZERO,"^",2)
+24 IF ('SET)
if (FNUM=.02)
SET SEG=OLDX
+25 if (SEG="")
QUIT -1
+26 SET TRANS=$PIECE($GET(^VAT(394.62,IFN,"TRNS")),"^",1)
+27 IF ('SET)
if (FNUM=40)
SET TRANS=OLDX
+28 if (TRANS="")
QUIT -1
+29 ;SET X-REF
+30 if (SET)
SET ^VAT(394.62,"A-SEGMENT",TRANS,SEG,IFN)=""
+31 ;KILL X-REF
+32 if ('SET)
KILL ^VAT(394.62,"A-SEGMENT",TRANS,SEG,IFN)
+33 QUIT 0
+34 ;
