- ORDD1 ; slc/dcm - Calls from OE/RR DD ;8/20/92 12:13 ;
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- K11 ;;Set logic from field 1 file 101
- 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)=""
- S X=ORKX K ORKEY,ORKX
- Q
- K12 ;;Kill logic from field 1 file 101
- 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)
- S X=ORKX K ORKEY,ORKX
- Q
- K21 ;;Set logic from field 2 file 101
- 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))=""
- S X=ORKX K ORKEY,ORITN
- Q
- K22 ;;Kill logic from field 2 file 101
- 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))
- S X=ORKX K ORKEY,ORKX
- Q
- K31 ;;Set logic from field 3 file 101
- S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
- I ORKEY'="ORWARD" K ORKEY Q
- S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP S ^ORD(101,"K."_ORKEY,X,DA(1))=""
- 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))=""
- S X=ORKX K ORKEY,ORKX
- Q
- K32 ;;Kill logic from field 3 file 101
- S ORKEY=$S($D(^DIC(19.1,X,0)):^(0),1:"") I ORKEY="" K ORKEY Q
- I ORKEY'="ORWARD" K ORKEY Q
- S ORKX=X,X=$P(^ORD(101,DA(1),0),"^",2) I $L(X) D UP K ^ORD(101,"K."_ORKEY,X,DA(1))
- 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))
- S X=ORKX K ORKEY,ORKX
- Q
- UP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- Q
- F1 ;Set logic (NOT CURRENTLY IN USE)
- 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)=""
- K T Q
- F2 ;Kill logic
- 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)
- K T Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDD1 2185 printed Jan 18, 2025@03:30:56 Page 2
- ORDD1 ; slc/dcm - Calls from OE/RR DD ;8/20/92 12:13 ;
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- K11 ;;Set logic from field 1 file 101
- +1 SET I=0
- SET ORKX=X
- DO UP
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA,3,I))
- if I<1
- QUIT
- SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
- IF $LENGTH(ORKEY)
- IF ORKEY="ORWARD"
- SET ^ORD(101,"K."_ORKEY,X,DA)=""
- +2 SET X=ORKX
- KILL ORKEY,ORKX
- +3 QUIT
- K12 ;;Kill logic from field 1 file 101
- +1 SET I=0
- SET ORKX=X
- DO UP
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA,3,I))
- if I<1
- QUIT
- SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
- IF $LENGTH(ORKEY)
- IF ORKEY="ORWARD"
- KILL ^ORD(101,"K."_ORKEY,X,DA)
- +2 SET X=ORKX
- KILL ORKEY,ORKX
- +3 QUIT
- K21 ;;Set logic from field 2 file 101
- +1 SET I=0
- SET ORKX=X
- DO UP
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA(1),3,I))
- if I<1
- QUIT
- SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
- IF $LENGTH(ORKEY)
- IF ORKEY="ORWARD"
- SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
- +2 SET X=ORKX
- KILL ORKEY,ORITN
- +3 QUIT
- K22 ;;Kill logic from field 2 file 101
- +1 SET I=0
- SET ORKX=X
- DO UP
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA(1),3,I))
- if I<1
- QUIT
- SET ORKEY=$SELECT($DATA(^DIC(19.1,+^(I,0),0)):$PIECE(^(0),"^"),1:"")
- IF $LENGTH(ORKEY)
- IF ORKEY="ORWARD"
- KILL ^ORD(101,"K."_ORKEY,X,DA(1))
- +2 SET X=ORKX
- KILL ORKEY,ORKX
- +3 QUIT
- K31 ;;Set logic from field 3 file 101
- +1 SET ORKEY=$SELECT($DATA(^DIC(19.1,X,0)):^(0),1:"")
- IF ORKEY=""
- KILL ORKEY
- QUIT
- +2 IF ORKEY'="ORWARD"
- KILL ORKEY
- QUIT
- +3 SET ORKX=X
- SET X=$PIECE(^ORD(101,DA(1),0),"^",2)
- IF $LENGTH(X)
- DO UP
- SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
- +4 SET I=0
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA(1),2,I))
- if I<1
- QUIT
- SET X=$PIECE(^(I,0),"^")
- IF $LENGTH(X)
- DO UP
- SET ^ORD(101,"K."_ORKEY,X,DA(1))=""
- +5 SET X=ORKX
- KILL ORKEY,ORKX
- +6 QUIT
- K32 ;;Kill logic from field 3 file 101
- +1 SET ORKEY=$SELECT($DATA(^DIC(19.1,X,0)):^(0),1:"")
- IF ORKEY=""
- KILL ORKEY
- QUIT
- +2 IF ORKEY'="ORWARD"
- KILL ORKEY
- QUIT
- +3 SET ORKX=X
- SET X=$PIECE(^ORD(101,DA(1),0),"^",2)
- IF $LENGTH(X)
- DO UP
- KILL ^ORD(101,"K."_ORKEY,X,DA(1))
- +4 SET I=0
- FOR J=0:0
- SET I=$ORDER(^ORD(101,DA(1),2,I))
- if I<1
- QUIT
- SET X=$PIECE(^(I,0),"^")
- IF $LENGTH(X)
- DO UP
- KILL ^ORD(101,"K."_ORKEY,X,DA(1))
- +5 SET X=ORKX
- KILL ORKEY,ORKX
- +6 QUIT
- UP SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +1 QUIT
- F1 ;Set logic (NOT CURRENTLY IN USE)
- +1 IF $DATA(@("^"_$PIECE(X,";",2)_"0)"))
- SET ORF="F."_+$PIECE(^(0),"^",2)
- SET T=$PIECE(^ORD(101,DA,0),"^",2)
- IF $LENGTH(T)
- SET ^ORD(101,ORF,T,DA)=""
- +2 KILL T
- QUIT
- F2 ;Kill logic
- +1 IF $DATA(@("^"_$PIECE(X,";",2)_"0)"))
- SET ORF="F."_+$PIECE(^(0),"^",2)
- SET T=$PIECE(^ORD(101,DA,0),"^",2)
- IF $LENGTH(T)
- KILL ^ORD(101,ORF,T,DA)
- +2 KILL T
- QUIT