Return to DIQGU.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIQGU.m, revision 1.1

1.1     ! snw         1: DIQGU  ;SFISC/DCL-DATA RETRIEVAL INTERNAL FUNCTIONS;07:24 AM  12 May 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: DT(H)  N D,M,X,Y
        !             5:        S X=H>21608+H-.1,Y=X\365.25+141,X=X#365.25\1
        !             6:        S D=X+306#(Y#4=0+365)#153#61#31+1,M=X-D\29+1
        !             7:        Q Y_"00"+M_"00"+D
        !             8: ROOT(DIC,DA,CP,ERR)    ;
        !             9: ENROOT S ERR=$G(ERR)=1
        !            10:        N DIQGUFN,DIQGUIEN
        !            11:        S DIQGUFN=$G(DIC),DIQGUIEN=$G(DA)
        !            12:        I DIC="" D:ERR BLD^DIALOG(200) Q ""
        !            13:        N RQ
        !            14:        S RQ=$G(CP)'["Q"
        !            15:        S CP=$G(CP)'[1
        !            16:        G:$L($G(DA),",,")>1 ERR
        !            17:        D:$G(DA)["," DAIEN(DA,.DA)
        !            18:        I $G(^DIC(DIC,0,"GL"))]"" N DIQGUX S DIQGUX=^("GL") D:ERR  Q:CP DIQGUX Q $$CREF(DIQGUX)
        !            19:        .Q:$G(DIQGUIEN)'[","
        !            20:        .N X S X=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN)
        !            21:        .Q:X
        !            22:        .S (CP,DIQGUX)=""
        !            23:        .Q
        !            24:        N A,A2
        !            25:        I $D(DA)>9,$G(^DIC(+$$UP(DIC,.A),0,"GL"))]"" S DIC=^("GL"),A=$P($O(A("")),"-",2) I A>0,$D(DA(A))=1,'$O(DA(A)) D  Q:CP DIC Q $$CREF(DIC)
        !            26:        .S A="" F  S A=$O(A(A)) Q:A'<0  D
        !            27:        ..I RQ S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","_$$Q(A2)_"," Q
        !            28:        ..S A2=$P(A(A),"^",2),DIC=DIC_DA($P(A,"-",2))_","""_A2_"""," Q
        !            29: ERR    Q:'ERR ""
        !            30:        S DIQGUIEN=$$IENS^DILF(.DA)
        !            31:        S A=$$IENCHK^DIT3(DIQGUFN,DIQGUIEN) Q:'A ""
        !            32:        D BLD^DIALOG(200) Q ""
        !            33: N9(FN,DA)      Q:$G(DA)="" 0 N N9 S N9=$$ROOT($$UP(FN),"",1) Q:N9="" 0 Q:$D(@N9@(DA,-9)) 1 Q 0
        !            34: DA(Y)  Q:$D(Y)=1 Y Q Y($O(Y(""),-1))
        !            35: UP(Y,A)        N D
        !            36:        S A(0)=Y F D=0:-1 Q:'$D(^DD(+A(D),0,"UP"))  S A(D-1)=$P(^("UP"),"^")_"^"_$P($P(^DD($P(^("UP"),"^"),$O(^DD($P(^("UP"),"^"),"SB",+A(D),"")),0),"^",4),";")
        !            37:        Q $P(A($O(A(""))),"^")
        !            38: CREF(X)        ;
        !            39: ENCREF N L,X1,X2,X3 S X1=$P(X,"("),X2=$P(X,"(",2,99),L=$L(X2),X3=$TR($E(X2,L),",)"),X2=$E(X2,1,(L-1))_X3 Q X1_$S(X2]"":"("_X2_")",1:"")
        !            40: OREF(X)        ;
        !            41: ENOREF N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
        !            42: OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
        !            43: RCP(%DIQGRCP)  Q $$CREF($$R^DIQGU0(%DIQGRCP))
        !            44: Q(%Z)  S %Z(%Z)="",%Z=$Q(%Z("")) Q $E(%Z,4,$L(%Z)-1)
        !            45: DY(Y)  S %=$E(Y,4,5)*3 Q $E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" "_$S($E(Y,6,7):$J(+$E(Y,6,7),2)_", ",1:"")_($E(Y,1,3)+1700)_$S(Y[".":"@"_$E(Y_0,9,10)_":"_$E(Y_"000",11,12)_$S($E(Y,13,14):":"_$E(Y_0,13,14),1:""),1:"")
        !            46: DAIEN(IEN,DA)  ;
        !            47:        K DA
        !            48:        S DA=$P(IEN,",")
        !            49:        N I F I=2:1 Q:$P(IEN,",",I)=""  S DA(I-1)=$P(IEN,",",I)
        !            50:        Q
        !            51:        ;
        !            52: EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIOUTPUT)     ;SEA/TOAD
        !            53:        G XTRNLX^DIDU
        !            54:        ;