Return to DDSM.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial commit

DDSM	;SFISC/MKO-MULTILINE ;01:34 PM  6 Oct 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
MNAV(FND)	;Navigate within repeating blocks
	;Returns FND if navigating to another field within the repeating
	;block
	N DDSCL,DDSDDO,DDSNR,DDSPDA,DDSSN,DDSSTL
	S DDSDDO=$P(DDSU("N"),U,$L($P("U^D^R^L^N",DDACT),U)+5)
	;
	S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2),DDSCL=$P(DDSREP,U,3)
	S DDSSN=$P(DDSREP,U,4),DDSNR=$P(DDSREP,U,5)
	;
	I $P(DDSDDO,",",2)="-1" D MUP Q
	I $P(DDSDDO,",",2)="+1" D MDN Q
	I DA S DDO=+DDSDDO,FND=1 Q
	Q
	;
MUP	;Move up a line
	Q:DDSSN'>1
	S DDSSN=DDSSN-1
	I DDSCL>1 D
	. S DDSCL=DDSCL-1 D MDA
	E  D
	. S DDSSTL=DDSSTL-1
	. D MDA,DB^DDSR(DDSPG,DDSBK)
	Q
	;
MDN	;Move down a line
	Q:'DA
	S DDSSN=DDSSN+1
	I DDSCL<DDSNR D
	. S DDSCL=DDSCL+1 D MDA
	E  D
	. S DDSSTL=DDSSTL+1
	. D MDA,DB^DDSR(DDSPG,DDSBK)
	Q
	;
MDA	;Update DDO, DA and Dn, set FND=1
	N DDSDASV
	S $P(DDSREP,U,2,4)=DDSSTL_U_DDSCL_U_DDSSN
	S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
	S DDSDASV=DDSDA
	S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
	S DA=+DDSDA,@("D"_DDSDL)=DA
	S DDO=$S(DA:+DDSDDO,1:$P(DDSREP,U,8))
	S FND=1
	Q
	;
SEL	;Issue read
	N DIRUT
	S DIR(0)="PO"_DIE_":QEMZ"_$E("L",'$D(DDSTP)&'$P(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,2),U,4))
	I $P(DDSREP,U,7) D
	. S:$D(@(DIE_"0)"))[0 @(DIE_"0)")=U_$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)_U_U
	E  D
	. S DIR("S")="I $D("_DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_",Y))"
	D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
	;
	S DA=+Y,$P(DDSDA,",")=DA
	I $P(Y,U,3)=1 D
	. N DDSFN,DDSLN,DDSPDA,DDSSN
	. S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
	. D ADD(DDSDA,DDSPDA,DDSSN)
	. S DDSFN="F"_$P(@DDSREFS@(DDSPG,DDSBK),U,3)
	. D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
	. S DDSCHKQ=2
	E  D
	. S DDSCHKQ=1
	. D POSDA(DDSDA)
	;
	S Y=$P(Y,U)
	S:X="" Y=""
	Q
	;
END	;
	S DDACT="N"
	Q:'DA
	D POSSN(999999999999)
	Q
	;
PGDN	;Page down
	S DDACT="N"
	Q:'DA
	D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
	Q
	;
PGUP	;Page up
	S DDACT="N"
	Q:$P(DDSREP,U,4)=1
	D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
	Q
	;
POSSN(DDSSN)	;Make line with given DDSSN current
	N DDSLSN,DDSPDA,DDSSTL
	S DDSPDA=$P(DDSREP,U)
	S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
	S DDSSN=$$MIN(DDSLSN,DDSSN)
	S:DDSSN<1 DDSSN=1
	S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
	S DA=+DDSDA
	S DDSSTL=$P(DDSREP,U,2)
	;
	S:'DA DDO=$P(DDSREP,U,8)
	I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
	. S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
	E  D
	. S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
	. S:DDSSTL<1 DDSSTL=1
	. S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
	. D DB^DDSR(DDSPG,DDSBK)
	Q
	;
POSDA(DDSDA)	;Make line with given DDSDA current
	N DDSPDA,DDSSN,DDSSTL
	S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
	S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
	;
	I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
	. N DY,DX
	. S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
	. S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
	E  D
	. S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
	. S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
	. D DB^DDSR(DDSPG,DDSBK)
	Q
	;
ADD(DDSDA,DDSPDA,DDSSN)	;Add entry
	S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
	S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
	S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
	D ^DDS11(DDSBK)
	S DDSCHG=1
	Q
	;
MIN(X,Y)	;
	Q $S(X<Y:X,1:Y)
MAX(X,Y)	;
	Q $S(X>Y:X,1:Y)