Annotation of freem_fileman/USER/DDSZ3.m, revision 1.1
1.1 ! snw 1: DDSZ3 ;SFISC/MKO-FORM COMPILER ;02:49 PM 30 Dec 1993
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>