Return to DDS5.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDS5.m, revision 1.1

1.1     ! snw         1: DDS5   ;SFISC/MKO-MULTS,NEXT/PREV PAGE,NEXT BLOCK ;10:39 AM  25 Oct 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I X="" D:DDSOLD="" NF^DDS01 D:DDSOLD]"" DM^DDS6 Q
        !             5:        I DIR0N,$D(DUZ)#2 S ^DISV(DUZ,$E(DDSGL,1,28))=$E(DDSGL,29,999)_X
        !             6:        I $G(@DDSREFS@("ASUB",DDSPG,DDSBK,DDO))]"" S DDS5PG=^(DDO)
        !             7:        E  I $P($G(DDSO(7)),U,2)="" D:X=DDSOLD NF^DDS01 Q
        !             8:        D MULT,R^DDSR
        !             9:        ;
        !            10:        K DDSSTACK
        !            11:        X:$G(^DIST(.404,DDSBK,40,DDO,10))'?."^" ^(10)
        !            12:        I $D(DDSSTACK) D ^DDSSTK,R^DDS3 K DDSBR
        !            13:        D:$D(DDSBR)#2 BR^DDS2
        !            14:        Q
        !            15: MULT   ;
        !            16:        N DIE,DDO,DDSBK,DDSDN,DDSNP,DDSOPB,DDSPG,DDSPTB,DDSREP,DDSTP
        !            17:        ;
        !            18:        I $G(DDS5PG) S DDSPG=DDS5PG K DDS5PG
        !            19:        E  D
        !            20:        . S DDSPG(1)=$P($G(DDSO(7)),U,2) Q:DDSPG(1)=""
        !            21:        . S DDSPG=$O(^DIST(.403,+DDS,40,"B",DDSPG(1),"")) Q:DDSPG=""
        !            22:        Q:$D(^DIST(.403,+DDS,40,+$G(DDSPG),0))[0
        !            23:        N:'$P(^(0),U,6) DDSSC
        !            24:        ;
        !            25:        D DDA(Y,.DA,.DDSDL)
        !            26:        I Y'=-1 D
        !            27:        . N DDP,DDSDA,DDSFLD,DDSDLORG,DDSDAORG,DDSFLORG
        !            28:        . S DIE=U_$P(DDSU("M"),U,2),DDP=$P(DDSU("M"),U,3)
        !            29:        . S DDSDLORG=DDSDL,DDSDAORG=DA,DDSDA=DA_","
        !            30:        . F DDSI=1:1:DDSDL S DDSDAORG(DDSI)=DA(DDSI),DDSDA=DDSDA_DA(DDSI)_","
        !            31:        . K DDSI
        !            32:        . S DDSSTK=1
        !            33:        . D PROC^DDS
        !            34:        D LST(.DA,.DDSDL,DDP,DDSDA,DDSFLD)
        !            35:        D UDA(.DA,.DDSDL)
        !            36:        Q
        !            37:        ;
        !            38: LST(DA,DDSDL,DDP,DDSDA,DDSFLD) ;Save last edited subrecord
        !            39:        ;In:  DA array, DDSDL      at subfile level
        !            40:        ;     DDP, DDSDA, DDSFLD   at file level
        !            41:        N DDSDIE,Y
        !            42:        S DDSDIE=U_$P(@DDSREFT@("F"_DDP,DDSDA,DDSFLD,"M"),U,2)
        !            43:        I $D(@(DDSDIE_"+$G(DA),0)"))[0 D
        !            44:        . S DA=$S($D(@(DDSDIE_"0)"))#2:$P(^(0),U,3),1:$O(^(0)))
        !            45:        . I DA>0 D
        !            46:        .. N C
        !            47:        .. S Y=$P(@(DDSDIE_DA_",0)"),U)
        !            48:        .. S C=$P(^DD(+$P(^DD(DDP,DDSFLD,0),U,2),.01,0),U,2)
        !            49:        .. D Y^DIQ
        !            50:        . E  S (DA,Y)=""
        !            51:        E  S (DA,Y)=""
        !            52:        I DA>0,$D(DUZ)#2 S ^DISV(DUZ,$E(DDSDIE,1,28))=$E(DDSDIE,29,999)_DA
        !            53:        ;
        !            54:        S @DDSREFT@("F"_DDP,DDSDA,DDSFLD,"X")=Y,^("D")=DA,DDACT="N"
        !            55:        Q
        !            56:        ;
        !            57: SEL    ;Issue the read at the Select mult prompt
        !            58:        S DIR(0)="PO"_DDSGL_":QEMZ"_$E("L",'$D(DDSTP)&'$P($G(DDSO(4)),U,5))
        !            59:        S:$D(@(DDSGL_"0)"))[0 @(DDSGL_"0)")=U_$P(^DD(DDP,+DDSFLD,0),U,2)_U_U
        !            60:        D DDA(0,.DA,.DDSDL),^DIR,UDA(.DA,.DDSDL) K DIR,DUOUT,DIRUT,DIROUT
        !            61:        Q:DDACT'="N"
        !            62:        ;
        !            63:        I DIR0N S (X,Y)=DDSOLD Q
        !            64:        I $P(Y,U,3)=1 S ^("ADD")=$G(@DDSREFT@("ADD"))+1,^("ADD",^("ADD"))=+Y_","_DDSDA_DDSGL
        !            65:        E  S DIR0N=1
        !            66:        S Y=$P(Y,U)
        !            67:        S:X="" Y=""
        !            68:        Q
        !            69:        ;
        !            70: DDA(Y,DA,DL)   ;Push Y onto DA array
        !            71:        N I
        !            72:        F I=DL:-1:1 S DA(I+1)=DA(I)
        !            73:        S DA(1)=DA,DL=DL+1
        !            74:        S (DA,@("D"_DL))=$S(+$P($G(Y),"E"):+$P(Y,"E"),1:0)
        !            75:        Q
        !            76:        ;
        !            77: UDA(DA,DL)     ;Pop DA array
        !            78:        N I
        !            79:        S DA=DA(1)
        !            80:        F I=2:1:DL S DA(I-1)=DA(I)
        !            81:        K DA(DL),@("D"_DL)
        !            82:        S DL=DL-1
        !            83:        Q
        !            84: NP(Y)  ;Returns: Next page
        !            85:        ;         (Y=1 if found, 0 if not found)
        !            86:        N P,P1
        !            87:        S Y=0,P1=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,4)
        !            88:        I P1]"" D
        !            89:        . S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
        !            90:        . I P,P'=DDSPG,$D(^DIST(.403,+DDS,40,P,0))#2 S Y=1
        !            91:        Q $S(Y=1:P,1:DDSPG)
        !            92: PP(Y)  ;
        !            93:        N P,P1
        !            94:        S Y=0,P1=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,5)
        !            95:        I P1]"" D
        !            96:        . S P=$O(^DIST(.403,+DDS,40,"B",P1,""))
        !            97:        . I P,P'=DDSPG,$D(^DIST(.403,+DDS,40,P,0))#2 S Y=1
        !            98:        Q $S(Y=1:P,1:DDSPG)
        !            99: NB(Y)  ;
        !           100:        N B,BO,X
        !           101:        S (B,Y)=0,BO=$P($G(^DIST(.403,+DDS,40,DDSPG,40,DDSBK,0)),U,2)
        !           102:        I BO F  D  Q:B=DDSBK!Y
        !           103:        . S BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",BO)) S:'BO BO=$O(^("")) S B=$O(^(BO,""))
        !           104:        . S X=$G(@DDSREFS@(DDSPG,B))
        !           105:        . I $P(X,U)]"",$P(X,U,5)'="h",$P(X,U,9),B'=DDSBK S Y=1
        !           106:        Q B