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