QAQAXREF.m

QAQAXREF ;HISC/DAD-EXECUTE SET AND KILL XREF'S ;5/12/92  14:08

 ;;1.7;QM Integration Module;;07/25/1995

 ; REQUIRED VARIABLES

 ;  QAQADICT = DATA DICTIONARY NUMBER

 ;  QAQAFLD  = FIELD NUMBER IN THE ABOVE DD

 ;  X        = FIELD VALUE TO BE CROSS REFERENCED

ENKILL ; *** Execute a field's cross reference kill logic

 D CHECK G:QAQAEXIT EXIT S QAQAXSAV=X

 F QAQAXREF=0:0 S QAQAXREF=$O(^DD(QAQADICT,QAQAFLD,1,QAQAXREF)) Q:QAQAXREF'>0  S X=QAQAXSAV X:$D(^DD(QAQADICT,QAQAFLD,1,QAQAXREF,2))#2 ^(2)

 G EXIT

ENSET ; *** Execute a field's cross reference set logic

 D CHECK G:QAQAEXIT EXIT S QAQAXSAV=X

 F QAQAXREF=0:0 S QAQAXREF=$O(^DD(QAQADICT,QAQAFLD,1,QAQAXREF)) Q:QAQAXREF'>0  S X=QAQAXSAV X:$D(^DD(QAQADICT,QAQAFLD,1,QAQAXREF,1))#2 ^(1)

EXIT ;

 K QAQADICT,QAQAEXIT,QAQAFLD,QAQAXREF,QAQAXSAV

 Q

CHECK ;

 S QAQAEXIT=$S($D(X)[0:1,$D(QAQADICT)[0:1,$D(QAQAFLD)[0:1,X="":1,QAQADICT'>0:1,QAQAFLD'>0:1,1:0)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAQAXREF   920     printed  Apr 09, 2024@21:33:53                                                                                                                                                                                                     Page 2

QAQAXREF  ;HISC/DAD-EXECUTE SET AND KILL XREF'S ;5/12/92  14:08

 +1       ;;1.7;QM Integration Module;;07/25/1995

 +2       ; REQUIRED VARIABLES

 +3       ;  QAQADICT = DATA DICTIONARY NUMBER

 +4       ;  QAQAFLD  = FIELD NUMBER IN THE ABOVE DD

 +5       ;  X        = FIELD VALUE TO BE CROSS REFERENCED

ENKILL    ; *** Execute a field's cross reference kill logic

 +1        DO CHECK

           if QAQAEXIT

               GOTO EXIT

           SET QAQAXSAV=X

 +2        FOR QAQAXREF=0:0

               SET QAQAXREF=$ORDER(^DD(QAQADICT,QAQAFLD,1,QAQAXREF))

               if QAQAXREF'>0

                   QUIT 

               SET X=QAQAXSAV

               if $DATA(^DD(QAQADICT,QAQAFLD,1,QAQAXREF,2))#2

                   XECUTE ^(2)

 +3        GOTO EXIT

ENSET     ; *** Execute a field's cross reference set logic

 +1        DO CHECK

           if QAQAEXIT

               GOTO EXIT

           SET QAQAXSAV=X

 +2        FOR QAQAXREF=0:0

               SET QAQAXREF=$ORDER(^DD(QAQADICT,QAQAFLD,1,QAQAXREF))

               if QAQAXREF'>0

                   QUIT 

               SET X=QAQAXSAV

               if $DATA(^DD(QAQADICT,QAQAFLD,1,QAQAXREF,1))#2

                   XECUTE ^(1)

EXIT      ;

 +1        KILL QAQADICT,QAQAEXIT,QAQAFLD,QAQAXREF,QAQAXSAV

 +2        QUIT 

CHECK     ;

 +1        SET QAQAEXIT=$SELECT($DATA(X)[0:1,$DATA(QAQADICT)[0:1,$DATA(QAQAFLD)[0:1,X="":1,QAQADICT'>0:1,QAQAFLD'>0:1,1:0)

 +2        QUIT