source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDOR.m@ 1801

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

revised back to 6/30/08 version

File size: 2.6 KB
RevLine 
[623]1ORWDOR ; SLC/KCM - Generic Orders calls for Windows Dialogs [ 08/05/96 8:21 AM ];03:50 PM 17 Jun 1998
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,164,253**;Dec 17, 1997
3NXT() ; -- returns next available index in return data array
4 S ILST=ILST+1
5 Q ILST
6 ;
7VMSLCT(LST) ; return default lists for vitals dialog
8 N ILST S ILST=0
9 S LST($$NXT)="~Measurements" D MEAS
10 S LST($$NXT)="~Schedules" D SCHED
11 Q
12MEAS ; called from VMSLCT
13 N I,X
14 S X="" F S X=$O(^ORD(101.43,"S.V/M",X)) Q:X="" D
15 . S I=$O(^ORD(101.43,"S.V/M",X,0))
16 . S LST($$NXT)="i"_I_U_$P(^ORD(101.43,"S.V/M",X,I),U,2)
17 Q
18SCHED ; called from VMSLCT
19 N I,X
20 S X="" F S X=$O(^PS(51.1,"APGMRV",X)) Q:X="" D
21 . S I=$O(^PS(51.1,"APGMRV",X,0)),LST($$NXT)="i"_I_U_X
22 Q
23VALNUM(ERR,X,DOM) ; return error if invalid number
24 N LOW,HIGH,DEC
25 S LOW=$P(DOM,":"),HIGH=$P(DOM,":",2),DEC=$P(DOM,":",3),ERR=0
26 I $L($P(X,"."))>24 S ERR="1^Exceeded maximum number of 24 characters" Q
27 I X'?.1"-".N.1".".N S ERR="1^Entry must be numeric" Q
28 I X>HIGH!(X<LOW) S ERR="1^Out of Range - value must be between "_LOW_" and "_HIGH_" inclusive" Q
29 I $L($P(+X,".",2))>DEC D
30 . I DEC=0 S ERR="1^No decimal places allowed"
31 . E I DEC=1 S ERR="1^Only one decimal place allowed"
32 . E S ERR="1^No more than "_DEC_" decimal places allowed"
33 Q
34LKSCRN(ORLST,FROM,DIR,REF,GBL,SCR) ; Return a set of entries from xref in REF
35 ; .Y=returned list, FROM=text to $O from, DIR=$O direction,
36 ; REF=subscript indirection global ref including xref,
37 ; GBL=standard FM global ref, SCR=reference to screen in 101.41
38 N I,IEN,CNT,X,Y,D,ORTYPE
39 S I=0,CNT=44,SCR=$G(SCR)
40 I $L(SCR) S SCR=$G(^ORD(101.41,+SCR,10,+$P(SCR,":",2),4))
41 S D=$P(REF,"""",2),ORTYPE="D" ;for OI screen
42 F Q:I'<CNT S FROM=$O(@REF@(FROM),DIR) Q:FROM="" D
43 . S IEN=0 F S IEN=$O(@REF@(FROM,IEN)) Q:'IEN D
44 . . ; if screen, set naked ref & Y, then execute screen
45 . . I $L(SCR) S Y=IEN,X=$P($G(@(GBL_"Y,0)")),U) X SCR Q:'$T
46 . . S I=I+1,ORLST(I)=IEN_"^"_FROM
47 Q
48MNUTREE(LST,ROOT) ; return menu tree for a menu type dialog
49 N ILST S ILST=0
50 S ILST=ILST+1,LST(ILST)=ROOT_U_$P(^ORD(101.41,ROOT,0),U,2)_"^0^+"
51 D LSTCHLD(ROOT)
52 Q
53LSTCHLD(PARENT) ; list descendends of this node (recursive)
54 N CHILD,I,J
55 S I=0 F S I=$O(^ORD(101.41,PARENT,10,"B",I)) Q:'I D
56 . S J=0 F S J=$O(^ORD(101.41,PARENT,10,"B",I,J)) Q:'J D
57 . . S CHILD=+$P(^ORD(101.41,PARENT,10,J,0),U,2) Q:'CHILD
58 . . ; also quit if child is not a generic order
59 . . S ILST=ILST+1,LST(ILST)=CHILD_U_$P(^ORD(101.41,CHILD,0),U,2)_U_PARENT
60 . . I $P(^ORD(101.41,CHILD,0),U,4)="M",$D(^ORD(101.41,CHILD,10))>1 D
61 . . . S LST(ILST)=LST(ILST)_"^+"
62 . . . D LSTCHLD(CHILD)
63 Q
Note: See TracBrowser for help on using the repository browser.