- LEXQIPA ;ISL/KER - Query - ICD Procedure - Ask ;04/21/2014
- ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- ;
- ; Global Variables
- ; None
- ;
- ; External References
- ; ^DIC ICR 10006
- ; $$CSI^ICDEX ICR 5747
- ; $$ICDOP^ICDEX ICR 5747
- ; $$ROOT^ICDEX ICR 5747
- ; $$DT^XLFDT ICR 10103
- ; $$UP^XLFSTR ICR 10104
- ;
- ; Local Variables NEWed or KILLed in LEXQIP
- ; LEXCDT,LEXEXIT
- ;
- Q
- ICP(X) ; ICD DX Code
- Q:+($G(LEXEXIT))>0 "^^" N DIC,DTOUT,DUOUT,LEXDX,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICDVDT,ICDSYS,ICDFMT S ICDFMT=2
- S DIC(0)="AEQMZ",DIC=$$ROOT^ICDEX(80.1),DIC("A")=" Select an ICD Procedure code: " W !
- D ^DIC S:$G(X)["^^"!($D(DTOUT)) LEXEXIT=1 Q:$G(X)["^^"!(+($G(LEXEXIT))>0) "^^"
- Q:$G(X)="^" "^" Q:$G(X)["^^" "^^" Q:$D(DTOUT)!($D(DUOUT)) "^" S LEXSO=$P($G(Y),"^",2) S X="" I +Y>0,$L(LEXSO) D
- . N LEXSYS S LEXSYS=$$CSI^ICDEX(80.1,+Y),LEXVDT=$G(LEXCDT) S:LEXVDT'?7N LEXVDT=$$DT^XLFDT S X=Y,LEXDTXT=$P($G(Y(0)),"^",2)
- . S LEXDX=$$ICDOP^ICDEX(LEXSO,LEXVDT,LEXSYS,"E") S:$L($G(LEXDTXT)) LEXDTXT=LEXDTXT_" (Text not Versioned)"
- . S LEXVTXT=$P(LEXDX,"^",5) S:'$L(LEXVTXT) LEXVTXT=LEXDTXT
- . S X=+Y_"^"_LEXSO S:$L(LEXVTXT) X=X_"^"_LEXVTXT
- S X=$$UP^XLFSTR(X) Q:'$L(X) "^"
- Q X
- LEXQIPA ;ISL/KER - Query - ICD Procedure - Ask ;04/21/2014
- +1 ;;2.0;LEXICON UTILITY;**62,80**;Sep 23, 1996;Build 10
- +2 ;
- +3 ; Global Variables
- +4 ; None
- +5 ;
- +6 ; External References
- +7 ; ^DIC ICR 10006
- +8 ; $$CSI^ICDEX ICR 5747
- +9 ; $$ICDOP^ICDEX ICR 5747
- +10 ; $$ROOT^ICDEX ICR 5747
- +11 ; $$DT^XLFDT ICR 10103
- +12 ; $$UP^XLFSTR ICR 10104
- +13 ;
- +14 ; Local Variables NEWed or KILLed in LEXQIP
- +15 ; LEXCDT,LEXEXIT
- +16 ;
- +17 QUIT
- ICP(X) ; ICD DX Code
- +1 IF +($GET(LEXEXIT))>0
- QUIT "^^"
- NEW DIC,DTOUT,DUOUT,LEXDX,LEXSO,LEXDTXT,LEXVTXT,LEXVDT,Y,ICDVDT,ICDSYS,ICDFMT
- SET ICDFMT=2
- +2 SET DIC(0)="AEQMZ"
- SET DIC=$$ROOT^ICDEX(80.1)
- SET DIC("A")=" Select an ICD Procedure code: "
- WRITE !
- +3 DO ^DIC
- IF $GET(X)["^^"!($DATA(DTOUT))
- SET LEXEXIT=1
- IF $GET(X)["^^"!(+($GET(LEXEXIT))>0)
- QUIT "^^"
- +4 IF $GET(X)="^"
- QUIT "^"
- IF $GET(X)["^^"
- QUIT "^^"
- IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT "^"
- SET LEXSO=$PIECE($GET(Y),"^",2)
- SET X=""
- IF +Y>0
- IF $LENGTH(LEXSO)
- Begin DoDot:1
- +5 NEW LEXSYS
- SET LEXSYS=$$CSI^ICDEX(80.1,+Y)
- SET LEXVDT=$GET(LEXCDT)
- IF LEXVDT'?7N
- SET LEXVDT=$$DT^XLFDT
- SET X=Y
- SET LEXDTXT=$PIECE($GET(Y(0)),"^",2)
- +6 SET LEXDX=$$ICDOP^ICDEX(LEXSO,LEXVDT,LEXSYS,"E")
- IF $LENGTH($GET(LEXDTXT))
- SET LEXDTXT=LEXDTXT_" (Text not Versioned)"
- +7 SET LEXVTXT=$PIECE(LEXDX,"^",5)
- IF '$LENGTH(LEXVTXT)
- SET LEXVTXT=LEXDTXT
- +8 SET X=+Y_"^"_LEXSO
- IF $LENGTH(LEXVTXT)
- SET X=X_"^"_LEXVTXT
- End DoDot:1
- +9 SET X=$$UP^XLFSTR(X)
- IF '$LENGTH(X)
- QUIT "^"
- +10 QUIT X
