| 1 | ORWDOR ; 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
|
|---|
| 3 | NXT() ; -- returns next available index in return data array
|
|---|
| 4 | S ILST=ILST+1
|
|---|
| 5 | Q ILST
|
|---|
| 6 | ;
|
|---|
| 7 | VMSLCT(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
|
|---|
| 12 | MEAS ; 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
|
|---|
| 18 | SCHED ; 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
|
|---|
| 23 | VALNUM(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
|
|---|
| 34 | LKSCRN(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
|
|---|
| 48 | MNUTREE(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
|
|---|
| 53 | LSTCHLD(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
|
|---|
