RACMPLE ;HISC-GJC/Compile Rad/Nuc Med input/print templates ;10/20/97 14:46
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
N D1,DIR,DIROUT,DIRUT,DMAX,DTOUT,DUOUT,RA1,RA2,RAFLENAM,RAFLENUM,RADMAX
N RAMAX,RAMIN,RANODE,RAROOT,RAXIT,X,Y,Z D:'$D(IOF) HOME^%ZIS W @IOF
K ^TMP($J,"RA INPUT TEMP"),^TMP($J,"RA PRINT TEMP")
W !?5,"This option will compile all Radiology/Nuclear Medicine input"
W !?5,"and print templates (within the defined file number range) which"
W !?5,"are currently compiled on your system. Since these templates"
W !?5,"are critical to the operation of the software, it is strongly"
W !?5,"advised that all Radiology/Nuclear Medicine users be off the"
W !?5,"system. It is also strongly advised that the compilation of"
W !?5,"templates be done when system activity is at a minimum.",!
S DIR(0)="YA",DIR("A")="Is it ok to continue? ",DIR("B")="No"
S DIR("?",1)="Enter 'Yes' to continue the compilation process, or 'No'"
S DIR("?")="to abort the compilation process."
D ^DIR Q:'+Y K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y W !
S RAMAX=+$$ROUSIZE^DILF,RAMIN=2400,RAXIT=0
S RAMAX=$S(RAMAX>RAMIN:RAMAX,1:5000)
S DIR(0)="NA^"_RAMIN_":"_RAMAX_":0",DIR("B")=RAMAX
S DIR("A")="Maximum routine size on this computer in bytes. "
S DIR("A")=DIR("A")_"(2400-"_RAMAX_") : "
S DIR("?",1)="This number will be used to determine the size of the"
S DIR("?",2)="compiled template routines. The size must be a number"
S DIR("?",3)="greater than "_RAMIN_" the larger the better, up to the"
S DIR("?")="maximum routine size for your operating system." D ^DIR
Q:$D(DIRUT) S RADMAX=+Y W !!
S RAMAX=79.99,RAMIN=70 ; File range for the Rad/Nuc Med package
F RAROOT="^DIE(","^DIPT(" D Q:RAXIT
. S RADIC=RAROOT,RADIC(0)="QEAZ"
. S RADIC("A")="Select Rad/Nuc Med"_$S(RAROOT="^DIE(":" Input",1:" Print")
. S RADIC("A")=RADIC("A")_" Template: "
. S RADIC("S")="N RA S RA(0)=$G(^(0)),RA(""ROU"")=$G(^(""ROU"")) "
. S RADIC("S")=RADIC("S")_"I $E($P(RA(0),""^""),1,2)=""RA"","
. S RADIC("S")=RADIC("S")_"($P(RA(0),""^"",4)'<RAMIN),"
. S RADIC("S")=RADIC("S")_"($P(RA(0),""^"",4)'>RAMAX),(RA(""ROU"")]"""")"
. S RADIC("W")="W "" File #: ""_$P($G(^(0)),""^"",4)"
. S RAUTIL=$S(RAROOT="^DIE(":"RA INPUT TEMP",1:"RA PRINT TEMP")
. W @IOF D EN1^RASELCT(.RADIC,RAUTIL,"",1)
. I '$D(^TMP($J,RAUTIL)),(RAROOT="^DIE(") D
.. S DIR(0)="YA",DIR("A",1)="You have not selected any Input Templates."
.. S DIR("A")="Do you wish to continue with Print Templates? "
.. S DIR("B")="No",DIR("?")="Enter 'Yes' to continue, 'No' to exit."
.. W ! D ^DIR
.. S:'+Y RAXIT=1 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
.. Q
. K %,%W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
. Q
I '$D(^TMP($J,"RA INPUT TEMP")),('$D(^TMP($J,"RA PRINT TEMP"))) D Q
. W !!?5,"You have not selected any template(s) to be compiled.",$C(7)
. Q
Q:'$$ASKCMPL()
F RAROOT="^TMP($J,""RA INPUT TEMP""","^TMP($J,""RA PRINT TEMP""" D
. S RA1="" F S RA1=$O(@(RAROOT_","""_RA1_""")")) Q:RA1']"" D
.. S RA2=0 F S RA2=$O(@(RAROOT_","""_RA1_""","_RA2_")")) Q:RA2'>0 D
... S RANODE("ROU")=$$GET1^DIQ($S(RAROOT["INPUT":.402,1:.4),RA2_",",1815,"")
... S DMAX=RADMAX
... S RAFLENUM=$$GET1^DIQ($S(RAROOT["INPUT":.402,1:.4),RA2_",",4,"I")
... S RAFLENAM=$$GET1^DIQ($S(RAROOT["INPUT":.402,1:.4),RA2_",",4,"")
... S Y=RA2,X=$P(RANODE("ROU"),"^",2) Q:X']""
... W !!?3,$S(RAROOT["INPUT":"Input",1:"Print")_" template to be"
... W " compiled: "_RA1
... W !?3,"For file #"_RAFLENUM_": ",RAFLENAM
... W !?3,"Routines filed under the following namespace: '",X_"'."
... D @$S(RAROOT["INPUT":"EN^DIEZ",1:"EN^DIPZ") W !?3,"Done!"
... Q
.. Q
. Q
K ^TMP($J,"RA INPUT TEMP"),^TMP($J,"RA PRINT TEMP")
Q
ASKCMPL() ; Ask the user if they wish to compile the selected templates.
N X,Y S DIR(0)="YA"
S DIR("A")="Are you sure you wish to compile the selected templates? "
S DIR("B")="No",DIR("?")="Enter 'Yes' to compile, 'No' to exit."
W ! D ^DIR K DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q Y ; (Y=1 for yes, Y=0 for no)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRACMPLE 4037 printed Apr 09, 2024@21:38:04 Page 2
RACMPLE ;HISC-GJC/Compile Rad/Nuc Med input/print templates ;10/20/97 14:46
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 NEW D1,DIR,DIROUT,DIRUT,DMAX,DTOUT,DUOUT,RA1,RA2,RAFLENAM,RAFLENUM,RADMAX
+3 NEW RAMAX,RAMIN,RANODE,RAROOT,RAXIT,X,Y,Z
if '$DATA(IOF)
DO HOME^%ZIS
WRITE @IOF
+4 KILL ^TMP($JOB,"RA INPUT TEMP"),^TMP($JOB,"RA PRINT TEMP")
+5 WRITE !?5,"This option will compile all Radiology/Nuclear Medicine input"
+6 WRITE !?5,"and print templates (within the defined file number range) which"
+7 WRITE !?5,"are currently compiled on your system. Since these templates"
+8 WRITE !?5,"are critical to the operation of the software, it is strongly"
+9 WRITE !?5,"advised that all Radiology/Nuclear Medicine users be off the"
+10 WRITE !?5,"system. It is also strongly advised that the compilation of"
+11 WRITE !?5,"templates be done when system activity is at a minimum.",!
+12 SET DIR(0)="YA"
SET DIR("A")="Is it ok to continue? "
SET DIR("B")="No"
+13 SET DIR("?",1)="Enter 'Yes' to continue the compilation process, or 'No'"
+14 SET DIR("?")="to abort the compilation process."
+15 DO ^DIR
if '+Y
QUIT
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
WRITE !
+16 SET RAMAX=+$$ROUSIZE^DILF
SET RAMIN=2400
SET RAXIT=0
+17 SET RAMAX=$SELECT(RAMAX>RAMIN:RAMAX,1:5000)
+18 SET DIR(0)="NA^"_RAMIN_":"_RAMAX_":0"
SET DIR("B")=RAMAX
+19 SET DIR("A")="Maximum routine size on this computer in bytes. "
+20 SET DIR("A")=DIR("A")_"(2400-"_RAMAX_") : "
+21 SET DIR("?",1)="This number will be used to determine the size of the"
+22 SET DIR("?",2)="compiled template routines. The size must be a number"
+23 SET DIR("?",3)="greater than "_RAMIN_" the larger the better, up to the"
+24 SET DIR("?")="maximum routine size for your operating system."
DO ^DIR
+25 if $DATA(DIRUT)
QUIT
SET RADMAX=+Y
WRITE !!
+26 ; File range for the Rad/Nuc Med package
SET RAMAX=79.99
SET RAMIN=70
+27 FOR RAROOT="^DIE(","^DIPT("
Begin DoDot:1
+28 SET RADIC=RAROOT
SET RADIC(0)="QEAZ"
+29 SET RADIC("A")="Select Rad/Nuc Med"_$SELECT(RAROOT="^DIE(":" Input",1:" Print")
+30 SET RADIC("A")=RADIC("A")_" Template: "
+31 SET RADIC("S")="N RA S RA(0)=$G(^(0)),RA(""ROU"")=$G(^(""ROU"")) "
+32 SET RADIC("S")=RADIC("S")_"I $E($P(RA(0),""^""),1,2)=""RA"","
+33 SET RADIC("S")=RADIC("S")_"($P(RA(0),""^"",4)'<RAMIN),"
+34 SET RADIC("S")=RADIC("S")_"($P(RA(0),""^"",4)'>RAMAX),(RA(""ROU"")]"""")"
+35 SET RADIC("W")="W "" File #: ""_$P($G(^(0)),""^"",4)"
+36 SET RAUTIL=$SELECT(RAROOT="^DIE(":"RA INPUT TEMP",1:"RA PRINT TEMP")
+37 WRITE @IOF
DO EN1^RASELCT(.RADIC,RAUTIL,"",1)
+38 IF '$DATA(^TMP($JOB,RAUTIL))
IF (RAROOT="^DIE(")
Begin DoDot:2
+39 SET DIR(0)="YA"
SET DIR("A",1)="You have not selected any Input Templates."
+40 SET DIR("A")="Do you wish to continue with Print Templates? "
+41 SET DIR("B")="No"
SET DIR("?")="Enter 'Yes' to continue, 'No' to exit."
+42 WRITE !
DO ^DIR
+43 if '+Y
SET RAXIT=1
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+44 QUIT
End DoDot:2
+45 KILL %,%W,%Y1,DIC,RADIC,RAQUIT,RAUTIL,X,Y
+46 QUIT
End DoDot:1
if RAXIT
QUIT
+47 IF '$DATA(^TMP($JOB,"RA INPUT TEMP"))
IF ('$DATA(^TMP($JOB,"RA PRINT TEMP")))
Begin DoDot:1
+48 WRITE !!?5,"You have not selected any template(s) to be compiled.",$CHAR(7)
+49 QUIT
End DoDot:1
QUIT
+50 if '$$ASKCMPL()
QUIT
+51 FOR RAROOT="^TMP($J,""RA INPUT TEMP""","^TMP($J,""RA PRINT TEMP"""
Begin DoDot:1
+52 SET RA1=""
FOR
SET RA1=$ORDER(@(RAROOT_","""_RA1_""")"))
if RA1']""
QUIT
Begin DoDot:2
+53 SET RA2=0
FOR
SET RA2=$ORDER(@(RAROOT_","""_RA1_""","_RA2_")"))
if RA2'>0
QUIT
Begin DoDot:3
+54 SET RANODE("ROU")=$$GET1^DIQ($SELECT(RAROOT["INPUT":.402,1:.4),RA2_",",1815,"")
+55 SET DMAX=RADMAX
+56 SET RAFLENUM=$$GET1^DIQ($SELECT(RAROOT["INPUT":.402,1:.4),RA2_",",4,"I")
+57 SET RAFLENAM=$$GET1^DIQ($SELECT(RAROOT["INPUT":.402,1:.4),RA2_",",4,"")
+58 SET Y=RA2
SET X=$PIECE(RANODE("ROU"),"^",2)
if X']""
QUIT
+59 WRITE !!?3,$SELECT(RAROOT["INPUT":"Input",1:"Print")_" template to be"
+60 WRITE " compiled: "_RA1
+61 WRITE !?3,"For file #"_RAFLENUM_": ",RAFLENAM
+62 WRITE !?3,"Routines filed under the following namespace: '",X_"'."
+63 DO @$SELECT(RAROOT["INPUT":"EN^DIEZ",1:"EN^DIPZ")
WRITE !?3,"Done!"
+64 QUIT
End DoDot:3
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
+67 KILL ^TMP($JOB,"RA INPUT TEMP"),^TMP($JOB,"RA PRINT TEMP")
+68 QUIT
ASKCMPL() ; Ask the user if they wish to compile the selected templates.
+1 NEW X,Y
SET DIR(0)="YA"
+2 SET DIR("A")="Are you sure you wish to compile the selected templates? "
+3 SET DIR("B")="No"
SET DIR("?")="Enter 'Yes' to compile, 'No' to exit."
+4 WRITE !
DO ^DIR
KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+5 ; (Y=1 for yes, Y=0 for no)
QUIT Y
