source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORVOM0.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1ORVOM0 ; slc/dcm - Gathers parts to send ;1/23/91 06:47 ;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 S DIT=0,DL=DRN,DRN=1001,DHS=DH,DSEC=0
4S ;
5 K ^UTILITY("DI",$J)
6I ;
7M S DIRS="K ^UTILITY(U,$J),^UTILITY(""DIK"",$J) "
8 W !,"MAXIMUM ROUTINE SIZE(BYTES): ",^DD("ROU"),"// "
9 R %:$S($D(DTIME):DTIME,1:60) E S DTOUT=1 G Q
10 S DIFRM=^DD("ROU")
11 I %]"" G Q:%[U S DIFRM=% I %\1'=%!(%<2000)!(%>9999) D M^ORVOMH G M
12GO W !,"...OK, this may take a while, hold on please..."
13 S Y=101,Y(101)="",X="PRO" D ADD
14 K %,%1,%2,%3,Y,CTR,TOP G ^ORVOM1
15 ;
16ADD ;
17 Q:$D(^DIC(Y,0))[0!$D(DTL(Y)) Q:$P(^(0),X,1)]""!'$D(^(0,"GL")) S Y=^("GL")
18 I $L(DH) D:$O(@(Y_"""B"",DH,0)")) A F S DH=$O(@(Y_"""B"",DH)")) Q:DH=""!($E(DH,1,$L(DHS))'=DHS)!($E(DH,($L(DHS)+1))="Z") D A
19 S II=0 F S II=$O(^ORD(100.99,1,5,DPK,1,II)) Q:II<1 S D=+^(II,0) D:'$D(^UTILITY(U,$J,X,D)) A1 S III=0 F S III=$O(^ORD(100.99,1,5,DPK,1,II,1,III)) Q:III<1 S MEN=^(III,0) D MEN
20 S DH=DHS
21 Q
22A ;
23 S D=$O(@(Y_"""B"",DH,0)"))
24A1 S %X=Y_"D,",%Y="^UTILITY(U,$J,X,D,"
25 S Q(X)=0 D %XY^%RCR
26 S %=^UTILITY(U,$J,X,D,0),%1=+$P(%,U,12),%1=$S($D(^DIC(9.4,%1,0)):$P(^(0),U),1:""),$P(%,U,12)=%1,$P(%,U,5)=""
27 S ^UTILITY(U,$J,X,D,0)=% I $D(^(10,0)) S CTR=$P(^(0),"^",4),TOP=$P(^(0),"^",3) K ^("B"),^("C")
28 I $D(^UTILITY(U,$J,X,D,5)) S %=$P(^(5),"^"),%1=$P(%,";",2) I %,$D(@("^"_%1_+%_",0)")) S %=$P(^(0),"^"),$P(^UTILITY(U,$J,X,D,5),"^")=%_";"_%1
29 S %=0 F S %=$O(^ORD(101,D,10,%)) Q:'% I $D(^(%,0)) S %2=^(0) I $D(^ORD(101,+%2,0)) S %3=$P(^(0),"^"),%1=$E(%3,1,$L(DHS)) D A2
30 I $D(^UTILITY(U,$J,X,D,10,0)) S $P(^(0),"^",3,4)=CTR_"^"_TOP
31 I $D(^UTILITY(U,$J,X,D,3,0)) K ^("B") S I=0 F S I=$O(^UTILITY(U,$J,X,D,3,I)) Q:I<1 S KEY=^(I,0) K ^(0) I $D(^DIC(19.1,+KEY,0)) S KEY=$P(^(0),"^"),^UTILITY(U,$J,X,D,3,I,0)=KEY
32 Q
33 ;
34Q ;
35 K ^UTILITY($J),^(U,$J),DH,DHS,EH,ORVROM,DR,DD,DLAYGO,DIRS,DIMA,DMAX,DWLW,DREF,D1
36 K DIX,DIY,DO,DZ,DIK,DIFQ,DDF,DDT,NO,DIF,DIG,DIH,DIU,DIV,DIW
37 K %A,%B,%C,%V,%X,%Y,%Z,NM,DG,D0,DA,DIFRM,DL,D,E,F,R,III,KEY,TXT,DIC,DIE,DN,DPK,DQ,DRN
38 K DIFQR,DNAME,DSEC,DTL,DIFC,Q,DIDIU,DIFKEP,DIT,DILN2 Q
39 ;
40MEN ;add to menu
41 Q:'$D(^ORD(101,+MEN,0)) S OMEN=$P(^(0),"^"),IT=$O(^ORD(101,+MEN,10,"B",D,0)) Q:$D(^UTILITY(U,$J,X,D,"MEN",OMEN)) S ^UTILITY(U,$J,X,D,"MEN",OMEN)=$S(IT:^ORD(101,+MEN,10,IT,0),1:D)
42 I IT,$P(^ORD(101,+MEN,10,IT,0),"^",4) S X0=$P(^(0),"^",4),$P(^(0),"^",4)="" I $D(^ORD(101,X0,0)) S $P(^UTILITY(U,$J,X,D,"MEN",OMEN),"^",4)=$P(^(0),"^")
43 W !,"Sending "_$P(^ORD(101,D,0),"^")_" to go on "_$P(^ORD(101,+MEN,0),"^")_" menu."
44 Q
45A2 I %1'=DHS,%3'?1"ORB".E K ^UTILITY(U,$J,X,D,10,%) S CTR=CTR-1,TOP=% Q
46 S ^UTILITY(U,$J,X,D,10,%,U)=%3
47 I $P(%2,"^",4),$D(^ORD(101,$P(%2,"^",4),0)) S $P(^UTILITY(U,$J,X,D,10,%,0),"^",4)=$P(^(0),"^")
48 Q
Note: See TracBrowser for help on using the repository browser.