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