VAQXRF1.m

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 ---VAQXRF1   2276     printed  Mar 13, 2025@21:31:36                                                                                                                                                                                                     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      ;