DIFGGSB2.m

DIFGGSB2 ;SFISC/DG,EDE(OHPRD)- ;6/19/92  9:28 AM

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

SPSPEC ; UNIQUE SPECIFIER

 F DIFGSB(DILL,"SPSPEC")=0:0 S DIFGSB(DILL,"SPSPEC")=$O(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC"))) Q:'DIFGSB(DILL,"SPSPEC")  I +^(DIFGSB(DILL,"SPSPEC")) Q:$P(^(DIFGSB(DILL,"SPSPEC")),U,2)'=""

 Q:'DIFGSB(DILL,"SPSPEC")

 I $P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"SPSPEC"),0),U,2)["P" S DIFGSB(DILL,"SPSPEC")=0 Q

 S $P(DIFGSB(DILL,"SPSPEC"),U,2)=$P(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC")),U,2)

 S DIFGSB(DILL,"FLD")=+DIFGSB(DILL,"SPSPEC")

 I '$D(DIFG(DILL,"MUL")) S DR=+DIFGSB(DILL,"SPSPEC")

 E  S DR(DIFG(DILL,"FILE"))=+DIFGSB(DILL,"SPSPEC")

 S DIFGSB(DILL,"SBT")="KEY:"

 D FIELDS^DIFGGSB1

 Q

 ;

PTRCHK ; CHECK FOR POINTER FIELD

 Q:$P(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2)'["P"

 S DITAB=DITAB+2

 S DILL=DILL+1

 D POINTER

 S DITAB=DITAB-2

 K DIFG(DILL)

 S DILL=DILL-1

 Q

 ;

POINTER ; POINTER FIELDS

 S DIFG(DILL,"FILE")=+$P($P(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2),"P",2),X=$P(^(0),U,4) S:$P(X,";")'=+X X=""""_$P(X,";")_""";"_$P(X,";",2)

 I $D(DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P")) S DIFG(DILL,"FE")=DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P")

 E  S DIFG(DILL,"FE")=$P(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$P(X,";",1)_")"),U,$P(X,";",2))

 I '$D(^DIC(DIFG(DILL,"FILE"),0)) D KILLLL^DIFGGU Q

 S DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL"),DIFG(DILL,"FNAME")=$P(^DIC(DIFG(DILL,"FILE"),0),U,1)

 I '$D(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)")) D KILLLL^DIFGGU Q

 I $D(Y),Y'="" S Z=Y,Y=""

 I $D(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD")))!($P(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2)'["'") S DIFG(DILL,"NOKEY")=""

 D START^DIFGGSB ; RECURSE

 Q

DIFGGSB2  ;SFISC/DG,EDE(OHPRD)- ;6/19/92  9:28 AM

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

SPSPEC    ; UNIQUE SPECIFIER

 +1        FOR DIFGSB(DILL,"SPSPEC")=0:0

               SET DIFGSB(DILL,"SPSPEC")=$ORDER(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC")))

               IF 'DIFGSB(DILL,"SPSPEC")

                   QUIT 

               IF +^(DIFGSB(DILL,"SPSPEC"))

                   IF $PIECE(^(DIFGSB(DILL,"SPSPEC")),U,2)'=""

                       QUIT 

 +2        IF 'DIFGSB(DILL,"SPSPEC")

               QUIT 

 +3        IF $PIECE(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"SPSPEC"),0),U,2)["P"

               SET DIFGSB(DILL,"SPSPEC")=0

               QUIT 

 +4        SET $PIECE(DIFGSB(DILL,"SPSPEC"),U,2)=$PIECE(^DD(DIFG(DILL,"FILE"),0,"SP",DIFGSB(DILL,"SPSPEC")),U,2)

 +5        SET DIFGSB(DILL,"FLD")=+DIFGSB(DILL,"SPSPEC")

 +6        IF '$DATA(DIFG(DILL,"MUL"))

               SET DR=+DIFGSB(DILL,"SPSPEC")

 +7       IF '$TEST

               SET DR(DIFG(DILL,"FILE"))=+DIFGSB(DILL,"SPSPEC")

 +8        SET DIFGSB(DILL,"SBT")="KEY:"

 +9        DO FIELDS^DIFGGSB1

 +10       QUIT 

 +11      ;

PTRCHK    ; CHECK FOR POINTER FIELD

 +1        IF $PIECE(^DD(DIFG(DILL,"FILE"),DIFGSB(DILL,"FLD"),0),U,2)'["P"

               QUIT 

 +2        SET DITAB=DITAB+2

 +3        SET DILL=DILL+1

 +4        DO POINTER

 +5        SET DITAB=DITAB-2

 +6        KILL DIFG(DILL)

 +7        SET DILL=DILL-1

 +8        QUIT 

 +9       ;

POINTER   ; POINTER FIELDS

 +1        SET DIFG(DILL,"FILE")=+$PIECE($PIECE(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2),"P",2)

           SET X=$PIECE(^(0),U,4)

           IF $PIECE(X,";")'=+X

               SET X=""""_$PIECE(X,";")_""";"_$PIECE(X,";",2)

 +2        IF $DATA(DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P"))

               SET DIFG(DILL,"FE")=DIFGGU(DIFG(DILL-1,"FILE"),DIFG(DILL-1,"FE"),DIFGSB(DILL-1,"FLD"),"P")

 +3       IF '$TEST

               SET DIFG(DILL,"FE")=$PIECE(@(DIFG(DILL-1,"FGBL")_DIFG(DILL-1,"FE")_","_$PIECE(X,";",1)_")"),U,$PIECE(X,";",2))

 +4        IF '$DATA(^DIC(DIFG(DILL,"FILE"),0))

               DO KILLLL^DIFGGU

               QUIT 

 +5        SET DIFG(DILL,"FGBL")=^DIC(DIFG(DILL,"FILE"),0,"GL")

           SET DIFG(DILL,"FNAME")=$PIECE(^DIC(DIFG(DILL,"FILE"),0),U,1)

 +6        IF '$DATA(@(DIFG(DILL,"FGBL")_DIFG(DILL,"FE")_",0)"))

               DO KILLLL^DIFGGU

               QUIT 

 +7        IF $DATA(Y)

               IF Y'=""

                   SET Z=Y

                   SET Y=""

 +8        IF $DATA(DIFGENV("LAYGO",DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD")))!($PIECE(^DD(DIFG(DILL-1,"FILE"),DIFGSB(DILL-1,"FLD"),0),U,2)'["'")

               SET DIFG(DILL,"NOKEY")=""

 +9       ; RECURSE

           DO START^DIFGGSB

 +10       QUIT