ORDV02.m

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 ---ORDV02   9023     printed  Feb 18, 2025@23:56:37                                                                                                                                                                                                      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)