- AZXRVP1B ;PAO/IHS/JHL;VISITS BY PROVIDERS[ 08/30/93 11:00 AM ]
- ;Version 1;VISITS BY PROVIDERS;;****;DATE OF RELEASE HERE
- ;JOHN H. LYNCH
- ;
- ;AZXRVP1B, INPUT PROGRAM 2 OF 4.
-
- ;THE ROUTINES THAT CALL AZXRVP1:
- ;AZXRVP1, 1st input program.
-
- ;THE ROUTINES THAT AZXRVP1 CALLS:
- ;AZXRVP1C, 3rd input program.
- ;^DIC, Fileman Lookup.
- ;^%DT, Fileman Date Conversion.
-
- ;Variable List
- ;DIC= Global root of file for Fileman Lookup.
- ;DIC(0)= Fileman Lookup parameters.
- ;DIC("A")= Fileman Lookup default prompt.
- ;%DT= Fileman Date Conversion parameters.
- ;%DT("A")= Fileman Date Conversion default prompt.
- ;DTOUT= Used for checking timeout.
- ;AZXRBCK= Flags whether user wants to back up one prompt.
- ;AZXRCLNC(#)= Clinic stops from AZXRVP1.
- ;AZXRFAC= Facility in external form^DFN from LOCATION file.
- ;AZXRFDT= Fileman From Date is returned in AZXRFDT.
- ;AZXRTDT= Fileman To Date is return in AZXRTDT.
- ;AZXROK= Check flag for validating all prompt entries.
- ;J,L= Counter variables.
- ;X= Lookup value from user input.
- ;Y= Returned lookup value from ^DIC.
-
- FDATE ;ASK USER FOR THE FROM DATE TO USE FOR REPORT
- ;SET LOCAL VARIABLES
- S AZXRBCK="N" ;AZXRBCK= 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
-
- D ^%DT ;CALL FILEMAN DATE CONVERSION
-
- I (X="^")!(X="")!($D(DTOUT)) K DTOUT S AZXRBCK="Y" Q
- ;USER WANTS TO BACK UP
- ;OR TIMEOUT
- 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 AZXRFDT=Y ;AZXRFDT= FILEMAN DT RETURNED
- ; IN Y
-
- D TDATE ;SET TO DATE
- G:AZXRBCK="Y" FDATE ;USER WANTS TO BACK UP "^"
- Q
-
- TDATE ;ASK USER FOR THE TO DATE TO USE FOR REPORT
- ;SET LOCAL VARIABLES
- S AZXRBCK="N" ;AZXRBCK= VARIABLE USED FOR
- ; CHECKING WHETHER USR
- ; 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
-
- D ^%DT ;CALL FILEMAN
-
- I (X="^")!(X="")!($D(DTOUT)) K DTOUT S AZXRBCK="Y" Q
- ;USER WANTS TO BACK UP
- ;OR TIMEOUT
- 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 AZXRTDT=Y ;AZXRTDT= FILEMAN DT RETURNED
- ; IN Y
- I AZXRTDT<AZXRFDT W !!,"'To Date' must be greater than or equal to 'From Date'",! G TDATE
- D CLINICS ;ASK USER FOR CLINIC STOPS
- G:AZXRBCK="Y" TDATE ;USER WANTS TO BACKUP "^"
- Q
-
- CLINICS ;ASK USER FOR ALL CLINIC STOPS
- ;SET LOCAL VARIABLES
- S AZXRBCK="N" ;AZXRBCK= VARIABLE USED FOR
- ; CHECKING WHETHER USER
- ; WANTS TO BACK UP "^"
- S DIC="^DIC(40.7," ;USE ^DIC(40.7, FOR LOOKUP
- ;CLINIC STOP FILE
- S DIC(0)="AEOQZ" ;DIC(0)= LOOKUP VALUES
- ; A= ASK THE ENTRY
- ; E= ECHO BACK ANSWER
- ; O= ONLY FIND ONE ANSWER
- ; Q= QUESTION ERROR INPUT
- ; Z= OUTPUT IN Y(0),Y(0,0)
-
- S DIC("A")="Enter Clinic Stop: " ;DIC("A")= DEFAULT PROMPT
-
- S L=1 ;L= FIRST CLINIC STOP SUBSCRPT
- F Q:AZXRBCK="Y" S AZXROK="Y" Q:L>5 D ^DIC Q:(X="")&(L>1) D
- .I (X="^")!((X="")&(L=1))!($D(DTOUT)) K DTOUT S AZXRBCK="Y" Q
- .I L>1 F J=1:1:(L-1) I Y(0,0)=$P(AZXRCLNC(J),U,2) S AZXROK="N" Q
- .I AZXROK="Y" S $P(AZXRCLNC(L),U,2)=Y(0,0),$P(AZXRCLNC(L),U)=$P(Y,U,1),L=L+1 Q
- .W !!,*7,"All clinic stops must be unique, please try again.",!
- ;DO LOOKUP FOR CLINIC STOPS
- ;CHECK IF USER WANTS TO BACK
- ;UP OR TIMEOUT
- ;MAKE SURE ALL CLINIC STOPS
- ;ARE UNIQUE
- ;AZXRCLNC(L)= 1) INTERNAL # OF
- ; CLINIC STOPS
- ; 2) EXTERNAL FORM
-
- Q:AZXRBCK="Y" ;GO BACK TO FACILITY PROMPT
- D AFFIL^AZXRVP1C ;GET AFFILIATIONS
- G:AZXRBCK="Y" CLINICS ;USER WANTS TO BACKUP "^"
- Q
- AZXRVP1B ;PAO/IHS/JHL;VISITS BY PROVIDERS[ 08/30/93 11:00 AM ]
- +1 ;Version 1;VISITS BY PROVIDERS;;****;DATE OF RELEASE HERE
- +2 ;JOHN H. LYNCH
- +3 ;
- +4 ;AZXRVP1B, INPUT PROGRAM 2 OF 4.
- +5 +6 ;THE ROUTINES THAT CALL AZXRVP1:
- +7 ;AZXRVP1, 1st input program.
- +8 +9 ;THE ROUTINES THAT AZXRVP1 CALLS:
- +10 ;AZXRVP1C, 3rd input program.
- +11 ;^DIC, Fileman Lookup.
- +12 ;^%DT, Fileman Date Conversion.
- +13 +14 ;Variable List
- +15 ;DIC= Global root of file for Fileman Lookup.
- +16 ;DIC(0)= Fileman Lookup parameters.
- +17 ;DIC("A")= Fileman Lookup default prompt.
- +18 ;%DT= Fileman Date Conversion parameters.
- +19 ;%DT("A")= Fileman Date Conversion default prompt.
- +20 ;DTOUT= Used for checking timeout.
- +21 ;AZXRBCK= Flags whether user wants to back up one prompt.
- +22 ;AZXRCLNC(#)= Clinic stops from AZXRVP1.
- +23 ;AZXRFAC= Facility in external form^DFN from LOCATION file.
- +24 ;AZXRFDT= Fileman From Date is returned in AZXRFDT.
- +25 ;AZXRTDT= Fileman To Date is return in AZXRTDT.
- +26 ;AZXROK= Check flag for validating all prompt entries.
- +27 ;J,L= Counter variables.
- +28 ;X= Lookup value from user input.
- +29 ;Y= Returned lookup value from ^DIC.
- +30 FDATE ;ASK USER FOR THE FROM DATE TO USE FOR REPORT
- +1 ;SET LOCAL VARIABLES
- +2 ;AZXRBCK= VARIABLE USED FOR
- SET AZXRBCK="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
- SET %DT("A")="From Date: "
- +13 +14 ;CALL FILEMAN DATE CONVERSION
- DO ^%DT
- +15 +16 IF (X="^")!(X="")!($DATA(DTOUT))
- KILL DTOUT
- SET AZXRBCK="Y"
- QUIT
- +17 ;USER WANTS TO BACK UP
- +18 ;OR TIMEOUT
- +19 ;INQUIRY TO HELP; GOTO FDATE
- IF X?1.3"?"
- GOTO FDATE
- +20 IF Y=-1
- WRITE !!,*7,"Invalid Date: Press a '?' for help."
- GOTO FDATE
- +21 ;INVALID ENTRY; GOTO FDATE
- +22 +23 ;AZXRFDT= FILEMAN DT RETURNED
- SET AZXRFDT=Y
- +24 ; IN Y
- +25 +26 ;SET TO DATE
- DO TDATE
- +27 ;USER WANTS TO BACK UP "^"
- IF AZXRBCK="Y"
- GOTO FDATE
- +28 QUIT
- +29 TDATE ;ASK USER FOR THE TO DATE TO USE FOR REPORT
- +1 ;SET LOCAL VARIABLES
- +2 ;AZXRBCK= VARIABLE USED FOR
- SET AZXRBCK="N"
- +3 ; CHECKING WHETHER USR
- +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
- SET %DT("A")="To Date: "
- +13 +14 ;CALL FILEMAN
- DO ^%DT
- +15 +16 IF (X="^")!(X="")!($DATA(DTOUT))
- KILL DTOUT
- SET AZXRBCK="Y"
- QUIT
- +17 ;USER WANTS TO BACK UP
- +18 ;OR TIMEOUT
- +19 ;INQUIRY TO HELP; GOTO TDATE
- IF X?1.3"?"
- GOTO TDATE
- +20 IF Y=-1
- WRITE !!,*7,"Invalid Date: Press a '?' for help."
- GOTO TDATE
- +21 ;INVALID ENTRY; GOTO TDATE
- +22 +23 ;AZXRTDT= FILEMAN DT RETURNED
- SET AZXRTDT=Y
- +24 ; IN Y
- +25 IF AZXRTDT<AZXRFDT
- WRITE !!,"'To Date' must be greater than or equal to 'From Date'",!
- GOTO TDATE
- +26 ;ASK USER FOR CLINIC STOPS
- DO CLINICS
- +27 ;USER WANTS TO BACKUP "^"
- IF AZXRBCK="Y"
- GOTO TDATE
- +28 QUIT
- +29 CLINICS ;ASK USER FOR ALL CLINIC STOPS
- +1 ;SET LOCAL VARIABLES
- +2 ;AZXRBCK= VARIABLE USED FOR
- SET AZXRBCK="N"
- +3 ; CHECKING WHETHER USER
- +4 ; WANTS TO BACK UP "^"
- +5 ;USE ^DIC(40.7, FOR LOOKUP
- SET DIC="^DIC(40.7,"
- +6 ;CLINIC STOP FILE
- +7 ;DIC(0)= LOOKUP VALUES
- SET DIC(0)="AEOQZ"
- +8 ; A= ASK THE ENTRY
- +9 ; E= ECHO BACK ANSWER
- +10 ; O= ONLY FIND ONE ANSWER
- +11 ; Q= QUESTION ERROR INPUT
- +12 ; Z= OUTPUT IN Y(0),Y(0,0)
- +13 +14 ;DIC("A")= DEFAULT PROMPT
- SET DIC("A")="Enter Clinic Stop: "
- +15 +16 ;L= FIRST CLINIC STOP SUBSCRPT
- SET L=1
- +17 FOR
- IF AZXRBCK="Y"
- QUIT
- SET AZXROK="Y"
- IF L>5
- QUIT
- DO ^DIC
- IF (X="")&(L>1)
- QUIT
- Begin DoDot:1
- +18 IF (X="^")!((X="")&(L=1))!($DATA(DTOUT))
- KILL DTOUT
- SET AZXRBCK="Y"
- QUIT
- +19 IF L>1
- FOR J=1:1:(L-1)
- IF Y(0,0)=$PIECE(AZXRCLNC(J),U,2)
- SET AZXROK="N"
- QUIT
- +20 IF AZXROK="Y"
- SET $PIECE(AZXRCLNC(L),U,2)=Y(0,0)
- SET $PIECE(AZXRCLNC(L),U)=$PIECE(Y,U,1)
- SET L=L+1
- QUIT
- +21 WRITE !!,*7,"All clinic stops must be unique, please try again.",!
- End DoDot:1
- +22 ;DO LOOKUP FOR CLINIC STOPS
- +23 ;CHECK IF USER WANTS TO BACK
- +24 ;UP OR TIMEOUT
- +25 ;MAKE SURE ALL CLINIC STOPS
- +26 ;ARE UNIQUE
- +27 ;AZXRCLNC(L)= 1) INTERNAL # OF
- +28 ; CLINIC STOPS
- +29 ; 2) EXTERNAL FORM
- +30 +31 ;GO BACK TO FACILITY PROMPT
- IF AZXRBCK="Y"
- QUIT
- +32 ;GET AFFILIATIONS
- DO AFFIL^AZXRVP1C
- +33 ;USER WANTS TO BACKUP "^"
- IF AZXRBCK="Y"
- GOTO CLINICS
- +34 QUIT
