Routine: ECXSTOP

ECXSTOP ;ALB/DHE Stop Codes/Clinic Stops ;6/8/18  09:25

 ;;3.0;DSS EXTRACTS;**120,126,144,149,170**;Dec 22, 1997;Build 12

STOP(CODE,TYPE,CLIEN,DATE,IEN) ;api to return stop code information

 ;input:

 ;   code: stop code IEN in #40.7

 ;   type: type REQUIRED (Stop Code, DSS Stop Code, Credit Stop Code, DSS Credit Stop Code)

 ;  clien: clinic IEN in #728.44 (optional)

 ;   date: date of action (default today) (optional)

 ;    ien: ien from edit so lookup won't happen

 ;ecxerr(err) and warning(wrn) are existing arrays

 ;make sure they exist!

 N XCODE,INACT,RTYPE

 Q:'CODE

 Q:(TYPE="")

 S CLIEN=$G(CLIEN)

 I $G(DATE)="" S DATE=DT

 S ERR=$G(ERR)+1,WRN=$G(WRN)+1

 K:ERR=1 ECXERR K:WRN=1 WARNING

 I TYPE="CHAR4 Code" D  Q  ;149 CVW

 . I (CODE'="")&($$GET1^DIQ(728.441,CODE,3)'="") S ECXERR(ERR)=$$GET1^DIQ(728.441,CODE,.01)_" "_TYPE_" is inactive, please change to an active code." S ERR=ERR+1 ;144 CVW

 . I (CODE'="")&($$GET1^DIQ(728.441,CODE,.01)="") S ECXERR(ERR)=CODE_" "_TYPE_" is invalid, please change to a legal value." S ERR=ERR+1 ;144 CVW

 D:$G(IEN)="" FINDCOD I +IEN'>0 S ECXERR(ERR)=CODE_" is Invalid for "_TYPE S ERR=ERR+1 Q

 I '$D(^DIC(40.7,IEN,0)) S ECXERR(ERR)=CODE_" is Invalid for "_TYPE S ERR=ERR+1 Q

 I (+CODE'=CODE),($L(CODE)>3) S ECXERR(ERR)=CODE_" is an Invalid "_TYPE S ERR=ERR+1 Q

 S INACT=$P(^DIC(40.7,IEN,0),"^",3) I INACT,((DATE>INACT)!(DATE=INACT)) S ECXERR(ERR)=CODE_" is an Inactive "_TYPE S ERR=ERR+1

 S RTYPE=$P(^DIC(40.7,IEN,0),"^",6)

 I (TYPE="Stop Code"),(RTYPE'=("P"))&(RTYPE'=("E")) S ECXERR(ERR)=CODE_" This stop code can only be used in the secondary position." S ERR=ERR+1

 I TYPE="DSS Stop Code",(RTYPE'=("P"))&(RTYPE'=("E")) S ECXERR(ERR)=CODE_" This stop code can only be used in the secondary position." S ERR=ERR+1

 I TYPE="Credit Stop Code",(RTYPE'=("S"))&(RTYPE'=("E")) S ECXERR(ERR)=CODE_" This stop code can only be used in the primary position." S ERR=ERR+1

 I TYPE="DSS Credit Stop Code",(RTYPE'=("S"))&(RTYPE'=("E")) S ECXERR(ERR)=CODE_" This stop code can only be used in the primary position." S ERR=ERR+1

 ;I ($P(^DIC(40.7,IEN,0),"^",7)>DT) S WARNING(WRN)=CODE_" This "_TYPE_" has a Restriction Date in the future." S WRN=WRN+1

 I (TYPE="Stop Code"),$G(CLIEN),(CODE=$P(^ECX(728.44,CLIEN,0),"^",3)) S ECXERR(ERR)=CODE_" "_TYPE_" should not match Credit Stop Code." S ERR=ERR+1

 I (TYPE="DSS Stop Code"),$G(CLIEN),(CODE=$P(^ECX(728.44,CLIEN,0),"^",5)) S ECXERR(ERR)=CODE_" "_TYPE_" should not match DSS Credit Stop Code." S ERR=ERR+1

 ;WARNING  ; check for inactivations in future

 I INACT>DT S WARNING(WRN)=CODE_" This "_TYPE_" has a pending Inactive Date." S WRN=WRN+1

FINDCOD ;find active code if one

 N ARRY,I,FLG,INACT

 S IEN=$O(^DIC(40.7,"C",CODE,0))

 I $O(^DIC(40.7,"C",CODE,IEN))'>0 Q

 ;must be some duplicates so find the best one

 S I=""

 F  S I=$O(^DIC(40.7,"C",CODE,I)) Q:'I  D

 . Q:'$D(^DIC(40.7,I,0))

 . S INACT=$P(^DIC(40.7,I,0),"^",3),FLG="A" D

 . . I INACT,((DATE>INACT)!(DATE=INACT)) S FLG="I"

 . S ARRY(FLG,I)=""

 I $D(ARRY("A")) S IEN=$O(ARRY("A",0))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSTOP   3096     printed  Feb 18, 2025@23:20:23                                                                                                                                                                                                     Page 2

ECXSTOP   ;ALB/DHE Stop Codes/Clinic Stops ;6/8/18  09:25

 +1       ;;3.0;DSS EXTRACTS;**120,126,144,149,170**;Dec 22, 1997;Build 12

 +2       ;

STOP(CODE,TYPE,CLIEN,DATE,IEN) ;api to return stop code information

 +1       ;

 +2       ;input:

 +3       ;   code: stop code IEN in #40.7

 +4       ;   type: type REQUIRED (Stop Code, DSS Stop Code, Credit Stop Code, DSS Credit Stop Code)

 +5       ;  clien: clinic IEN in #728.44 (optional)

 +6       ;   date: date of action (default today) (optional)

 +7       ;    ien: ien from edit so lookup won't happen

 +8       ;

 +9       ;ecxerr(err) and warning(wrn) are existing arrays

 +10      ;make sure they exist!

 +11      ;

 +12       NEW XCODE,INACT,RTYPE

 +13       if 'CODE

               QUIT

 +14       if (TYPE="")

               QUIT

 +15       SET CLIEN=$GET(CLIEN)

 +16       IF $GET(DATE)=""

               SET DATE=DT

 +17       SET ERR=$GET(ERR)+1

           SET WRN=$GET(WRN)+1

 +18       if ERR=1

               KILL ECXERR

           if WRN=1

               KILL WARNING

 +19      ;149 CVW

           IF TYPE="CHAR4 Code"

               Begin DoDot:1

 +20      ;144 CVW

                   IF (CODE'="")&($$GET1^DIQ(728.441,CODE,3)'="")

                       SET ECXERR(ERR)=$$GET1^DIQ(728.441,CODE,.01)_" "_TYPE_" is inactive, please change to an active code."

                       SET ERR=ERR+1

 +21      ;144 CVW

                   IF (CODE'="")&($$GET1^DIQ(728.441,CODE,.01)="")

                       SET ECXERR(ERR)=CODE_" "_TYPE_" is invalid, please change to a legal value."

                       SET ERR=ERR+1

               End DoDot:1

               QUIT

 +22       if $GET(IEN)=""

               DO FINDCOD

           IF +IEN'>0

               SET ECXERR(ERR)=CODE_" is Invalid for "_TYPE

               SET ERR=ERR+1

               QUIT

 +23       IF '$DATA(^DIC(40.7,IEN,0))

               SET ECXERR(ERR)=CODE_" is Invalid for "_TYPE

               SET ERR=ERR+1

               QUIT

 +24       IF (+CODE'=CODE)

               IF ($LENGTH(CODE)>3)

                   SET ECXERR(ERR)=CODE_" is an Invalid "_TYPE

                   SET ERR=ERR+1

                   QUIT

 +25       SET INACT=$PIECE(^DIC(40.7,IEN,0),"^",3)

           IF INACT

               IF ((DATE>INACT)!(DATE=INACT))

                   SET ECXERR(ERR)=CODE_" is an Inactive "_TYPE

                   SET ERR=ERR+1

 +26       SET RTYPE=$PIECE(^DIC(40.7,IEN,0),"^",6)

 +27       IF (TYPE="Stop Code")

               IF (RTYPE'=("P"))&(RTYPE'=("E"))

                   SET ECXERR(ERR)=CODE_" This stop code can only be used in the secondary position."

                   SET ERR=ERR+1

 +28       IF TYPE="DSS Stop Code"

               IF (RTYPE'=("P"))&(RTYPE'=("E"))

                   SET ECXERR(ERR)=CODE_" This stop code can only be used in the secondary position."

                   SET ERR=ERR+1

 +29       IF TYPE="Credit Stop Code"

               IF (RTYPE'=("S"))&(RTYPE'=("E"))

                   SET ECXERR(ERR)=CODE_" This stop code can only be used in the primary position."

                   SET ERR=ERR+1

 +30       IF TYPE="DSS Credit Stop Code"

               IF (RTYPE'=("S"))&(RTYPE'=("E"))

                   SET ECXERR(ERR)=CODE_" This stop code can only be used in the primary position."

                   SET ERR=ERR+1

 +31      ;I ($P(^DIC(40.7,IEN,0),"^",7)>DT) S WARNING(WRN)=CODE_" This "_TYPE_" has a Restriction Date in the future." S WRN=WRN+1

 +32       IF (TYPE="Stop Code")

               IF $GET(CLIEN)

                   IF (CODE=$PIECE(^ECX(728.44,CLIEN,0),"^",3))

                       SET ECXERR(ERR)=CODE_" "_TYPE_" should not match Credit Stop Code."

                       SET ERR=ERR+1

 +33       IF (TYPE="DSS Stop Code")

               IF $GET(CLIEN)

                   IF (CODE=$PIECE(^ECX(728.44,CLIEN,0),"^",5))

                       SET ECXERR(ERR)=CODE_" "_TYPE_" should not match DSS Credit Stop Code."

                       SET ERR=ERR+1

 +34      ;WARNING  ; check for inactivations in future

 +35       IF INACT>DT

               SET WARNING(WRN)=CODE_" This "_TYPE_" has a pending Inactive Date."

               SET WRN=WRN+1

 +36       QUIT

FINDCOD   ;find active code if one

 +1        NEW ARRY,I,FLG,INACT

 +2        SET IEN=$ORDER(^DIC(40.7,"C",CODE,0))

 +3        IF $ORDER(^DIC(40.7,"C",CODE,IEN))'>0

               QUIT

 +4       ;must be some duplicates so find the best one

 +5        SET I=""

 +6        FOR

               SET I=$ORDER(^DIC(40.7,"C",CODE,I))

               if 'I

                   QUIT

               Begin DoDot:1

 +7                if '$DATA(^DIC(40.7,I,0))

                       QUIT

 +8                SET INACT=$PIECE(^DIC(40.7,I,0),"^",3)

                   SET FLG="A"

                   Begin DoDot:2

 +9                    IF INACT

                           IF ((DATE>INACT)!(DATE=INACT))

                               SET FLG="I"

                   End DoDot:2

 +10               SET ARRY(FLG,I)=""

               End DoDot:1

 +11       IF $DATA(ARRY("A"))

               SET IEN=$ORDER(ARRY("A",0))

 +12       QUIT

ECXSTOP.m