source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDLR2.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1ORCDLR2 ;SLC/MKB - Silent utilities for LR dialogs
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4GUI(ORY,ORL,ORDERS) ; -- ck list of ORDERS for labs w/invalid coll times
5 N ORI,ORIFN,ORCNT,RES,I,N,DAD,X
6 K ^TMP($J,"ORLR") S ORCNT=0
7 S ORI="" F S ORI=$O(ORDERS(ORI)) Q:ORI="" D
8 . S ORIFN=+ORDERS(ORI) Q:'$$LC(ORIFN) ;only ck Lab, LC/I orders
9 . K RES D KIDS(.RES,$G(ORL),ORIFN)
10 . S I=0 F S I=$O(RES(I)) Q:I<1 I $P(RES(I),U,2) K RES(I)
11 . Q:'$O(RES(0)) ;no invalid times found
12 . S ORCNT=ORCNT+1,^TMP($J,"ORLR",ORCNT)=ORIFN
13 . S I=0 F S I=$O(RES(I)) Q:I<1 S ^TMP($J,"ORLR",ORCNT,I)=RES(I)
14 S ORY(1)="~COUNT",ORY(2)="d"_ORCNT,N=2
15 F DAD=1:1:ORCNT S ORIFN=$G(^TMP($J,"ORLR",DAD)) D
16 . S N=N+1,ORY(N)="~ORDER_"_DAD
17 . S N=N+1,ORY(N)="t#"_ORIFN_" "_$G(^OR(100,ORIFN,8,1,.1,1,0)) ;1st line order text
18 . S ORI=0 F S ORI=$O(^TMP($J,"ORLR",DAD,ORI)) Q:ORI<1 S X=^(ORI) D
19 .. S N=N+1,ORY(N)="i"_X
20 Q
21 ;
22KIDS(ORY,ORL,ORIFN,DATE,TYPE,SCH,DUR) ; -- get child times, validate LC/IC
23 ; ORL = Hospital Location file #44 vptr
24 ; ORIFN = Orders file #100 ien
25 ; or
26 ; DATE = Start date.time or "AM" or "NEXT"
27 ; TYPE = LC or I
28 ; SCH = Administration Schedule file #51.1 ien
29 ; DUR = # or "X"_#
30 ; Will quit if OREVENT exists <can't check delayed orders>
31 ;
32 ; Returns ORY(n) = child start.time ^ 1 or 0 ^ [error message]
33 ;
34 N OR0,VALIDT,ORTIME,ORIMTIME,ORDIV,X,Y,%DT,ORSTRT,ORI,ORN,OK
35 S OR0=$G(^OR(100,+$G(ORIFN),0)) Q:$P(OR0,U,17) Q:$G(OREVENT) ;delayed orders
36 I $G(ORIFN),'$L($G(DATE))!'$L($G(TYPE))!'$G(SCH)!'$L($G(DUR)) D ;get values
37 . S DATE=$$VALUE^ORX8(ORIFN,"START")
38 . S TYPE=$$VALUE^ORX8(ORIFN,"COLLECT")
39 . S SCH=$$VALUE^ORX8(ORIFN,"SCHEDULE")
40 . S DUR=$$VALUE^ORX8(ORIFN,"DAYS")
41 Q:'$L($G(DATE)) Q:'$G(SCH) Q:"SPWC"[$G(TYPE) Q:'$L($G(DUR))
42 S VALIDT="" D GETIMES^ORCDLR1
43 D AM^ORCSAVE2:DATE="AM",NEXT^ORCSAVE2:DATE="NEXT" ; returns X
44 S %DT="T" S:'$D(X) X=DATE D ^%DT I Y<1 Q
45 D SCHEDULE(.ORSTRT,Y,SCH,DUR) Q:ORSTRT'>1 0 ; get all starts
46 K ORY S ORY=ORSTRT
47 S (ORI,ORN)=0 F S ORI=$O(ORSTRT(ORI)) Q:'ORI S OK="" D
48 . I TYPE="LC" S OK=$$LABCOLL^ORCDLR1(ORI)
49 . I TYPE="I" S OK=$$IMMCOLL^ORCDLR1(ORI)
50 . S ORN=ORN+1,ORY(ORN)=ORI_U_OK
51 Q
52 ;
53SCHEDULE(ORY,PSJSD,SCH,ORDUR) ; Returns list of start time(s) from schedule
54 ; PSJEEU - DBIA #2417
55 ; PSS51P1 - DBIA #4546
56 N I,X,ORSCH,PSJFD,PSJW,PSJNE,PSJPP,PSJX,PSJAT,PSJM,PSJTS,PSJY,PSJAX,PSJSCH,PSJOSD,PSJOFD,PSJC,NXT
57 Q:'$G(PSJSD) S ORY=1,ORY(PSJSD)="",SCH=$G(SCH) ;1st occurrance
58 S I="",X=SCH S:+SCH I=+SCH,X="" ;I=ien or X=name
59 D ZERO^PSS51P1(I,X,"LR",,"ORLR") S ORSCH=+$O(^TMP($J,"ORLR",0)) ;ien
60 S PSJX=$G(^TMP($J,"ORLR",ORSCH,.01))
61 S PSJW=+$G(ORL),PSJNE="",PSJPP="LR" D ENSV^PSJEEU Q:'$L($G(PSJX))
62 I $G(PSJTS)'="C",$G(PSJTS)'="D" Q ;not continuous or day-of-week
63 S PSJSCH=PSJX
64 S:ORDUR PSJFD=$$FMADD^XLFDT(PSJSD,+ORDUR,,-1)
65 I 'ORDUR S X=+$E(ORDUR,2,9) D
66 . I PSJM S PSJFD=$$FMADD^XLFDT(PSJSD,,,(PSJM*X)-1) ;X_#times
67 . E D ;no freq in minutes --> day of week
68 .. N DAYS,LOCMX,SCHMX
69 .. S LOCMX=$$GET^XPAR("ALL^LOC.`"_+$G(ORL),"LR MAX DAYS CONTINUOUS",1,"Q")
70 .. S SCHMX=$G(^TMP($J,"ORLR",ORSCH,2.5))
71 .. S DAYS=$S('SCHMX:LOCMX,LOCMX<SCHMX:LOCMX,1:SCHMX)
72 .. S PSJFD=$$FMADD^XLFDT(PSJSD,DAYS,,-1)
73 D ENSPU^PSJEEU K ORY
74 I ORDUR M ORY=PSJC Q
75 S ORY=$S(PSJC<$E(ORDUR,2,9):PSJC,1:$E(ORDUR,2,9))
76 S NXT=0 F I=1:1:ORY S NXT=$O(PSJC(NXT)) Q:'NXT S ORY(NXT)=PSJC(NXT)
77 Q
78 ;
79LC(IEN) ; -- Return 1 or 0, if order IEN is to Lab for LC or I
80 N Y,X0,PKG S Y=0
81 S X0=$G(^OR(100,+$G(IEN),0)),PKG=$$NMSP^ORCD(+$P(X0,U,14))
82 I PKG="LR" D
83 . N X S X=$$VALUE^ORX8(IEN,"COLLECT")
84 . I X="LC"!(X="I") S Y=1
85 Q Y
Note: See TracBrowser for help on using the repository browser.