VAQXRF3 ;ALB/JRP - X-REF CODES FOR PDX;17-FEB-92
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
AF(IFN,SET,FNUM,OLDX) ;AF* 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
;
;NOTE: This x-ref is only SET if data was stored in display
; ready format. KILLing of x-ref is always allowed.
;
;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 ZERO,TRANS,SEGMENT,DISPLAY
;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
S ZERO=$G(^VAT(394.62,IFN,0))
Q:(ZERO="") -1
S DISPLAY=$P(ZERO,"^",5)
Q:(('DISPLAY)&SET) -1
S SEGMENT=$P(ZERO,"^",2)
I ('SET) S:(FNUM=.02) SEGMENT=OLDX
Q:(SEGMENT="") -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-DISPLAY",TRANS,SEGMENT,IFN)=""
;KILL X-REF
K:('SET) ^VAT(394.62,"A-DISPLAY",TRANS,SEGMENT,IFN)
Q 0
;
AG(IFN) ;AG X-REF FOR DATA FILE (#394.62)
;INPUT : IFN - Internal file number of record
;
;OUTPUT : If now display ready, result of killing AF x-ref
; If now info only, result of setting AF x-ref
;
;NOTE: This x-ref is used to clean-up the node set by the AF*
; x-refs. It will only be executed when field .05 is changed
; (only used in KILL logic).
;
;CHECK INPUT & RECORD EXISTANCE
Q:($G(IFN)="") -2
Q:('$D(^VAT(394.62,IFN))) -2
;DECLARE VARIABLES
N TEMP,DISPLAY,RESULT
S DISPLAY=$P($G(^VAT(394.62,IFN,0)),"^",5)
Q:(DISPLAY="") -1
;NEW FORMAT IS DISPLAY READY
I (DISPLAY) D
.;SET AF* X-REF
.S RESULT=$$AF^VAQXRF3(IFN,1)
;NEW FORMAT IS NOT DISPLAY READY
I ('DISPLAY) D
.;KILL AF* X-REF
.S RESULT=$$AF^VAQXRF3(IFN,0,"","")
Q RESULT
ONEPAR(FACPTR) ;SCREEN TO ONLY ALLOW ONE ENTRY IN PARAMTER FILE
;INPUT : FACPTR - Pointer to INSTITUTION File (what user has entered)
;OUTPUT : 1 - Institution entered may be used
; (there is no entry or it is the existing entry)
; 0 - Institution entered may not be used
; (it is not the existing entry)
;NOTES : Used in screening of field .01
;
;CHECK INPUT
Q:('FACPTR) 0
;DECLARE VARIABLES
N IFN,CURPTR
;CURRENTLY NO ENTRY
S IFN=$O(^VAT(394.81,0))
Q:('IFN) 1
;CURRENT ENTRY IS ENTERED INSTITUTION
S CURPTR=+$G(^VAT(394.81,IFN,0))
Q:(FACPTR=CURPTR) 1
;DON'T ALLOW SELECTION
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQXRF3 2851 printed Sep 23, 2025@20:02:49 Page 2
VAQXRF3 ;ALB/JRP - X-REF CODES FOR PDX;17-FEB-92
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
AF(IFN,SET,FNUM,OLDX) ;AF* 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 ;NOTE: This x-ref is only SET if data was stored in display
+13 ; ready format. KILLing of x-ref is always allowed.
+14 ;
+15 ;CHECK INPUT & RECORD EXISTANCE
+16 if ($GET(IFN)="")
QUIT -2
+17 SET SET=+$GET(SET)
+18 if ('$DATA(^VAT(394.62,IFN)))
QUIT -2
+19 if (('SET)&('$DATA(FNUM))&('$DATA(OLDX)))
QUIT -2
+20 ;DECLARE VARIABLES
+21 NEW ZERO,TRANS,SEGMENT,DISPLAY
+22 ;GET INFO FOR X-REF & QUIT IF ANY PART IS NULL
+23 SET ZERO=$GET(^VAT(394.62,IFN,0))
+24 if (ZERO="")
QUIT -1
+25 SET DISPLAY=$PIECE(ZERO,"^",5)
+26 if (('DISPLAY)&SET)
QUIT -1
+27 SET SEGMENT=$PIECE(ZERO,"^",2)
+28 IF ('SET)
if (FNUM=.02)
SET SEGMENT=OLDX
+29 if (SEGMENT="")
QUIT -1
+30 SET TRANS=$PIECE($GET(^VAT(394.62,IFN,"TRNS")),"^",1)
+31 IF ('SET)
if (FNUM=40)
SET TRANS=OLDX
+32 if (TRANS="")
QUIT -1
+33 ;SET X-REF
+34 if (SET)
SET ^VAT(394.62,"A-DISPLAY",TRANS,SEGMENT,IFN)=""
+35 ;KILL X-REF
+36 if ('SET)
KILL ^VAT(394.62,"A-DISPLAY",TRANS,SEGMENT,IFN)
+37 QUIT 0
+38 ;
AG(IFN) ;AG X-REF FOR DATA FILE (#394.62)
+1 ;INPUT : IFN - Internal file number of record
+2 ;
+3 ;OUTPUT : If now display ready, result of killing AF x-ref
+4 ; If now info only, result of setting AF x-ref
+5 ;
+6 ;NOTE: This x-ref is used to clean-up the node set by the AF*
+7 ; x-refs. It will only be executed when field .05 is changed
+8 ; (only used in KILL logic).
+9 ;
+10 ;CHECK INPUT & RECORD EXISTANCE
+11 if ($GET(IFN)="")
QUIT -2
+12 if ('$DATA(^VAT(394.62,IFN)))
QUIT -2
+13 ;DECLARE VARIABLES
+14 NEW TEMP,DISPLAY,RESULT
+15 SET DISPLAY=$PIECE($GET(^VAT(394.62,IFN,0)),"^",5)
+16 if (DISPLAY="")
QUIT -1
+17 ;NEW FORMAT IS DISPLAY READY
+18 IF (DISPLAY)
Begin DoDot:1
+19 ;SET AF* X-REF
+20 SET RESULT=$$AF^VAQXRF3(IFN,1)
End DoDot:1
+21 ;NEW FORMAT IS NOT DISPLAY READY
+22 IF ('DISPLAY)
Begin DoDot:1
+23 ;KILL AF* X-REF
+24 SET RESULT=$$AF^VAQXRF3(IFN,0,"","")
End DoDot:1
+25 QUIT RESULT
ONEPAR(FACPTR) ;SCREEN TO ONLY ALLOW ONE ENTRY IN PARAMTER FILE
+1 ;INPUT : FACPTR - Pointer to INSTITUTION File (what user has entered)
+2 ;OUTPUT : 1 - Institution entered may be used
+3 ; (there is no entry or it is the existing entry)
+4 ; 0 - Institution entered may not be used
+5 ; (it is not the existing entry)
+6 ;NOTES : Used in screening of field .01
+7 ;
+8 ;CHECK INPUT
+9 if ('FACPTR)
QUIT 0
+10 ;DECLARE VARIABLES
+11 NEW IFN,CURPTR
+12 ;CURRENTLY NO ENTRY
+13 SET IFN=$ORDER(^VAT(394.81,0))
+14 if ('IFN)
QUIT 1
+15 ;CURRENT ENTRY IS ENTERED INSTITUTION
+16 SET CURPTR=+$GET(^VAT(394.81,IFN,0))
+17 if (FACPTR=CURPTR)
QUIT 1
+18 ;DON'T ALLOW SELECTION
+19 QUIT 0
