ORDVX1 ; slc/dcm - OE/RR Extract Lab AP Reports ;01/08/15 08:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,315,377**;Dec 17, 199;Build 582
;
; Modified from Health Summary Extract ^GMTSLREE
; External References
; DBIA 525 ^LR(
; DBIA 5466 GETACC^LRJWLST
; 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,OACC,TIUDA
S CDT=$P(^LR(LRDFN,LRSS,IX,0),U),ACC=$P(^(0),U,6)
I $T(GETACC^LRJWLST)]"" S OACC=$$GETACC^LRJWLST(LRDFN,LRSS,IX) I OACC]"" S ACC=OACC
;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,.05)) D
. S TIUDA=0 F S TIUDA=$O(^LR(LRDFN,LRSS,IX,.05,"C",TIUDA)) Q:'TIUDA S ^TMP("OROOT",$J,IX,LRSS,.05)=TIUDA
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDVX1 2203 printed Apr 09, 2024@21:36:22 Page 2
ORDVX1 ; slc/dcm - OE/RR Extract Lab AP Reports ;01/08/15 08:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,315,377**;Dec 17, 199;Build 582
+2 ;
+3 ; Modified from Health Summary Extract ^GMTSLREE
+4 ; External References
+5 ; DBIA 525 ^LR(
+6 ; DBIA 5466 GETACC^LRJWLST
+7 ; DBIA 10011 ^DIWP
+8 ;
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,OACC,TIUDA
+2 SET CDT=$PIECE(^LR(LRDFN,LRSS,IX,0),U)
SET ACC=$PIECE(^(0),U,6)
+3 IF $TEXT(GETACC^LRJWLST)]""
SET OACC=$$GETACC^LRJWLST(LRDFN,LRSS,IX)
IF OACC]""
SET ACC=OACC
+4 ;I $S(+$P(^LR(LRDFN,LRSS,IX,0),U)'>0:1,+$P(^(0),U,11)'>0:1,1:0) Q
+5 IF $DATA(ACC)
SET IX0=IX0+1
+6 SET X=CDT
DO DTM4
SET CDT=X
KILL X
+7 SET ^TMP("OROOT",$JOB,IX,LRSS,0)=CDT_U_ACC
+8 IF $DATA(^LR(LRDFN,LRSS,IX,.05))
Begin DoDot:1
+9 SET TIUDA=0
FOR
SET TIUDA=$ORDER(^LR(LRDFN,LRSS,IX,.05,"C",TIUDA))
if 'TIUDA
QUIT
SET ^TMP("OROOT",$JOB,IX,LRSS,.05)=TIUDA
End DoDot:1
+10 IF $DATA(^LR(LRDFN,LRSS,IX,.1))
SET ^TMP("OROOT",$JOB,IX,LRSS,.1)="Site/Specimen"
+11 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)
+12 KILL ^TMP("ORC",$JOB)
+13 DO EN^LR7OSAP4("^TMP(""ORC"",$J)",LRDFN,LRSS,IX)
+14 SET J=0
SET CNT=$ORDER(^TMP("OROOT",$JOB,IX,LRSS,.2,999999),-1)-1
+15 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)
+16 KILL ^TMP("ORC",$JOB)
+17 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
