Annotation of freem_fileman/DDSM.m, revision 1.1
1.1 ! snw 1: DDSM ;SFISC/MKO-MULTILINE ;01:34 PM 6 Oct 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: MNAV(FND) ;Navigate within repeating blocks
! 5: ;Returns FND if navigating to another field within the repeating
! 6: ;block
! 7: N DDSCL,DDSDDO,DDSNR,DDSPDA,DDSSN,DDSSTL
! 8: S DDSDDO=$P(DDSU("N"),U,$L($P("U^D^R^L^N",DDACT),U)+5)
! 9: ;
! 10: S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2),DDSCL=$P(DDSREP,U,3)
! 11: S DDSSN=$P(DDSREP,U,4),DDSNR=$P(DDSREP,U,5)
! 12: ;
! 13: I $P(DDSDDO,",",2)="-1" D MUP Q
! 14: I $P(DDSDDO,",",2)="+1" D MDN Q
! 15: I DA S DDO=+DDSDDO,FND=1 Q
! 16: Q
! 17: ;
! 18: MUP ;Move up a line
! 19: Q:DDSSN'>1
! 20: S DDSSN=DDSSN-1
! 21: I DDSCL>1 D
! 22: . S DDSCL=DDSCL-1 D MDA
! 23: E D
! 24: . S DDSSTL=DDSSTL-1
! 25: . D MDA,DB^DDSR(DDSPG,DDSBK)
! 26: Q
! 27: ;
! 28: MDN ;Move down a line
! 29: Q:'DA
! 30: S DDSSN=DDSSN+1
! 31: I DDSCL<DDSNR D
! 32: . S DDSCL=DDSCL+1 D MDA
! 33: E D
! 34: . S DDSSTL=DDSSTL+1
! 35: . D MDA,DB^DDSR(DDSPG,DDSBK)
! 36: Q
! 37: ;
! 38: MDA ;Update DDO, DA and Dn, set FND=1
! 39: N DDSDASV
! 40: S $P(DDSREP,U,2,4)=DDSSTL_U_DDSCL_U_DDSSN
! 41: S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
! 42: S DDSDASV=DDSDA
! 43: S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
! 44: S DA=+DDSDA,@("D"_DDSDL)=DA
! 45: S DDO=$S(DA:+DDSDDO,1:$P(DDSREP,U,8))
! 46: S FND=1
! 47: Q
! 48: ;
! 49: SEL ;Issue read
! 50: N DIRUT
! 51: S DIR(0)="PO"_DIE_":QEMZ"_$E("L",'$D(DDSTP)&'$P(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,2),U,4))
! 52: I $P(DDSREP,U,7) D
! 53: . S:$D(@(DIE_"0)"))[0 @(DIE_"0)")=U_$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)_U_U
! 54: E D
! 55: . S DIR("S")="I $D("_DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_",Y))"
! 56: D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
! 57: ;
! 58: S DA=+Y,$P(DDSDA,",")=DA
! 59: I $P(Y,U,3)=1 D
! 60: . N DDSFN,DDSLN,DDSPDA,DDSSN
! 61: . S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
! 62: . D ADD(DDSDA,DDSPDA,DDSSN)
! 63: . S DDSFN="F"_$P(@DDSREFS@(DDSPG,DDSBK),U,3)
! 64: . D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
! 65: . S DDSCHKQ=2
! 66: E D
! 67: . S DDSCHKQ=1
! 68: . D POSDA(DDSDA)
! 69: ;
! 70: S Y=$P(Y,U)
! 71: S:X="" Y=""
! 72: Q
! 73: ;
! 74: END ;
! 75: S DDACT="N"
! 76: Q:'DA
! 77: D POSSN(999999999999)
! 78: Q
! 79: ;
! 80: PGDN ;Page down
! 81: S DDACT="N"
! 82: Q:'DA
! 83: D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
! 84: Q
! 85: ;
! 86: PGUP ;Page up
! 87: S DDACT="N"
! 88: Q:$P(DDSREP,U,4)=1
! 89: D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
! 90: Q
! 91: ;
! 92: POSSN(DDSSN) ;Make line with given DDSSN current
! 93: N DDSLSN,DDSPDA,DDSSTL
! 94: S DDSPDA=$P(DDSREP,U)
! 95: S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
! 96: S DDSSN=$$MIN(DDSLSN,DDSSN)
! 97: S:DDSSN<1 DDSSN=1
! 98: S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
! 99: S DA=+DDSDA
! 100: S DDSSTL=$P(DDSREP,U,2)
! 101: ;
! 102: S:'DA DDO=$P(DDSREP,U,8)
! 103: I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
! 104: . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
! 105: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
! 106: E D
! 107: . S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
! 108: . S:DDSSTL<1 DDSSTL=1
! 109: . S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
! 110: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
! 111: . D DB^DDSR(DDSPG,DDSBK)
! 112: Q
! 113: ;
! 114: POSDA(DDSDA) ;Make line with given DDSDA current
! 115: N DDSPDA,DDSSN,DDSSTL
! 116: S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
! 117: S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
! 118: ;
! 119: I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
! 120: . N DY,DX
! 121: . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
! 122: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
! 123: . S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
! 124: E D
! 125: . S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
! 126: . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
! 127: . D DB^DDSR(DDSPG,DDSBK)
! 128: Q
! 129: ;
! 130: ADD(DDSDA,DDSPDA,DDSSN) ;Add entry
! 131: S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
! 132: S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
! 133: S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
! 134: D ^DDS11(DDSBK)
! 135: S DDSCHG=1
! 136: Q
! 137: ;
! 138: MIN(X,Y) ;
! 139: Q $S(X<Y:X,1:Y)
! 140: MAX(X,Y) ;
! 141: Q $S(X>Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSM.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman