- SROICD ;BIR/SJA - CODE SET VERSIONING UTILITY ;27 Sep 2013 4:00 PM
- ;;3.0;Surgery;**116,127,177**;24 Jun 93;Build 89
- ;
- ; Reference to $$ICDDATA^ICDXCODE supported by DBIA #5699
- ; Reference to $$LS^ICDEX supported by DBIA #5747
- ; Reference to $$CODEC^ICDEX supported by DBIA #5747
- ; Reference to $$CODEN^ICDEX supported by DBIA #5747
- ; Reference to $$SYS^ICDEX supported by DBIA #5747
- ; Reference to $$VST^ICDEX supported by DBIA #5747
- ; Reference to $$SEARCH^ICDSAPI supported by DBIA #5757
- ; Reference to $$DIAGSRCH^LEX10CS supported by DBIA #5681
- ; Reference to $$IMPDATE^LEXU supported by DBIA #5679
- ; Reference to $$FREQ^LEXU supported by DBIA #5679
- ; Reference to $$MAX^LEXU supported by DBIA #5679
- ;
- ICDVST(SRCODE) ; Output Short Description, called from SRCUSS
- ; -- Input SRCODE in external code (e.g. "100.0" or "H54.0"
- N SRIEN,SRVST
- S SRIEN=+$$CODEN^ICDEX($G(SRCODE),80)
- I SRIEN<1 Q ""
- S SRVST=$$VST^ICDEX(80,SRIEN)
- Q SRVST
- ICDC(SRCODE) ; output principal ICD
- N SRC,SRSDATE,SRDA
- I $D(SRCODE),SRCODE="" Q
- S SRDA=$S($G(SRIEN):SRIEN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:"")
- S SRC=$$ICD(SRDA,SRCODE)
- Q $P(SRC,"^",2,4)
- ;
- ICD(SRIEN,SRC) ;
- N SRSYS,SRICD,SRDATE
- S SRDATE=$P($P($G(^SRF(SRIEN,0)),"^",9),".")
- S SRSYS=$$ICDSYS(SRDATE)
- S SRICD=$$ICDDATA^ICDXCODE(SRSYS,SRC,SRDATE,"I")
- Q SRICD
- ;
- ICDSYS(SRDT,SRICDTYP) ; determine ICD coding system
- ; If date of interest is null, today's date will be assumed
- ; If SRICDTYP is null, Diagnosis is assumed for code type
- N SRSYS,SRIMPDT
- S SRDT=$S($G(SRDT):$P(SRDT,"."),1:DT)
- S SRIMPDT=$$IMPDATE("10D")
- ; JAS - 06/12/13 - PATCH 177 - Modified ICD-9 to return proper 3 character coding system abbrev.
- S SRSYS=$S(SRDT'<SRIMPDT:"10D",1:"ICD")
- I $G(SRICDTYP)="DIAG" S SRSYS=$S(SRSYS="10D":"10D",1:"ICD")
- I $G(SRICDTYP)="PROC" S SRSYS=$S(SRSYS="10D":"10P",1:"ICP")
- ; END 177
- Q SRSYS
- ;
- ICDSTR(SRIEN) ; return either "(ICD9)" or "(ICD10)" string
- N SRDT,SRSYS
- S SRDT=$P($P($G(^SRF(SRIEN,0)),"^",9),"."),SRDT=$S($G(SRDT):SRDT,1:DT)
- S SRSYS=$$ICDSYS(SRDT),SRSYS=$S(SRSYS="10D":"(ICD10)",1:"(ICD9)")
- Q SRSYS
- ;
- ICD910(SRIEN) ; return either "9" or "10"
- N SRDT,SRSYS
- S SRDT=$P($P($G(^SRF(SRIEN,0)),"^",9),"."),SRDT=$S($G(SRDT):SRDT,1:DT)
- S SRSYS=$$ICDSYS(SRDT),SRSYS=$S(SRSYS="10D":"10",1:"9")
- Q SRSYS
- IMPDATE(SRCODSYS) ; a wrapper for IMPDATE API
- Q $$IMPDATE^LEXU(SRCODSYS)
- ;
- P80 ;No longer Used. ICD-9/ICD-10 diagnosis selection - called by input transform
- N DIC,SRDA,SRDT,SRSYS
- S SRDA=$S($G(SRIEN):SRIEN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:"") I 'SRDA K X Q
- S SRDT=$S($G(SRDA):$P($P(^SRF(SRDA,0),"^",9),"."),1:DT),SRSYS=$$ICDSYS(SRDT)
- I $L(X)>100!($L(X)<1) K X Q
- I SRSYS["10" S SRTXT=X D LEX Q
- S Y=$$SEARCH^ICDSAPI("DIAG",("I $$LS^ICDEX(80,+Y,"""_SRDT_""")=1"),"QEMZ",SRDT) S:Y>0 X=+Y
- I Y'>0 S X="" Q
- Q
- ASKOK(SRTOTAL) ;
- ; -- See default setting of SRASK at LEX+8
- I $G(SRASK)=1 D Q
- . D EN^DDIOL("A total of "_$G(SRTOTAL)_" Entries found for this search.","","!!")
- . D EN^DDIOL("Please refine your Search!")
- . D EN^DDIOL(" ")
- . H 3 S SROK=0
- . Q
- ;
- I $G(SRASK)=2 D Q
- . W !!,"Searching for """_SRICDTXT_""" requires inspecting "_$G(SRTOTAL)_" records to determine"
- . W !,"if they match the search criteria. This could take quite some time. Suggest"
- . W !,"refining the search by further specifying """_SRICDTXT_""".",!
- . ;
- . N DIR,X,Y
- . S DIR(0)="Y",DIR("A")="Do you wish to continue (Y/N)"
- . S DIR("B")="No"
- . S DIR("?")="Answer 'Y' for 'Yes' to continue searching on "_SRICDTXT_" or 'N' for 'No' to refine search criteria."
- . D ^DIR
- . I $D(DIROUT)!($D(DIRUT))!($D(DTOUT))!($D(DTOUT)) S SROK=0 Q
- . S SROK=Y
- . I SROK=1 W !," Searching...."
- . W !
- Q
- LEX N %DT,DIROUT,DUOUT,DTOUT,SREXIT,SRICDDT,SRICDTXT,SRICDUP,SRICDY,XX,SRTOT,SROK,SRZZONE
- ; Begin Recursive Loop
- S SRICDTXT=$G(X) Q:'$L(SRICDTXT)
- ; RBD - 10/15/13 - PATCH 177 - Spacebar search functionality added.
- I SRICDTXT=" " S SRICDTXT=$$SPACEBAR("^ICD9(") I SRICDTXT=" " K SRICDY G LOOK2
- ; End 177
- I $L(SRICDTXT)<2 D S X="" 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:'$G(SRASK) SRASK=2
- S SRTOT=$$FREQ^LEXU(SRICDTXT) ;IA 5679
- I SRTOT>$$MAX^LEXU(30) D ASKOK(SRTOT) Q:'$G(SROK)
- S SRICDDT=$G(SRDT),SREXIT=0
- K SRASK,SROK
- LOOK ; Lookup
- Q:+($G(SREXIT))>0 K SRICDY
- S SRICDY=$$DIAGSRCH^LEX10CS(SRICDTXT,.SRICDY,SRICDDT,30)
- S:$O(SRICDY(" "),-1)>0 SRICDY=+SRICDY
- ; RBD - 10/15/13 - PATCH 177 - LOOK2 label added for Spacebar logic
- LOOK2 I +SRICDY'>0 D K X,Y Q
- . D EN^DDIOL("No records found matching the value entered, revise search or enter ""?""","","!?5")
- . D EN^DDIOL("for help.","","!?5")
- . D EN^DDIOL(" ","","!?4")
- . Q
- ; RBD - 10/15/13 - PATCH 177 - 8 items at a time changed to 4
- S XX=$$SEL^SROICDL(.SRICDY,4)
- ; End 177
- I $D(DUOUT)&('$D(DIROUT)) K:'$D(SRICDNT) X Q
- I $D(DTOUT)&('$D(DIROUT)) S SREXIT=1 K X Q
- I $D(DIROUT) S SREXIT=1 K X Q
- ; Abort if timed out or user enters "^^"
- I $D(DTOUT)!($D(DIROUT)) S SREXIT=1 K X Q
- ; Up one level (SRICDUP) if user enters "^"
- ; Quit if already at top level and user enters "^"
- I $D(DUOUT),'$D(DIROUT),$L($G(SRICDUP)) K X Q
- ; No Selection
- I '$D(DUOUT),XX=-1 S SREXIT=1
- ; Code Found and Selected
- I $P(XX,";")'="99:CAT" S Y=+$$ICDDATA^ICDXCODE("10D",$P($P(XX,"^"),";",2)) S SREXIT=1 D Q
- . ; RBD - 10/15/13 - PATCH 177 - Spacebar logic added.
- . D SAVSPACE("^ICD9(",Y)
- . ; End 177
- . ;CHOOSE 1-5: 1 003.0 ICD-9 003.0 SALMONELLA ENTERITIS (C/C)
- . W:'$D(SRZZONE) " ",$P(XX,";",2)," ICD-10 ",$$VST^ICDEX(80,Y)
- ; Category Found and Selected
- D NXT G:+($G(SREXIT))'>0 LOOK
- Q
- NXT ; Next
- Q:+($G(SREXIT))>0 N SRICDNT,SRICDND,SRICDX
- S SRICDNT=$G(SRICDTXT),SRICDND=$G(SRICDDT),SRICDX=$G(XX)
- N SRICDTXT,SRICDDT S SRICDTXT=$P($P(SRICDX,"^"),";",2),SRICDDT=SRICDND
- G LOOK
- Q
- ; RBD - 10/15/13 - PATCH 177 - Spacebar save & retrieval APIs added
- ; retrieves the last code selected by the user - space bar recall
- ; logic here
- SPACEBAR(SRROOT) ;
- N SRICDIEN,SRRTV
- S SRRTV=" " I SRROOT="^ICD9(" D
- . S SRICDIEN=$G(^DISV(DUZ,SRROOT)) ; subscription to ICR #510
- . I $L(SRICDIEN) S SRRTV=$$CODEC^ICDEX(80,SRICDIEN)
- Q SRRTV
- ;
- ; store the selected code for the space bar recall feature above
- SAVSPACE(SRROOT,SRRETV) ;
- I +$G(DUZ)=0 Q
- ; Subscription to ICD #510 needed for call to RECALL API below
- I SRROOT="^ICD9(" D RECALL^DILFD(80,SRRETV_",",+DUZ) Q
- Q
- ;
- ; End 177
- OUT(SRICDC) ; called by output transform fields of the ICD diagnosis code fields
- N SRDA,SRDT,SRY
- ;JAS - 5/31/13 - PATCH 177 - Rewrote the following line since it was grabbing the wrong ien.
- S SRDA=$S($G(SRIEN):SRIEN,$G(SRTN):SRTN,$D(DA(1)):DA(1),$D(D0):D0,1:"")
- S SRDT=$P($P($G(^SRF(SRDA,0)),"^",9),".")
- ;JAS - 4/18/13 - PATCH 177 - Either internal or external value could be passed in, so made changes to handle that
- I SRICDC?1N.N S SRY=$$ICDDATA^ICDXCODE("DIAG",SRICDC,SRDT,"I")
- E S SRY=$$ICDDATA^ICDXCODE("DIAG",SRICDC,SRDT,"E")
- ;End 177
- Q $P(SRY,"^",2)
- ;
- SCRN(SRCODE) ;screen for active ICD codes
- N SRSTAT,SRDA,SRDT
- S SRDA=$S($G(SRIEN):SRIEN,$D(DA(2)):DA(2),$D(DA(1)):DA(1),$D(D0):D0,1:"")
- S SRDT=$S($G(SRDA):$P($P(^SRF(SRDA,0),"^",9),"."),1:DT)
- S SRSTAT=$$LS^ICDEX(80,SRCODE,SRDT)
- Q $S(SRSTAT<1:0,1:1)
- ;
- ICDSRCH ; To handle ICD ICD-9/10 Diagnosis Code Searches when ^DIC or ^DIE cannot be used
- ; SRPRMT - For specific label, this field needs to be set from calling routine
- ; SRDEF - For displaying the default field value at diagnosis prompt
- ; X & Y variables need to be newed prior to calling this tag
- I $G(SRPRMT)="" S SRPRMT=" Select ICD Diagnosis "
- N SRDT,SRSYS
- S SRDT=$P($P($G(^SRF(SRTN,0)),"^",9),"."),SRDT=$S($G(SRDT):SRDT,1:DT),SRSYS=$$SYS^ICDEX("DIAG",SRDT)
- W !!,SRPRMT_$$ICDSTR^SROICD(SRTN)_": "_$S($G(SRDEF)'="":SRDEF_"// ",1:"") R X:DTIME
- I X="",$G(SRDEF)'="" S X=SRDEF
- ; RBD - 10/15/13 - PATCH 177 - Needs to Quit when X Null also
- I (X="")!(X="^")!(X="@") Q
- ; End 177
- I X["?" D K X,Y G ICDSRCH
- .N SRTAG,SRFMT S SRTAG=""
- .I SRSYS=30 S SRTAG=$S(X["???":"D3^SROICDGT",X["??":"D2^SROICDGT",X["?":"D1^SROICDGT",1:"D1^SROICDGT") D @SRTAG Q
- .I SRSYS=1 S SRTAG="Answer with ICD-9 DIAGNOSIS CODE NUMBER, or DESCRIPTION."
- .S SRFMT=$S(X["??":"!?8",1:"!?5")
- .D EN^DDIOL(SRTAG,"",SRFMT)
- .Q
- I SRSYS=1 S Y=$$SEARCH^ICDSAPI("DIAG","","QEMZ",SRDT)
- E D LEX^SROICD
- ;JAS - 11/07/13 - PATCH 177 - Need to Kill Y too prior to returning to ICDSRCH
- I $G(Y)'>0!($G(Y)="") D K X,Y G ICDSRCH
- .I SRSYS=1 W !,?6,"Enter the ICD Diagnosis code for the principal postoperative diagnosis.",!,?6,"Screen prevents selection of inactive diagnosis."
- K SRPRMT,SRDEF
- Q
- ;
- TEST1 ;
- ; do not ask question
- S SRASK=1
- S X="FRACTURE",SRDT=3150101 D LEX
- Q
- TEST2 ;
- ; ask question
- S SRASK=2
- S X="FRACTURE",SRDT=3150101 D LEX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROICD 9047 printed Jan 18, 2025@03:45:03 Page 2
- SROICD ;BIR/SJA - CODE SET VERSIONING UTILITY ;27 Sep 2013 4:00 PM
- +1 ;;3.0;Surgery;**116,127,177**;24 Jun 93;Build 89
- +2 ;
- +3 ; Reference to $$ICDDATA^ICDXCODE supported by DBIA #5699
- +4 ; Reference to $$LS^ICDEX supported by DBIA #5747
- +5 ; Reference to $$CODEC^ICDEX supported by DBIA #5747
- +6 ; Reference to $$CODEN^ICDEX supported by DBIA #5747
- +7 ; Reference to $$SYS^ICDEX supported by DBIA #5747
- +8 ; Reference to $$VST^ICDEX supported by DBIA #5747
- +9 ; Reference to $$SEARCH^ICDSAPI supported by DBIA #5757
- +10 ; Reference to $$DIAGSRCH^LEX10CS supported by DBIA #5681
- +11 ; Reference to $$IMPDATE^LEXU supported by DBIA #5679
- +12 ; Reference to $$FREQ^LEXU supported by DBIA #5679
- +13 ; Reference to $$MAX^LEXU supported by DBIA #5679
- +14 ;
- ICDVST(SRCODE) ; Output Short Description, called from SRCUSS
- +1 ; -- Input SRCODE in external code (e.g. "100.0" or "H54.0"
- +2 NEW SRIEN,SRVST
- +3 SET SRIEN=+$$CODEN^ICDEX($GET(SRCODE),80)
- +4 IF SRIEN<1
- QUIT ""
- +5 SET SRVST=$$VST^ICDEX(80,SRIEN)
- +6 QUIT SRVST
- ICDC(SRCODE) ; output principal ICD
- +1 NEW SRC,SRSDATE,SRDA
- +2 IF $DATA(SRCODE)
- IF SRCODE=""
- QUIT
- +3 SET SRDA=$SELECT($GET(SRIEN):SRIEN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")
- +4 SET SRC=$$ICD(SRDA,SRCODE)
- +5 QUIT $PIECE(SRC,"^",2,4)
- +6 ;
- ICD(SRIEN,SRC) ;
- +1 NEW SRSYS,SRICD,SRDATE
- +2 SET SRDATE=$PIECE($PIECE($GET(^SRF(SRIEN,0)),"^",9),".")
- +3 SET SRSYS=$$ICDSYS(SRDATE)
- +4 SET SRICD=$$ICDDATA^ICDXCODE(SRSYS,SRC,SRDATE,"I")
- +5 QUIT SRICD
- +6 ;
- ICDSYS(SRDT,SRICDTYP) ; determine ICD coding system
- +1 ; If date of interest is null, today's date will be assumed
- +2 ; If SRICDTYP is null, Diagnosis is assumed for code type
- +3 NEW SRSYS,SRIMPDT
- +4 SET SRDT=$SELECT($GET(SRDT):$PIECE(SRDT,"."),1:DT)
- +5 SET SRIMPDT=$$IMPDATE("10D")
- +6 ; JAS - 06/12/13 - PATCH 177 - Modified ICD-9 to return proper 3 character coding system abbrev.
- +7 SET SRSYS=$SELECT(SRDT'<SRIMPDT:"10D",1:"ICD")
- +8 IF $GET(SRICDTYP)="DIAG"
- SET SRSYS=$SELECT(SRSYS="10D":"10D",1:"ICD")
- +9 IF $GET(SRICDTYP)="PROC"
- SET SRSYS=$SELECT(SRSYS="10D":"10P",1:"ICP")
- +10 ; END 177
- +11 QUIT SRSYS
- +12 ;
- ICDSTR(SRIEN) ; return either "(ICD9)" or "(ICD10)" string
- +1 NEW SRDT,SRSYS
- +2 SET SRDT=$PIECE($PIECE($GET(^SRF(SRIEN,0)),"^",9),".")
- SET SRDT=$SELECT($GET(SRDT):SRDT,1:DT)
- +3 SET SRSYS=$$ICDSYS(SRDT)
- SET SRSYS=$SELECT(SRSYS="10D":"(ICD10)",1:"(ICD9)")
- +4 QUIT SRSYS
- +5 ;
- ICD910(SRIEN) ; return either "9" or "10"
- +1 NEW SRDT,SRSYS
- +2 SET SRDT=$PIECE($PIECE($GET(^SRF(SRIEN,0)),"^",9),".")
- SET SRDT=$SELECT($GET(SRDT):SRDT,1:DT)
- +3 SET SRSYS=$$ICDSYS(SRDT)
- SET SRSYS=$SELECT(SRSYS="10D":"10",1:"9")
- +4 QUIT SRSYS
- IMPDATE(SRCODSYS) ; a wrapper for IMPDATE API
- +1 QUIT $$IMPDATE^LEXU(SRCODSYS)
- +2 ;
- P80 ;No longer Used. ICD-9/ICD-10 diagnosis selection - called by input transform
- +1 NEW DIC,SRDA,SRDT,SRSYS
- +2 SET SRDA=$SELECT($GET(SRIEN):SRIEN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")
- IF 'SRDA
- KILL X
- QUIT
- +3 SET SRDT=$SELECT($GET(SRDA):$PIECE($PIECE(^SRF(SRDA,0),"^",9),"."),1:DT)
- SET SRSYS=$$ICDSYS(SRDT)
- +4 IF $LENGTH(X)>100!($LENGTH(X)<1)
- KILL X
- QUIT
- +5 IF SRSYS["10"
- SET SRTXT=X
- DO LEX
- QUIT
- +6 SET Y=$$SEARCH^ICDSAPI("DIAG",("I $$LS^ICDEX(80,+Y,"""_SRDT_""")=1"),"QEMZ",SRDT)
- if Y>0
- SET X=+Y
- +7 IF Y'>0
- SET X=""
- QUIT
- +8 QUIT
- ASKOK(SRTOTAL) ;
- +1 ; -- See default setting of SRASK at LEX+8
- +2 IF $GET(SRASK)=1
- Begin DoDot:1
- +3 DO EN^DDIOL("A total of "_$GET(SRTOTAL)_" Entries found for this search.","","!!")
- +4 DO EN^DDIOL("Please refine your Search!")
- +5 DO EN^DDIOL(" ")
- +6 HANG 3
- SET SROK=0
- +7 QUIT
- End DoDot:1
- QUIT
- +8 ;
- +9 IF $GET(SRASK)=2
- Begin DoDot:1
- +10 WRITE !!,"Searching for """_SRICDTXT_""" requires inspecting "_$GET(SRTOTAL)_" records to determine"
- +11 WRITE !,"if they match the search criteria. This could take quite some time. Suggest"
- +12 WRITE !,"refining the search by further specifying """_SRICDTXT_""".",!
- +13 ;
- +14 NEW DIR,X,Y
- +15 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to continue (Y/N)"
- +16 SET DIR("B")="No"
- +17 SET DIR("?")="Answer 'Y' for 'Yes' to continue searching on "_SRICDTXT_" or 'N' for 'No' to refine search criteria."
- +18 DO ^DIR
- +19 IF $DATA(DIROUT)!($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DTOUT))
- SET SROK=0
- QUIT
- +20 SET SROK=Y
- +21 IF SROK=1
- WRITE !," Searching...."
- +22 WRITE !
- End DoDot:1
- QUIT
- +23 QUIT
- LEX NEW %DT,DIROUT,DUOUT,DTOUT,SREXIT,SRICDDT,SRICDTXT,SRICDUP,SRICDY,XX,SRTOT,SROK,SRZZONE
- +1 ; Begin Recursive Loop
- +2 SET SRICDTXT=$GET(X)
- if '$LENGTH(SRICDTXT)
- QUIT
- +3 ; RBD - 10/15/13 - PATCH 177 - Spacebar search functionality added.
- +4 IF SRICDTXT=" "
- SET SRICDTXT=$$SPACEBAR("^ICD9(")
- IF SRICDTXT=" "
- KILL SRICDY
- GOTO LOOK2
- +5 ; End 177
- +6 IF $LENGTH(SRICDTXT)<2
- Begin DoDot:1
- +7 DO EN^DDIOL("Please enter at least the first two characters of the ICD-10","","!!?5")
- +8 DO EN^DDIOL("code or code description to start the search.","","!?5")
- +9 DO EN^DDIOL(" ")
- +10 QUIT
- End DoDot:1
- SET X=""
- QUIT
- +11 if '$GET(SRASK)
- SET SRASK=2
- +12 ;IA 5679
- SET SRTOT=$$FREQ^LEXU(SRICDTXT)
- +13 IF SRTOT>$$MAX^LEXU(30)
- DO ASKOK(SRTOT)
- if '$GET(SROK)
- QUIT
- +14 SET SRICDDT=$GET(SRDT)
- SET SREXIT=0
- +15 KILL SRASK,SROK
- LOOK ; Lookup
- +1 if +($GET(SREXIT))>0
- QUIT
- KILL SRICDY
- +2 SET SRICDY=$$DIAGSRCH^LEX10CS(SRICDTXT,.SRICDY,SRICDDT,30)
- +3 if $ORDER(SRICDY(" "),-1)>0
- SET SRICDY=+SRICDY
- +4 ; RBD - 10/15/13 - PATCH 177 - LOOK2 label added for Spacebar logic
- LOOK2 IF +SRICDY'>0
- Begin DoDot:1
- +1 DO EN^DDIOL("No records found matching the value entered, revise search or enter ""?""","","!?5")
- +2 DO EN^DDIOL("for help.","","!?5")
- +3 DO EN^DDIOL(" ","","!?4")
- +4 QUIT
- End DoDot:1
- KILL X,Y
- QUIT
- +5 ; RBD - 10/15/13 - PATCH 177 - 8 items at a time changed to 4
- +6 SET XX=$$SEL^SROICDL(.SRICDY,4)
- +7 ; End 177
- +8 IF $DATA(DUOUT)&('$DATA(DIROUT))
- if '$DATA(SRICDNT)
- KILL X
- QUIT
- +9 IF $DATA(DTOUT)&('$DATA(DIROUT))
- SET SREXIT=1
- KILL X
- QUIT
- +10 IF $DATA(DIROUT)
- SET SREXIT=1
- KILL X
- QUIT
- +11 ; Abort if timed out or user enters "^^"
- +12 IF $DATA(DTOUT)!($DATA(DIROUT))
- SET SREXIT=1
- KILL X
- QUIT
- +13 ; Up one level (SRICDUP) if user enters "^"
- +14 ; Quit if already at top level and user enters "^"
- +15 IF $DATA(DUOUT)
- IF '$DATA(DIROUT)
- IF $LENGTH($GET(SRICDUP))
- KILL X
- QUIT
- +16 ; No Selection
- +17 IF '$DATA(DUOUT)
- IF XX=-1
- SET SREXIT=1
- +18 ; Code Found and Selected
- +19 IF $PIECE(XX,";")'="99:CAT"
- SET Y=+$$ICDDATA^ICDXCODE("10D",$PIECE($PIECE(XX,"^"),";",2))
- SET SREXIT=1
- Begin DoDot:1
- +20 ; RBD - 10/15/13 - PATCH 177 - Spacebar logic added.
- +21 DO SAVSPACE("^ICD9(",Y)
- +22 ; End 177
- +23 ;CHOOSE 1-5: 1 003.0 ICD-9 003.0 SALMONELLA ENTERITIS (C/C)
- +24 if '$DATA(SRZZONE)
- WRITE " ",$PIECE(XX,";",2)," ICD-10 ",$$VST^ICDEX(80,Y)
- End DoDot:1
- QUIT
- +25 ; Category Found and Selected
- +26 DO NXT
- if +($GET(SREXIT))'>0
- GOTO LOOK
- +27 QUIT
- NXT ; Next
- +1 if +($GET(SREXIT))>0
- QUIT
- NEW SRICDNT,SRICDND,SRICDX
- +2 SET SRICDNT=$GET(SRICDTXT)
- SET SRICDND=$GET(SRICDDT)
- SET SRICDX=$GET(XX)
- +3 NEW SRICDTXT,SRICDDT
- SET SRICDTXT=$PIECE($PIECE(SRICDX,"^"),";",2)
- SET SRICDDT=SRICDND
- +4 GOTO LOOK
- +5 QUIT
- +6 ; RBD - 10/15/13 - PATCH 177 - Spacebar save & retrieval APIs added
- +7 ; retrieves the last code selected by the user - space bar recall
- +8 ; logic here
- SPACEBAR(SRROOT) ;
- +1 NEW SRICDIEN,SRRTV
- +2 SET SRRTV=" "
- IF SRROOT="^ICD9("
- Begin DoDot:1
- +3 ; subscription to ICR #510
- SET SRICDIEN=$GET(^DISV(DUZ,SRROOT))
- +4 IF $LENGTH(SRICDIEN)
- SET SRRTV=$$CODEC^ICDEX(80,SRICDIEN)
- End DoDot:1
- +5 QUIT SRRTV
- +6 ;
- +7 ; store the selected code for the space bar recall feature above
- SAVSPACE(SRROOT,SRRETV) ;
- +1 IF +$GET(DUZ)=0
- QUIT
- +2 ; Subscription to ICD #510 needed for call to RECALL API below
- +3 IF SRROOT="^ICD9("
- DO RECALL^DILFD(80,SRRETV_",",+DUZ)
- QUIT
- +4 QUIT
- +5 ;
- +6 ; End 177
- OUT(SRICDC) ; called by output transform fields of the ICD diagnosis code fields
- +1 NEW SRDA,SRDT,SRY
- +2 ;JAS - 5/31/13 - PATCH 177 - Rewrote the following line since it was grabbing the wrong ien.
- +3 SET SRDA=$SELECT($GET(SRIEN):SRIEN,$GET(SRTN):SRTN,$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")
- +4 SET SRDT=$PIECE($PIECE($GET(^SRF(SRDA,0)),"^",9),".")
- +5 ;JAS - 4/18/13 - PATCH 177 - Either internal or external value could be passed in, so made changes to handle that
- +6 IF SRICDC?1N.N
- SET SRY=$$ICDDATA^ICDXCODE("DIAG",SRICDC,SRDT,"I")
- +7 IF '$TEST
- SET SRY=$$ICDDATA^ICDXCODE("DIAG",SRICDC,SRDT,"E")
- +8 ;End 177
- +9 QUIT $PIECE(SRY,"^",2)
- +10 ;
- SCRN(SRCODE) ;screen for active ICD codes
- +1 NEW SRSTAT,SRDA,SRDT
- +2 SET SRDA=$SELECT($GET(SRIEN):SRIEN,$DATA(DA(2)):DA(2),$DATA(DA(1)):DA(1),$DATA(D0):D0,1:"")
- +3 SET SRDT=$SELECT($GET(SRDA):$PIECE($PIECE(^SRF(SRDA,0),"^",9),"."),1:DT)
- +4 SET SRSTAT=$$LS^ICDEX(80,SRCODE,SRDT)
- +5 QUIT $SELECT(SRSTAT<1:0,1:1)
- +6 ;
- ICDSRCH ; To handle ICD ICD-9/10 Diagnosis Code Searches when ^DIC or ^DIE cannot be used
- +1 ; SRPRMT - For specific label, this field needs to be set from calling routine
- +2 ; SRDEF - For displaying the default field value at diagnosis prompt
- +3 ; X & Y variables need to be newed prior to calling this tag
- +4 IF $GET(SRPRMT)=""
- SET SRPRMT=" Select ICD Diagnosis "
- +5 NEW SRDT,SRSYS
- +6 SET SRDT=$PIECE($PIECE($GET(^SRF(SRTN,0)),"^",9),".")
- SET SRDT=$SELECT($GET(SRDT):SRDT,1:DT)
- SET SRSYS=$$SYS^ICDEX("DIAG",SRDT)
- +7 WRITE !!,SRPRMT_$$ICDSTR^SROICD(SRTN)_": "_$SELECT($GET(SRDEF)'="":SRDEF_"// ",1:"")
- READ X:DTIME
- +8 IF X=""
- IF $GET(SRDEF)'=""
- SET X=SRDEF
- +9 ; RBD - 10/15/13 - PATCH 177 - Needs to Quit when X Null also
- +10 IF (X="")!(X="^")!(X="@")
- QUIT
- +11 ; End 177
- +12 IF X["?"
- Begin DoDot:1
- +13 NEW SRTAG,SRFMT
- SET SRTAG=""
- +14 IF SRSYS=30
- SET SRTAG=$SELECT(X["???":"D3^SROICDGT",X["??":"D2^SROICDGT",X["?":"D1^SROICDGT",1:"D1^SROICDGT")
- DO @SRTAG
- QUIT
- +15 IF SRSYS=1
- SET SRTAG="Answer with ICD-9 DIAGNOSIS CODE NUMBER, or DESCRIPTION."
- +16 SET SRFMT=$SELECT(X["??":"!?8",1:"!?5")
- +17 DO EN^DDIOL(SRTAG,"",SRFMT)
- +18 QUIT
- End DoDot:1
- KILL X,Y
- GOTO ICDSRCH
- +19 IF SRSYS=1
- SET Y=$$SEARCH^ICDSAPI("DIAG","","QEMZ",SRDT)
- +20 IF '$TEST
- DO LEX^SROICD
- +21 ;JAS - 11/07/13 - PATCH 177 - Need to Kill Y too prior to returning to ICDSRCH
- +22 IF $GET(Y)'>0!($GET(Y)="")
- Begin DoDot:1
- +23 IF SRSYS=1
- WRITE !,?6,"Enter the ICD Diagnosis code for the principal postoperative diagnosis.",!,?6,"Screen prevents selection of inactive diagnosis."
- End DoDot:1
- KILL X,Y
- GOTO ICDSRCH
- +24 KILL SRPRMT,SRDEF
- +25 QUIT
- +26 ;
- TEST1 ;
- +1 ; do not ask question
- +2 SET SRASK=1
- +3 SET X="FRACTURE"
- SET SRDT=3150101
- DO LEX
- +4 QUIT
- TEST2 ;
- +1 ; ask question
- +2 SET SRASK=2
- +3 SET X="FRACTURE"
- SET SRDT=3150101
- DO LEX
- +4 QUIT