BGOCPTPR ; IHS/BAO/TMD - CPT PREFERENCES MANAGER ;13-Jul-2015 09:16;MGH
;;1.1;BGO COMPONENTS;**1,3,5,14,15**;Mar 20, 2007
; Validates a CPT code
VALIDATE(RET,IEN,CODE) ;EP
I 'IEN,$G(CODE)'="" D
.N X
.S IEN=-1,RET=""
.F X=0:0 S X=$O(^ICPT("B",CODE,X)) Q:'X D Q:RET'<0
..S IEN=X
..S RET=$$CHKCPT^BGOVCPT(IEN)
.S:IEN<0 RET=$$ERR^BGOUTL(1020,CODE)
E I 'IEN S RET=$$ERR^BGOUTL(1021)
E S RET=$$CHKCPT^BGOVCPT(IEN)
S:RET'<0 RET=""
Q
; Return long name of CPT
; IEN = CPT IEN
GETLNAME(RET,IEN) ;EP
N I,X
I 'IEN S RET=$$ERR^BGOUTL(1021) Q
S X=0,RET=""
F I=1:1 S X=$O(^ICPT(IEN,"D",X)) Q:'X S RET=RET_$S($L(RET):" ",1:"")_$G(^(X,0))
Q
; Return categories matching specified criteria
; INP = Category IEN [1] ^ Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5] ^ Historical Flag [6]
; where Historical Flag is (0=Non-historical only, 1=Historical only, 2=Both)
GETCATS(RET,INP) ;EP
D GETCATS^BGOPFUTL(.RET,INP,90362.31)
Q
; Returns list of CPTs for specified category
; INP = Category IEN [1] ^ Group [2] ^ Visit IEN [3] ^ Display Freq Order [4]
; Returned as a list of records in the format
; CPT IEN [1] ^ CPT Code [2] ^ CPT Text [3] ^ Short Text [4] ^ Freq [5] ^
; VCPT IEN [6] ^ Fee [7] ^ Rank [8] ^ Pref IEN [9] ^ Association [10] ^
; Long Text [11]
GETITEMS(RET,INP) ;EP
N PX,I,J,FREQ,VIEN,LONG,GRP,CAT,VPX,FREQ,CNT,RANK,IEN,SCHED
S RET=$$TMPGBL^BGOUTL
S CAT=+INP
I 'CAT S @RET@(1)=$$ERR^BGOUTL(1018) Q
I '$D(^BGOCPTPR(CAT,0)) S @RET@(1)=$$ERR^BGOUTL(1019) Q
S GRP=$P(INP,U,2)
S VIEN=$P(INP,U,3)
S FREQ=$P(INP,U,4)
S:$P(^BGOCPTPR(CAT,0),U,6) GRP=""
I VIEN D
.S VPX=0
.F S VPX=$O(^AUPNVCPT("AD",VIEN,VPX)) Q:'VPX D
..S I=$G(^AUPNVCPT(VPX,0))
..;IHS/MSC/MGH changed p15 because of items with no display text
..;S:$L(I) VPX(+I,+$P(I,U,4))=VPX
..S:$L(I) VPX(+I)=VPX
S (CNT,RANK)=0
S I=$P($G(^AUPNVSIT(+VIEN,0)),U,6)
S:'I I=+$G(DUZ(2))
S SCHED=+$P($G(^ABMDPARM(DUZ(2),I,0)),U,9)
I FREQ D
.S J=""
.F S J=$O(^BGOCPTPR(CAT,1,"AC",J),-1) Q:J="" D
..S IEN=0
..F S IEN=$O(^BGOCPTPR(CAT,1,"AC",J,IEN)) Q:'IEN D GP1
E D
.S IEN=0
.F S IEN=$O(^BGOCPTPR(CAT,1,IEN)) Q:'IEN D GP1
Q
GP1 N N0,CPTIEN,TXT,CPT,PX,FEE,ADA,FREQVAL,ASSOC
S N0=$G(^BGOCPTPR(CAT,1,IEN,0))
S CPTIEN=+N0
Q:'CPTIEN
Q:'$D(^ICPT(CPTIEN,0))
S CPT=$P(^ICPT(CPTIEN,0),U),PX=$P(^(0),U,2)
S (FEE,TXT,LONG)=""
D GETLNAME(.LONG,CPTIEN)
I CPT>9999,CPT<70000 S FEE=$P($G(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
I CPT?1A4N S FEE=$P($G(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
I CPT>69999,CPT<80000 S FEE=$P($G(^ABMDFEE(SCHED,15,CPTIEN,0)),U,2)
I CPT>79999,CPT<90000 S FEE=$P($G(^ABMDFEE(SCHED,17,CPTIEN,0)),U,2)
I CPT>89999,CPT<100000 S FEE=$P($G(^ABMDFEE(SCHED,19,CPTIEN,0)),U,2)
I $E(CPT)="D" S ADA=$O(^AUTTADA("B",$E(CPT,2,5),0)) Q:'ADA D
.S FEE=$O(^ABMDFEE(SCHED,21,"B",ADA,0))
.S FEE=$P($G(^ABMDFEE(SCHED,21,+FEE,0)),U,2)
.S PX=$P($G(^AUTTADA(ADA,0)),U,2)
S TXT=$P(N0,U,2),TXT(0)=+$$FNDNARR^BGOUTL2(TXT,0)
S FREQVAL=$P(N0,U,3)
S ASSOC=''$O(^BGOCPTPR(CAT,1,IEN,1,1))
S:FREQ RANK=RANK+1
S CNT=CNT+1
S @RET@(CNT)=CPTIEN_U_CPT_U_PX_U_TXT_U_FREQVAL_U_$G(VPX(CPTIEN))_U_FEE_U_$TR($J(RANK,4,0)," ",0)_U_IEN_U_ASSOC_U_LONG
Q
; Return list of managers associated with a specified category
GETMGRS(RET,CAT) ;EP
D GETMGRS^BGOPFUTL(.RET,CAT,90362.31)
Q
; Set category fields
; INP = Name [1] ^ Hosp Loc [2] ^ Clinic [3] ^ Provider [4] ^ User [5] ^ Category IEN [6] ^ Delete [7] ^ Discipline [8]
SETCAT(RET,INP) ;EP
D SETCAT^BGOPFUTL(.RET,INP,90362.31)
Q
; Set field values for a CPT preference entry
; INP = Category IEN [1] ^ CPT IEN [2] ^ Display Text [3] ^ Delete [4] ^ CPT Code [5] ^ Frequency [6] ^
; Allow Dups [7] ^ Item IEN [8]
SETITEM(RET,INP) ;EP
;IHS/MSC/MGH P14 don't import inactive codes
N CPTDATA,CPT,CPTIEN
S CPT=$P(INP,U,5)
I CPT'="" D
.S CPTIEN=$$CODEN^ICPTCOD(CPT)
.S CPTDATA=$$CPT^ICPTCOD(CPTIEN,$$NOW^XLFDT)
.I '$P(CPTDATA,U,7) S RET="-1^CPT "_CPT_" is inactive and will not be stored" Q
D SETITEM^BGOPFUTL(.RET,INP,90362.31)
Q
; Add or remove a manager from a category
; INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]
SETMGR(RET,INP) ;EP
D SETMGR^BGOPFUTL(.RET,INP,90362.313)
Q
; Set display name for a preference
; INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]
SETNAME(RET,INP) ;EP
D SETNAME^BGOPFUTL(.RET,INP,90362.312)
Q
; Set frequency for a CPT code
; INP = Category IEN [1] ^ CPT IEN [2] ^ Increment [3] ^ Frequency [4]
SETFREQ(RET,INP) ;EP
D SETFREQ^BGOPFUTL(.RET,INP,90362.312)
Q
BGOCPTPR ; IHS/BAO/TMD - CPT PREFERENCES MANAGER ;13-Jul-2015 09:16;MGH
+1 ;;1.1;BGO COMPONENTS;**1,3,5,14,15**;Mar 20, 2007
+2 ; Validates a CPT code
VALIDATE(RET,IEN,CODE) ;EP
+1 IF 'IEN
IF $GET(CODE)'=""
Begin DoDot:1
+2 NEW X
+3 SET IEN=-1
SET RET=""
+4 FOR X=0:0
SET X=$ORDER(^ICPT("B",CODE,X))
IF 'X
QUIT
Begin DoDot:2
+5 SET IEN=X
+6 SET RET=$$CHKCPT^BGOVCPT(IEN)
End DoDot:2
IF RET'<0
QUIT
+7 IF IEN<0
SET RET=$$ERR^BGOUTL(1020,CODE)
End DoDot:1
+8 IF '$TEST
IF 'IEN
SET RET=$$ERR^BGOUTL(1021)
+9 IF '$TEST
SET RET=$$CHKCPT^BGOVCPT(IEN)
+10 IF RET'<0
SET RET=""
+11 QUIT
+12 ; Return long name of CPT
+13 ; IEN = CPT IEN
GETLNAME(RET,IEN) ;EP
+1 NEW I,X
+2 IF 'IEN
SET RET=$$ERR^BGOUTL(1021)
QUIT
+3 SET X=0
SET RET=""
+4 FOR I=1:1
SET X=$ORDER(^ICPT(IEN,"D",X))
IF 'X
QUIT
SET RET=RET_$SELECT($LENGTH(RET):" ",1:"")_$GET(^(X,0))
+5 QUIT
+6 ; Return categories matching specified criteria
+7 ; INP = Category IEN [1] ^ Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5] ^ Historical Flag [6]
+8 ; where Historical Flag is (0=Non-historical only, 1=Historical only, 2=Both)
GETCATS(RET,INP) ;EP
+1 DO GETCATS^BGOPFUTL(.RET,INP,90362.31)
+2 QUIT
+3 ; Returns list of CPTs for specified category
+4 ; INP = Category IEN [1] ^ Group [2] ^ Visit IEN [3] ^ Display Freq Order [4]
+5 ; Returned as a list of records in the format
+6 ; CPT IEN [1] ^ CPT Code [2] ^ CPT Text [3] ^ Short Text [4] ^ Freq [5] ^
+7 ; VCPT IEN [6] ^ Fee [7] ^ Rank [8] ^ Pref IEN [9] ^ Association [10] ^
+8 ; Long Text [11]
GETITEMS(RET,INP) ;EP
+1 NEW PX,I,J,FREQ,VIEN,LONG,GRP,CAT,VPX,FREQ,CNT,RANK,IEN,SCHED
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET CAT=+INP
+4 IF 'CAT
SET @RET@(1)=$$ERR^BGOUTL(1018)
QUIT
+5 IF '$DATA(^BGOCPTPR(CAT,0))
SET @RET@(1)=$$ERR^BGOUTL(1019)
QUIT
+6 SET GRP=$PIECE(INP,U,2)
+7 SET VIEN=$PIECE(INP,U,3)
+8 SET FREQ=$PIECE(INP,U,4)
+9 IF $PIECE(^BGOCPTPR(CAT,0),U,6)
SET GRP=""
+10 IF VIEN
Begin DoDot:1
+11 SET VPX=0
+12 FOR
SET VPX=$ORDER(^AUPNVCPT("AD",VIEN,VPX))
IF 'VPX
QUIT
Begin DoDot:2
+13 SET I=$GET(^AUPNVCPT(VPX,0))
+14 ;IHS/MSC/MGH changed p15 because of items with no display text
+15 ;S:$L(I) VPX(+I,+$P(I,U,4))=VPX
+16 IF $LENGTH(I)
SET VPX(+I)=VPX
End DoDot:2
End DoDot:1
+17 SET (CNT,RANK)=0
+18 SET I=$PIECE($GET(^AUPNVSIT(+VIEN,0)),U,6)
+19 IF 'I
SET I=+$GET(DUZ(2))
+20 SET SCHED=+$PIECE($GET(^ABMDPARM(DUZ(2),I,0)),U,9)
+21 IF FREQ
Begin DoDot:1
+22 SET J=""
+23 FOR
SET J=$ORDER(^BGOCPTPR(CAT,1,"AC",J),-1)
IF J=""
QUIT
Begin DoDot:2
+24 SET IEN=0
+25 FOR
SET IEN=$ORDER(^BGOCPTPR(CAT,1,"AC",J,IEN))
IF 'IEN
QUIT
DO GP1
End DoDot:2
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET IEN=0
+28 FOR
SET IEN=$ORDER(^BGOCPTPR(CAT,1,IEN))
IF 'IEN
QUIT
DO GP1
End DoDot:1
+29 QUIT
GP1 NEW N0,CPTIEN,TXT,CPT,PX,FEE,ADA,FREQVAL,ASSOC
+1 SET N0=$GET(^BGOCPTPR(CAT,1,IEN,0))
+2 SET CPTIEN=+N0
+3 IF 'CPTIEN
QUIT
+4 IF '$DATA(^ICPT(CPTIEN,0))
QUIT
+5 SET CPT=$PIECE(^ICPT(CPTIEN,0),U)
SET PX=$PIECE(^(0),U,2)
+6 SET (FEE,TXT,LONG)=""
+7 DO GETLNAME(.LONG,CPTIEN)
+8 IF CPT>9999
IF CPT<70000
SET FEE=$PIECE($GET(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
+9 IF CPT?1A4N
SET FEE=$PIECE($GET(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
+10 IF CPT>69999
IF CPT<80000
SET FEE=$PIECE($GET(^ABMDFEE(SCHED,15,CPTIEN,0)),U,2)
+11 IF CPT>79999
IF CPT<90000
SET FEE=$PIECE($GET(^ABMDFEE(SCHED,17,CPTIEN,0)),U,2)
+12 IF CPT>89999
IF CPT<100000
SET FEE=$PIECE($GET(^ABMDFEE(SCHED,19,CPTIEN,0)),U,2)
+13 IF $EXTRACT(CPT)="D"
SET ADA=$ORDER(^AUTTADA("B",$EXTRACT(CPT,2,5),0))
IF 'ADA
QUIT
Begin DoDot:1
+14 SET FEE=$ORDER(^ABMDFEE(SCHED,21,"B",ADA,0))
+15 SET FEE=$PIECE($GET(^ABMDFEE(SCHED,21,+FEE,0)),U,2)
+16 SET PX=$PIECE($GET(^AUTTADA(ADA,0)),U,2)
End DoDot:1
+17 SET TXT=$PIECE(N0,U,2)
SET TXT(0)=+$$FNDNARR^BGOUTL2(TXT,0)
+18 SET FREQVAL=$PIECE(N0,U,3)
+19 SET ASSOC=''$ORDER(^BGOCPTPR(CAT,1,IEN,1,1))
+20 IF FREQ
SET RANK=RANK+1
+21 SET CNT=CNT+1
+22 SET @RET@(CNT)=CPTIEN_U_CPT_U_PX_U_TXT_U_FREQVAL_U_$GET(VPX(CPTIEN))_U_FEE_U_$TRANSLATE($JUSTIFY(RANK,4,0)," ",0)_U_IEN_U_ASSOC_U_LONG
+23 QUIT
+24 ; Return list of managers associated with a specified category
GETMGRS(RET,CAT) ;EP
+1 DO GETMGRS^BGOPFUTL(.RET,CAT,90362.31)
+2 QUIT
+3 ; Set category fields
+4 ; INP = Name [1] ^ Hosp Loc [2] ^ Clinic [3] ^ Provider [4] ^ User [5] ^ Category IEN [6] ^ Delete [7] ^ Discipline [8]
SETCAT(RET,INP) ;EP
+1 DO SETCAT^BGOPFUTL(.RET,INP,90362.31)
+2 QUIT
+3 ; Set field values for a CPT preference entry
+4 ; INP = Category IEN [1] ^ CPT IEN [2] ^ Display Text [3] ^ Delete [4] ^ CPT Code [5] ^ Frequency [6] ^
+5 ; Allow Dups [7] ^ Item IEN [8]
SETITEM(RET,INP) ;EP
+1 ;IHS/MSC/MGH P14 don't import inactive codes
+2 NEW CPTDATA,CPT,CPTIEN
+3 SET CPT=$PIECE(INP,U,5)
+4 IF CPT'=""
Begin DoDot:1
+5 SET CPTIEN=$$CODEN^ICPTCOD(CPT)
+6 SET CPTDATA=$$CPT^ICPTCOD(CPTIEN,$$NOW^XLFDT)
+7 IF '$PIECE(CPTDATA,U,7)
SET RET="-1^CPT "_CPT_" is inactive and will not be stored"
QUIT
End DoDot:1
+8 DO SETITEM^BGOPFUTL(.RET,INP,90362.31)
+9 QUIT
+10 ; Add or remove a manager from a category
+11 ; INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]
SETMGR(RET,INP) ;EP
+1 DO SETMGR^BGOPFUTL(.RET,INP,90362.313)
+2 QUIT
+3 ; Set display name for a preference
+4 ; INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]
SETNAME(RET,INP) ;EP
+1 DO SETNAME^BGOPFUTL(.RET,INP,90362.312)
+2 QUIT
+3 ; Set frequency for a CPT code
+4 ; INP = Category IEN [1] ^ CPT IEN [2] ^ Increment [3] ^ Frequency [4]
SETFREQ(RET,INP) ;EP
+1 DO SETFREQ^BGOPFUTL(.RET,INP,90362.312)
+2 QUIT
