BGOPAUD ; IHS/BAO/TMD - Problem Details ;16-Dec-2015 17:17;DU
;;1.1;BGO COMPONENTS;**13,14,19**;Mar 20, 2007;Build 2
;---------------------------------------------
CHANGED(PROB,FLDS) ;EP check audit log for changes
N GLO,E,T,AFIELD,AUTIME,BY,D,LIST,INVTIME,DATA
S FILE=9000011
S FLAGS="O"
S GLO=^DIC(FILE,0,"GL")
I '$G(START) S START=0
I '$G(END) D NOW^%DTC S END=%
S T="" F S T=$O(^DIA(FILE,"B",PROB,T)) Q:'+T D
.S E=$G(^DIA(FILE,T,0)) Q:'E
.S AFIELD=$P(E,U,3)
.Q:AFIELD'=FLDS
.I AFIELD=80001!(AFIELD="1301,.01")!(AFIELD="1701,.01")!(AFIELD="1801,.01") S AFIELD=$$CONCEPT(AFIELD)
.I AFIELD=80002 S AFIELD=$$DESC(AFIELD)
.Q:$G(^DIA(FILE,T,3))="" ;There is no new value
.S AUTIME=$P(E,U,2)
.S BY=$P(E,U,4)
.S INVTIME=9999999-AUTIME
.S LIST(INVTIME)=T_U_AFIELD_U_BY_U_AUTIME
S T=PROB_"," F S T=$O(^DIA(FILE,"B",T)) Q:+T'=PROB D
.F D=0:0 S D=$O(^DIA(FILE,"B",T,D)) Q:'D D
..S E=$G(^DIA(FILE,D,0)) Q:'E
..S AFIELD=$P(E,U,3)
..Q:AFIELD'=FLDS
..Q:$G(^DIA(FILE,D,3))="" ;There is no new value
..I AFIELD=80001!(AFIELD="1301,.01")!(AFIELD="1701,.01")!(AFIELD="1801,.01") S AFIELD=$$CONCEPT(AFIELD)
..I AFIELD=80002 S AFIELD=$$DESC(AFIELD)
..S AUTIME=$P(E,U,2)
..S BY=$P(E,U,4)
..S INVTIME=9999999-AUTIME
..S LIST(INVTIME)=D_U_AFIELD_U_BY_U_AUTIME
N X,Y,Z,BY,D,CNTP,TXT
S X=0,CNTP=0
F S X=$O(LIST(X)) Q:X="" D
.S TXT=""
.S DATA=$G(LIST(X))
.S D=$P(DATA,U,1)
.S T=$G(^DIA(FILE,D,2))
.;IHS/MSC/MGH P14-not needed anymore
.;I $P(DATA,U,2)=.05 D
.;.S T=$TR(T," ","")
.;.S TI=$P(T,"|",2)
.;.I TI'="" D
.;..S TXT=$$DESC(TI)
.;..I TXT="" S TXT=$G(^DIA(FILE,D,2))
.;..S TXT=TXT_"|"_$P(T,"|",1)
.;.E S TXT=T
.S TXT=T
.I TXT'="" D ADD2^BGOPRDD(" # Previous value: "_TXT)
.S Y=$$FMTDATE^BGOUTL($P(DATA,U,4))
.S BY=$P(DATA,U,3)
.S Z=$$GET1^DIQ(200,BY,.01)
.S TXT=" # Edited: "_Y_" by: "_Z
.D ADD2^BGOPRDD(TXT)
Q
TMPGBL(X) ;EP
K ^TMP("BGOAUD",$J) Q $NA(^($J))
CONCEPT(X) ;Find the text of the code
N RET,IN,OUT,SNO
S RET=""
;S OUT="ARR",IN=X_U_36_U_U_1
;S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
;I X>0 D
;.S RET=$G(ARR(1,"PRE","TRM"))
S IN=X_"^^^1"
S SNO=$$CONC^BSTSAPI(IN)
S RET=$P(SNO,U,4)
Q RET
DESC(X) ;Find the desc ct
N RET
S RET=""
S RET=$P($$DESC^BSTSAPI(X_"^^1"),U,2)
Q RET
BGOPAUD ; IHS/BAO/TMD - Problem Details ;16-Dec-2015 17:17;DU
+1 ;;1.1;BGO COMPONENTS;**13,14,19**;Mar 20, 2007;Build 2
+2 ;---------------------------------------------
CHANGED(PROB,FLDS) ;EP check audit log for changes
+1 NEW GLO,E,T,AFIELD,AUTIME,BY,D,LIST,INVTIME,DATA
+2 SET FILE=9000011
+3 SET FLAGS="O"
+4 SET GLO=^DIC(FILE,0,"GL")
+5 IF '$GET(START)
SET START=0
+6 IF '$GET(END)
DO NOW^%DTC
SET END=%
+7 SET T=""
FOR
SET T=$ORDER(^DIA(FILE,"B",PROB,T))
IF '+T
QUIT
Begin DoDot:1
+8 SET E=$GET(^DIA(FILE,T,0))
IF 'E
QUIT
+9 SET AFIELD=$PIECE(E,U,3)
+10 IF AFIELD'=FLDS
QUIT
+11 IF AFIELD=80001!(AFIELD="1301,.01")!(AFIELD="1701,.01")!(AFIELD="1801,.01")
SET AFIELD=$$CONCEPT(AFIELD)
+12 IF AFIELD=80002
SET AFIELD=$$DESC(AFIELD)
+13 ;There is no new value
IF $GET(^DIA(FILE,T,3))=""
QUIT
+14 SET AUTIME=$PIECE(E,U,2)
+15 SET BY=$PIECE(E,U,4)
+16 SET INVTIME=9999999-AUTIME
+17 SET LIST(INVTIME)=T_U_AFIELD_U_BY_U_AUTIME
End DoDot:1
+18 SET T=PROB_","
FOR
SET T=$ORDER(^DIA(FILE,"B",T))
IF +T'=PROB
QUIT
Begin DoDot:1
+19 FOR D=0:0
SET D=$ORDER(^DIA(FILE,"B",T,D))
IF 'D
QUIT
Begin DoDot:2
+20 SET E=$GET(^DIA(FILE,D,0))
IF 'E
QUIT
+21 SET AFIELD=$PIECE(E,U,3)
+22 IF AFIELD'=FLDS
QUIT
+23 ;There is no new value
IF $GET(^DIA(FILE,D,3))=""
QUIT
+24 IF AFIELD=80001!(AFIELD="1301,.01")!(AFIELD="1701,.01")!(AFIELD="1801,.01")
SET AFIELD=$$CONCEPT(AFIELD)
+25 IF AFIELD=80002
SET AFIELD=$$DESC(AFIELD)
+26 SET AUTIME=$PIECE(E,U,2)
+27 SET BY=$PIECE(E,U,4)
+28 SET INVTIME=9999999-AUTIME
+29 SET LIST(INVTIME)=D_U_AFIELD_U_BY_U_AUTIME
End DoDot:2
End DoDot:1
+30 NEW X,Y,Z,BY,D,CNTP,TXT
+31 SET X=0
SET CNTP=0
+32 FOR
SET X=$ORDER(LIST(X))
IF X=""
QUIT
Begin DoDot:1
+33 SET TXT=""
+34 SET DATA=$GET(LIST(X))
+35 SET D=$PIECE(DATA,U,1)
+36 SET T=$GET(^DIA(FILE,D,2))
+37 ;IHS/MSC/MGH P14-not needed anymore
+38 ;I $P(DATA,U,2)=.05 D
+39 ;.S T=$TR(T," ","")
+40 ;.S TI=$P(T,"|",2)
+41 ;.I TI'="" D
+42 ;..S TXT=$$DESC(TI)
+43 ;..I TXT="" S TXT=$G(^DIA(FILE,D,2))
+44 ;..S TXT=TXT_"|"_$P(T,"|",1)
+45 ;.E S TXT=T
+46 SET TXT=T
+47 IF TXT'=""
DO ADD2^BGOPRDD(" # Previous value: "_TXT)
+48 SET Y=$$FMTDATE^BGOUTL($PIECE(DATA,U,4))
+49 SET BY=$PIECE(DATA,U,3)
+50 SET Z=$$GET1^DIQ(200,BY,.01)
+51 SET TXT=" # Edited: "_Y_" by: "_Z
+52 DO ADD2^BGOPRDD(TXT)
End DoDot:1
+53 QUIT
TMPGBL(X) ;EP
+1 KILL ^TMP("BGOAUD",$JOB)
QUIT $NAME(^($JOB))
CONCEPT(X) ;Find the text of the code
+1 NEW RET,IN,OUT,SNO
+2 SET RET=""
+3 ;S OUT="ARR",IN=X_U_36_U_U_1
+4 ;S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
+5 ;I X>0 D
+6 ;.S RET=$G(ARR(1,"PRE","TRM"))
+7 SET IN=X_"^^^1"
+8 SET SNO=$$CONC^BSTSAPI(IN)
+9 SET RET=$PIECE(SNO,U,4)
+10 QUIT RET
DESC(X) ;Find the desc ct
+1 NEW RET
+2 SET RET=""
+3 SET RET=$PIECE($$DESC^BSTSAPI(X_"^^1"),U,2)
+4 QUIT RET
