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

AZXRBUG4.m

Go to the documentation of this file.
  1. AZXRBUG4 ;BUGDRUG2 Verfication PROGRAM [ 09/23/94 9:52 AM ]
  1. ;Version 1
  1. ;08/04/92 JOHN H. LYNCH
  1. ;
  1. ;ALLOWS THE DATA ENTRY PERSON TO VERIFY DATA INPUT
  1. ;FOR A PARTICULAR FACILITY AND FOR A PARTICULAR DATE.
  1. ;ALL DATA WILL BE DISPLAYED IN THE ORDER IT WAS
  1. ;ENTERED INTO THE BUGDRUG2 DATABASE.
  1. ;THE ROUTINES THAT CALL AZXRBUG4:
  1. ;AZXRBUG3, Reports Menu
  1. ;THE ROUTINES THAT AZXRBUG4 CALLS:
  1. ;DIC (FILEMAN LOOKUP ROUTINE)
  1. ;%DT (FILEMAN DATE CONVERSION ROUTINE)
  1. ;%ZIS (KERNAL DEVICE HANDLER)
  1. ;Variable List
  1. ;PG= Current page count.
  1. ;LN= Current line count.
  1. ;DIC= Global root of file for lookup.
  1. ;DIC(0)= Parameters for lookup.
  1. ;DIC("A")= Default prompt for lookup.
  1. ;FAC= External form for facility.
  1. ;FCLTY= Internal number for facility.
  1. ;BACKUP= Flag used for user wanting to back up a prompt.
  1. ;%DT= Parameters for date conversion.
  1. ;%DT("A")= Default prompt for date input.
  1. ;DATE= Fileman converted date to external form.
  1. ;LDATE= Starting point date for print loop (REPORT
  1. ; SUB-ROUTINE).
  1. ;%ZIS("B")= Don't use HOME as default device.
  1. ;BORDER= Special border for printout.
  1. ;BORDER2= Special border for printout.
  1. ;BORDER3= Special border for printout.
  1. ;BORDER4= Special border for printout.
  1. ;HEADER= Special header for printout.
  1. ;HEADER1= Special header for printout.
  1. ;Y= Date value used for conversion.
  1. ;DA= Internal entry number used in print loop (REPORT
  1. ; SUB-ROUTINE).
  1. ;NODE= Current entry to be printed.
  1. ;ORG= Current Organism_Code.
  1. ;SPEC= Current Specimen_Code.
  1. ;X= Current lookup value.
  1. ;YN= User input on whether to print another report.
  1. MAIN ;AZXRBUG4 PROGRAM CONTROL
  1. ;SET LOCAL VARIABLES
  1. S PG=0 ;INITIALIZE PAGE NUMBER
  1. S LN=0 ;INITIALIZE LINE COUNTER
  1. D INPUT
  1. D KILL
  1. Q
  1. INPUT ;ASK USER FOR THE FACILITY TO USE FOR VERIFICATION
  1. ;THEN CALL ROUTINE, DATE.
  1. ;SET LOCAL VARIABLES
  1. S DIC="^DIZ(1991010," ;GLOBAL ROOT OF SITES FILE
  1. ;USED FOR LOOKUP
  1. S DIC(0)="AEQZ" ;DIC(0)= LOOKUP VALUES
  1. ; A= ASK USER FOR INPUT
  1. ; E= ECHO ANSWER
  1. ; Q= QUESTION ERRONEOUS INPUT
  1. ; Z= ZERO NODE RETURNED IN
  1. ; Y(0) AND EXTERNAL FORM
  1. ; IN Y(0,0)
  1. S DIC("A")="Enter Facility: " ;DIC("A")= DEFAULT PROMPT FOR
  1. ; LOOKUP
  1. W @IOF ;CLEAR SCREEN
  1. W !!!,"BugDrug2 Verification...",!!
  1. FACILITY ;CALL FILEMAN LOOKUP FOR FACILITY
  1. D ^DIC
  1. I (X="^")!(X="") Q ;X= USER INPUT VALUE FROM ^DIC
  1. S FAC=Y(0,0) ;FAC= FACILITY IN EXTERNAL FORM
  1. S FCLTY=$P(Y,U,1) ;FCLTY= INTERNAL NUMBER OF SITE
  1. D DATE
  1. I BACKUP="Y" G FACILITY
  1. Q
  1. DATE ;ASK USER FOR THE DATE TO USE FOR VERIFICATION
  1. ;SET LOCAL VARIABLES
  1. S BACKUP="N" ;BACKUP= VARIABLE USED FOR
  1. ; CHECKING WHETHER USER
  1. ; WANTS TO BACK UP "^"
  1. S %DT="AEX" ;VALIDATES DATE INPUT AND
  1. ;CONVERTS IT FOR STORAGE
  1. ; A= ASK FOR DATE INPUT
  1. ; E= ECHO ANSWER
  1. ; X= EXACT DATE REQUIRED
  1. S %DT("A")="Enter Date: " ;%DT= DEFAULT PROMPT FOR DATE
  1. D ^%DT ;CALL FILEMAN DATE CONVERSION
  1. I X="^" S BACKUP="Y" Q ;USER WANTS TO BACK UP
  1. I X?1.3"?" G DATE ;INQUIRY TO HELP; GOTO DATE
  1. I Y=-1 W !!,*7,"Invalid Date: Press a '?' for help." G DATE
  1. ;INVALID ENTRY; GOTO DATE
  1. S DATE=Y ;DATE= FILEMAN DATE RETURNED
  1. ; IN Y
  1. D REPORT ;PRINT VERIFICATION REPORT
  1. Q
  1. REPORT ;OPEN DEVICE AND PRINT OUT VERIFICATION REPORT
  1. ;SET LOCAL VARIABLES
  1. S LDATE=DATE-1 ;STARTING POINT FOR PRINT
  1. ;LOOP
  1. S %ZIS("B")="" ;DON'T USE HOME AS DEFAULT
  1. ;DEVICE
  1. S BORDER="____________________________________________________________________________________________________________________________"
  1. S BORDER2="___________________________________|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|"
  1. S BORDER3="| | | | | | | | | | | | | | | | | | | | | | |"
  1. S BORDER4="|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|___|"
  1. S HEADER=" Organism_Name"
  1. S HEADER1="Rec_# Specimen_Name |CC |E |DP |P |AM |CF |C |FM |GM |SxT|TE |CB |NA |CP |CAX|VA |AUG|CRM|TI |PI |AK |CFX|"
  1. ;VERIFICATION HEADER LINE2
  1. W !
  1. D ^%ZIS U IO ;OPEN DEVICE
  1. I IO="" Q ;USER WANTS OUT
  1. I IO(0)=IO W !,*7,"The Verification must be printed.",! X ^%ZIS("C") G REPORT
  1. S Y=DATE ;CONVERT TO EXTERNAL DATE
  1. D DD^%DT ;VALUE RETURNED IN Y
  1. S RDATE=Y ;DATE= REPORT DATE
  1. F S LDATE=$O(^DIZ(1991020,"DF",LDATE)) Q:LDATE>DATE Q:'LDATE S DA=0 F S DA=$O(^DIZ(1991020,"DF",LDATE,FCLTY,DA)) Q:'DA D:(LN>(IOSL-2)) HEADING D PRTINFO
  1. X ^%ZIS("C") ;CLOSE DEVICE
  1. D CONT
  1. Q
  1. PRTINFO ;PRINT THE INFORMATION LINE OUT TO PRINTER
  1. ;SET LOCAL VARIABLES
  1. S DIC(0)="NXZ" ;N= INTERNAL NUMBER LOOKUP
  1. ;X= EXACT MATCH REQUIRED
  1. ;Z= VALUES RETURNED IN Y=N^S
  1. ; N= INTERNAL ENTRY NUMBER
  1. ; S= VALUE OF .01 FIELD
  1. I PG=0 D HEADING ;PRINT FIRST HEADING
  1. S LN=LN+3 ;ADD 3 TO LINE COUNTER
  1. I LN=13 W !
  1. I LN>13 W !,?35,BORDER4,!
  1. S NODE=^DIZ(1991020,DA,0) ;NODE= CURRENT ENTRY
  1. S ORG=$P(NODE,U,4) ;SET Organism_Code
  1. S DIC="^DIZ(1991018," ;DIC= ORGANISM FILE
  1. S X=ORG ;X= LOOKUP VALUE (ORG)
  1. D ^DIC ;DO FILEMAN LOOKUP
  1. S ORG=$P(^DIZ(1991018,$P(Y,U,1),0),U,1)
  1. ;ORG= Organism_Name
  1. W ?7,$E(ORG,1,27) ;PRINT Organism_Name
  1. W ?35,BORDER3
  1. W !,$J($P(NODE,U,1),5) ;PRINT Record Number
  1. S SPEC=$P(NODE,U,5) ;SET Specimen_Code
  1. S DIC="^DIZ(1991019," ;DIC= SPECIMEN FILE
  1. S X=SPEC ;X= LOOKUP VALUE (SPEC)
  1. D ^DIC ;DO FILEMAN LOOKUP
  1. S SPEC=$P(^DIZ(1991019,$P(Y,U,1),0),U,1)
  1. ;SPEC= Specimen_Name
  1. W ?7,$E(SPEC,1,27) ;PRINT Specimen_Name
  1. W ?35,"|"
  1. W ?36,$P(NODE,U,16) ;PRINT CC
  1. W ?39,"|"
  1. W ?40,$P(NODE,U,17) ;PRINT E
  1. W ?43,"|"
  1. W ?44,$P(NODE,U,19) ;PRINT DP
  1. W ?47,"|"
  1. W ?48,$P(NODE,U,22) ;PRINT P
  1. W ?51,"|"
  1. W ?52,$P(NODE,U,8) ;PRINT AM
  1. W ?55,"|"
  1. W ?56,$P(NODE,U,13) ;PRINT CF
  1. W ?59,"|"
  1. W ?60,$P(NODE,U,14) ;PRINT C
  1. W ?63,"|"
  1. W ?64,$P(NODE,U,21) ;PRINT FM
  1. W ?67,"|"
  1. W ?68,$P(NODE,U,18) ;PRINT GM
  1. W ?71,"|"
  1. W ?72,$P(NODE,U,24) ;PRINT SxT
  1. W ?75,"|"
  1. W ?76,$P(NODE,U,25) ;PRINT TE
  1. W ?79,"|"
  1. W ?80,$P(NODE,U,9) ;PRINT CB
  1. W ?83,"|"
  1. W ?84,$P(NODE,U,20) ;PRINT NA
  1. W ?87,"|"
  1. W ?88,$P(NODE,U,15) ;PRINT CP
  1. W ?91,"|"
  1. W ?92,$P(NODE,U,11) ;PRINT CAX
  1. W ?95,"|"
  1. W ?96,$P(NODE,U,27) ;PRINT VA
  1. W ?99,"|"
  1. W ?100,$P(NODE,U,7) ;PRINT AUG
  1. W ?103,"|"
  1. W ?104,$P(NODE,U,12) ;PRINT CRM
  1. W ?107,"|"
  1. W ?108,$P(NODE,U,26) ;PRINT TI
  1. W ?111,"|"
  1. W ?112,$P(NODE,U,23) ;PRINT PI
  1. W ?115,"|"
  1. W ?116,$P(NODE,U,6) ;PRINT AK
  1. W ?119,"|"
  1. W ?120,$P(NODE,U,10) ;PRINT CFX
  1. W ?123,"|"
  1. Q
  1. HEADING ;HEADING TO EACH PAGE OF THE VERIFICATION
  1. I PG>0 W # ;SEND FORMFEED
  1. S PG=PG+1 ;INCREMENT PAGE NUMBER
  1. W !,BORDER,!
  1. W !,"BugDrug2 Verification Report",?106,"Date: ",RDATE
  1. W !!,"Facility: ",FAC,?106,"Page: ",PG
  1. W !,BORDER
  1. W !!,HEADER
  1. W !,HEADER1
  1. W !,BORDER2
  1. S LN=10 ;INITIALIZE LINE COUNTER
  1. ;HEADER USES 10 LINES
  1. Q
  1. CONT ;ASK USER WHETHER TO CONTINUE WITH VERIFICATION PRINT
  1. ;SET LOCAL VARIABLES
  1. S PG=0 ;INITIALIZE PAGE COUNTER
  1. S LN=0 ;INITIALIZE LINE COUNTER
  1. R !!!!!!!,"Do you want to print another Verification? N//",YN
  1. ;ASK USER WHETHER TO CONTINUE?
  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") D INPUT
  1. Q
  1. KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXRBUG4
  1. K PG,LN,DIC,FAC,FCLTY,BACKUP,%DT,DATE
  1. K LDATE,%ZIS,BORDER,BORDER2,BORDER3,BORDER4
  1. K HEADER,HEADER1,Y,RDATE,DA,NODE,ORG,DIC
  1. K SPEC,X,YN
  1. Q