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

AZXRBUG8.m

Go to the documentation of this file. 
  1. AZXRBUG8 ;BUGDRUG2 Report PROGRAM [ 09/23/94   9:52 AM ]
  1.  ;Version 1
  1.  ;"Code Print Report"
  1.  ;10/07/92   JOHN H. LYNCH
  1.  ;
  1.  ;"Code Print Report" was written to provide all
  1.  ;Organism, and Specimen codes currently entered
  1.  ;into the system.  The user has the options of
  1.  ;printing these reports alphabetically or
  1.  ;numerically.
  1.  
  1.  ;THE ROUTINE THAT CALLS AZXRBUG8:
  1.  ;AZXRBUG3, Reports Menu
  1.  
  1.  ;THE ROUTINES THAT AZXRBUG8 CALLS:
  1.  ;None
  1.  
  1.  ;Variable List
  1.  ;PG=               Current page count.
  1.  ;LN=               Current line count.
  1.  ;TYPE=             The type of report to print, Organism/Specimen.
  1.  ;ORDER=            The order that the report is printed in,
  1.  ;                  alphabetically/numerically.
  1.  ;BORDER=           The border around heading.
  1.  ;BORDER2=          Name then code border.
  1.  ;BORDER3=          Code then name border.
  1.  ;Y=                Used to convert current internal date to external.
  1.  ;RDATE=            Report date; received from Y.
  1.  ;FILE=             Current file being used, 1991018 (ORGANISM)/
  1.  ;                  1991019 (SPECIMEN).
  1.  ;CURR=             Either, current Organism or current Code.
  1.  ;DA=               Internal entry number for cross-ref lookup.
  1.  ;YN=               Users input on whether to print another report.
  1.  
  1. MAIN ;AZXRBUG8 PROGRAM CONTROL    
  1.  ;SET LOCAL VARIABLES
  1.  S PG=0                                  ;INITIALIZE PAGE COUNT
  1.  S LN=0                                  ;INITIALIZE LINE COUNT
  1.  
  1.  D DTCNVRT
  1.  D INPUT
  1.  D KILL
  1.  Q
  1.  
  1. INPUT ;TAKE INPUT FROM USER
  1.  ;CHOOSE WHAT REPORT TO PRINT
  1.  
  1.  W @IOF                                  ;CLEAR SCREEN
  1.  W !!!,"BugDrug2 Code Print...",!
  1.  W !!,"Type an 'O' for Organism Code Print.",!
  1.  W "Type an 'S' for Specimen Code Print.",!
  1.  W "Type an '^' to quit.",!
  1. OPTTYPE R !!,"Option: ",TYPE
  1.  
  1.  I (TYPE="^")!(TYPE="") Q                ;USER WANTS TO QUIT
  1.  I (TYPE?1.3"?") D HELP G OPTTYPE
  1.  I '((TYPE?1"o")!(TYPE?1"O")!(TYPE?1"s")!(TYPE?1"S")) D ILLEGAL G OPTTYPE 
  1.  
  1. ORD ;TAKE INPUT FROM USER
  1.  ;ON WHAT ORDER REPORT SHOULD PRINT
  1.  W @IOF                                  ;CLEAR SCREEN
  1.  W !!!,"BugDrug2 Code Print...",!
  1.  W !!,"Type an 'A' for Alphabetical Order.",!
  1.  W "Type an 'N' for Numerical Order.",!
  1.  W "Type an '^' for previous prompt.",!
  1. OPTORDER R !!,"Option: ",ORDER
  1.  
  1.  I (ORDER="^")!(ORDER="") G INPUT        ;USER WANTS TO BACK UP
  1.  I (ORDER?1.3"?") D HELP1 G OPTORDER
  1.  I '((ORDER?1"a")!(ORDER?1"A")!(ORDER?1"n")!(ORDER?1"N")) D ILLEGAL G OPTORDER 
  1.  
  1.  D REPORT
  1.  Q
  1.  
  1. ILLEGAL ;ILLEGAL USER INPUT
  1.  W !!,*7,"Invalid input:  Press a '?' for help.",! H 2
  1.  Q
  1.  
  1. HELP ;GIVE USER GENERAL HELP ON "Code Print"
  1.  W !!,"O= Organism Code Print",?27,"S= Specimen Code Print",!
  1.  Q
  1.  
  1. HELP1 ;GIVE USER GENERAL HELP ON "Code Print"
  1.  W !!,"A= Alphabetical Order",?27,"N= Numerical Order",!
  1.  Q
  1.  
  1. REPORT ;PRINT USERS CHOICE OF REPORT
  1.  S BORDER="________________________________________________________________________________"
  1.  S BORDER2="Code     Name                                                                  "
  1.  S BORDER3="Name                            Code                                           "
  1.  D PGSETUP
  1.  G CONT
  1.  Q
  1.  
  1. DTCNVRT ;CONVERT CURRENT DATE TO EXTERNAL FORMAT (RDATE)
  1.  S Y=DT                                 ;CONVERT TO EXTERNAL DATE
  1.  D DD^%DT                               ;VALUE RETURNED IN Y
  1.  S RDATE=Y                              ;RDATE= REPORT DATE
  1.  Q
  1.  
  1. PGSETUP ;SETUP FOR EACH PAGE 
  1.  ;CHECK TYPE AND ORDER OF PRINT
  1.  ;OPEN AND CLOSE DEVICE
  1.  
  1.  W !!                                    ;SKIP LINES
  1.  D ^%ZIS U IO                            ;OPEN DEVICE
  1.  
  1.  I IO="" Q                               ;USER WANTS OUT
  1.  I IO(0)=IO W !,*7,"The BugDrug2 Code Print must be printed.",! X ^%ZIS("C") G PGSETUP
  1.  
  1.  
  1.  I (TYPE="O")!(TYPE="o")&(ORDER="A")!(ORDER="a") S TYPE="ORGALPH" D HEADING W BORDER3,!,BORDER,!! S LN=LN+3 D ORGALPH
  1.  I (TYPE="O")!(TYPE="o")&(ORDER="N")!(ORDER="n") S TYPE="ORGCODE" D HEADING W BORDER2,!,BORDER,!! S LN=LN+3 D ORGCODE
  1.  I (TYPE="S")!(TYPE="s")&(ORDER="A")!(ORDER="a") S TYPE="SPCALPH" D HEADING W BORDER3,!,BORDER,!! S LN=LN+3 D SPCALPH
  1.  I (TYPE="S")!(TYPE="s")&(ORDER="N")!(ORDER="n") S TYPE="SPCCODE" D HEADING W BORDER2,!,BORDER,!! S LN=LN+3 D SPCCODE
  1.  
  1.  X ^%ZIS("C")                            ;CLOSE DEVICE
  1.  Q
  1.  
  1. HEADING ;PRINT OUT THE HEADING FOR EACH NEW PAGE
  1.  
  1.  I PG>0 W #                              ;SEND FORMFEED
  1.  S PG=PG+1                               ;INCREMENT PAGE COUNTER
  1.  
  1.  W !,BORDER,!
  1.  W !,"BugDrug2"
  1.  W ?59,"Date: ",RDATE,!
  1.  I TYPE="ORGALPH" W !,"Organism Code Print by Name"
  1.  I TYPE="ORGCODE" W !,"Organism Code Print by Code"
  1.  I TYPE="SPCALPH" W !,"Specimen Code Print by Name"
  1.  I TYPE="SPCCODE" W !,"Specimen Code Print by Code"
  1.  W ?59,"Page: ",PG,!
  1.  W BORDER,!!
  1.  
  1.  S LN=8                                  ;INITIALIZE LINE COUNTER
  1.                                          ;HEADER USES 8 LINES
  1.  Q
  1.  
  1. ORGALPH ;ORGANISM IN ALPHABETICAL ORDER
  1.  ;SET LOCAL VARIABLES
  1.  S FILE="1991018"
  1.  S CURR=""                               ;CURR= INITIAL ORGANISM
  1.  F  S CURR=$O(^DIZ(FILE,"B",CURR)) Q:CURR=""  S DA=0  F  S DA=$O(^DIZ(FILE,"B",CURR,DA)) Q:'DA  D PRTALPH
  1.  Q
  1.  
  1. ORGCODE ;ORGANISM IN CODE ORDER
  1.  ;SET LOCAL VARIABLES
  1.  S FILE="1991018"
  1.  S CURR=999                              ;CURR= INITIAL CODE
  1.  F  S CURR=$O(^DIZ(FILE,"C",CURR)) Q:CURR=""  S DA=0  F  S DA=$O(^DIZ(FILE,"C",CURR,DA)) Q:'DA  D PRTCODE
  1.                                          ;DO CODES 001-099 FIRST
  1.  
  1.  S CURR=99                               ;CURR= INITIAL CODE
  1.  F  S CURR=$O(^DIZ(FILE,"C",CURR)) Q:(CURR<99)!(CURR="")  S DA=0  F  S DA=$O(^DIZ(FILE,"C",CURR,DA)) Q:'DA  D PRTCODE
  1.                                          ;DO CODES 100-999 LAST
  1.  Q
  1.  
  1. SPCALPH ;SPECIMEN IN ALPHABETICAL ORDER
  1.  ;SET LOCAL VARIABLES
  1.  S FILE="1991019"
  1.  S CURR=""                               ;CURR= INITIAL ORGANISM
  1.  F  S CURR=$O(^DIZ(FILE,"B",CURR)) Q:CURR=""  S DA=0  F  S DA=$O(^DIZ(FILE,"B",CURR,DA)) Q:'DA  D PRTALPH
  1.  Q
  1.  
  1. SPCCODE ;SPECIMEN IN CODE ORDER
  1.  ;SET LOCAL VARIABLES
  1.  S FILE="1991019"
  1.  S CURR=999                              ;CURR= INITIAL CODE
  1.  F  S CURR=$O(^DIZ(FILE,"C",CURR)) Q:CURR=""  S DA=0  F  S DA=$O(^DIZ(FILE,"C",CURR,DA)) Q:'DA  D PRTCODE
  1.                                          ;DO CODES 001-099 FIRST
  1.  
  1.  S CURR=99                               ;CURR= INITIAL CODE
  1.  F  S CURR=$O(^DIZ(FILE,"C",CURR)) Q:(CURR<99)!(CURR="")  S DA=0  F  S DA=$O(^DIZ(FILE,"C",CURR,DA)) Q:'DA  D PRTCODE
  1.                                          ;DO CODES 100-999 LAST
  1.  Q
  1.  
  1. PRTALPH ;PRINT SUB-ROUTINE FOR ALPHABETICAL ORDER BY ORG NAME
  1.  I LN+3>IOSL D HEADING W BORDER3,!,BORDER,!! S LN=LN+3         
  1.                                          ;CHECK IF NEW PAGE NEEDED 
  1.                                          ;WRITE PROPER BORDER
  1.  W CURR,?32,$P(^DIZ(FILE,DA,0),U,2),! S LN=LN+1
  1.                                          ;WRITE ALPHA, CODE
  1.                                          ;INCREMENT LINE COUNT
  1.  Q
  1.  
  1. PRTCODE ;PRINT SUB-ROUTINE FOR NUMERICAL ORDER BY CODE
  1.  I LN+3>IOSL D HEADING W BORDER2,!,BORDER,!! S LN=LN+3
  1.                                          ;CHECK IF NEW PAGE NEEDED 
  1.                                          ;WRITE PROPER BORDER
  1.  W CURR,?9,$P(^DIZ(FILE,DA,0),U,1),! S LN=LN+1
  1.                                          ;WRITE CODE, ALPHA
  1.                                          ;INCREMENT LINE COUNT
  1.  Q
  1.  
  1. CONT ;ASK USER WHETHER TO CONTINUE WITH REPORT PRINT
  1.  ;SET LOCAL VARIABLES
  1.  S PG=0                                  ;INITIALIZE PAGE COUNTER
  1.  S LN=0                                  ;INITIALIZE LINE COUNTER
  1.  
  1.  W !!!!!!!,"Do you want to print another"
  1.  R " 'Code Print' report? N//",YN
  1.                                          ;ASK USER WHETHER TO CONTINUE?
  1.  
  1.  I YN?1.3"?" W !!,"Answer with:  Y= Yes, N= No" G CONT
  1.                                          ;USER WANTS HELP
  1.  I (YN?1"Y")!(YN?1"y")!(YN?1"YES")!(YN?1"yes") G INPUT G CONT
  1.  Q
  1.  
  1. KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXRBUG8
  1.  K PG,LN,TYPE,ORDER,BORDER,BORDER2,BORDER3
  1.  K Y,RDATE,FILE,CURR,DA,YN
  1.  Q