| [613] | 1 | DDS1(DDSPG) ;SFISC/MKO-LOAD PAGE ;11:25 AM 4 Aug 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;Input:
|
|---|
| 5 | ; DDS = Form number^Form name
|
|---|
| 6 | ; DDSPG = Internal page number
|
|---|
| 7 | ; DA = Record array
|
|---|
| 8 | ; DDSREFT = Global location where data (temporarily) is stored
|
|---|
| 9 | ; DDP = Primary file number of form
|
|---|
| 10 | ; DIE = Global root of form
|
|---|
| 11 | ; DDSDA = DA,DA(1),... of form
|
|---|
| 12 | ; DDSDL = Level number
|
|---|
| 13 | ;Also needed for pointed-to blocks:
|
|---|
| 14 | ; DDSDAORG
|
|---|
| 15 | ; DDSDLORG
|
|---|
| 16 | ;Returns:
|
|---|
| 17 | ; DIERR
|
|---|
| 18 | ;
|
|---|
| 19 | S U="^"
|
|---|
| 20 | ;
|
|---|
| 21 | ;Get header block
|
|---|
| 22 | S DDS1B=$P($G(^DIST(.403,+DDS,40,DDSPG,0)),U,2)
|
|---|
| 23 | I DDS1B]"" D BLK(DDSPG,DDS1B,"",1) G:$G(DIERR) END
|
|---|
| 24 | ;
|
|---|
| 25 | ;Get all other blocks on page
|
|---|
| 26 | S DDS1BO="" F S DDS1BO=$O(^DIST(.403,+DDS,40,DDSPG,40,"AC",DDS1BO)) Q:DDS1BO="" S DDS1B=$O(^(DDS1BO,0)) Q:'DDS1B D BLK(DDSPG,DDS1B,DDS1BO) G:$G(DIERR) END
|
|---|
| 27 | ;
|
|---|
| 28 | END K DDS1B,DDS1BO
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | BLK(DDSPG,DDS1B,DDS1BO,DDS1H,DDS1E) ;Load block
|
|---|
| 32 | ;In: DDS1H = 1 if a header block
|
|---|
| 33 | ; DDS1E = 1 if we're loading up a pointed-to block and
|
|---|
| 34 | ; we want interactive dialog (DIC(0)["E") in the lookup
|
|---|
| 35 | ;
|
|---|
| 36 | I $D(^DIST(.404,DDS1B,0))[0 D BLD^DIALOG(3051,"#"_DDS1B) Q
|
|---|
| 37 | ;
|
|---|
| 38 | N DDS1PTB,DDS1REP S DDS1PTB=""
|
|---|
| 39 | I '$G(DDS1H) D
|
|---|
| 40 | . S DDS1PTB=$G(^DIST(.403,+DDS,40,DDSPG,40,DDS1B,1)),DDS1REP=$G(^(2))
|
|---|
| 41 | . K:DDS1REP<2 DDS1REP
|
|---|
| 42 | ;
|
|---|
| 43 | I DDS1PTB]"" N @$$D0(DDSDL),DA,DDP,DIE,DDSDL,DDSDA D Q:$G(DIERR)
|
|---|
| 44 | . I $G(DDS1REP)>1 D
|
|---|
| 45 | .. D BK^DDS10(.DDS1B,.DDP) Q:$G(DIERR)
|
|---|
| 46 | .. D GDA^DDS10(DDS1B,$G(DDS1E),.DA) Q:$G(DIERR)
|
|---|
| 47 | .. S DDP=$G(^DD(DDP,0,"UP"))
|
|---|
| 48 | .. D GL^DDS10(DDP,.DA,.DIE,.DDSDL,.DDSDA,1)
|
|---|
| 49 | .. D GETD0(.DA,DDSDL)
|
|---|
| 50 | . E D
|
|---|
| 51 | .. D SET^DDS10(DDS1B,$G(DDS1E),.DA,.DDP,.DIE,.DDSDL,.DDSDA)
|
|---|
| 52 | .. I +$G(DIERR)=1,$G(^TMP("DIERR",$J,1))=601 D Q
|
|---|
| 53 | ... L -@(DIE_DA_")")
|
|---|
| 54 | ... K ^TMP("DDS",$J,"LOCK",DIE_DA_")")
|
|---|
| 55 | ... D CLEAN^DILF
|
|---|
| 56 | ... S (DA,D0,DDSDA)=""
|
|---|
| 57 | .. Q:$G(DIERR)
|
|---|
| 58 | .. I DA="",'$G(DDS1E),$P($G(@DDSREFT@(DDSPG,DDS1B)),U)]"" S DDSDA=$P(^(DDS1B),U),DA=+DDSDA
|
|---|
| 59 | .. S D0=DA
|
|---|
| 60 | ;
|
|---|
| 61 | I $G(DA)!'$G(DDSDAORG),$G(@DDSREFT@(DDSPG,DDS1B,DDSDA))<1 D
|
|---|
| 62 | . S $P(@DDSREFT@(DDSPG,DDS1B,DDSDA),U)=1
|
|---|
| 63 | . I $G(DDS1REP)>1 D REP Q
|
|---|
| 64 | . ;
|
|---|
| 65 | . S @DDSREFT@(DDSPG,DDS1B,DDSDA,"GL")=DIE
|
|---|
| 66 | . D ^DDS11(DDS1B)
|
|---|
| 67 | ;
|
|---|
| 68 | S $P(@DDSREFT@(DDSPG,DDS1B),U)=$G(DDSDA)
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | REP ;Load data for repeating block
|
|---|
| 72 | N DDS1DDP,DDS1IND,DDS1INI,DDS1MUL,DDS1PDA,DDS1REF,DDS1RT,DDS1SEL
|
|---|
| 73 | N DDS1SN,DDS1VAL,DDS1FSCR,DDS1SCNT,DDS1STRT,DDS1Q
|
|---|
| 74 | S DDS1REF=$NA(@DDSREFT@(DDSPG,DDS1B))
|
|---|
| 75 | S DDS1DDP=$P(@DDSREFS@(DDSPG,DDS1B),U,3)
|
|---|
| 76 | S DDS1IND=$P(DDS1REP,U,2) S:DDS1IND="" DDS1IND="B"
|
|---|
| 77 | S DDS1INI=$P(DDS1REP,U,3)
|
|---|
| 78 | S DDS1SEL=$P(@DDSREFS@(DDSPG,DDS1B),U,10)
|
|---|
| 79 | S DDS1PDA=DDSDA
|
|---|
| 80 | ;
|
|---|
| 81 | S DDS1MUL=$O(^DD(DDP,"SB",DDS1DDP,""))
|
|---|
| 82 | S:$G(^DD(DDS1DDP,0,"SCR"))]"" DDS1FSCR=^("SCR")
|
|---|
| 83 | ;
|
|---|
| 84 | S $P(@DDS1REF@(DDS1PDA),U,7,10)=DDP_U_DDS1MUL_U_DDS1SEL_U_DDS1IND
|
|---|
| 85 | S @DDS1REF@(DDSDA,"GL")=$S(DDS1MUL:DIE_+DA_","""_$P($P(^DD(DDP,DDS1MUL,0),U,4),";")_""",",1:^DIC(DDS1DDP,0,"GL"))
|
|---|
| 86 | ;
|
|---|
| 87 | N DIE,DDP
|
|---|
| 88 | S DIE=@DDS1REF@(DDSDA,"GL"),DDS1RT=$$CREF^DILF(DIE),DDP=DDS1DDP
|
|---|
| 89 | S DDS1SN=0
|
|---|
| 90 | ;
|
|---|
| 91 | I DDS1MUL D
|
|---|
| 92 | . D DDA^DDS5(0,.DA,.DDSDL)
|
|---|
| 93 | . S DDSDA=","_DDSDA
|
|---|
| 94 | . S:'$D(@DDS1RT@(DDS1IND)) DDS1IND="!IEN"
|
|---|
| 95 | . I DDS1IND="!IEN" D
|
|---|
| 96 | .. S DA=0 F S DA=$O(@DDS1RT@(DA)) Q:'DA D REPLD
|
|---|
| 97 | . E D
|
|---|
| 98 | .. S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND)),DDS1SCNT=$QL(DDS1Q)
|
|---|
| 99 | .. F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
|
|---|
| 100 | ... S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
|
|---|
| 101 | ;
|
|---|
| 102 | E S DDS1VAL=DA N D0,DA,DDSDA D
|
|---|
| 103 | . S DDSDA=","
|
|---|
| 104 | . S (DDS1Q,DDS1STRT)=$NA(@DDS1RT@(DDS1IND,DDS1VAL)),DDS1SCNT=$QL(DDS1Q)
|
|---|
| 105 | . F S DDS1Q=$Q(@DDS1Q) Q:DDS1Q="" Q:$NA(@DDS1Q,DDS1SCNT)'=DDS1STRT D
|
|---|
| 106 | .. S DA=$QS(DDS1Q,$QL(DDS1Q)) D REPLD
|
|---|
| 107 | ;
|
|---|
| 108 | I DDS1INI="l"!(DDS1INI="n") D
|
|---|
| 109 | . N N,T
|
|---|
| 110 | . S N=DDS1INI="n"
|
|---|
| 111 | . S DDS1SN=$O(@DDS1REF@(DDS1PDA," "),-1)+N
|
|---|
| 112 | . S T=DDS1SN-DDS1REP+2-N
|
|---|
| 113 | . S DDS1INI=$S(T<1:1_U_DDS1SN,1:T_U_(DDS1REP-'N))_U_DDS1SN
|
|---|
| 114 | E S DDS1INI="1^1^1"
|
|---|
| 115 | ;
|
|---|
| 116 | S $P(@DDS1REF@(DDS1PDA),U,2,6)=DDS1PDA_U_DDS1INI_U_+DDS1REP
|
|---|
| 117 | ;
|
|---|
| 118 | I DDS1MUL D
|
|---|
| 119 | . D UDA^DDS5(.DA,.DDSDL)
|
|---|
| 120 | . S DDSDA=$P(DDSDA,",",2,999)
|
|---|
| 121 | Q
|
|---|
| 122 | ;
|
|---|
| 123 | REPLD ;Load data
|
|---|
| 124 | Q:'$D(@DDS1RT@(DA,0)) I $D(DDS1FSCR) N Y S Y=DA X DDS1FSCR Q:'$T
|
|---|
| 125 | S DDS1SN=DDS1SN+1,$P(DDSDA,",")=DA,@("D"_DDSDL)=DA
|
|---|
| 126 | S @DDS1REF@(DDS1PDA,DDS1SN)=DDSDA
|
|---|
| 127 | S @DDS1REF@(DDS1PDA,"B",DDSDA)=DDS1SN
|
|---|
| 128 | D ^DDS11(DDS1B)
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
| 131 | D0(DL) ;Given DL, return string D0,D1,...,Dn
|
|---|
| 132 | N I,S
|
|---|
| 133 | S S="" F I=0:1:DL S S=S_"D"_I_","
|
|---|
| 134 | S:S?.E1"," S=$E(S,1,$L(S)-1)
|
|---|
| 135 | Q S
|
|---|
| 136 | ;
|
|---|
| 137 | GETD0(DA,DL) ;Given DA array, set D0,D1...
|
|---|
| 138 | N I
|
|---|
| 139 | S @("D"_DL)=DA
|
|---|
| 140 | F I=1:1:DL-1 S @("D"_(DL-I))=DA(I)
|
|---|
| 141 | Q
|
|---|
