Routine: ORCDLR2

ORCDLR2 ;SLC/MKB - Silent utilities for LR dialogs ; 11/4/2007

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,303,317**;Dec 17, 1997;Build 2

 ;DJE/VM *317 ORLR changed to ORLRGUI

GUI(ORY,ORL,ORDERS)  ; -- ck list of ORDERS for labs w/invalid coll times

 N ORI,ORIFN,ORCNT,RES,I,N,DAD,X

 K ^TMP($J,"ORLRGUI") S ORCNT=0

 S ORI="" F  S ORI=$O(ORDERS(ORI)) Q:ORI=""  D

 . Q:+$P(ORDERS(ORI),";",2)>1          ;only ck NW order actions

 . S ORIFN=+ORDERS(ORI) Q:'$$LC(ORIFN)  ;only ck Lab, LC/I orders

 . K RES D KIDS(.RES,$G(ORL),ORIFN)

 . S I=0 F  S I=$O(RES(I)) Q:I<1  I $P(RES(I),U,2) K RES(I)

 . Q:'$O(RES(0))  ;no invalid times found

 . S ORCNT=ORCNT+1,^TMP($J,"ORLRGUI",ORCNT)=ORIFN

 . S I=0 F  S I=$O(RES(I)) Q:I<1  S ^TMP($J,"ORLRGUI",ORCNT,I)=RES(I)

 S ORY(1)="~COUNT",ORY(2)="d"_ORCNT,N=2

 F DAD=1:1:ORCNT S ORIFN=$G(^TMP($J,"ORLRGUI",DAD)) D

 . S N=N+1,ORY(N)="~ORDER_"_DAD

 . S N=N+1,ORY(N)="t#"_ORIFN_"  "_$G(^OR(100,ORIFN,8,1,.1,1,0)) ;1st line order text

 . S ORI=0 F  S ORI=$O(^TMP($J,"ORLRGUI",DAD,ORI)) Q:ORI<1  S X=^(ORI) D

 .. S N=N+1,ORY(N)="i"_X

