source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORDD1.m@ 1046

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

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1ORDD1 ; slc/dcm - Calls from OE/RR DD ;8/20/92 12:13 ;
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3K11 ;;Set logic from field 1 file 101
4 S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA,3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" S ^ORD(101,"K."_ORKEY,X,DA)=""
5 S X=ORKX K ORKEY,ORKX
6 Q
7K12 ;;Kill logic from field 1 file 101
8 S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA,3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" K ^ORD(101,"K."_ORKEY,X,DA)
9 S X=ORKX K ORKEY,ORKX
10 Q
11K21 ;;Set logic from field 2 file 101
12 S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA(1),3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" S ^ORD(101,"K."_ORKEY,X,DA(1))=""
13 S X=ORKX K ORKEY,ORITN
14 Q
15K22 ;;Kill logic from field 2 file 101
16 S I=0,ORKX=X D UP F J=0:0 S I=$O(^ORD(101,DA(1),3,I)) Q:I<1 S ORKEY=$S($D(^DIC(19.1,+^(I,0),0)):$P(^(0),"^"),1:"") I $L(ORKEY),ORKEY="ORWARD" K ^ORD(101,"K."_ORKEY,X,DA(1))
17 S X=ORKX K ORKEY,ORKX
18 Q
19K31 ;;Set logic from field 3 file 101
20 S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
21 I ORKEY'="ORWARD" K ORKEY Q
22 S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP S ^ORD(101,"K."_ORKEY,X,DA(1))=""
23 S I=0 F J=0:0 S I=$O(^ORD(101,DA(1),2,I)) Q:I<1 S X=$P(^(I,0),"^") I $L(X) D UP S ^ORD(101,"K."_ORKEY,X,DA(1))=""
24 S X=ORKX K ORKEY,ORKX
25 Q
26K32 ;;Kill logic from field 3 file 101
27 S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
28 I ORKEY'="ORWARD" K ORKEY Q
29 S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP K ^ORD(101,"K."_ORKEY,X,DA(1))
30 S I=0 F J=0:0 S I=$O(^ORD(101,DA(1),2,I)) Q:I<1 S X=$P(^(I,0),"^") I $L(X) D UP K ^ORD(101,"K."_ORKEY,X,DA(1))
31 S X=ORKX K ORKEY,ORKX
32 Q
33UP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
34 Q
35F1 ;Set logic (NOT CURRENTLY IN USE)
36 I $D(@("^"_$P(X,";",2)_"0)")) S ORF="F."_+$P(^(0),"^",2),T=$P(^ORD(101,DA,0),"^",2) I $L(T) S ^ORD(101,ORF,T,DA)=""
37 K T Q
38F2 ;Kill logic
39 I $D(@("^"_$P(X,";",2)_"0)")) S ORF="F."_+$P(^(0),"^",2),T=$P(^ORD(101,DA,0),"^",2) I $L(T) K ^ORD(101,ORF,T,DA)
40 K T Q
Note: See TracBrowser for help on using the repository browser.