LA7UTL02.m

LA7UTL02 ;VA/HOIFO/BH - Cytopathology Query Utility ; 17-Oct-2014 09:22 ; MKK

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1027,1032,1034**;NOV 01, 1997;Build 88

 ;

 ;;VA LR Patch(s): 69

 ;

CYPATH(LRDFN,IEN,RET,ERR) ; Returns data for a Cytopathology Encounter

 ;

 ; Input:

 ;

 ; LRDFN - Patient Lab DFN                        (Required)

 ; IEN   - IEN of CY entry                        (Required)

 ; RET   - Array reference for passing back data  (Required)

 ; ERR   - Error array to pass back               (Not required)

 ;

 ; Output:

 ;

 ; '0' - If the API encountered an Error along with @ERR array

 ;

 ; '1' - if the API ran successfully and the following data if it exists

 ;

 ;   Visit Date field .01 and Accession Number field .06 of file 63.09.

 ;   @RET("DEMO",ien of visit)=Visit Date^Accession Number

 ;

 ;   Specimen field .01 of sub file 63.902.

 ;   @RET("SPEC",ien of Specimen entry)=Specimen Data

 ;

 ;   Clinical History field .01 of sub file 63.913.

 ;   @RET("CHIS",ien of the Clinical History entry)=Clinical His.

 ;

 ;   Pre Operative Diagnosis field .01 of sub file 63.914.

 ;   @RET@("PREDX",ien of the Pre. Op. Diagnosis entry)=Pre Op Diag.

 ;

 ;   Operative Diagnosis field .01 of sub file 63.905. 

 ;   @RET@("OPERDX",ien of the Op. Diagnosis entry)=Op Diag.

 ;

 ;   Post Opertive Diagnosis field .01 of sub file 63.906.

 ;   @RET@("POSTDX,ien of the Post. Op Diagnosis entry)=Pst. Op Diag.

 ;

 ;   Cytopathology Diagnosis field .01 of sub file 63.903. 

 ;   @RET@("CYTODX",ien of the Cytopathology Diagnosis entry)=Cyto Dx

 ;

 ;   Microscopic Examination field .01 of sub file 63.911.

 ;   @RET@("MICRO",ien of the Microscopic Examination entry)=Micro. Exam

 ;

 ;   ICD field .01 of sub file 63.901.

 ;   @RET@("ICD9",ien of Cyto ien entry)=ICD9 (external)

 ;

 ; ---------------------------------------------------------------------

 ;

 K @RET

 K @ERR

 I $G(LRDFN)="" D  Q 0

 . I $G(ERR)'="" S @ERR@("-1")="No Lab DFN." Q

 ;

 I $G(IEN)="" D  Q 0

 . I $G(ERR)'="" S @ERR@("-1")="No Cytopathology record IEN." Q

 ;

 I $G(RET)="" D  Q 0

 . I $G(ERR)'="" S @ERR@("-1")="No results array reference passed." Q

 ;

 N QUIT

 D DEMO

 I 'QUIT D SPECIMEN

 I 'QUIT D HISTORY

 I 'QUIT D PDIAG

 I 'QUIT D OPDIAG

 I 'QUIT D POSTDIAG

 I 'QUIT D CYTOPATH

 I 'QUIT D MICRO

 I 'QUIT D ICD

 I QUIT Q 0

 Q 1

 ;

 ;

DEMO ; Get basic demographics

 N VDATE S QUIT=0

 S VDATE=$$GET1^DIQ(63.09,IEN_","_LRDFN,.01,"I")

 I VDATE=""!($G(DIERR)) S QUIT=1 Q

 S ANUM=$$GET1^DIQ(63.09,IEN_","_LRDFN,.06,"I")

 I $G(DIERR) S QUIT=1 Q

 S @RET@("DEMO",IEN)=VDATE_"^"_ANUM

 Q

 ;

 ;

SPECIMEN ;

 N SPIENS,SPIEN,SPECIMEN S SPIEN="0"

 F  S SPIEN=$O(^LR(LRDFN,"CY",IEN,.1,SPIEN)) Q:'SPIEN!(QUIT)  D

 . Q:QUIT

 . S SPIENS=SPIEN_","_IEN_","_LRDFN_","

 . S SPECIMEN=$$GET1^DIQ(63.902,SPIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Specimen data)."

 . . S QUIT=1

 . I SPECIMEN="" Q

 . S @RET@("SPEC",SPIEN)=SPECIMEN

 Q

 ;

 ;

HISTORY N CHIENS,CHIEN,HISTORY S CHIEN="0"

 F  S CHIEN=$O(^LR(LRDFN,"CY",IEN,.2,CHIEN)) Q:'CHIEN!(QUIT)  D

 . Q:QUIT

 . S CHIENS=CHIEN_","_IEN_","_LRDFN_","

 . S HISTORY=$$GET1^DIQ(63.913,CHIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Clinical History data)."

 . . S QUIT=1

 . I HISTORY="" Q

 . S @RET@("CHIS",CHIEN)=HISTORY

 Q

 ;

PDIAG N PDIENS,PDIEN,PREOPDX S PDIEN="0"

 F  S PDIEN=$O(^LR(LRDFN,"CY",IEN,.3,PDIEN)) Q:'PDIEN!(QUIT)  D

 . Q:QUIT

 . S PDIENS=PDIEN_","_IEN_","_LRDFN_","

 . S PREOPDX=$$GET1^DIQ(63.914,PDIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Pre Operative Diagnosis data)."

 . . S QUIT=1

 . I PREOPDX="" Q

 . S @RET@("PREDX",PDIEN)=PREOPDX

 Q

 ;

 ;

OPDIAG N ODIENS,ODIEN,OPERDX S ODIEN="0"

 F  S ODIEN=$O(^LR(LRDFN,"CY",IEN,.4,ODIEN)) Q:'ODIEN!(QUIT)  D

 . Q:QUIT

 . S ODIENS=ODIEN_","_IEN_","_LRDFN_","

 . S OPERDX=$$GET1^DIQ(63.905,ODIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Operative Diagnosis data)."

 . . S QUIT=1

 . I OPERDX="" Q

 . S @RET@("OPERDX",ODIEN)=OPERDX

 Q

 ;

 ;

POSTDIAG ;

 N PSDIENS,PSDIEN,POSTDX S PSDIEN="0"

 F  S PSDIEN=$O(^LR(LRDFN,"CY",IEN,.5,PSDIEN)) Q:'PSDIEN!(QUIT)  D

 . Q:QUIT

 . S PSDIENS=PSDIEN_","_IEN_","_LRDFN_","

 . S POSTDX=$$GET1^DIQ(63.906,PSDIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Post Operative Diagnosis data)."

 . . S QUIT=1

 . I POSTDX="" Q

 . S @RET@("POSTDX",PSDIEN)=POSTDX

 Q

 ;

CYTOPATH ; - Cyto Pathology

 N CYIENS,CYIEN,CYTODX S CYIEN="0"

 F  S CYIEN=$O(^LR(LRDFN,"CY",IEN,1.4,CYIEN)) Q:'CYIEN!(QUIT)  D

 . Q:QUIT

 . S CYIENS=CYIEN_","_IEN_","_LRDFN_","

 . S CYTODX=$$GET1^DIQ(63.903,CYIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Cytopathology diagnosis data)."

 . . S QUIT=1

 . I CYTODX="" Q

 . S @RET@("CYTODX",CYIEN)=CYTODX

 Q

 ;

MICRO ; - Microscopic Exam

 N MICIENS,MICEXAM,MICIEN S MICIEN="0"

 F  S MICIEN=$O(^LR(LRDFN,"CY",IEN,1.1,MICIEN)) Q:'MICIEN!(QUIT)  D

 . Q:QUIT

 . S MICIENS=MICIEN_","_IEN_","_LRDFN_","

 . S MICEXAM=$$GET1^DIQ(63.911,MICIENS,.01,"I")

 . I $G(DIERR) D  Q

 . . K @RET

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (Cytopathology Microscopic Examination)"

 . . S QUIT=1

 . I MICEXAM="" Q

 . S @RET@("MICRO",MICIEN)=MICEXAM

 Q

 ;

 ;

ICD ; - Get ICD Data

 N ICDIENS,ICDIEN,ICD9 S ICDIEN="0"

 F  S ICDIEN=$O(^LR(LRDFN,"CY",IEN,3,ICDIEN)) Q:'ICDIEN!(QUIT)  D

 . Q:QUIT

 . S ICDIENS=ICDIEN_","_IEN_","_LRDFN_","

 . S ICD9=$$GET1^DIQ(63.901,ICDIENS,.01,"E")

 . I $G(DIERR) D  Q

 . . K @RET

 . . ; I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (ICD9 data)."

 . . I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (ICD data)."  ; IHS/MSC/MKK - LR*5.2*1034

 . . S QUIT=1

 . I ICD9="" Q

 . S @RET@("ICD9",ICDIEN)=ICD9

 Q

 ;

LA7UTL02  ;VA/HOIFO/BH - Cytopathology Query Utility ; 17-Oct-2014 09:22 ; MKK

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**1027,1032,1034**;NOV 01, 1997;Build 88

 +2       ;

 +3       ;;VA LR Patch(s): 69

 +4       ;

CYPATH(LRDFN,IEN,RET,ERR) ; Returns data for a Cytopathology Encounter

 +1       ;

 +2       ; Input:

 +3       ;

 +4       ; LRDFN - Patient Lab DFN                        (Required)

 +5       ; IEN   - IEN of CY entry                        (Required)

 +6       ; RET   - Array reference for passing back data  (Required)

 +7       ; ERR   - Error array to pass back               (Not required)

 +8       ;

 +9       ; Output:

 +10      ;

 +11      ; '0' - If the API encountered an Error along with @ERR array

 +12      ;

 +13      ; '1' - if the API ran successfully and the following data if it exists

 +14      ;

 +15      ;   Visit Date field .01 and Accession Number field .06 of file 63.09.

 +16      ;   @RET("DEMO",ien of visit)=Visit Date^Accession Number

 +17      ;

 +18      ;   Specimen field .01 of sub file 63.902.

 +19      ;   @RET("SPEC",ien of Specimen entry)=Specimen Data

 +20      ;

 +21      ;   Clinical History field .01 of sub file 63.913.

 +22      ;   @RET("CHIS",ien of the Clinical History entry)=Clinical His.

 +23      ;

 +24      ;   Pre Operative Diagnosis field .01 of sub file 63.914.

 +25      ;   @RET@("PREDX",ien of the Pre. Op. Diagnosis entry)=Pre Op Diag.

 +26      ;

 +27      ;   Operative Diagnosis field .01 of sub file 63.905. 

 +28      ;   @RET@("OPERDX",ien of the Op. Diagnosis entry)=Op Diag.

 +29      ;

 +30      ;   Post Opertive Diagnosis field .01 of sub file 63.906.

 +31      ;   @RET@("POSTDX,ien of the Post. Op Diagnosis entry)=Pst. Op Diag.

 +32      ;

 +33      ;   Cytopathology Diagnosis field .01 of sub file 63.903. 

 +34      ;   @RET@("CYTODX",ien of the Cytopathology Diagnosis entry)=Cyto Dx

 +35      ;

 +36      ;   Microscopic Examination field .01 of sub file 63.911.

 +37      ;   @RET@("MICRO",ien of the Microscopic Examination entry)=Micro. Exam

 +38      ;

 +39      ;   ICD field .01 of sub file 63.901.

 +40      ;   @RET@("ICD9",ien of Cyto ien entry)=ICD9 (external)

 +41      ;

 +42      ; ---------------------------------------------------------------------

 +43      ;

 +44       KILL @RET

 +45       KILL @ERR

 +46       IF $GET(LRDFN)=""

               Begin DoDot:1

 +47               IF $GET(ERR)'=""

                       SET @ERR@("-1")="No Lab DFN."

                       QUIT 

               End DoDot:1

               QUIT 0

 +48      ;

 +49       IF $GET(IEN)=""

               Begin DoDot:1

 +50               IF $GET(ERR)'=""

                       SET @ERR@("-1")="No Cytopathology record IEN."

                       QUIT 

               End DoDot:1

               QUIT 0

 +51      ;

 +52       IF $GET(RET)=""

               Begin DoDot:1

 +53               IF $GET(ERR)'=""

                       SET @ERR@("-1")="No results array reference passed."

                       QUIT 

               End DoDot:1

               QUIT 0

 +54      ;

 +55       NEW QUIT

 +56       DO DEMO

 +57       IF 'QUIT

               DO SPECIMEN

 +58       IF 'QUIT

               DO HISTORY

 +59       IF 'QUIT

               DO PDIAG

 +60       IF 'QUIT

               DO OPDIAG

 +61       IF 'QUIT

               DO POSTDIAG

 +62       IF 'QUIT

               DO CYTOPATH

 +63       IF 'QUIT

               DO MICRO

 +64       IF 'QUIT

               DO ICD

 +65       IF QUIT

               QUIT 0

 +66       QUIT 1

 +67      ;

 +68      ;

DEMO      ; Get basic demographics

 +1        NEW VDATE

           SET QUIT=0

 +2        SET VDATE=$$GET1^DIQ(63.09,IEN_","_LRDFN,.01,"I")

 +3        IF VDATE=""!($GET(DIERR))

               SET QUIT=1

               QUIT 

 +4        SET ANUM=$$GET1^DIQ(63.09,IEN_","_LRDFN,.06,"I")

 +5        IF $GET(DIERR)

               SET QUIT=1

               QUIT 

 +6        SET @RET@("DEMO",IEN)=VDATE_"^"_ANUM

 +7        QUIT 

 +8       ;

 +9       ;

SPECIMEN  ;

 +1        NEW SPIENS,SPIEN,SPECIMEN

           SET SPIEN="0"

 +2        FOR 

               SET SPIEN=$ORDER(^LR(LRDFN,"CY",IEN,.1,SPIEN))

               IF 'SPIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +3                IF QUIT

                       QUIT 

 +4                SET SPIENS=SPIEN_","_IEN_","_LRDFN_","

 +5                SET SPECIMEN=$$GET1^DIQ(63.902,SPIENS,.01,"I")

 +6                IF $GET(DIERR)

                       Begin DoDot:2

 +7                        KILL @RET

 +8                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Specimen data)."

 +9                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +10               IF SPECIMEN=""

                       QUIT 

 +11               SET @RET@("SPEC",SPIEN)=SPECIMEN

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;

HISTORY    NEW CHIENS,CHIEN,HISTORY

           SET CHIEN="0"

 +1        FOR 

               SET CHIEN=$ORDER(^LR(LRDFN,"CY",IEN,.2,CHIEN))

               IF 'CHIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +2                IF QUIT

                       QUIT 

 +3                SET CHIENS=CHIEN_","_IEN_","_LRDFN_","

 +4                SET HISTORY=$$GET1^DIQ(63.913,CHIENS,.01,"I")

 +5                IF $GET(DIERR)

                       Begin DoDot:2

 +6                        KILL @RET

 +7                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Clinical History data)."

 +8                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +9                IF HISTORY=""

                       QUIT 

 +10               SET @RET@("CHIS",CHIEN)=HISTORY

               End DoDot:1

 +11       QUIT 

 +12      ;

