- DIPZ0 ;SFISC/TKW-COMPILE PRINT TEMPLATES ;19JAN2010
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- SIZ(DITYP) ;PROMPT FOR SIZE OF COMPILED ROUTINE
- ;PARAMETER DITYP CONTAINS A NUMBER IN DIALOG FILE POINTING TO EITHER
- ;TEXT FOR A TEMPLATE TYPE, OR TO THE TEXT 'CROSS-REFERENCES'.
- N %,DIR
- S %=$G(^DD("ROU")) S:'% %=$P($G(^DD("OS",DISYS,0)),U,4) S:'% %=5000
- S DIR(0)="N^2400:"_%_":0",DIR("B")=%,DIR("A")=$$EZBLD^DIALOG(8027)
- K % S %(1)=$$EZBLD^DIALOG(DITYP) D BLD^DIALOG(9002,.%,"","DIR(""?"")")
- D ^DIR Q
- ;
- RNM(DITYP) ;PROMPT FOR COMPILED ROUTINE NAME
- ;PARAMETER SAME AS FOR SIZ.
- N %,DIR,DIRNM
- S DIRNM="" D
- .I DITYP<8036 S DIRNM=$G(@(DIC_DIPZ_",""ROUOLD"")")),DIRNM(1)=$G(@(DIC_DIPZ_",""ROU"")"))
- .E S DIRNM=$G(@("^DD("_DIPZ_",0,""DIKOLD"")")),DIRNM(1)=$G(@("^DD("_DIPZ_",0,""DIK"")")) S:DIRNM="" DIRNM=DIRNM(1)
- .Q
- I DIRNM(1)]"" S DIR(0)="Y",DIR("B")="NO" D D ^DIR K DIR Q:$D(DIRUT) I Y D UNC Q
- .K % S %(1)=$$EZBLD^DIALOG(DITYP),%(2)=DIRNM(1)
- .D BLD^DIALOG(8028,.%,"","DIR(""A"")")
- .K %(2) D BLD^DIALOG(9004,.%,"","DIR(""?"")")
- .Q
- S %=7 ;S:DITYP=8036 %=6
- S DIR(0)="F^3:"_%_"^K:X'?1U.NU&(X'?1""%""1U.NU)!(X?1""DI"".E) X" S:DIRNM]"" DIR("B")=DIRNM
- D BLD^DIALOG(8001,"","","DIR(""A"")"),BLD^DIALOG(9006,%,"","DIR(""?"")")
- D ^DIR K DIR Q:$D(DIRUT)!(X="")
- I $L(X)>6 D
- .N A,% D BLD^DIALOG(8031,"","","A") W $C(7),! F %=0:0 S %=$O(A(%)) Q:'% W A(%),!
- .W ! Q
- I $$ROUEXIST^DILIBF(X) K % S %(1)=U_X D BLD^DIALOG(8016,.%,"","DIR") W $C(7),!?5,DIR K DIR
- Q
- UNC ;UNCOMPILE TEMPLATES/CROSS-REFS
- N %,DIR,DIPZ0 I DITYP<8036 K @(DIC_DIPZ_",""ROU"")") S DIPZ0=$G(^("ROUOLD")) D
- . I DITYP=8033 D UNCAF^DIEZ(DIPZ)
- .D DELETROU^DIEZ(DIPZ0)
- E S X=DIPZ D A^DIU21
- S %(1)=$$EZBLD^DIALOG(DITYP) D BLD^DIALOG(8026,.%,"","DIR(""A"")") ;'IS NOW UNCOMPILED'
- W $C(7),!!,DIR("A")
- S X="" Q
- ;
- ;DIALOG #8001 'Routine Name'
- ; #8016 'Note that...is already in the routine directory'
- ; #8027 'Maximum routine size on this computer...'
- ; #8028 '...currently compiled under namespace...UNCOMPILE...'
- ; #8031 'WARNING!! Since the namespace...routine...so long...'
- ; #8033 'Input template'
- ; #8034 'Print Template'
- ; #8036 'Cross-Reference(s)'
- ; #9002 'This number will be used to determine how large...'
- ; #9004 'Answer YES to UNCOMPILE the ...'
- ; #9006 'Enter a valid MUMPS routine name...'
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIPZ0 2683 printed Mar 13, 2025@21:58:21 Page 2
- DIPZ0 ;SFISC/TKW-COMPILE PRINT TEMPLATES ;19JAN2010
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- SIZ(DITYP) ;PROMPT FOR SIZE OF COMPILED ROUTINE
- +1 ;PARAMETER DITYP CONTAINS A NUMBER IN DIALOG FILE POINTING TO EITHER
- +2 ;TEXT FOR A TEMPLATE TYPE, OR TO THE TEXT 'CROSS-REFERENCES'.
- +3 NEW %,DIR
- +4 SET %=$GET(^DD("ROU"))
- if '%
- SET %=$PIECE($GET(^DD("OS",DISYS,0)),U,4)
- if '%
- SET %=5000
- +5 SET DIR(0)="N^2400:"_%_":0"
- SET DIR("B")=%
- SET DIR("A")=$$EZBLD^DIALOG(8027)
- +6 KILL %
- SET %(1)=$$EZBLD^DIALOG(DITYP)
- DO BLD^DIALOG(9002,.%,"","DIR(""?"")")
- +7 DO ^DIR
- QUIT
- +8 ;
- RNM(DITYP) ;PROMPT FOR COMPILED ROUTINE NAME
- +1 ;PARAMETER SAME AS FOR SIZ.
- +2 NEW %,DIR,DIRNM
- +3 SET DIRNM=""
- Begin DoDot:1
- +4 IF DITYP<8036
- SET DIRNM=$GET(@(DIC_DIPZ_",""ROUOLD"")"))
- SET DIRNM(1)=$GET(@(DIC_DIPZ_",""ROU"")"))
- +5 IF '$TEST
- SET DIRNM=$GET(@("^DD("_DIPZ_",0,""DIKOLD"")"))
- SET DIRNM(1)=$GET(@("^DD("_DIPZ_",0,""DIK"")"))
- if DIRNM=""
- SET DIRNM=DIRNM(1)
- +6 QUIT
- End DoDot:1
- +7 IF DIRNM(1)]""
- SET DIR(0)="Y"
- SET DIR("B")="NO"
- Begin DoDot:1
- +8 KILL %
- SET %(1)=$$EZBLD^DIALOG(DITYP)
- SET %(2)=DIRNM(1)
- +9 DO BLD^DIALOG(8028,.%,"","DIR(""A"")")
- +10 KILL %(2)
- DO BLD^DIALOG(9004,.%,"","DIR(""?"")")
- +11 QUIT
- End DoDot:1
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- IF Y
- DO UNC
- QUIT
- +12 ;S:DITYP=8036 %=6
- SET %=7
- +13 SET DIR(0)="F^3:"_%_"^K:X'?1U.NU&(X'?1""%""1U.NU)!(X?1""DI"".E) X"
- if DIRNM]""
- SET DIR("B")=DIRNM
- +14 DO BLD^DIALOG(8001,"","","DIR(""A"")")
- DO BLD^DIALOG(9006,%,"","DIR(""?"")")
- +15 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!(X="")
- QUIT
- +16 IF $LENGTH(X)>6
- Begin DoDot:1
- +17 NEW A,%
- DO BLD^DIALOG(8031,"","","A")
- WRITE $CHAR(7),!
- FOR %=0:0
- SET %=$ORDER(A(%))
- if '%
- QUIT
- WRITE A(%),!
- +18 WRITE !
- QUIT
- End DoDot:1
- +19 IF $$ROUEXIST^DILIBF(X)
- KILL %
- SET %(1)=U_X
- DO BLD^DIALOG(8016,.%,"","DIR")
- WRITE $CHAR(7),!?5,DIR
- KILL DIR
- +20 QUIT
- UNC ;UNCOMPILE TEMPLATES/CROSS-REFS
- +1 NEW %,DIR,DIPZ0
- IF DITYP<8036
- KILL @(DIC_DIPZ_",""ROU"")")
- SET DIPZ0=$GET(^("ROUOLD"))
- Begin DoDot:1
- +2 IF DITYP=8033
- DO UNCAF^DIEZ(DIPZ)
- +3 DO DELETROU^DIEZ(DIPZ0)
- End DoDot:1
- +4 IF '$TEST
- SET X=DIPZ
- DO A^DIU21
- +5 ;'IS NOW UNCOMPILED'
- SET %(1)=$$EZBLD^DIALOG(DITYP)
- DO BLD^DIALOG(8026,.%,"","DIR(""A"")")
- +6 WRITE $CHAR(7),!!,DIR("A")
- +7 SET X=""
- QUIT
- +8 ;
- +9 ;DIALOG #8001 'Routine Name'
- +10 ; #8016 'Note that...is already in the routine directory'
- +11 ; #8027 'Maximum routine size on this computer...'
- +12 ; #8028 '...currently compiled under namespace...UNCOMPILE...'
- +13 ; #8031 'WARNING!! Since the namespace...routine...so long...'
- +14 ; #8033 'Input template'
- +15 ; #8034 'Print Template'
- +16 ; #8036 'Cross-Reference(s)'
- +17 ; #9002 'This number will be used to determine how large...'
- +18 ; #9004 'Answer YES to UNCOMPILE the ...'
- +19 ; #9006 'Enter a valid MUMPS routine name...'
