- DICL10 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 2 ;5/21/98 15:27
- ;;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.
- ;
- POINT(DIFILE,DIFLAGS,DINDEX,DIDENT,DIEN,DIFIEN,DISCREEN,DILIST) ;
- ; save off the primary file info, follow the ptr chain to the end
- S DIFLAGS=DIFLAGS_"p"
- N DIVPTR,DIF S DIVPTR=$S(DINDEX(1,"TYPE")="V":1,1:0)
- M DIF=DIFILE N DIFILE M DIFILE=DIF K DIF
- D FOLLOW^DICL3(.DIFILE,"",DINDEX(1,"NODE"),1,0,"",DINDEX(1,"FIELD"),DINDEX(1,"FILE"),DIVPTR,1,.DISCREEN)
- D SETB^DICL3
- N DIX1 S DIX1="B"
- S DIX1("WAY")=DINDEX("WAY")
- N DIFROM S DIFROM(1)=$G(DINDEX(1,"FROM")),DIFROM("IEN")=""
- N DIPART S DIPART(1)=$G(DINDEX(1,"PART"))
- S DIFILE("STACK")=1_U_DIFILE("STACKEND",1)
- S DIFILE=$P(DIFILE("STACK"),U,3)
- D INDEX^DICUIX(.DIFILE,.DIFLAGS,.DIX1,.DIFROM,.DIPART)
- I $G(DINDEX(1,"USE")) S DIX1(1,"USE")=1
- N I F I="FIELD","FILE","FROM","GET","TYPE" K DIX1(1,I)
- K DIX1("FLIST")
- P1 ; no variable pointers in pointer chain
- I '$O(DIFILE("STACKEND",1)) D Q
- . D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,"",.DIC)
- . Q
- P2 ; variable pointer(s) in pointer chain
- N DIXV
- S DIFLAGS=DIFLAGS_"v",DIFILE("STACK")=""
- S I=0 F S I=$O(DIFILE("STACKEND",I)) Q:'I D
- . N DIXNAME,DISUB,R S DIXNAME="DIXV("_I_")",DISUB=DIX1(1)
- . N DIFL,DIGL S DIFL=+$P(DIFILE("STACKEND",I),U,2),DIGL=DIFILE(DIFL,"O")
- . S @DIXNAME@(1)=DISUB,@DIXNAME@(1,"MORE?")=DIX1(1,"MORE?"),@DIXNAME@(2)=""
- . S R=DIGL_"DINDEX"
- . S @DIXNAME@(1,"ROOT")=R_")",@DIXNAME@(2,"ROOT")=R_",DINDEX(1))"
- . I $G(DINDEX(1,"USE")),DISUB'="" D
- . . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB),-DIX1(1,"WAY"))
- . . S @DIXNAME@(1)=DISUB
- . . Q
- . S R=DIGL_"""B"")",DISUB=$O(@R@(DISUB)),@DIXNAME@(1,"NXTVAL")=DISUB
- . I DISUB="" K @DIXNAME,DIFILE("STACKEND",I) Q
- . Q:DIFILE("STACK")
- . S DIFILE("STACK")=I_U_DIFILE("STACKEND",I)
- . Q
- K DIX1(1,"USE")
- I +DIFILE("STACK")=1 S DIX1(1)=DIXV(1,1)
- E S I="DIXV("_+DIFILE("STACK")_")" M DIX1=@I
- D WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,.DIXV,.DIC)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICL10 2345 printed Jan 18, 2025@03:47:08 Page 2
- DICL10 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup: Lister, Part 2 ;5/21/98 15:27
- +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 ;
- POINT(DIFILE,DIFLAGS,DINDEX,DIDENT,DIEN,DIFIEN,DISCREEN,DILIST) ;
- +1 ; save off the primary file info, follow the ptr chain to the end
- +2 SET DIFLAGS=DIFLAGS_"p"
- +3 NEW DIVPTR,DIF
- SET DIVPTR=$SELECT(DINDEX(1,"TYPE")="V":1,1:0)
- +4 MERGE DIF=DIFILE
- NEW DIFILE
- MERGE DIFILE=DIF
- KILL DIF
- +5 DO FOLLOW^DICL3(.DIFILE,"",DINDEX(1,"NODE"),1,0,"",DINDEX(1,"FIELD"),DINDEX(1,"FILE"),DIVPTR,1,.DISCREEN)
- +6 DO SETB^DICL3
- +7 NEW DIX1
- SET DIX1="B"
- +8 SET DIX1("WAY")=DINDEX("WAY")
- +9 NEW DIFROM
- SET DIFROM(1)=$GET(DINDEX(1,"FROM"))
- SET DIFROM("IEN")=""
- +10 NEW DIPART
- SET DIPART(1)=$GET(DINDEX(1,"PART"))
- +11 SET DIFILE("STACK")=1_U_DIFILE("STACKEND",1)
- +12 SET DIFILE=$PIECE(DIFILE("STACK"),U,3)
- +13 DO INDEX^DICUIX(.DIFILE,.DIFLAGS,.DIX1,.DIFROM,.DIPART)
- +14 IF $GET(DINDEX(1,"USE"))
- SET DIX1(1,"USE")=1
- +15 NEW I
- FOR I="FIELD","FILE","FROM","GET","TYPE"
- KILL DIX1(1,I)
- +16 KILL DIX1("FLIST")
- P1 ; no variable pointers in pointer chain
- +1 IF '$ORDER(DIFILE("STACKEND",1))
- Begin DoDot:1
- +2 DO WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,"",.DIC)
- +3 QUIT
- End DoDot:1
- QUIT
- P2 ; variable pointer(s) in pointer chain
- +1 NEW DIXV
- +2 SET DIFLAGS=DIFLAGS_"v"
- SET DIFILE("STACK")=""
- +3 SET I=0
- FOR
- SET I=$ORDER(DIFILE("STACKEND",I))
- if 'I
- QUIT
- Begin DoDot:1
- +4 NEW DIXNAME,DISUB,R
- SET DIXNAME="DIXV("_I_")"
- SET DISUB=DIX1(1)
- +5 NEW DIFL,DIGL
- SET DIFL=+$PIECE(DIFILE("STACKEND",I),U,2)
- SET DIGL=DIFILE(DIFL,"O")
- +6 SET @DIXNAME@(1)=DISUB
- SET @DIXNAME@(1,"MORE?")=DIX1(1,"MORE?")
- SET @DIXNAME@(2)=""
- +7 SET R=DIGL_"DINDEX"
- +8 SET @DIXNAME@(1,"ROOT")=R_")"
- SET @DIXNAME@(2,"ROOT")=R_",DINDEX(1))"
- +9 IF $GET(DINDEX(1,"USE"))
- IF DISUB'=""
- Begin DoDot:2
- +10 SET R=DIGL_"""B"")"
- SET DISUB=$ORDER(@R@(DISUB),-DIX1(1,"WAY"))
- +11 SET @DIXNAME@(1)=DISUB
- +12 QUIT
- End DoDot:2
- +13 SET R=DIGL_"""B"")"
- SET DISUB=$ORDER(@R@(DISUB))
- SET @DIXNAME@(1,"NXTVAL")=DISUB
- +14 IF DISUB=""
- KILL @DIXNAME,DIFILE("STACKEND",I)
- QUIT
- +15 if DIFILE("STACK")
- QUIT
- +16 SET DIFILE("STACK")=I_U_DIFILE("STACKEND",I)
- +17 QUIT
- End DoDot:1
- +18 KILL DIX1(1,"USE")
- +19 IF +DIFILE("STACK")=1
- SET DIX1(1)=DIXV(1,1)
- +20 IF '$TEST
- SET I="DIXV("_+DIFILE("STACK")_")"
- MERGE DIX1=@I
- +21 DO WALK^DICLIX(DIFLAGS,.DIX1,.DIDENT,.DIFILE,.DIEN,.DIFIEN,.DISCREEN,.DILIST,.DINDEX,.DIXV,.DIC)
- +22 QUIT
- +23 ;