Annotation of freem_fileman/DIEH.m, revision 1.1

1.1     ! snw         1: DIEH   ;SFISC/DPC-HELP ;11/9/94  14:23
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: GET(DIEHF,DIEHIEN,DIEHFLD,DIEHFLG,DIEHOUT)     ;
        !             5: GETX   ;
        !             6:        N DIEHZ,DIEHD,DIEHEXIT,DIEHPF,DIEHUFLG
        !             7:        S DIEHUFLG=$G(DIEHFLG)
        !             8:        I '$G(DIQUIET) N DIQUIET S DIQUIET=1
        !             9:        I '$G(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !            10:        I $G(DIEHIEN)]"" N DA,C,D,I D DA^DIEFU(DIEHIEN,.DA) S C=$L(DIEHIEN,",")-1 F I=1:1:C S D="D"_(C-I) N @D S @D=$P(DIEHIEN,",",I)
        !            11:        S DIEHZ=$$ZERO(DIEHF,DIEHFLD) I DIEHZ=0 G GETOUT
        !            12:        S DIEHD=$P(DIEHZ,U,2)
        !            13:        D BLDFLGS G:$G(DIEHEXIT) GETOUT
        !            14:        I DIEHD["P" S DIEHPF=+$P(DIEHD,"P",2)
        !            15:        S DIHELP=+$O(^TMP("DIHELP",$J,""),-1)
        !            16:        I DIEHUFLG["F",DIEHFLD=.01 D PXREFS(DIEHF,DIEHFLD)
        !            17:        I DIEHUFLG["H" D HPROMPT(DIEHF,DIEHFLD)
        !            18:        I DIEHUFLG["X" D XHLP(DIEHF,DIEHFLD)
        !            19:        I DIEHUFLG["D" D DESCR(DIEHF,DIEHFLD)
        !            20:        I DIEHUFLG["P" D SCRNDES(DIEHF,DIEHFLD)
        !            21:        I DIEHUFLG["C" D SCRNDES(DIEHF,DIEHFLD)
        !            22:        I DIEHUFLG["T" N DIEHDT S DIEHDT=$P($P($P(DIEHZ,U,5,99),"%DT=""",2),"""",1)  D DT^DIEH1(DIEHDT)
        !            23:        I DIEHUFLG["S" D SCRNCD(DIEHF,DIEHFLD,DIEHZ)
        !            24:        I DIEHUFLG["U" D UNSCRNCD(DIEHZ)
        !            25:        I DIEHUFLG["V" D VPMSG(DIEHF,DIEHFLD)
        !            26:        I DIEHUFLG["B",DIEHUFLG'["b" D BLD^DIALOG(9115)
        !            27:        I DIEHUFLG["M" D BLD^DIALOG(9116)
        !            28:        I DIEHUFLG["G",DIEHFLG'["g",$G(DIEHPF) D FOLLOW(DIEHPF,DIEHFLG)
        !            29:        I '$G(DIHELP) K DIHELP
        !            30: GETOUT I $D(DIEHOUT) D CALLOUT^DIEFU(DIEHOUT)
        !            31:        Q
        !            32:        ;
        !            33: BLDFLGS        ;
        !            34:        N A1,A2,C1,C2,DIEHGFLG
        !            35:        S C1="HX",C2="XD",(A1,A2)=""
        !            36:        I DIEHD S DIEHF=+DIEHD,DIEHFLD=.01,DIEHD=$P(^DD(DIEHF,.01,0),U,2)
        !            37:        I DIEHD["W" S (A1,A2)="HD"
        !            38:        E  I DIEHD["D" S (A1,A2)="T"
        !            39:        E  I DIEHD["S" S A1="CS",A2="S",DIEHGFLG="U"
        !            40:        E  I DIEHD["P" S A1="PG",A2="G",DIEHGFLG="F"
        !            41:        E  I DIEHD="V" S A1="VB",A2="VMB"
        !            42:        I DIEHFLD=.01,'$D(^DD(DIEHF,0,"UP")) S A1=A1_"F",A2=A2_"F"
        !            43:        I DIEHUFLG'["r",'$$VERFLG^DIEFU(DIEHUFLG,"bgA?"_C1_C2_A1_A2_$G(DIEHGFLG)) S DIEHEXIT=1
        !            44:        I DIEHUFLG["??" S DIEHUFLG=DIEHUFLG_C2_A2
        !            45:        E  I DIEHUFLG["?" S DIEHUFLG=DIEHUFLG_C1_A1
        !            46:        E  I DIEHUFLG["A" S DIEHUFLG=$TR(C1_C2_A1_A2,"S","U")
        !            47:        Q
        !            48:        ;
        !            49: ZERO(F,D)      ;
        !            50:        I '$$VFILE^DIEFU(F,"D") Q 0
        !            51:        I '$$VFIELD^DIEFU(F,D,"D") Q 0
        !            52:        Q ^DD(F,D,0)
        !            53:        ;
        !            54: BN     ;Insert blank node.
        !            55:        S:DIHELP DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=""
        !            56:        Q
        !            57:        ;
        !            58: HPROMPT(F,D)   ;
        !            59:        N T
        !            60:        S T=$G(^DD(F,D,3))
        !            61:        I $L(T) D
        !            62:        . D BN
        !            63:        . S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=T
        !            64:        Q
        !            65:        ;
        !            66: XHLP(DIEHF,DIEHFLD)    ;
        !            67:        ;DA() and D0,D1,etc. passed thru symbol table.
        !            68:        N DIEHXH S DIEHXH=$G(^DD(DIEHF,DIEHFLD,4))
        !            69:        I $L(DIEHXH) D
        !            70:        . D BN
        !            71:        . N DIEHECNT S DIEHECNT=$G(DIERR)
        !            72:        . N DDIOLFLG S DDIOLFLG="H" X DIEHXH
        !            73:        . I DIEHECNT'=$G(DIERR) D HKERR^DILIBF(DIEHF,"",DIEHFLD,"Xecutable Help")
        !            74:        Q
        !            75:        ;
        !            76: DESCR(F,D)     ;
        !            77:        N L
        !            78:        S L=$P($G(^DD(F,D,21,0)),U,3)
        !            79:        I L D
        !            80:        . D BN
        !            81:        . N I F I=1:1:L S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=^DD(F,D,21,I,0)
        !            82:        . Q
        !            83:        Q
        !            84:        ;
        !            85: PXREFS(DIEHF,DIEHFLD)  ;
        !            86:        N DIF,DIFD,DIEHROOT,DIEHIXID,DIEHIXP,DIEHIXNM,DIFULL
        !            87:        S DIEHIXP=$$FILENM^DIEFU(DIEHF)_" "
        !            88:        D GETIXNM(DIEHF,.DIEHIXNM)
        !            89:        S DIF=""
        !            90:        F  S DIF=$O(DIEHIXNM(DIF)) Q:DIF=""  D  Q:$D(DIFULL)
        !            91:        . S DIFD=""
        !            92:        . F  S DIFD=$O(DIEHIXNM(DIF,DIFD)) Q:DIFD=""  D  Q:$D(DIFULL)
        !            93:        . . I $L(DIEHIXP)+$L(DIEHIXNM(DIF,DIFD))>240 D  Q
        !            94:        . . . S DIEHIXP=DIEHIXP_", etc     "
        !            95:        . . . S DIFULL=1
        !            96:        . . S DIEHIXP=DIEHIXP_DIEHIXNM(DIF,DIFD)_", or "
        !            97:        S DIEHIXP=$E(DIEHIXP,1,$L(DIEHIXP)-5)
        !            98:        D BLD^DIALOG(9105,DIEHIXP)
        !            99:        Q
        !           100:        ;
        !           101: GETIXNM(DIEHF,DIEHIXNM)        ;
        !           102:        S DIEHROOT=$$ROOT^DIQGU(DIEHF,"",1)
        !           103:        S DIEHIXID="Az"
        !           104:        F  S DIEHIXID=$O(@DIEHROOT@(DIEHIXID)) Q:DIEHIXID=""  D
        !           105:        . N DIEHIXF,DIEHIXFD
        !           106:        . S DIEHIXF=$O(^DD(DIEHF,0,"IX",DIEHIXID,"")) Q:DIEHIXF=""
        !           107:        . S DIEHIXFD=$O(^DD(DIEHF,0,"IX",DIEHIXID,DIEHIXF,"")) Q:DIEHIXFD=""
        !           108:        . S DIEHIXNM(DIEHIXF,DIEHIXFD)=$$FLDNM^DIEFU(DIEHIXF,DIEHIXFD)
        !           109:        Q
        !           110:        ;
        !           111: SCRNDES(F,D)   ;
        !           112:        N T
        !           113:        S T=$G(^DD(F,D,12))
        !           114:        I $L(T) D
        !           115:        . D BN
        !           116:        . S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=T
        !           117:        . Q
        !           118:        Q
        !           119:        ;
        !           120: SCRNCD(F,D,DIEHZ)      ;
        !           121:        N S,DIC,Y,A,T,I
        !           122:        I $P(DIEHZ,U,2)'["*" D UNSCRNCD(DIEHZ) Q
        !           123:        S S=$G(^DD(F,D,12.1))
        !           124:        I S="" D UNSCRNCD(DIEHZ) Q
        !           125:        D CODES
        !           126:        I $D(Y) D
        !           127:        . N DIEHECNT S DIEHECNT=$G(DIERR)
        !           128:        . X S
        !           129:        . D BLD^DIALOG(9101)
        !           130:        . F I=1:1:T D
        !           131:        . . S Y=$P(Y(I),";",1)
        !           132:        . . X DIC("S") I  D CODESOUT
        !           133:        . I DIEHECNT'=$G(DIERR) D HKERR^DILIBF(F,"",D,"set of codes screen")
        !           134:        Q
        !           135: UNSCRNCD(DIEHZ)        ;
        !           136:        N Y,A,T,I
        !           137:        D CODES
        !           138:        I $D(Y) D
        !           139:        . D BLD^DIALOG(9101)
        !           140:        . F I=1:1:T D CODESOUT
        !           141:        . Q
        !           142:        Q
        !           143:        ;
        !           144: CODES  ;
        !           145:        S A=$P(DIEHZ,U,3)
        !           146:        I A]"" D
        !           147:        . S T=$L(A,";")-1
        !           148:        . F I=1:1:T S Y(I)=$P(A,";",I)
        !           149:        . Q
        !           150:        Q
        !           151:        ;
        !           152: CODESOUT       ;
        !           153:        S DIHELP=DIHELP+1,^TMP("DIHELP",$J,DIHELP)=$P(Y(I),":",1)_"        "_$P(Y(I),":",2)
        !           154:        Q
        !           155:        ;
        !           156: VPMSG(F,D)     ;
        !           157:        N I,N,P,L
        !           158:        D BLD^DIALOG(9103)
        !           159:        S I=0 F  S I=$O(^DD(F,D,"V",I)) Q:I="B"  S N=^(I,0) D
        !           160:        . S P(1)=$P(N,U,4),P(2)=$P(N,U,2),L=$S(I=1:"",1:"S")
        !           161:        . D BLD^DIALOG(9117,.P,.P,"",L)
        !           162:        . Q
        !           163:        Q
        !           164:        ;
        !           165: FOLLOW(DIEHPF,DIEHUFLG)        ;
        !           166:        D GET(DIEHPF,"",.01,DIEHUFLG_"r")
        !           167:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>