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 Dec 13, 2024@02:53:30 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...'
