AMERUTIL ;GDIT/HS/BEE - AMER UTILITY CALLS ; 07 Oct 2013 11:33 AM
;;3.0;ER VISIT SYSTEM;**6,7,8**;MAR 03, 2009;Build 23
;
Q
;
POV(AUPNPAT,AMERPCC,AMERPOV) ;EP - Return a list of POV entries for a visit
;
;Pass in DFN or VIEN, plus array to return information in
;
;Returns list of POVs in the following format:
;AMERPOV(CNT)=[1]^[2]^[3]^[4]^[5]
;[1] - ICD code
;[2] - P-Primary, S-Secondary
;[3] - Provider Narrative
;[4] - IEN Pointer to file 80
;[5] - ICD Description Value
;[6] - V POV IEN
;[7] - Injury (Yes/No)
;
;Function returns: [1] # of POV entries on file in piece 1 ^[2] Primary POV entered
;
;Quit if no DFN or visit IEN passed in
I $G(AUPNPAT)="",$G(AMERPCC)="" Q "0"
;
;If Visit IEN is blank retrieve from ER ADMISSION file
S:$G(AMERPCC)="" AMERPCC=$$GET1^DIQ(9009081,AUPNPAT,1.1,"I")
I AMERPCC="" Q "0"
;
;Reset output array
K AMERPOV
;
NEW IEN,CNT,PRM
;
;Loop through the POVs for the visit
S (CNT,IEN,PRM)=0 F S IEN=$O(^AUPNVPOV("AD",AMERPCC,IEN)) Q:'IEN D
. NEW ICDIEN,VDATE,PS,ICDINFO,ICD,ICDDESC,PNAR,ICDV,INJ
. ;
. ;Get the narrative
. S PNAR=$$GET1^DIQ(9000010.07,IEN,.04,"E")
. ;
. ;Get the ICD Information
. S VDATE=$$FMTDATE($$GET1^DIQ(9000010,AMERPCC,.01,"I"))
. S ICDIEN=+$$GET1^DIQ(9000010.07,IEN,.01,"I")
. I $$AICD() S ICDINFO=$$ICDDX^ICDEX(ICDIEN,VDATE)
. E S ICDINFO=$$ICDDX^ICDCODE(ICDIEN,VDATE)
. S ICD=$P(ICDINFO,U,2) Q:ICD=""
. ;
. ;Get the description
. S ICDDESC=$P(ICDINFO,U,4)
. ;
. ;Get primary/secondary
. S PS=$$GET1^DIQ(9000010.07,IEN_",",.12,"I")
. S:PS="" PS="S"
. ;AMER*3.0*7;Track if more than one Primary
. ;S:PS="P" PRM=1
. S:PS="P" PRM=PRM+1
. ;
. ;Get whether an injury - Flag if injury date or cause of injury
. S INJ="No"
. I $$GET1^DIQ(9000010.07,IEN_",",.13,"I") S INJ="Yes"
. E I $$GET1^DIQ(9000010.07,IEN_",",.09,"I") S INJ="Yes"
. ;
. ;Set return entry
. S CNT=CNT+1
. S AMERPOV(CNT)=ICD_U_PS_U_PNAR_U_ICDIEN_U_ICDDESC_U_IEN_U_INJ
;
Q CNT_U_PRM
;
AICD() ;EP - Return 1 if AICD 4.0
Q $S($$VERSION^XPDUTL("AICD")="4.0":1,1:0)
;
FMTDATE(X,TM) ;EP - Return formated date - Taken from BGOUTL
Q:'X ""
N M,D,V
S M=$E(X,4,5),D=$E(X,6,7),V=$E(X,1,3)+1700
S:M&D V=D_"/"_V
S:M V=M_"/"_V
I $G(TM) D
.S X=X#1
.Q:'X
.S X=$TR($J(X*10000\1,4),0)
.S V=V_" "_$E(X,1,2)_":"_$E(X,3,4)
Q V
;
S(X) ;EP - Screen formatting - Based on AGVDF
NEW AMERM1,AMERMVDF
S AMERM1("X")=$X
S AMERM1("LN")=$T(@X),AMERM1(1)=$P(AMERM1("LN"),";;",2),AMERM1(2)=$P(AMERM1("LN"),";;",3),AMERM1(3)=$P(AMERM1("LN"),";;",4)
S AMERMVDF(+IOST(0),X)=$P($G(^%ZIS(2,+IOST(0),AMERM1(1))),"^",AMERM1(2),AMERM1(3))
I AMERMVDF(+IOST(0),X)="" S AMERMVDF(+IOST(0),X)="*0"
W @AMERMVDF(+IOST(0),X)
S $X=AMERM1("X")
S X=""
Q X
;
LEX(SEARCH,COUNT,FILTER,DATE,GENDER,RET) ;EP - Perform Lexicon Lookup
;
; SEARCH - The string to search on (Required)
; COUNT - The number of records to return (Optional) - Default 999
; FILTER - 0 - Regular Search - Filter out Cause of Injury Codes (Default)
; 1 - Cause of Injury Search - Return only Cause of Injury Codes
; 2 - Full Search - Return all results - no filtering
; DATE - The date to search on (default to today)
; GENDER - The patient gender (M/F/U) (Optional)
; RET - Return array
;
;Input checks
I $G(SEARCH)="" Q
S COUNT=$G(COUNT) S:'+COUNT COUNT=999
S FILTER=$G(FILTER) S:FILTER="" FILTER=0
S DATE=$G(DATE) S:DATE="" DATE=DT
S GENDER=$G(GENDER)
;
NEW ICD10,CSET,DIC,AUPNSEX,LEX,DELIMITER,DPLIST,TOTREC
;
K ^TMP("LEXSCH"),^TMP("LEXFND"),LEX("LIST")
;
;Set gender variable used in filtering call
S:($G(GENDER)]"") AUPNSEX=GENDER
;
;Determine if ICD-10 has been implemented
S ICD10=0 I $$VERSION^XPDUTL("AICD")>3.51,$$IMP^ICDEXA(30)'>DATE S ICD10=1
S CSET=$S(ICD10=0:"ICD",1:"10D")
;
D CONFIG^LEXSET(CSET,CSET,DATE)
;S DIC("S")="I $$ICDONE1^APCDAPOV(+Y,LEXVDT)"
;
;Choose the filter
S DIC("S")="I $$FILTER^AMERUTIL(+Y,LEXVDT,$G(ICD10),$G(FILTER))"
;
;Perform search
D LOOK^LEXA(SEARCH,$G(CSET),$G(COUNT),$G(CSET),$G(DATE))
;
;Determine the delimiter
S DELIMITER=$S(ICD10=0:"ICD-9-CM ",1:"ICD-10-CM ")
;
S TOTREC=0,LEX="0" F S LEX=$O(LEX("LIST",LEX)) Q:LEX="" D
. I '+LEX Q
. NEW CODE,LIEN,DIEN,DESC
. ;
. ;Get the code
. S CODE=$P($P(LEX("LIST",LEX),DELIMITER,2),")")
. ;
. ;Look for code in file 80
. I $$AICD() S ICD=$$ICDDX^ICDEX(CODE)
. E S ICD=$$ICDDX^ICDCODE(CODE)
. ;
. ;If cannot find, tack on a period
. I $P(ICD,U)="-1",CODE'["." D
.. S CODE=CODE_"."
.. I $$AICD() S ICD=$$ICDDX^ICDEX(CODE)
.. E S ICD=$$ICDDX^ICDCODE(CODE)
. ;
. ;Filter out duplicates
. I $D(DPLIST(CODE)) Q
. ;
. ;Quit if code not found
. I $P(ICD,U)="-1" Q
. ;
. ;Create entry to return
. S DIEN=$P(ICD,U) Q:DIEN=""
. S CODE=$P(ICD,U,2)
. S DESC=$P(ICD,U,4)
. S TOTREC=TOTREC+1,RET(TOTREC)=DIEN_U_CODE_U_DESC
. S DPLIST(CODE)=""
Q
;
;Filter on Cause of Injury
FILTER(ALEX,ALEXVDT,ICD10,FILTER) ;Filtering for Lexicon lookup
;
;Input parameters
; ALEX - IEN of file 757.01
; ALEXVDT - Date to use for screening by codes
; ICD10 - 1 - ICD10, 0 - ICD9
; FILTER - 0 - No Cause of Injury, 1 - Only Cause of Injury, 2 - All codes
;
NEW RETURN,APCDDATE
;
;Default to return
S RETURN=1
;
;For FILTER equal 2 - Return all
I $G(FILTER)=2 Q RETURN
;
;ICD9 - Filter 0
I FILTER=0,ICD10=0 D Q RETURN
. N ALEXICD
. S ALEXVDT=$S(+$G(ALEXVDT)>0:ALEXVDT,1:$$DT^XLFDT)
. S ALEX=$$ICDONE^LEXU(ALEX,ALEXVDT) I ALEX="" S RETURN="" Q
. S ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
. I $P(ALEXICD,"^",2)="INVALID CODE" S RETURN="" Q
. S APCDDATE=ALEXVDT
. I '$$CHK^AUPNSICD($P(ALEXICD,U,1)) S RETURN="" Q
;
;ICD10 - Filter 0
I FILTER=0,ICD10=1 D Q RETURN
. N ALEXICD
. S ALEX=$$ONE^LEXU(ALEX,ALEXVDT,"10D") I ALEX="" S RETURN="" Q
. S ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
. I $P(ALEXICD,"^",2)="INVALID CODE" S RETURN="" Q
. S APCDDATE=ALEXVDT
. I '$$CHK^AUPNSICD($P(ALEXICD,U,1)) S RETURN="" Q
;
;Both ICD9/ICD10 - Filter 1
I FILTER=1 D Q RETURN
. N ALEXICD,ALEVXDT,%
. S ALEX=$$ONE^LEXU(ALEX,ALEXVDT,$S(ICD10=1:"10D",1:"ICD")) I ALEX="" S RETURN="" Q
. S ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
. I $P(ALEXICD,"^",2)="INVALID CODE" S RETURN="" Q
. I '$$CHK^AMERUTIL($P(ALEXICD,U,1),ICD10,ALEXVDT) S RETURN="" Q
;
Q
;
CHK(Y,ICD10,ALEXVDT) ;EP - SCREEN NON CAUSE OF INJURY AND INACTIVE CODES
NEW A,I,%
I $G(DUZ("AG"))'="I" Q 1
S:ALEXVDT="" ALEXVDT=DT
S I=$S($G(ICD10)=0:1,1:30)
S %=$$ICDDX^AUPNVUTL(Y,ALEXVDT,"I") I 1
I $P(%,U,20)]"",$P(%,U,20)'=I Q 0 ;not correct coding system
S I="CHKDX"_I
G @I
;
CHKDX1 ;CODING SYSTEM 1 - ICD9
;
;Only return E codes
I $E($P(%,U,2),1)'="E" Q 0
;
;Skip inactive codes
I '$P(%,U,10) Q 0 ;STATUS IS INACTIVE
;
;If 'USE WITH SEX' field has a value check that value against AUPNSEX
I '$D(AUPNSEX) Q 1
I $P(%,U,11)]"",$P(%,U,11)'=AUPNSEX Q 0
Q 1
;
CHKDX30 ;coding system 30 - ICD10
NEW RET
S RET=0
I $E($P(%,U,2),1)="V" S RET=1
I 'RET,$E($P(%,U,2),1)="W" S RET=1
I 'RET,$E($P(%,U,2),1)="X" S RET=1
I 'RET,$E($P(%,U,2),1)="Y" D
. NEW EXC
. S EXC=$E($P(%,U,2),1,3)
. ;
. ;Handle exceptions to the list
. I EXC'="Y92",EXC'="Y93" S RET=1
. S RET=0
;
I '$P(%,U,10) S RET=0 ;STATUS IS INACTIVE
;
;If 'USE WITH SEX' field has a value check that value against AUPNSEX
I '$D(AUPNSEX) Q RET
I $P(%,U,11)]"",$P(%,U,11)'=AUPNSEX S RET=0
Q RET
;
;Locations of screen handling options for device
HIN ;;7;;1;;1;;HI INTENSITY ON
HIF ;;7;;2;;2;;HI INTENSITY OFF
RVN ;;5;;4;;4;;REVERSE VIDEO ON
RVF ;;5;;5;;5;;REVERSE VIDEO OFF
ULN ;;6;;4;;4;;UNDERLINE ON
ULF ;;6;;5;;5;;UNDERLINE OFF
DTP ;;17;;1;;1;;DOUBLE HIGH TOP HALF
DTB ;;17;;2;;2;;DOUBLE HIGH BOTTOM HALF
BLN ;;5;;8;;8;;BLINK ON
BLF ;;5;;9;;9;;BLINK OFF
IOF ;;1;;2;;2;;FORM FEED/CLEAR SCREEN
10 ;;5;;1;;1;;TEN PITCH
12 ;;5;;2;;2;;TWELVE PITCH
16 ;;12.1;;1;;250;;SIXTEEN PITCH
AMERUTIL ;GDIT/HS/BEE - AMER UTILITY CALLS ; 07 Oct 2013 11:33 AM
+1 ;;3.0;ER VISIT SYSTEM;**6,7,8**;MAR 03, 2009;Build 23
+2 ;
+3 QUIT
+4 ;
POV(AUPNPAT,AMERPCC,AMERPOV) ;EP - Return a list of POV entries for a visit
+1 ;
+2 ;Pass in DFN or VIEN, plus array to return information in
+3 ;
+4 ;Returns list of POVs in the following format:
+5 ;AMERPOV(CNT)=[1]^[2]^[3]^[4]^[5]
+6 ;[1] - ICD code
+7 ;[2] - P-Primary, S-Secondary
+8 ;[3] - Provider Narrative
+9 ;[4] - IEN Pointer to file 80
+10 ;[5] - ICD Description Value
+11 ;[6] - V POV IEN
+12 ;[7] - Injury (Yes/No)
+13 ;
+14 ;Function returns: [1] # of POV entries on file in piece 1 ^[2] Primary POV entered
+15 ;
+16 ;Quit if no DFN or visit IEN passed in
+17 IF $GET(AUPNPAT)=""
IF $GET(AMERPCC)=""
QUIT "0"
+18 ;
+19 ;If Visit IEN is blank retrieve from ER ADMISSION file
+20 IF $GET(AMERPCC)=""
SET AMERPCC=$$GET1^DIQ(9009081,AUPNPAT,1.1,"I")
+21 IF AMERPCC=""
QUIT "0"
+22 ;
+23 ;Reset output array
+24 KILL AMERPOV
+25 ;
+26 NEW IEN,CNT,PRM
+27 ;
+28 ;Loop through the POVs for the visit
+29 SET (CNT,IEN,PRM)=0
FOR
SET IEN=$ORDER(^AUPNVPOV("AD",AMERPCC,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+30 NEW ICDIEN,VDATE,PS,ICDINFO,ICD,ICDDESC,PNAR,ICDV,INJ
+31 ;
+32 ;Get the narrative
+33 SET PNAR=$$GET1^DIQ(9000010.07,IEN,.04,"E")
+34 ;
+35 ;Get the ICD Information
+36 SET VDATE=$$FMTDATE($$GET1^DIQ(9000010,AMERPCC,.01,"I"))
+37 SET ICDIEN=+$$GET1^DIQ(9000010.07,IEN,.01,"I")
+38 IF $$AICD()
SET ICDINFO=$$ICDDX^ICDEX(ICDIEN,VDATE)
+39 IF '$TEST
SET ICDINFO=$$ICDDX^ICDCODE(ICDIEN,VDATE)
+40 SET ICD=$PIECE(ICDINFO,U,2)
IF ICD=""
QUIT
+41 ;
+42 ;Get the description
+43 SET ICDDESC=$PIECE(ICDINFO,U,4)
+44 ;
+45 ;Get primary/secondary
+46 SET PS=$$GET1^DIQ(9000010.07,IEN_",",.12,"I")
+47 IF PS=""
SET PS="S"
+48 ;AMER*3.0*7;Track if more than one Primary
+49 ;S:PS="P" PRM=1
+50 IF PS="P"
SET PRM=PRM+1
+51 ;
+52 ;Get whether an injury - Flag if injury date or cause of injury
+53 SET INJ="No"
+54 IF $$GET1^DIQ(9000010.07,IEN_",",.13,"I")
SET INJ="Yes"
+55 IF '$TEST
IF $$GET1^DIQ(9000010.07,IEN_",",.09,"I")
SET INJ="Yes"
+56 ;
+57 ;Set return entry
+58 SET CNT=CNT+1
+59 SET AMERPOV(CNT)=ICD_U_PS_U_PNAR_U_ICDIEN_U_ICDDESC_U_IEN_U_INJ
End DoDot:1
+60 ;
+61 QUIT CNT_U_PRM
+62 ;
AICD() ;EP - Return 1 if AICD 4.0
+1 QUIT $SELECT($$VERSION^XPDUTL("AICD")="4.0":1,1:0)
+2 ;
FMTDATE(X,TM) ;EP - Return formated date - Taken from BGOUTL
+1 IF 'X
QUIT ""
+2 NEW M,D,V
+3 SET M=$EXTRACT(X,4,5)
SET D=$EXTRACT(X,6,7)
SET V=$EXTRACT(X,1,3)+1700
+4 IF M&D
SET V=D_"/"_V
+5 IF M
SET V=M_"/"_V
+6 IF $GET(TM)
Begin DoDot:1
+7 SET X=X#1
+8 IF 'X
QUIT
+9 SET X=$TRANSLATE($JUSTIFY(X*10000\1,4),0)
+10 SET V=V_" "_$EXTRACT(X,1,2)_":"_$EXTRACT(X,3,4)
End DoDot:1
+11 QUIT V
+12 ;
S(X) ;EP - Screen formatting - Based on AGVDF
+1 NEW AMERM1,AMERMVDF
+2 SET AMERM1("X")=$X
+3 SET AMERM1("LN")=$TEXT(@X)
SET AMERM1(1)=$PIECE(AMERM1("LN"),";;",2)
SET AMERM1(2)=$PIECE(AMERM1("LN"),";;",3)
SET AMERM1(3)=$PIECE(AMERM1("LN"),";;",4)
+4 SET AMERMVDF(+IOST(0),X)=$PIECE($GET(^%ZIS(2,+IOST(0),AMERM1(1))),"^",AMERM1(2),AMERM1(3))
+5 IF AMERMVDF(+IOST(0),X)=""
SET AMERMVDF(+IOST(0),X)="*0"
+6 WRITE @AMERMVDF(+IOST(0),X)
+7 SET $X=AMERM1("X")
+8 SET X=""
+9 QUIT X
+10 ;
LEX(SEARCH,COUNT,FILTER,DATE,GENDER,RET) ;EP - Perform Lexicon Lookup
+1 ;
+2 ; SEARCH - The string to search on (Required)
+3 ; COUNT - The number of records to return (Optional) - Default 999
+4 ; FILTER - 0 - Regular Search - Filter out Cause of Injury Codes (Default)
+5 ; 1 - Cause of Injury Search - Return only Cause of Injury Codes
+6 ; 2 - Full Search - Return all results - no filtering
+7 ; DATE - The date to search on (default to today)
+8 ; GENDER - The patient gender (M/F/U) (Optional)
+9 ; RET - Return array
+10 ;
+11 ;Input checks
+12 IF $GET(SEARCH)=""
QUIT
+13 SET COUNT=$GET(COUNT)
IF '+COUNT
SET COUNT=999
+14 SET FILTER=$GET(FILTER)
IF FILTER=""
SET FILTER=0
+15 SET DATE=$GET(DATE)
IF DATE=""
SET DATE=DT
+16 SET GENDER=$GET(GENDER)
+17 ;
+18 NEW ICD10,CSET,DIC,AUPNSEX,LEX,DELIMITER,DPLIST,TOTREC
+19 ;
+20 KILL ^TMP("LEXSCH"),^TMP("LEXFND"),LEX("LIST")
+21 ;
+22 ;Set gender variable used in filtering call
+23 IF ($GET(GENDER)]"")
SET AUPNSEX=GENDER
+24 ;
+25 ;Determine if ICD-10 has been implemented
+26 SET ICD10=0
IF $$VERSION^XPDUTL("AICD")>3.51
IF $$IMP^ICDEXA(30)'>DATE
SET ICD10=1
+27 SET CSET=$SELECT(ICD10=0:"ICD",1:"10D")
+28 ;
+29 DO CONFIG^LEXSET(CSET,CSET,DATE)
+30 ;S DIC("S")="I $$ICDONE1^APCDAPOV(+Y,LEXVDT)"
+31 ;
+32 ;Choose the filter
+33 SET DIC("S")="I $$FILTER^AMERUTIL(+Y,LEXVDT,$G(ICD10),$G(FILTER))"
+34 ;
+35 ;Perform search
+36 DO LOOK^LEXA(SEARCH,$GET(CSET),$GET(COUNT),$GET(CSET),$GET(DATE))
+37 ;
+38 ;Determine the delimiter
+39 SET DELIMITER=$SELECT(ICD10=0:"ICD-9-CM ",1:"ICD-10-CM ")
+40 ;
+41 SET TOTREC=0
SET LEX="0"
FOR
SET LEX=$ORDER(LEX("LIST",LEX))
IF LEX=""
QUIT
Begin DoDot:1
+42 IF '+LEX
QUIT
+43 NEW CODE,LIEN,DIEN,DESC
+44 ;
+45 ;Get the code
+46 SET CODE=$PIECE($PIECE(LEX("LIST",LEX),DELIMITER,2),")")
+47 ;
+48 ;Look for code in file 80
+49 IF $$AICD()
SET ICD=$$ICDDX^ICDEX(CODE)
+50 IF '$TEST
SET ICD=$$ICDDX^ICDCODE(CODE)
+51 ;
+52 ;If cannot find, tack on a period
+53 IF $PIECE(ICD,U)="-1"
IF CODE'["."
Begin DoDot:2
+54 SET CODE=CODE_"."
+55 IF $$AICD()
SET ICD=$$ICDDX^ICDEX(CODE)
+56 IF '$TEST
SET ICD=$$ICDDX^ICDCODE(CODE)
End DoDot:2
+57 ;
+58 ;Filter out duplicates
+59 IF $DATA(DPLIST(CODE))
QUIT
+60 ;
+61 ;Quit if code not found
+62 IF $PIECE(ICD,U)="-1"
QUIT
+63 ;
+64 ;Create entry to return
+65 SET DIEN=$PIECE(ICD,U)
IF DIEN=""
QUIT
+66 SET CODE=$PIECE(ICD,U,2)
+67 SET DESC=$PIECE(ICD,U,4)
+68 SET TOTREC=TOTREC+1
SET RET(TOTREC)=DIEN_U_CODE_U_DESC
+69 SET DPLIST(CODE)=""
End DoDot:1
+70 QUIT
+71 ;
+72 ;Filter on Cause of Injury
FILTER(ALEX,ALEXVDT,ICD10,FILTER) ;Filtering for Lexicon lookup
+1 ;
+2 ;Input parameters
+3 ; ALEX - IEN of file 757.01
+4 ; ALEXVDT - Date to use for screening by codes
+5 ; ICD10 - 1 - ICD10, 0 - ICD9
+6 ; FILTER - 0 - No Cause of Injury, 1 - Only Cause of Injury, 2 - All codes
+7 ;
+8 NEW RETURN,APCDDATE
+9 ;
+10 ;Default to return
+11 SET RETURN=1
+12 ;
+13 ;For FILTER equal 2 - Return all
+14 IF $GET(FILTER)=2
QUIT RETURN
+15 ;
+16 ;ICD9 - Filter 0
+17 IF FILTER=0
IF ICD10=0
Begin DoDot:1
+18 NEW ALEXICD
+19 SET ALEXVDT=$SELECT(+$GET(ALEXVDT)>0:ALEXVDT,1:$$DT^XLFDT)
+20 SET ALEX=$$ICDONE^LEXU(ALEX,ALEXVDT)
IF ALEX=""
SET RETURN=""
QUIT
+21 SET ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
+22 IF $PIECE(ALEXICD,"^",2)="INVALID CODE"
SET RETURN=""
QUIT
+23 SET APCDDATE=ALEXVDT
+24 IF '$$CHK^AUPNSICD($PIECE(ALEXICD,U,1))
SET RETURN=""
QUIT
End DoDot:1
QUIT RETURN
+25 ;
+26 ;ICD10 - Filter 0
+27 IF FILTER=0
IF ICD10=1
Begin DoDot:1
+28 NEW ALEXICD
+29 SET ALEX=$$ONE^LEXU(ALEX,ALEXVDT,"10D")
IF ALEX=""
SET RETURN=""
QUIT
+30 SET ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
+31 IF $PIECE(ALEXICD,"^",2)="INVALID CODE"
SET RETURN=""
QUIT
+32 SET APCDDATE=ALEXVDT
+33 IF '$$CHK^AUPNSICD($PIECE(ALEXICD,U,1))
SET RETURN=""
QUIT
End DoDot:1
QUIT RETURN
+34 ;
+35 ;Both ICD9/ICD10 - Filter 1
+36 IF FILTER=1
Begin DoDot:1
+37 NEW ALEXICD,ALEVXDT,%
+38 SET ALEX=$$ONE^LEXU(ALEX,ALEXVDT,$SELECT(ICD10=1:"10D",1:"ICD"))
IF ALEX=""
SET RETURN=""
QUIT
+39 SET ALEXICD=$$ICDDX^AUPNVUTL(ALEX,ALEXVDT,"E")
+40 IF $PIECE(ALEXICD,"^",2)="INVALID CODE"
SET RETURN=""
QUIT
+41 IF '$$CHK^AMERUTIL($PIECE(ALEXICD,U,1),ICD10,ALEXVDT)
SET RETURN=""
QUIT
End DoDot:1
QUIT RETURN
+42 ;
+43 QUIT
+44 ;
CHK(Y,ICD10,ALEXVDT) ;EP - SCREEN NON CAUSE OF INJURY AND INACTIVE CODES
+1 NEW A,I,%
+2 IF $GET(DUZ("AG"))'="I"
QUIT 1
+3 IF ALEXVDT=""
SET ALEXVDT=DT
+4 SET I=$SELECT($GET(ICD10)=0:1,1:30)
+5 SET %=$$ICDDX^AUPNVUTL(Y,ALEXVDT,"I")
IF 1
+6 ;not correct coding system
IF $PIECE(%,U,20)]""
IF $PIECE(%,U,20)'=I
QUIT 0
+7 SET I="CHKDX"_I
+8 GOTO @I
+9 ;
CHKDX1 ;CODING SYSTEM 1 - ICD9
+1 ;
+2 ;Only return E codes
+3 IF $EXTRACT($PIECE(%,U,2),1)'="E"
QUIT 0
+4 ;
+5 ;Skip inactive codes
+6 ;STATUS IS INACTIVE
IF '$PIECE(%,U,10)
QUIT 0
+7 ;
+8 ;If 'USE WITH SEX' field has a value check that value against AUPNSEX
+9 IF '$DATA(AUPNSEX)
QUIT 1
+10 IF $PIECE(%,U,11)]""
IF $PIECE(%,U,11)'=AUPNSEX
QUIT 0
+11 QUIT 1
+12 ;
CHKDX30 ;coding system 30 - ICD10
+1 NEW RET
+2 SET RET=0
+3 IF $EXTRACT($PIECE(%,U,2),1)="V"
SET RET=1
+4 IF 'RET
IF $EXTRACT($PIECE(%,U,2),1)="W"
SET RET=1
+5 IF 'RET
IF $EXTRACT($PIECE(%,U,2),1)="X"
SET RET=1
+6 IF 'RET
IF $EXTRACT($PIECE(%,U,2),1)="Y"
Begin DoDot:1
+7 NEW EXC
+8 SET EXC=$EXTRACT($PIECE(%,U,2),1,3)
+9 ;
+10 ;Handle exceptions to the list
+11 IF EXC'="Y92"
IF EXC'="Y93"
SET RET=1
+12 SET RET=0
End DoDot:1
+13 ;
+14 ;STATUS IS INACTIVE
IF '$PIECE(%,U,10)
SET RET=0
+15 ;
+16 ;If 'USE WITH SEX' field has a value check that value against AUPNSEX
+17 IF '$DATA(AUPNSEX)
QUIT RET
+18 IF $PIECE(%,U,11)]""
IF $PIECE(%,U,11)'=AUPNSEX
SET RET=0
+19 QUIT RET
+20 ;
+21 ;Locations of screen handling options for device
HIN ;;7;;1;;1;;HI INTENSITY ON
HIF ;;7;;2;;2;;HI INTENSITY OFF
RVN ;;5;;4;;4;;REVERSE VIDEO ON
RVF ;;5;;5;;5;;REVERSE VIDEO OFF
ULN ;;6;;4;;4;;UNDERLINE ON
ULF ;;6;;5;;5;;UNDERLINE OFF
DTP ;;17;;1;;1;;DOUBLE HIGH TOP HALF
DTB ;;17;;2;;2;;DOUBLE HIGH BOTTOM HALF
BLN ;;5;;8;;8;;BLINK ON
BLF ;;5;;9;;9;;BLINK OFF
IOF ;;1;;2;;2;;FORM FEED/CLEAR SCREEN
10 ;;5;;1;;1;;TEN PITCH
12 ;;5;;2;;2;;TWELVE PITCH
16 ;;12.1;;1;;250;;SIXTEEN PITCH