KIDS(ORY,ORL,ORIFN,DATE,TYPE,SCH,DUR) ; -- get child times, validate LC/IC

 ; ORL   = Hospital Location file #44 vptr

 ; ORIFN = Orders file #100 ien

 ;   or

 ; DATE  = Start date.time or "AM" or "NEXT"

 ; TYPE  = LC or I

 ; SCH   = Administration Schedule file #51.1 ien

 ; DUR   = # or "X"_#

 ; Will quit if OREVENT exists <can't check delayed orders>

 ; Returns ORY(n) = child start.time ^ 1 or 0 ^ [error message]

 N OR0,VALIDT,ORTIME,ORIMTIME,ORDIV,X,Y,%DT,ORSTRT,ORI,ORN,OK

 S OR0=$G(^OR(100,+$G(ORIFN),0)) Q:$P(OR0,U,17)  Q:$G(OREVENT)  ;delayed orders

 I $G(ORIFN),'$L($G(DATE))!'$L($G(TYPE))!'$G(SCH)!'$L($G(DUR)) D  ;get values

 . S DATE=$$VALUE^ORX8(ORIFN,"START")

 . S TYPE=$$VALUE^ORX8(ORIFN,"COLLECT")

 . S SCH=$$VALUE^ORX8(ORIFN,"SCHEDULE")

 . S DUR=$$VALUE^ORX8(ORIFN,"DAYS")

 Q:'$L($G(DATE))  Q:'$G(SCH)  Q:"SPWC"[$G(TYPE)  Q:'$L($G(DUR))

 S VALIDT="" D GETIMES^ORCDLR1

 D AM^ORCSAVE2:DATE="AM",NEXT^ORCSAVE2:DATE="NEXT" ; returns X

 S %DT="T" S:'$D(X) X=DATE  D ^%DT I Y<1 Q

 D SCHEDULE(.ORSTRT,Y,SCH,DUR) Q:ORSTRT'>1 0 ; get all starts

 K ORY S ORY=ORSTRT

 S (ORI,ORN)=0 F  S ORI=$O(ORSTRT(ORI)) Q:'ORI  S OK="" D

 . I TYPE="LC" S OK=$$LABCOLL^ORCDLR1(ORI)

 . I TYPE="I" S OK=$$IMMCOLL^ORCDLR1(ORI)

 . S ORN=ORN+1,ORY(ORN)=ORI_U_OK

SCHEDULE(ORY,PSJSD,SCH,ORDUR) ; Returns list of start time(s) from schedule

 ; PSJEEU  - DBIA #2417

 ; PSS51P1 - DBIA #4546

 N I,X,ORSCH,PSJFD,PSJW,PSJNE,PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY,PSJAX,PSJSCH,PSJOSD,PSJOFD,PSJC,NXT

 Q:'$G(PSJSD)  S ORY=1,ORY(PSJSD)="",SCH=$G(SCH) ;1st occurrance

 S I="",X=SCH S:+SCH I=+SCH,X="" ;I=ien or X=name

 D ZERO^PSS51P1(I,X,"LR",,"ORLR") S ORSCH=+$O(^TMP($J,"ORLR",0)) ;ien

 S PSJX=$G(^TMP($J,"ORLR",ORSCH,.01))

 S PSJW=+$G(ORL),PSJNE="",PSJPP="LR" D ENSV^PSJEEU Q:'$L($G(PSJX))

 I $G(PSJTS)'="C",$G(PSJTS)'="D" Q  ;not continuous or day-of-week

 S PSJSCH=PSJX

 S:ORDUR PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1)

 I 'ORDUR S X=+$E(ORDUR,2,9) D

 . I PSJM S PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1) ;X_#times

 . E  D  ;no freq in minutes --> day of week

 .. N DAYS,LOCMX,SCHMX

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

 .. S SCHMX=$G(^TMP($J,"ORLR",ORSCH,2.5))

 .. S DAYS=$S('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX)

 .. S PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1)

 D ENSPU^PSJEEU K ORY

 I ORDUR M ORY=PSJC Q

 S ORY=$S(PSJC<$E(ORDUR,2,9):PSJC,1:$E(ORDUR,2,9))

 S NXT=0 F I=1:1:ORY S NXT=$O(PSJC(NXT)) Q:'NXT  S ORY(NXT)=PSJC(NXT)

LC(IEN) ; -- Return 1 or 0, if order IEN is to Lab for LC or I

 N Y,X0,PKG S Y=0

 S X0=$G(^OR(100,+$G(IEN),0)),PKG=$$NMSP^ORCD(+$P(X0,U,14))

 I PKG="LR" D

 . N X S X=$$VALUE^ORX8(IEN,"COLLECT")

 . I X="LC"!(X="I") S Y=1

Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDLR2   3833     printed  Mar 13, 2025@21:33:03                                                                                                                                                                                                     Page 2

ORCDLR2   ;SLC/MKB - Silent utilities for LR dialogs ; 11/4/2007

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,303,317**;Dec 17, 1997;Build 2

 +2       ;

 +3       ;DJE/VM *317 ORLR changed to ORLRGUI

GUI(ORY,ORL,ORDERS) ; -- ck list of ORDERS for labs w/invalid coll times

 +1        NEW ORI,ORIFN,ORCNT,RES,I,N,DAD,X

 +2        KILL ^TMP($JOB,"ORLRGUI")

           SET ORCNT=0

 +3        SET ORI=""

FOR

               SET ORI=$ORDER(ORDERS(ORI))

               if ORI=""

                   QUIT

               Begin DoDot:1

 +4       ;only ck NW order actions

                   if +$PIECE(ORDERS(ORI),";",2)>1

                       QUIT

 +5       ;only ck Lab, LC/I orders

                   SET ORIFN=+ORDERS(ORI)

                   if '$$LC(ORIFN)

                       QUIT

 +6                KILL RES

                   DO KIDS(.RES,$GET(ORL),ORIFN)

 +7                SET I=0