PDIAG      NEW PDIENS,PDIEN,PREOPDX

           SET PDIEN="0"

 +1        FOR 

               SET PDIEN=$ORDER(^LR(LRDFN,"CY",IEN,.3,PDIEN))

               IF 'PDIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +2                IF QUIT

                       QUIT 

 +3                SET PDIENS=PDIEN_","_IEN_","_LRDFN_","

 +4                SET PREOPDX=$$GET1^DIQ(63.914,PDIENS,.01,"I")

 +5                IF $GET(DIERR)

                       Begin DoDot:2

 +6                        KILL @RET

 +7                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Pre Operative Diagnosis data)."

 +8                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +9                IF PREOPDX=""

                       QUIT 

 +10               SET @RET@("PREDX",PDIEN)=PREOPDX

               End DoDot:1

 +11       QUIT 

 +12      ;

 +13      ;

OPDIAG     NEW ODIENS,ODIEN,OPERDX

           SET ODIEN="0"

 +1        FOR 

               SET ODIEN=$ORDER(^LR(LRDFN,"CY",IEN,.4,ODIEN))

               IF 'ODIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +2                IF QUIT

                       QUIT 

 +3                SET ODIENS=ODIEN_","_IEN_","_LRDFN_","

 +4                SET OPERDX=$$GET1^DIQ(63.905,ODIENS,.01,"I")

 +5                IF $GET(DIERR)

                       Begin DoDot:2

 +6                        KILL @RET

 +7                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Operative Diagnosis data)."

 +8                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +9                IF OPERDX=""

                       QUIT 

 +10               SET @RET@("OPERDX",ODIEN)=OPERDX

               End DoDot:1

 +11       QUIT 

 +12      ;

 +13      ;

