Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDSM

DDSM.m

Go to the documentation of this file. 
  1. DDSM ;SFISC/MKO-MULTILINE ;10:12 AM  1 Oct 1999 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**8**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;Returns FND if navigating to another field within the repeating
  1.  ;block
  1.  N DDSCL,DDSDDO,DDSNR,DDSPDA,DDSSN,DDSSTL
  1.  S DDSDDO=$P(DDSU("N"),U,$L($P("U^D^R^L^N",DDACT),U)+5)
  1.  ;
  1.  S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2),DDSCL=$P(DDSREP,U,3)
  1.  S DDSSN=$P(DDSREP,U,4),DDSNR=$P(DDSREP,U,5)
  1.  ;
  1.  I $P(DDSDDO,",",2)="-1" D MUP Q
  1.  I $P(DDSDDO,",",2)="+1" D MDN Q
  1.  I DA S DDO=+DDSDDO,FND=1 Q
  1.  Q
  1.  ;
  1. MUP ;Move up a line
  1.  Q:DDSSN'>1
  1.  S DDSSN=DDSSN-1
  1.  I DDSCL>1 D
  1.  . S DDSCL=DDSCL-1 D MDA
  1.  E  D
  1.  . S DDSSTL=DDSSTL-1
  1.  . D MDA,DB^DDSR(DDSPG,DDSBK)
  1.  Q
  1.  ;
  1. MDN ;Move down a line
  1.  Q:'DA
  1.  S DDSSN=DDSSN+1
  1.  I DDSCL<DDSNR D
  1.  . S DDSCL=DDSCL+1 D MDA
  1.  E  D
  1.  . S DDSSTL=DDSSTL+1
  1.  . D MDA,DB^DDSR(DDSPG,DDSBK)
  1.  Q
  1.  ;
  1. MDA ;Update DDO, DA and Dn, set FND=1
  1.  N DDSDASV
  1.  S $P(DDSREP,U,2,4)=DDSSTL_U_DDSCL_U_DDSSN
  1.  S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  1.  S DDSDASV=DDSDA
  1.  S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
  1.  S DA=+DDSDA,@("D"_DDSDL)=DA
  1.  S DDO=$S(DA:+DDSDDO,1:$P(DDSREP,U,8))
  1.  S FND=1
  1.  Q
  1.  ;
  1. SEL ;Issue read
  1.  N DIRUT
  1.  S DIR(0)="PO"_DIE_":QEMZ"_$E("L",'$D(DDSTP)&'$P(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,2),U,4))_$E("V",$P(^(2),U,6))
  1.  I $P(DDSREP,U,7) D
  1.  . N DDSMSPEC S DDSMSPEC=$P(^DD($P(DDSREP,U,6),$P(DDSREP,U,7),0),U,2)
  1.  . I $D(@(DIE_"0)"))[0 S ^(0)=U_DDSMSPEC_U_U
  1.  . E  I $P(@(DIE_"0)"),U,2)'=DDSMSPEC S $P(^(0),U,2)=DDSMSPEC
  1.  . I $P(DDSREP,U,9)]"" D
  1.  .. N DDSROOT,DDSSUB
  1.  .. S DDSROOT=$NA(@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B"))
  1.  .. S DDSSUB="Y_"",""_"""_$P(DDSREP,U)_""""
  1.  .. S DDSROOT=$E(DDSROOT,1,$L(DDSROOT)-1)_","_DDSSUB_")"
  1.  .. S DIR("S")="I $D("_DDSROOT_")"
  1.  E  N DDSLASCN D
  1.  . S DDSLASCN=$NA(@(DIE_""""_$P(DDSREP,U,9)_""","_+$P(DDSREP,U)_")"))
  1.  . S DIR("S")="X ""I 0"" N R,S S (R,S)=DDSLASCN F  S R=$Q(@R) Q:R=""""!($NA(@R,"_$QL(DDSLASCN)_")'=S)  I $QS(R,$QL(R))=Y Q"
  1.  D ^DIR K DIR,DUOUT,DIROUT Q:DIR0N!$D(DIRUT)
  1.  ;
  1.  S DA=+Y,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
  1.  I $P(Y,U,3)=1 D
  1.  . N DDSFN,DDSLN,DDSPDA,DDSSN
  1.  . S DDSPDA=$P(DDSREP,U),DDSLN=$P(DDSREP,U,3),DDSSN=$P(DDSREP,U,4)
  1.  . S DDSFN=+$P(@DDSREFS@(DDSPG,DDSBK),U,3)
  1.  . ;
  1.  . I '$P(DDSREP,U,7) D
  1.  .. N DR,X,Y
  1.  .. S DR=$O(^DD(DDSFN,0,"IX",$P(DDSREP,U,9),DDSFN,""))_"////"_+DDSREP
  1.  .. D ^DIE
  1.  . ;
  1.  . D ADD(DDSDA,DDSPDA,DDSSN)
  1.  . S DDSFN="F"_DDSFN
  1.  . D DMULT1^DDSR(DDSPG,DDSBK,DDSFN,DDSDA,DDSLN,DDSSN)
  1.  . S DDSCHKQ=2
  1.  E  D
  1.  . S DDSCHKQ=1
  1.  . D POSDA(DDSDA)
  1.  ;
  1.  S Y=$P(Y,U)
  1.  S:X="" Y=""
  1.  Q
  1.  ;
  1. END ;
  1.  S DDACT="N"
  1.  Q:'DA
  1.  D POSSN(999999999999)
  1.  Q
  1.  ;
  1. PGDN ;Page down
  1.  S DDACT="N"
  1.  I 'DA D
  1.  . I DDSNP]"" S DDSPG=DDSNP,DDACT="NP"
  1.  E  D POSSN($P(DDSREP,U,2)+$P(DDSREP,U,5))
  1.  Q
  1.  ;
  1. PGUP ;Page up
  1.  S DDACT="N"
  1.  I $P(DDSREP,U,4)=1 D
  1.  . S DDSPG=$$PP^DDS5(.Y)
  1.  . S:Y=1 DDACT="NP"
  1.  E  D POSSN($P(DDSREP,U,2)-$P(DDSREP,U,5))
  1.  Q
  1.  ;
  1. POSSN(DDSSN,DDSPAINT) ;Make line with given DDSSN current
  1.  N DDSLSN,DDSPDA,DDSSTL
  1.  S DDSPDA=$P(DDSREP,U)
  1.  S DDSSTL=$P(DDSREP,U,2)
  1.  ;
  1.  S DDSLSN=$O(@DDSREFT@(DDSPG,DDSBK,DDSPDA," "),-1)+1
  1.  S DDSSN=$$MIN(DDSLSN,DDSSN)
  1.  S:DDSSN<1 DDSSN=1
  1.  ;
  1.  S DDSDA=$G(@DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN),"0,"_$P(DDSDA,",",2,999))
  1.  S DA=+DDSDA,@("D"_DDSDL)=DA
  1.  ;
  1.  S:'DA DDO=$P(DDSREP,U,8)
  1.  I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
  1.  . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
  1.  . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  1.  . D:$G(DDSPAINT) DB^DDSR(DDSPG,DDSBK)
  1.  E  D
  1.  . S DDSSTL=$$MIN(DDSLSN-$P(DDSREP,U,5)+1,DDSSN)
  1.  . S:DDSSTL<1 DDSSTL=1
  1.  . S $P(DDSREP,U,2,4)=DDSSTL_U_(DDSSN-DDSSTL+1)_U_DDSSN
  1.  . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  1.  . D DB^DDSR(DDSPG,DDSBK)
  1.  Q
  1.  ;
  1. POSDA(DDSDA) ;Make line with given DDSDA current
  1.  N DDSPDA,DDSSN,DDSSTL
  1.  S DDSSN=@DDSREFT@(DDSPG,DDSBK,$P(DDSREP,U),"B",DDSDA)
  1.  S DDSPDA=$P(DDSREP,U),DDSSTL=$P(DDSREP,U,2)
  1.  ;
  1.  I DDSSN'<DDSSTL,DDSSN<(DDSSTL+$P(DDSREP,U,5)) D
  1.  . N DY,DX
  1.  . S $P(DDSREP,U,3,4)=DDSSN-DDSSTL+1_U_DDSSN
  1.  . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  1.  . S DY=$P(DIR0,U),DX=$P(DIR0,U,2) X IOXY W $J("",$P(DIR0,U,3))
  1.  E  D
  1.  . S $P(DDSREP,U,2,4)=DDSSN_"^1^"_DDSSN
  1.  . S $P(@DDSREFT@(DDSPG,DDSBK,DDSPDA),U,2,999)=DDSREP
  1.  . D DB^DDSR(DDSPG,DDSBK)
  1.  Q
  1.  ;
  1. ADD(DDSDA,DDSPDA,DDSSN) ;Add entry
  1.  S @DDSREFT@(DDSPG,DDSBK,DDSPDA,"B",DDSDA)=DDSSN
  1.  S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=DDSDA_DIE
  1.  S @DDSREFT@(DDSPG,DDSBK,DDSPDA,DDSSN)=DDSDA
  1.  D ^DDS11(DDSBK)
  1.  S DDSCHG=1
  1.  Q
  1.  ;
  1. MIN(X,Y) ;
  1.  Q $S(X<Y:X,1:Y)
  1. MAX(X,Y) ;
  1.  Q $S(X>Y:X,1:Y)