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

ICDEXH.m

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