ORWDLR33.m

ORWDLR33 ; SLC/KCM/REV/JDL - Lab Calls ;7/1/2002 11AM

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,141,243,315**;Dec 17, 1997;Build 20

 ;

 ;

 ; DBIA 2388   ^LAB(61

 ; DBIA 2429   ^LR7OV4

 ; DBIA 2992   ^XTV(8989.51

 ;

STOP(VAL,X2)       ; return a calculated stop date

 N X1,X

 S X1=DT D C^%DTC S VAL=X

 Q

MAXDAYS(Y,LOC,SCHED) ; Return max number of days for a continuing order

 N TMP1,TMP2

 K ^TMP($J,"ORWDLR33 MAXDAYS")

 S TMP1=$$GET^XPAR("ALL^LOC.`"_+LOC,"LR MAX DAYS CONTINUOUS",1,"Q")

 I +TMP1=0 S Y="-1" Q

 I +$G(SCHED)>0 D ZERO^PSS51P1(SCHED,,,,"ORWDLR33 MAXDAYS") S TMP2=$G(^TMP($J,"ORWDLR33 MAXDAYS",SCHED,2.5)) K ^TMP($J,"ORWDLR33 MAXDAYS")

 E  S TMP2=0

 I +TMP1=0,+TMP2>0 S Y=TMP2 Q

 I +TMP2=0,+TMP1>0 S Y=TMP1 Q

 S Y=$S(+TMP1>+TMP2:+TMP2,+TMP2>+TMP1:+TMP1,+TMP1=+TMP2:+TMP1,1:0)

 K ^TMP($J,"ORWDLR33 MAXDAYS")

 Q

ALLSPEC(Y,FROM,DIR) ; Return a set of specimens from topography file

 N I,IEN,CNT,A,%,NOW,B

 D NOW^%DTC S NOW=$P(%,".")

 S I=0,CNT=44

 F  Q:I'<CNT  S FROM=$O(^LAB(61,"B",FROM),DIR) Q:FROM=""  D

 . S IEN=0 F  S IEN=$O(^LAB(61,"B",FROM,IEN)) Q:'IEN  D

 . . S A=$G(^LAB(61,IEN,64.91)) S B=$P(A,"^",3) I B]"",B'>NOW Q

 . . S I=I+1,Y(I)=IEN_U_FROM_"  ("_$P($G(^LAB(61,IEN,0)),U,2)_")"

 Q

LABCOLTM(ORYN,ORDATE,ORLOC) ; Is this a routine lab collect time for this location?

 N ORDA,ORTI,ORDOW,ORCTM,I,X,Y

 S ORYN=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC))

 S ORDA=$P(ORDATE,".",1),ORTI=$P(ORDATE,".",2)

 S I=0 F  S I=$L(ORTI) Q:I>3  S ORTI=ORTI_"0"

 S X=ORDA D DW^%DTC S ORDOW=X

 D GETLST^XPAR(.ORCTM,"ALL","LR PHLEBOTOMY COLLECTION","Q")

 S I=0 F  S I=$O(ORCTM(I)) Q:'I  D

 . S:$P(ORCTM(I),U,2)=ORTI ORYN=1

 Q:ORYN=0

 I $G(ORLOC),$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") S ORYN=1 Q

 I '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORYN=0 Q

 I $$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORYN=1 Q

 S ORYN=0

 Q

IMMCOLL(ORY) ; Return help screen showing immediate collect times

 D SHOW^LR7OV4(DUZ(2),.ORY)

 Q

ICDEFLT(ORY) ;Return default immediate collect time

 S ORY=$$DEFTIME^LR7OV4(DUZ(2))

 Q

ICVALID(ORY,ORTIME) ;Is the time a valid immediate collect time?

 S ORTIME=$P(ORTIME,".",1)_"."_$E($P(ORTIME,".",2),1,4)

 S ORY=$$VALID^LR7OV4(DUZ(2),ORTIME)

 Q

