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

ACKQASU4.m

Go to the documentation of this file.
  1. ACKQASU4 ;HCIOFO/AG - New/Edit Visit Utilities ;18 Nov 2013 4:38 PM
  1. ;;3.0;QUASAR;**17,22,21**;Feb 11, 2000;Build 40
  1. ;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
  1. ;
  1. ; Reference/ICR
  1. ; $$CODEC^ICDEX - 5747
  1. ; $$MOD^ICPTMOD - 1996
  1. ; $$CPT^ICPTCOD - 1995
  1. ;
  1. COPYPCE(ACKVIEN,ACKPCENO) ; Copies the visit data from given PCE Visit
  1. ; inputs:- ACKVIEN - QUASAR Visit ien to receive data
  1. ; ACKPCENO - PCE Visit ien to copy from
  1. ; outputs:- 0^ - everything ok
  1. ; n^ - n errors found
  1. ; errors filed in ^TMP("ACKQASU4",$J,"COPYPCE","ERROR",n)=field^int^ext^message
  1. ; NB. In the validation of Dx and CPT codes, the Visit Stop Code (A,S,
  1. ; AT or ST) is read from the Qsr Visit record. For this validation to
  1. ; work therefore, the Visit Stop Code must already be filed on the Qsr
  1. ; visit.
  1. N ACKERR,ACKARR,ACKVELG,ACKI,ACKICD,ACKE,ACKTMP,ACKPRIM,ACKSTUD
  1. N ACKSC,ACKAO,ACKIR,ACKEC,ACKREC,ACKPRV,ACKTYP,ACKCPT,ACKQTY,ACKVTME
  1. N ACKDPRIM,ACKQPRV,ACKPRVCK
  1. K ^TMP("ACKQASU4",$J,"COPYPCE") ; initialise return array
  1. S ACKERR=0 ; error counter
  1. ;
  1. ; get the PCE Visit data - returned in ^TMP("PXKENC",$J,pce ien,...)
  1. D ENCEVENT^PXAPI(ACKPCENO,"")
  1. ;
  1. ; Get Diagnostic codes
  1. S ACKI="",ACKDPRIM=""
  1. F S ACKI=$O(^TMP("PXKENC",$J,ACKPCENO,"POV",ACKI)) Q:ACKI="" D
  1. . S ACKICD=$P($G(^TMP("PXKENC",$J,ACKPCENO,"POV",ACKI,0)),U,1) ; icd ien
  1. . I ACKDPRIM="",$P($G(^TMP("PXKENC",$J,ACKPCENO,"POV",ACKI,0)),U,12)="P" S ACKDPRIM=1
  1. . ; add to visit
  1. . S ACKE=$$SETDIAG^ACKQASU5(ACKVIEN,ACKICD,ACKDPRIM)
  1. . I ACKDPRIM S ACKDPRIM="0"
  1. . ; if error returned then file
  1. . I 'ACKE D Q
  1. . . ;ACKQ*3.0*22 updated api
  1. . . S ACKTMP="Diagnosis"_U_ACKICD_U_$$CODEC^ICDEX(80,ACKICD)_U_$P(ACKE,U,2)
  1. . . D ADDERR
  1. . ; if successful then ensure Diagnosis is added to Patient Diagnostic history
  1. . D DIAGHIST
  1. ;
  1. ; get all the providers and file
  1. S ACKI="",ACKPRIM="",ACKSTUD=""
  1. F S ACKI=$O(^TMP("PXKENC",$J,ACKPCENO,"PRV",ACKI)) Q:ACKI="" D
  1. . S ACKREC=$G(^TMP("PXKENC",$J,ACKPCENO,"PRV",ACKI,0))
  1. . S ACKPRV=$P(ACKREC,U,1) ; provider ien
  1. . S ACKTYP=$P(ACKREC,U,4) ; primary/secondary
  1. . I ACKTYP="P" D COPYPRIM Q ; copy primary provider
  1. . I ACKTYP="S" D COPYSCND Q ; copy secondary provider
  1. ;
  1. ; Get procedure codes
  1. S ACKI=""
  1. F S ACKI=$O(^TMP("PXKENC",$J,ACKPCENO,"CPT",ACKI)) Q:ACKI="" D
  1. . S ACKREC=$G(^TMP("PXKENC",$J,ACKPCENO,"CPT",ACKI,0))
  1. . S ACKCPT=$P(ACKREC,U,1),ACKQTY=$P(ACKREC,U,16) ; unpack cpt and volume
  1. . ; Get Procedure Provider
  1. . S ACKPRV=$P($G(^TMP("PXKENC",$J,ACKPCENO,"CPT",ACKI,12)),U,4)
  1. . S ACKQPRV=$$PROVCHK(ACKPRV)
  1. . I ACKPRV'="" D
  1. . . S ACKPRVCK=$$STACT^ACKQUTL(ACKQPRV,ACKVD)
  1. . . I ACKPRVCK'="0",ACKPRVCK'="-6" D
  1. . . . S ACKTMP="Provider"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. . . . S ACKTMP=ACKTMP_"Invalid Procedure Provider"
  1. . . . D ADDERR
  1. . . . S ACKQPRV=""
  1. . ; add to visit
  1. . S ACKE=$$SETPROC^ACKQASU5(ACKVIEN,ACKCPT,ACKQTY,ACKQPRV)
  1. . ; if error returned then file
  1. . I 'ACKE D Q
  1. . . ;ACKQ*3.0*22 updated api
  1. . . S ACKTMP="Procedure"_U_ACKCPT_U_$P($$CPT^ICPTCOD(ACKCPT),U,2)_U_$P(ACKE,U,2)
  1. . . D ADDERR
  1. . ; if successful then do the modifiers for this procedure
  1. . S ACKM=0,ACKPIEN=+ACKE ; ACKPIEN=procedure ien from visit file
  1. . F S ACKM=$O(^TMP("PXKENC",$J,ACKPCENO,"CPT",ACKI,1,ACKM)) Q:'ACKM D
  1. . . S ACKMOD=$P($G(^TMP("PXKENC",$J,ACKPCENO,"CPT",ACKI,1,ACKM,0)),U,1)
  1. . . ; add to visit
  1. . . S ACKE=$$SETMDFR^ACKQASU5(ACKVIEN,ACKPIEN,ACKMOD)
  1. . . ; if error returned then file
  1. . . I '+ACKE D Q
  1. . . . ;ACKQ*3.0*22 updated api
  1. . . . S ACKTMP="Modifier"_U_ACKMOD_U_$P($$MOD^ICPTMOD(ACKMOD,"I"),U,2)_U_$P(ACKE,U,2)
  1. . . . D ADDERR
  1. ;
  1. ; now file header items
  1. K ACKARR,ACKPRV
  1. ;
  1. ; If PCE visit has an eligibility write to a&sp visit file
  1. S ACKVELG=$P($G(^TMP("PXKENC",$J,ACKPCENO,"VST",ACKPCENO,0)),U,21)
  1. I ACKVELG'="" S ACKARR(509850.6,ACKVIEN_",",80)=ACKVELG
  1. ;
  1. ; Get service connected,Agent Orange,Radiation and Environmental
  1. ; Contaminents from PCE file and set them to the Visit file.
  1. S ACKREC=$G(^TMP("PXKENC",$J,ACKPCENO,"VST",ACKPCENO,800))
  1. S ACKSC=$P(ACKREC,U,1) ; service connected
  1. S ACKAO=$P(ACKREC,U,2) ; agent orange
  1. S ACKIR=$P(ACKREC,U,3) ; ionizing radiation
  1. S ACKEC=$P(ACKREC,U,4) ; environmental contaminants
  1. S ACKARR(509850.6,ACKVIEN_",",20)=$S(+ACKSC:1,ACKSC=0:0,1:"")
  1. S ACKARR(509850.6,ACKVIEN_",",25)=$S(+ACKAO:1,ACKAO=0:0,1:"")
  1. S ACKARR(509850.6,ACKVIEN_",",30)=$S(+ACKIR:1,ACKIR=0:0,1:"")
  1. S ACKARR(509850.6,ACKVIEN_",",35)=$S(+ACKEC:1,ACKEC=0:0,1:"")
  1. ;
  1. ; Update QUASAR visit record
  1. D FILE^DIE("","ACKARR")
  1. K ACKARR
  1. ;
  1. COPYPCEX ; Exit point
  1. K ^TMP("PXKENC",$J) ; Clear PCE data
  1. I ACKERR S ^TMP("ACKQASU4",$J,"COPYPCE","ERROR")=ACKERR ; final error count
  1. Q ACKERR_U ; return error count
  1. ;
  1. ;
  1. COPYPRIM ; Copy the primary provider to QUASAR
  1. ;
  1. ; If we haven't successfully filed a primary then attempt to
  1. I ACKPRIM="" D Q ;
  1. . S ACKQPRV=$$PROVCHK(ACKPRV)
  1. . S ACKE=$$SETPRIM^ACKQASU6(ACKVIEN,ACKQPRV) ; Attempt to add to visit
  1. . I +ACKE S ACKPRIM=ACKQPRV ; Record that we now have a primary
  1. . I '+ACKE D ; error occurred
  1. . . S ACKTMP="Provider"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. . . S ACKTMP=ACKTMP_$P(ACKE,U,2)
  1. . . D ADDERR
  1. ;
  1. ; if we already have a primary then add an error message
  1. S ACKTMP="Provider"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. S ACKTMP=ACKTMP_"Visit already has a Primary Provider"
  1. D ADDERR
  1. ;
  1. ; return to provider loop
  1. Q
  1. ;
  1. COPYSCND ; copy a secondary provider to QUASAR
  1. ;
  1. ; determine the Quasar classification for this provider
  1. S ACKQPRV=$$PROVCHK(ACKPRV)
  1. S ACKTYPQ=$$GET1^DIQ(509850.3,$S(ACKQPRV="":" ",1:ACKQPRV)_",",.02,"I")
  1. ;
  1. ; if they are a student and we haven't one already,
  1. ; then attempt to file as student
  1. I ACKTYPQ="S",ACKSTUD="" D Q ; student
  1. . S ACKE=$$SETSTUD^ACKQASU6(ACKVIEN,ACKQPRV)
  1. . I +ACKE S ACKSTUD=ACKQPRV Q ; record that we now have a student
  1. . I '+ACKE D ; Error occurred
  1. . . S ACKTMP="Student"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. . . S ACKTMP=ACKTMP_$P(ACKE,U,2)
  1. . . D ADDERR
  1. ;
  1. ; if they are a student and we already have one then set error
  1. I ACKTYPQ="S",ACKSTUD'="" D Q
  1. . S ACKTMP="Student"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. . S ACKTMP=ACKTMP_"Visit already has a Student"
  1. . D ADDERR
  1. ;
  1. ; if they are a regular provider, and we do not already have
  1. ; a secondary provider then attempt to file
  1. I (ACKTYPQ="C")!(ACKTYPQ="F")!(ACKTYPQ="O") D Q
  1. . S ACKE=$$SETSCND^ACKQASU6(ACKVIEN,ACKQPRV) ; attempt to add to visit
  1. . I +ACKE Q ; All okay
  1. . I '+ACKE D ; Error occurred
  1. . . S ACKTMP="Provider"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. . . S ACKTMP=ACKTMP_$P(ACKE,U,2)
  1. . . D ADDERR
  1. ;
  1. ; if we get this far then provider must be unknown to Quasar
  1. S ACKTMP="Provider"_U_ACKPRV_U_$$GET1^DIQ(200,ACKPRV_",",.01,"E")_U
  1. S ACKTMP=ACKTMP_"Provider not defined for Audiology and Speech Pathology"
  1. D ADDERR
  1. ;
  1. ; end of checking a secondary provider
  1. Q
  1. ;
  1. ADDERR ; add an error to return array in ^TMP
  1. ; ACKERR is current error count, ACKTMP is the error detail
  1. S ACKERR=ACKERR+1
  1. S ^TMP("ACKQASU4",$J,"COPYPCE","ERROR",ACKERR)=ACKTMP
  1. Q
  1. ;
  1. DIAGHIST ; ensure diagnosis is on Patient history
  1. ; this s/r checks for ACKICD (diagnosis ien) on the patient history
  1. ; of patient ACKPAT
  1. ; if the ICD is not found a new entry is automatically added using the
  1. ; visit date in ACKVD
  1. N ACKTGT
  1. ;
  1. ; look for the diagnosis on the current history
  1. D FIND^DIC(509850.22,","_ACKPAT_",","","Q",ACKICD,1,"B","","","ACKTGT")
  1. ;
  1. ; if found then exit
  1. I +$P($G(ACKTGT("DILIST",0)),U,1)=1 Q ; exactly one found
  1. ;
  1. ; create a new entry
  1. S ACKUPD(509850.22,"+1,"_ACKPAT_",",.01)=ACKICD
  1. S ACKUPD(509850.22,"+1,"_ACKPAT_",",1)=ACKVD
  1. D UPDATE^DIE("","ACKUPD","","")
  1. ;
  1. ; end
  1. Q
  1. ;
  1. PROVCHK(ACKPRV) ; Check to see if Provider is on Quasar Staff file - if so
  1. ; function passes back Quasars Provider IEN No else null
  1. ;
  1. N ACKA,ACKB,NPNAME S ACKB=""
  1. I ACKPRV="" Q ACKB
  1. ;ACKQ*3*17
  1. S NPNAME=$$GET1^DIQ(200,ACKPRV,.01,"")
  1. I '$D(^ACK(509850.3,"B",NPNAME)) Q ACKB
  1. Q $O(^ACK(509850.3,"B",NPNAME,ACKB))
  1. ;