ICDDIC ;ISL/KER - ICD Code Lookup Prototype (DIC) ;04/21/2014
;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
;
; Global Variables
; None
;
; External References
; $$DT^XLFDT ICR 10103
; $$FMTE^XLFDT ICR 10103
; ^DIC ICR 10006
;
; Local Variables NEWed or KILLed Elsewhere
; Y
;
EN ; Main Entry Point
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ICD,ICDA,ICDB,ICDC,ICDCOD,ICDCS,ICDCDT,ICDD,ICDD1,ICDD2
N ICDDP,ICDF,ICDFI,ICDFM,ICDFMT,ICDI,ICDID,ICDINP,ICDK,ICDLONG,ICDMFT,ICDMIX,ICDN
N ICDO,ICDOA,ICDOUT,ICDPSN,ICDR,ICDS,ICDSHRT,ICDSRC,ICDSY,ICDSYS,ICDT,ICDTD,ICDTY
N ICDU,ICDV,ICDVAL,ICDVD,ICDVDT,ICDVR,ICD K X,Y
D EN^ICDDICA W:$D(DTOUT) !!," Try later",!
Q:$D(DTOUT) W:$D(DUOUT) !!," Abort lookup",! Q:$D(DUOUT) S:+($G(ICDCS))>0 ICDSYS=+($G(ICDCS))
S ICDFMT=1 S:+($G(ICDFM))>0 ICDFMT=+($G(ICDFM)) S:$G(ICDVD)?7N ICDVDT=$G(ICDVD)
K:+($G(ICDVR))'>0 ICDVDT S:+($G(ICDFM))>0 ICDMFT=+($G(ICDFM)) S ICDSY=$P(ICDCS,"^",2)
S ICDTY=$S(+ICDFI=80:"Diagnosis",+ICDFI=80.1:"Procedure",1:"")
S DIC=$S(ICDDP="D":$$ROOT^ICDEX(80),ICDDP="P":$$ROOT^ICDEX(80.1),1:"")
W:'$L(DIC) !!," Invalid Global Root",!
Q:'$L(DIC) S DIC("A")=" Enter an "_ICDSY_" "_ICDTY_": ",DIC(0)="AEQZ"
S:'$L($$TM(ICDSY)) DIC("A")=" Enter a "_ICDTY_": ",DIC(0)="AEQZ"
S:$L($G(DIC0)) DIC(0)=DIC0 D:$D(ICDSHOW) SHOW K X,Y D ^DIC,OUT N DIC0
Q
EN2 ; Entry Point that Input Displays Variables
N ICDSHOW S ICDSHOW="" D EN
Q
ICD10D ;
S DIC=$$ROOT^ICDEX(80),DIC("A")=" Enter an ICD-10 Diagnosis: ",DIC(0)="AEQZ",ICDVDT=3141010,ICDSYS=30
K X,Y D ^DIC,OUT W !
Q
ICD10P ;
S DIC=$$ROOT^ICDEX(80.1),DIC("A")=" Enter an ICD-10 Procedure: ",DIC(0)="AEQZ",ICDVDT=3141010,ICDSYS=30
K X,Y D ^DIC,OUT W !
Q
ICD9D ;
S DIC=$$ROOT^ICDEX(80),DIC("A")=" Enter an ICD-9 Diagnosis: ",DIC(0)="AEQZ",ICDVDT=3120101,ICDSYS=1
K X,Y D ^DIC,OUT W !
Q
ICD9P ;
S DIC=$$ROOT^ICDEX(80.1),DIC("A")=" Enter an ICD-10 Procedure: ",DIC(0)="AEQZ",ICDVDT=3120101,ICDSYS=1
K X,Y D ^DIC,OUT W !
Q
OUT ; Output
N ICDARY,ICDC,ICDCOD,ICDDT,ICDEF,ICDEFF,ICDHIS,ICDI
N ICDIEN,ICDLON,ICDND,ICDROOT,ICDSHT,ICDST,ICDTDT,ICDX
S ICDX=$G(X) I +Y'>0,$L($P(Y,"^",2)) D Q
. ;W !!," ERROR: ",$P(Y,"^",2),! S X=ICDX
S ICDIEN=+Y Q:+ICDIEN'>0
S ICDCOD=$P(Y,"^",2) Q:'$L(ICDCOD)
S ICDROOT=$$ROOT^ICDEX(+($G(ICDFI))) Q:'$L(ICDROOT)
S ICDSHT=$P($G(Y(0,1)),"^",4)
S:'$L(ICDSHT) ICDSHT=$$SD^ICDEX(+($G(ICDFI)),$G(ICDIEN),$P($G(ICDVDT),".",1))
I '$L(ICDSHT) D
. N ICDEFF,ICDHIS S ICDEFF=$O(@(ICDROOT_ICDIEN_",67,""B"","" "")"),-1)
. S ICDHIS=$O(@(ICDROOT_ICDIEN_",67,""B"","_+ICDEFF_","" "")"),-1)
. S ICDSHT=$G(@(ICDROOT_ICDIEN_",67,"_+ICDHIS_",0)"))
. S ICDSHT=$P(ICDSHT,"^",2)
S ICDLON=$G(Y(0,2))
S:'$L(ICDLON) ICDLON=$$LD^ICDEX(+($G(ICDFI)),$G(ICDIEN),$P($G(ICDVDT),".",1))
I '$L(ICDLON) D
. N ICDEFF,ICDHIS S ICDEFF=$O(@(ICDROOT_ICDIEN_",68,""B"","" "")"),-1)
. S ICDHIS=$O(@(ICDROOT_ICDIEN_",68,""B"","_+ICDEFF_","" "")"),-1)
. S ICDLON=$G(@(ICDROOT_ICDIEN_",68,"_+ICDHIS_",0)"))
Q:'$L(ICDSHT) Q:'$L(ICDLON)
S ICDARY(1)=ICDLON D PAR^ICDEX(.ICDARY,(78-15))
W !!,?1,ICDCOD,?15,ICDSHT
W !!,?1,"Description:",?15,$G(ICDARY(1))
S ICDI=1 F S ICDI=$O(ICDARY(ICDI)) Q:+ICDI'>0 W !,?15,$G(ICDARY(ICDI))
S ICDTDT=$$DT^XLFDT S:$G(ICDVDT)?7N ICDTDT=ICDVDT
S ICDC=0,ICDEFF=0 F S ICDEFF=$O(@(ICDROOT_ICDIEN_",66,""B"","""_ICDEFF_""")")) Q:'$L(ICDEFF) D
. Q:ICDEFF'?7N N ICDHIS S ICDHIS=0
. F S ICDHIS=$O(@(ICDROOT_ICDIEN_",66,""B"","""_ICDEFF_""","""_ICDHIS_""")")) Q:+ICDHIS'>0 D
. . N ICDND,ICDST,ICDDT,ICDEDT,ICDP S ICDND=$G(@(ICDROOT_ICDIEN_",66,"_+ICDHIS_",0)"))
. . S ICDDT=$P(ICDND,"^",1),ICDST=$P(ICDND,"^",2)
. . S ICDST=$S(ICDST="1":"Active",ICDST="0":"Inactive",1:"") Q:'$L(ICDST)
. . S ICDP="" S:ICDTDT?7N&(ICDDT?7N)&(ICDTDT<ICDDT) ICDP=" (Pending)"
. . S ICDEDT=$$FMTE^XLFDT(ICDDT,"5Z") Q:'$L(ICDEDT) Q:$L(ICDEDT,"/")'=3 S ICDC=ICDC+1
. . W:ICDC=1 !!,?1,"History:" W ?15,$G(ICDEDT),?30,ICDST,ICDP,!
Q
SHOW ; Show Lookup Variables
W ! W:$L($G(DIC))!($L($G(DIC(0))))!($L($G(DIC("A")))) !," FileMan Variables",!
W:$L($G(DIC)) !,?2," Global Root/File:",?27,"DIC=""",$$QM($G(DIC)),""""
W:$L($G(DIC(0))) !,?2," FileMan Response:",?27,"DIC(0)=""",$$QM($G(DIC(0))),""""
W:$G(DIC(0))["A" !,?35,"A Ask the entry"
W:$G(DIC(0))["E" !,?35,"E Echo information"
W:$G(DIC(0))["F" !,?35,"F Forget the lookup value"
W:$G(DIC(0))["I" !,?35,"I Ignore the Special Lookup"
W:$G(DIC(0))["L" !,?35,"L Not allowed"
W:$G(DIC(0))["M" !,?35,"M Multiple-Index"
W:$G(DIC(0))["N" !,?35,"N IEN lookup allowed not forced"
W:$G(DIC(0))["n" !,?35,"n Partial matching on pure numeric"
W:$G(DIC(0))["O" !,?35,"O One exact match"
W:$G(DIC(0))["Q" !,?35,"Q Question erroneous input"
W:$G(DIC(0))["T" !,?35,"T Continue Searching"
W:$G(DIC(0))["X" !,?35,"X Exact match required"
W:$G(DIC(0))["Z" !,?35,"Z Zero node returned"
W:$L($G(DIC("A"))) !,?2," Prompt:",?27,"DIC(""A"")=""",$$QM($G(DIC("A"))),""""
W:$L($G(ICDSYS))!($L($G(ICDVDT)))!($L($G(ICDFMT))) !!," Special Variables",!
W:$L($G(ICDSYS)) !,?2," Coding System:",?27,"ICDSYS=""",$$QM($G(ICDSYS)),""""
W:$L($G(ICDSYS))&($L($G(ICDSY)))&($L($G(ICDTY))) ?45,$G(ICDSY)," ",$G(ICDTY)
W:$L($G(ICDVDT))&($G(ICDVDT)?7N) !,?2," Versioning Date:",?27,"ICDVDT=""",$$QM($G(ICDVDT)),""""
W:$L($G(ICDVDT))&($G(ICDVDT)?7N) ?45,$$FMTE^XLFDT($P(ICDVDT,".",1),"5Z")," (No inactive codes)"
W:'$L($G(ICDVDT)) !,?2," Versioning Date:",?27,"<null>"
W:'$L($G(ICDVDT)) ?45,"Active and Inactive codes shown"
I +($G(ICDFMT))>0 D
. W !,?2," Display Format:",?27,"ICDFMT=""",$$QM($G(ICDFMT)),""""
. W:+($G(ICDFMT))=1 ?45,"FileMan format, code followed ",!,?45,"by the short description."
. W:+($G(ICDFMT))=2 ?45,"Modified FileMan format, code ",!,?45,"followed by the long description."
. W:+($G(ICDFMT))=3 ?45,"Short Lexicon format, short ",!,?45,"description followed by the ",!,?45,"code."
. W:+($G(ICDFMT))=4 ?45,"Long Lexicon format, Long ",!,?45,"description followed by the ",!,?45,"code."
Q
QM(X) ; Quote Marks
N ICDPSN,ICDOUT,ICDINP S ICDINP=$G(X) Q:'$L(X) ""
S ICDOUT="" F ICDPSN=1:1:$L(ICDINP,$C(34)) D
. S ICDOUT=ICDOUT_$C(34)_$C(34)_$P(ICDINP,$C(34),ICDPSN)
S:$E(ICDOUT,1,2)="""""" ICDOUT=$E(ICDOUT,3,$L(ICDOUT)) S X=ICDOUT
Q X
TM(X,Y) ; Trim Character Y - Default " "
S X=$G(X) Q:X="" X S Y=$G(Y) S:'$L(Y) Y=" " Q:X'[Y X
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
ICDDIC ;ISL/KER - ICD Code Lookup Prototype (DIC) ;04/21/2014
+1 ;;18.0;DRG Grouper;**57**;Oct 20, 2000;Build 7
+2 ;
+3 ; Global Variables
+4 ; None
+5 ;
+6 ; External References
+7 ; $$DT^XLFDT ICR 10103
+8 ; $$FMTE^XLFDT ICR 10103
+9 ; ^DIC ICR 10006
+10 ;
+11 ; Local Variables NEWed or KILLed Elsewhere
+12 ; Y
+13 ;
EN ; Main Entry Point
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,ICD,ICDA,ICDB,ICDC,ICDCOD,ICDCS,ICDCDT,ICDD,ICDD1,ICDD2
+2 NEW ICDDP,ICDF,ICDFI,ICDFM,ICDFMT,ICDI,ICDID,ICDINP,ICDK,ICDLONG,ICDMFT,ICDMIX,ICDN
+3 NEW ICDO,ICDOA,ICDOUT,ICDPSN,ICDR,ICDS,ICDSHRT,ICDSRC,ICDSY,ICDSYS,ICDT,ICDTD,ICDTY
+4 NEW ICDU,ICDV,ICDVAL,ICDVD,ICDVDT,ICDVR,ICD
KILL X,Y
+5 DO EN^ICDDICA
IF $DATA(DTOUT)
WRITE !!," Try later",!
+6 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
WRITE !!," Abort lookup",!
IF $DATA(DUOUT)
QUIT
IF +($GET(ICDCS))>0
SET ICDSYS=+($GET(ICDCS))
+7 SET ICDFMT=1
IF +($GET(ICDFM))>0
SET ICDFMT=+($GET(ICDFM))
IF $GET(ICDVD)?7N
SET ICDVDT=$GET(ICDVD)
+8 IF +($GET(ICDVR))'>0
KILL ICDVDT
IF +($GET(ICDFM))>0
SET ICDMFT=+($GET(ICDFM))
SET ICDSY=$PIECE(ICDCS,"^",2)
+9 SET ICDTY=$SELECT(+ICDFI=80:"Diagnosis",+ICDFI=80.1:"Procedure",1:"")
+10 SET DIC=$SELECT(ICDDP="D":$$ROOT^ICDEX(80),ICDDP="P":$$ROOT^ICDEX(80.1),1:"")
+11 IF '$LENGTH(DIC)
WRITE !!," Invalid Global Root",!
+12 IF '$LENGTH(DIC)
QUIT
SET DIC("A")=" Enter an "_ICDSY_" "_ICDTY_": "
SET DIC(0)="AEQZ"
+13 IF '$LENGTH($$TM(ICDSY))
SET DIC("A")=" Enter a "_ICDTY_": "
SET DIC(0)="AEQZ"
+14 IF $LENGTH($GET(DIC0))
SET DIC(0)=DIC0
IF $DATA(ICDSHOW)
DO SHOW
KILL X,Y
DO ^DIC
DO OUT
NEW DIC0
+15 QUIT
EN2 ; Entry Point that Input Displays Variables
+1 NEW ICDSHOW
SET ICDSHOW=""
DO EN
+2 QUIT
ICD10D ;
+1 SET DIC=$$ROOT^ICDEX(80)
SET DIC("A")=" Enter an ICD-10 Diagnosis: "
SET DIC(0)="AEQZ"
SET ICDVDT=3141010
SET ICDSYS=30
+2 KILL X,Y
DO ^DIC
DO OUT
WRITE !
+3 QUIT
ICD10P ;
+1 SET DIC=$$ROOT^ICDEX(80.1)
SET DIC("A")=" Enter an ICD-10 Procedure: "
SET DIC(0)="AEQZ"
SET ICDVDT=3141010
SET ICDSYS=30
+2 KILL X,Y
DO ^DIC
DO OUT
WRITE !
+3 QUIT
ICD9D ;
+1 SET DIC=$$ROOT^ICDEX(80)
SET DIC("A")=" Enter an ICD-9 Diagnosis: "
SET DIC(0)="AEQZ"
SET ICDVDT=3120101
SET ICDSYS=1
+2 KILL X,Y
DO ^DIC
DO OUT
WRITE !
+3 QUIT
ICD9P ;
+1 SET DIC=$$ROOT^ICDEX(80.1)
SET DIC("A")=" Enter an ICD-10 Procedure: "
SET DIC(0)="AEQZ"
SET ICDVDT=3120101
SET ICDSYS=1
+2 KILL X,Y
DO ^DIC
DO OUT
WRITE !
+3 QUIT
OUT ; Output
+1 NEW ICDARY,ICDC,ICDCOD,ICDDT,ICDEF,ICDEFF,ICDHIS,ICDI
+2 NEW ICDIEN,ICDLON,ICDND,ICDROOT,ICDSHT,ICDST,ICDTDT,ICDX
+3 SET ICDX=$GET(X)
IF +Y'>0
IF $LENGTH($PIECE(Y,"^",2))
Begin DoDot:1
+4 ;W !!," ERROR: ",$P(Y,"^",2),! S X=ICDX
End DoDot:1
QUIT
+5 SET ICDIEN=+Y
IF +ICDIEN'>0
QUIT
+6 SET ICDCOD=$PIECE(Y,"^",2)
IF '$LENGTH(ICDCOD)
QUIT
+7 SET ICDROOT=$$ROOT^ICDEX(+($GET(ICDFI)))
IF '$LENGTH(ICDROOT)
QUIT
+8 SET ICDSHT=$PIECE($GET(Y(0,1)),"^",4)
+9 IF '$LENGTH(ICDSHT)
SET ICDSHT=$$SD^ICDEX(+($GET(ICDFI)),$GET(ICDIEN),$PIECE($GET(ICDVDT),".",1))
+10 IF '$LENGTH(ICDSHT)
Begin DoDot:1
+11 NEW ICDEFF,ICDHIS
SET ICDEFF=$ORDER(@(ICDROOT_ICDIEN_",67,""B"","" "")"),-1)
+12 SET ICDHIS=$ORDER(@(ICDROOT_ICDIEN_",67,""B"","_+ICDEFF_","" "")"),-1)
+13 SET ICDSHT=$GET(@(ICDROOT_ICDIEN_",67,"_+ICDHIS_",0)"))
+14 SET ICDSHT=$PIECE(ICDSHT,"^",2)
End DoDot:1
+15 SET ICDLON=$GET(Y(0,2))
+16 IF '$LENGTH(ICDLON)
SET ICDLON=$$LD^ICDEX(+($GET(ICDFI)),$GET(ICDIEN),$PIECE($GET(ICDVDT),".",1))
+17 IF '$LENGTH(ICDLON)
Begin DoDot:1
+18 NEW ICDEFF,ICDHIS
SET ICDEFF=$ORDER(@(ICDROOT_ICDIEN_",68,""B"","" "")"),-1)
+19 SET ICDHIS=$ORDER(@(ICDROOT_ICDIEN_",68,""B"","_+ICDEFF_","" "")"),-1)
+20 SET ICDLON=$GET(@(ICDROOT_ICDIEN_",68,"_+ICDHIS_",0)"))
End DoDot:1
+21 IF '$LENGTH(ICDSHT)
QUIT
IF '$LENGTH(ICDLON)
QUIT
+22 SET ICDARY(1)=ICDLON
DO PAR^ICDEX(.ICDARY,(78-15))
+23 WRITE !!,?1,ICDCOD,?15,ICDSHT
+24 WRITE !!,?1,"Description:",?15,$GET(ICDARY(1))
+25 SET ICDI=1
FOR
SET ICDI=$ORDER(ICDARY(ICDI))
IF +ICDI'>0
QUIT
WRITE !,?15,$GET(ICDARY(ICDI))
+26 SET ICDTDT=$$DT^XLFDT
IF $GET(ICDVDT)?7N
SET ICDTDT=ICDVDT
+27 SET ICDC=0
SET ICDEFF=0
FOR
SET ICDEFF=$ORDER(@(ICDROOT_ICDIEN_",66,""B"","""_ICDEFF_""")"))
IF '$LENGTH(ICDEFF)
QUIT
Begin DoDot:1
+28 IF ICDEFF'?7N
QUIT
NEW ICDHIS
SET ICDHIS=0
+29 FOR
SET ICDHIS=$ORDER(@(ICDROOT_ICDIEN_",66,""B"","""_ICDEFF_""","""_ICDHIS_""")"))
IF +ICDHIS'>0
QUIT
Begin DoDot:2
+30 NEW ICDND,ICDST,ICDDT,ICDEDT,ICDP
SET ICDND=$GET(@(ICDROOT_ICDIEN_",66,"_+ICDHIS_",0)"))
+31 SET ICDDT=$PIECE(ICDND,"^",1)
SET ICDST=$PIECE(ICDND,"^",2)
+32 SET ICDST=$SELECT(ICDST="1":"Active",ICDST="0":"Inactive",1:"")
IF '$LENGTH(ICDST)
QUIT
+33 SET ICDP=""
IF ICDTDT?7N&(ICDDT?7N)&(ICDTDT<ICDDT)
SET ICDP=" (Pending)"
+34 SET ICDEDT=$$FMTE^XLFDT(ICDDT,"5Z")
IF '$LENGTH(ICDEDT)
QUIT
IF $LENGTH(ICDEDT,"/")'=3
QUIT
SET ICDC=ICDC+1
+35 IF ICDC=1
WRITE !!,?1,"History:"
WRITE ?15,$GET(ICDEDT),?30,ICDST,ICDP,!
End DoDot:2
End DoDot:1
+36 QUIT
SHOW ; Show Lookup Variables
+1 WRITE !
IF $LENGTH($GET(DIC))!($LENGTH($GET(DIC(0))))!($LENGTH($GET(DIC("A"))))
WRITE !," FileMan Variables",!
+2 IF $LENGTH($GET(DIC))
WRITE !,?2," Global Root/File:",?27,"DIC=""",$$QM($GET(DIC)),""""
+3 IF $LENGTH($GET(DIC(0)))
WRITE !,?2," FileMan Response:",?27,"DIC(0)=""",$$QM($GET(DIC(0))),""""
+4 IF $GET(DIC(0))["A"
WRITE !,?35,"A Ask the entry"
+5 IF $GET(DIC(0))["E"
WRITE !,?35,"E Echo information"
+6 IF $GET(DIC(0))["F"
WRITE !,?35,"F Forget the lookup value"
+7 IF $GET(DIC(0))["I"
WRITE !,?35,"I Ignore the Special Lookup"
+8 IF $GET(DIC(0))["L"
WRITE !,?35,"L Not allowed"
+9 IF $GET(DIC(0))["M"
WRITE !,?35,"M Multiple-Index"
+10 IF $GET(DIC(0))["N"
WRITE !,?35,"N IEN lookup allowed not forced"
+11 IF $GET(DIC(0))["n"
WRITE !,?35,"n Partial matching on pure numeric"
+12 IF $GET(DIC(0))["O"
WRITE !,?35,"O One exact match"
+13 IF $GET(DIC(0))["Q"
WRITE !,?35,"Q Question erroneous input"
+14 IF $GET(DIC(0))["T"
WRITE !,?35,"T Continue Searching"
+15 IF $GET(DIC(0))["X"
WRITE !,?35,"X Exact match required"
+16 IF $GET(DIC(0))["Z"
WRITE !,?35,"Z Zero node returned"
+17 IF $LENGTH($GET(DIC("A")))
WRITE !,?2," Prompt:",?27,"DIC(""A"")=""",$$QM($GET(DIC("A"))),""""
+18 IF $LENGTH($GET(ICDSYS))!($LENGTH($GET(ICDVDT)))!($LENGTH($GET(ICDFMT)))
WRITE !!," Special Variables",!
+19 IF $LENGTH($GET(ICDSYS))
WRITE !,?2," Coding System:",?27,"ICDSYS=""",$$QM($GET(ICDSYS)),""""
+20 IF $LENGTH($GET(ICDSYS))&($LENGTH($GET(ICDSY)))&($LENGTH($GET(ICDTY)))
WRITE ?45,$GET(ICDSY)," ",$GET(ICDTY)
+21 IF $LENGTH($GET(ICDVDT))&($GET(ICDVDT)?7N)
WRITE !,?2," Versioning Date:",?27,"ICDVDT=""",$$QM($GET(ICDVDT)),""""
+22 IF $LENGTH($GET(ICDVDT))&($GET(ICDVDT)?7N)
WRITE ?45,$$FMTE^XLFDT($PIECE(ICDVDT,".",1),"5Z")," (No inactive codes)"
+23 IF '$LENGTH($GET(ICDVDT))
WRITE !,?2," Versioning Date:",?27,"<null>"
+24 IF '$LENGTH($GET(ICDVDT))
WRITE ?45,"Active and Inactive codes shown"
+25 IF +($GET(ICDFMT))>0
Begin DoDot:1
+26 WRITE !,?2," Display Format:",?27,"ICDFMT=""",$$QM($GET(ICDFMT)),""""
+27 IF +($GET(ICDFMT))=1
WRITE ?45,"FileMan format, code followed ",!,?45,"by the short description."
+28 IF +($GET(ICDFMT))=2
WRITE ?45,"Modified FileMan format, code ",!,?45,"followed by the long description."
+29 IF +($GET(ICDFMT))=3
WRITE ?45,"Short Lexicon format, short ",!,?45,"description followed by the ",!,?45,"code."
+30 IF +($GET(ICDFMT))=4
WRITE ?45,"Long Lexicon format, Long ",!,?45,"description followed by the ",!,?45,"code."
End DoDot:1
+31 QUIT
QM(X) ; Quote Marks
+1 NEW ICDPSN,ICDOUT,ICDINP
SET ICDINP=$GET(X)
IF '$LENGTH(X)
QUIT ""
+2 SET ICDOUT=""
FOR ICDPSN=1:1:$LENGTH(ICDINP,$CHAR(34))
Begin DoDot:1
+3 SET ICDOUT=ICDOUT_$CHAR(34)_$CHAR(34)_$PIECE(ICDINP,$CHAR(34),ICDPSN)
End DoDot:1
+4 IF $EXTRACT(ICDOUT,1,2)=""""""
SET ICDOUT=$EXTRACT(ICDOUT,3,$LENGTH(ICDOUT))
SET X=ICDOUT
+5 QUIT X
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=" "
IF X'[Y
QUIT X
+2 FOR
IF $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 FOR
IF $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 QUIT X
