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