POSTDIAG  ;

 +1        NEW PSDIENS,PSDIEN,POSTDX

           SET PSDIEN="0"

 +2        FOR 

               SET PSDIEN=$ORDER(^LR(LRDFN,"CY",IEN,.5,PSDIEN))

               IF 'PSDIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +3                IF QUIT

                       QUIT 

 +4                SET PSDIENS=PSDIEN_","_IEN_","_LRDFN_","

 +5                SET POSTDX=$$GET1^DIQ(63.906,PSDIENS,.01,"I")

 +6                IF $GET(DIERR)

                       Begin DoDot:2

 +7                        KILL @RET

 +8                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Post Operative Diagnosis data)."

 +9                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +10               IF POSTDX=""

                       QUIT 

 +11               SET @RET@("POSTDX",PSDIEN)=POSTDX

               End DoDot:1

 +12       QUIT 

 +13      ;

CYTOPATH  ; - Cyto Pathology

 +1        NEW CYIENS,CYIEN,CYTODX

           SET CYIEN="0"

 +2        FOR 

               SET CYIEN=$ORDER(^LR(LRDFN,"CY",IEN,1.4,CYIEN))

               IF 'CYIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +3                IF QUIT

                       QUIT 

 +4                SET CYIENS=CYIEN_","_IEN_","_LRDFN_","

 +5                SET CYTODX=$$GET1^DIQ(63.903,CYIENS,.01,"I")

 +6                IF $GET(DIERR)

                       Begin DoDot:2

 +7                        KILL @RET

 +8                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Cytopathology diagnosis data)."

 +9                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +10               IF CYTODX=""

                       QUIT 

 +11               SET @RET@("CYTODX",CYIEN)=CYTODX

               End DoDot:1

 +12       QUIT 

 +13      ;

