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 Oct 16, 2024@18:47:15 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 ;
