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

ACKQUTL8.m

Go to the documentation of this file.
  1. ACKQUTL8 ;HCIOFO/AG - QUASAR Utility Routine ;30 Jan 2013 3:16 PM
  1. ;;3.0;QUASAR;**1,2,8,21**;Feb 11, 2000;Build 40
  1. ;
  1. ; Reference/IA
  1. ; $$CSI^ICDEX - 5747
  1. ; $$CODEC^ICDEX - 5747
  1. ;
  1. CHKVST(ACKVIEN,ACKARR,ACKFULL) ; check a visit for missing fields
  1. ; this function will validate a visit to determine if there are any
  1. ; missing required fields.
  1. ; required inputs: ACKVIEN - visit ien number
  1. ; ACKARR - array to hold errors (must be passed by ref ie ".ACKARR")
  1. ; ACKFULL - if true, the visit will be checked in full and may
  1. ; return type 0 errors, and type 1 and type 2. if false, the
  1. ; function will only look for type 1s if there are no type 0s etc.
  1. ; output:
  1. ; ACKARR=typ - type of error found
  1. ; -1 = Error - unable to process visit
  1. ; 0 = visit does not have minimum data required
  1. ; for Quasar
  1. ; 1 = visit has minimum for Quasar but some additional
  1. ; required fields are missing
  1. ; 2 = all Quasar required fields are present but one
  1. ; or more PCE fields are missing (ie will not be
  1. ; accepted by PCE if the interface is on).
  1. ; 3 = everything ok
  1. ; ACKARR(typ)=num - number of fields in error
  1. ; ACKARR(typ,1-num)=field - free text name of field
  1. ; example:
  1. ; ACKARR=0 - visit does not have minimum reqd by Quasar
  1. ; and ACKARR(0)=2,ACKARR(0,1)="Clinic",ACKARR(0,2)="Patient"
  1. ; this visit does not have a clinic or a patient
  1. ;
  1. N ACKDATA
  1. S ACKFULL=+$G(ACKFULL)
  1. K ACKARR S ACKARR=3
  1. ;
  1. ; if visit number not passed in then exit
  1. I +$G(ACKVIEN)=0 S ACKARR=-1 G CHKVSTX
  1. ;
  1. ; get quasar minimum fields for the visit (level 0)
  1. GET0 D GETS^DIQ(509850.6,ACKVIEN_",",".01;1;2.6;5;60","I","ACKDATA")
  1. ;
  1. ; if nothing returned by fileman then exit
  1. I '$D(ACKDATA(509850.6,ACKVIEN_",")) S ACKARR=-1 G CHKVSTX
  1. ;
  1. ; check visit date
  1. CHK0 I $G(ACKDATA(509850.6,ACKVIEN_",",.01,"I"))'?7N D
  1. . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
  1. . S ACKARR(0,ACKARR(0))="Visit Date"
  1. ; check Patient
  1. ; I $G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))'?1.N D
  1. ; . ; S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
  1. ; . ; S ACKARR(0,ACKARR(0))="Patient"
  1. ; check Clinic
  1. I $G(ACKDATA(509850.6,ACKVIEN_",",2.6,"I"))'?1.N D
  1. . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
  1. . S ACKARR(0,ACKARR(0))="Clinic"
  1. ; check CDR Account
  1. I $G(ACKDATA(509850.6,ACKVIEN_",",5,"I"))'?1.N D
  1. . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
  1. . S ACKARR(0,ACKARR(0))="CDR Account"
  1. ; check Division
  1. I $G(ACKDATA(509850.6,ACKVIEN_",",60,"I"))'?1.N D
  1. . S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
  1. . S ACKARR(0,ACKARR(0))="Division"
  1. ;
  1. END0 ; if errors found and we're not doing a full check then exit
  1. I ACKARR<3,'ACKFULL G CHKVSTX
  1. ;
  1. GET1 ; get data for level 1 check
  1. K ACKDATA
  1. D GETS^DIQ(509850.6,ACKVIEN_",","55;6;7;.09;4.01;.07","I","ACKDATA")
  1. ;
  1. ; check Appointment Time
  1. CHK1 I $G(ACKDATA(509850.6,ACKVIEN_",",55,"I"))'?1"."1.N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Appointment Time"
  1. ;
  1. ; check Primary Provider
  1. N ACKPRV
  1. S ACKPRV=$G(ACKDATA(509850.6,ACKVIEN_",",6,"I")) ; prim
  1. I ACKPRV'?1.N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=+$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Provider"
  1. ;
  1. ; check procedure
  1. I 'ACKEVENT D
  1. . N ACKCPT
  1. . N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,3,0)),ACKCPT=""
  1. . I ACKP S ACKCPT=$P($G(^ACK(509850.6,ACKVIEN,3,ACKP,0)),U,1)
  1. . I ACKCPT'?1N.N D
  1. . . S:ACKARR>1 ACKARR=1
  1. . . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="CPT Procedure"
  1. . K ACKCPT
  1. ;
  1. I ACKEVENT D
  1. . N ACKEV S ACKEV=""
  1. . N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,7,0)),ACKEV=""
  1. . I ACKP S ACKEV=$P($G(^ACK(509850.6,ACKVIEN,7,ACKP,0)),U,1)
  1. . I ACKEV="" D
  1. . . S:ACKARR>1 ACKARR=1
  1. . . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Event Capture Procedure"
  1. . K ACKEV
  1. ;
  1. ; check Diagnosis
  1. N ACKICD,ACKFROM
  1. ; D LIST^DIC(509850.63,","_ACKVIEN_",","","",1,.ACKFROM,"","","","","ACKICD")
  1. ; I $P($G(ACKICD("DILIST",0)),U,1)'=1 D ; LIST call removed - too slow!
  1. N ACKD S ACKD=$O(^ACK(509850.6,ACKVIEN,1,0)),ACKICD=""
  1. I ACKD S ACKICD=$P($G(^ACK(509850.6,ACKVIEN,1,ACKD,0)),U,1)
  1. I ACKICD'?1N.N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Diagnosis"
  1. ; check to see that a diagnosis has been allocated as the Primary
  1. I '$$PRIMARY^ACKQASU5(ACKVIEN,"") D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Diagnosis"
  1. K ACKICD
  1. ;
  1. ; check C and P status (CHECK FOR OPEN REQUEST?)
  1. N ACKCP
  1. S ACKCP=$G(ACKDATA(509850.6,ACKVIEN_",",.09,"I"))
  1. I ACKCP'="",ACKCP'?1N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="C and P Status"
  1. ;
  1. ; check first audiometric field
  1. I ACKCP,$G(ACKDATA(509850.6,ACKVIEN_",",4.01,"I"))'?1.N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Audiometric Data"
  1. ;
  1. ; check Time Spent
  1. I $G(ACKDATA(509850.6,ACKVIEN_",",.07,"I"))'?1N.N D
  1. . S:ACKARR>1 ACKARR=1
  1. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Time Spent"
  1. ;
  1. END1 ; if errors found and we're not doing a full check then exit
  1. I ACKARR<3,'ACKFULL G CHKVSTX
  1. ;
  1. ; get data for level 2
  1. GET2 K ACKDATA
  1. D GETS^DIQ(509850.6,ACKVIEN_",","1;80;20;25;30;35","I","ACKDATA")
  1. ;
  1. ; check visit eligibility
  1. CHK2 I $G(ACKDATA(509850.6,ACKVIEN_",",80,"I"))'?1.N D
  1. . S:ACKARR>2 ACKARR=2
  1. . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Visit Eligibility"
  1. ;
  1. ; get service connected data
  1. N DFN,VAEL,VASV,ACKSC,ACKSCV,ACKAO,ACKIR,ACKENV,ACKEC
  1. S DFN=$G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))
  1. S (ACKSC,ACKAO,ACKIR,ACKEC)=0
  1. I DFN?1.N D ELIG^VADPT,SVC^VADPT D
  1. . S ACKSC=$S(+VAEL(3)=1:1,1:0) ; patient service connected
  1. . S ACKAO=$S(+VASV(2)=1:1,1:0) ; patient agent orange
  1. . S ACKIR=$S(+VASV(3)=1:1,1:0) ; patient radiation
  1. . S ACKEC=$S($$GET1^DIQ(2,DFN_",",.322013,"I")="Y":1,1:0) ; pat env cont
  1. S ACKSCV=$G(ACKDATA(509850.6,ACKVIEN_",",20,"I")) ; serv conn visit
  1. ;
  1. ; check service connected status
  1. I ACKSC=1,ACKSCV'?1N D
  1. . S:ACKARR>2 ACKARR=2
  1. . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Service Connected"
  1. ;
  1. ; check Agent Orange
  1. I ACKSCV'=1,ACKAO,$G(ACKDATA(509850.6,ACKVIEN_",",25,"I"))'?1N D
  1. . S:ACKARR>2 ACKARR=2
  1. . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Agent Orange"
  1. ;
  1. ; check Radiation
  1. I ACKSCV'=1,ACKIR,$G(ACKDATA(509850.6,ACKVIEN_",",30,"I"))'?1N D
  1. . S:ACKARR>2 ACKARR=2
  1. . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Ionizing Radiation"
  1. ;
  1. ; check Environmental contaminants
  1. I ACKSCV'=1,ACKEC,$G(ACKDATA(509850.6,ACKVIEN_",",35,"I"))'?1N D
  1. . S:ACKARR>2 ACKARR=2
  1. . S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Environmental Contaminants"
  1. ;
  1. ;
  1. CHKVSTX ; that'll do
  1. Q
  1. ;
  1. ;
  1. DIAGTXT(ACKQDCDS,ACKCVD) ; Get Short ICD Description
  1. N DIAGTXT
  1. I $G(ACKCVD)="" S ACKCVD=$$DATE
  1. S ACKICD=$$CSI^ICDEX(80,ACKQDCDS)
  1. S DIAGTXT=$$ICDDATA^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,"I")
  1. S DIAGTXT=$P(DIAGTXT,"^",4)
  1. Q DIAGTXT
  1. ;
  1. LDIAGTXT(ACKQDCDS,ACKCVD,ACKICD) ; Get Long ICD Description
  1. N LDIAGTXT,LST,RET,OUTARR
  1. S ACKQDCDS=$$CONV(ACKQDCDS)
  1. I $G(ACKCVD)="" S ACKCVD=$$DATE
  1. S RET=$$ICDDESC^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,.OUTARR)
  1. I $P(RET,"^",1)="-1" S LDIAGTXT=$P(RET,"^",2)
  1. I $P(RET,"^",1)'="-1" S LDIAGTXT=OUTARR(1)
  1. Q LDIAGTXT
  1. ;
  1. PROCTXT(ACKQDCDS,ACKCVD) ; Get Short CPT Description
  1. N PROCTXT
  1. I $G(ACKCVD)="" S ACKCVD=$$DATE
  1. S PROCTXT=$$CPT^ICPTCOD(ACKQDCDS,ACKCVD)
  1. S PROCTXT=$P(PROCTXT,"^",3)
  1. Q PROCTXT
  1. ;
  1. MODTXT(ACKQMCDS,ACKCVD) ; Get Short CPT Modifier Description
  1. N MODTXT
  1. I $G(ACKCVD)="" S ACKCVD=$$DATE
  1. S MODTXT=$$MOD^ICPTMOD(ACKQMCDS,"I",ACKCVD)
  1. S MODTXT=$P(MODTXT,"^",3)
  1. Q MODTXT
  1. ;
  1. CONV(ACKQDCDS) ;
  1. N CODE
  1. S CODE=$$CODEC^ICDEX(80,ACKQDCDS)
  1. Q CODE
  1. ;
  1. DATE() ;
  1. N %
  1. D NOW^%DTC
  1. Q $P(%,".",1)
  1. ;
  1. ;