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
