AZXRBUG1 ;BUGDRUG2 Entry/Edit PROGRAM [ 09/23/94 9:50 AM ]
;Version 1
;08/04/92 JOHN H. LYNCH
;
;ALLOWS THE DATA ENTRY PERSON TO ENTER OR
;EDIT INFORMATION IN THE BUGDRUG2 DATABASE.
;THE ROUTINES THAT CALL AZXRBUG2:
;AZXRBUG, Main
;THE ROUTINES THAT AZXRBUG2 CALLS:
;EN^DIK (FILEMAN RE-CROSS-REF ROUTINE)
;^DIE (FILEMAN EDIT ROUTINE)
;^DIC (FILEMAN LOOKUP ROUTINE)
;SET LOCAL VARIABLES OUTSIDE OF MAIN
S FLAG=-1 ;FLAG= A CHECK FOR NEW ENTRIES
;WHICH RUN DEFAULT SUB-ROUTINE
;THE DEFAULT SUB-ROUTINE WILL
;ONLY BE RUN AFTER THE FIRST
;NEW ENTRY.
;Variable List
;FLAG= A flag which alerts program to run DEFAULT sub-routine.
;DIE("NO^")= Keeps user from exiting once in; allows jumping though.
;DIE= BUGDRUG2 database global.
;INUM= The current internal entry number.
;TCOUNT= The total count of current entries in the file.
;SNUM= The users input of the record number.
;PIEC= Starting point of lookup for users SNUM entry.
;DA= Internal entry number used during lookup.
;DR= Used as entry/edit setup in calling Fileman.
;X= Used in setting the default values for Entry/Edit
;DIK= Global root of file for re-indexing.
;DIK(1)= Specifies which field and cross-ref. to re-index.
;DIC(0)= Setup values for Fileman lookup.
;DDA= Default Internal Entry Number.
;DFAC= Default Facility.
;DIC= Global root of file for Fileman lookup.
;DDATE= Default Date.
;Y= The returned value from Fileman lookup.
;DORG= Default Organism_Name.
;DSPEC= Default Specimen_Name.
MAIN ;AZXRBUG1 PROGRAM CONTROL
;SET LOCAL VARIABLES
S DIE("NO^")="BACK" ;KEEP USER FROM EXITING
;ALLOW JUMPING
S DIE="1991020" ;^BUGDRUG2 (DATABASE GLOBAL)
W @IOF ;CLEAR SCREEN
W !!!,"BugDrug2 Entry/Edit...",!!
RECORD ;Select Record Number: ;SUB-ROUTINE
;SET LOCAL VARIABLES
S INUM=$P(^DIZ(DIE,0),U,3) ;INUM= CURR. INTERNAL NUMBER
S TCOUNT=$P(^DIZ(DIE,0),U,4) ;TCOUNT= TOTAL COUNT CURRENT
;IN FILE
W !,"Select Record Number: ",INUM+1,"//"
R SNUM
I (SNUM'="")&(SNUM'?1.3"?")&(SNUM'="^")&'((SNUM>0)&(SNUM<1000000))&(SNUM'?1.6N) W !!,"Illegal Record Number.",!!," Enter a Record Number between [1..999999], or",!," Enter a ""?"" for help, or",!," Enter a ""^"" to quit.",!,*7 G RECORD
;CHECK FOR VALID USER INPUT
I SNUM="" S SNUM=INUM+1 ;DEFAULT (NEW ENTRY)
I SNUM="^" D KILL Q ;"^"= QUIT/RETURN TO AZXRBUG
I SNUM?1.3"?" W !!,"Please enter your Record Number or",!,"press return and accept the default for a new entry.",! G RECORD
I (SNUM=(INUM+1)) S $P(^DIZ(DIE,0),U,3)=INUM+1,$P(^DIZ(DIE,0),U,4)=TCOUNT+1 S FLAG=FLAG+1 I FLAG D DEFAULT ;SNUM= NEW ENTRY
;INCREMENT COUNTERS IN
;^DIZ(DIE,0)
;FLAG= SET DEFAULT VALUES FOR
;ENTRY SCREEN (AFTER 1ST ENTRY)
I SNUM>(INUM+1) W !!,"SKIPPING RECORD NUMBERS IS NOT ALLOWED!",*7 H 3 G MAIN ;USER TRYING TO ENTER NUMBER
;OUT OF SEQUENCE
S PIEC=0
I (SNUM<(INUM+1))&('$O(^DIZ(DIE,"B",SNUM,PIEC))) W !!,"RECORD NUMBER, ",SNUM,", HAS ALREADY BEEN DELETED!",!,*7 H 3 G RECORD
;LOOK UP USER INPUT TO SEE IF
;IT ALREADY EXISTS, IF NOT SAY
;IT HAS BEEN ALREADY DELETED
S PIEC=0
S DA=SNUM ;DA= INTERNAL ENTRY NUMBER
I (SNUM<(INUM+1))&($O(^DIZ(DIE,"B",SNUM,PIEC))) K ^DIZ(DIE,"FOD",$P(^DIZ(DIE,DA,0),U,2),$P(^DIZ(DIE,DA,0),U,4),$P(^DIZ(DIE,DA,0),U,3),DA),^DIZ(DIE,"FDSO",$P(^DIZ(DIE,DA,0),U,2),$P(^DIZ(DIE,DA,0),U,3),$P(^DIZ(DIE,DA,0),U,5),$P(^DIZ(DIE,DA,0),U,4),DA)
;LOOK UP USER INPUT TO SEE IF
;IT ALREADY EXISTS, IF IT DOES
;DELETE "FOD" & "FDSO"
;CROSS-REFERENCE
L ^DIZ(DIE,DA):0 I '$T W !!,"RECORD HAS BEEN LOCKED, TRY AGAIN LATER!",! H 3 G RECORD ;LOCK RECORD
;INTO ^BUGDRUG2 DATABASE
I (SNUM'=(INUM+1))!('FLAG) S DR=".01///^S X=DA;1;2;3;4;15;16;18;21;7;12;13;20;17;23;24;8;19;14;10;26;6;11;25;22;5;9" D ^DIE G UNLOCK
;SETUP FOR CALL TO FILEMAN
;--EDIT AN ENTRY or
;--FLAG NOT SET YET
;DR= STUFF .01 (Record Number)
;CALL FILEMAN EDIT
S DR=".01///^S X=DA" ;SETUP FOR CALL TO FILEMAN
;--NEW ENTRY and
;--FLAG IS SET
;DR= STUFF .01 (Record Number)
D ^DIE ;CALL FILEMAN ENTRY
S DR="1//^S X=DFAC" ;SET DEFAULT (DFAC) FACILITY
D ^DIE ;CALL FILEMAN ENTRY
S DR="2//^S X=DDATE" ;SET DEFAULT (DDATE) DATE
D ^DIE ;CALL FILEMAN ENTRY
S DR="3//^S X=DORG" ;SET DEFAULT (DORG) Organism
D ^DIE ;CALL FILEMAN ENTRY
S DR="4//^S X=DSPEC;15;16;18;21;7;12;13;20;17;23;24;8;19;14;10;26;6;11;25;22;5;9"
;SET DEFAULT (DSPEC) Specimen
;ENTER IN SPECIFIC ORDER
D ^DIE ;CALL FILEMAN ENTRY
UNLOCK D INDEX L ;CALL FILEMAN FOR ENTRY/EDIT
;CALL INDEX (RE-CROSS-REF.)
;UNLOCK RECORD
G MAIN ;SET UP FOR NEXT ENTRY/EDIT
Q
INDEX ;RE-INDEX "FOD" AND "FDSO" CROSS-REFS.
;SET LOCAL VARIABLES
S DA=SNUM ;DA= INTERNAL ENTRY NUMBER
S DIK="^DIZ(1991020," ;GLOBAL ROOT (^BUGDRUG2)
S DIK(1)="3^FOD" ;Organism_Name, "FOD" CR-REF
D EN^DIK ;RE-INDEX "FOD"
S DIK(1)="4^FDSO" ;Specimen_Name, "FDSO" CR-REF
D EN^DIK ;RE-INDEX "FDSO"
Q
DEFAULT ;SET UP NEW DEFAULT VALUES FOR
;Facility, Date, Organism_Name, Specimen_Name
;SET LOCAL VARIABLES
S DIC(0)="NXZ" ;N= INTERNAL NUMBER LOOKUP
;X= EXACT MATCH REQUIRED
;Z= VALUES RETURNED IN Y=N^S
; N= INTERNAL ENTRY NUMBER
; S= VALUE OF .01 FIELD
S DDA=SNUM-1 ;DDA= DEFAULT INTERNAL NUMBER
S DFAC=$P(^DIZ(1991020,DDA,0),U,2) ;DFAC= DEFAULT Facility CODE
S DIC="^DIZ(1991010," ;DIC= SITES FILE
S X=DFAC ;X= LOOKUP VALUE (DFAC)
D ^DIC ;DO FILEMAN LOOKUP
S DFAC=$P(^DIZ(1991010,$P(Y,U,1),0),U,1)
;DFAC= DEFAULT Facility NAME
S DDATE=$P(^DIZ(1991020,DDA,0),U,3) ;DDATE= DEFAULT Date (Fileman)
S Y=DDATE D DD^%DT S DDATE=Y ;DDATE= DEFAULT External Date
S DORG=$P(^DIZ(1991020,DDA,0),U,4) ;DORG= DEFAULT Organism_Code
S DIC="^DIZ(1991018," ;DIC= ORGANISM FILE
S X=DORG ;X= LOOKUP VALUE (DORG)
D ^DIC ;DO FILEMAN LOOKUP
S DORG=$P(^DIZ(1991018,$P(Y,U,1),0),U,1)
;DORG= DEFAULT Organism_Name
S DSPEC=$P(^DIZ(1991020,DDA,0),U,5) ;DSPEC= DEFAULT Specimen_Code
S DIC="^DIZ(1991019," ;DIC= SPECIMEN FILE
S X=DSPEC ;X= LOOKUP VALUE (DSPEC)
D ^DIC ;DO FILEMAN LOOKUP
S DSPEC=$P(^DIZ(1991019,$P(Y,U,1),0),U,1)
;DSPEC= DEFAULT Specimen_Name
Q
KILL ;KILL ALL LOCAL VARIABLES TO AZXRBUG1
K FLAG,DIE("NO^"),DIE,INUM,TCOUNT,SNUM,PIEC,DA,DR,X,DIK
K DIK(1),DIC(0),DDA,DFAC,DIC,DDATE,Y,DORG,DSPEC
Q
AZXRBUG1 ;BUGDRUG2 Entry/Edit PROGRAM [ 09/23/94 9:50 AM ]
+1 ;Version 1
+2 ;08/04/92 JOHN H. LYNCH
+3 ;
+4 ;ALLOWS THE DATA ENTRY PERSON TO ENTER OR
+5 ;EDIT INFORMATION IN THE BUGDRUG2 DATABASE.
+6 +7 ;THE ROUTINES THAT CALL AZXRBUG2:
+8 ;AZXRBUG, Main
+9 +10 ;THE ROUTINES THAT AZXRBUG2 CALLS:
+11 ;EN^DIK (FILEMAN RE-CROSS-REF ROUTINE)
+12 ;^DIE (FILEMAN EDIT ROUTINE)
+13 ;^DIC (FILEMAN LOOKUP ROUTINE)
+14 +15 ;SET LOCAL VARIABLES OUTSIDE OF MAIN
+16 ;FLAG= A CHECK FOR NEW ENTRIES
SET FLAG=-1
+17 ;WHICH RUN DEFAULT SUB-ROUTINE
+18 ;THE DEFAULT SUB-ROUTINE WILL
+19 ;ONLY BE RUN AFTER THE FIRST
+20 ;NEW ENTRY.
+21 +22 ;Variable List
+23 ;FLAG= A flag which alerts program to run DEFAULT sub-routine.
+24 ;DIE("NO^")= Keeps user from exiting once in; allows jumping though.
+25 ;DIE= BUGDRUG2 database global.
+26 ;INUM= The current internal entry number.
+27 ;TCOUNT= The total count of current entries in the file.
+28 ;SNUM= The users input of the record number.
+29 ;PIEC= Starting point of lookup for users SNUM entry.
+30 ;DA= Internal entry number used during lookup.
+31 ;DR= Used as entry/edit setup in calling Fileman.
+32 ;X= Used in setting the default values for Entry/Edit
+33 ;DIK= Global root of file for re-indexing.
+34 ;DIK(1)= Specifies which field and cross-ref. to re-index.
+35 ;DIC(0)= Setup values for Fileman lookup.
+36 ;DDA= Default Internal Entry Number.
+37 ;DFAC= Default Facility.
+38 ;DIC= Global root of file for Fileman lookup.
+39 ;DDATE= Default Date.
+40 ;Y= The returned value from Fileman lookup.
+41 ;DORG= Default Organism_Name.
+42 ;DSPEC= Default Specimen_Name.
+43 MAIN ;AZXRBUG1 PROGRAM CONTROL
+1 ;SET LOCAL VARIABLES
+2 ;KEEP USER FROM EXITING
SET DIE("NO^")="BACK"
+3 ;ALLOW JUMPING
+4 ;^BUGDRUG2 (DATABASE GLOBAL)
SET DIE="1991020"
+5 +6 ;CLEAR SCREEN
WRITE @IOF
+7 +8 WRITE !!!,"BugDrug2 Entry/Edit...",!!
+9 RECORD ;Select Record Number: ;SUB-ROUTINE
+1 ;SET LOCAL VARIABLES
+2 ;INUM= CURR. INTERNAL NUMBER
SET INUM=$PIECE(^DIZ(DIE,0),U,3)
+3 ;TCOUNT= TOTAL COUNT CURRENT
SET TCOUNT=$PIECE(^DIZ(DIE,0),U,4)
+4 ;IN FILE
+5 +6 WRITE !,"Select Record Number: ",INUM+1,"//"
+7 READ SNUM
+8 +9 IF (SNUM'="")&(SNUM'?1.3"?")&(SNUM'="^")&'((SNUM>0)&(SNUM<1000000))&(SNUM'?1.6N)
WRITE !!,"Illegal Record Number.",!!," Enter a Record Number between [1..999999], or",!," Enter a ""?"" for help, or",!," Enter a ""^"" to quit.",!,*7
GOTO RECORD
+10 ;CHECK FOR VALID USER INPUT
+11 +12 ;DEFAULT (NEW ENTRY)
IF SNUM=""
SET SNUM=INUM+1
+13 ;"^"= QUIT/RETURN TO AZXRBUG
IF SNUM="^"
DO KILL
QUIT
+14 IF SNUM?1.3"?"
WRITE !!,"Please enter your Record Number or",!,"press return and accept the default for a new entry.",!
GOTO RECORD
+15 +16 ;SNUM= NEW ENTRY
IF (SNUM=(INUM+1))
SET $PIECE(^DIZ(DIE,0),U,3)=INUM+1
SET $PIECE(^DIZ(DIE,0),U,4)=TCOUNT+1
SET FLAG=FLAG+1
IF FLAG
DO DEFAULT
+17 ;INCREMENT COUNTERS IN
+18 ;^DIZ(DIE,0)
+19 ;FLAG= SET DEFAULT VALUES FOR
+20 ;ENTRY SCREEN (AFTER 1ST ENTRY)
+21 +22 ;USER TRYING TO ENTER NUMBER
IF SNUM>(INUM+1)
WRITE !!,"SKIPPING RECORD NUMBERS IS NOT ALLOWED!",*7
HANG 3
GOTO MAIN
+23 ;OUT OF SEQUENCE
+24 +25 SET PIEC=0
+26 IF (SNUM<(INUM+1))&('$ORDER(^DIZ(DIE,"B",SNUM,PIEC)))
WRITE !!,"RECORD NUMBER, ",SNUM,", HAS ALREADY BEEN DELETED!",!,*7
HANG 3
GOTO RECORD
+27 ;LOOK UP USER INPUT TO SEE IF
+28 ;IT ALREADY EXISTS, IF NOT SAY
+29 ;IT HAS BEEN ALREADY DELETED
+30 +31 SET PIEC=0
+32 ;DA= INTERNAL ENTRY NUMBER
SET DA=SNUM
+33 IF (SNUM<(INUM+1))&($ORDER(^DIZ(DIE,"B",SNUM,PIEC)))
KILL ^DIZ(DIE,"FOD",$PIECE(^DIZ(DIE,DA,0),U,2),$PIECE(^DIZ(DIE,DA,0),U,4),$PIECE(^DIZ(DIE,DA,0),U,3),DA),^DIZ(DIE,"FDSO",$PIECE(^DIZ(DIE,DA,0),U,2),$PIECE(^DIZ(DIE,DA,0),U,3),$PIECE(^DIZ(DIE,DA,0),U,5),$PIECE(^DIZ(DIE,DA,0),U,4),DA)
+34 ;LOOK UP USER INPUT TO SEE IF
+35 ;IT ALREADY EXISTS, IF IT DOES
+36 ;DELETE "FOD" & "FDSO"
+37 ;CROSS-REFERENCE
+38 +39 ;LOCK RECORD
LOCK ^DIZ(DIE,DA):0
IF '$TEST
WRITE !!,"RECORD HAS BEEN LOCKED, TRY AGAIN LATER!",!
HANG 3
GOTO RECORD
+40 ;INTO ^BUGDRUG2 DATABASE
+41 +42 IF (SNUM'=(INUM+1))!('FLAG)
SET DR=".01///^S X=DA;1;2;3;4;15;16;18;21;7;12;13;20;17;23;24;8;19;14;10;26;6;11;25;22;5;9"
DO ^DIE
GOTO UNLOCK
+43 ;SETUP FOR CALL TO FILEMAN
+44 ;--EDIT AN ENTRY or
+45 ;--FLAG NOT SET YET
+46 ;DR= STUFF .01 (Record Number)
+47 ;CALL FILEMAN EDIT
+48 +49 ;SETUP FOR CALL TO FILEMAN
SET DR=".01///^S X=DA"
+50 ;--NEW ENTRY and
+51 ;--FLAG IS SET
+52 ;DR= STUFF .01 (Record Number)
+53 ;CALL FILEMAN ENTRY
DO ^DIE
+54 +55 ;SET DEFAULT (DFAC) FACILITY
SET DR="1//^S X=DFAC"
+56 ;CALL FILEMAN ENTRY
DO ^DIE
+57 +58 ;SET DEFAULT (DDATE) DATE
SET DR="2//^S X=DDATE"
+59 ;CALL FILEMAN ENTRY
DO ^DIE
+60 +61 ;SET DEFAULT (DORG) Organism
SET DR="3//^S X=DORG"
+62 ;CALL FILEMAN ENTRY
DO ^DIE
+63 +64 SET DR="4//^S X=DSPEC;15;16;18;21;7;12;13;20;17;23;24;8;19;14;10;26;6;11;25;22;5;9"
+65 ;SET DEFAULT (DSPEC) Specimen
+66 ;ENTER IN SPECIFIC ORDER
+67 ;CALL FILEMAN ENTRY
DO ^DIE
+68 UNLOCK ;CALL FILEMAN FOR ENTRY/EDIT
DO INDEX
LOCK
+1 ;CALL INDEX (RE-CROSS-REF.)
+2 ;UNLOCK RECORD
+3 +4 ;SET UP FOR NEXT ENTRY/EDIT
GOTO MAIN
+5 QUIT
+6 INDEX ;RE-INDEX "FOD" AND "FDSO" CROSS-REFS.
+1 ;SET LOCAL VARIABLES
+2 ;DA= INTERNAL ENTRY NUMBER
SET DA=SNUM
+3 ;GLOBAL ROOT (^BUGDRUG2)
SET DIK="^DIZ(1991020,"
+4 +5 ;Organism_Name, "FOD" CR-REF
SET DIK(1)="3^FOD"
+6 ;RE-INDEX "FOD"
DO EN^DIK
+7 +8 ;Specimen_Name, "FDSO" CR-REF
SET DIK(1)="4^FDSO"
+9 ;RE-INDEX "FDSO"
DO EN^DIK
+10 QUIT
+11 DEFAULT ;SET UP NEW DEFAULT VALUES FOR
+1 ;Facility, Date, Organism_Name, Specimen_Name
+2 ;SET LOCAL VARIABLES
+3 ;N= INTERNAL NUMBER LOOKUP
SET DIC(0)="NXZ"
+4 ;X= EXACT MATCH REQUIRED
+5 ;Z= VALUES RETURNED IN Y=N^S
+6 ; N= INTERNAL ENTRY NUMBER
+7 ; S= VALUE OF .01 FIELD
+8 +9 ;DDA= DEFAULT INTERNAL NUMBER
SET DDA=SNUM-1
+10 +11 ;DFAC= DEFAULT Facility CODE
SET DFAC=$PIECE(^DIZ(1991020,DDA,0),U,2)
+12 ;DIC= SITES FILE
SET DIC="^DIZ(1991010,"
+13 ;X= LOOKUP VALUE (DFAC)
SET X=DFAC
+14 ;DO FILEMAN LOOKUP
DO ^DIC
+15 SET DFAC=$PIECE(^DIZ(1991010,$PIECE(Y,U,1),0),U,1)
+16 ;DFAC= DEFAULT Facility NAME
+17 +18 ;DDATE= DEFAULT Date (Fileman)
SET DDATE=$PIECE(^DIZ(1991020,DDA,0),U,3)
+19 ;DDATE= DEFAULT External Date
SET Y=DDATE
DO DD^%DT
SET DDATE=Y
+20 +21 ;DORG= DEFAULT Organism_Code
SET DORG=$PIECE(^DIZ(1991020,DDA,0),U,4)
+22 ;DIC= ORGANISM FILE
SET DIC="^DIZ(1991018,"
+23 ;X= LOOKUP VALUE (DORG)
SET X=DORG
+24 ;DO FILEMAN LOOKUP
DO ^DIC
+25 SET DORG=$PIECE(^DIZ(1991018,$PIECE(Y,U,1),0),U,1)
+26 ;DORG= DEFAULT Organism_Name
+27 +28 ;DSPEC= DEFAULT Specimen_Code
SET DSPEC=$PIECE(^DIZ(1991020,DDA,0),U,5)
+29 ;DIC= SPECIMEN FILE
SET DIC="^DIZ(1991019,"
+30 ;X= LOOKUP VALUE (DSPEC)
SET X=DSPEC
+31 ;DO FILEMAN LOOKUP
DO ^DIC
+32 SET DSPEC=$PIECE(^DIZ(1991019,$PIECE(Y,U,1),0),U,1)
+33 ;DSPEC= DEFAULT Specimen_Name
+34 QUIT
+35 KILL ;KILL ALL LOCAL VARIABLES TO AZXRBUG1
+1 KILL FLAG,DIE("NO^"),DIE,INUM,TCOUNT,SNUM,PIEC,DA,DR,X,DIK
+2 KILL DIK(1),DIC(0),DDA,DFAC,DIC,DDATE,Y,DORG,DSPEC
+3 QUIT