MICRO     ; - Microscopic Exam

 +1        NEW MICIENS,MICEXAM,MICIEN

           SET MICIEN="0"

 +2        FOR 

               SET MICIEN=$ORDER(^LR(LRDFN,"CY",IEN,1.1,MICIEN))

               IF 'MICIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +3                IF QUIT

                       QUIT 

 +4                SET MICIENS=MICIEN_","_IEN_","_LRDFN_","

 +5                SET MICEXAM=$$GET1^DIQ(63.911,MICIENS,.01,"I")

 +6                IF $GET(DIERR)

                       Begin DoDot:2

 +7                        KILL @RET

 +8                        IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (Cytopathology Microscopic Examination)"

 +9                        SET QUIT=1

                       End DoDot:2

                       QUIT 

 +10               IF MICEXAM=""

                       QUIT 

 +11               SET @RET@("MICRO",MICIEN)=MICEXAM

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;

ICD       ; - Get ICD Data

 +1        NEW ICDIENS,ICDIEN,ICD9

           SET ICDIEN="0"

 +2        FOR 

               SET ICDIEN=$ORDER(^LR(LRDFN,"CY",IEN,3,ICDIEN))

               IF 'ICDIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +3                IF QUIT

                       QUIT 

 +4                SET ICDIENS=ICDIEN_","_IEN_","_LRDFN_","

 +5                SET ICD9=$$GET1^DIQ(63.901,ICDIENS,.01,"E")

 +6                IF $GET(DIERR)

                       Begin DoDot:2

 +7                        KILL @RET

 +8       ; I $G(ERR)'="" S @ERR@("-1")="Fileman Error within GET1 call (ICD9 data)."

 +9       ; IHS/MSC/MKK - LR*5.2*1034

                           IF $GET(ERR)'=""

                               SET @ERR@("-1")="Fileman Error within GET1 call (ICD data)."

 +10                       SET QUIT=1

                       End DoDot:2

                       QUIT 

 +11               IF ICD9=""

                       QUIT 

 +12               SET @RET@("ICD9",ICDIEN)=ICD9

               End DoDot:1

 +13       QUIT 

 +14      ;