Routine: ORDV02A

ORDV02A ; slc/dcm - OE/RR Report Extracts ; 4/15/21 1:08pm

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,377,498**;Dec 17, 1997;Build 38

 ; DBIA 4751 - IMGCNT^TIUSRVLO

 ;LAB Components

EM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)      ;Electron Microscopy

 ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 S OROMEGA=1,ORALPHA=9999999,ORMAX=9999

 I $L($T(GCPR^OMGCOAS1)) D  ; Call if FHIE station 200

 . N BEG,END

 . Q:'$G(ORALPHA)  Q:'$G(OROMEGA)

 . S ORMAX=$S(+$G(ORMAX)>0:ORMAX,1:999)

 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA

 . D GCPR^OMGCOAS1(DFN,"EM",BEG,END,ORMAX)

 D GET

CY(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)      ;Cytology

 ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 S OROMEGA=1,ORALPHA=9999999,ORMAX=9999

 I $L($T(GCPR^OMGCOAS1)) D  ; Call if FHIE station 200

 . N BEG,END

 . Q:'$G(ORALPHA)  Q:'$G(OROMEGA)

 . S ORMAX=$S(+$G(ORMAX)>0:ORMAX,1:999)

 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA

 . D GCPR^OMGCOAS1(DFN,"CY",BEG,END,ORMAX)

 D GET

SP(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT)      ;Surgical Pathology

 ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 S OROMEGA=1,ORALPHA=9999999,ORMAX=9999

 I $L($T(GCPR^OMGCOAS1)) D  ; Call if FHIE station 200

 . N BEG,END

 . Q:'$G(ORALPHA)  Q:'$G(OROMEGA)

 . S ORMAX=$S(+$G(ORMAX)>0:ORMAX,1:999)

 . S BEG=9999999-OROMEGA,END=9999999-ORALPHA

 . D GCPR^OMGCOAS1(DFN,"SP",BEG,END,ORMAX)

 D GET

