- AMHUTIL2 ; IHS/CMI/LAB - provider functions ;
- ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5,8**;JUN 02, 2010;Build 7
- ;
- PNPV(N,AMHDA) ;PEP - OUTPUT TX PROVIDER NARRATIVE
- S AMHDA=$G(AMHDA)
- S N=$G(N)
- I N="" Q ""
- Q $$SNOMED^AUPNVUTL(N)
- NEW R,D
- S (R,D)=""
- I AMHDA S R=$P($G(^AMHRPRO(AMHDA,0)),U,3)
- I AMHDA S D=$P($G(^AMHRPRO(AMHDA,0)),U,1)
- I N="" Q "<No Provider Narrative>"
- I R,$P($G(^AMHREC(R,11)),U,10) G EHR ;if EHR created do EHR stuff
- Q $P(^AUTNPOV(N,0),U) ;IF NOT AN EHR CREATED VISIT JUST DISPLAY THE NARRATIVE LIKE WE ALWAYS DID
- EHR ;
- S N=$P($G(^AUTNPOV(N,0)),U,1)
- I N'["|" Q $$GET1^DIQ(9002012.2,D,.02)_" | "_N ; no vertical equals no snomed desc id so use problem narrative
- I N["| " Q $$GET1^DIQ(9002012.2,D,.02)_" | "_N ;prenatal v1.0
- I $T(DESC^BSTSAPI)="" Q $$GET1^DIQ(9002012.2,D,.02)_" | "_N ;no snomed stuff installed
- NEW SDI,SDIT
- S SDI=$P(N,"|",2) ;snomed descriptive id is in piece 2
- S SDIT=$P($$DESC^BSTSAPI(SDI_"^^1"),U,2)
- I SDIT="" Q $$GET1^DIQ(9002012.2,D,.02)_" | "_$P(N,"|",1) ;not snomed text?? somebody stored a bad descriptive id return "* | " per Susan
- Q SDIT_" | "_$P(N,"|",1)
- HL(H) ;EP - called to return internal of file 44 for hospital location based on program H
- I $G(H)="" Q ""
- I '$D(^AMHSITE(DUZ(2))) Q "" ;NO SITE ENTRY
- NEW I
- I H="M" S I=$$VALI^XBDIQ1(9002013,DUZ(2),1812) I I Q $S($D(^SC(I,0)):I,1:"")
- I H="S" S I=$$VALI^XBDIQ1(9002013,DUZ(2),1813) I I Q $S($D(^SC(I,0)):I,1:"")
- I H="C" S I=$$VALI^XBDIQ1(9002013,DUZ(2),1814) I I Q $S($D(^SC(I,0)):I,1:"")
- I H="O" S I=$$VALI^XBDIQ1(9002013,DUZ(2),1815) I I Q $S($D(^SC(I,0)):I,1:"")
- Q ""
- CS(I) ;EP - called to determine coding system of ien I
- ;are the icd10 routines in place?, if so, use them
- I $T(ICDDX^ICDEX)]"" Q $P($$ICDDX^ICDEX(I),U,20) ;return 1 or 30
- Q 1 ;if no icdex then assume site is only on icd9
- IMP(D) ;EP - which coding system should be used:
- ;RETURN IEN of entry in ^ICDS
- ;1 = ICD9
- ;30 = ICD10
- ;will need to add subroutines for ICD11 when we have that.
- I $G(D)="" S D=DT
- NEW X,Y,Z
- S Y=""
- I '$O(^ICDS(0)) Q 1 ;icd 10 not installed yet
- S X=0 F S X=$O(^ICDS("F",80,X)) Q:X'=+X D
- .I $P(^ICDS(X,0),U,4)="" Q ;NO IMPLEMENTATION DATE?? SKIP IT
- .S Z($P(^ICDS(X,0),U,4))=X
- ;now go through and get the last one before it imp date is greater than the visit date
- S X=0 F S X=$O(Z(X)) Q:X="" D
- .I D<X Q
- .I D=X S Y=Z(X) Q
- .I D>X S Y=Z(X) Q
- I Y="" S Y=$O(Z(0)) Q Z(Y)
- Q Y
- PRIMCPT(V,F) ;EP - primaryCPT in many different formats
- I 'V Q ""
- I '$D(^AMHREC(V)) Q ""
- NEW %,Y,P,C,Z
- S (Z,P)="",(Y,C)=0
- S Y=$O(^AMHRPROC("AD",V,0)) I Y S P=$P(^AMHRPROC(Y,0),U),Z=Y
- I 'P Q P
- I '$D(^ICPT(P)) Q ""
- I $G(F)="" S F="C"
- S %="" D @F
- Q %
- ;
- SECCPT(V,N,F) ;EP
- I 'V Q ""
- I '$D(^AMHREC(V)) Q ""
- I '$G(N) Q ""
- NEW %,Y,P,C,Z
- S (Z,P)="",(Y,C)=0
- S Y=0,C=-1 F S Y=$O(^AMHRPROC("AD",V,Y)) Q:Y'=+Y S C=C+1 I C=N S P=$P(^AMHRPROC(Y,0),U),Z=Y
- I 'P Q P
- I '$D(^ICPT(P)) Q ""
- I $G(F)="" S F="C"
- S %="" D @F
- Q %
- ;
- CPT ;EP
- NEW Z,C,%,S,I,J
- S (C,Y)=0 F S Y=$O(^AMHRPROC("AD",V,Y)) Q:Y'=+Y S C=C+1 S APCLV(C)="",P=$P(^AMHRPROC(Y,0),U),Z=Y D
- .I F=99 D Q
- ..F I=1:1 S S=$T(@I) Q:S="" S %="" D @I S $P(APCLV(C),U,I)=%
- .I F[";" D Q
- ..F J=1:1 S I=$P(F,";",J) Q:I="" I I'=99 S %="" D @I S $P(APCLV(C),U,I)=% ;IHS/TUCSON/LAB - patch 1 05/19/97 changed ,I TO ,J
- .S %="",I=F D @I S $P(APCLV(C),U)=%
- .Q
- Q
- ;
- I ;
- S %=P Q
- E ;CATEGORY
- S %=$$CPT^ICPTCOD(P,$P($P($G(^AMHREC(V,0)),U),"."),U,4) Q
- C ;CODE
- S %=$$CPT^ICPTCOD(P,$P($P($G(^AMHREC(V,0)),U),"."),U,2) Q
- ;
- N ;NARRATIVE - SHORT NAME
- S %=$$CPT^ICPTCOD(P,$P($P($G(^AMHREC(V,0)),U),"."),U,3) Q
- ;
- PTSEC(RESULT,DFN,MSG,OPT) ;EP - RPC/API entry point for patient sensitive & record access checks
- ;Output array (Required)
- ; RESULT(1)= -1-RPC/API failed
- ; Required variable not defined
- ; 0-No display/action required
- ; Not accessing own, employee, or sensitive record
- ; 1-Display warning message
- ; Sensitive and DG SENSITIVITY key holder
- ; or Employee and DG SECURITY OFFICER key holder
- ; 2-Display warning message/require OK to continue
- ; Sensitive and not a DG SENSITIVITY key holder
- ; Employee and not a DG SECURITY OFFICER key holder
- ; 3-Access to record denied
- ; Accessing own record
- ; 4-Access to Patient (#2) file records denied
- ; SSN not defined
- ; 5-Access to Patient for this User is denied ;IHS/OIT/LJF 08/31/2007 PATCH 1008
- ;
- ; RESULT(2-8) = error or display messages
- ;
- ;Input parameters: DFN = Patient file entry (Required)
- ; MSG = If 1, generate message (optional)
- ; OPT = Option name^Menu text (Optional)
- ;
- K RESULT
- I $G(DFN)="" D Q
- .S RESULT(1)=-1
- .S RESULT(2)="Required variable missing."
- ;
- ;IHS/OIT/LJF 08/31/2007 PATCH 1008
- ;S DGMSG=$G(DGMSG)
- S MSG=$G(MSG,1)
- I $$STATUS^BDGSPT2(DUZ,DFN,1)["RESTRICTED ACCESS" D Q
- .S RESULT(1)=5 Q:MSG'=1
- .S RESULT(2)="Sorry, you are restricted from accessing this patient's record."
- .S RESULT(3)="If you have questions, please contact your HIM department."
- ;end of PATCH 1008 code
- ;
- D OWNREC^DGSEC4(.RESULT,DFN,$G(DUZ),MSG)
- I RESULT(1)=1 S RESULT(1)=3 Q
- I RESULT(1)=2 S RESULT(1)=4 Q
- K RESULT
- D SENS^DGSEC4(.RESULT,DFN,$G(DUZ))
- ;
- ;IHS/OIT/LJF 01/06/2006 PATCH 1005 account for tracking all patients
- ;I RESULT(1)=1 D
- I (RESULT(1)=1)!(RESULT(1)=0) D
- .I (RESULT(1)=0)&($$GET1^DIQ(43,1,9999999.01)'="YES")&('$P($G(^DGSL(38.1,+DFN,0)),U,2)) Q ;cmi/maw 1/26/2010 PATCH 1011
- .;
- .I $G(DUZ)="" D Q
- ..;DUZ must be defined to access sensitive record & update DG Security log
- ..S RESULT(1)=-1
- ..S RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record."
- .D SETLOG1^DGSEC(DFN,DUZ,,$G(DGOPT)) ;ihs/cmi/maw 12/15/2010 added set of log
- Q
- ANY25(AMHX) ;EP
- NEW F,X,G
- S X="",G=0 F S X=$O(^TMP("DDS",$J,+DDS,"F9002013.01101",X)) Q:X="" D
- .I $G(^TMP("DDS",$J,+DDS,"F9002013.01101",X,.02,"D"))=2 S G=1
- .I $G(^TMP("DDS",$J,+DDS,"F9002013.01101",X,.02,"D"))=5 S G=1
- .Q
- Q G
- ICD9 ;EP - CALLED FROM INPUT TX ON SITE PARAMETERS FIELD .13
- I $$CHK(Y)
- Q:$D(^ICD9(Y))
- Q
- ;
- CHK(Y) ;EP - SCREEN OUT E CODES AND INACTIVE CODES
- NEW A,I,D,%
- I $T(ICDDX^ICDEX)]"" S %=$$ICDDX^ICDEX(Y) I $P(%,U,20)'=1 Q 0
- I $T(ICDDX^ICDEX)="" S %=$$ICDDX^ICDCODE(Y)
- ;I $P(%,U,20)'=1 Q 0 ;not correct coding system
- I $E($P(%,U,2),1)="E" Q 0 ;no E codes
- I '$P(%,U,10) Q 0 ;STATUS IS INACTIVE
- Q 1
- ICD10 ;EP CALLED FROM INPUT TX ON SITE PARAMETERS FIELD 1204
- ;
- I $$CHK1(Y)
- Q:$D(^ICD9(Y))
- Q
- ;
- CHK1(Y) ;EP - SCREEN OUT E CODES AND INACTIVE CODES
- NEW A,I,D,%
- I $T(ICDDX^ICDEX)]"" S %=$$ICDDX^ICDEX(Y) I $P(%,U,20)'=30 Q 0
- I $T(ICDDX^ICDEX)="" S %=$$ICDDX^ICDCODE(Y)
- ;I $P(%,U,20)'=30 Q 0 ;not correct coding system
- I $E($P(%,U,2),1)="V" Q 0 ;no codes V00-Y99 per Leslie Racine.
- I $E($P(%,U,2),1)="W" Q 0
- I $E($P(%,U,2),1)="X" Q 0
- I $E($P(%,U,2),1)="Y" Q 0
- I '$P(%,U,10) Q 0 ;STATUS IS INACTIVE
- Q 1
- AMHUTIL2 ; IHS/CMI/LAB - provider functions ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,4,5,8**;JUN 02, 2010;Build 7
- +2 ;
- PNPV(N,AMHDA) ;PEP - OUTPUT TX PROVIDER NARRATIVE
- +1 SET AMHDA=$GET(AMHDA)
- +2 SET N=$GET(N)
- +3 IF N=""
- QUIT ""
- +4 QUIT $$SNOMED^AUPNVUTL(N)
- +5 NEW R,D
- +6 SET (R,D)=""
- +7 IF AMHDA
- SET R=$PIECE($GET(^AMHRPRO(AMHDA,0)),U,3)
- +8 IF AMHDA
- SET D=$PIECE($GET(^AMHRPRO(AMHDA,0)),U,1)
- +9 IF N=""
- QUIT "<No Provider Narrative>"
- +10 ;if EHR created do EHR stuff
- IF R
- IF $PIECE($GET(^AMHREC(R,11)),U,10)
- GOTO EHR
- +11 ;IF NOT AN EHR CREATED VISIT JUST DISPLAY THE NARRATIVE LIKE WE ALWAYS DID
- QUIT $PIECE(^AUTNPOV(N,0),U)
- EHR ;
- +1 SET N=$PIECE($GET(^AUTNPOV(N,0)),U,1)
- +2 ; no vertical equals no snomed desc id so use problem narrative
- IF N'["|"
- QUIT $$GET1^DIQ(9002012.2,D,.02)_" | "_N
- +3 ;prenatal v1.0
- IF N["| "
- QUIT $$GET1^DIQ(9002012.2,D,.02)_" | "_N
- +4 ;no snomed stuff installed
- IF $TEXT(DESC^BSTSAPI)=""
- QUIT $$GET1^DIQ(9002012.2,D,.02)_" | "_N
- +5 NEW SDI,SDIT
- +6 ;snomed descriptive id is in piece 2
- SET SDI=$PIECE(N,"|",2)
- +7 SET SDIT=$PIECE($$DESC^BSTSAPI(SDI_"^^1"),U,2)
- +8 ;not snomed text?? somebody stored a bad descriptive id return "* | " per Susan
- IF SDIT=""
- QUIT $$GET1^DIQ(9002012.2,D,.02)_" | "_$PIECE(N,"|",1)
- +9 QUIT SDIT_" | "_$PIECE(N,"|",1)
- HL(H) ;EP - called to return internal of file 44 for hospital location based on program H
- +1 IF $GET(H)=""
- QUIT ""
- +2 ;NO SITE ENTRY
- IF '$DATA(^AMHSITE(DUZ(2)))
- QUIT ""
- +3 NEW I
- +4 IF H="M"
- SET I=$$VALI^XBDIQ1(9002013,DUZ(2),1812)
- IF I
- QUIT $SELECT($DATA(^SC(I,0)):I,1:"")
- +5 IF H="S"
- SET I=$$VALI^XBDIQ1(9002013,DUZ(2),1813)
- IF I
- QUIT $SELECT($DATA(^SC(I,0)):I,1:"")
- +6 IF H="C"
- SET I=$$VALI^XBDIQ1(9002013,DUZ(2),1814)
- IF I
- QUIT $SELECT($DATA(^SC(I,0)):I,1:"")
- +7 IF H="O"
- SET I=$$VALI^XBDIQ1(9002013,DUZ(2),1815)
- IF I
- QUIT $SELECT($DATA(^SC(I,0)):I,1:"")
- +8 QUIT ""
- CS(I) ;EP - called to determine coding system of ien I
- +1 ;are the icd10 routines in place?, if so, use them
- +2 ;return 1 or 30
- IF $TEXT(ICDDX^ICDEX)]""
- QUIT $PIECE($$ICDDX^ICDEX(I),U,20)
- +3 ;if no icdex then assume site is only on icd9
- QUIT 1
- IMP(D) ;EP - which coding system should be used:
- +1 ;RETURN IEN of entry in ^ICDS
- +2 ;1 = ICD9
- +3 ;30 = ICD10
- +4 ;will need to add subroutines for ICD11 when we have that.
- +5 IF $GET(D)=""
- SET D=DT
- +6 NEW X,Y,Z
- +7 SET Y=""
- +8 ;icd 10 not installed yet
- IF '$ORDER(^ICDS(0))
- QUIT 1
- +9 SET X=0
- FOR
- SET X=$ORDER(^ICDS("F",80,X))
- IF X'=+X
- QUIT
- Begin DoDot:1
- +10 ;NO IMPLEMENTATION DATE?? SKIP IT
- IF $PIECE(^ICDS(X,0),U,4)=""
- QUIT
- +11 SET Z($PIECE(^ICDS(X,0),U,4))=X
- End DoDot:1
- +12 ;now go through and get the last one before it imp date is greater than the visit date
- +13 SET X=0
- FOR
- SET X=$ORDER(Z(X))
- IF X=""
- QUIT
- Begin DoDot:1
- +14 IF D<X
- QUIT
- +15 IF D=X
- SET Y=Z(X)
- QUIT
- +16 IF D>X
- SET Y=Z(X)
- QUIT
- End DoDot:1
- +17 IF Y=""
- SET Y=$ORDER(Z(0))
- QUIT Z(Y)
- +18 QUIT Y
- PRIMCPT(V,F) ;EP - primaryCPT in many different formats
- +1 IF 'V
- QUIT ""
- +2 IF '$DATA(^AMHREC(V))
- QUIT ""
- +3 NEW %,Y,P,C,Z
- +4 SET (Z,P)=""
- SET (Y,C)=0
- +5 SET Y=$ORDER(^AMHRPROC("AD",V,0))
- IF Y
- SET P=$PIECE(^AMHRPROC(Y,0),U)
- SET Z=Y
- +6 IF 'P
- QUIT P
- +7 IF '$DATA(^ICPT(P))
- QUIT ""
- +8 IF $GET(F)=""
- SET F="C"
- +9 SET %=""
- DO @F
- +10 QUIT %
- +11 ;
- SECCPT(V,N,F) ;EP
- +1 IF 'V
- QUIT ""
- +2 IF '$DATA(^AMHREC(V))
- QUIT ""
- +3 IF '$GET(N)
- QUIT ""
- +4 NEW %,Y,P,C,Z
- +5 SET (Z,P)=""
- SET (Y,C)=0
- +6 SET Y=0
- SET C=-1
- FOR
- SET Y=$ORDER(^AMHRPROC("AD",V,Y))
- IF Y'=+Y
- QUIT
- SET C=C+1
- IF C=N
- SET P=$PIECE(^AMHRPROC(Y,0),U)
- SET Z=Y
- +7 IF 'P
- QUIT P
- +8 IF '$DATA(^ICPT(P))
- QUIT ""
- +9 IF $GET(F)=""
- SET F="C"
- +10 SET %=""
- DO @F
- +11 QUIT %
- +12 ;
- CPT ;EP
- +1 NEW Z,C,%,S,I,J
- +2 SET (C,Y)=0
- FOR
- SET Y=$ORDER(^AMHRPROC("AD",V,Y))
- IF Y'=+Y
- QUIT
- SET C=C+1
- SET APCLV(C)=""
- SET P=$PIECE(^AMHRPROC(Y,0),U)
- SET Z=Y
- Begin DoDot:1
- +3 IF F=99
- Begin DoDot:2
- +4 FOR I=1:1
- SET S=$TEXT(@I)
- IF S=""
- QUIT
- SET %=""
- DO @I
- SET $PIECE(APCLV(C),U,I)=%
- End DoDot:2
- QUIT
- +5 IF F[";"
- Begin DoDot:2
- +6 ;IHS/TUCSON/LAB - patch 1 05/19/97 changed ,I TO ,J
- FOR J=1:1
- SET I=$PIECE(F,";",J)
- IF I=""
- QUIT
- IF I'=99
- SET %=""
- DO @I
- SET $PIECE(APCLV(C),U,I)=%
- End DoDot:2
- QUIT
- +7 SET %=""
- SET I=F
- DO @I
- SET $PIECE(APCLV(C),U)=%
- +8 QUIT
- End DoDot:1
- +9 QUIT
- +10 ;
- I ;
- +1 SET %=P
- QUIT
- E ;CATEGORY
- +1 SET %=$$CPT^ICPTCOD(P,$PIECE($PIECE($GET(^AMHREC(V,0)),U),"."),U,4)
- QUIT
- C ;CODE
- +1 SET %=$$CPT^ICPTCOD(P,$PIECE($PIECE($GET(^AMHREC(V,0)),U),"."),U,2)
- QUIT
- +2 ;
- N ;NARRATIVE - SHORT NAME
- +1 SET %=$$CPT^ICPTCOD(P,$PIECE($PIECE($GET(^AMHREC(V,0)),U),"."),U,3)
- QUIT
- +2 ;
- PTSEC(RESULT,DFN,MSG,OPT) ;EP - RPC/API entry point for patient sensitive & record access checks
- +1 ;Output array (Required)
- +2 ; RESULT(1)= -1-RPC/API failed
- +3 ; Required variable not defined
- +4 ; 0-No display/action required
- +5 ; Not accessing own, employee, or sensitive record
- +6 ; 1-Display warning message
- +7 ; Sensitive and DG SENSITIVITY key holder
- +8 ; or Employee and DG SECURITY OFFICER key holder
- +9 ; 2-Display warning message/require OK to continue
- +10 ; Sensitive and not a DG SENSITIVITY key holder
- +11 ; Employee and not a DG SECURITY OFFICER key holder
- +12 ; 3-Access to record denied
- +13 ; Accessing own record
- +14 ; 4-Access to Patient (#2) file records denied
- +15 ; SSN not defined
- +16 ; 5-Access to Patient for this User is denied ;IHS/OIT/LJF 08/31/2007 PATCH 1008
- +17 ;
- +18 ; RESULT(2-8) = error or display messages
- +19 ;
- +20 ;Input parameters: DFN = Patient file entry (Required)
- +21 ; MSG = If 1, generate message (optional)
- +22 ; OPT = Option name^Menu text (Optional)
- +23 ;
- +24 KILL RESULT
- +25 IF $GET(DFN)=""
- Begin DoDot:1
- +26 SET RESULT(1)=-1
- +27 SET RESULT(2)="Required variable missing."
- End DoDot:1
- QUIT
- +28 ;
- +29 ;IHS/OIT/LJF 08/31/2007 PATCH 1008
- +30 ;S DGMSG=$G(DGMSG)
- +31 SET MSG=$GET(MSG,1)
- +32 IF $$STATUS^BDGSPT2(DUZ,DFN,1)["RESTRICTED ACCESS"
- Begin DoDot:1
- +33 SET RESULT(1)=5
- IF MSG'=1
- QUIT
- +34 SET RESULT(2)="Sorry, you are restricted from accessing this patient's record."
- +35 SET RESULT(3)="If you have questions, please contact your HIM department."
- End DoDot:1
- QUIT
- +36 ;end of PATCH 1008 code
- +37 ;
- +38 DO OWNREC^DGSEC4(.RESULT,DFN,$GET(DUZ),MSG)
- +39 IF RESULT(1)=1
- SET RESULT(1)=3
- QUIT
- +40 IF RESULT(1)=2
- SET RESULT(1)=4
- QUIT
- +41 KILL RESULT
- +42 DO SENS^DGSEC4(.RESULT,DFN,$GET(DUZ))
- +43 ;
- +44 ;IHS/OIT/LJF 01/06/2006 PATCH 1005 account for tracking all patients
- +45 ;I RESULT(1)=1 D
- +46 IF (RESULT(1)=1)!(RESULT(1)=0)
- Begin DoDot:1
- +47 ;cmi/maw 1/26/2010 PATCH 1011
- IF (RESULT(1)=0)&($$GET1^DIQ(43,1,9999999.01)'="YES")&('$PIECE($GET(^DGSL(38.1,+DFN,0)),U,2))
- QUIT
- +48 ;
- +49 IF $GET(DUZ)=""
- Begin DoDot:2
- +50 ;DUZ must be defined to access sensitive record & update DG Security log
- +51 SET RESULT(1)=-1
- +52 SET RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record."
- End DoDot:2
- QUIT
- +53 ;ihs/cmi/maw 12/15/2010 added set of log
- DO SETLOG1^DGSEC(DFN,DUZ,,$GET(DGOPT))
- End DoDot:1
- +54 QUIT
- ANY25(AMHX) ;EP
- +1 NEW F,X,G
- +2 SET X=""
- SET G=0
- FOR
- SET X=$ORDER(^TMP("DDS",$JOB,+DDS,"F9002013.01101",X))
- IF X=""
- QUIT
- Begin DoDot:1
- +3 IF $GET(^TMP("DDS",$JOB,+DDS,"F9002013.01101",X,.02,"D"))=2
- SET G=1
- +4 IF $GET(^TMP("DDS",$JOB,+DDS,"F9002013.01101",X,.02,"D"))=5
- SET G=1
- +5 QUIT
- End DoDot:1
- +6 QUIT G
- ICD9 ;EP - CALLED FROM INPUT TX ON SITE PARAMETERS FIELD .13
- +1 IF $$CHK(Y)
- +2 IF $DATA(^ICD9(Y))
- QUIT
- +3 QUIT
- +4 ;
- CHK(Y) ;EP - SCREEN OUT E CODES AND INACTIVE CODES
- +1 NEW A,I,D,%
- +2 IF $TEXT(ICDDX^ICDEX)]""
- SET %=$$ICDDX^ICDEX(Y)
- IF $PIECE(%,U,20)'=1
- QUIT 0
- +3 IF $TEXT(ICDDX^ICDEX)=""
- SET %=$$ICDDX^ICDCODE(Y)
- +4 ;I $P(%,U,20)'=1 Q 0 ;not correct coding system
- +5 ;no E codes
- IF $EXTRACT($PIECE(%,U,2),1)="E"
- QUIT 0
- +6 ;STATUS IS INACTIVE
- IF '$PIECE(%,U,10)
- QUIT 0
- +7 QUIT 1
- ICD10 ;EP CALLED FROM INPUT TX ON SITE PARAMETERS FIELD 1204
- +1 ;
- +2 IF $$CHK1(Y)
- +3 IF $DATA(^ICD9(Y))
- QUIT
- +4 QUIT
- +5 ;
- CHK1(Y) ;EP - SCREEN OUT E CODES AND INACTIVE CODES
- +1 NEW A,I,D,%
- +2 IF $TEXT(ICDDX^ICDEX)]""
- SET %=$$ICDDX^ICDEX(Y)
- IF $PIECE(%,U,20)'=30
- QUIT 0
- +3 IF $TEXT(ICDDX^ICDEX)=""
- SET %=$$ICDDX^ICDCODE(Y)
- +4 ;I $P(%,U,20)'=30 Q 0 ;not correct coding system
- +5 ;no codes V00-Y99 per Leslie Racine.
- IF $EXTRACT($PIECE(%,U,2),1)="V"
- QUIT 0
- +6 IF $EXTRACT($PIECE(%,U,2),1)="W"
- QUIT 0
- +7 IF $EXTRACT($PIECE(%,U,2),1)="X"
- QUIT 0
- +8 IF $EXTRACT($PIECE(%,U,2),1)="Y"
- QUIT 0
- +9 ;STATUS IS INACTIVE
- IF '$PIECE(%,U,10)
- QUIT 0
- +10 QUIT 1
