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
Q
;
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
Q
;
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)
Q
;
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 Sep 23, 2025@20:04:24 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
