ACKQASU6 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
;
SETPRIM(ACKVIEN,ACKQPRV) ; add primary provider to A&SP Clinic Visit
; inputs: ACKVIEN - A&SP visit ien
; ACKQPRV - provider ien from Quasar or null
; outputs: 1^ - everything ok
; 0^xxxxxxx - update failed (reason=xxxxxx)
; NB. This function checks the visit date for the visit against the
; activation and inactivation dates for the Provider. it therefore
; assumes that the visit date has already been filed.
N ACKPRIM,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
S ACKPRIM="" ; return string
;
S ACKPRVN=ACKQPRV
;
; if not found then set error message and exit
I 'ACKPRVN D G SETPRIMX
. S ACKPRIM="0^Provider not defined for Audiology and Speech Pathology"
;
; if defined get status (clinician/fee basis/other provider/student)
S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
;
; if not a clinician or fee basis then not allowed as primary provider
I ACKSTAT'="C",ACKSTAT'="F" D G SETPRIMX
. S ACKPRIM="0^Primary Provider must be a Clinician or Fee Basis Clinician"
;
; get the visit date and the provider activation/inactivation dates
S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
;
; if the provider is not active then set error and exit
I (ACKPACT="")!(ACKPACT>ACKVD) D G SETPRIMX
. S ACKPRIM="0^Provider not Active on the Visit Date"
;
; if the provider is inactive then set error and exit
I ACKPINA'="",ACKPINA<ACKVD D G SETPRIMX
. S ACKPRIM="0^Provider made Inactive prior to the Visit Date"
;
; all ok, then add the provider to the visit
S ACKARR(509850.6,ACKVIEN_",",6)=ACKPRVN
D FILE^DIE("","ACKARR","")
S ACKPRIM="1^" ; set return flag to OK
;
SETPRIMX ; exit point
Q ACKPRIM
;
SETSCND(ACKVIEN,ACKQPRV) ; add secondary provider to A&SP Clinic Visit
; inputs: ACKVIEN - A&SP visit ien
; ACKQPRV - provider ien from Quasar file or null
; outputs: 1^ - everything ok
; 0^xxxxxxx - update failed (reason=xxxxxx)
; NB. This function checks the visit date for the visit against the
; activation and inactivation dates for the Provider. it therefore
; assumes that the visit date has already been filed.
N ACKSCND,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
S ACKSCND="" ; return string
;
S ACKPRVN=ACKQPRV
;
; if not found then set error message and exit
I 'ACKPRVN D G SETSCNDX
. S ACKSCND="0^Provider not defined for Audiology and Speech Pathology"
;
; if found, get status (clinician/fee basis/other provider/student)
S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
;
; if not a clinician, fee basis or other provider then not allowed as second provider
I ACKSTAT'="C",ACKSTAT'="F",ACKSTAT'="O" D G SETSCNDX
. S ACKSCND="0^Secondary Provider must be a Clinician, Fee Basis or Other Provider"
;
; get the visit date and the provider activation/inactivation dates
S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
;
; if the provider is not active then set error and exit
I (ACKPACT="")!(ACKPACT>ACKVD) D G SETSCNDX
. S ACKSCND="0^Provider not Active on the Visit Date"
;
; if the provider is inactive then set error and exit
I ACKPINA'="",ACKPINA<ACKVD D G SETSCNDX
. S ACKSCND="0^Provider made Inactive prior to the Visit Date"
;
; all ok, then add the provider to the visit
S ACKARR(509850.66,"+1,"_ACKVIEN_",",.01)=ACKPRVN
D UPDATE^DIE("","ACKARR","","")
S ACKSCND="1^" ; set return flag to OK
;
SETSCNDX ; exit point
Q ACKSCND
;
SETSTUD(ACKVIEN,ACKQPRV) ; add student to A&SP Clinic Visit
; inputs: ACKVIEN - A&SP visit ien
; ACKQPRV - provider ien from Quasar file or null
; outputs: 1^ - everything ok
; 0^xxxxxxx - update failed (reason=xxxxxx)
; NB. This function checks the visit date for the visit against the
; activation and inactivation dates for the Provider. it therefore
; assumes that the visit date has already been filed.
N ACKSTUD,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
S ACKSTUD="" ; return string
;
S ACKPRVN=ACKQPRV
;
; if not found then set error message and exit
I 'ACKPRVN D G SETSTUDX
. S ACKSTUD="0^Provider not defined for Audiology and Speech Pathology"
;
; if found, get status (clinician/fee basis/other provider/student)
S ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
;
; if not a student then set error message and quit
I ACKSTAT'="S" D G SETSTUDX
. S ACKSTUD="0^Provider must be defined as a Student in the A&SP Staff File."
;
; get the visit date and the provider activation/inactivation dates
S ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
S ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
S ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
;
; if the provider is not active then set error and exit
I (ACKPACT="")!(ACKPACT>ACKVD) D G SETSTUDX
. S ACKSTUD="0^Provider not Active on the Visit Date"
;
; if the provider is inactive then set error and exit
I ACKPINA'="",ACKPINA<ACKVD D G SETSTUDX
. S ACKSTUD="0^Provider made Inactive prior to the Visit Date"
;
; all ok, then add the provider to the visit
S ACKARR(509850.6,ACKVIEN_",",7)=ACKPRVN
D FILE^DIE("","ACKARR","")
S ACKSTUD="1^" ; set return flag to OK
;
SETSTUDX ; exit point
Q ACKSTUD
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQASU6 5627 printed Oct 16, 2024@18:32:35 Page 2
ACKQASU6 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
+4 ;
SETPRIM(ACKVIEN,ACKQPRV) ; add primary provider to A&SP Clinic Visit
+1 ; inputs: ACKVIEN - A&SP visit ien
+2 ; ACKQPRV - provider ien from Quasar or null
+3 ; outputs: 1^ - everything ok
+4 ; 0^xxxxxxx - update failed (reason=xxxxxx)
+5 ; NB. This function checks the visit date for the visit against the
+6 ; activation and inactivation dates for the Provider. it therefore
+7 ; assumes that the visit date has already been filed.
+8 NEW ACKPRIM,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
+9 ; return string
SET ACKPRIM=""
+10 ;
+11 SET ACKPRVN=ACKQPRV
+12 ;
+13 ; if not found then set error message and exit
+14 IF 'ACKPRVN
Begin DoDot:1
+15 SET ACKPRIM="0^Provider not defined for Audiology and Speech Pathology"
End DoDot:1
GOTO SETPRIMX
+16 ;
+17 ; if defined get status (clinician/fee basis/other provider/student)
+18 SET ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
+19 ;
+20 ; if not a clinician or fee basis then not allowed as primary provider
+21 IF ACKSTAT'="C"
IF ACKSTAT'="F"
Begin DoDot:1
+22 SET ACKPRIM="0^Primary Provider must be a Clinician or Fee Basis Clinician"
End DoDot:1
GOTO SETPRIMX
+23 ;
+24 ; get the visit date and the provider activation/inactivation dates
+25 SET ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
+26 SET ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
+27 SET ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
+28 ;
+29 ; if the provider is not active then set error and exit
+30 IF (ACKPACT="")!(ACKPACT>ACKVD)
Begin DoDot:1
+31 SET ACKPRIM="0^Provider not Active on the Visit Date"
End DoDot:1
GOTO SETPRIMX
+32 ;
+33 ; if the provider is inactive then set error and exit
+34 IF ACKPINA'=""
IF ACKPINA<ACKVD
Begin DoDot:1
+35 SET ACKPRIM="0^Provider made Inactive prior to the Visit Date"
End DoDot:1
GOTO SETPRIMX
+36 ;
+37 ; all ok, then add the provider to the visit
+38 SET ACKARR(509850.6,ACKVIEN_",",6)=ACKPRVN
+39 DO FILE^DIE("","ACKARR","")
+40 ; set return flag to OK
SET ACKPRIM="1^"
+41 ;
SETPRIMX ; exit point
+1 QUIT ACKPRIM
+2 ;
SETSCND(ACKVIEN,ACKQPRV) ; add secondary provider to A&SP Clinic Visit
+1 ; inputs: ACKVIEN - A&SP visit ien
+2 ; ACKQPRV - provider ien from Quasar file or null
+3 ; outputs: 1^ - everything ok
+4 ; 0^xxxxxxx - update failed (reason=xxxxxx)
+5 ; NB. This function checks the visit date for the visit against the
+6 ; activation and inactivation dates for the Provider. it therefore
+7 ; assumes that the visit date has already been filed.
+8 NEW ACKSCND,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
+9 ; return string
SET ACKSCND=""
+10 ;
+11 SET ACKPRVN=ACKQPRV
+12 ;
+13 ; if not found then set error message and exit
+14 IF 'ACKPRVN
Begin DoDot:1
+15 SET ACKSCND="0^Provider not defined for Audiology and Speech Pathology"
End DoDot:1
GOTO SETSCNDX
+16 ;
+17 ; if found, get status (clinician/fee basis/other provider/student)
+18 SET ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
+19 ;
+20 ; if not a clinician, fee basis or other provider then not allowed as second provider
+21 IF ACKSTAT'="C"
IF ACKSTAT'="F"
IF ACKSTAT'="O"
Begin DoDot:1
+22 SET ACKSCND="0^Secondary Provider must be a Clinician, Fee Basis or Other Provider"
End DoDot:1
GOTO SETSCNDX
+23 ;
+24 ; get the visit date and the provider activation/inactivation dates
+25 SET ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
+26 SET ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
+27 SET ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
+28 ;
+29 ; if the provider is not active then set error and exit
+30 IF (ACKPACT="")!(ACKPACT>ACKVD)
Begin DoDot:1
+31 SET ACKSCND="0^Provider not Active on the Visit Date"
End DoDot:1
GOTO SETSCNDX
+32 ;
+33 ; if the provider is inactive then set error and exit
+34 IF ACKPINA'=""
IF ACKPINA<ACKVD
Begin DoDot:1
+35 SET ACKSCND="0^Provider made Inactive prior to the Visit Date"
End DoDot:1
GOTO SETSCNDX
+36 ;
+37 ; all ok, then add the provider to the visit
+38 SET ACKARR(509850.66,"+1,"_ACKVIEN_",",.01)=ACKPRVN
+39 DO UPDATE^DIE("","ACKARR","","")
+40 ; set return flag to OK
SET ACKSCND="1^"
+41 ;
SETSCNDX ; exit point
+1 QUIT ACKSCND
+2 ;
SETSTUD(ACKVIEN,ACKQPRV) ; add student to A&SP Clinic Visit
+1 ; inputs: ACKVIEN - A&SP visit ien
+2 ; ACKQPRV - provider ien from Quasar file or null
+3 ; outputs: 1^ - everything ok
+4 ; 0^xxxxxxx - update failed (reason=xxxxxx)
+5 ; NB. This function checks the visit date for the visit against the
+6 ; activation and inactivation dates for the Provider. it therefore
+7 ; assumes that the visit date has already been filed.
+8 NEW ACKSTUD,ACKPRVN,ACKARR,ACKVD,ACKPACT,ACKPINA,ACKSTAT
+9 ; return string
SET ACKSTUD=""
+10 ;
+11 SET ACKPRVN=ACKQPRV
+12 ;
+13 ; if not found then set error message and exit
+14 IF 'ACKPRVN
Begin DoDot:1
+15 SET ACKSTUD="0^Provider not defined for Audiology and Speech Pathology"
End DoDot:1
GOTO SETSTUDX
+16 ;
+17 ; if found, get status (clinician/fee basis/other provider/student)
+18 SET ACKSTAT=$$GET1^DIQ(509850.3,ACKPRVN_",",.02,"I")
+19 ;
+20 ; if not a student then set error message and quit
+21 IF ACKSTAT'="S"
Begin DoDot:1
+22 SET ACKSTUD="0^Provider must be defined as a Student in the A&SP Staff File."
End DoDot:1
GOTO SETSTUDX
+23 ;
+24 ; get the visit date and the provider activation/inactivation dates
+25 SET ACKVD=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I")
+26 SET ACKPACT=$$GET1^DIQ(509850.3,ACKPRVN_",",.03,"I")
+27 SET ACKPINA=$$GET1^DIQ(509850.3,ACKPRVN_",",.04,"I")
+28 ;
+29 ; if the provider is not active then set error and exit
+30 IF (ACKPACT="")!(ACKPACT>ACKVD)
Begin DoDot:1
+31 SET ACKSTUD="0^Provider not Active on the Visit Date"
End DoDot:1
GOTO SETSTUDX
+32 ;
+33 ; if the provider is inactive then set error and exit
+34 IF ACKPINA'=""
IF ACKPINA<ACKVD
Begin DoDot:1
+35 SET ACKSTUD="0^Provider made Inactive prior to the Visit Date"
End DoDot:1
GOTO SETSTUDX
+36 ;
+37 ; all ok, then add the provider to the visit
+38 SET ACKARR(509850.6,ACKVIEN_",",7)=ACKPRVN
+39 DO FILE^DIE("","ACKARR","")
+40 ; set return flag to OK
SET ACKSTUD="1^"
+41 ;
SETSTUDX ; exit point
+1 QUIT ACKSTUD
+2 ;
