- 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 Feb 18, 2025@23:59:28 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 ;