ACKQUTL8 ;HCIOFO/AG - QUASAR Utility Routine ;30 Jan 2013 3:16 PM
;;3.0;QUASAR;**1,2,8,21**;Feb 11, 2000;Build 40
;
; Reference/IA
; $$CSI^ICDEX - 5747
; $$CODEC^ICDEX - 5747
;
CHKVST(ACKVIEN,ACKARR,ACKFULL) ; check a visit for missing fields
; this function will validate a visit to determine if there are any
; missing required fields.
; required inputs: ACKVIEN - visit ien number
; ACKARR - array to hold errors (must be passed by ref ie ".ACKARR")
; ACKFULL - if true, the visit will be checked in full and may
; return type 0 errors, and type 1 and type 2. if false, the
; function will only look for type 1s if there are no type 0s etc.
; output:
; ACKARR=typ - type of error found
; -1 = Error - unable to process visit
; 0 = visit does not have minimum data required
; for Quasar
; 1 = visit has minimum for Quasar but some additional
; required fields are missing
; 2 = all Quasar required fields are present but one
; or more PCE fields are missing (ie will not be
; accepted by PCE if the interface is on).
; 3 = everything ok
; ACKARR(typ)=num - number of fields in error
; ACKARR(typ,1-num)=field - free text name of field
; example:
; ACKARR=0 - visit does not have minimum reqd by Quasar
; and ACKARR(0)=2,ACKARR(0,1)="Clinic",ACKARR(0,2)="Patient"
; this visit does not have a clinic or a patient
;
N ACKDATA
S ACKFULL=+$G(ACKFULL)
K ACKARR S ACKARR=3
;
; if visit number not passed in then exit
I +$G(ACKVIEN)=0 S ACKARR=-1 G CHKVSTX
;
; get quasar minimum fields for the visit (level 0)
GET0 D GETS^DIQ(509850.6,ACKVIEN_",",".01;1;2.6;5;60","I","ACKDATA")
;
; if nothing returned by fileman then exit
I '$D(ACKDATA(509850.6,ACKVIEN_",")) S ACKARR=-1 G CHKVSTX
;
; check visit date
CHK0 I $G(ACKDATA(509850.6,ACKVIEN_",",.01,"I"))'?7N D
. S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
. S ACKARR(0,ACKARR(0))="Visit Date"
; check Patient
; I $G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))'?1.N D
; . ; S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
; . ; S ACKARR(0,ACKARR(0))="Patient"
; check Clinic
I $G(ACKDATA(509850.6,ACKVIEN_",",2.6,"I"))'?1.N D
. S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
. S ACKARR(0,ACKARR(0))="Clinic"
; check CDR Account
I $G(ACKDATA(509850.6,ACKVIEN_",",5,"I"))'?1.N D
. S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
. S ACKARR(0,ACKARR(0))="CDR Account"
; check Division
I $G(ACKDATA(509850.6,ACKVIEN_",",60,"I"))'?1.N D
. S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
. S ACKARR(0,ACKARR(0))="Division"
;
END0 ; if errors found and we're not doing a full check then exit
I ACKARR<3,'ACKFULL G CHKVSTX
;
GET1 ; get data for level 1 check
K ACKDATA
D GETS^DIQ(509850.6,ACKVIEN_",","55;6;7;.09;4.01;.07","I","ACKDATA")
;
; check Appointment Time
CHK1 I $G(ACKDATA(509850.6,ACKVIEN_",",55,"I"))'?1"."1.N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Appointment Time"
;
; check Primary Provider
N ACKPRV
S ACKPRV=$G(ACKDATA(509850.6,ACKVIEN_",",6,"I")) ; prim
I ACKPRV'?1.N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=+$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Provider"
;
; check procedure
I 'ACKEVENT D
. N ACKCPT
. N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,3,0)),ACKCPT=""
. I ACKP S ACKCPT=$P($G(^ACK(509850.6,ACKVIEN,3,ACKP,0)),U,1)
. I ACKCPT'?1N.N D
. . S:ACKARR>1 ACKARR=1
. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="CPT Procedure"
. K ACKCPT
;
I ACKEVENT D
. N ACKEV S ACKEV=""
. N ACKP S ACKP=$O(^ACK(509850.6,ACKVIEN,7,0)),ACKEV=""
. I ACKP S ACKEV=$P($G(^ACK(509850.6,ACKVIEN,7,ACKP,0)),U,1)
. I ACKEV="" D
. . S:ACKARR>1 ACKARR=1
. . S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Event Capture Procedure"
. K ACKEV
;
; check Diagnosis
N ACKICD,ACKFROM
; D LIST^DIC(509850.63,","_ACKVIEN_",","","",1,.ACKFROM,"","","","","ACKICD")
; I $P($G(ACKICD("DILIST",0)),U,1)'=1 D ; LIST call removed - too slow!
N ACKD S ACKD=$O(^ACK(509850.6,ACKVIEN,1,0)),ACKICD=""
I ACKD S ACKICD=$P($G(^ACK(509850.6,ACKVIEN,1,ACKD,0)),U,1)
I ACKICD'?1N.N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Diagnosis"
; check to see that a diagnosis has been allocated as the Primary
I '$$PRIMARY^ACKQASU5(ACKVIEN,"") D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Primary Diagnosis"
K ACKICD
;
; check C and P status (CHECK FOR OPEN REQUEST?)
N ACKCP
S ACKCP=$G(ACKDATA(509850.6,ACKVIEN_",",.09,"I"))
I ACKCP'="",ACKCP'?1N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="C and P Status"
;
; check first audiometric field
I ACKCP,$G(ACKDATA(509850.6,ACKVIEN_",",4.01,"I"))'?1.N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Audiometric Data"
;
; check Time Spent
I $G(ACKDATA(509850.6,ACKVIEN_",",.07,"I"))'?1N.N D
. S:ACKARR>1 ACKARR=1
. S ACKARR(1)=$G(ACKARR(1))+1,ACKARR(1,ACKARR(1))="Time Spent"
;
END1 ; if errors found and we're not doing a full check then exit
I ACKARR<3,'ACKFULL G CHKVSTX
;
; get data for level 2
GET2 K ACKDATA
D GETS^DIQ(509850.6,ACKVIEN_",","1;80;20;25;30;35","I","ACKDATA")
;
; check visit eligibility
CHK2 I $G(ACKDATA(509850.6,ACKVIEN_",",80,"I"))'?1.N D
. S:ACKARR>2 ACKARR=2
. S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Visit Eligibility"
;
; get service connected data
N DFN,VAEL,VASV,ACKSC,ACKSCV,ACKAO,ACKIR,ACKENV,ACKEC
S DFN=$G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))
S (ACKSC,ACKAO,ACKIR,ACKEC)=0
I DFN?1.N D ELIG^VADPT,SVC^VADPT D
. S ACKSC=$S(+VAEL(3)=1:1,1:0) ; patient service connected
. S ACKAO=$S(+VASV(2)=1:1,1:0) ; patient agent orange
. S ACKIR=$S(+VASV(3)=1:1,1:0) ; patient radiation
. S ACKEC=$S($$GET1^DIQ(2,DFN_",",.322013,"I")="Y":1,1:0) ; pat env cont
S ACKSCV=$G(ACKDATA(509850.6,ACKVIEN_",",20,"I")) ; serv conn visit
;
; check service connected status
I ACKSC=1,ACKSCV'?1N D
. S:ACKARR>2 ACKARR=2
. S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Service Connected"
;
; check Agent Orange
I ACKSCV'=1,ACKAO,$G(ACKDATA(509850.6,ACKVIEN_",",25,"I"))'?1N D
. S:ACKARR>2 ACKARR=2
. S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Agent Orange"
;
; check Radiation
I ACKSCV'=1,ACKIR,$G(ACKDATA(509850.6,ACKVIEN_",",30,"I"))'?1N D
. S:ACKARR>2 ACKARR=2
. S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Ionizing Radiation"
;
; check Environmental contaminants
I ACKSCV'=1,ACKEC,$G(ACKDATA(509850.6,ACKVIEN_",",35,"I"))'?1N D
. S:ACKARR>2 ACKARR=2
. S ACKARR(2)=$G(ACKARR(2))+1,ACKARR(2,ACKARR(2))="Environmental Contaminants"
;
;
CHKVSTX ; that'll do
Q
;
;
DIAGTXT(ACKQDCDS,ACKCVD) ; Get Short ICD Description
N DIAGTXT
I $G(ACKCVD)="" S ACKCVD=$$DATE
S ACKICD=$$CSI^ICDEX(80,ACKQDCDS)
S DIAGTXT=$$ICDDATA^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,"I")
S DIAGTXT=$P(DIAGTXT,"^",4)
Q DIAGTXT
;
LDIAGTXT(ACKQDCDS,ACKCVD,ACKICD) ; Get Long ICD Description
N LDIAGTXT,LST,RET,OUTARR
S ACKQDCDS=$$CONV(ACKQDCDS)
I $G(ACKCVD)="" S ACKCVD=$$DATE
S RET=$$ICDDESC^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,.OUTARR)
I $P(RET,"^",1)="-1" S LDIAGTXT=$P(RET,"^",2)
I $P(RET,"^",1)'="-1" S LDIAGTXT=OUTARR(1)
Q LDIAGTXT
;
PROCTXT(ACKQDCDS,ACKCVD) ; Get Short CPT Description
N PROCTXT
I $G(ACKCVD)="" S ACKCVD=$$DATE
S PROCTXT=$$CPT^ICPTCOD(ACKQDCDS,ACKCVD)
S PROCTXT=$P(PROCTXT,"^",3)
Q PROCTXT
;
MODTXT(ACKQMCDS,ACKCVD) ; Get Short CPT Modifier Description
N MODTXT
I $G(ACKCVD)="" S ACKCVD=$$DATE
S MODTXT=$$MOD^ICPTMOD(ACKQMCDS,"I",ACKCVD)
S MODTXT=$P(MODTXT,"^",3)
Q MODTXT
;
CONV(ACKQDCDS) ;
N CODE
S CODE=$$CODEC^ICDEX(80,ACKQDCDS)
Q CODE
;
DATE() ;
N %
D NOW^%DTC
Q $P(%,".",1)
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQUTL8 8008 printed Dec 13, 2024@02:32:57 Page 2
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
+2 ;
+3 ; Reference/IA
+4 ; $$CSI^ICDEX - 5747
+5 ; $$CODEC^ICDEX - 5747
+6 ;
CHKVST(ACKVIEN,ACKARR,ACKFULL) ; check a visit for missing fields
+1 ; this function will validate a visit to determine if there are any
+2 ; missing required fields.
+3 ; required inputs: ACKVIEN - visit ien number
+4 ; ACKARR - array to hold errors (must be passed by ref ie ".ACKARR")
+5 ; ACKFULL - if true, the visit will be checked in full and may
+6 ; return type 0 errors, and type 1 and type 2. if false, the
+7 ; function will only look for type 1s if there are no type 0s etc.
+8 ; output:
+9 ; ACKARR=typ - type of error found
+10 ; -1 = Error - unable to process visit
+11 ; 0 = visit does not have minimum data required
+12 ; for Quasar
+13 ; 1 = visit has minimum for Quasar but some additional
+14 ; required fields are missing
+15 ; 2 = all Quasar required fields are present but one
+16 ; or more PCE fields are missing (ie will not be
+17 ; accepted by PCE if the interface is on).
+18 ; 3 = everything ok
+19 ; ACKARR(typ)=num - number of fields in error
+20 ; ACKARR(typ,1-num)=field - free text name of field
+21 ; example:
+22 ; ACKARR=0 - visit does not have minimum reqd by Quasar
+23 ; and ACKARR(0)=2,ACKARR(0,1)="Clinic",ACKARR(0,2)="Patient"
+24 ; this visit does not have a clinic or a patient
+25 ;
+26 NEW ACKDATA
+27 SET ACKFULL=+$GET(ACKFULL)
+28 KILL ACKARR
SET ACKARR=3
+29 ;
+30 ; if visit number not passed in then exit
+31 IF +$GET(ACKVIEN)=0
SET ACKARR=-1
GOTO CHKVSTX
+32 ;
+33 ; get quasar minimum fields for the visit (level 0)
GET0 DO GETS^DIQ(509850.6,ACKVIEN_",",".01;1;2.6;5;60","I","ACKDATA")
+1 ;
+2 ; if nothing returned by fileman then exit
+3 IF '$DATA(ACKDATA(509850.6,ACKVIEN_","))
SET ACKARR=-1
GOTO CHKVSTX
+4 ;
+5 ; check visit date
CHK0 IF $GET(ACKDATA(509850.6,ACKVIEN_",",.01,"I"))'?7N
Begin DoDot:1
+1 SET ACKARR=0
SET ACKARR(0)=+$GET(ACKARR(0))+1
+2 SET ACKARR(0,ACKARR(0))="Visit Date"
End DoDot:1
+3 ; check Patient
+4 ; I $G(ACKDATA(509850.6,ACKVIEN_",",1,"I"))'?1.N D
+5 ; . ; S ACKARR=0,ACKARR(0)=+$G(ACKARR(0))+1
+6 ; . ; S ACKARR(0,ACKARR(0))="Patient"
+7 ; check Clinic
+8 IF $GET(ACKDATA(509850.6,ACKVIEN_",",2.6,"I"))'?1.N
Begin DoDot:1
+9 SET ACKARR=0
SET ACKARR(0)=+$GET(ACKARR(0))+1
+10 SET ACKARR(0,ACKARR(0))="Clinic"
End DoDot:1
+11 ; check CDR Account
+12 IF $GET(ACKDATA(509850.6,ACKVIEN_",",5,"I"))'?1.N
Begin DoDot:1
+13 SET ACKARR=0
SET ACKARR(0)=+$GET(ACKARR(0))+1
+14 SET ACKARR(0,ACKARR(0))="CDR Account"
End DoDot:1
+15 ; check Division
+16 IF $GET(ACKDATA(509850.6,ACKVIEN_",",60,"I"))'?1.N
Begin DoDot:1
+17 SET ACKARR=0
SET ACKARR(0)=+$GET(ACKARR(0))+1
+18 SET ACKARR(0,ACKARR(0))="Division"
End DoDot:1
+19 ;
END0 ; if errors found and we're not doing a full check then exit
+1 IF ACKARR<3
IF 'ACKFULL
GOTO CHKVSTX
+2 ;
GET1 ; get data for level 1 check
+1 KILL ACKDATA
+2 DO GETS^DIQ(509850.6,ACKVIEN_",","55;6;7;.09;4.01;.07","I","ACKDATA")
+3 ;
+4 ; check Appointment Time
CHK1 IF $GET(ACKDATA(509850.6,ACKVIEN_",",55,"I"))'?1"."1.N
Begin DoDot:1
+1 if ACKARR>1
SET ACKARR=1
+2 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Appointment Time"
End DoDot:1
+3 ;
+4 ; check Primary Provider
+5 NEW ACKPRV
+6 ; prim
SET ACKPRV=$GET(ACKDATA(509850.6,ACKVIEN_",",6,"I"))
+7 IF ACKPRV'?1.N
Begin DoDot:1
+8 if ACKARR>1
SET ACKARR=1
+9 SET ACKARR(1)=+$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Primary Provider"
End DoDot:1
+10 ;
+11 ; check procedure
+12 IF 'ACKEVENT
Begin DoDot:1
+13 NEW ACKCPT
+14 NEW ACKP
SET ACKP=$ORDER(^ACK(509850.6,ACKVIEN,3,0))
SET ACKCPT=""
+15 IF ACKP
SET ACKCPT=$PIECE($GET(^ACK(509850.6,ACKVIEN,3,ACKP,0)),U,1)
+16 IF ACKCPT'?1N.N
Begin DoDot:2
+17 if ACKARR>1
SET ACKARR=1
+18 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="CPT Procedure"
End DoDot:2
+19 KILL ACKCPT
End DoDot:1
+20 ;
+21 IF ACKEVENT
Begin DoDot:1
+22 NEW ACKEV
SET ACKEV=""
+23 NEW ACKP
SET ACKP=$ORDER(^ACK(509850.6,ACKVIEN,7,0))
SET ACKEV=""
+24 IF ACKP
SET ACKEV=$PIECE($GET(^ACK(509850.6,ACKVIEN,7,ACKP,0)),U,1)
+25 IF ACKEV=""
Begin DoDot:2
+26 if ACKARR>1
SET ACKARR=1
+27 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Event Capture Procedure"
End DoDot:2
+28 KILL ACKEV
End DoDot:1
+29 ;
+30 ; check Diagnosis
+31 NEW ACKICD,ACKFROM
+32 ; D LIST^DIC(509850.63,","_ACKVIEN_",","","",1,.ACKFROM,"","","","","ACKICD")
+33 ; I $P($G(ACKICD("DILIST",0)),U,1)'=1 D ; LIST call removed - too slow!
+34 NEW ACKD
SET ACKD=$ORDER(^ACK(509850.6,ACKVIEN,1,0))
SET ACKICD=""
+35 IF ACKD
SET ACKICD=$PIECE($GET(^ACK(509850.6,ACKVIEN,1,ACKD,0)),U,1)
+36 IF ACKICD'?1N.N
Begin DoDot:1
+37 if ACKARR>1
SET ACKARR=1
+38 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Diagnosis"
End DoDot:1
+39 ; check to see that a diagnosis has been allocated as the Primary
+40 IF '$$PRIMARY^ACKQASU5(ACKVIEN,"")
Begin DoDot:1
+41 if ACKARR>1
SET ACKARR=1
+42 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Primary Diagnosis"
End DoDot:1
+43 KILL ACKICD
+44 ;
+45 ; check C and P status (CHECK FOR OPEN REQUEST?)
+46 NEW ACKCP
+47 SET ACKCP=$GET(ACKDATA(509850.6,ACKVIEN_",",.09,"I"))
+48 IF ACKCP'=""
IF ACKCP'?1N
Begin DoDot:1
+49 if ACKARR>1
SET ACKARR=1
+50 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="C and P Status"
End DoDot:1
+51 ;
+52 ; check first audiometric field
+53 IF ACKCP
IF $GET(ACKDATA(509850.6,ACKVIEN_",",4.01,"I"))'?1.N
Begin DoDot:1
+54 if ACKARR>1
SET ACKARR=1
+55 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Audiometric Data"
End DoDot:1
+56 ;
+57 ; check Time Spent
+58 IF $GET(ACKDATA(509850.6,ACKVIEN_",",.07,"I"))'?1N.N
Begin DoDot:1
+59 if ACKARR>1
SET ACKARR=1
+60 SET ACKARR(1)=$GET(ACKARR(1))+1
SET ACKARR(1,ACKARR(1))="Time Spent"
End DoDot:1
+61 ;
END1 ; if errors found and we're not doing a full check then exit
+1 IF ACKARR<3
IF 'ACKFULL
GOTO CHKVSTX
+2 ;
+3 ; get data for level 2
GET2 KILL ACKDATA
+1 DO GETS^DIQ(509850.6,ACKVIEN_",","1;80;20;25;30;35","I","ACKDATA")
+2 ;
+3 ; check visit eligibility
CHK2 IF $GET(ACKDATA(509850.6,ACKVIEN_",",80,"I"))'?1.N
Begin DoDot:1
+1 if ACKARR>2
SET ACKARR=2
+2 SET ACKARR(2)=$GET(ACKARR(2))+1
SET ACKARR(2,ACKARR(2))="Visit Eligibility"
End DoDot:1
+3 ;
+4 ; get service connected data
+5 NEW DFN,VAEL,VASV,ACKSC,ACKSCV,ACKAO,ACKIR,ACKENV,ACKEC
+6 SET DFN=$GET(ACKDATA(509850.6,ACKVIEN_",",1,"I"))
+7 SET (ACKSC,ACKAO,ACKIR,ACKEC)=0
+8 IF DFN?1.N
DO ELIG^VADPT
DO SVC^VADPT
Begin DoDot:1
+9 ; patient service connected
SET ACKSC=$SELECT(+VAEL(3)=1:1,1:0)
+10 ; patient agent orange
SET ACKAO=$SELECT(+VASV(2)=1:1,1:0)
+11 ; patient radiation
SET ACKIR=$SELECT(+VASV(3)=1:1,1:0)
+12 ; pat env cont
SET ACKEC=$SELECT($$GET1^DIQ(2,DFN_",",.322013,"I")="Y":1,1:0)
End DoDot:1
+13 ; serv conn visit
SET ACKSCV=$GET(ACKDATA(509850.6,ACKVIEN_",",20,"I"))
+14 ;
+15 ; check service connected status
+16 IF ACKSC=1
IF ACKSCV'?1N
Begin DoDot:1
+17 if ACKARR>2
SET ACKARR=2
+18 SET ACKARR(2)=$GET(ACKARR(2))+1
SET ACKARR(2,ACKARR(2))="Service Connected"
End DoDot:1
+19 ;
+20 ; check Agent Orange
+21 IF ACKSCV'=1
IF ACKAO
IF $GET(ACKDATA(509850.6,ACKVIEN_",",25,"I"))'?1N
Begin DoDot:1
+22 if ACKARR>2
SET ACKARR=2
+23 SET ACKARR(2)=$GET(ACKARR(2))+1
SET ACKARR(2,ACKARR(2))="Agent Orange"
End DoDot:1
+24 ;
+25 ; check Radiation
+26 IF ACKSCV'=1
IF ACKIR
IF $GET(ACKDATA(509850.6,ACKVIEN_",",30,"I"))'?1N
Begin DoDot:1
+27 if ACKARR>2
SET ACKARR=2
+28 SET ACKARR(2)=$GET(ACKARR(2))+1
SET ACKARR(2,ACKARR(2))="Ionizing Radiation"
End DoDot:1
+29 ;
+30 ; check Environmental contaminants
+31 IF ACKSCV'=1
IF ACKEC
IF $GET(ACKDATA(509850.6,ACKVIEN_",",35,"I"))'?1N
Begin DoDot:1
+32 if ACKARR>2
SET ACKARR=2
+33 SET ACKARR(2)=$GET(ACKARR(2))+1
SET ACKARR(2,ACKARR(2))="Environmental Contaminants"
End DoDot:1
+34 ;
+35 ;
CHKVSTX ; that'll do
+1 QUIT
+2 ;
+3 ;
DIAGTXT(ACKQDCDS,ACKCVD) ; Get Short ICD Description
+1 NEW DIAGTXT
+2 IF $GET(ACKCVD)=""
SET ACKCVD=$$DATE
+3 SET ACKICD=$$CSI^ICDEX(80,ACKQDCDS)
+4 SET DIAGTXT=$$ICDDATA^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,"I")
+5 SET DIAGTXT=$PIECE(DIAGTXT,"^",4)
+6 QUIT DIAGTXT
+7 ;
LDIAGTXT(ACKQDCDS,ACKCVD,ACKICD) ; Get Long ICD Description
+1 NEW LDIAGTXT,LST,RET,OUTARR
+2 SET ACKQDCDS=$$CONV(ACKQDCDS)
+3 IF $GET(ACKCVD)=""
SET ACKCVD=$$DATE
+4 SET RET=$$ICDDESC^ICDXCODE(ACKICD,ACKQDCDS,ACKCVD,.OUTARR)
+5 IF $PIECE(RET,"^",1)="-1"
SET LDIAGTXT=$PIECE(RET,"^",2)
+6 IF $PIECE(RET,"^",1)'="-1"
SET LDIAGTXT=OUTARR(1)
+7 QUIT LDIAGTXT
+8 ;
PROCTXT(ACKQDCDS,ACKCVD) ; Get Short CPT Description
+1 NEW PROCTXT
+2 IF $GET(ACKCVD)=""
SET ACKCVD=$$DATE
+3 SET PROCTXT=$$CPT^ICPTCOD(ACKQDCDS,ACKCVD)
+4 SET PROCTXT=$PIECE(PROCTXT,"^",3)
+5 QUIT PROCTXT
+6 ;
MODTXT(ACKQMCDS,ACKCVD) ; Get Short CPT Modifier Description
+1 NEW MODTXT
+2 IF $GET(ACKCVD)=""
SET ACKCVD=$$DATE
+3 SET MODTXT=$$MOD^ICPTMOD(ACKQMCDS,"I",ACKCVD)
+4 SET MODTXT=$PIECE(MODTXT,"^",3)
+5 QUIT MODTXT
+6 ;
CONV(ACKQDCDS) ;
+1 NEW CODE
+2 SET CODE=$$CODEC^ICDEX(80,ACKQDCDS)
+3 QUIT CODE
+4 ;
DATE() ;
+1 NEW %
+2 DO NOW^%DTC
+3 QUIT $PIECE(%,".",1)
+4 ;
+5 ;
