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 Oct 16, 2024@18:32:34 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 ;
