Return to DID.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DID	;SFISC/XAK-LIST DD'S ;10:11 AM  16 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	D KL,L^DICRW1 I $D(DIC) S (DUB,DIB,DFF)=+Y G O:Y'=+DIB(1),SUB
KL	K DIS,DIJS,DHIT,DIB,DINM,DIDX,DIGR,DIDH,BY,DICMX,DIOEND,FLDS
	K DFF,DIFF,DID,DUB,DHD,DIC,DICS,POP,DA,DR,S,F,J,K,Z,W,X,Y,M,G,N,I
	K DIWF,DIPP,DPP,DIMS,DIPQ,DJ,DDL1,DDL2,DDL3,DDLF,DDN1,X1,DDRG,I1 Q
	;
SUB	S DIC="^DD("_+Y_"," G O:$O(^DD(+Y,"SB",0))'>0 S DIC(0)="AEQZ",DIC("A")="      Select SUB-FILE: ",DIC("S")="I $P(^(0),U,2)" D ^DIC G KL:$D(DTOUT) I Y>0 S (DFF,Y)=+$P(Y(0),U,2) G SUB
	G KL:X[U
O	K DIC S:DFF-DUB DIC("S")="I Y-5" S DIC="^DOPT(""DID"",",DIC(0)="AEQ",DIC("B")=1 D ^DIC G KL:Y<0
O1	K DIC S DIC="^DD(DFF,"
	I +Y=3 S DIS(0)="I $D(^DD(DFF,D0,0))",DIOEND="G L^DIDC",DIOBEG="S L=0 I $D(DQI),DQI,$D(^UTILITY($J,2)) S ^(1.5)=""W $O(^DD(DIB,0,""""NM"""",0))_"""" FILE """""",^(2)=""X ^(1.5) ""_^(2)" D EN^DIP G KL
	I +Y=4,'$D(DIFORMAT) D MOD^DID2 G KL:X[U
	S L=0,FLDS="",BY="@.001" I +Y=5 S (FR,TO)=.01,DHIT="S F(1)=DUB",DHD="W """" D H1^DIDG",DIOEND="D T^DID" G G
	S DHIT="D ^DID1",DHD="W """" D ^DIDH",(FR,TO)="",DIOEND="D END^DID"
	I +Y=6 S DHIT="D ^DIDG",DIOEND="D END^DIDG"
	I +Y=2 S DHIT="D ^DIDX",DIDX=0,%=2 I '$D(DIFORMAT) D AH^DIDX Q:%<1
	I +Y=7 S DHIT="S (X1,X2)=DFF D ^DIDC",DHD="@" S DIOEND="D IOF^DID"
G	Q:DIB=0  S DIOEND(1)=DIOEND,DIOEND="D LOOP^DID" D EN1^DIP G KL
LOOP	I $D(Y),Y=U Q
	X DIOEND(1) I $D(M),M=U Q
	I IOST?1"C-".E W $C(7) R X:DTIME I X[U!'$T Q
	S DN=1,D0=0,DIB=$O(^DIC(+DIB)) Q:DIB>DIB(1)!(+DIB'=DIB)  S (F(1),DUB,DFF)=DIB,DC="," D ^DIO2 I $D(M),M=U Q
	G LOOP
	;
END	;
	I $D(^UTILITY($J,"P")) W !!!?6,"FILES POINTED TO",?44,"FIELDS",! D PTR^DIDC
D	K ^UTILITY($J,"P") G IOF:DHIT["DIDX"
T	;
	S S=0,M=1
T1	S S=S+1 D:$Y+3>IOSL HDR^DIDG Q:M=U
	W !!,$S(S<4:$P("INPU^PRIN^SOR",U,S)_"T TEMPLATE(S):",1:"FORM(S)/BLOCK(S):")
	S DFF="^DI"_$P("E^PT^BT^ST(.403)",U,S),DA=""
	F  S DA=$O(@DFF@("F"_F(1),DA)) Q:DA=""  D  Q:M=U
	. S DUB=0 F  S DUB=$O(@DFF@("F"_F(1),DA,DUB)) Q:'DUB  D  Q:M=U
	.. I $D(@DFF@(DUB,0))#2 S %1=^(0) D TEMPL
	K %1 G Q:M=U,T1:S<4
IOF	W:IOST'?1"C".E @IOF Q
	;
TEMPL	I $Y+3>IOSL D HDR^DIDG Q:M=U
	W !,$P(%1,U),?30 G:DFF["DIST" FORM
	S W="",Y=$P(%1,U,2) I Y D DD^%DT W Y
	W ?50,"USER #"_+$P(%1,U,5),?61 I $D(@(DFF_"(DUB,""ROU"")")) W ^("ROU")_$P("*",U,DFF["DIBT")_" "
	I $D(^("H")) S Y=^("H"),%=$L(Y) W:65+%>IOM ! W "   ",?IOM-%-1,$E(Y,1,IOM-4)
	G DES:DFF'="^DIBT"
	I $D(^("DIPT")) W ?55 S Y=" '"_^("DIPT")_"' Print Template always used" W:$X+$L(Y)>IOM ! W ?IOM-$L(Y)-1,Y
	I $D(^(2)) S D0=DUB,DICMX="W !?4,X" X $P(^DD(.401,1620,0),U,5,99)
	F Y=1:1 Q:'$D(^DIBT(DUB,"O",Y,0))  W "  " S %=^(0),D=IOM-$L(%)-5 W:$X>D !?$S(D>55:55,1:D) W %
DES	N A1,%1,X S A1=$P($G(@(DFF_"(DUB,""%D"",0)")),U,3) F %1=0:0 S %1=$O(@(DFF_"(DUB,""%D"",%1)")) Q:%1'>0  Q:+A1&(%1>A1)  S X=^(%1,0) W !,?5,X
Q	W:DFF["DIBT" ! Q
DT	G DT^DIO2
	;
EN	;
	Q:'$D(DIC)  I 'DIC,$D(@(DIC_"0)")) S DIC=+$P(^(0),U,2)
	Q:'DIC!'$D(^DIC(DIC,0,"GL"))  S (DFF,DUB,DIB,DIB(1))=DIC
	G O:'$D(DIFORMAT) S Y=DIFORMAT I 'Y S Y=$O(^DOPT("DID","B",Y,0))
	Q:Y>7!'Y  G O1
	;
FORM	;
	S Y=$P(%1,U,5) I Y D DD^%DT W ?30,Y
	W ?50,"USER #"_+$P(%1,U,4)
	;
	N B,L,P
	S L=1,L(1)=U
	S P=0 F  S P=$O(^DIST(.403,DUB,40,P)) Q:'P  D  Q:M=U
	. Q:$D(^DIST(.403,DUB,40,P,0))[0  S B=$P(^(0),U,2) D:B BLOCK  Q:M=U
	. S B=0 F  S B=$O(^DIST(.403,DUB,40,P,40,B)) Q:'B  D BLOCK  Q:M=U
	S %1=0 F  S %1=$O(@DFF@(DUB,15,%1)) Q:'%1  W:$D(^(%1,0))#2 !?5,^(0)
	W !
	Q
BLOCK	;
	N I
	F I=1:1:L I L(I)[(U_B_U) G BLOCKQ
	S:$L(L)+$L(B)+1>245 L=L+1,L(L)=U S L(L)=L(L)_B_U
	Q:$D(^DIST(.404,B,0))[0  S %1=^(0)
	;
	I $Y+3>IOSL D HDR^DIDG Q:M=U
	W !?2,$P(%1,U) W:$P(%1,U,2)]"" ?32,"DD #"_$P(%1,U,2)
BLOCKQ	Q
	;
FILELST(DIDROOT)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	N DIDARRAY
	D EN4^DIQGDD
	M @DIDROOT=DIDARRAY
	Q
	;
FILE(DIQGR,DIQGPARM,DR,DIQGTA,DIQGERRA,DIQGIPAR)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	G EN2^DIQGDD
	;
FIELDLST(DIDROOT)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	N DIDARRAY
	D EN5^DIQGDD
	M @DIDROOT=DIDARRAY
	Q
	;
FIELD(DIQGR,DA,DIQGPARM,DR,DIQGTA,DIQGERRA,DIQGIPAR)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	G EN1^DIQGDD
	;
GET1(DIQGR,DA,DIQGPARM,DR,DIQGETA,DIQGERRA,DIQGIPAR)	;
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	G EN3^DIQGDD
	;
PIECE(DIQGR,DA,DIQGPARM,DR,DIQGTA,DIQGERRA,DIQGIPAR)	;CLOSEDREF,PIECE,FLAG,ATTRIBUTE,TARGETARRAY,ERRORARRAY,INTERNAL
	;PROCEDURE CALL AND  * * RETURN RESULTS IN TARGET ARRAY * *
	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
	G EN6^DIQGDD0