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

BGOVUPD2.m

Go to the documentation of this file. 
  1. BGOVUPD2 ; IHS/MSC/MGH - Manage V UPDATE/REVIEWED file ;06-May-2011 16:04;PLS
  1.  ;;1.1;BGO COMPONENTS;**8**;Mar 20, 2007;Build 1
  1.  ; Get latest entries for a visit and user
  1.  ;  INP = Visit string [1] ^User IEN [2] ^Type [3] ^ DFN [4]
  1.  ; .RET returned as a list of records in the format:
  1.  ;   Type[1] ^ IEN [2] ^ Text [3]  ^ Yes/no if pt has entries in file [4]
  1. REVIEW(RET,INP) ;EP
  1.  N CODE,CNT,USER,VIEN,IEN,RESULT,DFN,VSTR
  1.  S RET=0,CNT=0
  1.  S VSTR=$P(INP,U,1)
  1.  S USER=$P(INP,U,2)
  1.  S DFN=$P(INP,U,4)
  1.  S CODE=$P(INP,U,3)
  1.  I 'DFN S RET(1)="-1^No patient entered" Q
  1.  I 'USER S RET(1)="-1^No user entered" Q
  1.  ;Find the visit
  1.  S VIEN=$$VSTR2VIS^BEHOENCX(DFN,VSTR,0,USER)
  1.  S CODE=$P(INP,U,3)
  1.  I 'DFN S RET(1)="-1^No patient entered" Q
  1.  I 'USER S RET(1)="-1^No user entered" Q
  1.  I CODE["P" S RESULT=$$PROB(DFN) D LIST("P",USER,RESULT)
  1.  I CODE["A" S RESULT=$$ALLER(DFN) D LIST("A",USER,RESULT)
  1.  I CODE["M" S RESULT=$$MEDS(DFN) D LIST("M",USER,RESULT)
  1.  Q
  1. LIST(TYPE,USER,RESULT) ;
  1.  N IEN,STOP
  1.  S STOP=0
  1.  I VIEN=0 D
  1.  .S CNT=CNT+1
  1.  .S STR=$S(TYPE="P":"PROBLEMS",TYPE="A":"ALLERGIES",TYPE="M":"MEDICATIONS",1:"")
  1.  .S RET(CNT)=TYPE_"^0^"_STR_" NEED REVIEW"_U_RESULT
  1.  E  D
  1.  .S IEN="" F  S IEN=$O(^AUPNVRUP("AD",VIEN,IEN),-1) Q:IEN=""!(STOP=1)  D CNT(IEN,TYPE,USER,RESULT)
  1.  .I STOP=0 D
  1.  ..S CNT=CNT+1
  1.  ..S STR=$S(TYPE="P":"PROBLEMS",TYPE="A":"ALLERGIES",TYPE="M":"MEDICATIONS",1:"")
  1.  ..S RET(CNT)=TYPE_"^0^"_STR_" NEED REVIEW"_U_RESULT
  1.  Q
  1. CNT(IEN,TYPE,USER,RESULT) ;Put the data in to array for return
  1.  N UTYP,VDATE,VISIT,ETYPE,ATYP,PRV,X
  1.  Q:$D(^AUPNVRUP(IEN,2))   ;Skip entries that are in error
  1.  S UTYP=$P($G(^AUPNVRUP(IEN,0)),U,1)
  1.  S ETYPE=$$GET1^DIQ(9000010.54,IEN,.01)
  1.  S PRV=$P($G(^AUPNVRUP(IEN,1)),U,2)
  1.  S ATYP=$S(ETYPE["ALLERG":"A",ETYPE["PROBLEM":"P",ETYPE["MEDICATION":"M",1:"")
  1.  I (ATYP=TYPE)&(PRV=USER) D
  1.  .S CNT=CNT+1,STOP=1
  1.  .S RET(CNT)=TYPE_U_IEN_U_ETYPE_U_RESULT
  1.  Q
  1. GETTYP(RET,CODE) ; EP Returns a list of the types of clinical review actions to selct based on type
  1.  N CNT,ABB,TYPE,IEN,NAME
  1.  S CNT=0
  1.  S ABB="" F  S ABB=$O(^AUTTCRA("C",ABB)) Q:ABB=""  D
  1.  .I (ABB="ALR")!(ABB="ALU")!(ABB="NAA") S TYPE="A"
  1.  .I (ABB="MLR")!(ABB="MLU")!(ABB="NAM") S TYPE="M"
  1.  .I (ABB="PLR")!(ABB="PLU")!(ABB="NAP") S TYPE="P"
  1.  .I CODE[TYPE D
  1.  ..S IEN=$O(^AUTTCRA("C",ABB,"")) Q:IEN=""  D
  1.  ...S NAME=$P($G(^AUTTCRA(IEN,0)),U)
  1.  ...S CNT=CNT+1
  1.  ...S RET(CNT)=IEN_U_NAME
  1.  Q
  1. PROB(DFN) ;Find if patient has any problems
  1.  N PLST,RET
  1.  S RET=0
  1.  D LIST^GMPLUTL2(.PLST,DFN,"A")
  1.  I PLST(0)>0 S RET=1
  1.  Q RET
  1. ALLER(DFN) ;Find if patient has any allergies
  1.  N DAT,LP,CNT,X
  1.  D LIST^BEHOARCV(.DAT,DFN,1,1)
  1.  S (LP,CNT)=0
  1.  F  S LP=$O(@DAT@(LP)) Q:'LP  D
  1.  .S X=@DAT@(LP)
  1.  .I $P(X,U),'$P(X,U,7) S CNT=CNT+1
  1.  Q CNT>0
  1.  ;
  1.  N GMRAL,RET
  1.  S RET=0
  1.  D EN1^GMRADPT
  1.  I GMRAL=1 S RET=1
  1.  Q RET
  1. MEDS(DFN) ;Find if pt has active meds
  1.  N MED,RET,RXN,X,QUIT,CNT
  1.  S RET=0,CNT=0,QUIT=0
  1.  D LIST^BEHORXCV(.DATA,DFN)
  1.  F  S CNT=$O(^TMP("CIAVMRPC",$J,CNT)) Q:CNT=""!(QUIT=1)  D
  1.  .S DATA=$G(^TMP("CIAVMRPC",$J,CNT))
  1.  .I $P(DATA,U,9)="ACTIVE" S RET=1,QUIT=1
  1.  Q RET