DIFGGSB2 ;SFISC/DG,EDE(OHPRD)- ;6/19/92 9:28 AM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFGGSB2 2102 printed Apr 09, 2024@21:43:43 Page 2
DIFGGSB2 ;SFISC/DG,EDE(OHPRD)- ;6/19/92 9:28 AM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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
