- ORDV02A ; slc/dcm - OE/RR Report Extracts ; 10/8/03 11:18
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- ;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
- 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 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^[+]",ORCNT=ORCNT+1 ;flag for detail
- K ^TMP("OROOT",$J)
- S ROOT=$NA(^TMP("ORDATA",$J))
- Q
- ORDV02A ; slc/dcm - OE/RR Report Extracts ; 10/8/03 11:18
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- +2 ;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
- +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 SITE=$SELECT($LENGTH($GET(^TMP("OROOT",$JOB,ORDT,ORSS,"facility"))):^("facility"),1:ORSITE)
- +17 ;Station ID
- SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",1)="1^"_SITE
- +18 ;collection date
- SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",2)="2^"_$PIECE(ORX0,U)
- +19 ;accession number
- SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",4)="4^"_$PIECE(ORX0,U,2)
- +20 ;specimen
- DO SPMRG^ORDVU("^TMP(""OROOT"","_$JOB_","_ORDT_","_""""_ORSS_""""_",.1)","^TMP(""ORDATA"","_$JOB_","_""""_ORDT_ORSS_""""_",""WP"",3)",3)
- +21 ;report text
- DO SPMRG^ORDVU("^TMP(""OROOT"","_$JOB_","_ORDT_","_""""_ORSS_""""_",.2)","^TMP(""ORDATA"","_$JOB_","_""""_ORDT_ORSS_""""_",""WP"",5)",5)
- +22 ;flag for detail
- SET ^TMP("ORDATA",$JOB,ORDT_ORSS,"WP",6)="6^[+]"
- SET ORCNT=ORCNT+1
- End DoDot:2
- End DoDot:1
- +23 KILL ^TMP("OROOT",$JOB)
- +24 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +25 QUIT
