LA7UTL02 ;HOIFO/BH - Cytopathology Query Utility ; 10/28/03 8:40am
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69**;Sep 27, 1994
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)."
 . . S QUIT=1
 . I ICD9="" Q
 . S @RET@("ICD9",ICDIEN)=ICD9
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UTL02   5994     printed  Sep 23, 2025@19:16                                                                                                                                                                                                       Page 2
LA7UTL02  ;HOIFO/BH - Cytopathology Query Utility ; 10/28/03 8:40am
 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**69**;Sep 27, 1994
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                        IF $GET(ERR)'=""
                               SET @ERR@("-1")="Fileman Error within GET1 call (ICD9 data)."
 +9                        SET QUIT=1
                       End DoDot:2
                       QUIT 
 +10               IF ICD9=""
                       QUIT 
 +11               SET @RET@("ICD9",ICDIEN)=ICD9
               End DoDot:1
 +12       QUIT 
 +13      ;