Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGOCPTPR

BGOCPTPR.m

Go to the documentation of this file. 
  1. 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
  1.  ; Validates a CPT code
  1. VALIDATE(RET,IEN,CODE) ;EP
  1.  I 'IEN,$G(CODE)'="" D
  1.  .N X
  1.  .S IEN=-1,RET=""
  1.  .F X=0:0 S X=$O(^ICPT("B",CODE,X)) Q:'X  D  Q:RET'<0
  1.  ..S IEN=X
  1.  ..S RET=$$CHKCPT^BGOVCPT(IEN)
  1.  .S:IEN<0 RET=$$ERR^BGOUTL(1020,CODE)
  1.  E  I 'IEN S RET=$$ERR^BGOUTL(1021)
  1.  E  S RET=$$CHKCPT^BGOVCPT(IEN)
  1.  S:RET'<0 RET=""
  1.  Q
  1.  ; Return long name of CPT
  1.  ;  IEN = CPT IEN
  1. GETLNAME(RET,IEN) ;EP
  1.  N I,X
  1.  I 'IEN S RET=$$ERR^BGOUTL(1021) Q
  1.  S X=0,RET=""
  1.  F I=1:1 S X=$O(^ICPT(IEN,"D",X)) Q:'X  S RET=RET_$S($L(RET):" ",1:"")_$G(^(X,0))
  1.  Q
  1.  ; Return categories matching specified criteria
  1.  ;  INP = Category IEN [1] ^ Location IEN [2] ^ Provider IEN [3] ^ Manager IEN [4] ^ Show All [5] ^ Historical Flag [6]
  1.  ;    where Historical Flag is (0=Non-historical only, 1=Historical only, 2=Both)
  1. GETCATS(RET,INP) ;EP
  1.  D GETCATS^BGOPFUTL(.RET,INP,90362.31)
  1.  Q
  1.  ; Returns list of CPTs for specified category
  1.  ;  INP = Category IEN [1] ^ Group [2] ^ Visit IEN [3] ^ Display Freq Order [4]
  1.  ;  Returned as a list of records in the format
  1.  ;   CPT IEN [1] ^ CPT Code [2] ^ CPT Text [3] ^ Short Text [4] ^ Freq [5] ^
  1.  ;   VCPT IEN [6] ^ Fee [7] ^ Rank [8] ^ Pref IEN [9] ^ Association [10] ^
  1.  ;   Long Text [11]
  1. GETITEMS(RET,INP) ;EP
  1.  N PX,I,J,FREQ,VIEN,LONG,GRP,CAT,VPX,FREQ,CNT,RANK,IEN,SCHED
  1.  S RET=$$TMPGBL^BGOUTL
  1.  S CAT=+INP
  1.  I 'CAT S @RET@(1)=$$ERR^BGOUTL(1018) Q
  1.  I '$D(^BGOCPTPR(CAT,0)) S @RET@(1)=$$ERR^BGOUTL(1019) Q
  1.  S GRP=$P(INP,U,2)
  1.  S VIEN=$P(INP,U,3)
  1.  S FREQ=$P(INP,U,4)
  1.  S:$P(^BGOCPTPR(CAT,0),U,6) GRP=""
  1.  I VIEN D
  1.  .S VPX=0
  1.  .F  S VPX=$O(^AUPNVCPT("AD",VIEN,VPX)) Q:'VPX  D
  1.  ..S I=$G(^AUPNVCPT(VPX,0))
  1.  ..;IHS/MSC/MGH changed p15 because of items with no display text
  1.  ..;S:$L(I) VPX(+I,+$P(I,U,4))=VPX
  1.  ..S:$L(I) VPX(+I)=VPX
  1.  S (CNT,RANK)=0
  1.  S I=$P($G(^AUPNVSIT(+VIEN,0)),U,6)
  1.  S:'I I=+$G(DUZ(2))
  1.  S SCHED=+$P($G(^ABMDPARM(DUZ(2),I,0)),U,9)
  1.  I FREQ D
  1.  .S J=""
  1.  .F  S J=$O(^BGOCPTPR(CAT,1,"AC",J),-1) Q:J=""  D
  1.  ..S IEN=0
  1.  ..F  S IEN=$O(^BGOCPTPR(CAT,1,"AC",J,IEN)) Q:'IEN  D GP1
  1.  E  D
  1.  .S IEN=0
  1.  .F  S IEN=$O(^BGOCPTPR(CAT,1,IEN)) Q:'IEN  D GP1
  1.  Q
  1. GP1 N N0,CPTIEN,TXT,CPT,PX,FEE,ADA,FREQVAL,ASSOC
  1.  S N0=$G(^BGOCPTPR(CAT,1,IEN,0))
  1.  S CPTIEN=+N0
  1.  Q:'CPTIEN
  1.  Q:'$D(^ICPT(CPTIEN,0))
  1.  S CPT=$P(^ICPT(CPTIEN,0),U),PX=$P(^(0),U,2)
  1.  S (FEE,TXT,LONG)=""
  1.  D GETLNAME(.LONG,CPTIEN)
  1.  I CPT>9999,CPT<70000 S FEE=$P($G(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
  1.  I CPT?1A4N S FEE=$P($G(^ABMDFEE(SCHED,11,CPTIEN,0)),U,2)
  1.  I CPT>69999,CPT<80000 S FEE=$P($G(^ABMDFEE(SCHED,15,CPTIEN,0)),U,2)
  1.  I CPT>79999,CPT<90000 S FEE=$P($G(^ABMDFEE(SCHED,17,CPTIEN,0)),U,2)
  1.  I CPT>89999,CPT<100000 S FEE=$P($G(^ABMDFEE(SCHED,19,CPTIEN,0)),U,2)
  1.  I $E(CPT)="D" S ADA=$O(^AUTTADA("B",$E(CPT,2,5),0)) Q:'ADA  D
  1.  .S FEE=$O(^ABMDFEE(SCHED,21,"B",ADA,0))
  1.  .S FEE=$P($G(^ABMDFEE(SCHED,21,+FEE,0)),U,2)
  1.  .S PX=$P($G(^AUTTADA(ADA,0)),U,2)
  1.  S TXT=$P(N0,U,2),TXT(0)=+$$FNDNARR^BGOUTL2(TXT,0)
  1.  S FREQVAL=$P(N0,U,3)
  1.  S ASSOC=''$O(^BGOCPTPR(CAT,1,IEN,1,1))
  1.  S:FREQ RANK=RANK+1
  1.  S CNT=CNT+1
  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
  1.  Q
  1.  ; Return list of managers associated with a specified category
  1. GETMGRS(RET,CAT) ;EP
  1.  D GETMGRS^BGOPFUTL(.RET,CAT,90362.31)
  1.  Q
  1.  ; Set category fields
  1.  ;  INP = Name [1] ^ Hosp Loc [2] ^ Clinic [3] ^ Provider [4] ^ User [5] ^ Category IEN [6] ^ Delete [7] ^ Discipline [8]
  1. SETCAT(RET,INP) ;EP
  1.  D SETCAT^BGOPFUTL(.RET,INP,90362.31)
  1.  Q
  1.  ; Set field values for a CPT preference entry
  1.  ;  INP = Category IEN [1] ^ CPT IEN [2] ^ Display Text [3] ^ Delete [4] ^ CPT Code [5] ^ Frequency [6] ^
  1.  ;        Allow Dups [7] ^ Item IEN [8]
  1. SETITEM(RET,INP) ;EP
  1.  ;IHS/MSC/MGH P14 don't import inactive codes
  1.  N CPTDATA,CPT,CPTIEN
  1.  S CPT=$P(INP,U,5)
  1.  I CPT'="" D
  1.  .S CPTIEN=$$CODEN^ICPTCOD(CPT)
  1.  .S CPTDATA=$$CPT^ICPTCOD(CPTIEN,$$NOW^XLFDT)
  1.  .I '$P(CPTDATA,U,7) S RET="-1^CPT "_CPT_" is inactive and will not be stored" Q
  1.  D SETITEM^BGOPFUTL(.RET,INP,90362.31)
  1.  Q
  1.  ; Add or remove a manager from a category
  1.  ;  INP = Category IEN [1] ^ Manager IEN [2] ^ Add [3]
  1. SETMGR(RET,INP) ;EP
  1.  D SETMGR^BGOPFUTL(.RET,INP,90362.313)
  1.  Q
  1.  ; Set display name for a preference
  1.  ;  INP = Category IEN [1] ^ Item IEN [2] ^ Display Name [3]
  1. SETNAME(RET,INP) ;EP
  1.  D SETNAME^BGOPFUTL(.RET,INP,90362.312)
  1.  Q
  1.  ; Set frequency for a CPT code
  1.  ;  INP = Category IEN [1] ^ CPT IEN [2] ^ Increment [3] ^ Frequency [4]
  1. SETFREQ(RET,INP) ;EP
  1.  D SETFREQ^BGOPFUTL(.RET,INP,90362.312)
  1.  Q