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
Q
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
Q
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
Q
;
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))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV02A 3071 printed Oct 16, 2024@18:30:39 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
