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'="",ACKPINAACKVD) 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'="",ACKPINAACKVD) 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