Return to DIQ.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIQ.m, revision 1.1

1.1     ! snw         1: DIQ    ;SFISC/GFT-CAPTIONED TEMPLATE ;10/4/94  11:30
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        G INQ^DII
        !             5:        ;
        !             6: GET1(DIQGR,DA,DR,DIQGPARM,DIQGETA,DIQGERRA,DIQGIPAR)   ;Extrinsic Function
        !             7:        ; file,record,field,parm,targetarray,errortargetarray,internal
        !             8:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
        !             9:        I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !            10:        G DDENTRY^DIQG
        !            11:        ;
        !            12: GETS(DIQGR,DA,DR,DIQGPARM,DIQGTA,DIQGERRA,DIQGIPAR)    ;Procedure Call
        !            13:        ; file,record,field,parm,targetarray,errortargetarray,internal
        !            14:        I '$D(DIQUIET) N DIQUIET S DIQUIET=1
        !            15:        I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
        !            16:        D DDENTRY^DIQGQ
        !            17:        I $G(DIQGQERR)]"" S DIERR=DIQGQERR
        !            18:        D:$G(DIQGERRA)]"" CALLOUT^DIEFU(DIQGERRA)
        !            19:        Q
        !            20:        ;
        !            21:        ;
        !            22: GUY    S:'$D(DTIME) DTIME=300 K DTOUT,DUOUT,DIRUT,DIR
        !            23:        S D0=DA,D=DIC_DA_",",DL=1 S:$S('$D(S)#2:1,1:'S) S=3 I '$D(DIQS) W !
        !            24:        E  S Z=0,A=0 F  S @("Z=$O("_DIQS_"Z))") Q:Z=""  S @(DIQS_"Z)=""""")
        !            25:        E  S Z=-1
        !            26:        I $D(DX(0))[0 S DX(0)="Q" I $D(IOST)#2,IOST?1"C".E S DX(0)="S S=S+1 I S>22 N X,Y S DIR(0)=""E"" D ^DIR K DIR W ! S S=$S($D(DIRUT):0,1:1)"
        !            27: 1      I $D(DIQS) S Z=0,A=0 F  S @("Z=$O("_DIQS_"Z))") S:Z="" Z=-1 S A=$O(^DD(DD,"B",Z,0)) S:A="" A=-1 Q:Z<0  I $D(^DD(DD,A,0)) S C=$P(^(0),U,2) I C["C" D COM S @(DIQS_"Z)=X")
        !            28:        I N<0,$D(^DD(DD,.001,0)) S W=.001,A=-1,Y=@("D"_(DL\2)) G W
        !            29:        I $G(DIQ(0))["R",N<0,(DL\2)=0 S W=.001,A=-1,O="NUMBER",Y=D0 G W2
        !            30: N      S @("N=$O("_D_"N))") S:N="" N=-1 I DL=1,@E D LF D:$D(DIQ(0)) ^DIQ1:DIQ(0)["C" G Q
        !            31:        I $D(^(N))#2 S Z=^(N),A=-1 G NS
        !            32:        I N<0 S DL=DL-1 G B
        !            33:        I DL#2 S Z=$O(^DD(DD,"GL",N,0,0)) S:Z="" Z=-1 G N:Z<0 S O=0,X=+$P(^DD(DD,Z,0),"^",2) X:$D(DICS) DICS E  G N
        !            34:        E  G N:N'>0 S X=DD,O=-1,@("D"_(DL\2)_"=N") D LF Q:'S  I $D(DSC(X)) X DSC(X) E  G N
        !            35:        S DD(DL)=DD,D(DL)=D,N(DL)=N,DL=DL+1 S:+N'=N N=""""_N_"""" S D=D_N_",",N=O,DD=X G 1:DL#2,N
        !            36:        ;
        !            37: B      I $D(DIQ(0)),DIQ(0)["C",'(DL#2) D ^DIQ1
        !            38:        S N=N(DL),D=D(DL),DD=DD(DL) D LF Q:'S  G N
        !            39:        ;
        !            40: DIQS   S @(DIQS_"O)=Y")
        !            41: NS     S A=$O(^DD(DD,"GL",N,A)) S:A="" A=-1 G N:A<0
        !            42:        S W=$O(^(A,0)) S:W="" W=-1 I A S Y=$P(Z,"^",A) G W:Y]"",NS
        !            43:        S Y=$E(Z,+$E(A,2,9),$P(A,",",2)) G NS:Y?." "
        !            44: W      S O=$P(^DD(DD,W,0),"^"),C=$P(^(0),"^",2) I $D(DICS) X DICS E  G NS
        !            45:        I C["W",'$D(DIQS) D DIQ^DIWW G:$D(DN) Q:'DN S DL=DL-2 G B
        !            46:        D Y I $D(DIQS) G @("DIQS:$D("_DIQS_"O))"),NS:'$D(^(W)) S O=W G DIQS
        !            47: W2     I $X'<40!($L(O)+$L(Y)>38) S O=$E(O,1,253-$L(Y))
        !            48:        S O=O_": "_Y I  D LF Q:'S
        !            49:        W:$X ?40 W:W'?1"."1.2"0"1"1" ?2 W O G NS
        !            50:        ;
        !            51: Y      I C["O",$D(^(2)) X ^(2) Q  ;NAKED REFERENCE IS TO ^DD(FILE#,FIELD#,0)
        !            52: S      I C["S" S C=";"_$P(^(0),U,3),%=$F(C,";"_Y_":") S:% Y=$P($E(C,%,999),";",1) Q
        !            53:        I C["P",$D(@("^"_$P(^(0),U,3)_"0)")) S C=$P(^(0),U,2) Q:'$D(^(+Y,0))  S Y=$P(^(0),U) I $D(^DD(+C,.01,0)) S C=$P(^(0),U,2) G S
        !            54:        I C["V",+Y,$D(@("^"_$P(Y,";",2)_"0)")) S C=$P(^(0),U,2) Q:'$D(^(+Y,0))  S Y=$P(^(0),U) I $D(^DD(+C,.01,0)) S C=$P(^(0),U,2) G S
        !            55:        Q:C'["D"  Q:'Y
        !            56: D      ;S %=$E(Y,4,5)*3,Y=$S(%:$E("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC",%-2,%)_" ",1:"")_$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:"") Q
        !            57:        S Y=$$FMTE^DILIBF(Y,"1U") Q
        !            58:        ;
        !            59: DT     D D:Y W Y Q
        !            60: H      G H^DIO2
        !            61:        ;
        !            62: LF     I '$D(DIQS),$X W ! X DX(0)
        !            63:        Q
        !            64: EN1    S DRX=DR
        !            65: EN2    S DR=$P(DRX,";",1),DRX=$P(DRX,";",2,999) D EN W ! G EN2:DRX]""&S
        !            66:        K DRX Q
        !            67: EN     ;
        !            68:        S S=0
        !            69:        I '$D(IOST)!'$D(IOSL)!'$D(IOM) S IOP="HOME" D ^%ZIS Q:POP
        !            70:        G Q:'$D(@(DIC_"0)")) S U="^",DD=+$P(^(0),U,2),DK=DD
        !            71:        I '$D(DR) S N=-1,O=""
        !            72:        E  S N=$P(DR,":"),N=$S(0[N:-1,+N=N:N-.000001,1:$E(N,1,$L(N)-1)_$C($A(N,$L(N))-1)),O=$P(DR,":",DR[":"+1) G EN1:DR[";"
        !            73:        S E="N<0" I O]"" S E=E_"!(N]"""_$S(+O=O:"?"")!(N>"_O_")",1:O_""")")
        !            74:        D GUY S DA=D0 I $D(DIQ(0)),DIQ(0)["A" D AUD^DII
        !            75: Q      K C,O,W,N,E,Z,D,DD,IOP Q
        !            76:        ;
        !            77: COM    X $P(^(0),U,5,99) S C=$P($P(C,"J",2),",",2) I C?1N.E,X S X=$J(X,0,C)