LEXQIPA.m

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