Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDSZ

DDSZ.m

Go to the documentation of this file.
  1. DDSZ ;SFISC/MKO-FORM COMPILER ;17JUN2004
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;Prompt, compile
  1. N DDSFRM,DDSDDP,DDSREFS
  1. N C,DIC,X,Y
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. ;
  1. S DIC="^DIST(.403,",DIC(0)="AEQZ"
  1. D ^DIC K DIC Q:Y=-1!'$D(^DIST(.403,+Y,0))
  1. S DDSFRM=Y,DDSDDP=$P(Y(0),U,8)
  1. ;
  1. W !!,"Compiling "_$P(Y,U,2)_" (#"_+Y_") ...",!
  1. D EN(DDSFRM,DDSDDP)
  1. I $G(DIERR) W $C(7) D MSG^DIALOG("BW")
  1. Q
  1. ;
  1. ALL ;Compile all forms
  1. N DDSFRM,DDSDDP,DDSFNUM,DDSREFS
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. W:'$D(DDSQUIET) !,"Compiling all forms ...",!
  1. ;
  1. S DDSFNUM=0
  1. F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
  1. . Q:$D(^DIST(.403,DDSFNUM,0))[0
  1. . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U),DDSDDP=+$P(^(0),U,8)
  1. . S DDSREFS=$$REF^DDS0(DDSFRM)
  1. . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
  1. . D EN(DDSFRM,DDSDDP)
  1. . I $G(DIERR),'$D(DDSQUIET) W !,$C(7) D MSG^DIALOG("BW") W !
  1. Q
  1. ;
  1. EN(DDSFRM,DDSDDP,DDSREFS) ;Compile a form
  1. N DDSDO,DDSPG,DDSNDD,DDSPGRP
  1. ;
  1. S:'$G(DDSDDP) DDSDDP=$P(^DIST(.403,+DDSFRM,0),U,8)
  1. S:$G(DDSREFS)="" DDSREFS=$$REF^DDS0(DDSFRM)
  1. K @DDSREFS
  1. ;
  1. ;Find page groups
  1. D PGRP^DDSZ3(+DDSFRM,.DDSPGRP)
  1. ;
  1. S DDSPG=0,(DDSDO,DDSNDD)=1
  1. F S DDSPG=$O(^DIST(.403,+DDSFRM,40,DDSPG)) Q:'DDSPG D PG(DDSFRM,DDSPG,DDSDDP,.DDSDO,.DDSNDD) Q:$G(DIERR)
  1. I $G(DIERR) D ERR(DDSFRM,DDSREFS) Q
  1. S $P(^DIST(.403,+DDSFRM,0),U,9,11)=+$G(DDSDO)_U_+$G(DDSNDD)_U_1 ;DDSNDD=1 means don't need a starting DA
  1. Q
  1. ;
  1. PG(DDSFRM,DDSPG,DDSDDP,DDSDO,DDSNDD) ;Compile a page
  1. ;
  1. Q:$D(^DIST(.403,+DDSFRM,40,DDSPG,0))[0
  1. D:$P($G(^DIST(.403,+DDSFRM,40,DDSPG,1)),U,2)]"" ASUB^DDSZ3(DDSPG,DDSFRM)
  1. ;
  1. ;Get page coordinates
  1. S DDSPX=$P(^DIST(.403,+DDSFRM,40,DDSPG,0),U,3)
  1. S DDSPY=$P(DDSPX,",")-1,DDSPX=$P(DDSPX,",",2)-1
  1. S:DDSPY<0 DDSPY=0 S:DDSPX<0 DDSPX=0
  1. ;
  1. ;Compile header block
  1. S DDSB=$P($G(^DIST(.403,+DDSFRM,40,DDSPG,0)),U,2)
  1. I DDSB]"" D BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,"",1,"",.DDSNDD,.DDSSCR,.DDSNAV,.DDSORD) G:$G(DIERR) END
  1. ;
  1. ;Compile all other blocks on page
  1. 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
  1. ;
  1. D:$D(DDSSCR)!$D(DDSORD) EN^DDSZ2(.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
  1. ;
  1. END K DDSB,DDSBO,DDSMUL,DDSNAV,DDSORD
  1. K DDSP,DDSPX,DDSPY,DDSREP,DDSRNAV,DDSSCR
  1. Q
  1. ;
  1. BLK(DDSFRM,DDSPG,DDSDDP,DDSPY,DDSPX,DDSB,DDSBO,DDSH,DDSDO,DDSNDD,DDSSCR,DDSNAV,DDSORD) ;
  1. ;Compile block
  1. ; DDSH = 1 if header block
  1. ; DDSDO = killed if any edit blocks
  1. ; DDSNDD = killed if any DD fields
  1. ;
  1. N DDP
  1. I $D(^DIST(.404,DDSB,0))[0 D BLD^DIALOG(3051,"#"_DDSB) Q
  1. S DDSDN=$P(^DIST(.404,DDSB,0),U,3),DDP=+$P(^(0),U,2)
  1. ;
  1. S DDSPTB=""
  1. S:'$G(DDSH) DDSPTB=$G(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,1))
  1. ;
  1. ;Get DDSBY,DDSBX,DDSTP
  1. I $G(DDSH) S DDSBY=DDSPY,DDSBX=DDSPX,DDSTP="h",DDSREP=1
  1. E D
  1. . 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)
  1. . K:DDSTP="e" DDSDO
  1. . S DDSBY=$P(DDSBX,",")-1,DDSBX=$P(DDSBX,",",2)-1
  1. . S:DDSBY<0 DDSBY=0 S:DDSBX<0 DDSBX=0
  1. . S DDSBY=DDSBY+DDSPY,DDSBX=DDSBX+DDSPX
  1. IND . I DDSREP>1,+$G(^DIST(.403,+DDSFRM,21))=+$P($G(^DIST(.403,+DDSFRM,40,DDSPG,0)),U) D ;RECORD SELECTION PAGE USING REPEATING BLOCK
  1. ..N IND
  1. ..S IND=$P(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,2),U,2) I IND]"",$D(^DD(+DDSDDP,0,"IX",IND,+DDSDDP)) D
  1. ...S IND=^DIC(+DDSDDP,0,"GL")_""""_IND_"""" ;BUILD COMPUTED MULTIPLE OFF THE REPEATING-BLOCK INDEX
  1. ...I $D(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,"COMP MUL"))
  1. ...S ^("COMP MUL")="N D,DIMQ,DIMSTRT,DIMSCNT S (DIMQ,DIMSTRT)=$NA("_IND_")),DIMSCNT=$QL(DIMQ) F S DIMQ=$Q(@DIMQ) Q:DIMQ="""" Q:$NA(@DIMQ,DIMSCNT)'=DIMSTRT S D=$QS(DIMQ,$QL(DIMQ)) Q:'D I @DIMQ="""" N D0 S D0=D X DICMX"
  1. ..I $G(^DIST(.403,+DDSFRM,40,DDSPG,40,DDSB,"COMP MUL"))]"" S ^("COMP MUL PTR")=+DDSDDP
  1. ;
  1. ;Set @DDSREFS@(DDSPG,DDSB)
  1. 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:"")
  1. ;
  1. D:DDSPTB]"" PT^DDSPTR(DDSDDP,DDSPTB,DDSFRM,DDSPG,DDSB)
  1. D EN^DDSZ1(DDSPG,DDSB,DDP,DDSBY,DDSBX,DDSBO,DDSTP,DDSREP,.DDSNDD,.DDSPGRP,.DDSSCR,.DDSNAV,.DDSORD,.DDSRNAV)
  1. ;
  1. K DDSBX,DDSBY,DDSDN,DDSPTB,DDSTP
  1. Q
  1. ;
  1. ENGRP(DDSFRM) ;Compile a form and all forms that use any of the blocks
  1. ;on that form
  1. N DDSLST
  1. D FRMLST(DDSFRM,.DDSLST)
  1. ;
  1. ;Compile all forms in DDSLST
  1. S DDSFRM=0 F S DDSFRM=$O(DDSLST(DDSFRM)) Q:'DDSFRM D EN(DDSFRM)
  1. Q
  1. ;
  1. DELGRP(DDSFRM) ;Uncompile a form and all forms that use any of the blocks
  1. ;on that form
  1. N DDSLST
  1. D FRMLST(DDSFRM,.DDSLST)
  1. ;
  1. ;Uncompile all forms in DDSLST
  1. S DDSFRM=0 F S DDSFRM=$O(DDSLST(DDSFRM)) Q:'DDSFRM D DEL(DDSFRM)
  1. Q
  1. ;
  1. ENLIST(DDSROOT) ;Compile all forms in @DDSROOT
  1. N DDSFRM
  1. S DDSFRM=0 F S DDSFRM=$O(@DDSROOT@(DDSFRM)) Q:'DDSFRM D EN(DDSFRM)
  1. Q
  1. ;
  1. FRMLST(DDSFRM,DDSLST) ;Build list of forms that contain blocks on this form
  1. N DDSPG,DDSBK
  1. S DDSPG=0 F S DDSPG=$O(^DIST(.403,DDSFRM,40,DDSPG)) Q:'DDSPG D
  1. . D BLDLST($P($G(^DIST(.403,DDSFRM,40,DDSPG,0)),U,2),.DDSLST)
  1. . S DDSBK=0 F S DDSBK=$O(^DIST(.403,DDSFRM,40,DDSPG,40,DDSBK)) Q:'DDSBK D
  1. .. D BLDLST($P($G(^DIST(.403,DDSFRM,40,DDSPG,40,DDSBK,0)),U),.DDSLST)
  1. Q
  1. ;
  1. BLDLST(DDSBK,DDSLST) ;Build list of forms that contain a given block
  1. N DDSFRM
  1. Q:'$G(DDSBK)
  1. S DDSFRM=0 F S DDSFRM=$O(^DIST(.403,"AB",DDSBK,DDSFRM)) Q:'DDSFRM S DDSLST(DDSFRM)=""
  1. S DDSFRM=0 F S DDSFRM=$O(^DIST(.403,"AC",DDSBK,DDSFRM)) Q:'DDSFRM S DDSLST(DDSFRM)=""
  1. Q
  1. ;
  1. DELALL ;Delete compile global for all forms
  1. N DDSFRM,DDSFNUM,DDSREFS
  1. W:'$D(DDSQUIET) !,"Deleting compiled form data ...",!
  1. ;
  1. S DDSFNUM=0
  1. F S DDSFNUM=$O(^DIST(.403,DDSFNUM)) Q:'DDSFNUM D
  1. . Q:$D(^DIST(.403,DDSFNUM,0))[0
  1. . S DDSFRM=DDSFNUM_U_$P(^DIST(.403,DDSFNUM,0),U)
  1. . W:'$D(DDSQUIET) !?3,$P(DDSFRM,U,2),?35,"(#"_+DDSFRM_")"
  1. . D DEL(DDSFRM)
  1. Q
  1. ;
  1. DEL(DDSFRM) ;Delete compiled global
  1. N DDSREFS
  1. S DDSREFS=$$REF^DDS0(DDSFRM) K @DDSREFS
  1. S $P(^DIST(.403,+DDSFRM,0),U,11)=""
  1. Q
  1. ;
  1. ERR(DDSFRM,DDSREFS) ;Print error, kill compiled global
  1. Q:'$G(DIERR)
  1. N DDSNAM
  1. S DDSNAM=$P(DDSFRM,U,2)
  1. S:DDSNAM="" DDSNAM=$P($G(^DIST(.403,+DDSFRM,0)),U)
  1. D BLD^DIALOG(3002,DDSNAM)
  1. S $P(^DIST(.403,+DDSFRM,0),U,11)=""
  1. K @DDSREFS
  1. Q