- DICUF ;SEA/TOAD,SF/TKW-FileMan: Lookup Tools, Files ;12APR2008
- ;;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.
- ;
- ;
- FILE(DIFILE,DIFIEN,DIFLAGS) ;
- ; retrieve and calculate info about indexed file
- ;
- F1 ; set and check source file number.
- ;
- S DIFILE=+$G(DIFILE) I 'DIFILE D ERR(202,"","","","","file") Q
- ;
- F2 ; get the file's .01 definition; quit & error if bad
- ;
- N DINODE S DINODE=$G(^DD(DIFILE,.01,0))
- I DINODE="" D ERR($S('$D(^DD(DIFILE)):401,1:406),DIFILE) Q
- I $P(DINODE,U,2)["W" D ERR(407,DIFILE) Q
- ;
- F3 ; set and check the Lister's IENS parameter
- ;
- S DIFIEN=$G(DIFIEN) I DIFIEN="" S DIFIEN=","
- I '$$IEN^DIDU1(DIFIEN) D Q
- . I '$$IEN^DIDU1(DIFIEN_",") D ERR(202,"","","","","IENS") Q
- . E D ERR(304,"",DIFIEN) Q
- I $P(DIFIEN,",")'="" D ERR(306,"",DIFIEN) Q
- ;
- F4 ; calculate the source file's global root (open & closed)
- ;
- S DIFILE(DIFILE)=$$ROOT^DIQGU(DIFILE,DIFIEN,1,1) Q:$G(DIERR)
- I DIFILE(DIFILE)'?1"^"1A.ANP,DIFILE(DIFILE)'?1"^%".ANP D Q ;JIM SELF --ALLOW LC GLOBAL NAMES
- . D ERR(402,DIFILE,DIFIEN,"",DIFILE(DIFILE))
- S DIFILE(DIFILE,"O")=$$OREF^DIQGU(DIFILE(DIFILE))
- Q
- ;
- SCREEN(DIFLAGS,DIFILE,DISCREEN) ;
- ; Set user defined and whole file screen variables.
- ;
- I $G(DISCREEN("S"))="" S DISCREEN("S")=$G(DISCREEN)
- I $G(DISCREEN("V"))]"",$G(DISCREEN("V",1))']"" S DISCREEN("V",1)=DISCREEN("V")
- S DISCREEN("F")="" I DIFLAGS'["U" D
- . Q:$P($G(@DIFILE(DIFILE)@(0)),U,2)'["s"
- . S DISCREEN("F")=$G(^DD(DIFILE,0,"SCR"))
- . Q
- Q
- ;
- VPDATA(DINDEX,DISCREEN) ; Add variable pointer info to DINDEX array for executing DIC("V") type screen
- N DISUB,F,I,F1,F2,G,Y
- F DISUB=1:1:DINDEX("#") I $G(DISCREEN("V",DISUB))]"" D
- . S F1=DINDEX(DISUB,"FILE"),F2=DINDEX(DISUB,"FIELD") Q:'F1!('F2)
- . F F=0:0 S F=$O(^DD(F1,F2,"V","B",F)) Q:'F D
- . . S I=$O(^DD(F1,F2,"V","B",F,0)) Q:'I
- . . S Y(0)=$G(^DD(F1,F2,"V",I,0)) Q:Y(0)=""
- . . X DISCREEN("V",DISUB) Q:'$T
- . . S G=$G(^DIC(F,0,"GL")) Q:G=""
- . . S DINDEX(DISUB,"VP",G)="" Q
- . Q
- Q
- ;
- ERR(DIERN,DIFILE,DIIENS,DIFIELD,DIROOT,DI1,DI2,DI3) ;
- ;
- ; error logging procedure
- ;
- E1 N DIPE,P
- N DI F DI="FILE","IENS","FIELD","ROOT",1:1:3 D
- . S P=$G(@("DI"_DI)) Q:P=""
- . S DIPE(DI)=P
- D BLD^DIALOG(DIERN,.DIPE,.DIPE)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICUF 2510 printed Feb 19, 2025@00:12:56 Page 2
- DICUF ;SEA/TOAD,SF/TKW-FileMan: Lookup Tools, Files ;12APR2008
- +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 ;
- +7 ;
- FILE(DIFILE,DIFIEN,DIFLAGS) ;
- +1 ; retrieve and calculate info about indexed file
- +2 ;
- F1 ; set and check source file number.
- +1 ;
- +2 SET DIFILE=+$GET(DIFILE)
- IF 'DIFILE
- DO ERR(202,"","","","","file")
- QUIT
- +3 ;
- F2 ; get the file's .01 definition; quit & error if bad
- +1 ;
- +2 NEW DINODE
- SET DINODE=$GET(^DD(DIFILE,.01,0))
- +3 IF DINODE=""
- DO ERR($SELECT('$DATA(^DD(DIFILE)):401,1:406),DIFILE)
- QUIT
- +4 IF $PIECE(DINODE,U,2)["W"
- DO ERR(407,DIFILE)
- QUIT
- +5 ;
- F3 ; set and check the Lister's IENS parameter
- +1 ;
- +2 SET DIFIEN=$GET(DIFIEN)
- IF DIFIEN=""
- SET DIFIEN=","
- +3 IF '$$IEN^DIDU1(DIFIEN)
- Begin DoDot:1
- +4 IF '$$IEN^DIDU1(DIFIEN_",")
- DO ERR(202,"","","","","IENS")
- QUIT
- +5 IF '$TEST
- DO ERR(304,"",DIFIEN)
- QUIT
- End DoDot:1
- QUIT
- +6 IF $PIECE(DIFIEN,",")'=""
- DO ERR(306,"",DIFIEN)
- QUIT
- +7 ;
- F4 ; calculate the source file's global root (open & closed)
- +1 ;
- +2 SET DIFILE(DIFILE)=$$ROOT^DIQGU(DIFILE,DIFIEN,1,1)
- if $GET(DIERR)
- QUIT
- +3 ;JIM SELF --ALLOW LC GLOBAL NAMES
- IF DIFILE(DIFILE)'?1"^"1A.ANP
- IF DIFILE(DIFILE)'?1"^%".ANP
- Begin DoDot:1
- +4 DO ERR(402,DIFILE,DIFIEN,"",DIFILE(DIFILE))
- End DoDot:1
- QUIT
- +5 SET DIFILE(DIFILE,"O")=$$OREF^DIQGU(DIFILE(DIFILE))
- +6 QUIT
- +7 ;
- SCREEN(DIFLAGS,DIFILE,DISCREEN) ;
- +1 ; Set user defined and whole file screen variables.
- +2 ;
- +3 IF $GET(DISCREEN("S"))=""
- SET DISCREEN("S")=$GET(DISCREEN)
- +4 IF $GET(DISCREEN("V"))]""
- IF $GET(DISCREEN("V",1))']""
- SET DISCREEN("V",1)=DISCREEN("V")
- +5 SET DISCREEN("F")=""
- IF DIFLAGS'["U"
- Begin DoDot:1
- +6 if $PIECE($GET(@DIFILE(DIFILE)@(0)),U,2)'["s"
- QUIT
- +7 SET DISCREEN("F")=$GET(^DD(DIFILE,0,"SCR"))
- +8 QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- VPDATA(DINDEX,DISCREEN) ; Add variable pointer info to DINDEX array for executing DIC("V") type screen
- +1 NEW DISUB,F,I,F1,F2,G,Y
- +2 FOR DISUB=1:1:DINDEX("#")
- IF $GET(DISCREEN("V",DISUB))]""
- Begin DoDot:1
- +3 SET F1=DINDEX(DISUB,"FILE")
- SET F2=DINDEX(DISUB,"FIELD")
- if 'F1!('F2)
- QUIT
- +4 FOR F=0:0
- SET F=$ORDER(^DD(F1,F2,"V","B",F))
- if 'F
- QUIT
- Begin DoDot:2
- +5 SET I=$ORDER(^DD(F1,F2,"V","B",F,0))
- if 'I
- QUIT
- +6 SET Y(0)=$GET(^DD(F1,F2,"V",I,0))
- if Y(0)=""
- QUIT
- +7 XECUTE DISCREEN("V",DISUB)
- if '$TEST
- QUIT
- +8 SET G=$GET(^DIC(F,0,"GL"))
- if G=""
- QUIT
- +9 SET DINDEX(DISUB,"VP",G)=""
- QUIT
- End DoDot:2
- +10 QUIT
- End DoDot:1
- +11 QUIT
- +12 ;
- ERR(DIERN,DIFILE,DIIENS,DIFIELD,DIROOT,DI1,DI2,DI3) ;
- +1 ;
- +2 ; error logging procedure
- +3 ;
- E1 NEW DIPE,P
- +1 NEW DI
- FOR DI="FILE","IENS","FIELD","ROOT",1:1:3
- Begin DoDot:1
- +2 SET P=$GET(@("DI"_DI))
- if P=""
- QUIT
- +3 SET DIPE(DI)=P
- End DoDot:1
- +4 DO BLD^DIALOG(DIERN,.DIPE,.DIPE)
- +5 QUIT
- +6 ;