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
Q
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))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXSTOP 3096 printed Dec 13, 2024@01:53:59 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