GET ;Get data

 N ORDT,ORX0,ORCNT,GMI,LRDFN,IX,X,IX0,ORSITE,ORSS,SITE,GO,ORIMGCNT

 Q:'$L(OREXT)

 S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)

 Q:'$L($T(@GO))

 S LRDFN=+$G(^DPT(DFN,"LR"))

 Q:'LRDFN

 S ORMAX=$S(+$G(ORMAX)>0:ORMAX,1:999)

 S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)

 K ^TMP("ORDATA",$J)

 I '$L($T(GCPR^OMGCOAS1)) D

 . K ^TMP("OROOT",$J)

 . D @GO

 S ORDT=OROMEGA,ORCNT=0

 F  S ORDT=$O(^TMP("OROOT",$J,ORDT)) Q:(ORDT'>0)!(ORDT>ORALPHA)!(ORCNT>ORMAX)  D

 . S ORSS="" F  S ORSS=$O(^TMP("OROOT",$J,ORDT,ORSS)) Q:ORSS=""!(ORCNT>ORMAX)  S ORX0=^(ORSS,0) D

 .. S ORIMGCNT=$S($D(^TMP("OROOT",$J,ORDT,ORSS,.05)):$$IMGCNT^TIUSRVLO($G(^TMP("OROOT",$J,ORDT,ORSS,.05))),1:0)

 .. S SITE=$S($L($G(^TMP("OROOT",$J,ORDT,ORSS,"facility"))):^("facility"),1:ORSITE)

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",1)="1^"_SITE ;Station ID

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",2)="2^"_$P(ORX0,U) ;collection date

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",4)="4^"_$P(ORX0,U,2) ;accession number

 .. D SPMRG^ORDVU("^TMP(""OROOT"","_$J_","_ORDT_","_""""_ORSS_""""_",.1)","^TMP(""ORDATA"","_$J_","_""""_ORDT_ORSS_""""_",""WP"",3)",3) ;specimen

 .. D SPMRG^ORDVU("^TMP(""OROOT"","_$J_","_ORDT_","_""""_ORSS_""""_",.2)","^TMP(""ORDATA"","_$J_","_""""_ORDT_ORSS_""""_",""WP"",5)",5) ;report text

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",6)="6^[+]" ;flag for detail

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",7)="7^"_ORIMGCNT ;image indicator flag

 .. S ^TMP("ORDATA",$J,ORDT_ORSS,"WP",8)="8^"_+$G(^TMP("OROOT",$J,ORDT,ORSS,.05)),ORCNT=ORCNT+1 ; TIU IEN for image

 K ^TMP("OROOT",$J)

 S ROOT=$NA(^TMP("ORDATA",$J))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV02A   3071     printed  Mar 13, 2025@21:35:01                                                                                                                                                                                                     Page 2

ORDV02A   ; slc/dcm - OE/RR Report Extracts ; 4/15/21 1:08pm

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,377,498**;Dec 17, 1997;Build 38

 +2       ; DBIA 4751 - IMGCNT^TIUSRVLO

 +3       ;LAB Components

EM(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Electron Microscopy

 +1       ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 +2       ;

 +3        SET OROMEGA=1

           SET ORALPHA=9999999

           SET ORMAX=9999

 +4       ; Call if FHIE station 200

           IF $LENGTH($TEXT(GCPR^OMGCOAS1))

               Begin DoDot:1

 +5                NEW BEG,END

 +6                if '$GET(ORALPHA)

                       QUIT

                   if '$GET(OROMEGA)

                       QUIT

 +7                SET ORMAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)

 +8                SET BEG=9999999-OROMEGA

                   SET END=9999999-ORALPHA

 +9                DO GCPR^OMGCOAS1(DFN,"EM",BEG,END,ORMAX)

               End DoDot:1

 +10       DO GET

 +11       QUIT

CY(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Cytology

 +1       ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 +2       ;

 +3        SET OROMEGA=1

           SET ORALPHA=9999999

           SET ORMAX=9999

 +4       ; Call if FHIE station 200

           IF $LENGTH($TEXT(GCPR^OMGCOAS1))

               Begin DoDot:1

 +5                NEW BEG,END

 +6                if '$GET(ORALPHA)

                       QUIT

                   if '$GET(OROMEGA)

                       QUIT

 +7                SET ORMAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)

 +8                SET BEG=9999999-OROMEGA

                   SET END=9999999-ORALPHA

 +9                DO GCPR^OMGCOAS1(DFN,"CY",BEG,END,ORMAX)

               End DoDot:1

 +10       DO GET

 +11       QUIT

SP(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgical Pathology

 +1       ;External references to ^DPT(DFN,"LR"), ^ORDVX1,

 +2       ;

 +3        SET OROMEGA=1

           SET ORALPHA=9999999

           SET ORMAX=9999

 +4       ; Call if FHIE station 200

           IF $LENGTH($TEXT(GCPR^OMGCOAS1))

               Begin DoDot:1

 +5                NEW BEG,END

 +6                if '$GET(ORALPHA)

                       QUIT

                   if '$GET(OROMEGA)

                       QUIT

 +7                SET ORMAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)

 +8                SET BEG=9999999-OROMEGA

                   SET END=9999999-ORALPHA

 +9                DO GCPR^OMGCOAS1(DFN,"SP",BEG,END,ORMAX)

               End DoDot:1

 +10       DO GET

 +11       QUIT

 +12      ;

GET       ;Get data

 +1        NEW ORDT,ORX0,ORCNT,GMI,LRDFN,IX,X,IX0,ORSITE,ORSS,SITE,GO,ORIMGCNT

 +2        if '$LENGTH(OREXT)

               QUIT

 +3        SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)

 +4        if '$LENGTH($TEXT(@GO))

               QUIT

 +5        SET LRDFN=+$GET(^DPT(DFN,"LR"))

 +6        if 'LRDFN

               QUIT

 +7        SET ORMAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)

 +8        SET ORSITE=$$SITE^VASITE

           SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)

 +9        KILL ^TMP("ORDATA",$JOB)

 +10       IF '$LENGTH($TEXT(GCPR^OMGCOAS1))

               Begin DoDot:1

 +11               KILL ^TMP("OROOT",$JOB)

 +12               DO @GO

               End DoDot:1

 +13       SET ORDT=OROMEGA

           SET ORCNT=0

 +14       FOR

               SET ORDT=$ORDER(^TMP("OROOT",$JOB,ORDT))

               if (ORDT'>0)!(ORDT>ORALPHA)!(ORCNT>ORMAX)

                   QUIT

               Begin DoDot:1

 +15               SET ORSS=""

FOR

                       SET ORSS=$ORDER(^TMP("OROOT",$JOB,ORDT,ORSS))

                       if ORSS=""!(ORCNT>ORMAX)

                           QUIT

                       SET ORX0=^(ORSS,0)

                       Begin DoDot:2

 +16                       SET ORIMGCNT=$SELECT($DATA(^TMP("OROOT",$JOB,ORDT,ORSS,.05)):$$IMGCNT^TIUSRVLO($GET(^TMP("OROOT",$JOB,ORDT,ORSS,.05))),1:0)

 +17                       SET SITE=$SELECT($LENGTH($GET(^TMP("OROOT",$JOB,ORDT,ORSS,"facility"))):^("facility"),1:ORSITE)

 +18      ;Station ID

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",1)="1^"_SITE

 +19      ;collection date

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",2)="2^"_$PIECE(ORX0,U)

 +20      ;accession number

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",4)="4^"_$PIECE(ORX0,U,2)

 +21      ;specimen

                           DO SPMRG^ORDVU("^TMP(""OROOT"","_$JOB_","_ORDT_","_""""_ORSS_""""_",.1)","^TMP(""ORDATA"","_$JOB_","_""""_ORDT_ORSS_""""_",""WP"",3)",3)

 +22      ;report text

                           DO SPMRG^ORDVU("^TMP(""OROOT"","_$JOB_","_ORDT_","_""""_ORSS_""""_",.2)","^TMP(""ORDATA"","_$JOB_","_""""_ORDT_ORSS_""""_",""WP"",5)",5)

 +23      ;flag for detail

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",6)="6^[+]"

 +24      ;image indicator flag

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",7)="7^"_ORIMGCNT

 +25      ; TIU IEN for image

                           SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",8)="8^"_+$GET(^TMP("OROOT",$JOB,ORDT,ORSS,.05))

                           SET ORCNT=ORCNT+1

                       End DoDot:2

               End DoDot:1

 +26       KILL ^TMP("OROOT",$JOB)

 +27       SET ROOT=$NAME(^TMP("ORDATA",$JOB))

 +28       QUIT

ORDV02A.m