SROICDGT ;BIR/SJA - CODE SET VERSIONING UTILITY ;26 Sep 2013 3:39 PM
;;3.0;Surgery;**177**;24 Jun 93;Build 89
;
; Reference to $$SYS^ICDEX supported by DBIA #5747
;
GETAPI(SRAPP,TYPE,SRIEN) ;ICD-9/ICD-10 selection - called by input transform
; - INPUT: X := the initial user input to be searched on (REQUIRED)
; SRAPP := application name in file 130.4;.01 (REQUIRED)
; TYPE := type of call in file 130.4;.04 (REQUIRED)
; SRIEN := top level entry in file 130 (DA) used to get date to compute correct version (OPTIONAL but needs DA)
; Note: applications using this as an example will need to modify the code that uses this.
; - OUTPUT: X := the internal value to be stored in the field.
; Y := the internal value to be stored in the field
;
N DIC,DIE,SRDA,SRDT,ENTRY,SRCODE,SRVER,SRX,DTOUT,DUOUT,DIROUT,SRONECH
; JAS - Patch 177 - Next line - A value for Y was leaking into this API
K Y
I X=" " S X=$$SPACEBAR^SROICD("^ICD9(") I X=" " K X,Y Q
I X="?BAD" W ! S X="" Q
;
I X="@" K X Q
I '$L($G(SRAPP)) D MSG("The Application making the call was not specified.") K X Q
I '$L($G(TYPE)) D MSG("The Search Type (diagnosis or procedure) was not specified.") K X Q
I $L($G(X))>100!($L($G(X))<1) D MSG("Answer must be 1-100 characters in length.") K X Q
;
; -- next three lines are Surgery Specific
;
; - Note: X and SRDT are used inside the executed code
S SRDA=$S($G(SRIEN):SRIEN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(DA):DA,$D(D0):D0,$G(SRTN):SRTN,1:"")
I $G(^SRF($G(SRDA),0))="" D MSG("Entry in the Surgery file was not found.") K X Q
S SRDT=$S($G(SRDA):$P($P(^SRF(SRDA,0),"^",9),"."),1:DT) ; SRDT is used in executable code
;
N DA
S SRVER=$$SYS^ICDEX(TYPE,SRDT)
I SRVER'>0 D MSG("Could not acquire the correct ICD Version for '"_TYPE_"' on "_$$FMTE^XLFDT(SRDT)) K X Q
;
I X["?" D K X,Y Q
. N SRTAG S SRTAG=""
. I SRVER=30 S SRTAG=$S(X["???":"D3",X["??":"D2",X["?":"D1",1:"D1") D @SRTAG Q
. I SRVER=1 S SRTAG="Answer with ICD-9 DIAGNOSIS CODE NUMBER, or DESCRIPTION."
. N SRFORMAT S SRFORMAT=$S(X["??":"!?8",1:"!?5")
. D EN^DDIOL(SRTAG,"",SRFORMAT)
. Q
I SRVER=30,X="*" S X=""
;
I SRVER=30,$L(X)<2 D K X,Y S SRONECH=1 Q
. D EN^DDIOL("Please enter at least the first two characters of the ICD-10","","!!?5")
. D EN^DDIOL("code or code description to start the search.","","!?5")
. D EN^DDIOL(" ")
. Q
;
S ENTRY=$O(^DIC(130.4,"C",SRAPP,TYPE,SRVER,0))
I ENTRY'>0 D MSG("Search Entry in ICD SEARCH API file for application '"_SRAPP_"' of type '"_TYPE_"' for Version '"_SRVER_"' is missing.") K X Q
S SRCODE=$G(^DIC(130.4,ENTRY,1))
I '$L(SRCODE) D MSG("No Executable Code found for a ICD code search for type '"_TYPE_"'.") K X Q
I $L(SRCODE) X SRCODE
I SRVER=1 D
. I $D(Y(0,1)) W " ",$P(Y(0,1),U,2)," ICD-9 ",$P(Y(0,1),U,4)
I $G(Y)>0 S X=+Y Q
K X,Y
Q
MSG(SRTEXT) ;
D EN^DDIOL(SRTEXT)
Q
;
D1 ; -- Diagnosis ? Help
Q:$G(SRONECH)
Q:X="?BAD"
I X["???" D D3 Q ;For calls from ^DIR, doesn't support ??? help
I X["??" D D2 Q
D EN^DDIOL("Enter code or ""text"" for more information.","","!?5")
D EN^DDIOL(" ")
Q
;
D2 ; -- Diagnosis ?? Help
D EN^DDIOL("Enter a ""free text"" term or part of a term such as ""femur fracture"".","","!?8")
D EN^DDIOL(" or","","!?8")
D EN^DDIOL("Enter a ""classification code"" (ICD/CPT, etc.) to find the single term","","!?8")
D EN^DDIOL("associated with the code","","!?8")
D EN^DDIOL(" or","","!?8")
D EN^DDIOL("Enter a ""partial code"". Include the decimal when a search criterion","","!?8")
D EN^DDIOL("includes 3 characters or more for code searches.","","!?8")
D EN^DDIOL(" ")
Q
;
D3 ; -- Diagnosis ??? Help
N SRHLP
S SRHLP(1)="Number of Code Matches"
S SRHLP(1,"F")="!?8"
S SRHLP(2)="----------------------"
S SRHLP(2,"F")="!?8"
S SRHLP(3)="The ICD-10 Diagnosis Code search will show the user the number of"
S SRHLP(3,"F")="!!?8"
S SRHLP(4)="matches found, indicate if additional characters in ICD code exist,"
S SRHLP(4,"F")="!?8"
S SRHLP(5)="and the number of codes within the category or subcategory that are"
S SRHLP(5,"F")="!?8"
S SRHLP(6)="available for selection. For example:"
S SRHLP(6,"F")="!?8"
S SRHLP(8)="19 matches found"
S SRHLP(8,"F")="!!?8"
S SRHLP(10)="M91. - Juvenile osteochondrosis of hip and pelvis (19)"
S SRHLP(10,"F")="!!?8"
S SRHLP(12)="This indicates that 19 unique matches or matching groups have been"
S SRHLP(12,"F")="!!?8"
S SRHLP(13)="found and will be displayed."
S SRHLP(13,"F")="!?8"
S SRHLP(15)="M91. - the ""-"" indicates that there are additional characters"
S SRHLP(15)="M91. - the ""-"" indicates that there are additional characters"
S SRHLP(15,"F")="!!?8"
S SRHLP(16)="that specify unique ICD-10 codes available."
S SRHLP(16,"F")="!?8"
S SRHLP(18)="(19) Indicates that there are 19 additional ICD-10 codes in the"
S SRHLP(18,"F")="!!?8"
S SRHLP(19)="M91 ""family"" that are possible selections."
S SRHLP(19,"F")="!?8"
D EN^DDIOL(.SRHLP)
Q
;
TR(X) ;
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q X
TEST ; -- test api calls
S X="003.1" D GETAPI^SROICDGT("SURG","DIAG",1)
Q
S X="F1" W !,"1" D GETAPI^SROICDGT(,"DIAG",1) ;no application
S X="F1" W !,"2" D GETAPI^SROICDGT("SURG",,1) ;no Type
S X="F1" W !,"3" D GETAPI^SROICDGT("SURG","DIAG",199999) ;no entry is Surgery file
S X="" W !,"4" D GETAPI^SROICDGT("SURG","DIAG",1) ;Answer too short
S X="aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
W !,"5" D GETAPI^SROICDGT("SURG","PROC",1) ;answer too long
S X="F1" W !,"6" D GETAPI^SROICDGT("SURG","DAIG",1) ; NO VERSION found
S X="F1" W !,"7" D GETAPI^SROICDGT("SUGR","DIAG",1) ; no entry for Daig
S X="F1" W !,"8" D GETAPI^SROICDGT("SURG","PROC",1) ;no executable code
;
S X="330" W !,"9 - SHOULD WORK" D GETAPI^SROICDGT("SURG","DIAG",1) ; This one is icd-9
S X="S62" W !,"10 - SHOULD WORK" D GETAPI^SROICDGT("SURG","DIAG",21) ; This one is icd-10
S X="COCAINE" W !,"11 - SHOULD WORK" D GETAPI^SROICDGT("SURG","DIAG",21) ; This one is icd-10
S X="fracture" W !,"12 - SHOULD WORK" D GETAPI^SROICDGT("SURG","DIAG",21) ; This one is icd-10
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROICDGT 6333 printed Apr 09, 2024@21:48:21 Page 2
SROICDGT ;BIR/SJA - CODE SET VERSIONING UTILITY ;26 Sep 2013 3:39 PM
+1 ;;3.0;Surgery;**177**;24 Jun 93;Build 89
+2 ;
+3 ; Reference to $$SYS^ICDEX supported by DBIA #5747
+4 ;
GETAPI(SRAPP,TYPE,SRIEN) ;ICD-9/ICD-10 selection - called by input transform
+1 ; - INPUT: X := the initial user input to be searched on (REQUIRED)
+2 ; SRAPP := application name in file 130.4;.01 (REQUIRED)
+3 ; TYPE := type of call in file 130.4;.04 (REQUIRED)
+4 ; SRIEN := top level entry in file 130 (DA) used to get date to compute correct version (OPTIONAL but needs DA)
+5 ; Note: applications using this as an example will need to modify the code that uses this.
+6 ; - OUTPUT: X := the internal value to be stored in the field.
+7 ; Y := the internal value to be stored in the field
+8 ;
+9 NEW DIC,DIE,SRDA,SRDT,ENTRY,SRCODE,SRVER,SRX,DTOUT,DUOUT,DIROUT,SRONECH
+10 ; JAS - Patch 177 - Next line - A value for Y was leaking into this API
+11 KILL Y
+12 IF X=" "
SET X=$$SPACEBAR^SROICD("^ICD9(")
IF X=" "
KILL X,Y
QUIT
+13 IF X="?BAD"
WRITE !
SET X=""
QUIT
+14 ;
+15 IF X="@"
KILL X
QUIT
+16 IF '$LENGTH($GET(SRAPP))
DO MSG("The Application making the call was not specified.")
KILL X
QUIT
+17 IF '$LENGTH($GET(TYPE))
DO MSG("The Search Type (diagnosis or procedure) was not specified.")
KILL X
QUIT
+18 IF $LENGTH($GET(X))>100!($LENGTH($GET(X))<1)
DO MSG("Answer must be 1-100 characters in length.")
KILL X
QUIT
+19 ;
+20 ; -- next three lines are Surgery Specific
+21 ;
+22 ; - Note: X and SRDT are used inside the executed code
+23 SET SRDA=$SELECT($GET(SRIEN):SRIEN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(DA):DA,$DATA(D0):D0,$GET(SRTN):SRTN,1:"")
+24 IF $GET(^SRF($GET(SRDA),0))=""
DO MSG("Entry in the Surgery file was not found.")
KILL X
QUIT
+25 ; SRDT is used in executable code
SET SRDT=$SELECT($GET(SRDA):$PIECE($PIECE(^SRF(SRDA,0),"^",9),"."),1:DT)
+26 ;
+27 NEW DA
+28 SET SRVER=$$SYS^ICDEX(TYPE,SRDT)
+29 IF SRVER'>0
DO MSG("Could not acquire the correct ICD Version for '"_TYPE_"' on "_$$FMTE^XLFDT(SRDT))
KILL X
QUIT
+30 ;
+31 IF X["?"
Begin DoDot:1
+32 NEW SRTAG
SET SRTAG=""
+33 IF SRVER=30
SET SRTAG=$SELECT(X["???":"D3",X["??":"D2",X["?":"D1",1:"D1")
DO @SRTAG
QUIT
+34 IF SRVER=1
SET SRTAG="Answer with ICD-9 DIAGNOSIS CODE NUMBER, or DESCRIPTION."
+35 NEW SRFORMAT
SET SRFORMAT=$SELECT(X["??":"!?8",1:"!?5")
+36 DO EN^DDIOL(SRTAG,"",SRFORMAT)
+37 QUIT
End DoDot:1
KILL X,Y
QUIT
+38 IF SRVER=30
IF X="*"
SET X=""
+39 ;
+40 IF SRVER=30
IF $LENGTH(X)<2
Begin DoDot:1
+41 DO EN^DDIOL("Please enter at least the first two characters of the ICD-10","","!!?5")
+42 DO EN^DDIOL("code or code description to start the search.","","!?5")
+43 DO EN^DDIOL(" ")
+44 QUIT
End DoDot:1
KILL X,Y
SET SRONECH=1
QUIT
+45 ;
+46 SET ENTRY=$ORDER(^DIC(130.4,"C",SRAPP,TYPE,SRVER,0))
+47 IF ENTRY'>0
DO MSG("Search Entry in ICD SEARCH API file for application '"_SRAPP_"' of type '"_TYPE_"' for Version '"_SRVER_"' is missing.")
KILL X
QUIT
+48 SET SRCODE=$GET(^DIC(130.4,ENTRY,1))
+49 IF '$LENGTH(SRCODE)
DO MSG("No Executable Code found for a ICD code search for type '"_TYPE_"'.")
KILL X
QUIT
+50 IF $LENGTH(SRCODE)
XECUTE SRCODE
+51 IF SRVER=1
Begin DoDot:1
+52 IF $DATA(Y(0,1))
WRITE " ",$PIECE(Y(0,1),U,2)," ICD-9 ",$PIECE(Y(0,1),U,4)
End DoDot:1
+53 IF $GET(Y)>0
SET X=+Y
QUIT
+54 KILL X,Y
+55 QUIT
MSG(SRTEXT) ;
+1 DO EN^DDIOL(SRTEXT)
+2 QUIT
+3 ;
D1 ; -- Diagnosis ? Help
+1 if $GET(SRONECH)
QUIT
+2 if X="?BAD"
QUIT
+3 ;For calls from ^DIR, doesn't support ??? help
IF X["???"
DO D3
QUIT
+4 IF X["??"
DO D2
QUIT
+5 DO EN^DDIOL("Enter code or ""text"" for more information.","","!?5")
+6 DO EN^DDIOL(" ")
+7 QUIT
+8 ;
D2 ; -- Diagnosis ?? Help
+1 DO EN^DDIOL("Enter a ""free text"" term or part of a term such as ""femur fracture"".","","!?8")
+2 DO EN^DDIOL(" or","","!?8")
+3 DO EN^DDIOL("Enter a ""classification code"" (ICD/CPT, etc.) to find the single term","","!?8")
+4 DO EN^DDIOL("associated with the code","","!?8")
+5 DO EN^DDIOL(" or","","!?8")
+6 DO EN^DDIOL("Enter a ""partial code"". Include the decimal when a search criterion","","!?8")
+7 DO EN^DDIOL("includes 3 characters or more for code searches.","","!?8")
+8 DO EN^DDIOL(" ")
+9 QUIT
+10 ;
D3 ; -- Diagnosis ??? Help
+1 NEW SRHLP
+2 SET SRHLP(1)="Number of Code Matches"
+3 SET SRHLP(1,"F")="!?8"
+4 SET SRHLP(2)="----------------------"
+5 SET SRHLP(2,"F")="!?8"
+6 SET SRHLP(3)="The ICD-10 Diagnosis Code search will show the user the number of"
+7 SET SRHLP(3,"F")="!!?8"
+8 SET SRHLP(4)="matches found, indicate if additional characters in ICD code exist,"
+9 SET SRHLP(4,"F")="!?8"
+10 SET SRHLP(5)="and the number of codes within the category or subcategory that are"
+11 SET SRHLP(5,"F")="!?8"
+12 SET SRHLP(6)="available for selection. For example:"
+13 SET SRHLP(6,"F")="!?8"
+14 SET SRHLP(8)="19 matches found"
+15 SET SRHLP(8,"F")="!!?8"
+16 SET SRHLP(10)="M91. - Juvenile osteochondrosis of hip and pelvis (19)"
+17 SET SRHLP(10,"F")="!!?8"
+18 SET SRHLP(12)="This indicates that 19 unique matches or matching groups have been"
+19 SET SRHLP(12,"F")="!!?8"
+20 SET SRHLP(13)="found and will be displayed."
+21 SET SRHLP(13,"F")="!?8"
+22 SET SRHLP(15)="M91. - the ""-"" indicates that there are additional characters"
+23 SET SRHLP(15)="M91. - the ""-"" indicates that there are additional characters"
+24 SET SRHLP(15,"F")="!!?8"
+25 SET SRHLP(16)="that specify unique ICD-10 codes available."
+26 SET SRHLP(16,"F")="!?8"
+27 SET SRHLP(18)="(19) Indicates that there are 19 additional ICD-10 codes in the"
+28 SET SRHLP(18,"F")="!!?8"
+29 SET SRHLP(19)="M91 ""family"" that are possible selections."
+30 SET SRHLP(19,"F")="!?8"
+31 DO EN^DDIOL(.SRHLP)
+32 QUIT
+33 ;
TR(X) ;
+1 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT X
TEST ; -- test api calls
+1 SET X="003.1"
DO GETAPI^SROICDGT("SURG","DIAG",1)
+2 QUIT
+3 ;no application
SET X="F1"
WRITE !,"1"
DO GETAPI^SROICDGT(,"DIAG",1)
+4 ;no Type
SET X="F1"
WRITE !,"2"
DO GETAPI^SROICDGT("SURG",,1)
+5 ;no entry is Surgery file
SET X="F1"
WRITE !,"3"
DO GETAPI^SROICDGT("SURG","DIAG",199999)
+6 ;Answer too short
SET X=""
WRITE !,"4"
DO GETAPI^SROICDGT("SURG","DIAG",1)
+7 SET X="aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+8 ;answer too long
WRITE !,"5"
DO GETAPI^SROICDGT("SURG","PROC",1)
+9 ; NO VERSION found
SET X="F1"
WRITE !,"6"
DO GETAPI^SROICDGT("SURG","DAIG",1)
+10 ; no entry for Daig
SET X="F1"
WRITE !,"7"
DO GETAPI^SROICDGT("SUGR","DIAG",1)
+11 ;no executable code
SET X="F1"
WRITE !,"8"
DO GETAPI^SROICDGT("SURG","PROC",1)
+12 ;
+13 ; This one is icd-9
SET X="330"
WRITE !,"9 - SHOULD WORK"
DO GETAPI^SROICDGT("SURG","DIAG",1)
+14 ; This one is icd-10
SET X="S62"
WRITE !,"10 - SHOULD WORK"
DO GETAPI^SROICDGT("SURG","DIAG",21)
+15 ; This one is icd-10
SET X="COCAINE"
WRITE !,"11 - SHOULD WORK"
DO GETAPI^SROICDGT("SURG","DIAG",21)
+16 ; This one is icd-10
SET X="fracture"
WRITE !,"12 - SHOULD WORK"
DO GETAPI^SROICDGT("SURG","DIAG",21)
+17 QUIT
