ORDVX1.m

ORDVX1 ; slc/dcm - OE/RR Extract Lab AP Reports ;3/22/03  9:34

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 199;Build 242

 ; Modified from Health Summary Extract ^GMTSLREE

 ; External References

 ;   DBIA   525  ^LR(

 ;   DBIA 10011  ^DIWP

 ;                    

XEM ; Extract EM Data

 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA

 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"EM",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("EM")

 Q

XSP ; Extract SP Data

 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA

 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"SP",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("SP")

 Q

XCY ; Extract CY Data

 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA

 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"CY",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("CY")

 Q

APSET(LRSS)   ; Sets ^TMP("OROOT",$J

 N ACC,CDT,DA,DIC,DIQ,DR,GMW,SN,X,YR

 S CDT=$P(^LR(LRDFN,LRSS,IX,0),U),ACC=$P(^(0),U,6)

 ;I $S(+$P(^LR(LRDFN,LRSS,IX,0),U)'>0:1,+$P(^(0),U,11)'>0:1,1:0) Q

 I $D(ACC) S IX0=IX0+1

 S X=CDT D DTM4 S CDT=X K X

 S ^TMP("OROOT",$J,IX,LRSS,0)=CDT_U_ACC

 I $D(^LR(LRDFN,LRSS,IX,.1)) S ^TMP("OROOT",$J,IX,LRSS,.1)="Site/Specimen"

 S SN=0 F  S SN=$O(^LR(LRDFN,LRSS,IX,.1,SN)) Q:SN'>0  S ^TMP("OROOT",$J,IX,LRSS,.1,SN)=$P(^LR(LRDFN,LRSS,IX,.1,SN,0),U)

 K ^TMP("ORC",$J)

 D EN^LR7OSAP4("^TMP(""ORC"",$J)",LRDFN,LRSS,IX)

 S J=0,CNT=$O(^TMP("OROOT",$J,IX,LRSS,.2,999999),-1)-1

 F  S J=$O(^TMP("ORC",$J,J)) Q:'J  S CNT=CNT+1,^TMP("OROOT",$J,IX,LRSS,.2,CNT)=^TMP("ORC",$J,J,0)

 K ^TMP("ORC",$J)

 Q

DTM4 ;   Receives X FM date and returns X in MM/DD/YYYY TT:TT

 S X=$TR($$FMTE^XLFDT(X,"5ZM"),"@"," ")

 Q

ALL ; Get all AP data in one swell foop

 N IX0,IX K ^TMP("OROOT",$J) S IX=OROMEGA

 F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"SP",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("SP")

 S IX=OROMEGA F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"CY",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("CY")

 S IX=OROMEGA F IX0=1:0:ORMAX S IX=$O(^LR(LRDFN,"EM",IX)) Q:IX'>0!(IX>ORALPHA)  D APSET("EM")

 Q

ORDVX1    ; slc/dcm - OE/RR Extract Lab AP Reports ;3/22/03  9:34

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 199;Build 242

 +2       ; Modified from Health Summary Extract ^GMTSLREE

 +3       ; External References

 +4       ;   DBIA   525  ^LR(

 +5       ;   DBIA 10011  ^DIWP

 +6       ;                    

XEM       ; Extract EM Data

 +1        NEW IX0,IX

           KILL ^TMP("OROOT",$JOB)

           SET IX=OROMEGA

 +2        FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"EM",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("EM")

 +3        QUIT 

XSP       ; Extract SP Data

 +1        NEW IX0,IX

           KILL ^TMP("OROOT",$JOB)

           SET IX=OROMEGA

 +2        FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"SP",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("SP")

 +3        QUIT 

XCY       ; Extract CY Data

 +1        NEW IX0,IX

           KILL ^TMP("OROOT",$JOB)

           SET IX=OROMEGA

 +2        FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"CY",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("CY")

 +3        QUIT 

APSET(LRSS) ; Sets ^TMP("OROOT",$J

 +1        NEW ACC,CDT,DA,DIC,DIQ,DR,GMW,SN,X,YR

 +2        SET CDT=$PIECE(^LR(LRDFN,LRSS,IX,0),U)

           SET ACC=$PIECE(^(0),U,6)

 +3       ;I $S(+$P(^LR(LRDFN,LRSS,IX,0),U)'>0:1,+$P(^(0),U,11)'>0:1,1:0) Q

 +4        IF $DATA(ACC)

               SET IX0=IX0+1

 +5        SET X=CDT

           DO DTM4

           SET CDT=X

           KILL X

 +6        SET ^TMP("OROOT",$JOB,IX,LRSS,0)=CDT_U_ACC

 +7        IF $DATA(^LR(LRDFN,LRSS,IX,.1))

               SET ^TMP("OROOT",$JOB,IX,LRSS,.1)="Site/Specimen"

 +8        SET SN=0

           FOR 

               SET SN=$ORDER(^LR(LRDFN,LRSS,IX,.1,SN))

               IF SN'>0

                   QUIT 

               SET ^TMP("OROOT",$JOB,IX,LRSS,.1,SN)=$PIECE(^LR(LRDFN,LRSS,IX,.1,SN,0),U)

 +9        KILL ^TMP("ORC",$JOB)

 +10       DO EN^LR7OSAP4("^TMP(""ORC"",$J)",LRDFN,LRSS,IX)

 +11       SET J=0

           SET CNT=$ORDER(^TMP("OROOT",$JOB,IX,LRSS,.2,999999),-1)-1

 +12       FOR 

               SET J=$ORDER(^TMP("ORC",$JOB,J))

               IF 'J

                   QUIT 

               SET CNT=CNT+1

               SET ^TMP("OROOT",$JOB,IX,LRSS,.2,CNT)=^TMP("ORC",$JOB,J,0)

 +13       KILL ^TMP("ORC",$JOB)

 +14       QUIT 

DTM4      ;   Receives X FM date and returns X in MM/DD/YYYY TT:TT

 +1        SET X=$TRANSLATE($$FMTE^XLFDT(X,"5ZM"),"@"," ")

 +2        QUIT 

ALL       ; Get all AP data in one swell foop

 +1        NEW IX0,IX

           KILL ^TMP("OROOT",$JOB)

           SET IX=OROMEGA

 +2        FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"SP",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("SP")

 +3        SET IX=OROMEGA

           FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"CY",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("CY")

 +4        SET IX=OROMEGA

           FOR IX0=1:0:ORMAX

               SET IX=$ORDER(^LR(LRDFN,"EM",IX))

               IF IX'>0!(IX>ORALPHA)

                   QUIT 

               DO APSET("EM")

 +5        QUIT