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
