- 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)
- 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
