- ACKQASU5 ;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.
- ;
- SETDIAG(ACKVIEN,ACKICD,ACKDPRIM) ; add ICD9 code to A&SP Clinic Visit
- ; inputs: ACKVIEN - A&SP visit ien
- ; ACKICD - ICD9 Diagnosis ien from ICD9 file
- ; ACKDPRIM - Primary Diag. flag
- ; outputs: 1^ - everything ok
- ; 0^xxxxxxx - update failed (reason=xxxxxx)
- ; NB. This function checks the Stop Code for the visit against the
- ; valid stop codes for the Diagnosis. It therefore assumes that the
- ; visit stop code has already been filed.
- N ACKDIAG,ACKICDN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKDSC
- ;
- S ACKDIAG=""
- ; find the ICD code on the QUASAR file
- S ACKICDN=$$FIND1^DIC(509850.1,",","Q",ACKICD,"","","")
- ;
- ; if not found then set error message and exit
- I 'ACKICDN D G SETDIAGX
- . S ACKDIAG="0^Diagnosis not valid for Audiology and Speech Pathology"
- ;
- ; if found, get status (active/inactive)
- S ACKSTAT=$$GET1^DIQ(509850.1,ACKICDN_",",.06,"I")
- ;
- ; if inactive then set error message and exit
- I ACKSTAT'=1 D G SETDIAGX
- . S ACKDIAG="0^Diagnosis not Active"
- ;
- ; get the stop code for the visit and the stop code for the Diagnosis
- S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
- S ACKDSC=$$GET1^DIQ(509850.1,ACKICDN_",",.04,"I")
- ;
- ; if diagnosis is for different stop code then set error and exit
- I ACKDSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETDIAGX
- . S ACKDIAG="0^Diagnosis is not valid for an Audiology Visit"
- I ACKDSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETDIAGX
- . S ACKDIAG="0^Diagnosis is not valid for a Speech Pathology Visit"
- ;
- ; see if the code already exists on the visit
- S ACKE=$$FIND1^DIC(509850.63,","_ACKVIEN_",","Q",ACKICDN,"","","")
- ;
- ; if it does already exist on the visit then set error message and exit
- ; (null value also is an error as this means an error occurred in the lookup)
- I ACKE'=0 D G SETDIAGX
- . S ACKDIAG="0^Duplicate Diagnosis"
- ;
- ; all ok, then add the diagnosis to the visit
- S ACKARR(509850.63,"+1,"_ACKVIEN_",",.01)=ACKICDN
- I ACKDPRIM S ACKARR(509850.63,"+1,"_ACKVIEN_",",.12)=1
- D UPDATE^DIE("","ACKARR","","")
- S ACKDIAG="1^" ; set return flag to OK
- ;
- SETDIAGX ; exit point
- Q ACKDIAG
- ;
- SETPROC(ACKVIEN,ACKCPT,ACKQTY,ACKPPRV) ; add CPT code to A&SP Clinic Visit
- ; inputs: ACKVIEN - A&SP visit ien
- ; ACKCPT - CPT Procedure ien from ICPT file
- ; ACKQTY - number of time procedure was performed (opt)
- ; ACKPPRV - Procedure Provider
- ; outputs: n^ - everything ok (n=cpt ien on visit)
- ; 0^xxxxxxx - update failed (reason=xxxxxx)
- ; NB. This function checks the Stop Code for the visit against the
- ; valid stop codes for the procedure. It therefore assumes that the
- ; visit stop code has already been filed.
- N ACKPROC,ACKCPTN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKPSC,ACKIEN
- ;
- ; initialise return variable and procedure quantity
- S ACKPROC="",ACKQTY=$S(+$G(ACKQTY)=0:1,1:ACKQTY)
- ;
- ; find the ICD code on the QUASAR file
- S ACKCPTN=$$FIND1^DIC(509850.4,",","Q",ACKCPT,"","","")
- ;
- ; if not found then set error message and exit
- I 'ACKCPTN D G SETPROCX
- . S ACKPROC="0^Procedure not valid for Audiology and Speech Pathology"
- ;
- ; if found, get status (active/inactive)
- S ACKSTAT=$$GET1^DIQ(509850.4,ACKCPTN_",",.04,"I")
- ;
- ; if inactive then set error message and exit
- I ACKSTAT'=1 D G SETPROCX
- . S ACKPROC="0^Procedure not Active"
- ;
- ; get the stop code for the visit and the stop code for the Procedure
- S ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
- S ACKPSC=$$GET1^DIQ(509850.4,ACKCPTN_",",.02,"I")
- ;
- ; if procedure is for different stop code then set error and exit
- I ACKPSC="S",(ACKVSC="A")!(ACKVSC="AT") D G SETPROCX
- . S ACKPROC="0^Procedure is not valid for an Audiology Visit"
- I ACKPSC="A",(ACKVSC="S")!(ACKVSC="ST") D G SETPROCX
- . S ACKPROC="0^Procedure is not valid for a Speech Pathology Visit"
- ;
- ; all ok, then add the procedure to the visit
- S ACKARR(509850.61,"+1,"_ACKVIEN_",",.01)=ACKCPTN
- S ACKARR(509850.61,"+1,"_ACKVIEN_",",.03)=ACKQTY
- S ACKARR(509850.61,"+1,"_ACKVIEN_",",.05)=ACKPPRV
- K ACKIEN
- D UPDATE^DIE("","ACKARR","ACKIEN","")
- S ACKPROC=+$G(ACKIEN(1))_"^" ; set return flag to OK
- ;
- SETPROCX ; exit point
- Q ACKPROC
- ;
- SETMDFR(ACKVIEN,ACKPIEN,ACKMOD) ; add modifier to A&SP Clinic Visit
- ; inputs: ACKVIEN - A&SP visit ien
- ; ACKPIEN - Procedure ien from visit file
- ; ACKMOD - modifier (ien from file 81.3)
- ; outputs: 1^ - everything ok
- ; 0^xxxxxxx - update failed (reason=xxxxxx)
- N ACKMDFR,ACKMODN,ACKARR,ACKSTAT
- ;
- ; initialise return variable
- S ACKMDFR=""
- ;
- ; find the modifier code on the QUASAR file
- S ACKMODN=$$FIND1^DIC(509850.5,",","Q",ACKMOD,"","","")
- ;
- ; if not found then set error message and exit
- I 'ACKMODN D G SETMODX
- . S ACKMOD="0^Modifier not valid for Audiology and Speech Pathology"
- ;
- ; if found, get status (active/inactive)
- S ACKSTAT=$$GET1^DIQ(509850.5,ACKMODN_",",1,"I")
- ;
- ; if inactive then set error message and exit
- I ACKSTAT'=1 D G SETMODX
- . S ACKMOD="0^Modifier not Active"
- ;
- ; all ok, then add the modifier to the visit and procedure
- S ACKARR(509850.64,"+1,"_ACKPIEN_","_ACKVIEN_",",.01)=ACKMODN
- D UPDATE^DIE("","ACKARR","","")
- S ACKMOD="1^" ; set return flag to OK
- ;
- SETMODX ; exit point
- Q ACKMOD
- ;
- ;
- PRIMARY(ACKVIEN,ACKDD) ; Does the visit contain a Primary Diagnosis
- ; Input - Visit IEN
- ; Output - 1=Visit has a Primary Diagnosis
- ; 0=Visit Does not have a Primary Diagnosis
- ; or User editing diagnosis that is the Primary
- ;
- I ACKDD'="",$$GET1^DIQ(509850.63,ACKDD_","_ACKVIEN_",",".12","I")=1 K ACKDD Q 0
- N ACKFLAG,ACKK3
- D LIST^DIC(509850.63,","_ACKVIEN_",",".12","I","*","","","","","","ACKDIAG")
- S ACKK3=0,ACKFLAG=0
- F S ACKK3=$O(ACKDIAG("DILIST","ID",ACKK3)) Q:ACKK3=""!(ACKFLAG) D
- . I ACKDIAG("DILIST","ID",ACKK3,".12")=1 S ACKFLAG=1
- K ACKDD
- Q ACKFLAG
- ;
- POSTDIAG(ACKVIEN) ; After Diagnosis codes have been entered check that
- ; one is a Primary diagnosis.
- ;
- ; Input - Visit IEN
- ; Output - 1=A primary has been entered
- ; 0=A Primary needs to be entered
- ;
- I $$PRIMARY(ACKVIEN,"") Q 1
- W !!,"One of the Diagnosis codes entered must be defined as the Primary Diagnosis."
- Q 0
- ;
- TIMECHEK(ACKVIEN,ACKPARAM) ; Prevet user from editing a Visit Time
- ;
- ; Input ACKVIEN - Visit IEN
- ; ACKPARMAM - 1=Called from Template
- ; Null=Called from input Tranform of Visit Time
- ; Output 0=Visit has No Visit Time
- ; 1=Visit has Visit Time
- ;
- N ACKQTME
- S ACKQTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"E")
- I ACKQTME="" Q 0
- I ACKPARAM=1 D
- . W !,"APPOINTMENT TIME : "_ACKQTME_" (Uneditable)"
- K ACKPARAM
- Q 1
- ;
- TIMERR ;
- W !," NOTE - Once entered this field cannot be edited."
- W !," If you wish to edit the Visit Time use the Delete Visit option then",!
- W " re-enter the visit with the correct Visit Time.",!
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQASU5 7170 printed Jan 18, 2025@03:33 Page 2
- ACKQASU5 ;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 ;
- SETDIAG(ACKVIEN,ACKICD,ACKDPRIM) ; add ICD9 code to A&SP Clinic Visit
- +1 ; inputs: ACKVIEN - A&SP visit ien
- +2 ; ACKICD - ICD9 Diagnosis ien from ICD9 file
- +3 ; ACKDPRIM - Primary Diag. flag
- +4 ; outputs: 1^ - everything ok
- +5 ; 0^xxxxxxx - update failed (reason=xxxxxx)
- +6 ; NB. This function checks the Stop Code for the visit against the
- +7 ; valid stop codes for the Diagnosis. It therefore assumes that the
- +8 ; visit stop code has already been filed.
- +9 NEW ACKDIAG,ACKICDN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKDSC
- +10 ;
- +11 SET ACKDIAG=""
- +12 ; find the ICD code on the QUASAR file
- +13 SET ACKICDN=$$FIND1^DIC(509850.1,",","Q",ACKICD,"","","")
- +14 ;
- +15 ; if not found then set error message and exit
- +16 IF 'ACKICDN
- Begin DoDot:1
- +17 SET ACKDIAG="0^Diagnosis not valid for Audiology and Speech Pathology"
- End DoDot:1
- GOTO SETDIAGX
- +18 ;
- +19 ; if found, get status (active/inactive)
- +20 SET ACKSTAT=$$GET1^DIQ(509850.1,ACKICDN_",",.06,"I")
- +21 ;
- +22 ; if inactive then set error message and exit
- +23 IF ACKSTAT'=1
- Begin DoDot:1
- +24 SET ACKDIAG="0^Diagnosis not Active"
- End DoDot:1
- GOTO SETDIAGX
- +25 ;
- +26 ; get the stop code for the visit and the stop code for the Diagnosis
- +27 SET ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
- +28 SET ACKDSC=$$GET1^DIQ(509850.1,ACKICDN_",",.04,"I")
- +29 ;
- +30 ; if diagnosis is for different stop code then set error and exit
- +31 IF ACKDSC="S"
- IF (ACKVSC="A")!(ACKVSC="AT")
- Begin DoDot:1
- +32 SET ACKDIAG="0^Diagnosis is not valid for an Audiology Visit"
- End DoDot:1
- GOTO SETDIAGX
- +33 IF ACKDSC="A"
- IF (ACKVSC="S")!(ACKVSC="ST")
- Begin DoDot:1
- +34 SET ACKDIAG="0^Diagnosis is not valid for a Speech Pathology Visit"
- End DoDot:1
- GOTO SETDIAGX
- +35 ;
- +36 ; see if the code already exists on the visit
- +37 SET ACKE=$$FIND1^DIC(509850.63,","_ACKVIEN_",","Q",ACKICDN,"","","")
- +38 ;
- +39 ; if it does already exist on the visit then set error message and exit
- +40 ; (null value also is an error as this means an error occurred in the lookup)
- +41 IF ACKE'=0
- Begin DoDot:1
- +42 SET ACKDIAG="0^Duplicate Diagnosis"
- End DoDot:1
- GOTO SETDIAGX
- +43 ;
- +44 ; all ok, then add the diagnosis to the visit
- +45 SET ACKARR(509850.63,"+1,"_ACKVIEN_",",.01)=ACKICDN
- +46 IF ACKDPRIM
- SET ACKARR(509850.63,"+1,"_ACKVIEN_",",.12)=1
- +47 DO UPDATE^DIE("","ACKARR","","")
- +48 ; set return flag to OK
- SET ACKDIAG="1^"
- +49 ;
- SETDIAGX ; exit point
- +1 QUIT ACKDIAG
- +2 ;
- SETPROC(ACKVIEN,ACKCPT,ACKQTY,ACKPPRV) ; add CPT code to A&SP Clinic Visit
- +1 ; inputs: ACKVIEN - A&SP visit ien
- +2 ; ACKCPT - CPT Procedure ien from ICPT file
- +3 ; ACKQTY - number of time procedure was performed (opt)
- +4 ; ACKPPRV - Procedure Provider
- +5 ; outputs: n^ - everything ok (n=cpt ien on visit)
- +6 ; 0^xxxxxxx - update failed (reason=xxxxxx)
- +7 ; NB. This function checks the Stop Code for the visit against the
- +8 ; valid stop codes for the procedure. It therefore assumes that the
- +9 ; visit stop code has already been filed.
- +10 NEW ACKPROC,ACKCPTN,ACKE,ACKARR,ACKSTAT,ACKVSC,ACKPSC,ACKIEN
- +11 ;
- +12 ; initialise return variable and procedure quantity
- +13 SET ACKPROC=""
- SET ACKQTY=$SELECT(+$GET(ACKQTY)=0:1,1:ACKQTY)
- +14 ;
- +15 ; find the ICD code on the QUASAR file
- +16 SET ACKCPTN=$$FIND1^DIC(509850.4,",","Q",ACKCPT,"","","")
- +17 ;
- +18 ; if not found then set error message and exit
- +19 IF 'ACKCPTN
- Begin DoDot:1
- +20 SET ACKPROC="0^Procedure not valid for Audiology and Speech Pathology"
- End DoDot:1
- GOTO SETPROCX
- +21 ;
- +22 ; if found, get status (active/inactive)
- +23 SET ACKSTAT=$$GET1^DIQ(509850.4,ACKCPTN_",",.04,"I")
- +24 ;
- +25 ; if inactive then set error message and exit
- +26 IF ACKSTAT'=1
- Begin DoDot:1
- +27 SET ACKPROC="0^Procedure not Active"
- End DoDot:1
- GOTO SETPROCX
- +28 ;
- +29 ; get the stop code for the visit and the stop code for the Procedure
- +30 SET ACKVSC=$$GET1^DIQ(509850.6,ACKVIEN_",",4,"I")
- +31 SET ACKPSC=$$GET1^DIQ(509850.4,ACKCPTN_",",.02,"I")
- +32 ;
- +33 ; if procedure is for different stop code then set error and exit
- +34 IF ACKPSC="S"
- IF (ACKVSC="A")!(ACKVSC="AT")
- Begin DoDot:1
- +35 SET ACKPROC="0^Procedure is not valid for an Audiology Visit"
- End DoDot:1
- GOTO SETPROCX
- +36 IF ACKPSC="A"
- IF (ACKVSC="S")!(ACKVSC="ST")
- Begin DoDot:1
- +37 SET ACKPROC="0^Procedure is not valid for a Speech Pathology Visit"
- End DoDot:1
- GOTO SETPROCX
- +38 ;
- +39 ; all ok, then add the procedure to the visit
- +40 SET ACKARR(509850.61,"+1,"_ACKVIEN_",",.01)=ACKCPTN
- +41 SET ACKARR(509850.61,"+1,"_ACKVIEN_",",.03)=ACKQTY
- +42 SET ACKARR(509850.61,"+1,"_ACKVIEN_",",.05)=ACKPPRV
- +43 KILL ACKIEN
- +44 DO UPDATE^DIE("","ACKARR","ACKIEN","")
- +45 ; set return flag to OK
- SET ACKPROC=+$GET(ACKIEN(1))_"^"
- +46 ;
- SETPROCX ; exit point
- +1 QUIT ACKPROC
- +2 ;
- SETMDFR(ACKVIEN,ACKPIEN,ACKMOD) ; add modifier to A&SP Clinic Visit
- +1 ; inputs: ACKVIEN - A&SP visit ien
- +2 ; ACKPIEN - Procedure ien from visit file
- +3 ; ACKMOD - modifier (ien from file 81.3)
- +4 ; outputs: 1^ - everything ok
- +5 ; 0^xxxxxxx - update failed (reason=xxxxxx)
- +6 NEW ACKMDFR,ACKMODN,ACKARR,ACKSTAT
- +7 ;
- +8 ; initialise return variable
- +9 SET ACKMDFR=""
- +10 ;
- +11 ; find the modifier code on the QUASAR file
- +12 SET ACKMODN=$$FIND1^DIC(509850.5,",","Q",ACKMOD,"","","")
- +13 ;
- +14 ; if not found then set error message and exit
- +15 IF 'ACKMODN
- Begin DoDot:1
- +16 SET ACKMOD="0^Modifier not valid for Audiology and Speech Pathology"
- End DoDot:1
- GOTO SETMODX
- +17 ;
- +18 ; if found, get status (active/inactive)
- +19 SET ACKSTAT=$$GET1^DIQ(509850.5,ACKMODN_",",1,"I")
- +20 ;
- +21 ; if inactive then set error message and exit
- +22 IF ACKSTAT'=1
- Begin DoDot:1
- +23 SET ACKMOD="0^Modifier not Active"
- End DoDot:1
- GOTO SETMODX
- +24 ;
- +25 ; all ok, then add the modifier to the visit and procedure
- +26 SET ACKARR(509850.64,"+1,"_ACKPIEN_","_ACKVIEN_",",.01)=ACKMODN
- +27 DO UPDATE^DIE("","ACKARR","","")
- +28 ; set return flag to OK
- SET ACKMOD="1^"
- +29 ;
- SETMODX ; exit point
- +1 QUIT ACKMOD
- +2 ;
- +3 ;
- PRIMARY(ACKVIEN,ACKDD) ; Does the visit contain a Primary Diagnosis
- +1 ; Input - Visit IEN
- +2 ; Output - 1=Visit has a Primary Diagnosis
- +3 ; 0=Visit Does not have a Primary Diagnosis
- +4 ; or User editing diagnosis that is the Primary
- +5 ;
- +6 IF ACKDD'=""
- IF $$GET1^DIQ(509850.63,ACKDD_","_ACKVIEN_",",".12","I")=1
- KILL ACKDD
- QUIT 0
- +7 NEW ACKFLAG,ACKK3
- +8 DO LIST^DIC(509850.63,","_ACKVIEN_",",".12","I","*","","","","","","ACKDIAG")
- +9 SET ACKK3=0
- SET ACKFLAG=0
- +10 FOR
- SET ACKK3=$ORDER(ACKDIAG("DILIST","ID",ACKK3))
- if ACKK3=""!(ACKFLAG)
- QUIT
- Begin DoDot:1
- +11 IF ACKDIAG("DILIST","ID",ACKK3,".12")=1
- SET ACKFLAG=1
- End DoDot:1
- +12 KILL ACKDD
- +13 QUIT ACKFLAG
- +14 ;
- POSTDIAG(ACKVIEN) ; After Diagnosis codes have been entered check that
- +1 ; one is a Primary diagnosis.
- +2 ;
- +3 ; Input - Visit IEN
- +4 ; Output - 1=A primary has been entered
- +5 ; 0=A Primary needs to be entered
- +6 ;
- +7 IF $$PRIMARY(ACKVIEN,"")
- QUIT 1
- +8 WRITE !!,"One of the Diagnosis codes entered must be defined as the Primary Diagnosis."
- +9 QUIT 0
- +10 ;
- TIMECHEK(ACKVIEN,ACKPARAM) ; Prevet user from editing a Visit Time
- +1 ;
- +2 ; Input ACKVIEN - Visit IEN
- +3 ; ACKPARMAM - 1=Called from Template
- +4 ; Null=Called from input Tranform of Visit Time
- +5 ; Output 0=Visit has No Visit Time
- +6 ; 1=Visit has Visit Time
- +7 ;
- +8 NEW ACKQTME
- +9 SET ACKQTME=$$GET1^DIQ(509850.6,ACKVIEN,55,"E")
- +10 IF ACKQTME=""
- QUIT 0
- +11 IF ACKPARAM=1
- Begin DoDot:1
- +12 WRITE !,"APPOINTMENT TIME : "_ACKQTME_" (Uneditable)"
- End DoDot:1
- +13 KILL ACKPARAM
- +14 QUIT 1
- +15 ;
- TIMERR ;
- +1 WRITE !," NOTE - Once entered this field cannot be edited."
- +2 WRITE !," If you wish to edit the Visit Time use the Delete Visit option then",!
- +3 WRITE " re-enter the visit with the correct Visit Time.",!
- +4 ;