ADEGRL5C.m

ADEGRL5C ; IHS/HQT/MJL - CODE EDIT FUNCTIONS ;08:01 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 ;

GETSFC(ADEOPC,ADEVCOD) ;EP - Returns SURFACE for ADEOPC in ADEVCOD

 N ADEOP,ADESFC,ADEK

 S ADEOP=$P(ADEVCOD,U,2),ADESFC=$P(ADEVCOD,U,4)

 F ADEK=1:1:$P(ADEVCOD,U) I $P(ADEOP,",",ADEK)=ADEOPC S ADESFC=$P(ADESFC,",",ADEK) Q

 Q ADESFC

 K ADEOPC ;*NE

 ;

DUPE(ADEOP) ;EP - Returns 1 if ADEOP contains duplicate opsite, otw 0

 ;Changed to return dupe opsite number.

 N ADEPC,ADECNT,ADEJ,ADEK

 I ADEOP'["," Q 0

 F ADEK=1:1:$L(ADEOP,",") S ADEPC=$P(ADEOP,",",ADEK) S ADECNT=0 D  I ADECNT Q

 . F ADEJ=ADEK+1:1:$L(ADEOP,",") S:ADEPC=$P(ADEOP,",",ADEJ) ADECNT=ADEPC

 Q ADECNT

 ;

DELOP(ADEDEL,ADEVCOD) ;EP - Deletes opsite ADEDEL from ADEV(ADECOD)

 ;Make sure ADEVCOD has 2 or more opsites when calling this function!

 N ADETST,ADECNT,ADEJ,ADEFIX,ADESFC,ADEFIX2,ADEFIX3,ADENONR

 I +ADEVCOD<2 S ADEVCOD="" Q ADEVCOD

 S ADETST=$P(ADEVCOD,U,2),ADESFC=$P(ADEVCOD,U,4),ADENONR=$P(ADEVCOD,U,5)

 S ADECNT=0 F ADEJ=1:1:$L(ADETST,",") I $P(ADETST,",",ADEJ)'=ADEDEL S ADECNT=ADECNT+1,$P(ADEFIX,",",ADECNT)=$P(ADETST,",",ADEJ),$P(ADEFIX2,",",ADECNT)=$P(ADESFC,",",ADEJ),$P(ADEFIX3,",",ADECNT)=$P(ADENONR,",",ADEJ)

 S $P(ADEVCOD,U)=$L(ADEFIX,","),$P(ADEVCOD,U,2)=ADEFIX,$P(ADEVCOD,U,4)=ADEFIX2,$P(ADEVCOD,U,5)=ADEFIX3

 Q ADEVCOD

 K ADEFIX,ADEFIX2,ADEFIX3,ADENONR ;*NE

ADEGRL5C  ; IHS/HQT/MJL - CODE EDIT FUNCTIONS ;08:01 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2       ;

GETSFC(ADEOPC,ADEVCOD) ;EP - Returns SURFACE for ADEOPC in ADEVCOD

 +1        NEW ADEOP,ADESFC,ADEK

 +2        SET ADEOP=$PIECE(ADEVCOD,U,2)

           SET ADESFC=$PIECE(ADEVCOD,U,4)

 +3        FOR ADEK=1:1:$PIECE(ADEVCOD,U)

               IF $PIECE(ADEOP,",",ADEK)=ADEOPC

                   SET ADESFC=$PIECE(ADESFC,",",ADEK)

                   QUIT 

 +4        QUIT ADESFC

 +5       ;*NE

           KILL ADEOPC

 +6       ;

DUPE(ADEOP) ;EP - Returns 1 if ADEOP contains duplicate opsite, otw 0

 +1       ;Changed to return dupe opsite number.

 +2        NEW ADEPC,ADECNT,ADEJ,ADEK

 +3        IF ADEOP'[","

               QUIT 0

 +4        FOR ADEK=1:1:$LENGTH(ADEOP,",")

               SET ADEPC=$PIECE(ADEOP,",",ADEK)

               SET ADECNT=0

               Begin DoDot:1

 +5                FOR ADEJ=ADEK+1:1:$LENGTH(ADEOP,",")

                       IF ADEPC=$PIECE(ADEOP,",",ADEJ)

                           SET ADECNT=ADEPC

               End DoDot:1

               IF ADECNT

                   QUIT 

 +6        QUIT ADECNT

 +7       ;

DELOP(ADEDEL,ADEVCOD) ;EP - Deletes opsite ADEDEL from ADEV(ADECOD)

 +1       ;Make sure ADEVCOD has 2 or more opsites when calling this function!

 +2        NEW ADETST,ADECNT,ADEJ,ADEFIX,ADESFC,ADEFIX2,ADEFIX3,ADENONR

 +3        IF +ADEVCOD<2

               SET ADEVCOD=""

               QUIT ADEVCOD

 +4        SET ADETST=$PIECE(ADEVCOD,U,2)

           SET ADESFC=$PIECE(ADEVCOD,U,4)

           SET ADENONR=$PIECE(ADEVCOD,U,5)

 +5        SET ADECNT=0

           FOR ADEJ=1:1:$LENGTH(ADETST,",")

               IF $PIECE(ADETST,",",ADEJ)'=ADEDEL

                   SET ADECNT=ADECNT+1

                   SET $PIECE(ADEFIX,",",ADECNT)=$PIECE(ADETST,",",ADEJ)

                   SET $PIECE(ADEFIX2,",",ADECNT)=$PIECE(ADESFC,",",ADEJ)

                   SET $PIECE(ADEFIX3,",",ADECNT)=$PIECE(ADENONR,",",ADEJ)

 +6        SET $PIECE(ADEVCOD,U)=$LENGTH(ADEFIX,",")

           SET $PIECE(ADEVCOD,U,2)=ADEFIX

           SET $PIECE(ADEVCOD,U,4)=ADEFIX2

           SET $PIECE(ADEVCOD,U,5)=ADEFIX3

 +7        QUIT ADEVCOD

 +8       ;*NE

           KILL ADEFIX,ADEFIX2,ADEFIX3,ADENONR