FOR

                       SET I=$ORDER(RES(I))

                       if I<1

                           QUIT

                       IF $PIECE(RES(I),U,2)

                           KILL RES(I)

 +8       ;no invalid times found

                   if '$ORDER(RES(0))

                       QUIT

 +9                SET ORCNT=ORCNT+1

                   SET ^TMP($JOB,"ORLRGUI",ORCNT)=ORIFN

 +10               SET I=0

FOR

                       SET I=$ORDER(RES(I))

                       if I<1

                           QUIT

                       SET ^TMP($JOB,"ORLRGUI",ORCNT,I)=RES(I)

               End DoDot:1

 +11       SET ORY(1)="~COUNT"

           SET ORY(2)="d"_ORCNT

           SET N=2

 +12       FOR DAD=1:1:ORCNT

               SET ORIFN=$GET(^TMP($JOB,"ORLRGUI",DAD))

               Begin DoDot:1

 +13               SET N=N+1

                   SET ORY(N)="~ORDER_"_DAD

 +14      ;1st line order text

                   SET N=N+1

                   SET ORY(N)="t#"_ORIFN_"  "_$GET(^OR(100,ORIFN,8,1,.1,1,0))

 +15               SET ORI=0

FOR

                       SET ORI=$ORDER(^TMP($JOB,"ORLRGUI",DAD,ORI))

                       if ORI<1

                           QUIT

                       SET X=^(ORI)

                       Begin DoDot:2

 +16                       SET N=N+1

                           SET ORY(N)="i"_X

                       End DoDot:2

               End DoDot:1

 +17       QUIT

 +18      ;

