ORQQLR.m

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

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