- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDOR.m
r613 r623 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,243**;Dec 17, 1997;Build 242 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 X,I 20 K ^TMP($J,"ORWDGX APGMRV") 21 D AP^PSS51P1("GMRV",,,,"ORWDGX APGMRV") 22 S X="" F S X=$O(^TMP($J,"ORWDGX APGMRV","APGMRV",X)) Q:X="" D 23 . S I=$O(^TMP($J,"ORWDGX APGMRV","APGMRV",X,0)),LST($$NXT)="i"_I_U_X 24 K ^TMP($J,"ORWDGX APGMRV") 25 Q 26 VALNUM(ERR,X,DOM) ; return error if invalid number 27 N LOW,HIGH,DEC 28 S LOW=$P(DOM,":"),HIGH=$P(DOM,":",2),DEC=$P(DOM,":",3),ERR=0 29 I $L($P(X,"."))>24 S ERR="1^Exceeded maximum number of 24 characters" Q 30 I X'?.1"-".N.1".".N S ERR="1^Entry must be numeric" Q 31 I X>HIGH!(X<LOW) S ERR="1^Out of Range - value must be between "_LOW_" and "_HIGH_" inclusive" Q 32 I $L($P(+X,".",2))>DEC D 33 . I DEC=0 S ERR="1^No decimal places allowed" 34 . E I DEC=1 S ERR="1^Only one decimal place allowed" 35 . E S ERR="1^No more than "_DEC_" decimal places allowed" 36 Q 37 LKSCRN(ORLST,FROM,DIR,REF,GBL,SCR) ; Return a set of entries from xref in REF 38 ; .Y=returned list, FROM=text to $O from, DIR=$O direction, 39 ; REF=subscript indirection global ref including xref, 40 ; GBL=standard FM global ref, SCR=reference to screen in 101.41 41 N I,IEN,CNT,X,Y,D,ORTYPE 42 S I=0,CNT=44,SCR=$G(SCR) 43 I $L(SCR) S SCR=$G(^ORD(101.41,+SCR,10,+$P(SCR,":",2),4)) 44 S D=$P(REF,"""",2),ORTYPE="D" ;for OI screen 45 F Q:I'<CNT S FROM=$O(@REF@(FROM),DIR) Q:FROM="" D 46 . S IEN=0 F S IEN=$O(@REF@(FROM,IEN)) Q:'IEN D 47 . . ; if screen, set naked ref & Y, then execute screen 48 . . I $L(SCR) S Y=IEN,X=$P($G(@(GBL_"Y,0)")),U) X SCR Q:'$T 49 . . S I=I+1,ORLST(I)=IEN_"^"_FROM 50 Q 51 MNUTREE(LST,ROOT) ; return menu tree for a menu type dialog 52 N ILST S ILST=0 53 S ILST=ILST+1,LST(ILST)=ROOT_U_$P(^ORD(101.41,ROOT,0),U,2)_"^0^+" 54 D LSTCHLD(ROOT) 55 Q 56 LSTCHLD(PARENT) ; list descendends of this node (recursive) 57 N CHILD,I,J 58 S I=0 F S I=$O(^ORD(101.41,PARENT,10,"B",I)) Q:'I D 59 . S J=0 F S J=$O(^ORD(101.41,PARENT,10,"B",I,J)) Q:'J D 60 . . S CHILD=+$P(^ORD(101.41,PARENT,10,J,0),U,2) Q:'CHILD 61 . . ; also quit if child is not a generic order 62 . . S ILST=ILST+1,LST(ILST)=CHILD_U_$P(^ORD(101.41,CHILD,0),U,2)_U_PARENT 63 . . I $P(^ORD(101.41,CHILD,0),U,4)="M",$D(^ORD(101.41,CHILD,10))>1 D 64 . . . S LST(ILST)=LST(ILST)_"^+" 65 . . . D LSTCHLD(CHILD) 66 Q 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
Note:
See TracChangeset
for help on using the changeset viewer.