KIDS(ORY,ORL,ORIFN,DATE,TYPE,SCH,DUR) ; -- get child times, validate LC/IC

 +1       ; ORL   = Hospital Location file #44 vptr

 +2       ; ORIFN = Orders file #100 ien

 +3       ;   or

 +4       ; DATE  = Start date.time or "AM" or "NEXT"

 +5       ; TYPE  = LC or I

 +6       ; SCH   = Administration Schedule file #51.1 ien

 +7       ; DUR   = # or "X"_#

 +8       ; Will quit if OREVENT exists <can't check delayed orders>

 +9       ;

 +10      ; Returns ORY(n) = child start.time ^ 1 or 0 ^ [error message]

 +11      ;

 +12       NEW OR0,VALIDT,ORTIME,ORIMTIME,ORDIV,X,Y,%DT,ORSTRT,ORI,ORN,OK

 +13      ;delayed orders

           SET OR0=$GET(^OR(100,+$GET(ORIFN),0))

           if $PIECE(OR0,U,17)

               QUIT

           if $GET(OREVENT)

               QUIT

 +14      ;get values

           IF $GET(ORIFN)

               IF '$LENGTH($GET(DATE))!'$LENGTH($GET(TYPE))!'$GET(SCH)!'$LENGTH($GET(DUR))

                   Begin DoDot:1

 +15                   SET DATE=$$VALUE^ORX8(ORIFN,"START")

 +16                   SET TYPE=$$VALUE^ORX8(ORIFN,"COLLECT")

 +17                   SET SCH=$$VALUE^ORX8(ORIFN,"SCHEDULE")

 +18                   SET DUR=$$VALUE^ORX8(ORIFN,"DAYS")

                   End DoDot:1

 +19       if '$LENGTH($GET(DATE))

               QUIT

           if '$GET(SCH)

               QUIT

           if "SPWC"[$GET(TYPE)

               QUIT

           if '$LENGTH($GET(DUR))

               QUIT

 +20       SET VALIDT=""

           DO GETIMES^ORCDLR1

 +21      ; returns X

           if DATE="AM"

               DO AM^ORCSAVE2

           if DATE="NEXT"

               DO NEXT^ORCSAVE2

 +22       SET %DT="T"

           if '$DATA(X)

               SET X=DATE

           DO ^%DT

           IF Y<1

               QUIT

 +23      ; get all starts

           DO SCHEDULE(.ORSTRT,Y,SCH,DUR)

           if ORSTRT'>1

               QUIT 0

 +24       KILL ORY

           SET ORY=ORSTRT

 +25       SET (ORI,ORN)=0

FOR

               SET ORI=$ORDER(ORSTRT(ORI))

               if 'ORI

                   QUIT

               SET OK=""

               Begin DoDot:1

 +26               IF TYPE="LC"

                       SET OK=$$LABCOLL^ORCDLR1(ORI)

 +27               IF TYPE="I"

                       SET OK=$$IMMCOLL^ORCDLR1(ORI)

 +28               SET ORN=ORN+1

                   SET ORY(ORN)=ORI_U_OK

               End DoDot:1

 +29       QUIT

 +30      ;

SCHEDULE(ORY,PSJSD,SCH,ORDUR) ; Returns list of start time(s) from schedule

 +1       ; PSJEEU  - DBIA #2417

 +2       ; PSS51P1 - DBIA #4546

 +3        NEW I,X,ORSCH,PSJFD,PSJW,PSJNE,PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY,PSJAX,PSJSCH,PSJOSD,PSJOFD,PSJC,NXT

 +4       ;1st occurrance

           if '$GET(PSJSD)

               QUIT

           SET ORY=1

           SET ORY(PSJSD)=""

           SET SCH=$GET(SCH)

 +5       ;I=ien or X=name

           SET I=""

           SET X=SCH

           if +SCH

               SET I=+SCH

               SET X=""

 +6       ;ien

           DO ZERO^PSS51P1(I,X,"LR",,"ORLR")

           SET ORSCH=+$ORDER(^TMP($JOB,"ORLR",0))

 +7        SET PSJX=$GET(^TMP($JOB,"ORLR",ORSCH,.01))

 +8        SET PSJW=+$GET(ORL)

           SET PSJNE=""

           SET PSJPP="LR"

           DO ENSV^PSJEEU

           if '$LENGTH($GET(PSJX))

               QUIT

 +9       ;not continuous or day-of-week

           IF $GET(PSJTS)'="C"

               IF $GET(PSJTS)'="D"

                   QUIT

 +10       SET PSJSCH=PSJX

 +11       if ORDUR

               SET PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1)

 +12       IF 'ORDUR

               SET X=+$EXTRACT(ORDUR,2,9)

               Begin DoDot:1

 +13      ;X_#times

                   IF PSJM

                       SET PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1)

 +14      ;no freq in minutes --> day of week

                  IF '$TEST

                       Begin DoDot:2

 +15                       NEW DAYS,LOCMX,SCHMX

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

 +17                       SET SCHMX=$GET(^TMP($JOB,"ORLR",ORSCH,2.5))

 +18                       SET DAYS=$SELECT('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX)

 +19                       SET PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1)

                       End DoDot:2

               End DoDot:1

 +20       DO ENSPU^PSJEEU

           KILL ORY

 +21       IF ORDUR

               MERGE ORY=PSJC

               QUIT

 +22       SET ORY=$SELECT(PSJC<$EXTRACT(ORDUR,2,9):PSJC,1:$EXTRACT(ORDUR,2,9))

 +23       SET NXT=0

           FOR I=1:1:ORY

               SET NXT=$ORDER(PSJC(NXT))

               if 'NXT

                   QUIT

               SET ORY(NXT)=PSJC(NXT)

 +24       QUIT

 +25      ;

LC(IEN)   ; -- Return 1 or 0, if order IEN is to Lab for LC or I

 +1        NEW Y,X0,PKG

           SET Y=0

 +2        SET X0=$GET(^OR(100,+$GET(IEN),0))

           SET PKG=$$NMSP^ORCD(+$PIECE(X0,U,14))

 +3        IF PKG="LR"

               Begin DoDot:1

 +4                NEW X

                   SET X=$$VALUE^ORX8(IEN,"COLLECT")

 +5                IF X="LC"!(X="I")

                       SET Y=1

               End DoDot:1

 +6        QUIT Y

ORCDLR2.m