ORDV03 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:17
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,208,215,243,402**;Dec 17, 1997;Build 3
RI(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology impression
;External Calls: MAIN^GMTSRAE(1)
;
; ^TMP("GMTSRAD",$J) used via DBIA 4333
; ^TMP("RAE",$J) used via DBIA 3968
N ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S IOST=$G(IOST),GMTSNDM=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS2=ORALPHA,GMTS1=OROMEGA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J),^TMP("RAE",$J) ;DBIA 3968
D @GO
S ORDT=GMTS1,ORCNT=0
F S ORDT=$O(^TMP("RAE",$J,ORDT)) Q:(ORDT'>0)!(ORDT>GMTS2) D
. S ORJ=0 F S ORJ=$O(^TMP("RAE",$J,ORDT,ORJ)) Q:'ORJ I $G(^(ORJ,0)) S ORX0=^(0) D
.. S ORCNT=ORCNT+1
.. S SITE=$S($L($G(^TMP("RAE",$J,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,ORCNT,"WP",1)="1^"_SITE ;Station ID
.. S ^TMP("ORDATA",$J,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($P(ORX0,U)) ;date
.. S ^TMP("ORDATA",$J,ORCNT,"WP",3)="3^"_$P(ORX0,U,2) ;procedure
.. S ^TMP("ORDATA",$J,ORCNT,"WP",4)="4^"_$P(ORX0,U,4) ;report status
.. S ^TMP("ORDATA",$J,ORCNT,"WP",5)="5^"_$P(ORX0,U,7) ;cpt code
.. D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"I")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",6)),6) ;impression
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"I",0)) S ^TMP("ORDATA",$J,ORCNT,"WP",8)="8^[+]" ;flag for detail
K ^TMP("RAE",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
RR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
;External Calls: MAIN^GMTSRAE(2)
I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
. N BEG,END,MAX
. Q:'$G(ORALPHA) Q:'$G(OROMEGA)
. S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
. S BEG=9999999-OROMEGA,END=9999999-ORALPHA
. D GCPR^OMGCOAS1(DFN,"RR",BEG,END,MAX)
N ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
K ^TMP("ORDATA",$J)
S GMTSNDM=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("RAE",$J)
. D @GO
S ORDT=GMTS1,ORCNT=0
F S ORDT=$O(^TMP("RAE",$J,ORDT)) Q:(ORDT'>0) D
. S ORJ=0 F S ORJ=$O(^TMP("RAE",$J,ORDT,ORJ)) Q:'ORJ D
.. S ORCNT=ORCNT+1,ORMORE=0
.. S ORX0=$G(^TMP("RAE",$J,ORDT,ORJ,0))
.. S SITE=$S($L($G(^TMP("RAE",$J,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,ORCNT,"WP",1)="1^"_SITE ;Site ID
.. S ^TMP("ORDATA",$J,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($P(ORX0,U)) ;date
.. S ^TMP("ORDATA",$J,ORCNT,"WP",3)="3^"_$P(ORX0,U,2) ;procedure
.. S ^TMP("ORDATA",$J,ORCNT,"WP",4)="4^"_$S($L($P(ORX0,U,4)):$P(ORX0,U,4),1:"No Report") ;report status
.. S ^TMP("ORDATA",$J,ORCNT,"WP",5)="5^"_$P(ORX0,U,7) ;cpt code
.. N ORID S ORID=0 ;p402
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"S",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"S")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",6,1)),6) S ORID=6 ;reason for study
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"H",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"H")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",7,1)),7) S ORID=7 ;clinical history
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"I",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"I")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",8,1)),8) S ORID=8 ;impression
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"R",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"R")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",9,1)),9) S ORID=9 ;report
.. ;p402 Add primary and secondary diagnostic codes to report
.. I ORID D
... N ORIDX,ORSDC S ORIDX=9999999
... S ORIDX=$O(^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX),-1) Q:(ORIDX'>0)
... S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^" ; blank line
... S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^Primary Diagnostic Code: "_$S($L(^TMP("RAE",$J,ORDT,ORJ,"D",1))'>0:"NONE",$D(^TMP("RAE",$J,ORDT,ORJ,"D",1)):$G(^TMP("RAE",$J,ORDT,ORJ,"D",1)),1:"NONE")
... S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^Secondary Diagnostic Codes: "
... S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^ "_$S($D(^TMP("RAE",$J,ORDT,ORJ,"D",2)):$G(^TMP("RAE",$J,ORDT,ORJ,"D",2)),1:"NONE")
...S ORSDC=2 ; print a max of 2 secondary dx codes
...F S ORSDC=$O(^TMP("RAE",$J,ORDT,ORJ,"D",ORSDC)) Q:(ORSDC="")!(ORSDC>3) D
....S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^ "_$G(^TMP("RAE",$J,ORDT,ORJ,"D",ORSDC))
...S ORIDX=ORIDX+1,^TMP("ORDATA",$J,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^" ; blank line
... K ORIDX
.. K ORID ;p402 end
.. I ORMORE S ^TMP("ORDATA",$J,ORCNT,"WP",10)="10^[+]" ;flag for detail
K ^TMP("RAE",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
RRDOD(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
;External Calls: MAIN^GMTSRAE(2)
;
I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
. N BEG,END,MAX
. Q:'$G(ORALPHA) Q:'$G(OROMEGA)
. S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
. S BEG=9999999-OROMEGA,END=9999999-ORALPHA
. D GCPR^OMGCOAS1(DFN,"RR",BEG,END,MAX)
;
N ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
K ^TMP("ORDATA",$J)
S GMTSNDM=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("RAE",$J)
. D @GO
S ORDT=GMTS1,ORCNT=0
F S ORDT=$O(^TMP("RAE",$J,ORDT)) Q:(ORDT'>0) D
. S ORJ=0 F S ORJ=$O(^TMP("RAE",$J,ORDT,ORJ)) Q:'ORJ D
.. S ORCNT=ORCNT+1,ORMORE=0
.. S ORX0=$G(^TMP("RAE",$J,ORDT,ORJ,0))
.. S SITE=$S($L($G(^TMP("RAE",$J,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,ORCNT,"WP",1)="1^"_SITE ;Site ID
.. S ^TMP("ORDATA",$J,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($P(ORX0,U)) ;date
.. S ^TMP("ORDATA",$J,ORCNT,"WP",3)="3^"_$P(ORX0,U,2) ;procedure
.. S ^TMP("ORDATA",$J,ORCNT,"WP",4)="4^"_$S($L($P(ORX0,U,4)):$P(ORX0,U,4),1:"No Report") ;report status
.. S ^TMP("ORDATA",$J,ORCNT,"WP",5)="5^"_$P(ORX0,U,7) ;cpt code
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"H",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"H")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",6,1)),6) ;clinical history
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"I",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"I")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",7,1)),7) ;impression
.. I $O(^TMP("RAE",$J,ORDT,ORJ,"R",0)) S ORMORE=1 D SPMRG^ORDVU($NA(^TMP("RAE",$J,ORDT,ORJ,"R")),$NA(^TMP("ORDATA",$J,ORCNT,"WP",8,1)),8) ;report
.. I ORMORE S ^TMP("ORDATA",$J,ORCNT,"WP",9)="9^[+]" ;flag for detail
K ^TMP("RAE",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
RS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology status
;External calls: GET^GMTSRAD
N ORSITE,SITE,CNT,ORDT,ORDA,ORDA2,REC,GMTSEND,GMTSBEG,GO,STAT
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S GMTSBEG=ORDBEG,GMTSEND=ORDEND
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("GMTSRAD",$J) ;DBIA 4333
D @GO
S CNT=0,ORDT=OROMEGA
F S ORDT=$O(^TMP("GMTSRAD",$J,ORDT)) Q:(ORDT'>0)!(ORDT>ORALPHA)!(CNT'<ORMAX) D
.S ORDA=0
.F S ORDA=$O(^TMP("GMTSRAD",$J,ORDT,ORDA)) Q:'ORDA!(CNT'<ORMAX) D
..S ORDA2=0
..F S ORDA2=$O(^TMP("GMTSRAD",$J,ORDT,ORDA,ORDA2)) Q:'ORDA2!(CNT'<ORMAX) S REC=^(ORDA2),STAT=$P(REC,"^",2) D
...S CNT=CNT+1
...S SITE=$S($L($G(^TMP("GMTSRAD",$J,ORDT,ORDA,ORDA2,"facility"))):^("facility"),1:ORSITE)
...S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE
...S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$$DATE^ORDVU($P(REC,"^"))
...S ^TMP("ORDATA",$J,ORDT,"WP",3)="3^"_$S(STAT="d":"Discontinued",STAT="c":"Complete",STAT="h":"Hold",STAT="p":"Pending",STAT="a":"Active",STAT="s":"Scheduled",STAT="u":"Unreleased",1:STAT)
...S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$P(REC,"^",3)
...S ^TMP("ORDATA",$J,ORDT,"WP",5)="5^"_$$DATE^ORDVU($P(REC,"^",4))
...S ^TMP("ORDATA",$J,ORDT,"WP",6)="6^"_$P(REC,"^",5)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
RAD1 ;Get radiology impression
D MAIN^GMTSRAE(1)
Q
RAD2 ;Get radiology report
D MAIN^GMTSRAE(2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV03 8308 printed Apr 09, 2024@21:43:50 Page 2
ORDV03 ; slc/dcm - OE/RR Report Extracts ;10/8/03 11:17
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,208,215,243,402**;Dec 17, 1997;Build 3
RI(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology impression
+1 ;External Calls: MAIN^GMTSRAE(1)
+2 ;
+3 ; ^TMP("GMTSRAD",$J) used via DBIA 4333
+4 ; ^TMP("RAE",$J) used via DBIA 3968
+5 NEW ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO
+6 if '$LENGTH(OREXT)
QUIT
+7 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+8 if '$LENGTH($TEXT(@GO))
QUIT
+9 SET IOST=$GET(IOST)
SET GMTSNDM=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS2=ORALPHA
SET GMTS1=OROMEGA
+10 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+11 ;DBIA 3968
KILL ^TMP("ORDATA",$JOB),^TMP("RAE",$JOB)
+12 DO @GO
+13 SET ORDT=GMTS1
SET ORCNT=0
+14 FOR
SET ORDT=$ORDER(^TMP("RAE",$JOB,ORDT))
if (ORDT'>0)!(ORDT>GMTS2)
QUIT
Begin DoDot:1
+15 SET ORJ=0
FOR
SET ORJ=$ORDER(^TMP("RAE",$JOB,ORDT,ORJ))
if 'ORJ
QUIT
IF $GET(^(ORJ,0))
SET ORX0=^(0)
Begin DoDot:2
+16 SET ORCNT=ORCNT+1
+17 SET SITE=$SELECT($LENGTH($GET(^TMP("RAE",$JOB,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
+18 ;Station ID
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",1)="1^"_SITE
+19 ;date
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(ORX0,U))
+20 ;procedure
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",3)="3^"_$PIECE(ORX0,U,2)
+21 ;report status
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",4)="4^"_$PIECE(ORX0,U,4)
+22 ;cpt code
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",5)="5^"_$PIECE(ORX0,U,7)
+23 ;impression
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"I")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",6)),6)
+24 ;flag for detail
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"I",0))
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",8)="8^[+]"
End DoDot:2
End DoDot:1
+25 KILL ^TMP("RAE",$JOB)
+26 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+27 QUIT
RR(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
+1 ;External Calls: MAIN^GMTSRAE(2)
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 NEW BEG,END,MAX
+4 if '$GET(ORALPHA)
QUIT
if '$GET(OROMEGA)
QUIT
+5 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
+6 SET BEG=9999999-OROMEGA
SET END=9999999-ORALPHA
+7 DO GCPR^OMGCOAS1(DFN,"RR",BEG,END,MAX)
End DoDot:1
+8 NEW ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
+9 if '$LENGTH(OREXT)
QUIT
+10 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+11 if '$LENGTH($TEXT(@GO))
QUIT
+12 KILL ^TMP("ORDATA",$JOB)
+13 SET GMTSNDM=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
+14 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+15 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+16 KILL ^TMP("RAE",$JOB)
+17 DO @GO
End DoDot:1
+18 SET ORDT=GMTS1
SET ORCNT=0
+19 FOR
SET ORDT=$ORDER(^TMP("RAE",$JOB,ORDT))
if (ORDT'>0)
QUIT
Begin DoDot:1
+20 SET ORJ=0
FOR
SET ORJ=$ORDER(^TMP("RAE",$JOB,ORDT,ORJ))
if 'ORJ
QUIT
Begin DoDot:2
+21 SET ORCNT=ORCNT+1
SET ORMORE=0
+22 SET ORX0=$GET(^TMP("RAE",$JOB,ORDT,ORJ,0))
+23 SET SITE=$SELECT($LENGTH($GET(^TMP("RAE",$JOB,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
+24 ;Site ID
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",1)="1^"_SITE
+25 ;date
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(ORX0,U))
+26 ;procedure
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",3)="3^"_$PIECE(ORX0,U,2)
+27 ;report status
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",4)="4^"_$SELECT($LENGTH($PIECE(ORX0,U,4)):$PIECE(ORX0,U,4),1:"No Report")
+28 ;cpt code
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",5)="5^"_$PIECE(ORX0,U,7)
+29 ;p402
NEW ORID
SET ORID=0
+30 ;reason for study
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"S",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"S")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",6,1)),6)
SET ORID=6
+31 ;clinical history
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"H",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"H")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",7,1)),7)
SET ORID=7
+32 ;impression
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"I",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"I")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",8,1)),8)
SET ORID=8
+33 ;report
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"R",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"R")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",9,1)),9)
SET ORID=9
+34 ;p402 Add primary and secondary diagnostic codes to report
+35 IF ORID
Begin DoDot:3
+36 NEW ORIDX,ORSDC
SET ORIDX=9999999
+37 SET ORIDX=$ORDER(^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX),-1)
if (ORIDX'>0)
QUIT
+38 ; blank line
SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^"
+39 SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^Primary Diagnostic Code: "_$SELECT($LENGTH(^TMP("RAE",$JOB,ORDT,ORJ,"D",1))'>0:"NONE",$DATA(^TMP("RAE",$JOB,ORDT,ORJ,"D",1)):$GET(^TMP("RAE",$JOB,ORDT,ORJ,"D",1)),1:
"NONE")
+40 SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^Secondary Diagnostic Codes: "
+41 SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^ "_$SELECT($DATA(^TMP("RAE",$JOB,ORDT,ORJ,"D",2)):$GET(^TMP("RAE",$JOB,ORDT,ORJ,"D",2)),1:"NONE")
+42 ; print a max of 2 secondary dx codes
SET ORSDC=2
+43 FOR
SET ORSDC=$ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"D",ORSDC))
if (ORSDC="")!(ORSDC>3)
QUIT
Begin DoDot:4
+44 SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^ "_$GET(^TMP("RAE",$JOB,ORDT,ORJ,"D",ORSDC))
End DoDot:4
+45 ; blank line
SET ORIDX=ORIDX+1
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",ORID,1,ORIDX)=ORID_"^"
+46 KILL ORIDX
End DoDot:3
+47 ;p402 end
KILL ORID
+48 ;flag for detail
IF ORMORE
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",10)="10^[+]"
End DoDot:2
End DoDot:1
+49 KILL ^TMP("RAE",$JOB)
+50 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+51 QUIT
RRDOD(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology report
+1 ;External Calls: MAIN^GMTSRAE(2)
+2 ;
+3 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+4 NEW BEG,END,MAX
+5 if '$GET(ORALPHA)
QUIT
if '$GET(OROMEGA)
QUIT
+6 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
+7 SET BEG=9999999-OROMEGA
SET END=9999999-ORALPHA
+8 DO GCPR^OMGCOAS1(DFN,"RR",BEG,END,MAX)
End DoDot:1
+9 ;
+10 NEW ORDT,ORX0,ORJ,ORCNT,GMDATA,GMTSI,GMW,MAX,TEST,GMTSNDM,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
+11 if '$LENGTH(OREXT)
QUIT
+12 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+13 if '$LENGTH($TEXT(@GO))
QUIT
+14 KILL ^TMP("ORDATA",$JOB)
+15 SET GMTSNDM=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
+16 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+17 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+18 KILL ^TMP("RAE",$JOB)
+19 DO @GO
End DoDot:1
+20 SET ORDT=GMTS1
SET ORCNT=0
+21 FOR
SET ORDT=$ORDER(^TMP("RAE",$JOB,ORDT))
if (ORDT'>0)
QUIT
Begin DoDot:1
+22 SET ORJ=0
FOR
SET ORJ=$ORDER(^TMP("RAE",$JOB,ORDT,ORJ))
if 'ORJ
QUIT
Begin DoDot:2
+23 SET ORCNT=ORCNT+1
SET ORMORE=0
+24 SET ORX0=$GET(^TMP("RAE",$JOB,ORDT,ORJ,0))
+25 SET SITE=$SELECT($LENGTH($GET(^TMP("RAE",$JOB,ORDT,ORJ,"facility"))):^("facility"),1:ORSITE)
+26 ;Site ID
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",1)="1^"_SITE
+27 ;date
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(ORX0,U))
+28 ;procedure
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",3)="3^"_$PIECE(ORX0,U,2)
+29 ;report status
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",4)="4^"_$SELECT($LENGTH($PIECE(ORX0,U,4)):$PIECE(ORX0,U,4),1:"No Report")
+30 ;cpt code
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",5)="5^"_$PIECE(ORX0,U,7)
+31 ;clinical history
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"H",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"H")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",6,1)),6)
+32 ;impression
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"I",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"I")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",7,1)),7)
+33 ;report
IF $ORDER(^TMP("RAE",$JOB,ORDT,ORJ,"R",0))
SET ORMORE=1
DO SPMRG^ORDVU($NAME(^TMP("RAE",$JOB,ORDT,ORJ,"R")),$NAME(^TMP("ORDATA",$JOB,ORCNT,"WP",8,1)),8)
+34 ;flag for detail
IF ORMORE
SET ^TMP("ORDATA",$JOB,ORCNT,"WP",9)="9^[+]"
End DoDot:2
End DoDot:1
+35 KILL ^TMP("RAE",$JOB)
+36 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+37 QUIT
RS(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Radiology status
+1 ;External calls: GET^GMTSRAD
+2 NEW ORSITE,SITE,CNT,ORDT,ORDA,ORDA2,REC,GMTSEND,GMTSBEG,GO,STAT
+3 if '$LENGTH(OREXT)
QUIT
+4 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+5 if '$LENGTH($TEXT(@GO))
QUIT
+6 SET GMTSBEG=ORDBEG
SET GMTSEND=ORDEND
+7 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+8 ;DBIA 4333
KILL ^TMP("GMTSRAD",$JOB)
+9 DO @GO
+10 SET CNT=0
SET ORDT=OROMEGA
+11 FOR
SET ORDT=$ORDER(^TMP("GMTSRAD",$JOB,ORDT))
if (ORDT'>0)!(ORDT>ORALPHA)!(CNT'<ORMAX)
QUIT
Begin DoDot:1
+12 SET ORDA=0
+13 FOR
SET ORDA=$ORDER(^TMP("GMTSRAD",$JOB,ORDT,ORDA))
if 'ORDA!(CNT'<ORMAX)
QUIT
Begin DoDot:2
+14 SET ORDA2=0
+15 FOR
SET ORDA2=$ORDER(^TMP("GMTSRAD",$JOB,ORDT,ORDA,ORDA2))
if 'ORDA2!(CNT'<ORMAX)
QUIT
SET REC=^(ORDA2)
SET STAT=$PIECE(REC,"^",2)
Begin DoDot:3
+16 SET CNT=CNT+1
+17 SET SITE=$SELECT($LENGTH($GET(^TMP("GMTSRAD",$JOB,ORDT,ORDA,ORDA2,"facility"))):^("facility"),1:ORSITE)
+18 SET ^TMP("ORDATA",$JOB,ORDT,"WP",1)="1^"_SITE
+19 SET ^TMP("ORDATA",$JOB,ORDT,"WP",2)="2^"_$$DATE^ORDVU($PIECE(REC,"^"))
+20 SET ^TMP("ORDATA",$JOB,ORDT,"WP",3)="3^"_$SELECT(STAT="d":"Discontinued",STAT="c":"Complete",STAT="h":"Hold",STAT="p":"Pending",STAT="a":"Active",STAT="s":"Scheduled",STAT="u":"Unreleased",1:STAT)
+21 SET ^TMP("ORDATA",$JOB,ORDT,"WP",4)="4^"_$PIECE(REC,"^",3)
+22 SET ^TMP("ORDATA",$JOB,ORDT,"WP",5)="5^"_$$DATE^ORDVU($PIECE(REC,"^",4))
+23 SET ^TMP("ORDATA",$JOB,ORDT,"WP",6)="6^"_$PIECE(REC,"^",5)
End DoDot:3
End DoDot:2
End DoDot:1
+24 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+25 QUIT
RAD1 ;Get radiology impression
+1 DO MAIN^GMTSRAE(1)
+2 QUIT
RAD2 ;Get radiology report
+1 DO MAIN^GMTSRAE(2)
+2 QUIT
