Annotation of freem_fileman/DDSZ.m, revision 1.1
1.1 ! snw 1: DDSZ ;SFISC/MKO-FORM COMPILER ;11:26 AM 16 Nov 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: ;
! 5: ;Prompt, compile
! 6: N DDSFRM,DDSDDP,DDSREFS
! 7: N C,DIC,X,Y
! 8: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
! 9: ;
! 10: S DIC="^DIST(.403,",DIC(0)="AEQZ"
! 11: D ^DIC K DIC Q:Y=-1!'$D(^DIST(.403,+Y,0))
! 12: S DDSFRM=Y,DDSDDP=$P(Y(0),U,8)
! 13: ;
! 14: W !!,"Compiling "_$P(Y,U,2)_" (#"_+Y_") ...",!
! 15: D EN(DDSFRM,DDSDDP)
! 16: I $G(DIERR) W $C(7) D MSG^DIALOG("BW")
! 17: Q
! 18: ;
! 19: ALL ;Compile all forms
! 20: N DDSFRM,DDSDDP,DDSFNUM,DDSREFS
! 21: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
! 22: W:'$D(DDSQUIET) !,"Compiling all forms ...",!
! 23: ;
! 24: S DDSFNUM=0
! 25: F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
! 26: . Q:$D(^DIST(.403,DDSFNUM,0))[0
! 27: . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U),DDSDDP=+$P(^(0),U,8)
! 28: . S DDSREFS=$$REF^DDS0(DDSFRM)
! 29: . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
! 30: . D EN(DDSFRM,DDSDDP)
! 31: . I $G(DIERR),'$D(DDSQUIET) W !,$C(7) D MSG^DIALOG("BW") W !
! 32: Q
! 33: ;
! 34: EN(DDSFRM,DDSDDP,DDSREFS) ;Compile a form
! 35: N DDSDO,DDSPG,DDSNDD,DDSPGRP
! 36: ;
! 37: S:'$G(DDSDDP) DDSDDP=$P(^DIST(.403,+DDSFRM,0),U,8)
! 38: S:$G(DDSREFS)="" DDSREFS=$$REF^DDS0(DDSFRM)
! 39: K @DDSREFS
! 40: ;
! 41: ;Find page groups
! 42: D PGRP^DDSZ3(+DDSFRM,.DDSPGRP)
! 43: ;
! 44: S DDSPG=0,(DDSDO,DDSNDD)=1
! 45: F S DDSPG=$O(^DIST(.403,+DDSFRM,40,DDSPG)) Q:'DDSPG D PG(DDSFRM,DDSPG,DDSDDP,.DDSDO,.DDSNDD) Q:$G(DIERR)
! 46: I $G(DIERR) D ERR(DDSFRM,DDSREFS) Q
! 47: S $P(^DIST(.403,+DDSFRM,0),U,9,11)=+$G(DDSDO)_U_+$G(DDSNDD)_U_1
! 48: Q
! 49: ;
! 50: PG(DDSFRM,DDSPG,DDSDDP,DDSDO,DDSNDD) ;Compile a page
! 51: ;
! 52: Q:$D(^DIST(.403,+DDSFRM,40,DDSPG,0))[0
! 53: D:$P($G(^DIST(.403,+DDSFRM,40,DDSPG,1)),U,2)]"" ASUB^DDSZ3(DDSPG,DDSFRM)
! 54: ;
! 55: ;Get page coordinates
! 56: S DDSPX=$P(^DIST(.403,+DDSFRM,40,DDSPG,0),U,3)
! 57: S DDSPY=$P(DDSPX,",")-1,DDSPX=$P(DDSPX,",",2)-1
! 58: S:DDSPY<0 DDSPY=0 S:DDSPX<0 DDSPX=0
! 59: ;
! 60: ;Compile header block
! 61: S DDSB=$P($G(^DIST(.403,+DDSFRM,40,DDSPG,0)),U,2)
! 62: I DDSB]"" D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,"",1,"",.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
! 63: ;
! 64: ;Compile all other blocks on page
! 65: S DDSBO="" F S DDSBO=$O(^DIST(.403,+DDSFRM,40,DDSPG,40,"AC",DDSBO)) Q:DDSBO="" S DDSB=$O(^(DDSBO,0)) Q:'DDSB D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,"",.DDSDO,.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
! 66: ;
! 67: D:$D(DDSSCR)!$D(DDSORD) EN^DDSZ2(.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
! 68: ;
! 69: END K DDSB,DDSBO,DDSMUL,DDSNAV,DDSORD
! 70: K DDSP,DDSPX,DDSPY,DDSREP,DDSRNAV,DDSSCR
! 71: Q
! 72: ;
! 73: BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,DDSH,DDSDO,DDSNDD,DDSSCR,DDSNAV,DDSORD) ;
! 74: ;Compile block
! 75: ; DDSH = 1 if header block
! 76: ; DDSDO = killed if any edit blocks
! 77: ; DDSNDD = killed if any DD fields
! 78: ;
! 79: N DDP
! 80: I $D(^DIST(.404,DDSB,0))[0 D BLD^DIALOG(3051,"#"_DDSB) Q
! 81: S DDSDN=$P(^DIST(.404,DDSB,0),U,3),DDP=+$P(^(0),U,2)
! 82: ;
! 83: S DDSPTB=""
! 84: S:'$G(DDSH) DDSPTB=$G(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,1))
! 85: ;
! 86: ;Get DDSBY,DDSBX,DDSTP
! 87: I $G(DDSH) S DDSBY=DDSPY,DDSBX=DDSPX,DDSTP="h",DDSREP=1
! 88: E D
! 89: . S DDSBX=$P(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,0),U,3),DDSTP=$P(^(0),U,4) S DDSREP=$S($G(^(2)):^(2),1:1)
! 90: . K:DDSTP="e" DDSDO
! 91: . S DDSBY=$P(DDSBX,",")-1,DDSBX=$P(DDSBX,",",2)-1
! 92: . S:DDSBY<0 DDSBY=0 S:DDSBX<0 DDSBX=0
! 93: . S DDSBY=DDSBY+DDSPY,DDSBX=DDSBX+DDSPX
! 94: ;
! 95: ;Set @DDSREFS@(DDSPG,DDSB)
! 96: S @DDSREFS@(DDSPG,DDSB)=DDSBY_U_DDSBX_U_$P($G(^DIST(.404,DDSB,0)),U,2)_U_DDSDN_U_DDSTP_$S(DDSREP>1:U_U_+DDSREP,1:"")
! 97: ;
! 98: D:DDSPTB]"" PT^DDSPTR(DDSDDP,DDSPTB,DDSFRM,DDSPG,DDSB)
! 99: D EN^DDSZ1(DDSPG,DDSB,DDP,DDSBY,DDSBX,DDSBO,DDSTP,DDSREP,.DDSNDD,.DDSPGRP,.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
! 100: ;
! 101: K DDSBX,DDSBY,DDSDN,DDSPTB,DDSTP
! 102: Q
! 103: ;
! 104: DELALL ;Delete compile global for all forms
! 105: N DDSFRM,DDSFNUM,DDSREFS
! 106: W:'$D(DDSQUIET) !,"Deleting compiled form data ...",!
! 107: ;
! 108: S DDSFNUM=0
! 109: F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
! 110: . Q:$D(^DIST(.403,DDSFNUM,0))[0
! 111: . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U)
! 112: . S DDSREFS=$$REF^DDS0(DDSFRM)
! 113: . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
! 114: . D DEL(DDSFRM)
! 115: Q
! 116: ;
! 117: DEL(DDSFRM) ;Delete compiled global
! 118: N DDSREFS
! 119: S DDSREFS=$$REF^DDS0(DDSFRM) K @DDSREFS
! 120: S $P(^DIST(.403,+DDSFRM,0),U,11)=""
! 121: Q
! 122: ;
! 123: ERR(DDSFRM,DDSREFS) ;Print error, kill compiled global
! 124: Q:'$G(DIERR)
! 125: N DDSNAM
! 126: S DDSNAM=$P(DDSFRM,U,2)
! 127: S:DDSNAM="" DDSNAM=$P($G(^DIST(.403,+DDSFRM,0)),U)
! 128: D BLD^DIALOG(3002,DDSNAM)
! 129: S $P(^DIST(.403,+DDSFRM,0),U,11)=""
! 130: K @DDSREFS
! 131: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDSZ.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman