ORQQLR ; slc/CLA - Functions which return patient lab results ;12/15/97 [ 04/02/97 3:46 PM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,143**;Dec 17, 1997
;
LIST(Y,PT,SDT,EDT,SUBSECT) ; return patient's lab results between start date and stop date for the lab sub section:
N I,J,SUB,INVDT,SEQ,DIFF,X,EXTDT,ORSRV
S J=1,SUB=0,INVDT=0,SEQ=0
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
I '$L($G(SDT)) S Y(1)="^Error in date range." Q
I '$L($G(EDT)) D NOW^%DTC S EDT=+% K %
S:'$L($G(SUBSECT)) SUBSECT="ALL"
K ^TMP("LRRR",$J)
D RR^LR7OR1(PT,"",SDT,EDT,SUBSECT)
F S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB="" D
.S INVDT=0 F S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:INVDT="" D
..S SEQ=0 F S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:SEQ=""!(SEQ<1) D
...S X=^(SEQ),Y(J)=$P(X,U)_U_$P(X,U,15)_U_$P(X,U,2)_U_$P(X,U,4)_U_$P(X,U,3)_U
...S EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT),Y(J)=Y(J)_EXTDT
...S J=J+1
K ^TMP("LRRR",$J)
S:+$G(Y(1))<1 Y(1)="^No results found."
Q
;
ORDER(Y,PATIENT,ORDER) ; return patient's lab results for an order:
N RSLT
S RSLT=$$GETDATA^OCXCACHE(.Y,"ORDERC^ORQQLR(.OCXDATA,"_PATIENT_","_ORDER_")",PATIENT,)
Q
;
ORDERC(Y,PATIENT,ORDER) ; return patient's lab results for an order:
N SUB,INVDT,SEQ,RESULT,J,LRORD S SUB="",INVDT=0,SEQ=0,J=1
K ^TMP("LRRR",$J)
S LRORD=$G(^OR(100,+ORDER,4))
Q:'$L(LRORD)
D RR^LR7OR1(PATIENT,LRORD,"","","","","")
S SUB=$O(^TMP("LRRR",$J,PATIENT,SUB)) Q:SUB=""
S INVDT=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT)) Q:'INVDT
F S SEQ=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT,SEQ)) Q:'SEQ D
.S RESULT=^(SEQ),Y(J)=$P(RESULT,U)_U_$P(RESULT,U,15)_U_$P(RESULT,U,2)_U_$P(RESULT,U,4)_U_$P(RESULT,U,3)_U_$P(RESULT,U,5)_U_INVDT,J=J+1
K ^TMP("LRRR",$J)
Q
DETAIL(LST,DFN,ORDER) ; return lab results for an order
N LRORD,SUB,IDT,I,DATE,FLAG,REF,ILST
S LST(1)="No detailed information found.",ILST=0
S LRORD=$G(^OR(100,+ORDER,4))
Q:'$L(LRORD)
K ^TMP("LRRR",$J)
D RR^LR7OR1(DFN,LRORD,"","","","","")
S SUB="" F S SUB=$O(^TMP("LRRR",$J,DFN,SUB)) Q:SUB="" D
. S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,SUB,IDT)) Q:'IDT D
. . S I=0 F S I=$O(^TMP("LRRR",$J,DFN,SUB,IDT,I)) Q:'I S X=^(I) D
. . . S DATE=$$FMTE^XLFDT(9999999-IDT),FLAG=$P(X,U,3)
. . . S REF=$P(X,U,5)
. . . S:$L(REF) REF="("_$P(X,U,5)_")"
. . . S X=$P(X,U,15)_U_$P(X,U,2)_U_$P(X,U,4)_U_FLAG_U_DATE_U_REF
. . . S X=$$TABPIECE(X,"1,2,3,4,5,6","9,18,24,27,50")
. . . S ILST=ILST+1,LST(ILST)=X
K ^TMP("LRRR",$J)
Q
TABPIECE(X,PIECES,TABS) ; return pieces with withspace between them
N I,J,Y,APIECE S Y=""
F I=1:1:$L(PIECES,",") S APIECE=+$P(PIECES,",",I) D
. S Y=Y_$P(X,U,APIECE)
. F J=$L(Y):1:+$P(TABS,",",I) S Y=Y_" "
Q Y
ZDETAIL(Y,PATIENT,ORDER) ; return detailed, narrative results for an order:
N CR,J,SUB,INVDT,SEQ,RESULT,EXTDT,FLAG,LRORD
S CR=$CHAR(13),J=1,SUB="",INVDT=0,SEQ=0
S LRORD=$$OETOLAB^ORQQLR1(+ORDER)
I '$L($G(LRORD)) S Y(J)="No detailed information found." Q
K ^TMP("LRRR",$J)
D RR^LR7OR1(PATIENT,LRORD,"","","","","")
S SUB=$O(^TMP("LRRR",$J,PATIENT,SUB))
I '$L($G(SUB)) S Y(J)="No detailed information found." Q
S INVDT=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT))
I '$L($G(INVDT)) S Y(J)="No detailed information found." Q
F S SEQ=$O(^TMP("LRRR",$J,PATIENT,SUB,INVDT,SEQ)) Q:'SEQ D
.S RESULT=^(SEQ),Y(J)=$P(RESULT,U,15)_" "_$P(RESULT,U,2)_" "_$P(RESULT,U,4),FLAG=$P(RESULT,U,3)
.S Y(J)=Y(J)_$S($L($G(FLAG)):" "_FLAG,1:"")
.S EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT)
.S Y(J)=Y(J)_" "_EXTDT_" (ref. "_$P(RESULT,U,5)_")",J=J+1
K ^TMP("LRRR",$J)
Q
SROUT(ORY) ;return lab results search date range for an outpatient
N DIFF,SDT,EDT,ORSRV
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S DIFF=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE OUTPT",1,"E")
S:+$G(DIFF)<1 DIFF=14 ;if no default defined use 14 days
S ORY=DIFF
Q
SRIN(ORY,ORPT) ;return lab results search date range for an inpatient
N DIFF,SDT,EDT,ORSRV,ORLOC
;
;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
;reliably determined, and many simultaneous outpt locations can occur):
I +$G(ORPT)>0 D
.N DFN S DFN=ORPT,VA200="" D OERR^VADPT
.I +$G(VAIN(4))>0 S ORLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
.K VA200,VAIN
;
S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S DIFF=$$GET^XPAR("USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE INPT",1,"E")
S:+$G(DIFF)<1 DIFF=2 ;if no default defined use 2 days
S ORY=DIFF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQLR 4580 printed Dec 13, 2024@02:33:37 Page 2
ORQQLR ; slc/CLA - Functions which return patient lab results ;12/15/97 [ 04/02/97 3:46 PM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,143**;Dec 17, 1997
+2 ;
LIST(Y,PT,SDT,EDT,SUBSECT) ; return patient's lab results between start date and stop date for the lab sub section:
+1 NEW I,J,SUB,INVDT,SEQ,DIFF,X,EXTDT,ORSRV
+2 SET J=1
SET SUB=0
SET INVDT=0
SET SEQ=0
+3 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+4 IF '$LENGTH($GET(SDT))
SET Y(1)="^Error in date range."
QUIT
+5 IF '$LENGTH($GET(EDT))
DO NOW^%DTC
SET EDT=+%
KILL %
+6 if '$LENGTH($GET(SUBSECT))
SET SUBSECT="ALL"
+7 KILL ^TMP("LRRR",$JOB)
+8 DO RR^LR7OR1(PT,"",SDT,EDT,SUBSECT)
+9 FOR
SET SUB=$ORDER(^TMP("LRRR",$JOB,PT,SUB))
if SUB=""
QUIT
Begin DoDot:1
+10 SET INVDT=0
FOR
SET INVDT=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT))
if INVDT=""
QUIT
Begin DoDot:2
+11 SET SEQ=0
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT,SEQ))
if SEQ=""!(SEQ<1)
QUIT
Begin DoDot:3
+12 SET X=^(SEQ)
SET Y(J)=$PIECE(X,U)_U_$PIECE(X,U,15)_U_$PIECE(X,U,2)_U_$PIECE(X,U,4)_U_$PIECE(X,U,3)_U
+13 SET EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT)
SET Y(J)=Y(J)_EXTDT
+14 SET J=J+1
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL ^TMP("LRRR",$JOB)
+16 if +$GET(Y(1))<1
SET Y(1)="^No results found."
+17 QUIT
+18 ;
ORDER(Y,PATIENT,ORDER) ; return patient's lab results for an order:
+1 NEW RSLT
+2 SET RSLT=$$GETDATA^OCXCACHE(.Y,"ORDERC^ORQQLR(.OCXDATA,"_PATIENT_","_ORDER_")",PATIENT,)
+3 QUIT
+4 ;
ORDERC(Y,PATIENT,ORDER) ; return patient's lab results for an order:
+1 NEW SUB,INVDT,SEQ,RESULT,J,LRORD
SET SUB=""
SET INVDT=0
SET SEQ=0
SET J=1
+2 KILL ^TMP("LRRR",$JOB)
+3 SET LRORD=$GET(^OR(100,+ORDER,4))
+4 if '$LENGTH(LRORD)
QUIT
+5 DO RR^LR7OR1(PATIENT,LRORD,"","","","","")
+6 SET SUB=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB))
if SUB=""
QUIT
+7 SET INVDT=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB,INVDT))
if 'INVDT
QUIT
+8 FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB,INVDT,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+9 SET RESULT=^(SEQ)
SET Y(J)=$PIECE(RESULT,U)_U_$PIECE(RESULT,U,15)_U_$PIECE(RESULT,U,2)_U_$PIECE(RESULT,U,4)_U_$PIECE(RESULT,U,3)_U_$PIECE(RESULT,U,5)_U_INVDT
SET J=J+1
End DoDot:1
+10 KILL ^TMP("LRRR",$JOB)
+11 QUIT
DETAIL(LST,DFN,ORDER) ; return lab results for an order
+1 NEW LRORD,SUB,IDT,I,DATE,FLAG,REF,ILST
+2 SET LST(1)="No detailed information found."
SET ILST=0
+3 SET LRORD=$GET(^OR(100,+ORDER,4))
+4 if '$LENGTH(LRORD)
QUIT
+5 KILL ^TMP("LRRR",$JOB)
+6 DO RR^LR7OR1(DFN,LRORD,"","","","","")
+7 SET SUB=""
FOR
SET SUB=$ORDER(^TMP("LRRR",$JOB,DFN,SUB))
if SUB=""
QUIT
Begin DoDot:1
+8 SET IDT=0
FOR
SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT))
if 'IDT
QUIT
Begin DoDot:2
+9 SET I=0
FOR
SET I=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,I))
if 'I
QUIT
SET X=^(I)
Begin DoDot:3
+10 SET DATE=$$FMTE^XLFDT(9999999-IDT)
SET FLAG=$PIECE(X,U,3)
+11 SET REF=$PIECE(X,U,5)
+12 if $LENGTH(REF)
SET REF="("_$PIECE(X,U,5)_")"
+13 SET X=$PIECE(X,U,15)_U_$PIECE(X,U,2)_U_$PIECE(X,U,4)_U_FLAG_U_DATE_U_REF
+14 SET X=$$TABPIECE(X,"1,2,3,4,5,6","9,18,24,27,50")
+15 SET ILST=ILST+1
SET LST(ILST)=X
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL ^TMP("LRRR",$JOB)
+17 QUIT
TABPIECE(X,PIECES,TABS) ; return pieces with withspace between them
+1 NEW I,J,Y,APIECE
SET Y=""
+2 FOR I=1:1:$LENGTH(PIECES,",")
SET APIECE=+$PIECE(PIECES,",",I)
Begin DoDot:1
+3 SET Y=Y_$PIECE(X,U,APIECE)
+4 FOR J=$LENGTH(Y):1:+$PIECE(TABS,",",I)
SET Y=Y_" "
End DoDot:1
+5 QUIT Y
ZDETAIL(Y,PATIENT,ORDER) ; return detailed, narrative results for an order:
+1 NEW CR,J,SUB,INVDT,SEQ,RESULT,EXTDT,FLAG,LRORD
+2 SET CR=$CHAR(13)
SET J=1
SET SUB=""
SET INVDT=0
SET SEQ=0
+3 SET LRORD=$$OETOLAB^ORQQLR1(+ORDER)
+4 IF '$LENGTH($GET(LRORD))
SET Y(J)="No detailed information found."
QUIT
+5 KILL ^TMP("LRRR",$JOB)
+6 DO RR^LR7OR1(PATIENT,LRORD,"","","","","")
+7 SET SUB=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB))
+8 IF '$LENGTH($GET(SUB))
SET Y(J)="No detailed information found."
QUIT
+9 SET INVDT=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB,INVDT))
+10 IF '$LENGTH($GET(INVDT))
SET Y(J)="No detailed information found."
QUIT
+11 FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,PATIENT,SUB,INVDT,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+12 SET RESULT=^(SEQ)
SET Y(J)=$PIECE(RESULT,U,15)_" "_$PIECE(RESULT,U,2)_" "_$PIECE(RESULT,U,4)
SET FLAG=$PIECE(RESULT,U,3)
+13 SET Y(J)=Y(J)_$SELECT($LENGTH($GET(FLAG)):" "_FLAG,1:"")
+14 SET EXTDT=$$EXTERNAL^DILFD(4.302,.01,"",9999999-INVDT)
+15 SET Y(J)=Y(J)_" "_EXTDT_" (ref. "_$PIECE(RESULT,U,5)_")"
SET J=J+1
End DoDot:1
+16 KILL ^TMP("LRRR",$JOB)
+17 QUIT
SROUT(ORY) ;return lab results search date range for an outpatient
+1 NEW DIFF,SDT,EDT,ORSRV
+2 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+3 SET DIFF=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE OUTPT",1,"E")
+4 ;if no default defined use 14 days
if +$GET(DIFF)<1
SET DIFF=14
+5 SET ORY=DIFF
+6 QUIT
SRIN(ORY,ORPT) ;return lab results search date range for an inpatient
+1 NEW DIFF,SDT,EDT,ORSRV,ORLOC
+2 ;
+3 ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
+4 ;reliably determined, and many simultaneous outpt locations can occur):
+5 IF +$GET(ORPT)>0
Begin DoDot:1
+6 NEW DFN
SET DFN=ORPT
SET VA200=""
DO OERR^VADPT
+7 IF +$GET(VAIN(4))>0
SET ORLOC=+$GET(^DIC(42,+$GET(VAIN(4)),44))
+8 KILL VA200,VAIN
End DoDot:1
+9 ;
+10 SET ORSRV=$GET(^VA(200,DUZ,5))
IF +ORSRV>0
SET ORSRV=$PIECE(ORSRV,U)
+11 SET DIFF=$$GET^XPAR("USR^LOC.`"_$GET(ORLOC)_"^SRV.`"_+$GET(ORSRV)_"^DIV^SYS^PKG","ORQQLR SEARCH RANGE INPT",1,"E")
+12 ;if no default defined use 2 days
if +$GET(DIFF)<1
SET DIFF=2
+13 SET ORY=DIFF
+14 QUIT
