Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFN4

IBDFN4.m

Go to the documentation of this file.
  1. IBDFN4 ;ALB/CJM - ENCOUNTER FORM - (entry points for selection routines) ;5/21/93
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,51,64,63**;APR 24, 1997;Build 80
  1. ;
  1. ;
  1. CPT ;select ambulatory procedures
  1. N NAME,CODE,SCREEN,IBDESCR,IBDESCLG,QUIT
  1. S QUIT=0
  1. S SCREEN="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;List only active codes
  1. K DIC S DIC=81,DIC(0)="AEMQZ",DIC("S")=SCREEN
  1. I $D(^ICPT) D ^DIC K DIC I +Y>0 D
  1. .;;change to api cpt;dhh
  1. .S CODE=$P(Y(0),U)
  1. .S CODE=$$CPT^ICPTCOD(CODE)
  1. .I +CODE=-1 K @IBARY Q
  1. .S NAME=$P(CODE,"^",3)
  1. .S IBDESCLG=$$CPTD^ICPTCOD(+CODE,.IBCPTD)
  1. .S IBDESCR=$G(IBCPTD(1))_" "_$G(IBCPTD(2))
  1. .S @IBARY=$P(CODE,"^",2)_"^"_NAME_"^"_IBDESCR
  1. E K @IBARY ;kill either if file doesn't exist or nothing chosen
  1. Q
  1. CPTSCRN ;This code is probably not called, but will modify to be safe.
  1. S SCREEN="I $P($$CPT^ICPTCOD(Y),U,7)=1"
  1. ;
  1. ;don't ask the user about categories - it doesn't work well
  1. S @IBARY@("SCREEN")=SCREEN
  1. Q
  1. ;
  1. ICD9 ;select ICD-9 codes
  1. N IBDX,CODE,SCREEN,IBDESCR,QUIT
  1. S QUIT=0
  1. S SCREEN="I $P($$ICDDX^ICDCODE(Y),U,10)=1" ;List only active codes
  1. I $G(DIC("A"))="" S DIC("A")="SELECT ICD-9 DIAGNOSIS CODE NUMBER: "
  1. S DIC=80,DIC(0)="AEMQZI",DIC("S")=SCREEN
  1. D ^DIC K DIC I +Y>0 D
  1. .S CODE=$P(Y(0),U),IBDX=$$GETIDX("ICD9",CODE,DT),IBDESCR=$$GETDSCR("ICD9",CODE,DT) ;(#10) DESCRIPTION in the old ICD9 DD
  1. .S IBDX=$P(IBDX,U,2)
  1. .S @IBARY=CODE_"^"_IBDX_"^"_IBDESCR
  1. E K @IBARY ;kill if either file doesn't exist or nothing chosen - this is how to let the encounter form utilities know nothing was selected
  1. Q
  1. ICD9SCRN ;This code is probably not called, but will modify to be safe.
  1. S SCREEN="I $P($$ICDDX^ICDCODE(Y),U,10)=1"
  1. ;
  1. S @IBARY@("SCREEN")=SCREEN
  1. Q
  1. NULL ;returns NOTHING for selection
  1. S @IBARY=""
  1. Q
  1. ;
  1. VSIT ; -- Select only visit cpt codes
  1. N NAME,CODE,IBDESCR,QUIT,DIC,X,Y,IBHDR,IBTXT
  1. S QUIT=0
  1. ;
  1. ;;S DIC="^IBE(357.69,",DIC(0)="AEMQZ",DIC("S")="I '$P(^(0),U,4)"
  1. S DIC="^IBE(357.69,",DIC(0)="AEMQZ"
  1. S DIC("S")="I $P($$CPT^ICPTCOD(Y),U,7)=1" ;List only active codes
  1. D ^DIC K DIC I +Y>0 D
  1. .;;----change to api cpt;dhh
  1. .S CODE=$P(Y(0),U),IBHDR=$P(Y(0),U,2),IBTXT=$P(Y(0),U,3)
  1. .S NODE=$$CPT^ICPTCOD(CODE)
  1. .I +NODE=-1 S IBSNM="" Q
  1. .S IBSNM=$P(NODE,U,3)
  1. .S @IBARY=CODE_"^"_IBTXT_"^"_IBHDR_"^"_IBSNM
  1. E K @IBARY ;kill if nothing chosen
  1. Q
  1. ;
  1. PRVDR ;for selecting provider
  1. D GETPRO^IBDF18B(IBCLINIC,IBARY)
  1. Q
  1. ;
  1. IBPFID ;for printing the form # assigned by form tracking
  1. S @IBARY=$G(IBPFID)
  1. Q
  1. ;
  1. PCPR ; -- get primary care provider for a patient
  1. S @IBARY=$P($$OUTPTPR^SDUTL3(DFN,DT),"^",2)
  1. Q
  1. ;
  1. PCTM ; -- get primary care team for a patient
  1. S @IBARY=$P($$OUTPTTM^SDUTL3(DFN,DT),"^",2)
  1. Q
  1. ;
  1. SCCOND ; -- display sc conditions
  1. Q:'$G(DFN)
  1. D DIS^DGRPDB
  1. W !
  1. Q
  1. ;
  1. ;
  1. CPTMOD ;- Select active CPT Modifiers
  1. ;- (used in selecting CPT Modifier(s) when creating the CPT Modifier
  1. ; Display ToolKit Block)
  1. ;
  1. N CODE,DIC,NAME,SCREEN
  1. Q:$G(IBARY)=""
  1. ;
  1. ;- Screen out inactive CPT modifiers
  1. ;;S SCREEN="I '$P(^(0),U,5)"
  1. ;;I '$D(@IBARY@("SCREEN")) S @IBARY@("SCREEN")=SCREEN
  1. ;
  1. ;List only active modifiers
  1. S SCREEN="I $P($$MOD^ICPTMOD(Y,""I""),U,7)=1"
  1. S DIC=81.3
  1. S DIC(0)="AEMQZ"
  1. S DIC("S")=SCREEN
  1. D ^DIC
  1. I +Y>0 D
  1. . ;- Use first 35 chars of modifier description
  1. . S CODE=$P(Y(0),"^"),NAME=$E($P(Y(0),"^",2),1,35)
  1. . S @IBARY=CODE_"^"_NAME
  1. ;
  1. ;- Kill if file doesn't exist or nothing chosen
  1. E K @IBARY
  1. Q
  1. ;------new code------
  1. ; IBDSERCH 1=Wildcard Search, 2=Lexicon Search
  1. ICD10 ; Wildcard search for ICD-10 codes.
  1. N DIR,%,IBDANS,IBDAUTO,IBDNEXT,IBDOUT,IBDTEXT,IBDWORD,IBDX,IBDY
  1. ; IBDSERCH 1=Wildcard ICD code search, 2=Lexicon ICD code search
  1. I '$D(IBDSERCH) S IBDSERCH=1 ;Set Wildcard ICD code search as default search.
  1. I IBDSERCH=2 D LXSEARCH Q ;Do Lexicon Partial Code ICD search.
  1. ;Wildcard ICD code search.
  1. K ^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J),^TMP("IBDFN4_ASSOCIATE",$J)
  1. I $G(DIC("A"))="" K ^TMP("IBDFN4_WCSEARCH",$J)
  1. ;I $G(DIC("A"))'="" W !
  1. S IBDAUTO=0
  1. S DIR("A")=$S($G(DIC("A"))'="":$TR(DIC("A"),":",""),1:"SELECT ICD-10 DIAGNOSIS CODE NUMBER")
  1. S DIR(0)="FO^3:8"
  1. S DIR("?")="Enter 3 to 8 characters or '??' for more help"
  1. S DIR("??")="^D HELP^IBDFN4A"
  1. D ^DIR K DIR
  1. I Y="^"!(Y="")!($D(DTOUT)) K @IBARY Q
  1. ;Do wildcard search.
  1. S IBDANS=$P(Y,U)
  1. I $G(DIC("A"))="" S IBDY=$$CODELIST^IBDUTICD("10D",IBDANS,"IBDFN4_WCSEARCH",DT,"",1)
  1. I $G(DIC("A"))'="" S IBDY=$$CODELIST^IBDUTICD("10D",IBDANS,"IBDFN4_ASSOCIATE_WCSEARCH",DT,"",1)
  1. I +IBDY<1 D
  1. .S IBDWORD=$P($P(IBDY,U,2)," ")
  1. .S IBDWORD=$TR($E(IBDWORD,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(IBDWORD,2,99) ;Capitalize first character of text message.
  1. .S $P(IBDY,U,2)=IBDWORD_" "_$P(IBDY," ",2,99)
  1. .W !!,$P(IBDY,U,2)_"."
  1. I +IBDY<1 G ICD10
  1. I $P(IBDY,U,2)=0 D G ICD10
  1. .W !!,"No data found for selected search, please enter partial code'*' for"
  1. .W !,"additional selections e.g. E11* .",!
  1. ;Do wildcard selection for SECOND and THIRD associated ICD-10 codes.
  1. S IBDOUT=0
  1. I $G(DIC("A"))'="" K Y D ASSOCIAT(.Y,.IBDOUT) G:Y=0!(IBDOUT) ICD10 Q
  1. I +IBDY'<1 D ;
  1. .S %=1
  1. .I $P(IBDY,U,2)>1 D
  1. ..W !!,"There are "_$P(IBDY,U,2)_" ICD-10-CM diagnosis codes that begin with "_IBDANS_". Do you wish to"
  1. ..W !,"automatically add all of these diagnosis codes to this block"
  1. ..S %=2 D YN^DICN
  1. .I %=1 S IBDAUTO=1
  1. .I ($G(DTOUT)) Q
  1. .I %=-1!(%=2) W !!,"Continue to select from the (# of items in list) ICD-10 diagnoses" S %=2 D YN^DICN I $G(DTOUT)!(%=-1)!(%=2) Q
  1. .D WCSEARCH(IBDAUTO) ;Wildcard Search
  1. I '$D(^TMP("IBDFN4_DISPLAY",$J)) K ^TMP("IBDFN4_SELECTED",$J),@IBARY G ICD10
  1. D DISPLAY
  1. K @IBARY,^TMP("IBDFN4_SELECTED",$J),^TMP("IBDFN4_DISPLAY",$J),^TMP("IBDFN4_WCSEARCH",$J),^TMP("IBDFN4_ASSOCIATE",$J)
  1. K ^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J)
  1. I +IBDY W !,"Now for another!"
  1. G ICD10
  1. Q
  1. ;
  1. ;Loop through ^TMP global created by wildcard search.
  1. WCSEARCH(IBDAUTO) ;
  1. ;
  1. N IBDBEGN,IBDCNT,IBDCODE,IBDCONTU,IBDESCR,IBDNOE,IBDNDEX,IBDNO,IBDQUIT,IBDSEL,IBDX
  1. I 'IBDAUTO W !
  1. S (IBDNDEX,IBDCNT,IBDQUIT,IBDBEGN)=0
  1. S IBDCONTU=1
  1. F S IBDNDEX=$O(^TMP("IBDFN4_WCSEARCH",$J,IBDNDEX)) Q:IBDNDEX=""!(IBDQUIT)!('IBDCONTU) D ;
  1. .S IBDNOE=^TMP("IBDFN4_WCSEARCH",$J,0) ;Number of entries in wildcard search.
  1. .S IBDCODE=^TMP("IBDFN4_WCSEARCH",$J,IBDNDEX,1)
  1. .S IBDCODE=$P(IBDCODE,U,2)
  1. .S IBDX=$P($$GETIDX("10D",IBDCODE,DT),U,2)
  1. .S IBDESCR=$P(^TMP("IBDFN4_WCSEARCH",$J,IBDNDEX,2),U,2)
  1. .S IBDCNT=IBDCNT+1
  1. .I IBDCNT=1 S IBDBEGN=1 I IBDNOE>5,'IBDAUTO W @IOF
  1. .I IBDAUTO D Q ;User chose to automatically add ICD-10 codes or user only chose 1 ICD code so SELECT tag is by-passed.
  1. ..I IBDCNT>1 W !!,"Automatic selection continued:",!
  1. ..;Display automatic selected wildcard search ICD code to user one at a time.
  1. ..S IBDNO=0
  1. ..D OKPROMPT($S(IBDNOE=1:1,1:""),IBDCODE,IBDX,.IBDQUIT,.IBDNO)
  1. ..I IBDNO!(IBDQUIT) Q
  1. ..S @IBARY=IBDCODE_U_IBDX_U_IBDESCR
  1. ..N IBDSLIEN
  1. ..;Add the Group and bring back the IEN Selection from ^IBE(357.3.
  1. ..D ADDGROUP(.IBDQUIT,.IBDSLIEN,IBDCODE)
  1. ..I IBDQUIT D:$D(IBDSLIEN) KILL3573(IBDSLIEN) S IBDQUIT=0 Q
  1. ..D SETMSG(IBDSLIEN,IBDCODE,IBDX,IBDCNT)
  1. .;User chose to select which ICD-10 codes he/she wants to add to form.
  1. .;Set ^TMP global for ICD selections.
  1. .S ^TMP("IBDFN4_SELECTED",$J,IBDCNT)=IBDCODE_U_IBDX_U_IBDESCR
  1. .W !,IBDCNT_".",?4,IBDCODE,?15,IBDX ;Display wildcard selected ICD codes
  1. .I IBDCNT#22=0 D Q ;Display every 22 ICD codes to user.
  1. ..D SELECT(IBDBEGN,IBDCNT,.IBDQUIT,.IBDNDEX,.IBDSEL,.IBDCONTU)
  1. ..S IBDBEGN=IBDCNT+1
  1. ..;I IBDSEL="",$O(^TMP("IBDFN4_WCSEARCH",$J,IBDNDEX))'="",'IBDQUIT,IBDCONTU W @IOF
  1. I IBDAUTO!(IBDQUIT)!('IBDCONTU) Q
  1. ;Less than 22 ICD codes displayed.
  1. D SELECT(IBDBEGN,IBDCNT,.IBDQUIT,"",.IBDSEL,.IBDCONTU)
  1. Q
  1. ;Allow user to select a range of ICD codes.
  1. SELECT(IBDBEGN,IBDCNT,IBDQUIT,IBDNDEX,IBDSEL,IBDCONTU) ;
  1. N IBDCODE,IBDESCR,IBDI,IBDNEXT,IBDNO,IBDNODE,IBDSELN,IBDSKIP,IBDTEXT,IBDTEMP,IBDTEMPY,IBDX
  1. S IBDSKIP=0
  1. S IBDSEL=$G(IBDSEL)
  1. I IBDNDEX'="" S IBDNEXT=$O(^TMP("IBDFN4_WCSEARCH",$J,IBDNDEX))
  1. K Y
  1. S DIR("A")="Select ICD-10 DIAGNOSIS CODE or '?' for more help"
  1. S DIR("?")=$S(IBDCNT#22=0:"press Enter for more or '^' to exit.",1:"press Enter to continue or '^' to exit.")
  1. S DIR("?",1)="Enter a single number from the list or range (e.g., 1,3,5 or 2-4,8) or"
  1. S DIR(0)="LO^"_IBDBEGN_":"_IBDCNT D ^DIR K DIR
  1. I $D(DTOUT) S IBDQUIT=1 Q
  1. I Y="",$G(IBDNEXT) W @IOF Q
  1. I $D(DUOUT) S IBDSKIP=1 ;Allows user to terminate with '^' out of selection list.
  1. S IBDTEMPY=Y
  1. I '$D(DUOUT),Y'="" S IBDTEMP=Y
  1. K Y
  1. I $G(IBDNEXT),'IBDSKIP D
  1. .S DIR("A")="Save selections and continue to (# of remaining items) in list"
  1. .S DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR
  1. .I Y W @IOF
  1. .I Y=0 S IBDTEMP=""
  1. S Y=$G(Y)
  1. I $D(DTOUT) S IBDQUIT=1 Q
  1. I $D(DUOUT)!(Y=0) D
  1. .I IBDSEL="" S IBDCONTU=0
  1. Q:'IBDCONTU
  1. I IBDTEMPY="^",IBDSEL="" S IBDCONTU=0 Q
  1. I '$D(DUOUT),$G(IBDTEMP)'="" S IBDSEL=$G(IBDSEL)_IBDTEMP I $G(IBDNEXT) Q
  1. I IBDSEL="" Q
  1. S IBDTEXT=$S($L(IBDSEL,",")=2:"this diagnosis",1:"these diagnoses")
  1. W !,"Do you really want to select "_IBDTEXT
  1. S %=2 D YN^DICN
  1. I $G(DTOUT)!(%=2)!(%=-1) S IBDQUIT=1 K ^TMP("IBDFN4_DISPLAY",$J) Q
  1. W !
  1. F IBDI=1:1 Q:$P(IBDSEL,",",IBDI)="" D Q:IBDQUIT
  1. .I IBDI>1 W !!,"Selected list continued:",!
  1. .S IBDSELN=$P(IBDSEL,",",IBDI)
  1. .S IBDNODE=^TMP("IBDFN4_SELECTED",$J,IBDSELN)
  1. .S IBDCODE=$P(IBDNODE,U)
  1. .S IBDX=$P(IBDNODE,U,2)
  1. .S IBDESCR=$P(IBDNODE,U,3)
  1. .;W !,?4,IBDCODE,?15,IBDX
  1. .S IBDNO=0
  1. .D OKPROMPT("",IBDCODE,IBDX,.IBDQUIT,.IBDNO)
  1. .I IBDQUIT!(IBDNO) Q
  1. .S @IBARY=IBDCODE_"^"_IBDX_"^"_IBDESCR
  1. .N IBDSLIEN
  1. .;Adds the Group, files the entry and brings back the IEN Selection from ^IBE(357.3.
  1. .D ADDGROUP(.IBDQUIT,.IBDSLIEN,IBDCODE)
  1. .I IBDQUIT D:$D(IBDSLIEN) KILL3573(IBDSLIEN) S IBDQUIT=0 Q
  1. .D SETMSG(IBDSLIEN,IBDCODE,IBDX,IBDSELN)
  1. S IBDCONTU=0
  1. Q
  1. ;
  1. ;IBDEXTCD - the external code that we are adding to the group (optional)
  1. ADDGROUP(IBDQUIT,IBDSLIEN,IBDEXTCD) ;
  1. N DIC
  1. W !
  1. I '$D(@IBRTN("DATA_LOCATION")) W !,"Data location not established. Unable to file data." S IBDQUIT=1 Q
  1. I $G(IBGRP)'>0 D Q
  1. .S DIC="^IBE(357.4,",DIC(0)="AEMN",DIC("S")="I $P(^IBE(357.4,+Y,0),""^"",3)=IBLIST" D ^DIC K DIC S:X="^"!($D(DTOUT)) IBDQUIT=1 Q:IBDQUIT S IBGRP=+Y I Y<0 D Q:IBDQUIT=1
  1. ..W !!,"A SELECTION GROUP HEADER IS REQUIRED.... The selection will not be added if none is provided....Enter '??' for a list of choices.",!!
  1. ..S DIC="^IBE(357.4,",DIC(0)="AEMN",DIC("S")="I $P(^IBE(357.4,+Y,0),""^"",3)=IBLIST" D ^DIC K DIC S IBGRP=+Y I Y<0!($D(DTOUT)) S IBDQUIT=1 Q
  1. .D ADDREC^IBDF4(.IBDQUIT,"",.IBDSLIEN,$G(IBDEXTCD))
  1. .S IBGRP=""
  1. ;Adds Second and Third Associated ICD-10 codes,
  1. ;editing of subcolumn 3, Narrative to PCE, Clinical Lexicon Entry,
  1. ;files the entry and brings back the IEN Selection from ^IBE(357.3.
  1. D ADDREC^IBDF4(.IBDQUIT,"",.IBDSLIEN,$G(IBDEXTCD))
  1. Q
  1. ;Get the second and third associated codes.
  1. ASSOCIAT(Y,IBDOUT) ;
  1. N IBDCNT,IBDCODE,IBDESCR,IBDIEN,IBDNEXT,IBDNDEX,IBDNO,IBDNODE,IBDNOE,IBDQUIT,IBDX
  1. S (IBDAUTO,IBDCNT,IBDQUIT)=0
  1. S Y=""
  1. S (IBDNDEX,IBDNO)=0
  1. F S IBDNDEX=$O(^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J,IBDNDEX)) Q:IBDNDEX=""!(IBDQUIT)!(IBDNO) D
  1. .S IBDNEXT=$O(^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J,IBDNDEX))
  1. .S IBDCNT=IBDCNT+1
  1. .I IBDCNT=1 D
  1. ..S IBDBEGN=1
  1. ..S IBDNOE=^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J,0) ;Number of entries in wildcard search.
  1. ..I IBDNOE>5 W @IOF
  1. .I IBDCNT=1,IBDNOE>1 W !,"There are "_IBDNOE_" associated codes beginning with "_IBDANS_":"
  1. .S IBDCODE=^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J,IBDNDEX,1)
  1. .S IBDIEN=+$P(IBDCODE,U) ;+ to resolve both direct and variable pointers
  1. .S IBDCODE=$P(IBDCODE,U,2)
  1. .S IBDX=$P($$GETIDX("10D",IBDCODE,DT),U,2)
  1. .S IBDESCR=$P(^TMP("IBDFN4_ASSOCIATE_WCSEARCH",$J,IBDNDEX,2),U,2)
  1. .S ^TMP("IBDFN4_ASSOCIATE",$J,IBDCNT)=IBDIEN_U_IBDCODE_U_IBDX_U_IBDESCR
  1. .I IBDNOE>1 W !,IBDCNT_".",?4,IBDCODE,?15,IBDX
  1. .I IBDNOE=1 D
  1. ..D OKPROMPT(1,IBDCODE,IBDX,.IBDQUIT,.IBDNO)
  1. .I IBDQUIT!(IBDNO) Q
  1. .;Display every 22 ICD codes to user.
  1. .I IBDCNT#22=0 D
  1. ..K Y
  1. ..S DIR("A")="Press Enter for more, ^ to exit or Select ICD-10 ASSOCIATED CODE"
  1. ..S DIR(0)="NO^"_IBDBEGN_":"_IBDCNT
  1. ..D ^DIR K DIR
  1. ..S IBDBEGN=IBDCNT+1
  1. ..I Y="" W @IOF
  1. .I $D(DUOUT)!($D(DTOUT)) S (IBDQUIT,IBDOUT)=1 Q
  1. .I IBDCNT#22'=0,IBDNEXT="",IBDNOE'=1 D ;
  1. ..K Y
  1. ..S DIR("A")="Press Enter to continue, ^ to exit or Select ICD-10 ASSOCIATED CODE"
  1. ..S DIR(0)="NO^"_IBDBEGN_":"_IBDCNT
  1. ..D ^DIR K DIR
  1. .I $D(DUOUT)!($D(DTOUT)) S (IBDQUIT,IBDOUT)=1 Q
  1. .I Y?1N.N!(IBDNOE=1) D ;
  1. ..S IBDNODE=$S(IBDNOE=1:^TMP("IBDFN4_ASSOCIATE",$J,1),1:^TMP("IBDFN4_ASSOCIATE",$J,Y))
  1. ..S IBDIEN=$P(IBDNODE,U),IBDCODE=$P(IBDNODE,U,2),IBDX=$P(IBDNODE,U,3),IBDESCR=$P(IBDNODE,U,4)
  1. ..S @IBARY=IBDCODE_U_IBDX_U_IBDESCR
  1. ..S IBDQUIT=1
  1. ..I IBDNOE>1 W !,?4,IBDCODE,?15,IBDX
  1. ..K Y ;set up Y array to be passed back for filing of ^IBE(357.3.
  1. ..S Y=IBDIEN_U_IBDCODE
  1. ..S Y(0)=IBDCODE
  1. ..S Y(0,0)=IBDCODE
  1. Q
  1. ;Display the selected ICD-10 code(s) to user.
  1. DISPLAY ;
  1. ;
  1. N IBDCNT,IBDCODE,IBDNODE,IBDQUIT,IBDSUB,IBDX
  1. S (IBDCNT,IBDQUIT)=0
  1. W !!,^TMP("IBDFN4_DISPLAY",$J,0)_" Diagnosis Added.",!
  1. S IBDSUB=0
  1. F S IBDSUB=$O(^TMP("IBDFN4_DISPLAY",$J,IBDSUB)) Q:IBDSUB="" D ;
  1. .;Display wildcard selections to user.
  1. .S IBDCNT=IBDCNT+1
  1. .S IBDNODE=^TMP("IBDFN4_DISPLAY",$J,IBDSUB)
  1. .S IBDCODE=$P(IBDNODE,U)
  1. .S IBDX=$P(IBDNODE,U,2)
  1. .W !,IBDX_" (ICD-10-CM "_IBDCODE_")"
  1. .I IBDCNT#18=0 D ;
  1. ..W !
  1. ..S DIR(0)="E"
  1. ..D ^DIR
  1. ..I 'Y S IBDQUIT=1 Q
  1. ..W @IOF
  1. I IBDCNT#18=0 H 5
  1. W !
  1. Q
  1. ;get description
  1. GETDSCR(IBDCSYS,IBDCODE,IBDT) ;
  1. N IBDZZ,IBDRETV
  1. S IBDRETV=$$ICDDESC^ICDXCODE(IBDCSYS,IBDCODE,IBDT,.IBDZZ)
  1. I IBDRETV<1 Q $P(IBDRETV,U,2)
  1. Q IBDZZ(1)_" "_$G(IBDZZ(3))
  1. ;get ien and diagnosis description
  1. ;IBDCSYS - "ICD-9" if ICD9 code, "10D" if ICD-10 code
  1. ;IBDCODE - Actual ICD code (ie S62.011P)
  1. ;IBDT - Today's date.
  1. GETIDX(IBDCSYS,IBDCODE,IBDT) ;
  1. N IBDICDX
  1. S IBDICDX=$$ICDDATA^ICDXCODE(IBDCSYS,IBDCODE,IBDT)
  1. I IBDICDX<1 Q $P(IBDICDX,U,2)
  1. Q $P(IBDICDX,U)_U_$P(IBDICDX,U,4)
  1. ;Set ^TMP global to display selected ICD-10 code and ICD-10 description to the user.
  1. ;Selected ICD-10 codes will be displayed to the user in line tag DISPLAY.
  1. ;NOTE: ICD-10 description could have been edited by the user.
  1. SETMSG(IBDSLIEN,IBDCODE,IBDX,IBDSUB) ;
  1. N IBDI,IBDINDEX,IBDNODE,IBDSCHDR
  1. F IBDI=1:1:8 I $G(IBLIST("SCPIECE",IBDI)) D ;
  1. .S IBDSCHDR=$G(IBLIST("SCHDR",IBDI)) I IBDSCHDR'="" D ;
  1. ..I IBDSCHDR'="CODE",IBDSCHDR'="DIAGNOSIS" Q
  1. ..S IBDINDEX=0 F S IBDINDEX=$O(^IBE(357.3,IBDSLIEN,1,IBDINDEX)) Q:'IBDINDEX D ;
  1. ...S IBDNODE=^IBE(357.3,IBDSLIEN,1,IBDINDEX,0)
  1. ...I $P(IBDNODE,U)=IBDI,IBDSCHDR="DIAGNOSIS" S IBDX=$P(IBDNODE,U,2)
  1. ...I $P(IBDNODE,U)=IBDI,IBDSCHDR="CODE" S IBDCODE=$P(IBDNODE,U,2)
  1. S ^TMP("IBDFN4_DISPLAY",$J,0)=$G(^TMP("IBDFN4_DISPLAY",$J,0))+1
  1. S ^TMP("IBDFN4_DISPLAY",$J,IBDSUB)=IBDCODE_U_IBDX
  1. Q
  1. ;To kill incomplete entries in ^IBE(357.3
  1. KILL3573(IBDSEL) ;
  1. N DA,DIK
  1. S DA=IBDSEL,DIK="^IBE(357.3," D ^DIK K DIK
  1. Q
  1. ;Ask user with 'OK? Yes' prompt.
  1. OKPROMPT(IBDONE,IBDCODE,IBDX,IBDQUIT,IBDNO) ;
  1. N DIR,IBDI
  1. I '$D(IBDONE) S IBDONE=0
  1. S DIR("A")="OK? (Yes/No) "
  1. F IBDI=1:1:4 D
  1. .I IBDONE D
  1. ..I IBDI=1 S DIR("A",1)="One match found."
  1. ..I IBDI=2 S DIR("A",2)=" "
  1. ..I IBDI=3 S DIR("A",3)=IBDCODE_" "_IBDX
  1. ..I IBDI=4 S DIR("A",4)=" "
  1. .I 'IBDONE D
  1. ..I IBDI=1 S DIR("A",1)=" "
  1. ..I IBDI=2 S DIR("A",2)=IBDCODE_" "_IBDX
  1. ..I IBDI=3 S DIR("A",3)=" "
  1. S DIR(0)="YAO",DIR("B")="Yes" D ^DIR K DIR
  1. W !
  1. I $D(DUOUT)!($D(DTOUT)) S IBDQUIT=1 Q
  1. I Y=0 S IBDNO=1
  1. Q
  1. ;Partial Code Lexicon ICD code search.
  1. LXSEARCH ;
  1. N IBDCODE,IBDESCR,IBDINDEX,IBDQUIT,IBDX,IBDY
  1. S IBDQUIT=0
  1. I $G(DIC("A"))'="" D Q:IBDQUIT
  1. .S DIR("A")=DIC("A")
  1. .S DIR(0)="FAO^0:245"
  1. .S DIR("?")="^D INPHLP^IBDLXDG"
  1. .S DIR("??")="^D INPHLP^IBDLXDG"
  1. .D ^DIR
  1. .I Y="^"!(Y="")!($D(DTOUT)) K @IBARY,DIC S IBDQUIT=1 Q
  1. .D SETPARAM^IBDLXDG(.IBDPARAM)
  1. .S IBDY=$$LEXICD10^IBDLXDG(Y,$$ICD10DT^IBDUTICD(DT),.IBDPARAM)
  1. I $G(DIC("A"))="" D
  1. .D SETPARAM^IBDLXDG(.IBDPARAM)
  1. .S IBDY=$$DIAG10^IBDLXDG($$ICD10DT^IBDUTICD(DT),"",.IBDPARAM)
  1. I IBDY="" W !!,IBDPARAM("NO DATA FOUND"),!,IBDPARAM("NO DATA FOUND 2"),! G LXSEARCH
  1. I IBDY=-1!(IBDY=-2)!(IBDY=-3)!(IBDY=-4) Q ;Timed out or was aborted.
  1. S IBDCODE=$P($P(IBDY,U),";",2)
  1. S IBDX=$$GETIDX("10D",IBDCODE,DT)
  1. S IBDX=$P(IBDX,U,2)
  1. S IBDESCR=$P(IBDY,U,2)
  1. S @IBARY=IBDCODE_"^"_IBDX_"^"_IBDESCR
  1. K DIC
  1. Q
  1. ;IBDFN4