Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICQ1

DICQ1.m

Go to the documentation of this file.
  1. DICQ1 ;SFISC/GFT,TKW - HELP FOR LOOKUPS ;01MAR2016
  1. ;;22.2;VA FileMan;**2,20**;Jan 05, 2016;Build 2
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. EN ; Set up parameters for lister call, then display current entries.
  1. I 'DIRECUR,'$D(DDS) D Z^DDSU
  1. I DICNT>1,$D(DZ)#2 S DST=" " D:DZ["??"&'$D(DDS) %^DICQ S DST=$$EZBLD^DIALOG(8068) D %^DICQ
  1. N DISCR S:$G(DIC("S"))]"" DISCR("S")=DIC("S")
  1. I $D(DIC("V")) M DISCR("V")=DIC("V")
  1. S %=$G(DIC("?PARAM",DIFILEI,"INDEX")) I %]"" D
  1. . S (DIX,DIBEGIX)=%,DIX("WAY")=1 D INDEX^DICUIX(.DIFILEI,"hl",.DIX) Q
  1. I $O(DIC("?PARAM",DIFILEI,"PART",0)) S DIPART(1)="",%=0 D
  1. . F S %=$O(DIC("?PARAM",DIFILEI,"PART",%)) Q:'% I '(%#1) S DIPART(%)=DIC("?PARAM",DIFILEI,"PART",%)
  1. . S DIPART=DIPART(1) Q
  1. N DIFLAGS,DIFIELDS,DIIENS S DIFLAGS="MPh"
  1. I 'DIUPRITE,"PV"[$G(DIX(1,"TYPE")) D
  1. . N DIFRPRT S DIFRPRT=DIFROM_$G(DIC("?PARAM",DIFILEI,"FROM",1))_$G(DIPART)
  1. . Q:'$$CHKP^DICUIX1(.DIFILEI,.DIX,DDC,DIFRPRT,.DISCR,1)
  1. . S DIFLAGS="MPQh" K DIFROM S DIFROM="" Q
  1. I DIUPRITE S DID01=0,DIBEGIX="#"
  1. S DIIENS=$S(DIC(0)["p":",",1:DIENS)
  1. W S DIFIELDS="@;IX" D
  1. .I 'DIUPRITE,DID01!(DIC(0)["S") K DID01 Q
  1. .N EXT S EXT="$$EXT^DIC2("_DIFILEI_",.01,$P("_DIC_"Y,0),U))"
  1. .I '$D(DDS)!'$D(DDSMOUSY) S DIC("DID01")="W "" "","_EXT Q
  1. .S DIC("DID01")="W "" "" D WRITMOUS^DDSU("_EXT_")"
  1. E1 K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
  1. I $D(DDH)>10 D LIST^DDSU Q:$D(DDSQ)
  1. I DIFROM]"" D S DIFROM(1)=DIFROM
  1. . I +$P(DIFROM,"E")=DIFROM S DIFROM=DIFROM-.00000001 Q
  1. . N M F %=$L(DIFROM):-1:1 S M=$A(DIFROM,%) I M>32 S DIFROM=$E(DIFROM,1,%-1)_$C(M-1)_$C(122) Q
  1. . Q
  1. I DIFLAGS'["Q" S %=$G(DIC("?PARAM",DIFILEI,"FROM",1)) I %]"" D
  1. . S:DIFROM="" (DIFROM,DIFROM(1))=% S %=1
  1. . F S %=$O(DIC("?PARAM",DIFILEI,"FROM",%)) Q:'% I '(%#1) S DIFROM(%)=DIC("?PARAM",DIFILEI,"FROM",%)
  1. . Q
  1. ;
  1. L ; List current entries in the file.
  1. N DICQ
  1. D LIST^DICL(.DIFILEI,DIIENS,DIFIELDS,DIFLAGS,DDC,.DIFROM,.DIPART,DIBEGIX,.DISCR,"","DICQ","",.DIC)
  1. K DIC("DID01"),DICQ
  1. D BK^DIEQ S:'$D(DDS) DDD=3 ;D LIST^DDSU ***
  1. K DDH Q:$D(DDSQ)!($G(DTOUT))
  1. D 0 Q
  1. ;
  1. DSP(DINDEX,DICQ,DIC,DIFILE) ; Display entries from DICQ array
  1. ; note: this routine is called from the lister, DICLIX & DICL1.
  1. N I,J,F,X,Y,DD,DDD,DIY,DILN,DIZ,DIMAP,DDH,DID01,DIQUIET,DIPGM,DST,DISPACE,DIERR,DP
  1. S DIMAP=$G(DICQ(0,"MAP")),DDH=0,DST="",DIPGM="DICQ1",$P(DISPACE," ",10)=""
  1. S:$G(DIC("DID01"))]"" DID01=DIC("DID01")
  1. N DIKEYL,DIKEY I $O(DIFILE(DIFILE,"KEY",DIFILE,0)),DIC(0)'["S" M DIKEYL=DIFILE(DIFILE,"KEY",DIFILE)
  1. I $D(DIC("W"))!($D(DID01))!($D(DIKEYL)) D ID
  1. F I=0:0 S I=$O(DICQ(I)) Q:'I S X=$G(DICQ(I,0)) I X]"" D
  1. . S DST=""
  1. . I DINDEX="#" S DST=$P(X,U)_" " S:$L(DST)<7 DST=DST_$E(DISPACE,($L(DST)+1),7)
  1. . I $D(DIKEYL) S DIKEY(+X)="" F J=0:0 S J=$O(DIKEYL(J)) Q:'J!$G(DIERR) F F=0:0 S F=$O(DIKEYL(J,F)) Q:'F!$G(DIERR) D
  1. . . I (F=.01&($D(DID01))!(DINDEX("FLISTD")[("^"_F_"^"))) D Q
  1. . . . S:DIKEY(+X)="" DIKEY(+X)=" " Q
  1. . . S Y=$$GET1^DIQ(DIFILE,+X_DIFILE(DIFILE,"KEY","IEN"),F,"","","DIERR") Q:$G(DIERR)
  1. . . I ($L(DIKEY(+X)))+($L(Y))+2>240 S DIERR=1 Q
  1. . . S DIKEY(+X)=DIKEY(+X)_$P(" ^",U,DIKEY(+X)]"")_Y Q
  1. . F J=2:1 Q:$P(DIMAP,U,J)="" S Y=$P(X,U,J) D:$P(DIMAP,U,J+1)]"" S:$L(DST_Y)<240 DST=DST_Y
  1. . . S Y=Y_" "
  1. . . I J=(DINDEX("#")+1) S Y=Y_" "
  1. . . Q
  1. . I DST]"" S Y=+X,DDH=DDH+1,DDH(DDH,Y)=DST_" "
  1. . Q
  1. S DD="",DIY=99,DDD=5,DP=DIFILE
  1. I '$G(DIC("?N",DIFILE)) S (DIZ,DILN)=21
  1. E S (DIZ,DILN)=999
  1. D LIST^DDSU K DICQ
  1. K DIERR,^TMP("DIERR",$J)
  1. Q
  1. ;
  1. ID ; Put code to display .01 field and Identifiers into DDH array.
  1. S DIY="I $D("_DIC_"Y,0))" I $D(DID01) S DIY=DIY_" "_DID01_" "_DIY
  1. I $D(DIKEYL) S:$D(DID01) DIY=DIY_" W "" """ S DIY=DIY_" W DIKEY(Y)"
  1. I '$D(DIC("W")) S DDH("ID")=DIY Q
  1. S DIY=DIY_" "
  1. I $L(DIC("W"))+$L(DIY)<240 S DDH("ID")=DIY_DIC("W") Q
  1. S DDH("ID")=DIY_"X DDH(""ID"",1)" S DDH("ID",1)=DIC("W") Q
  1. ;
  1. WOV N DIC,Y,DI1X,DIY,DIYX,%,C,DINAME S DIC=DIGBL,Y=DIEN,DI1X=0
  1. W1 F S DI1X=$O(^DD(DIFILEI,0,"ID",DI1X)) Q:DI1X="" S %=^(DI1X) D
  1. . X "W "" "",$E("_DIGBL_DIEN_",0),0)",%
  1. Q
  1. ;
  1. 0 ; If LAYGO allowed, display additional help.
  1. K DDC,DIEQ,DIW,DS I DIC(0)'["L" D QQ Q
  1. I $D(%Y)#2 S:%Y="??" DZ=%Y S:%Y?1P DZ="?"
  1. S DDH=+$G(DDH) N A1,DIACCESS S DIACCESS=1
  1. I $S($D(DLAYGO):DIFILEI\1-(DLAYGO\1),1:1),DUZ(0)'="@",'$D(^DD(DIFILEI,0,"UP")) D CHKACC ;p20 change DIFILEI
  1. I '$G(DIACCESS) D RCR Q
  1. 10 ; Tell user that they may enter new entries to the file
  1. I DZ?1."?" S DST=" " D DS^DIEQ S DST=$$EZBLD^DIALOG(8069,$P(DO,U)) D DS^DIEQ D:DZ="?" HP
  1. D H
  1. I DO(2)["S" S DST=$$EZBLD^DIALOG(8068)_" " D %^DICQ D
  1. . N X,Y,I,A2,DST,DISETOC,DIMAXL,DIC
  1. . ; Build list of selectable codes into DISETOC for online help.
  1. . ; If set-of-codes field has a screen, execute it.
  1. . S DIMAXL=0,DISETOC=""
  1. . I $G(^DD(+DO(2),.01,12.1))]"" X ^(12.1)
  1. . S X=$P(^DD(+DO(2),.01,0),U,3),I=+$P($P(^(0),U,2),"t",2) I X="",I S X=$$PROP4TYP^DIETLIBF("SET OF CODES",I)
  1. . I '$D(DIC("S")) S DISETOC=X
  1. . E F I=1:1 S Y=$P($P(X,";",I),":") Q:Y="" X DIC("S") I $T S DISETOC=DISETOC_$P(X,";",I)_";"
  1. . K DIC("S")
  1. . F X=1:1 S Y=$P($P(DISETOC,";",X),":") Q:Y="" S:$L(Y)>DIMAXL DIMAXL=$L(Y)
  1. . S DIMAXL=DIMAXL+4
  1. . F X=1:1 S Y=$P(DISETOC,";",X) Q:Y="" S A2="",$P(A2," ",DIMAXL-$L($P(Y,":")))=" ",DST=" "_$P(Y,":")_A2_$P(Y,":",2) D DS^DIEQ
  1. . Q
  1. I DO(2)["V" D
  1. . N DG,DU,D
  1. . S DU=+DO(2),D=.01 D V^DIEQ Q
  1. ;
  1. RCR ; Recursive call to display entries on pointed-to file.
  1. I DO(2)'["P"!($G(DZ(1))=0) D QQ Q
  1. N %,D,DS,DIPTRIX S D=""
  1. S DS=^DD(+DO(2),.01,0)
  1. S DIPTRIX=$G(DIC("PTRIX",+DO(2),.01,+$P($P(DS,U,2),"P",2)))
  1. M %=DIC("PTRIX"),%(1)=DIC("?N"),%(2)=DIC("?PARAM")
  1. N DIC M DIC("PTRIX")=%,DIC("?N")=%(1),DIC("?PARAM")=%(2) K %
  1. S DIC=U_$P(DS,U,3),DIC(0)=$E("L",$P(DS,U,2)'["'")
  1. I $P(DS,U,2)["*" D
  1. . N DILCV,DICP,DIPTRIX,DISAV0 S DISAV0=DIC(0)
  1. . F DILCV=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S DICP=$F(DS,DILCV) I DICP D S DIC(0)=DISAV0
  1. . . X $P($E(DS,1,DICP-$L(DILCV)-1),U,5,99) Q
  1. . S D=$P($G(D),U) Q
  1. S:DIPTRIX]"" D=$P(DIPTRIX,U) K DIPTRIX,DS
  1. N DO,DIFILEI,DINDEX I D="" S D="B"
  1. S DIRECUR=DIRECUR+1
  1. D DQ^DICQ
  1. QQ Q:$D(DDH)'>10
  1. K DDD S DD="",DIY=99,DDD=$S($D(DDS):1,1:5),(DIZ,DILN)=21
  1. S:$D(DDS) DDC=-1 D LIST^DDSU K DDC Q
  1. ;
  1. HP N DG,X,%,DST
  1. EGP S X=$$HELP^DIALOGZ(+DO(2),.01) D S X=$G(^DD(+DO(2),.01,12)) D ;**CCO/NI PLUS NEXT LINE WRITE HELP MESSAGE FOR .01 FIELD
  1. .I X]"" F %=$L(X," "):-1:1 I $L($P(X," ",1,%))<70 S DST=$P(X," ",1,%) D DS^DIEQ,P1 Q
  1. Q
  1. ;
  1. P1 I %'=$L(X," ") S DST=$P(X," ",%+1,99) D DS^DIEQ
  1. Q
  1. ;
  1. H ; Display eXecutable help and long description for .01 field.
  1. N %,X,DIPGM S %=DIC,X=DZ,DIPGM="DICQ1" D
  1. . N DIC,D,DP,DIFILEI,DINDEX,DZ S DZ=X
  1. . S DIC=%,D=.01,DP=+DO(2) D H^DIEQ Q
  1. Q
  1. ;
  1. CHKACC ;Check file access
  1. N A1,DIFILE,DIAC,% S DIFILE=+DO(2),DIAC="LAYGO",%=0 D ^DIAC
  1. S:% DIACCESS=1 Q
  1. ;
  1. ;#8069 You may enter a new |filename|, if you wish
  1. ;#8068 Choose from