Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQASU5

ACKQASU5.m

Go to the documentation of this file.
  1. ACKQASU5 ;HCIOFO/AG - New/Edit Visit Utilities ; 04/01/99
  1. ;;3.0;QUASAR;;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. ;
  1. SETDIAG(ACKVIEN,ACKICD,ACKDPRIM) ; add ICD9 code to A&SP Clinic Visit
  1. ; inputs: ACKVIEN - A&SP visit ien
  1. ; ACKICD - ICD9 Diagnosis ien from ICD9 file
  1. ; ACKDPRIM - Primary Diag. flag
  1. ; outputs: 1^ - everything ok
  1. ; 0^xxxxxxx - update failed (reason=xxxxxx)
  1. ; NB. This function checks the Stop Code for the visit against the
  1. ; valid stop codes for the Diagnosis. It therefore assumes that the
  1. ; visit stop code has already been filed.
  1. N ACKDIAG,ACKICDN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKDSC
  1. ;
  1. S ACKDIAG=""
  1. ; find the ICD code on the QUASAR file
  1. S ACKICDN=$$FIND1^DIC(509850.1,",","Q",ACKICD,"","","")
  1. ;
  1. ; if not found then set error message and exit
  1. I 'ACKICDN D G SETDIAGX
  1. . S ACKDIAG="0^Diagnosis not valid for Audiology and Speech Pathology"
  1. ;
  1. ; if found, get status (active/inactive)
  1. S ACKSTAT=$$GET1^DIQ(509850.1,ACKICDN_",",.06,"I")
  1. ;
  1. ; if inactive then set error message and exit
  1. I ACKSTAT'=1 D G SETDIAGX
  1. . S ACKDIAG="0^Diagnosis not Active"
  1. ;
  1. ; get the stop code for the visit and the stop code for the Diagnosis
  1. S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
  1. S ACKDSC=$$GET1^DIQ(509850.1,ACKICDN_",",.04,"I")
  1. ;
  1. ; if diagnosis is for different stop code then set error and exit
  1. I ACKDSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETDIAGX
  1. . S ACKDIAG="0^Diagnosis is not valid for an Audiology Visit"
  1. I ACKDSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETDIAGX
  1. . S ACKDIAG="0^Diagnosis is not valid for a Speech Pathology Visit"
  1. ;
  1. ; see if the code already exists on the visit
  1. S ACKE=$$FIND1^DIC(509850.63,","_ACKVIEN_",","Q",ACKICDN,"","","")
  1. ;
  1. ; if it does already exist on the visit then set error message and exit
  1. ; (null value also is an error as this means an error occurred in the lookup)
  1. I ACKE'=0 D G SETDIAGX
  1. . S ACKDIAG="0^Duplicate Diagnosis"
  1. ;
  1. ; all ok, then add the diagnosis to the visit
  1. S ACKARR(509850.63,"+1,"_ACKVIEN_",",.01)=ACKICDN
  1. I ACKDPRIM S ACKARR(509850.63,"+1,"_ACKVIEN_",",.12)=1
  1. D UPDATE^DIE("","ACKARR","","")
  1. S ACKDIAG="1^" ; set return flag to OK
  1. ;
  1. SETDIAGX ; exit point
  1. Q ACKDIAG
  1. ;
  1. SETPROC(ACKVIEN,ACKCPT,ACKQTY,ACKPPRV) ; add CPT code to A&SP Clinic Visit
  1. ; inputs: ACKVIEN - A&SP visit ien
  1. ; ACKCPT - CPT Procedure ien from ICPT file
  1. ; ACKQTY - number of time procedure was performed (opt)
  1. ; ACKPPRV - Procedure Provider
  1. ; outputs: n^ - everything ok (n=cpt ien on visit)
  1. ; 0^xxxxxxx - update failed (reason=xxxxxx)
  1. ; NB. This function checks the Stop Code for the visit against the
  1. ; valid stop codes for the procedure. It therefore assumes that the
  1. ; visit stop code has already been filed.
  1. N ACKPROC,ACKCPTN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKPSC,ACKIEN
  1. ;
  1. ; initialise return variable and procedure quantity
  1. S ACKPROC="",ACKQTY=$S(+$G(ACKQTY)=0:1,1:ACKQTY)
  1. ;
  1. ; find the ICD code on the QUASAR file
  1. S ACKCPTN=$$FIND1^DIC(509850.4,",","Q",ACKCPT,"","","")
  1. ;
  1. ; if not found then set error message and exit
  1. I 'ACKCPTN D G SETPROCX
  1. . S ACKPROC="0^Procedure not valid for Audiology and Speech Pathology"
  1. ;
  1. ; if found, get status (active/inactive)
  1. S ACKSTAT=$$GET1^DIQ(509850.4,ACKCPTN_",",.04,"I")
  1. ;
  1. ; if inactive then set error message and exit
  1. I ACKSTAT'=1 D G SETPROCX
  1. . S ACKPROC="0^Procedure not Active"
  1. ;
  1. ; get the stop code for the visit and the stop code for the Procedure
  1. S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
  1. S ACKPSC=$$GET1^DIQ(509850.4,ACKCPTN_",",.02,"I")
  1. ;
  1. ; if procedure is for different stop code then set error and exit
  1. I ACKPSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETPROCX
  1. . S ACKPROC="0^Procedure is not valid for an Audiology Visit"
  1. I ACKPSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETPROCX
  1. . S ACKPROC="0^Procedure is not valid for a Speech Pathology Visit"
  1. ;
  1. ; all ok, then add the procedure to the visit
  1. S ACKARR(509850.61,"+1,"_ACKVIEN_",",.01)=ACKCPTN
  1. S ACKARR(509850.61,"+1,"_ACKVIEN_",",.03)=ACKQTY
  1. S ACKARR(509850.61,"+1,"_ACKVIEN_",",.05)=ACKPPRV
  1. K ACKIEN
  1. D UPDATE^DIE("","ACKARR","ACKIEN","")
  1. S ACKPROC=+$G(ACKIEN(1))_"^" ; set return flag to OK
  1. ;
  1. SETPROCX ; exit point
  1. Q ACKPROC
  1. ;
  1. SETMDFR(ACKVIEN,ACKPIEN,ACKMOD) ; add modifier to A&SP Clinic Visit
  1. ; inputs: ACKVIEN - A&SP visit ien
  1. ; ACKPIEN - Procedure ien from visit file
  1. ; ACKMOD - modifier (ien from file 81.3)
  1. ; outputs: 1^ - everything ok
  1. ; 0^xxxxxxx - update failed (reason=xxxxxx)
  1. N ACKMDFR,ACKMODN,ACKARR,ACKSTAT
  1. ;
  1. ; initialise return variable
  1. S ACKMDFR=""
  1. ;
  1. ; find the modifier code on the QUASAR file
  1. S ACKMODN=$$FIND1^DIC(509850.5,",","Q",ACKMOD,"","","")
  1. ;
  1. ; if not found then set error message and exit
  1. I 'ACKMODN D G SETMODX
  1. . S ACKMOD="0^Modifier not valid for Audiology and Speech Pathology"
  1. ;
  1. ; if found, get status (active/inactive)
  1. S ACKSTAT=$$GET1^DIQ(509850.5,ACKMODN_",",1,"I")
  1. ;
  1. ; if inactive then set error message and exit
  1. I ACKSTAT'=1 D G SETMODX
  1. . S ACKMOD="0^Modifier not Active"
  1. ;
  1. ; all ok, then add the modifier to the visit and procedure
  1. S ACKARR(509850.64,"+1,"_ACKPIEN_","_ACKVIEN_",",.01)=ACKMODN
  1. D UPDATE^DIE("","ACKARR","","")
  1. S ACKMOD="1^" ; set return flag to OK
  1. ;
  1. SETMODX ; exit point
  1. Q ACKMOD
  1. ;
  1. ;
  1. PRIMARY(ACKVIEN,ACKDD) ; Does the visit contain a Primary Diagnosis
  1. ; Input - Visit IEN
  1. ; Output - 1=Visit has a Primary Diagnosis
  1. ; 0=Visit Does not have a Primary Diagnosis
  1. ; or User editing diagnosis that is the Primary
  1. ;
  1. I ACKDD'="",$$GET1^DIQ(509850.63,ACKDD_","_ACKVIEN_",",".12","I")=1 K ACKDD Q 0
  1. N ACKFLAG,ACKK3
  1. D LIST^DIC(509850.63,","_ACKVIEN_",",".12","I","*","","","","","","ACKDIAG")
  1. S ACKK3=0,ACKFLAG=0
  1. F S ACKK3=$O(ACKDIAG("DILIST","ID",ACKK3)) Q:ACKK3=""!(ACKFLAG) D
  1. . I ACKDIAG("DILIST","ID",ACKK3,".12")=1 S ACKFLAG=1
  1. K ACKDD
  1. Q ACKFLAG
  1. ;
  1. POSTDIAG(ACKVIEN) ; After Diagnosis codes have been entered check that
  1. ; one is a Primary diagnosis.
  1. ;
  1. ; Input - Visit IEN
  1. ; Output - 1=A primary has been entered
  1. ; 0=A Primary needs to be entered
  1. ;
  1. I $$PRIMARY(ACKVIEN,"") Q 1
  1. W !!,"One of the Diagnosis codes entered must be defined as the Primary Diagnosis."
  1. Q 0
  1. ;
  1. TIMECHEK(ACKVIEN,ACKPARAM) ; Prevet user from editing a Visit Time
  1. ;
  1. ; Input ACKVIEN - Visit IEN
  1. ; ACKPARMAM - 1=Called from Template
  1. ; Null=Called from input Tranform of Visit Time
  1. ; Output 0=Visit has No Visit Time
  1. ; 1=Visit has Visit Time
  1. ;
  1. N ACKQTME
  1. S ACKQTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"E")
  1. I ACKQTME="" Q 0
  1. I ACKPARAM=1 D
  1. . W !,"APPOINTMENT TIME : "_ACKQTME_" (Uneditable)"
  1. K ACKPARAM
  1. Q 1
  1. ;
  1. TIMERR ;
  1. W !," NOTE - Once entered this field cannot be edited."
  1. W !," If you wish to edit the Visit Time use the Delete Visit option then",!
  1. W " re-enter the visit with the correct Visit Time.",!
  1. ;