| [613] | 1 | DDSZ3 ;SFISC/MKO-FORM COMPILER ;02:49 PM 30 Dec 1993
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ASUB(DDSPG,DDSFRM) ;
|
|---|
| 6 | ;Set @DDSREFS@("ASUB",pg,bk,ddo)=subpage for parent field
|
|---|
| 7 | N MF,MB,MP
|
|---|
| 8 | S MF=$P(^DIST(.403,+DDSFRM,40,DDSPG,1),U,2) Q:MF=""
|
|---|
| 9 | S MP=$P(MF,",",3),MB=$P(MF,",",2),MF=$P(MF,",")
|
|---|
| 10 | ;
|
|---|
| 11 | S MF=$$GETFLD^DDSLIB(MF,MB,MP,DDSFRM)
|
|---|
| 12 | I $G(DIERR) K DIERR,^TMP("DIERR",$J) Q
|
|---|
| 13 | S @DDSREFS@("ASUB",$P(MF,",",3),$P(MF,",",2),$P(MF,","))=DDSPG
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | PGRP(FRM,G) ;Find page groups
|
|---|
| 17 | ;In: FRM = Form number
|
|---|
| 18 | ;Out: G = Array of page groups
|
|---|
| 19 | ;
|
|---|
| 20 | N B,I,NP,P,PP,PG
|
|---|
| 21 | S G=0
|
|---|
| 22 | S P=0 F S P=$O(^DIST(.403,FRM,40,P)) Q:'P D
|
|---|
| 23 | . Q:'$D(^DIST(.403,FRM,40,P,0)) S NP=$P(^(0),U,4),PP=$P(^(0),U,5)
|
|---|
| 24 | . F PG="NP","PP" I @PG D
|
|---|
| 25 | .. S @PG=$O(^DIST(.403,FRM,40,"B",@PG,"")) Q:'@PG
|
|---|
| 26 | .. S:$D(^DIST(.403,FRM,40,@PG,0))[0 @PG=""
|
|---|
| 27 | . S:NP=P NP=0 S:PP=NP!(PP=P) PP=0
|
|---|
| 28 | . S I=0 F S I=$O(G(I)) Q:'I Q:U_G(I)_U[(U_P_U)
|
|---|
| 29 | . I 'I S G=G+1,G(G)=P_$S(NP:U_NP,1:"")_$S(PP:U_PP,1:"") Q
|
|---|
| 30 | . F PG="NP","PP" I @PG,U_G(I)_U'[(U_@PG_U) S G(I)=G(I)_U_@PG
|
|---|
| 31 | Q
|
|---|
