- AZXROBL1 ;CHS Dollars Obligated Report Input PROGRAM [ 06/10/93 8:27 AM ]
- ;09/04/92 JOHN H. LYNCH
- ;
- ;ALLOWS THE USER TO INPUT THE FACILITY AND THE
- ;DATE RANGES FOR THE CHS Dollars Obligated REPORT.
-
- ;THE ROUTINES THAT AZXROBL1 CALLS:
- ;^DIC, Fileman Lookup.
- ;^%DT, Fileman Date Conversion.
-
- ;THE ROUTINES THAT CALL AZXROBL1:
- ;AZXROBL, CHS Dollars Obligated Report.
-
- ;Variable List
- ;DIC= Global root of file for Fileman Lookup.
- ;DIC(0)= Fileman Lookup parameters.
- ;DIC("A")= Fileman Lookup default prompt.
- ;BACKUP= Flags whether user wants to back up one prompt.
- ;%DT= Fileman Date Conversion parameters.
- ;%DT("A")= Fileman Date Conversion default prompt.
-
- ;Variables which are sent to AZXROBL:
- ;FACBKUP= Flag returned to AZXROBL with data on
- ; whether user wants to quit.
- ;FAC= Facility in external form.
- ;FCLTY= Internal Number of site from INSTITUTION file.
- ;COMNAME= External form of community.
- ;COMMUN= Internal entry number for community.
- ;FDATE= Fileman From Date is returned in FDATE.
- ;TDATE= Fileman To Date is return in TDATE.
-
-
- MAIN ;AZXROBL PROGRAM CONTROL
-
- D INPUT
- Q
-
- INPUT ;ASK USER FOR THE FACILITY TO USE FOR REPORT
- ;THEN CALL FDATE ROUTINE
-
- W @IOF ;CLEAR SCREEN
-
- W !!!,"'CHS Dollars Obligated Report'...",!!
-
- FACILITY ;CALL FILEMAN LOOKUP FOR FACILITY
- ;SET LOCAL VARIABLES
- S DIC="^DIC(4," ;GLOBAL ROOT OF INSTITUTION
- ;FILE USED FOR LOOKUP
-
- S DIC(0)="AEQZ" ;DIC(0)= LOOKUP VALUES
- ; A= ASK USER FOR INPUT
- ; E= ECHO ANSWER
- ; Q= QUESTION ERRONEOUS INPUT
- ; Z= ZERO NODE RETURNED IN
- ; Y(0) AND EXTERNAL FORM
- ; IN Y(0,0)
-
- S DIC("A")="Enter Facility: " ;DIC("A")= DEFAULT PROMPT FOR
- ; LOOKUP
-
- D ^DIC
-
- I (X="^")!(X="") S FACBKUP="Y" Q ;X= USER INPUT VALUE FROM ^DIC
- ;FACBKUP= RETURNED VARIABLE
- ; WHICH TELLS WHETHER
- ; USER WANTS TO BACKUP
- ; A PROMPT
- S FACBKUP="N" ;--USER DOESN'T WANT TO BACKUP
-
- S FAC=Y(0,0) ;FAC= FACLITY IN EXTERNAL FORM
-
- S FCLTY=$P(Y,U,1) ;FCLTY= INTRNAL NUMBER OF SITE
-
- D COMMUN
-
- I BACKUP="Y" G FACILITY
- Q
-
- COMMUN ;CALL FILEMAN LOOKUP FOR COMMUNITY
- S DIC="^AUTTCOM(" ;GLOBAL ROOT OF COMMUNITY
- ;FILE USED FOR LOOKUP
-
- S DIC("A")="Enter Location: " ;DIC("A")= DEFAULT PROMPT FOR
- ; LOOKUP
-
- D ^DIC
-
- I (X="^")!(X="") S BACKUP="Y" Q ;X= USER INPUT VALUE FROM ^DIC
- ;BACKUP= RETURNED VARIABLE
- ; WHICH TELLS WHETHER
- ; USER WANTS TO BACKUP
- ; A PROMPT
- S BACKUP="N" ;--USER DOESN'T WANT TO BACKUP
-
-
- S COMMUN=$P(Y,U,1) ;COMMUN= INTERNAL # OF COM.
-
- S COMNAME=$P(^AUTTCOM(COMMUN,0),U,1) ;COMNAME= NAME OF COMMUNITY
-
- D FDATE
-
- I BACKUP="Y" G COMMUN
- Q
-
- FDATE ;ASK USER FOR THE FROM DATE TO USE FOR REPORT
- ;SET LOCAL VARIABLES
- S BACKUP="N" ;BACKUP= VARIABLE USED FOR
- ; CHECKING WHETHER USER
- ; WANTS TO BACK UP "^"
-
- S %DT="AEX" ;VALIDATES DATE INPUT AND
- ;CONVERTS IT FOR STORAGE
- ; A= ASK FOR DATE INPUT
- ; E= ECHO ANSWER
- ; X= EXACT DATE REQUIRED
-
- S %DT("A")="From Date: " ;%DT("A")= DEFAULT PROMPT;FDATE
-
- D ^%DT ;CALL FILEMAN DATE CONVERSION
-
- I (X="^")!(X="") S BACKUP="Y" Q ;USER WANTS TO BACK UP
- I X?1.3"?" G FDATE ;INQUIRY TO HELP; GOTO FDATE
- I Y=-1 W !!,*7,"Invalid Date: Press a '?' for help." G FDATE
- ;INVALID ENTRY; GOTO FDATE
-
- S FDATE=Y ;FDATE= FILEMAN DATE RETURNED
- ; IN Y
-
- D TDATE ;SET TO DATE
- I BACKUP="Y" G FDATE ;USER WANTS TO BACK UP "^"
- Q
-
- TDATE ;ASK USER FOR THE TO DATE TO USE FOR REPORT
- ;SET LOCAL VARIABLE
- S BACKUP="N" ;BACKUP= VARIABLE USED FOR
- ; CHECKING WHETHER USER
- ; WANTS TO BACK UP "^"
-
- S %DT="AEX" ;VALIDATES DATE INPUT AND
- ;CONVERTS IT FOR STORAGE
- ; A= ASK FOR DATE INPUT
- ; E= ECHO ANSWER
- ; X= EXACT DATE REQUIRED
-
- S %DT("A")="To Date: " ;%DT("A")= DEFAULT PROMPT;TDATE
-
- D ^%DT ;CALL FILEMAN
-
- I (X="^")!(X="") S BACKUP="Y" Q ;USER WANTS TO BACK UP
- I X?1.3"?" G TDATE ;INQUIRY TO HELP; GOTO TDATE
- I Y=-1 W !!,*7,"Invalid Date: Press a '?' for help." G TDATE
- ;INVALID ENTRY; GOTO TDATE
-
- S TDATE=Y ;TDATE= FILEMAN DATE RETURNED
- ; IN Y
- I TDATE<FDATE W !!,"'To Date' must be greater than or equal to 'From Date'",! G TDATE
- Q
-
- KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXROBL1
- K DIC,BACKUP,%DT
- Q
- AZXROBL1 ;CHS Dollars Obligated Report Input PROGRAM [ 06/10/93 8:27 AM ]
- +1 ;09/04/92 JOHN H. LYNCH
- +2 ;
- +3 ;ALLOWS THE USER TO INPUT THE FACILITY AND THE
- +4 ;DATE RANGES FOR THE CHS Dollars Obligated REPORT.
- +5 +6 ;THE ROUTINES THAT AZXROBL1 CALLS:
- +7 ;^DIC, Fileman Lookup.
- +8 ;^%DT, Fileman Date Conversion.
- +9 +10 ;THE ROUTINES THAT CALL AZXROBL1:
- +11 ;AZXROBL, CHS Dollars Obligated Report.
- +12 +13 ;Variable List
- +14 ;DIC= Global root of file for Fileman Lookup.
- +15 ;DIC(0)= Fileman Lookup parameters.
- +16 ;DIC("A")= Fileman Lookup default prompt.
- +17 ;BACKUP= Flags whether user wants to back up one prompt.
- +18 ;%DT= Fileman Date Conversion parameters.
- +19 ;%DT("A")= Fileman Date Conversion default prompt.
- +20 +21 ;Variables which are sent to AZXROBL:
- +22 ;FACBKUP= Flag returned to AZXROBL with data on
- +23 ; whether user wants to quit.
- +24 ;FAC= Facility in external form.
- +25 ;FCLTY= Internal Number of site from INSTITUTION file.
- +26 ;COMNAME= External form of community.
- +27 ;COMMUN= Internal entry number for community.
- +28 ;FDATE= Fileman From Date is returned in FDATE.
- +29 ;TDATE= Fileman To Date is return in TDATE.
- +30 +31 MAIN ;AZXROBL PROGRAM CONTROL
- +1 +2 DO INPUT
- +3 QUIT
- +4 INPUT ;ASK USER FOR THE FACILITY TO USE FOR REPORT
- +1 ;THEN CALL FDATE ROUTINE
- +2 +3 ;CLEAR SCREEN
- WRITE @IOF
- +4 +5 WRITE !!!,"'CHS Dollars Obligated Report'...",!!
- +6 FACILITY ;CALL FILEMAN LOOKUP FOR FACILITY
- +1 ;SET LOCAL VARIABLES
- +2 ;GLOBAL ROOT OF INSTITUTION
- SET DIC="^DIC(4,"
- +3 ;FILE USED FOR LOOKUP
- +4 +5 ;DIC(0)= LOOKUP VALUES
- SET DIC(0)="AEQZ"
- +6 ; A= ASK USER FOR INPUT
- +7 ; E= ECHO ANSWER
- +8 ; Q= QUESTION ERRONEOUS INPUT
- +9 ; Z= ZERO NODE RETURNED IN
- +10 ; Y(0) AND EXTERNAL FORM
- +11 ; IN Y(0,0)
- +12 +13 ;DIC("A")= DEFAULT PROMPT FOR
- SET DIC("A")="Enter Facility: "
- +14 ; LOOKUP
- +15 +16 DO ^DIC
- +17 +18 ;X= USER INPUT VALUE FROM ^DIC
- IF (X="^")!(X="")
- SET FACBKUP="Y"
- QUIT
- +19 ;FACBKUP= RETURNED VARIABLE
- +20 ; WHICH TELLS WHETHER
- +21 ; USER WANTS TO BACKUP
- +22 ; A PROMPT
- +23 ;--USER DOESN'T WANT TO BACKUP
- SET FACBKUP="N"
- +24 +25 ;FAC= FACLITY IN EXTERNAL FORM
- SET FAC=Y(0,0)
- +26 +27 ;FCLTY= INTRNAL NUMBER OF SITE
- SET FCLTY=$PIECE(Y,U,1)
- +28 +29 DO COMMUN
- +30 +31 IF BACKUP="Y"
- GOTO FACILITY
- +32 QUIT
- +33 COMMUN ;CALL FILEMAN LOOKUP FOR COMMUNITY
- +1 ;GLOBAL ROOT OF COMMUNITY
- SET DIC="^AUTTCOM("
- +2 ;FILE USED FOR LOOKUP
- +3 +4 ;DIC("A")= DEFAULT PROMPT FOR
- SET DIC("A")="Enter Location: "
- +5 ; LOOKUP
- +6 +7 DO ^DIC
- +8 +9 ;X= USER INPUT VALUE FROM ^DIC
- IF (X="^")!(X="")
- SET BACKUP="Y"
- QUIT
- +10 ;BACKUP= RETURNED VARIABLE
- +11 ; WHICH TELLS WHETHER
- +12 ; USER WANTS TO BACKUP
- +13 ; A PROMPT
- +14 ;--USER DOESN'T WANT TO BACKUP
- SET BACKUP="N"
- +15 +16 +17 ;COMMUN= INTERNAL # OF COM.
- SET COMMUN=$PIECE(Y,U,1)
- +18 +19 ;COMNAME= NAME OF COMMUNITY
- SET COMNAME=$PIECE(^AUTTCOM(COMMUN,0),U,1)
- +20 +21 DO FDATE
- +22 +23 IF BACKUP="Y"
- GOTO COMMUN
- +24 QUIT
- +25 FDATE ;ASK USER FOR THE FROM DATE TO USE FOR REPORT
- +1 ;SET LOCAL VARIABLES
- +2 ;BACKUP= VARIABLE USED FOR
- SET BACKUP="N"
- +3 ; CHECKING WHETHER USER
- +4 ; WANTS TO BACK UP "^"
- +5 +6 ;VALIDATES DATE INPUT AND
- SET %DT="AEX"
- +7 ;CONVERTS IT FOR STORAGE
- +8 ; A= ASK FOR DATE INPUT
- +9 ; E= ECHO ANSWER
- +10 ; X= EXACT DATE REQUIRED
- +11 +12 ;%DT("A")= DEFAULT PROMPT;FDATE
- SET %DT("A")="From Date: "
- +13 +14 ;CALL FILEMAN DATE CONVERSION
- DO ^%DT
- +15 +16 ;USER WANTS TO BACK UP
- IF (X="^")!(X="")
- SET BACKUP="Y"
- QUIT
- +17 ;INQUIRY TO HELP; GOTO FDATE
- IF X?1.3"?"
- GOTO FDATE
- +18 IF Y=-1
- WRITE !!,*7,"Invalid Date: Press a '?' for help."
- GOTO FDATE
- +19 ;INVALID ENTRY; GOTO FDATE
- +20 +21 ;FDATE= FILEMAN DATE RETURNED
- SET FDATE=Y
- +22 ; IN Y
- +23 +24 ;SET TO DATE
- DO TDATE
- +25 ;USER WANTS TO BACK UP "^"
- IF BACKUP="Y"
- GOTO FDATE
- +26 QUIT
- +27 TDATE ;ASK USER FOR THE TO DATE TO USE FOR REPORT
- +1 ;SET LOCAL VARIABLE
- +2 ;BACKUP= VARIABLE USED FOR
- SET BACKUP="N"
- +3 ; CHECKING WHETHER USER
- +4 ; WANTS TO BACK UP "^"
- +5 +6 ;VALIDATES DATE INPUT AND
- SET %DT="AEX"
- +7 ;CONVERTS IT FOR STORAGE
- +8 ; A= ASK FOR DATE INPUT
- +9 ; E= ECHO ANSWER
- +10 ; X= EXACT DATE REQUIRED
- +11 +12 ;%DT("A")= DEFAULT PROMPT;TDATE
- SET %DT("A")="To Date: "
- +13 +14 ;CALL FILEMAN
- DO ^%DT
- +15 +16 ;USER WANTS TO BACK UP
- IF (X="^")!(X="")
- SET BACKUP="Y"
- QUIT
- +17 ;INQUIRY TO HELP; GOTO TDATE
- IF X?1.3"?"
- GOTO TDATE
- +18 IF Y=-1
- WRITE !!,*7,"Invalid Date: Press a '?' for help."
- GOTO TDATE
- +19 ;INVALID ENTRY; GOTO TDATE
- +20 +21 ;TDATE= FILEMAN DATE RETURNED
- SET TDATE=Y
- +22 ; IN Y
- +23 IF TDATE<FDATE
- WRITE !!,"'To Date' must be greater than or equal to 'From Date'",!
- GOTO TDATE
- +24 QUIT
- +25 KILL ;KILL LOCAL VARIABLES AND EXIT ROUTINE AZXROBL1
- +1 KILL DIC,BACKUP,%DT
- +2 QUIT
