- 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))
