ORDV02 ;SLC/DCM - OE/RR REPORT EXTRACTS ;03/17/2015 10:24
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,118,146,141,208,318,350**;Dec 17, 1997;Build 77
;LAB Components
LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Order Component
;External calls to ^GMTSLROE
;
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,"LRO",BEG,END,MAX)
;
N D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA,GMTSBEG=ORDBEG,GMTSEND=ORDEND
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRO",$J),^TMP("ORTXT",$J)
. D @GO
S (CTR,D)=0
F S D=$O(^TMP("LRO",$J,D)) Q:'D D
. S SN=0
. F S SN=$O(^TMP("LRO",$J,D,SN)) Q:'SN S ORX0=^(SN) I $L(ORX0) D
.. S SITE=$S($L($G(^TMP("LRO",$J,D,SN,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,D,SN,"WP",1)="1^"_SITE ;Station ID
.. S ^TMP("ORDATA",$J,D,SN,"WP",2)="2^"_$P(ORX0,U) ;collection date
.. S ^TMP("ORDATA",$J,D,SN,"WP",3)="3^"_$P($P(ORX0,U,2),";",2) ;test name
.. S ^TMP("ORDATA",$J,D,SN,"WP",4)="4^"_$P($P(ORX0,U,2),";") ;test ien
.. S ^TMP("ORDATA",$J,D,SN,"WP",5)="5^"_$P($P(ORX0,U,3),";",2) ;specimen name
.. S ^TMP("ORDATA",$J,D,SN,"WP",6)="6^"_$P($P(ORX0,U,3),";") ;specimen ien
.. S ^TMP("ORDATA",$J,D,SN,"WP",7)="7^"_$P(ORX0,U,4) ;urgency
.. S ^TMP("ORDATA",$J,D,SN,"WP",8)="8^"_$P($P(ORX0,U,6),";",2) ;provider name
.. S ^TMP("ORDATA",$J,D,SN,"WP",9)="9^"_$P($P(ORX0,U,6),";") ;provider ien
.. S ^TMP("ORDATA",$J,D,SN,"WP",10)="10^"_$P(ORX0,U,7) ;order date/time
.. S ^TMP("ORDATA",$J,D,SN,"WP",11)="11^"_$P(ORX0,U,8) ;accession number
.. S ^TMP("ORDATA",$J,D,SN,"WP",12)="12^"_$P(ORX0,U,9) ;available date/time
.. S ^TMP("ORDATA",$J,D,SN,"WP",13)="13^"_$P(ORX0,U,5) ;status
K ^TMP("LRO",$J),^TMP("ORTXT",$J),^TMP("ORSORT",$J),^TMP("ORXPND",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
CH(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Chemistry/Hematology
;External references to ^DPT(DFN,"LR"),^LR(LRDFN, ^GMTSLRCE
;
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,"LRC",BEG,END,MAX)
;
N CTR,ORI,TST,PC,ORX0,GMCFLAG,GMCMNT,GMW,IX0,IX,LRDFN,CNT,PTR,MAX,GMTS1,GMTS2,GMTSAGE,ORSITE,SEX,SITE,GO,VA,VAIN,VAERR,VAIN,VADM
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S LRDFN=+$G(^DPT(DFN,"LR"))
I GO["GMTSLRCE" Q:'LRDFN
D OERR^VADPT
S GMTSAGE=$S(+VADM(4)>0:+VADM(4),1:99),SEX=$P(VADM(5),"^")
S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRC",$J)
. D @GO
S CTR=0,ORI=GMTS1
F S ORI=$O(^TMP("LRC",$J,ORI)) Q:'ORI!(ORI>GMTS2) D
. S TST=""
. F S TST=$O(^TMP("LRC",$J,ORI,TST)) Q:TST="" D
.. I TST S ORX0=$G(^TMP("LRC",$J,ORI,TST)) Q:ORX0="" D
... S SITE=$S($L($G(^TMP("LRC",$J,ORI,TST,"facility"))):^("facility"),1:ORSITE)
... S ^TMP("ORDATA",$J,ORI,TST,"WP",1)="1^"_SITE ;Station ID
... S ^TMP("ORDATA",$J,ORI,TST,"WP",2)="2^"_$P(ORX0,U) ;collection date
... S ^TMP("ORDATA",$J,ORI,TST,"WP",3)="3^"_$P(ORX0,U,3) ;test name
... S ^TMP("ORDATA",$J,ORI,TST,"WP",4)="4^"_$P(ORX0,U,2) ;specimen
... S ^TMP("ORDATA",$J,ORI,TST,"WP",5)="5^"_$P(ORX0,U,4) ;result
... S ^TMP("ORDATA",$J,ORI,TST,"WP",6)="6^"_$P(ORX0,U,5) ;indicator
... S ^TMP("ORDATA",$J,ORI,TST,"WP",7)="7^"_$P(ORX0,U,6) ;units
... S ^TMP("ORDATA",$J,ORI,TST,"WP",8)="8^"_$P(ORX0,U,7) ;ref low
... S ^TMP("ORDATA",$J,ORI,TST,"WP",9)="9^"_$P(ORX0,U,8) ;ref high
... D SPMRG^ORDVU("^TMP(""LRC"","_$J_","_ORI_",""C"")","^TMP(""ORDATA"","_$J_","_ORI_","_TST_",""WP"",10)",10) ;comments
... I $O(^TMP("LRC",$J,ORI,"C",0)) S ^TMP("ORDATA",$J,ORI,TST,"WP",11)="11^[+]" ;flag for details
.. S CTR=CTR+1
K ^TMP("LRC",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
SP(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgical Pathology
;External references to ^DPT(DFN,"LR"), ^GMTSLRAE,
;
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,"SP",BEG,END,MAX)
;
N ORDT,ORX0,ORCNT,GMI,MAX,LRDFN,IX,X,IX0,GMTS1,GMTS2,ORSITE,SITE,GO
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S LRDFN=+$G(^DPT(DFN,"LR"))
I GO["GMTSLRAE" Q:'LRDFN
S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRA",$J)
. D @GO
S ORDT=GMTS1,ORCNT=0
F S ORDT=$O(^TMP("LRA",$J,ORDT)) Q:(ORDT'>0)!(ORDT>GMTS2) S ORX0=^(ORDT,0) D
. S SITE=$S($L($G(^TMP("LRA",$J,ORDT,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$P(ORX0,U) ;collection date
. S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$P(ORX0,U,2) ;accession number
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",.1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",3)",3) ;specimen
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",.2)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",5)",5) ;brief Clinical Hx
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",6)",6) ;gross Description
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",7)",7) ;microscopic Exam
. I $D(^TMP("LRA",$J,ORDT,1.2,1,0)) S X=^(0) D
.. S ^TMP("LRA",$J,ORDT,1.2,1,0)=$$DATE^ORDVU(X)
.. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.2)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",8)",8) ;supplemetary Report
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.3)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",9)",9) ;frozen Section
. D SPMRG^ORDVU("^TMP(""LRA"","_$J_","_ORDT_",1.4)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",10)",10) ;surgical path Dx
. S ^TMP("ORDATA",$J,ORDT,"WP",11)="11^[+]" ;flag for detail
K ^TMP("LRA",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
CY(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Cytopathology
;External references to ^DPT(DFN,"LR"), ^GMTSLRPE
;
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,"CY",BEG,END,MAX)
;
N ORDT,ORX0,GMI,IX0,MAX,LRDFN,IX,GMTS1,GMTS2,ORSITE,SITE,GO,ORMORE
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S LRDFN=+$G(^DPT(DFN,"LR"))
I GO["GMTSLRPE" Q:'LRDFN
S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999),GMTS1=OROMEGA,GMTS2=ORALPHA
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRCY",$J)
. D @GO
S ORDT=GMTS1,ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
F S ORDT=$O(^TMP("LRCY",$J,ORDT)) Q:(ORDT'>0)!(ORDT>GMTS2) S ORX0=$G(^(ORDT,0)) D
. S ORMORE=0,SITE=$S($L($G(^TMP("LRCY",$J,ORDT,"facility"))):^("facility"),1:ORSITE)
. S ^TMP("ORDATA",$J,ORDT,"WP",1)="1^"_SITE ;Station ID
. S ^TMP("ORDATA",$J,ORDT,"WP",2)="2^"_$P(ORX0,U) ;collection date
. S ^TMP("ORDATA",$J,ORDT,"WP",5)="5^"_$P(ORX0,U,2) ;accession number
. S ^TMP("ORDATA",$J,ORDT,"WP",4)="4^"_$$DATE^ORDVU($P($G(^TMP("LRCY",$J,ORDT,1)),U,2)) ;report release date
. I $O(^TMP("LRCY",$J,ORDT,1,0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",1)","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",3)",3) ;specimen
. I $O(^TMP("LRCY",$J,ORDT,"AH",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""AH"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",6)",6) ;brief Clinical Hx
. I $O(^TMP("LRCY",$J,ORDT,"G",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""G"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",7)",7) ;gross Description
. I $O(^TMP("LRCY",$J,ORDT,"MI",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""MI"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",8)",8) ;microscopic Exam
. I $O(^TMP("LRCY",$J,ORDT,"NDX",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""NDX"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",9)",9) ;cythopathology DX
. I $O(^TMP("LRCY",$J,ORDT,"SR",0)) S ORMORE=1 D SPMRG^ORDVU("^TMP(""LRCY"","_$J_","_ORDT_",""SR"")","^TMP(""ORDATA"","_$J_","_ORDT_",""WP"",10)",10) ;supplemetary Report
. I ORMORE S ^TMP("ORDATA",$J,ORDT,"WP",11)="11^[+]" ;flag for detail
K ^TMP("LRCY",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV02 9023 printed Oct 16, 2024@18:30:38 Page 2
ORDV02 ;SLC/DCM - OE/RR REPORT EXTRACTS ;03/17/2015 10:24
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,118,146,141,208,318,350**;Dec 17, 1997;Build 77
+2 ;LAB Components
LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Order Component
+1 ;External calls to ^GMTSLROE
+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,"LRO",BEG,END,MAX)
End DoDot:1
+9 ;
+10 NEW D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO
+11 if '$LENGTH(OREXT)
QUIT
+12 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+13 if '$LENGTH($TEXT(@GO))
QUIT
+14 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
SET GMTSBEG=ORDBEG
SET GMTSEND=ORDEND
+15 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+16 KILL ^TMP("ORDATA",$JOB)
+17 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+18 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB)
+19 DO @GO
End DoDot:1
+20 SET (CTR,D)=0
+21 FOR
SET D=$ORDER(^TMP("LRO",$JOB,D))
if 'D
QUIT
Begin DoDot:1
+22 SET SN=0
+23 FOR
SET SN=$ORDER(^TMP("LRO",$JOB,D,SN))
if 'SN
QUIT
SET ORX0=^(SN)
IF $LENGTH(ORX0)
Begin DoDot:2
+24 SET SITE=$SELECT($LENGTH($GET(^TMP("LRO",$JOB,D,SN,"facility"))):^("facility"),1:ORSITE)
+25 ;Station ID
SET ^TMP("ORDATA",$JOB,D,SN,"WP",1)="1^"_SITE
+26 ;collection date
SET ^TMP("ORDATA",$JOB,D,SN,"WP",2)="2^"_$PIECE(ORX0,U)
+27 ;test name
SET ^TMP("ORDATA",$JOB,D,SN,"WP",3)="3^"_$PIECE($PIECE(ORX0,U,2),";",2)
+28 ;test ien
SET ^TMP("ORDATA",$JOB,D,SN,"WP",4)="4^"_$PIECE($PIECE(ORX0,U,2),";")
+29 ;specimen name
SET ^TMP("ORDATA",$JOB,D,SN,"WP",5)="5^"_$PIECE($PIECE(ORX0,U,3),";",2)
+30 ;specimen ien
SET ^TMP("ORDATA",$JOB,D,SN,"WP",6)="6^"_$PIECE($PIECE(ORX0,U,3),";")
+31 ;urgency
SET ^TMP("ORDATA",$JOB,D,SN,"WP",7)="7^"_$PIECE(ORX0,U,4)
+32 ;provider name
SET ^TMP("ORDATA",$JOB,D,SN,"WP",8)="8^"_$PIECE($PIECE(ORX0,U,6),";",2)
+33 ;provider ien
SET ^TMP("ORDATA",$JOB,D,SN,"WP",9)="9^"_$PIECE($PIECE(ORX0,U,6),";")
+34 ;order date/time
SET ^TMP("ORDATA",$JOB,D,SN,"WP",10)="10^"_$PIECE(ORX0,U,7)
+35 ;accession number
SET ^TMP("ORDATA",$JOB,D,SN,"WP",11)="11^"_$PIECE(ORX0,U,8)
+36 ;available date/time
SET ^TMP("ORDATA",$JOB,D,SN,"WP",12)="12^"_$PIECE(ORX0,U,9)
+37 ;status
SET ^TMP("ORDATA",$JOB,D,SN,"WP",13)="13^"_$PIECE(ORX0,U,5)
End DoDot:2
End DoDot:1
+38 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB),^TMP("ORXPND",$JOB)
+39 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+40 QUIT
CH(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Chemistry/Hematology
+1 ;External references to ^DPT(DFN,"LR"),^LR(LRDFN, ^GMTSLRCE
+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,"LRC",BEG,END,MAX)
End DoDot:1
+9 ;
+10 NEW CTR,ORI,TST,PC,ORX0,GMCFLAG,GMCMNT,GMW,IX0,IX,LRDFN,CNT,PTR,MAX,GMTS1,GMTS2,GMTSAGE,ORSITE,SEX,SITE,GO,VA,VAIN,VAERR,VAIN,VADM
+11 if '$LENGTH(OREXT)
QUIT
+12 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+13 if '$LENGTH($TEXT(@GO))
QUIT
+14 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+15 IF GO["GMTSLRCE"
if 'LRDFN
QUIT
+16 DO OERR^VADPT
+17 SET GMTSAGE=$SELECT(+VADM(4)>0:+VADM(4),1:99)
SET SEX=$PIECE(VADM(5),"^")
+18 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
+19 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+20 KILL ^TMP("ORDATA",$JOB)
+21 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+22 KILL ^TMP("LRC",$JOB)
+23 DO @GO
End DoDot:1
+24 SET CTR=0
SET ORI=GMTS1
+25 FOR
SET ORI=$ORDER(^TMP("LRC",$JOB,ORI))
if 'ORI!(ORI>GMTS2)
QUIT
Begin DoDot:1
+26 SET TST=""
+27 FOR
SET TST=$ORDER(^TMP("LRC",$JOB,ORI,TST))
if TST=""
QUIT
Begin DoDot:2
+28 IF TST
SET ORX0=$GET(^TMP("LRC",$JOB,ORI,TST))
if ORX0=""
QUIT
Begin DoDot:3
+29 SET SITE=$SELECT($LENGTH($GET(^TMP("LRC",$JOB,ORI,TST,"facility"))):^("facility"),1:ORSITE)
+30 ;Station ID
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",1)="1^"_SITE
+31 ;collection date
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",2)="2^"_$PIECE(ORX0,U)
+32 ;test name
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",3)="3^"_$PIECE(ORX0,U,3)
+33 ;specimen
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",4)="4^"_$PIECE(ORX0,U,2)
+34 ;result
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",5)="5^"_$PIECE(ORX0,U,4)
+35 ;indicator
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",6)="6^"_$PIECE(ORX0,U,5)
+36 ;units
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",7)="7^"_$PIECE(ORX0,U,6)
+37 ;ref low
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",8)="8^"_$PIECE(ORX0,U,7)
+38 ;ref high
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",9)="9^"_$PIECE(ORX0,U,8)
+39 ;comments
DO SPMRG^ORDVU("^TMP(""LRC"","_$JOB_","_ORI_",""C"")","^TMP(""ORDATA"","_$JOB_","_ORI_","_TST_",""WP"",10)",10)
+40 ;flag for details
IF $ORDER(^TMP("LRC",$JOB,ORI,"C",0))
SET ^TMP("ORDATA",$JOB,ORI,TST,"WP",11)="11^[+]"
End DoDot:3
+41 SET CTR=CTR+1
End DoDot:2
End DoDot:1
+42 KILL ^TMP("LRC",$JOB)
+43 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+44 QUIT
SP(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Surgical Pathology
+1 ;External references to ^DPT(DFN,"LR"), ^GMTSLRAE,
+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,"SP",BEG,END,MAX)
End DoDot:1
+9 ;
+10 NEW ORDT,ORX0,ORCNT,GMI,MAX,LRDFN,IX,X,IX0,GMTS1,GMTS2,ORSITE,SITE,GO
+11 if '$LENGTH(OREXT)
QUIT
+12 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+13 if '$LENGTH($TEXT(@GO))
QUIT
+14 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+15 IF GO["GMTSLRAE"
if 'LRDFN
QUIT
+16 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
+17 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+18 KILL ^TMP("ORDATA",$JOB)
+19 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+20 KILL ^TMP("LRA",$JOB)
+21 DO @GO
End DoDot:1
+22 SET ORDT=GMTS1
SET ORCNT=0
+23 FOR
SET ORDT=$ORDER(^TMP("LRA",$JOB,ORDT))
if (ORDT'>0)!(ORDT>GMTS2)
QUIT
SET ORX0=^(ORDT,0)
Begin DoDot:1
+24 SET SITE=$SELECT($LENGTH($GET(^TMP("LRA",$JOB,ORDT,"facility"))):^("facility"),1:ORSITE)
+25 ;Station ID
SET ^TMP("ORDATA",$JOB,ORDT,"WP",1)="1^"_SITE
+26 ;collection date
SET ^TMP("ORDATA",$JOB,ORDT,"WP",2)="2^"_$PIECE(ORX0,U)
+27 ;accession number
SET ^TMP("ORDATA",$JOB,ORDT,"WP",4)="4^"_$PIECE(ORX0,U,2)
+28 ;specimen
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",.1)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",3)",3)
+29 ;brief Clinical Hx
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",.2)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",5)",5)
+30 ;gross Description
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",1)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",6)",6)
+31 ;microscopic Exam
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",1.1)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",7)",7)
+32 IF $DATA(^TMP("LRA",$JOB,ORDT,1.2,1,0))
SET X=^(0)
Begin DoDot:2
+33 SET ^TMP("LRA",$JOB,ORDT,1.2,1,0)=$$DATE^ORDVU(X)
+34 ;supplemetary Report
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",1.2)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",8)",8)
End DoDot:2
+35 ;frozen Section
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",1.3)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",9)",9)
+36 ;surgical path Dx
DO SPMRG^ORDVU("^TMP(""LRA"","_$JOB_","_ORDT_",1.4)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",10)",10)
+37 ;flag for detail
SET ^TMP("ORDATA",$JOB,ORDT,"WP",11)="11^[+]"
End DoDot:1
+38 KILL ^TMP("LRA",$JOB)
+39 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+40 QUIT
CY(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ;Cytopathology
+1 ;External references to ^DPT(DFN,"LR"), ^GMTSLRPE
+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,"CY",BEG,END,MAX)
End DoDot:1
+9 ;
+10 NEW ORDT,ORX0,GMI,IX0,MAX,LRDFN,IX,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 SET LRDFN=+$GET(^DPT(DFN,"LR"))
+15 IF GO["GMTSLRPE"
if 'LRDFN
QUIT
+16 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
SET GMTS1=OROMEGA
SET GMTS2=ORALPHA
+17 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+18 KILL ^TMP("ORDATA",$JOB)
+19 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+20 KILL ^TMP("LRCY",$JOB)
+21 DO @GO
End DoDot:1
+22 SET ORDT=GMTS1
SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+23 FOR
SET ORDT=$ORDER(^TMP("LRCY",$JOB,ORDT))
if (ORDT'>0)!(ORDT>GMTS2)
QUIT
SET ORX0=$GET(^(ORDT,0))
Begin DoDot:1
+24 SET ORMORE=0
SET SITE=$SELECT($LENGTH($GET(^TMP("LRCY",$JOB,ORDT,"facility"))):^("facility"),1:ORSITE)
+25 ;Station ID
SET ^TMP("ORDATA",$JOB,ORDT,"WP",1)="1^"_SITE
+26 ;collection date
SET ^TMP("ORDATA",$JOB,ORDT,"WP",2)="2^"_$PIECE(ORX0,U)
+27 ;accession number
SET ^TMP("ORDATA",$JOB,ORDT,"WP",5)="5^"_$PIECE(ORX0,U,2)
+28 ;report release date
SET ^TMP("ORDATA",$JOB,ORDT,"WP",4)="4^"_$$DATE^ORDVU($PIECE($GET(^TMP("LRCY",$JOB,ORDT,1)),U,2))
+29 ;specimen
IF $ORDER(^TMP("LRCY",$JOB,ORDT,1,0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",1)","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",3)",3)
+30 ;brief Clinical Hx
IF $ORDER(^TMP("LRCY",$JOB,ORDT,"AH",0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",""AH"")","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",6)",6)
+31 ;gross Description
IF $ORDER(^TMP("LRCY",$JOB,ORDT,"G",0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",""G"")","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",7)",7)
+32 ;microscopic Exam
IF $ORDER(^TMP("LRCY",$JOB,ORDT,"MI",0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",""MI"")","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",8)",8)
+33 ;cythopathology DX
IF $ORDER(^TMP("LRCY",$JOB,ORDT,"NDX",0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",""NDX"")","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",9)",9)
+34 ;supplemetary Report
IF $ORDER(^TMP("LRCY",$JOB,ORDT,"SR",0))
SET ORMORE=1
DO SPMRG^ORDVU("^TMP(""LRCY"","_$JOB_","_ORDT_",""SR"")","^TMP(""ORDATA"","_$JOB_","_ORDT_",""WP"",10)",10)
+35 ;flag for detail
IF ORMORE
SET ^TMP("ORDATA",$JOB,ORDT,"WP",11)="11^[+]"
End DoDot:1
+36 KILL ^TMP("LRCY",$JOB)
+37 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+38 QUIT
