BTIUPDD3 ; IHS/MSC/MGH - Problem and OB by entry date ;25-May-2016 16:23;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1017**;MAR 20, 2013;Build 7
;
Q
;
;
;Get the problems associated with this visit and only the latest or items updated during this visit
VST(DFN,TARGET,VIEN) ;Problems updated this visit
N PROB,CNT,RET,I,VST
S CNT=0
K @TARGET
S VIEN=$G(VIEN)
I VIEN'="" G GETPRB
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
D GETPRB
I CNT=0 S @TARGET@(1,0)="No Problems used as POVs in this visit record"
Q "~@"_$NA(@TARGET)
;
GETPRB ;Get problems to update
N POV,PRIEN,PCNT,ARRAY
S ARRAY=""
I $G(VIEN)="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S PCNT=0,PRIEN=0
F S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN D
.;Check for which statuses to return
.S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
.Q:STAT="D"
.I $D(^AUPNPROB(PRIEN,14,"B",VIEN)) D
..D GETDATA(.ARRAY,PRIEN,VIEN)
;IHS/MSC/MGH Patch 1014
D ADDITMS(.ARRAY)
Q
GETDATA(ARRAY,PRIEN,VIEN) ;Get data for a problem
N NARR,STATUS,ICD
Q:'+PRIEN
S NARR=$$POV^BTIUPDD(VIEN,PRIEN)
Q:$P(NARR,U,1)=""!($P(NARR,U,2)="")!($P(NARR,U,3)="")
S ARRAY($P(NARR,U,2),$P(NARR,U,3),$P(NARR,U,1),PRIEN)=""
Q
;S NARR=$$GET1^DIQ(9000010.07,POV,.04)
ADDITMS(ARRAY) ;Get items in order
N STAT,NARR,PRIEN,ENTRY
S STAT="" F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
.S ENTRY="" F S ENTRY=$O(ARRAY(STAT,ENTRY)) Q:ENTRY="" D
..S NARR="" F S NARR=$O(ARRAY(STAT,ENTRY,NARR)) Q:NARR="" D
...S PRIEN="" F S PRIEN=$O(ARRAY(STAT,ENTRY,NARR,PRIEN)) Q:PRIEN="" D
....S PCNT=PCNT+1
....D ADD($J(PCNT,2)_")"_NARR_" "_"("_STAT_")")
....D QUAL^BTIUPV1(PRIEN,.CNT)
....D VOB^BTIUPV2(DFN,PRIEN,VIEN,.CNT) ;V OB notes
Q
ADD(DATA) ;add to list
S CNT=CNT+1
S @TARGET@(CNT,0)=DATA
Q
TMPGBL(X) ;EP
K ^TMP("BGOPRDD",$J) Q $NA(^($J))
BTIUPDD3 ; IHS/MSC/MGH - Problem and OB by entry date ;25-May-2016 16:23;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1017**;MAR 20, 2013;Build 7
+2 ;
+3 QUIT
+4 ;
+5 ;
+6 ;Get the problems associated with this visit and only the latest or items updated during this visit
VST(DFN,TARGET,VIEN) ;Problems updated this visit
+1 NEW PROB,CNT,RET,I,VST
+2 SET CNT=0
+3 KILL @TARGET
+4 SET VIEN=$GET(VIEN)
+5 IF VIEN'=""
GOTO GETPRB
+6 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+7 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+8 SET VIEN=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+9 DO GETPRB
+10 IF CNT=0
SET @TARGET@(1,0)="No Problems used as POVs in this visit record"
+11 QUIT "~@"_$NAME(@TARGET)
+12 ;
GETPRB ;Get problems to update
+1 NEW POV,PRIEN,PCNT,ARRAY
+2 SET ARRAY=""
+3 IF $GET(VIEN)=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+4 SET PCNT=0
SET PRIEN=0
+5 FOR
SET PRIEN=$ORDER(^AUPNPROB("AC",DFN,PRIEN))
IF 'PRIEN
QUIT
Begin DoDot:1
+6 ;Check for which statuses to return
+7 SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)
+8 IF STAT="D"
QUIT
+9 IF $DATA(^AUPNPROB(PRIEN,14,"B",VIEN))
Begin DoDot:2
+10 DO GETDATA(.ARRAY,PRIEN,VIEN)
End DoDot:2
End DoDot:1
+11 ;IHS/MSC/MGH Patch 1014
+12 DO ADDITMS(.ARRAY)
+13 QUIT
GETDATA(ARRAY,PRIEN,VIEN) ;Get data for a problem
+1 NEW NARR,STATUS,ICD
+2 IF '+PRIEN
QUIT
+3 SET NARR=$$POV^BTIUPDD(VIEN,PRIEN)
+4 IF $PIECE(NARR,U,1)=""!($PIECE(NARR,U,2)="")!($PIECE(NARR,U,3)="")
QUIT
+5 SET ARRAY($PIECE(NARR,U,2),$PIECE(NARR,U,3),$PIECE(NARR,U,1),PRIEN)=""
+6 QUIT
+7 ;S NARR=$$GET1^DIQ(9000010.07,POV,.04)
ADDITMS(ARRAY) ;Get items in order
+1 NEW STAT,NARR,PRIEN,ENTRY
+2 SET STAT=""
FOR
SET STAT=$ORDER(ARRAY(STAT))
IF STAT=""
QUIT
Begin DoDot:1
+3 SET ENTRY=""
FOR
SET ENTRY=$ORDER(ARRAY(STAT,ENTRY))
IF ENTRY=""
QUIT
Begin DoDot:2
+4 SET NARR=""
FOR
SET NARR=$ORDER(ARRAY(STAT,ENTRY,NARR))
IF NARR=""
QUIT
Begin DoDot:3
+5 SET PRIEN=""
FOR
SET PRIEN=$ORDER(ARRAY(STAT,ENTRY,NARR,PRIEN))
IF PRIEN=""
QUIT
Begin DoDot:4
+6 SET PCNT=PCNT+1
+7 DO ADD($JUSTIFY(PCNT,2)_")"_NARR_" "_"("_STAT_")")
+8 DO QUAL^BTIUPV1(PRIEN,.CNT)
+9 ;V OB notes
DO VOB^BTIUPV2(DFN,PRIEN,VIEN,.CNT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
ADD(DATA) ;add to list
+1 SET CNT=CNT+1
+2 SET @TARGET@(CNT,0)=DATA
+3 QUIT
TMPGBL(X) ;EP
+1 KILL ^TMP("BGOPRDD",$JOB)
QUIT $NAME(^($JOB))
