- ICDEXH ;SLC/KER - ICD Extractor - API Help ;04/21/2014
- ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
- ;
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; ^%ZIS ICR 10086
- ; HOME^%ZIS ICR 10086
- ; ^%ZISC ICR 10089
- ; ^%ZTLOAD ICR 10063
- ; ^DIR ICR 10026
- ;
- EN ; API Help Main Entry Point
- D HLP("EXT") Q
- ALL ; Help for All APIs
- N SEL,EXIT,ANS,HDR S EXIT=0 K SEL D HLP("AL")
- Q
- HLP(X) ; Help for X APIs
- N SEL,EXIT,ANS,TYPE,HDR S EXIT=0 K SEL S TYPE=$G(X) S:'$L(TYPE) TYPE="AL" Q:'$L($T(@(TYPE_"+0^ICDEXH"))) D @TYPE
- Q
- EXT ; Extraction API Help
- S HDR=" Data Extraction API Help available for:"
- D EX S ANS=$$ASK Q:+ANS'>0 Q:'$D(SEL(+ANS)) D DHLP
- Q
- LEG ; Legacy API Help
- S HDR=" Legacy API Help available for:"
- D LG S ANS=$$ASK Q:+ANS'>0 Q:'$D(SEL(+ANS)) D DHLP
- Q
- SDD ; SDD Mandated API Help
- S HDR=" SDD Mandated API Help available for:"
- D SD S ANS=$$ASK Q:+ANS'>0 Q:'$D(SEL(+ANS)) D DHLP
- Q
- AL ; All APIs Help
- S HDR=" API Help available for:"
- K SEL D EX,LG,SD S ANS=$$ASK Q:+ANS'>0 Q:'$D(SEL(+ANS)) D DHLP
- Q
- DHLP ; Display Help
- N %ZIS,CF,CONT,DNC,EOP,I,LC,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
- S %ZIS("A")=" Device: ",ZTRTN="DIS^ICDEXH",ZTDESC="Display ICD API Help"
- S ZTIO=ION,ZTDTH=$H,%ZIS="Q",ZTSAVE("SEL(")="",ZTSAVE("ANS")="" W ! D ^%ZIS I POP K %ZIS Q
- S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC,HOME^%ZIS K %ZIS Q
- K %ZIS D NOQUE Q
- NOQUE ; Do not queue Display
- W @IOF W:IOST["P-" !,"< Not queued, printing ICD API Help >",! U:IOST["P-" IO D @ZTRTN,^%ZISC,HOME^%ZIS Q
- QUE ; Task queued to print Help
- K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! Q
- Q
- CAP ; Capture
- D EX N ENT,CHR S CHR="",ENT=0 F S ENT=$O(SEL(ENT)) Q:+ENT'>0 D
- . N API,TTL,END,MENU,TXT,TXT2,TAG,RTN,CF,FIRST,LINE S TTL=$G(SEL(ENT)),API=$G(SEL(ENT,1))
- . Q:'$L(TTL) Q:'$L($P(TTL,"^",1)) Q:'$L($P(TTL,"^",2)) Q:'$L($P(TTL," ",2,299))
- . Q:'$L(API) Q:'$L($P(API,"^",1)) Q:'$L($P(API,"^",2)) Q:API'["ICDEX"
- . S END=$E($P(API,"ICDEX",2),1) I END'=CHR D
- . . S CHR=END N HDR,LN S (HDR,LN)="" S:END="C" HDR="ICD Code APIs" S:END="A" HDR="Misceaneous ICD APIs"
- . . S:END="S" HDR="ICD Support APIs" S:END="D" HDR="DRG Grouper APIs" S:END="H" HDR="ICD API Help"
- . . S:END="L" HDR="ICD Special Lookup APIs" S:$L(HDR) $P(LN,"=",$L(HDR))="=" W:$L(HDR) !!,HDR,!,LN,!
- . S TAG=$P(API,"^",1),RTN=$P(API,"^",2)
- . Q:'$L($T(@(RTN_"^"_RTN))) Q:'$L($T(@(TAG_"^"_RTN)))
- . S EXEC="S FIRST=$T("_TAG_"+1^"_RTN_")" X EXEC
- . S MENU=TTL,TXT2=$$TM($T(@(TAG_"+1^"_RTN))) W !!,$S('$D(FORUM):" ",1:""),MENU W:$G(FIRST)'[";" !
- . S CF=1 S TXT="" F LINE=1:1 D Q:'$L(TXT)
- . . N EXEC,TXT2,TXT3 S (TXT,TXT2,TXT3)=""
- . . S EXEC="S (TXT,TXT2)=$T("_TAG_"+"_LINE_"^"_RTN_")" X EXEC
- . . S EXEC="S TXT3=$T("_TAG_"+"_(LINE+1)_"^"_RTN_")" X EXEC
- . . S TXT2=$$TM(TXT2) I TXT2="Q"!(TXT2'[";") S TXT="" Q
- . . S:TXT3'[";" TXT3="" S:TXT2[";" TXT2=" "_$P(TXT2,";",2,299)
- . . I $L(TXT2),$L(TXT3) W:'$D(FORUM) !," ",TXT2 W:$D(FORUM) !,$$TM(TXT2) S CF=0
- N FORUM
- Q
- ;
- DIS ; Display
- N MENU,TAG,RTN,LINE,TXT,TXT1,TXT2,CF,LC,EOP,CONT,EXIT S ANS=+($G(ANS)) Q:+ANS'>0
- S MENU=$G(SEL(+($G(ANS)))),TAG=$G(SEL(+($G(ANS)),1)),RTN=$P(TAG,"^",2),TAG=$P(TAG,"^",1)
- Q:'$L(MENU) Q:'$L(TAG) Q:'$L(RTN) Q:'$L($T(@(RTN_"^"_RTN))) Q:'$L($T(@(TAG_"^"_RTN)))
- S CONT="",(CF,LC)=0,EOP=+($G(IOSL)) S:EOP=0 EOP=24 S TXT1=$$TM($T(@(TAG_"^"_RTN)))
- S TXT2=$$TM($T(@(TAG_"+1^"_RTN))) W:$L($G(IOF)) @IOF W:'$L($G(IOF)) ! D:'$L($G(IOF)) LF
- W !," ",MENU D LF W:$L(TXT2) ! D:$L(TXT2) LF
- S CF=1 S TXT="" F LINE=1:1 D Q:'$L(TXT)
- . N EXEC,TXT2,TXT3 S (TXT,TXT2,TXT3)=""
- . S EXEC="S (TXT,TXT2)=$T("_TAG_"+"_LINE_"^"_RTN_")" X EXEC
- . S EXEC="S TXT3=$T("_TAG_"+"_(LINE+1)_"^"_RTN_")" X EXEC
- . S TXT2=$$TM(TXT2) I TXT2="Q"!(TXT2'[";") S TXT="" Q
- . S:TXT3'[";" TXT3="" S:TXT2[";" TXT2=" "_$P(TXT2,";",2,299)
- . I $L(TXT2),$L(TXT3) W !," ",TXT2 S CF=0 D LF
- S:$D(ZTQUEUED) ZTREQ="@" K:+($G(EXIT))>0 SEL,ANS Q:+($G(EXIT))>0 I 'CF D EOP
- W:$L($G(IOF)) @IOF K SEL,ANS
- Q
- LF ; Line Feed
- S LC=LC+1 D:IOST["P-"&(LC>(EOP-7)) EOP D:IOST'["P-"&(LC>(EOP-4)) EOP
- Q
- EOP ; End of Page
- S LC=0 W:IOST["P-" @IOF Q:IOST["P-" W !! S CONT=$$CONT S CF=1
- Q
- CONT(X) ; Ask to Continue
- Q:+($G(EXIT))>0 "^^" N DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y S DIR(0)="EAO",DIR("A")=" Enter RETURN to continue or '^' to exit: "
- S DIR("PRE")="S:X[""?"" X=""??"" S:X[""^"" X=""^""",(DIR("?"),DIR("??"))="^D CONTH^ICDEXH"
- D ^DIR S:X["^^"!($D(DTOUT)) X="^^",EXIT=1 Q:X["^^"!(+($G(EXIT))>0) "^^" Q:$D(DIROUT)!($D(DIRUT))!($D(DUOUT))!($D(DTOUT)) "^"
- Q:X["^^" "^^" Q:X["^" "^"
- Q ""
- CONTH ; Ask to Continue Help
- W !," Enter either RETURN or '^'."
- Q
- ;
- ASK(X) ; Multiple Entries Found
- Q:+($G(EXIT))>0 "^^"
- N IEN,ITEM,TOT,MAX,ENT,ANS,EXIT,LEN,ROOT,Y,INT S INT=" API Help available for:"
- S:$L($G(HDR)) INT=$G(HDR) S LEN=+($G(LEN)) S:+LEN'>0 LEN=10 S (MAX,ENT,ANS,EXIT)=0,U="^"
- S TOT=$O(SEL(" "),-1) G:+TOT=0 MULQ S ANS=0 W:+TOT>1 !,INT
- F ENT=1:1:TOT Q:((ANS>0)&(ANS<ENT+1)) Q:EXIT D Q:EXIT
- . N ITEM,IEN,TEXT S ITEM=$G(SEL(ENT))
- . S IEN=+ITEM,TEXT=$P(ITEM,U,2) Q:'$L(TEXT)
- . S MAX=ENT W:ENT#LEN=1 ! W !,$J(ENT,4),". ",ITEM
- . W:ENT#LEN=0 ! S:ENT#LEN=0 ANS=$$MULS(MAX,ENT) S:ANS["^" EXIT=1
- I ENT#LEN'=0,+ANS=0 W ! S ANS=$$MULS(MAX,ENT) S:ANS["^" EXIT=1
- G MULQ
- Q X
- MULS(MAX,ENT) ; Select Multiple
- Q:+($G(EXIT))>0 "^^"
- N X,Y,LAST,NEXT,RAN,DIR,DTOUT,DUOUT,DIROUT,DIRUT,DIRB,HLP
- S MAX=+($G(MAX)),LAST=+($G(ENT)) Q:MAX'>0 -1
- S RAN=" Select 1-"_MAX_": ",NEXT=$O(SEL(+LAST))
- S:+NEXT>0 DIR("A")=" Press <RETURN> for more, '^' to exit, or"_RAN
- S:+NEXT'>0 DIR("A")=RAN
- S HLP=" Answer must be from 1 to "_MAX_", or <Return> to continue"
- S DIR("PRE")="S:X[""?"" X=""??"""
- S (DIR("?"),DIR("??"))="^D MULSH^ICDEXH"
- S DIR(0)="NAO^1:"_MAX_":0" D ^DIR
- S:X["^^"!($D(DTOUT)) EXIT=1,X="^^"
- I X["^^"!(+($G(EXIT))>0) Q "^^"
- S Y=+Y S:$D(DTOUT)!(X["^") Y="^" K DIR
- Q Y
- MULSH ; Select Multiple Help
- I $L($G(HLP)) W !,$G(HLP) Q
- Q
- MULQ ; Quit Multiple
- Q:+($G(ANS))'>0 -1 S X=+($G(ANS))
- Q X
- ;
- ; Build Menus
- EX ; Extraction APIs
- N LINE,RTN,TXT S RTN="ICDEX",TXT="" F LINE=1:1 D Q:'$L(TXT)
- . N EXEC,TXT1,TXT2,MENU,TAG,CALL,COMM,SEQ S (TXT,TXT1,TXT2)="",EXEC="S TXT1=$T(+"_LINE_"^"_RTN_")" X EXEC
- . S EXEC="S TXT2=$T(+"_(LINE+1)_"^"_RTN_")" X EXEC S TXT=TXT2 Q:'$L(TXT) Q:$P(TXT1," ",1)="EN"!($P(TXT2," ",1)="EN")
- . Q:$P(TXT1," ",1)="HELP"!($P(TXT2," ",1)="HELP") Q:TXT1["ICDEXH"!(TXT2["ICDEXH")
- . I $E(TXT1,1)'=" ",$E(TXT2,1)=" ",TXT1[" ; ",(TXT2["^ICDEX"!(TXT2["^ICDTOKN")) D
- . . N TAG,CALL,NAM,ENT,COM S TAG=$P(TXT1,"(",1),TAG=$P(TAG," ",1)
- . . I TXT1[(TAG_"(") D
- . . . S CALL=TAG_"^"_RTN S:TXT1[(TAG_"(") CALL=CALL_"("_$P($P(TXT1,"(",2),")",1)_")" S:TXT2["$$" CALL="$$"_CALL
- . . I TXT1'[(TAG_"(") S TAG=$P(TXT1," ; ",1),CALL=TAG_"^"_RTN
- . . S COM=$P(TXT1," ;",2),COM=$P(COM,"ICDEX",1),COM=$P(COM," (ICD",1),COM=$P(COM," (inter",1),COM=$P(COM," (opp",1)
- . . S COM=$$TM(COM),MENU=CALL,MENU=MENU_$J(" ",(40-$L(MENU)))_COM,CALL=$$TM(TXT2) S:$E(CALL,2)=" " CALL=$P(CALL," ",2)
- . . S:CALL["(" CALL=$P(CALL,"(",1) S TAG=$P(CALL,"^",1),NAM=$P(CALL,"^",2),TAG=$TR(TAG,"$","")
- . . S ENT=$T(@(TAG_"^"_NAM))
- . . Q:'$L(ENT) S SEQ=$O(SEL(" "),-1)+1,SEL(SEQ)=MENU,SEL(SEQ,1)=TAG_"^"_NAM
- Q
- LG ; Legacy APIs
- N LINE,RTN,TXT S RTN="ICDEX",TXT="" F LINE=1:1 D Q:'$L(TXT)
- . N EXEC,TXT1,MENU,TAG,CAL,NAM,TAG,RTN,SEQ S (TXT,TXT1,TXT2)="",EXEC="S TXT1=$T(LEGI+"_LINE_"^ICDEXH)" X EXEC
- . S TXT=TXT1 Q:'$L(TXT) S TXT=$P(TXT,";;",2) Q:'$L(TXT) S CAL=$P(TXT1,";;",2) Q:'$L(CAL)
- . S NAM=$P(TXT1,";;",3) Q:'$L(NAM) S TAG=$P(TXT1,";;",4) Q:'$L(TAG) S RTN=$P(TXT1,";;",5) Q:'$L(RTN)
- . S MENU=CAL,MENU=MENU_$J(" ",(40-$L(MENU)))_NAM S SEQ=$O(SEL(" "),-1)+1,SEL(SEQ)=MENU,SEL(SEQ,1)=TAG_"^"_RTN
- Q
- LEGI ; Legacy API Menu Items
- ;;$$ICDDX^ICDCODE(CODE,CDT,DFN,SRC);;ICD Dx code info;;ICDDX;;ICDCODE
- ;;$$ICDOP^ICDCODE(CODE,CDT,DFN,SRC);;ICD Op/Proc code info;;ICDOP;;ICDCODE
- ;;ICDD^ICDCODE(CODE,OUTARR,CDT);;ICD description;;ICDD;;ICDCODE
- ;;$$CODEN^ICDCODE(CODE,FILE);;IEN from code;;CODEN;;ICDCODE
- ;;$$CODEC^ICDCODE(IEN,FILE);;Code from IEN;;CODEC;;ICDCODE
- ;;$$CODEBA^ICDCODE(CODE,ROOT);;IEN from code/root;;CODEBA;;ICDCODE
- ;;$$DTBR^ICDAPIU(CDT,CS);;Date Business Rules;;DTBR;;ICDAPIU
- ;;$$MSG^ICDAPIU(CDT,CS);;Warning Message;;MSG;;ICDAPIU
- ;;$$STATCHK^ICDAPIU(CODE,CDT);;Check ICD code status;;STATCHK;;ICDAPIU
- ;;$$NEXT^ICDAPIU(CODE);;Next ICD Code;;NEXT;;ICDAPIU
- ;;$$PREV^ICDAPIU(CODE);;Previous ICD Code;;PREV;;ICDAPIU
- ;;$$HIST^ICDAPIU(CODE,ARY);;Activation History;;HIST;;ICDAPIU
- ;;PERIOD^ICDAPIU(CODE,ARY);;Activation Periods;;PERIOD;;ICDAPIU
- ;;$$EFF^ICDSUPT(FILE,IEN,CDT);;Effective date and status;;EFF;;ICDSUPT
- ;;$$NUM^ICDSUPT(CODE);;Numeric value from code;;NUM;;ICDSUPT
- ;;;;
- SD ; SDD Mandated APIs
- N LINE,RTN,TXT S RTN="ICDEX",TXT="" F LINE=1:1 D Q:'$L(TXT)
- . N EXEC,TXT1,MENU,TAG,CAL,NAM,TAG,RTN,SEQ S (TXT,TXT1,TXT2)="",EXEC="S TXT1=$T(SDDI+"_LINE_"^ICDEXH)" X EXEC
- . S TXT=TXT1 Q:'$L(TXT) S TXT=$P(TXT,";;",2) Q:'$L(TXT) S CAL=$P(TXT1,";;",2) Q:'$L(CAL)
- . S NAM=$P(TXT1,";;",3) Q:'$L(NAM) S TAG=$P(TXT1,";;",4) Q:'$L(TAG) S RTN=$P(TXT1,";;",5) Q:'$L(RTN)
- . S MENU=CAL,MENU=MENU_$J(" ",(40-$L(MENU)))_NAM S SEQ=$O(SEL(" "),-1)+1,SEL(SEQ)=MENU,SEL(SEQ,1)=TAG_"^"_RTN
- Q
- SDDI ; SDD Mandated API Menu Items
- ;;$$ICDDATA^ICDXCODE(CSYS,CODE,DATE,FRMT);;ICD code data;;ICDDATA;;ICDXCODE
- ;;$$ICDDESC^ICDXCODE(CSYS,CODE,DATE,.ARY);;ICD code description;;ICDDESC;;ICDXCODE
- ;;$$STATCHK^ICDXCODE(CSYS,CODE,DATE);;ICD code status and date;;STATCHK;;ICDXCODE
- ;;$$PREV^ICDXCODE(CSYS,CODE);;Previous ICD code;;PREV;;ICDXCODE
- ;;$$NEXT^ICDXCODE(CSYS,CODE);;Next ICD code;;NEXT;;ICDXCODE
- ;;$$HIST^ICDXCODE(CSYS,CODE,ARY);;Activation History;;HIST;;ICDXCODE
- ;;$$PERIOD^ICDXCODE(CSYS,CODE,ARY);;Activation/Inactivation Periods;;PERIOD;;ICDXCODE
- ;;$$SEARCH^ICDSAPI(FILE,SCR,DI,VDT,FMT);;Search ICD files;;SEARCH;;ICDSAPI
- ;;;;
- ; Miscellaneous
- TM(X,Y) ; Trim Character Y - Default " "
- S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" " F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
- F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
- Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDEXH 10413 printed Jan 18, 2025@02:51:55 Page 2
- ICDEXH ;SLC/KER - ICD Extractor - API Help ;04/21/2014
- +1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 1
- +2 ;
- +3 ;
- +4 ; Global Variables
- +5 ; None
- +6 ;
- +7 ; External References
- +8 ; ^%ZIS ICR 10086
- +9 ; HOME^%ZIS ICR 10086
- +10 ; ^%ZISC ICR 10089
- +11 ; ^%ZTLOAD ICR 10063
- +12 ; ^DIR ICR 10026
- +13 ;
- EN ; API Help Main Entry Point
- +1 DO HLP("EXT")
- QUIT
- ALL ; Help for All APIs
- +1 NEW SEL,EXIT,ANS,HDR
- SET EXIT=0
- KILL SEL
- DO HLP("AL")
- +2 QUIT
- HLP(X) ; Help for X APIs
- +1 NEW SEL,EXIT,ANS,TYPE,HDR
- SET EXIT=0
- KILL SEL
- SET TYPE=$GET(X)
- if '$LENGTH(TYPE)
- SET TYPE="AL"
- if '$LENGTH($TEXT(@(TYPE_"+0^ICDEXH")))
- QUIT
- DO @TYPE
- +2 QUIT
- EXT ; Extraction API Help
- +1 SET HDR=" Data Extraction API Help available for:"
- +2 DO EX
- SET ANS=$$ASK
- if +ANS'>0
- QUIT
- if '$DATA(SEL(+ANS))
- QUIT
- DO DHLP
- +3 QUIT
- LEG ; Legacy API Help
- +1 SET HDR=" Legacy API Help available for:"
- +2 DO LG
- SET ANS=$$ASK
- if +ANS'>0
- QUIT
- if '$DATA(SEL(+ANS))
- QUIT
- DO DHLP
- +3 QUIT
- SDD ; SDD Mandated API Help
- +1 SET HDR=" SDD Mandated API Help available for:"
- +2 DO SD
- SET ANS=$$ASK
- if +ANS'>0
- QUIT
- if '$DATA(SEL(+ANS))
- QUIT
- DO DHLP
- +3 QUIT
- AL ; All APIs Help
- +1 SET HDR=" API Help available for:"
- +2 KILL SEL
- DO EX
- DO LG
- DO SD
- SET ANS=$$ASK
- if +ANS'>0
- QUIT
- if '$DATA(SEL(+ANS))
- QUIT
- DO DHLP
- +3 QUIT
- DHLP ; Display Help
- +1 NEW %ZIS,CF,CONT,DNC,EOP,I,LC,ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK,POP
- +2 SET %ZIS("A")=" Device: "
- SET ZTRTN="DIS^ICDEXH"
- SET ZTDESC="Display ICD API Help"
- +3 SET ZTIO=ION
- SET ZTDTH=$HOROLOG
- SET %ZIS="Q"
- SET ZTSAVE("SEL(")=""
- SET ZTSAVE("ANS")=""
- WRITE !
- DO ^%ZIS
- IF POP
- KILL %ZIS
- QUIT
- +4 SET ZTIO=ION
- IF $DATA(IO("Q"))
- DO QUE
- DO ^%ZISC
- DO HOME^%ZIS
- KILL %ZIS
- QUIT
- +5 KILL %ZIS
- DO NOQUE
- QUIT
- NOQUE ; Do not queue Display
- +1 WRITE @IOF
- if IOST["P-"
- WRITE !,"< Not queued, printing ICD API Help >",!
- if IOST["P-"
- USE IO
- DO @ZTRTN
- DO ^%ZISC
- DO HOME^%ZIS
- QUIT
- QUE ; Task queued to print Help
- +1 KILL IO("Q")
- DO ^%ZTLOAD
- WRITE !,$SELECT($DATA(ZTSK):"Request Queued",1:"Request Cancelled"),!
- QUIT
- +2 QUIT
- CAP ; Capture
- +1 DO EX
- NEW ENT,CHR
- SET CHR=""
- SET ENT=0
- FOR
- SET ENT=$ORDER(SEL(ENT))
- if +ENT'>0
- QUIT
- Begin DoDot:1
- +2 NEW API,TTL,END,MENU,TXT,TXT2,TAG,RTN,CF,FIRST,LINE
- SET TTL=$GET(SEL(ENT))
- SET API=$GET(SEL(ENT,1))
- +3 if '$LENGTH(TTL)
- QUIT
- if '$LENGTH($PIECE(TTL,"^",1))
- QUIT
- if '$LENGTH($PIECE(TTL,"^",2))
- QUIT
- if '$LENGTH($PIECE(TTL," ",2,299))
- QUIT
- +4 if '$LENGTH(API)
- QUIT
- if '$LENGTH($PIECE(API,"^",1))
- QUIT
- if '$LENGTH($PIECE(API,"^",2))
- QUIT
- if API'["ICDEX"
- QUIT
- +5 SET END=$EXTRACT($PIECE(API,"ICDEX",2),1)
- IF END'=CHR
- Begin DoDot:2
- +6 SET CHR=END
- NEW HDR,LN
- SET (HDR,LN)=""
- if END="C"
- SET HDR="ICD Code APIs"
- if END="A"
- SET HDR="Misceaneous ICD APIs"
- +7 if END="S"
- SET HDR="ICD Support APIs"
- if END="D"
- SET HDR="DRG Grouper APIs"
- if END="H"
- SET HDR="ICD API Help"
- +8 if END="L"
- SET HDR="ICD Special Lookup APIs"
- if $LENGTH(HDR)
- SET $PIECE(LN,"=",$LENGTH(HDR))="="
- if $LENGTH(HDR)
- WRITE !!,HDR,!,LN,!
- End DoDot:2
- +9 SET TAG=$PIECE(API,"^",1)
- SET RTN=$PIECE(API,"^",2)
- +10 if '$LENGTH($TEXT(@(RTN_"^"_RTN)))
- QUIT
- if '$LENGTH($TEXT(@(TAG_"^"_RTN)))
- QUIT
- +11 SET EXEC="S FIRST=$T("_TAG_"+1^"_RTN_")"
- XECUTE EXEC
- +12 SET MENU=TTL
- SET TXT2=$$TM($TEXT(@(TAG_"+1^"_RTN)))
- WRITE !!,$SELECT('$DATA(FORUM):" ",1:""),MENU
- if $GET(FIRST)'[";"
- WRITE !
- +13 SET CF=1
- SET TXT=""
- FOR LINE=1:1
- Begin DoDot:2
- +14 NEW EXEC,TXT2,TXT3
- SET (TXT,TXT2,TXT3)=""
- +15 SET EXEC="S (TXT,TXT2)=$T("_TAG_"+"_LINE_"^"_RTN_")"
- XECUTE EXEC
- +16 SET EXEC="S TXT3=$T("_TAG_"+"_(LINE+1)_"^"_RTN_")"
- XECUTE EXEC
- +17 SET TXT2=$$TM(TXT2)
- IF TXT2="Q"!(TXT2'[";")
- SET TXT=""
- QUIT
- +18 if TXT3'[";"
- SET TXT3=""
- if TXT2[";"
- SET TXT2=" "_$PIECE(TXT2,";",2,299)
- +19 IF $LENGTH(TXT2)
- IF $LENGTH(TXT3)
- if '$DATA(FORUM)
- WRITE !," ",TXT2
- if $DATA(FORUM)
- WRITE !,$$TM(TXT2)
- SET CF=0
- End DoDot:2
- if '$LENGTH(TXT)
- QUIT
- End DoDot:1
- +20 NEW FORUM
- +21 QUIT
- +22 ;
- DIS ; Display
- +1 NEW MENU,TAG,RTN,LINE,TXT,TXT1,TXT2,CF,LC,EOP,CONT,EXIT
- SET ANS=+($GET(ANS))
- if +ANS'>0
- QUIT
- +2 SET MENU=$GET(SEL(+($GET(ANS))))
- SET TAG=$GET(SEL(+($GET(ANS)),1))
- SET RTN=$PIECE(TAG,"^",2)
- SET TAG=$PIECE(TAG,"^",1)
- +3 if '$LENGTH(MENU)
- QUIT
- if '$LENGTH(TAG)
- QUIT
- if '$LENGTH(RTN)
- QUIT
- if '$LENGTH($TEXT(@(RTN_"^"_RTN)))
- QUIT
- if '$LENGTH($TEXT(@(TAG_"^"_RTN)))
- QUIT
- +4 SET CONT=""
- SET (CF,LC)=0
- SET EOP=+($GET(IOSL))
- if EOP=0
- SET EOP=24
- SET TXT1=$$TM($TEXT(@(TAG_"^"_RTN)))
- +5 SET TXT2=$$TM($TEXT(@(TAG_"+1^"_RTN)))
- if $LENGTH($GET(IOF))
- WRITE @IOF
- if '$LENGTH($GET(IOF))
- WRITE !
- if '$LENGTH($GET(IOF))
- DO LF
- +6 WRITE !," ",MENU
- DO LF
- if $LENGTH(TXT2)
- WRITE !
- if $LENGTH(TXT2)
- DO LF
- +7 SET CF=1
- SET TXT=""
- FOR LINE=1:1
- Begin DoDot:1
- +8 NEW EXEC,TXT2,TXT3
- SET (TXT,TXT2,TXT3)=""
- +9 SET EXEC="S (TXT,TXT2)=$T("_TAG_"+"_LINE_"^"_RTN_")"
- XECUTE EXEC
- +10 SET EXEC="S TXT3=$T("_TAG_"+"_(LINE+1)_"^"_RTN_")"
- XECUTE EXEC
- +11 SET TXT2=$$TM(TXT2)
- IF TXT2="Q"!(TXT2'[";")
- SET TXT=""
- QUIT
- +12 if TXT3'[";"
- SET TXT3=""
- if TXT2[";"
- SET TXT2=" "_$PIECE(TXT2,";",2,299)
- +13 IF $LENGTH(TXT2)
- IF $LENGTH(TXT3)
- WRITE !," ",TXT2
- SET CF=0
- DO LF
- End DoDot:1
- if '$LENGTH(TXT)
- QUIT
- +14 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- if +($GET(EXIT))>0
- KILL SEL,ANS
- if +($GET(EXIT))>0
- QUIT
- IF 'CF
- DO EOP
- +15 if $LENGTH($GET(IOF))
- WRITE @IOF
- KILL SEL,ANS
- +16 QUIT
- LF ; Line Feed
- +1 SET LC=LC+1
- if IOST["P-"&(LC>(EOP-7))
- DO EOP
- if IOST'["P-"&(LC>(EOP-4))
- DO EOP
- +2 QUIT
- EOP ; End of Page
- +1 SET LC=0
- if IOST["P-"
- WRITE @IOF
- if IOST["P-"
- QUIT
- WRITE !!
- SET CONT=$$CONT
- SET CF=1
- +2 QUIT
- CONT(X) ; Ask to Continue
- +1 if +($GET(EXIT))>0
- QUIT "^^"
- NEW DIR,DIROUT,DIRUT,DUOUT,DTOUT,Y
- SET DIR(0)="EAO"
- SET DIR("A")=" Enter RETURN to continue or '^' to exit: "
- +2 SET DIR("PRE")="S:X[""?"" X=""??"" S:X[""^"" X=""^"""
- SET (DIR("?"),DIR("??"))="^D CONTH^ICDEXH"
- +3 DO ^DIR
- if X["^^"!($DATA(DTOUT))
- SET X="^^"
- SET EXIT=1
- if X["^^"!(+($GET(EXIT))>0)
- QUIT "^^"
- if $DATA(DIROUT)!($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DTOUT))
- QUIT "^"
- +4 if X["^^"
- QUIT "^^"
- if X["^"
- QUIT "^"
- +5 QUIT ""
- CONTH ; Ask to Continue Help
- +1 WRITE !," Enter either RETURN or '^'."
- +2 QUIT
- +3 ;
- ASK(X) ; Multiple Entries Found
- +1 if +($GET(EXIT))>0
- QUIT "^^"
- +2 NEW IEN,ITEM,TOT,MAX,ENT,ANS,EXIT,LEN,ROOT,Y,INT
- SET INT=" API Help available for:"
- +3 if $LENGTH($GET(HDR))
- SET INT=$GET(HDR)
- SET LEN=+($GET(LEN))
- if +LEN'>0
- SET LEN=10
- SET (MAX,ENT,ANS,EXIT)=0
- SET U="^"
- +4 SET TOT=$ORDER(SEL(" "),-1)
- if +TOT=0
- GOTO MULQ
- SET ANS=0
- if +TOT>1
- WRITE !,INT
- +5 FOR ENT=1:1:TOT
- if ((ANS>0)&(ANS<ENT+1))
- QUIT
- if EXIT
- QUIT
- Begin DoDot:1
- +6 NEW ITEM,IEN,TEXT
- SET ITEM=$GET(SEL(ENT))
- +7 SET IEN=+ITEM
- SET TEXT=$PIECE(ITEM,U,2)
- if '$LENGTH(TEXT)
- QUIT
- +8 SET MAX=ENT
- if ENT#LEN=1
- WRITE !
- WRITE !,$JUSTIFY(ENT,4),". ",ITEM
- +9 if ENT#LEN=0
- WRITE !
- if ENT#LEN=0
- SET ANS=$$MULS(MAX,ENT)
- if ANS["^"
- SET EXIT=1
- End DoDot:1
- if EXIT
- QUIT
- +10 IF ENT#LEN'=0
- IF +ANS=0
- WRITE !
- SET ANS=$$MULS(MAX,ENT)
- if ANS["^"
- SET EXIT=1
- +11 GOTO MULQ
- +12 QUIT X
- MULS(MAX,ENT) ; Select Multiple
- +1 if +($GET(EXIT))>0
- QUIT "^^"
- +2 NEW X,Y,LAST,NEXT,RAN,DIR,DTOUT,DUOUT,DIROUT,DIRUT,DIRB,HLP
- +3 SET MAX=+($GET(MAX))
- SET LAST=+($GET(ENT))
- if MAX'>0
- QUIT -1
- +4 SET RAN=" Select 1-"_MAX_": "
- SET NEXT=$ORDER(SEL(+LAST))
- +5 if +NEXT>0
- SET DIR("A")=" Press <RETURN> for more, '^' to exit, or"_RAN
- +6 if +NEXT'>0
- SET DIR("A")=RAN
- +7 SET HLP=" Answer must be from 1 to "_MAX_", or <Return> to continue"
- +8 SET DIR("PRE")="S:X[""?"" X=""??"""
- +9 SET (DIR("?"),DIR("??"))="^D MULSH^ICDEXH"
- +10 SET DIR(0)="NAO^1:"_MAX_":0"
- DO ^DIR
- +11 if X["^^"!($DATA(DTOUT))
- SET EXIT=1
- SET X="^^"
- +12 IF X["^^"!(+($GET(EXIT))>0)
- QUIT "^^"
- +13 SET Y=+Y
- if $DATA(DTOUT)!(X["^")
- SET Y="^"
- KILL DIR
- +14 QUIT Y
- MULSH ; Select Multiple Help
- +1 IF $LENGTH($GET(HLP))
- WRITE !,$GET(HLP)
- QUIT
- +2 QUIT
- MULQ ; Quit Multiple
- +1 if +($GET(ANS))'>0
- QUIT -1
- SET X=+($GET(ANS))
- +2 QUIT X
- +3 ;
- +4 ; Build Menus
- EX ; Extraction APIs
- +1 NEW LINE,RTN,TXT
- SET RTN="ICDEX"
- SET TXT=""
- FOR LINE=1:1
- Begin DoDot:1
- +2 NEW EXEC,TXT1,TXT2,MENU,TAG,CALL,COMM,SEQ
- SET (TXT,TXT1,TXT2)=""
- SET EXEC="S TXT1=$T(+"_LINE_"^"_RTN_")"
- XECUTE EXEC
- +3 SET EXEC="S TXT2=$T(+"_(LINE+1)_"^"_RTN_")"
- XECUTE EXEC
- SET TXT=TXT2
- if '$LENGTH(TXT)
- QUIT
- if $PIECE(TXT1," ",1)="EN"!($PIECE(TXT2," ",1)="EN")
- QUIT
- +4 if $PIECE(TXT1," ",1)="HELP"!($PIECE(TXT2," ",1)="HELP")
- QUIT
- if TXT1["ICDEXH"!(TXT2["ICDEXH")
- QUIT
- +5 IF $EXTRACT(TXT1,1)'=" "
- IF $EXTRACT(TXT2,1)=" "
- IF TXT1[" ; "
- IF (TXT2["^ICDEX"!(TXT2["^ICDTOKN"))
- Begin DoDot:2
- +6 NEW TAG,CALL,NAM,ENT,COM
- SET TAG=$PIECE(TXT1,"(",1)
- SET TAG=$PIECE(TAG," ",1)
- +7 IF TXT1[(TAG_"(")
- Begin DoDot:3
- +8 SET CALL=TAG_"^"_RTN
- if TXT1[(TAG_"(")
- SET CALL=CALL_"("_$PIECE($PIECE(TXT1,"(",2),")",1)_")"
- if TXT2["$$"
- SET CALL="$$"_CALL
- End DoDot:3
- +9 IF TXT1'[(TAG_"(")
- SET TAG=$PIECE(TXT1," ; ",1)
- SET CALL=TAG_"^"_RTN
- +10 SET COM=$PIECE(TXT1," ;",2)
- SET COM=$PIECE(COM,"ICDEX",1)
- SET COM=$PIECE(COM," (ICD",1)
- SET COM=$PIECE(COM," (inter",1)
- SET COM=$PIECE(COM," (opp",1)
- +11 SET COM=$$TM(COM)
- SET MENU=CALL
- SET MENU=MENU_$JUSTIFY(" ",(40-$LENGTH(MENU)))_COM
- SET CALL=$$TM(TXT2)
- if $EXTRACT(CALL,2)=" "
- SET CALL=$PIECE(CALL," ",2)
- +12 if CALL["("
- SET CALL=$PIECE(CALL,"(",1)
- SET TAG=$PIECE(CALL,"^",1)
- SET NAM=$PIECE(CALL,"^",2)
- SET TAG=$TRANSLATE(TAG,"$","")
- +13 SET ENT=$TEXT(@(TAG_"^"_NAM))
- +14 if '$LENGTH(ENT)
- QUIT
- SET SEQ=$ORDER(SEL(" "),-1)+1
- SET SEL(SEQ)=MENU
- SET SEL(SEQ,1)=TAG_"^"_NAM
- End DoDot:2
- End DoDot:1
- if '$LENGTH(TXT)
- QUIT
- +15 QUIT
- LG ; Legacy APIs
- +1 NEW LINE,RTN,TXT
- SET RTN="ICDEX"
- SET TXT=""
- FOR LINE=1:1
- Begin DoDot:1
- +2 NEW EXEC,TXT1,MENU,TAG,CAL,NAM,TAG,RTN,SEQ
- SET (TXT,TXT1,TXT2)=""
- SET EXEC="S TXT1=$T(LEGI+"_LINE_"^ICDEXH)"
- XECUTE EXEC
- +3 SET TXT=TXT1
- if '$LENGTH(TXT)
- QUIT
- SET TXT=$PIECE(TXT,";;",2)
- if '$LENGTH(TXT)
- QUIT
- SET CAL=$PIECE(TXT1,";;",2)
- if '$LENGTH(CAL)
- QUIT
- +4 SET NAM=$PIECE(TXT1,";;",3)
- if '$LENGTH(NAM)
- QUIT
- SET TAG=$PIECE(TXT1,";;",4)
- if '$LENGTH(TAG)
- QUIT
- SET RTN=$PIECE(TXT1,";;",5)
- if '$LENGTH(RTN)
- QUIT
- +5 SET MENU=CAL
- SET MENU=MENU_$JUSTIFY(" ",(40-$LENGTH(MENU)))_NAM
- SET SEQ=$ORDER(SEL(" "),-1)+1
- SET SEL(SEQ)=MENU
- SET SEL(SEQ,1)=TAG_"^"_RTN
- End DoDot:1
- if '$LENGTH(TXT)
- QUIT
- +6 QUIT
- LEGI ; Legacy API Menu Items
- +1 ;;$$ICDDX^ICDCODE(CODE,CDT,DFN,SRC);;ICD Dx code info;;ICDDX;;ICDCODE
- +2 ;;$$ICDOP^ICDCODE(CODE,CDT,DFN,SRC);;ICD Op/Proc code info;;ICDOP;;ICDCODE
- +3 ;;ICDD^ICDCODE(CODE,OUTARR,CDT);;ICD description;;ICDD;;ICDCODE
- +4 ;;$$CODEN^ICDCODE(CODE,FILE);;IEN from code;;CODEN;;ICDCODE
- +5 ;;$$CODEC^ICDCODE(IEN,FILE);;Code from IEN;;CODEC;;ICDCODE
- +6 ;;$$CODEBA^ICDCODE(CODE,ROOT);;IEN from code/root;;CODEBA;;ICDCODE
- +7 ;;$$DTBR^ICDAPIU(CDT,CS);;Date Business Rules;;DTBR;;ICDAPIU
- +8 ;;$$MSG^ICDAPIU(CDT,CS);;Warning Message;;MSG;;ICDAPIU
- +9 ;;$$STATCHK^ICDAPIU(CODE,CDT);;Check ICD code status;;STATCHK;;ICDAPIU
- +10 ;;$$NEXT^ICDAPIU(CODE);;Next ICD Code;;NEXT;;ICDAPIU
- +11 ;;$$PREV^ICDAPIU(CODE);;Previous ICD Code;;PREV;;ICDAPIU
- +12 ;;$$HIST^ICDAPIU(CODE,ARY);;Activation History;;HIST;;ICDAPIU
- +13 ;;PERIOD^ICDAPIU(CODE,ARY);;Activation Periods;;PERIOD;;ICDAPIU
- +14 ;;$$EFF^ICDSUPT(FILE,IEN,CDT);;Effective date and status;;EFF;;ICDSUPT
- +15 ;;$$NUM^ICDSUPT(CODE);;Numeric value from code;;NUM;;ICDSUPT
- +16 ;;;;
- SD ; SDD Mandated APIs
- +1 NEW LINE,RTN,TXT
- SET RTN="ICDEX"
- SET TXT=""
- FOR LINE=1:1
- Begin DoDot:1
- +2 NEW EXEC,TXT1,MENU,TAG,CAL,NAM,TAG,RTN,SEQ
- SET (TXT,TXT1,TXT2)=""
- SET EXEC="S TXT1=$T(SDDI+"_LINE_"^ICDEXH)"
- XECUTE EXEC
- +3 SET TXT=TXT1
- if '$LENGTH(TXT)
- QUIT
- SET TXT=$PIECE(TXT,";;",2)
- if '$LENGTH(TXT)
- QUIT
- SET CAL=$PIECE(TXT1,";;",2)
- if '$LENGTH(CAL)
- QUIT
- +4 SET NAM=$PIECE(TXT1,";;",3)
- if '$LENGTH(NAM)
- QUIT
- SET TAG=$PIECE(TXT1,";;",4)
- if '$LENGTH(TAG)
- QUIT
- SET RTN=$PIECE(TXT1,";;",5)
- if '$LENGTH(RTN)
- QUIT
- +5 SET MENU=CAL
- SET MENU=MENU_$JUSTIFY(" ",(40-$LENGTH(MENU)))_NAM
- SET SEQ=$ORDER(SEL(" "),-1)+1
- SET SEL(SEQ)=MENU
- SET SEL(SEQ,1)=TAG_"^"_RTN
- End DoDot:1
- if '$LENGTH(TXT)
- QUIT
- +6 QUIT
- SDDI ; SDD Mandated API Menu Items
- +1 ;;$$ICDDATA^ICDXCODE(CSYS,CODE,DATE,FRMT);;ICD code data;;ICDDATA;;ICDXCODE
- +2 ;;$$ICDDESC^ICDXCODE(CSYS,CODE,DATE,.ARY);;ICD code description;;ICDDESC;;ICDXCODE
- +3 ;;$$STATCHK^ICDXCODE(CSYS,CODE,DATE);;ICD code status and date;;STATCHK;;ICDXCODE
- +4 ;;$$PREV^ICDXCODE(CSYS,CODE);;Previous ICD code;;PREV;;ICDXCODE
- +5 ;;$$NEXT^ICDXCODE(CSYS,CODE);;Next ICD code;;NEXT;;ICDXCODE
- +6 ;;$$HIST^ICDXCODE(CSYS,CODE,ARY);;Activation History;;HIST;;ICDXCODE
- +7 ;;$$PERIOD^ICDXCODE(CSYS,CODE,ARY);;Activation/Inactivation Periods;;PERIOD;;ICDXCODE
- +8 ;;$$SEARCH^ICDSAPI(FILE,SCR,DI,VDT,FMT);;Search ICD files;;SEARCH;;ICDSAPI
- +9 ;;;;
- +10 ; Miscellaneous
- TM(X,Y) ; Trim Character Y - Default " "
- +1 SET X=$GET(X)
- if X=""
- QUIT X
- SET Y=$GET(Y)
- if '$LENGTH(Y)
- SET Y=" "
- FOR
- if $EXTRACT(X,1)'=Y
- QUIT
- SET X=$EXTRACT(X,2,$LENGTH(X))
- +2 FOR
- if $EXTRACT(X,$LENGTH(X))'=Y
- QUIT
- SET X=$EXTRACT(X,1,($LENGTH(X)-1))
- +3 QUIT X