- 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