GETLABTM(ORY,ORDATE,ORLOC) ;Return list of lab collect times for a date and location

 N ORDA,ORTI,ORNOW,ORDOW,ORCTM,ORTI,X,%,%H

 S ORY(0)=0 Q:'$G(ORDATE)!($G(ORDATE)<0)!('$G(ORLOC))

 S ORDA=$P(ORDATE,".",1)

 S ORNOW=$$NOW^XLFDT,ORTI=$P(ORNOW,".",2)

 I ORDA<$P(ORNOW,".",1) S ORY(0)="-1^Dates in the past are not allowed." Q

 I '+$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q") D

 . S X=ORDA D DW^%DTC S ORDOW=X

 . I '+$$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q") S ORY(0)="-1^No collections on "_ORDOW Q

 . I '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q"),$D(^HOLIDAY(ORDA,0)) S ORY(0)="-1^No holiday collections" Q

 I +ORY(0)>-1 D 

 . D GETLST^XPAR(.ORY,"ALL","LR PHLEBOTOMY COLLECTION","Q")

 . I +$G(ORY)=0 S ORY(0)="-1^No lab collect times defined for this division" Q

 S I=0 F  S I=$O(ORY(I)) Q:'I  D

 . D NOW^%DTC S ORTI=%,%H=+%H_","_+ORY(I) D YMD^%DTC

 . I (ORDA=$P(ORTI,".",1)),(+(ORDA+%)<+ORTI) K ORY(I) S ORY=ORY-1 Q   ; cutoff time has passed for this collect time

 . S ORY(I)=$P(ORY(I),U,2)

 I +$G(ORY)=0,('$D(ORY(0))) S ORY(0)="-1^All of today's collection times have passed."

 Q

LCFUTR(ORDY,ORLOC,ORDIV)  ;Get # of days for future Lab Collects

 ; For Event Delay Order

 ;  --ORLOC Event default location

 ;  --ORDIV Event default division

 S ORDY=0

 Q:'$D(^XTV(8989.51,"B","LR LAB COLLECT FUTURE"))

 I $G(ORDIV) S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")

 E  S ORDY=+$$GET^XPAR(+$G(ORLOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")

 ;S DUZ(2)=TMPDIV

 Q

LASTTIME(ORY)   ; Get last collection time used from ^TMP("ORECALL",$J) array

 N ORDIALOG,ORTYPE,ORTIME

 S ORDIALOG=$O(^ORD(101.41,"B","LR OTHER LAB TESTS",0))

 S ORTYPE=$O(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))

 S ORTIME=$O(^ORD(101.41,"B","OR GTX START DATE/TIME",0))

 S ORY=$$RECALL^ORCD(ORTYPE,1)_U_$$RECALL^ORCD(ORTIME,1)

 Q

LCTOWC(ORTXT,ORLOC)     ; return text instructing user when LC changed to WC on accept/release

 N ORDIV,ORSVC

 S ORDIV=DUZ(2)

 S ORSVC=+$G(^VA(200,DUZ,5))

 I ORSVC S ORTXT=$$GET^XPAR(+$G(ORLOC)_";SC("_"^"_+$G(ORSVC)_";DIC(49,^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I")

 E  S ORTXT=$$GET^XPAR(+$G(ORLOC)_";SC("_"^SVC^"_+$G(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORWDLR33   4592     printed  Apr 23, 2025@18:50:09                                                                                                                                                                                                    Page 2

ORWDLR33  ; SLC/KCM/REV/JDL - Lab Calls ;7/1/2002 11AM

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,141,243,315**;Dec 17, 1997;Build 20

 +2       ;

 +3       ;

 +4       ; DBIA 2388   ^LAB(61

 +5       ; DBIA 2429   ^LR7OV4

 +6       ; DBIA 2992   ^XTV(8989.51

 +7       ;

STOP(VAL,X2) ; return a calculated stop date

 +1        NEW X1,X

 +2        SET X1=DT

           DO C^%DTC

           SET VAL=X

 +3        QUIT 

MAXDAYS(Y,LOC,SCHED) ; Return max number of days for a continuing order

 +1        NEW TMP1,TMP2

 +2        KILL ^TMP($JOB,"ORWDLR33 MAXDAYS")

 +3        SET TMP1=$$GET^XPAR("ALL^LOC.`"_+LOC,"LR MAX DAYS CONTINUOUS",1,"Q")

 +4        IF +TMP1=0

               SET Y="-1"

               QUIT 

 +5        IF +$GET(SCHED)>0

               DO ZERO^PSS51P1(SCHED,,,,"ORWDLR33 MAXDAYS")

               SET TMP2=$GET(^TMP($JOB,"ORWDLR33 MAXDAYS",SCHED,2.5))

               KILL ^TMP($JOB,"ORWDLR33 MAXDAYS")

 +6       IF '$TEST

               SET TMP2=0

 +7        IF +TMP1=0

               IF +TMP2>0

                   SET Y=TMP2

                   QUIT 

 +8        IF +TMP2=0

               IF +TMP1>0

                   SET Y=TMP1

                   QUIT 

 +9        SET Y=$SELECT(+TMP1>+TMP2:+TMP2,+TMP2>+TMP1:+TMP1,+TMP1=+TMP2:+TMP1,1:0)

 +10       KILL ^TMP($JOB,"ORWDLR33 MAXDAYS")

 +11       QUIT 

ALLSPEC(Y,FROM,DIR) ; Return a set of specimens from topography file

 +1        NEW I,IEN,CNT,A,%,NOW,B

 +2        DO NOW^%DTC

           SET NOW=$PIECE(%,".")

 +3        SET I=0

           SET CNT=44

 +4        FOR 

               if I'<CNT

                   QUIT 

               SET FROM=$ORDER(^LAB(61,"B",FROM),DIR)

               if FROM=""

                   QUIT 

               Begin DoDot:1

 +5                SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^LAB(61,"B",FROM,IEN))

                       if 'IEN

                           QUIT 

                       Begin DoDot:2

 +6                        SET A=$GET(^LAB(61,IEN,64.91))

                           SET B=$PIECE(A,"^",3)

                           IF B]""

                               IF B'>NOW

                                   QUIT 

 +7                        SET I=I+1

                           SET Y(I)=IEN_U_FROM_"  ("_$PIECE($GET(^LAB(61,IEN,0)),U,2)_")"

                       End DoDot:2

               End DoDot:1

 +8        QUIT 

LABCOLTM(ORYN,ORDATE,ORLOC) ; Is this a routine lab collect time for this location?

 +1        NEW ORDA,ORTI,ORDOW,ORCTM,I,X,Y

 +2        SET ORYN=0

           if '$GET(ORDATE)!($GET(ORDATE)<0)!('$GET(ORLOC))

               QUIT 

 +3        SET ORDA=$PIECE(ORDATE,".",1)

           SET ORTI=$PIECE(ORDATE,".",2)

 +4        SET I=0

           FOR 

               SET I=$LENGTH(ORTI)

               if I>3

                   QUIT 

               SET ORTI=ORTI_"0"

 +5        SET X=ORDA

           DO DW^%DTC

           SET ORDOW=X

 +6        DO GETLST^XPAR(.ORCTM,"ALL","LR PHLEBOTOMY COLLECTION","Q")

 +7        SET I=0

           FOR 

               SET I=$ORDER(ORCTM(I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +8                if $PIECE(ORCTM(I),U,2)=ORTI

                       SET ORYN=1

               End DoDot:1

 +9        if ORYN=0

               QUIT 

 +10       IF $GET(ORLOC)

               IF $$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q")

                   SET ORYN=1

                   QUIT 

 +11       IF '$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q")

               IF $DATA(^HOLIDAY(ORDA,0))

                   SET ORYN=0

                   QUIT 

 +12       IF $$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q")

               SET ORYN=1

               QUIT 

 +13       SET ORYN=0

 +14       QUIT 

IMMCOLL(ORY) ; Return help screen showing immediate collect times

 +1        DO SHOW^LR7OV4(DUZ(2),.ORY)

 +2        QUIT 

ICDEFLT(ORY) ;Return default immediate collect time

 +1        SET ORY=$$DEFTIME^LR7OV4(DUZ(2))

 +2        QUIT 

ICVALID(ORY,ORTIME) ;Is the time a valid immediate collect time?

 +1        SET ORTIME=$PIECE(ORTIME,".",1)_"."_$EXTRACT($PIECE(ORTIME,".",2),1,4)

 +2        SET ORY=$$VALID^LR7OV4(DUZ(2),ORTIME)

 +3        QUIT 

GETLABTM(ORY,ORDATE,ORLOC) ;Return list of lab collect times for a date and location

 +1        NEW ORDA,ORTI,ORNOW,ORDOW,ORCTM,ORTI,X,%,%H

 +2        SET ORY(0)=0

           if '$GET(ORDATE)!($GET(ORDATE)<0)!('$GET(ORLOC))

               QUIT 

 +3        SET ORDA=$PIECE(ORDATE,".",1)

 +4        SET ORNOW=$$NOW^XLFDT

           SET ORTI=$PIECE(ORNOW,".",2)

 +5        IF ORDA<$PIECE(ORNOW,".",1)

               SET ORY(0)="-1^Dates in the past are not allowed."

               QUIT 

 +6        IF '+$$GET^XPAR(ORLOC_";SC(","LR EXCEPTED LOCATIONS",1,"Q")

               Begin DoDot:1

 +7                SET X=ORDA

                   DO DW^%DTC

                   SET ORDOW=X

 +8                IF '+$$GET^XPAR("ALL","LR COLLECT "_ORDOW,1,"Q")

                       SET ORY(0)="-1^No collections on "_ORDOW

                       QUIT 

 +9                IF '+$$GET^XPAR("ALL","LR IGNORE HOLIDAYS",1,"Q")

                       IF $DATA(^HOLIDAY(ORDA,0))

                           SET ORY(0)="-1^No holiday collections"

                           QUIT 

               End DoDot:1

 +10       IF +ORY(0)>-1

               Begin DoDot:1

 +11               DO GETLST^XPAR(.ORY,"ALL","LR PHLEBOTOMY COLLECTION","Q")

 +12               IF +$GET(ORY)=0

                       SET ORY(0)="-1^No lab collect times defined for this division"

                       QUIT 

               End DoDot:1

 +13       SET I=0

           FOR 

               SET I=$ORDER(ORY(I))

               if 'I

                   QUIT 

               Begin DoDot:1

 +14               DO NOW^%DTC

                   SET ORTI=%

                   SET %H=+%H_","_+ORY(I)

                   DO YMD^%DTC

 +15      ; cutoff time has passed for this collect time

                   IF (ORDA=$PIECE(ORTI,".",1))

                       IF (+(ORDA+%)<+ORTI)

                           KILL ORY(I)

                           SET ORY=ORY-1

                           QUIT 

 +16               SET ORY(I)=$PIECE(ORY(I),U,2)

               End DoDot:1

 +17       IF +$GET(ORY)=0

               IF ('$DATA(ORY(0)))

                   SET ORY(0)="-1^All of today's collection times have passed."

 +18       QUIT 

LCFUTR(ORDY,ORLOC,ORDIV) ;Get # of days for future Lab Collects

 +1       ; For Event Delay Order

 +2       ;  --ORLOC Event default location

 +3       ;  --ORDIV Event default division

 +4        SET ORDY=0

 +5        if '$DATA(^XTV(8989.51,"B","LR LAB COLLECT FUTURE"))

               QUIT 

 +6        IF $GET(ORDIV)

               SET ORDY=+$$GET^XPAR(+$GET(ORLOC)_";SC("_"^"_+$GET(ORDIV)_";DIC(4,^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")

 +7       IF '$TEST

               SET ORDY=+$$GET^XPAR(+$GET(ORLOC)_";SC("_"^DIV^SYS^PKG","LR LAB COLLECT FUTURE",1,"I")

 +8       ;S DUZ(2)=TMPDIV

 +9        QUIT 

LASTTIME(ORY) ; Get last collection time used from ^TMP("ORECALL",$J) array

 +1        NEW ORDIALOG,ORTYPE,ORTIME

 +2        SET ORDIALOG=$ORDER(^ORD(101.41,"B","LR OTHER LAB TESTS",0))

 +3        SET ORTYPE=$ORDER(^ORD(101.41,"B","OR GTX COLLECTION TYPE",0))

 +4        SET ORTIME=$ORDER(^ORD(101.41,"B","OR GTX START DATE/TIME",0))

 +5        SET ORY=$$RECALL^ORCD(ORTYPE,1)_U_$$RECALL^ORCD(ORTIME,1)

 +6        QUIT 

LCTOWC(ORTXT,ORLOC) ; return text instructing user when LC changed to WC on accept/release

 +1        NEW ORDIV,ORSVC

 +2        SET ORDIV=DUZ(2)

 +3        SET ORSVC=+$GET(^VA(200,DUZ,5))

 +4        IF ORSVC

               SET ORTXT=$$GET^XPAR(+$GET(ORLOC)_";SC("_"^"_+$GET(ORSVC)_";DIC(49,^"_+$GET(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I")

 +5       IF '$TEST

               SET ORTXT=$$GET^XPAR(+$GET(ORLOC)_";SC("_"^SVC^"_+$GET(ORDIV)_";DIC(4,^SYS^PKG","ORWLR LC CHANGED TO WC",1,"I")

 +6        QUIT