BTIUPDD1 ; IHS/MSC/MGH - Problem Objects ;21-Oct-2015 14:20;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013,1014**;MAR 20, 2013;Build 6
;IHS/MSC/MGH Patch 1013 added CP=2 for todays care plans
;
Q
;
;
;Get the problems associated with this visit and only the latest or items updated during this visit
VST(DFN,TARGET,VIEN,CP) ;Problems updated this visit
N PROB,CNT,RET,I,VST
S CNT=0,CP=$G(CP)
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
S NARR=$$POV^BTIUPDD(VIEN,PRIEN)
S ARRAY($P(NARR,U,2),$P(NARR,U,1),PRIEN)=""
Q
;S NARR=$$GET1^DIQ(9000010.07,POV,.04)
ADDITMS(ARRAY) ;Get items in order
N STAT,NARR,PRIEN
S STAT="" F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
.S NARR="" F S NARR=$O(ARRAY(STAT,NARR)) Q:NARR="" D
..S PRIEN="" F S PRIEN=$O(ARRAY(STAT,NARR,PRIEN)) Q:PRIEN="" D
...S PCNT=PCNT+1
...D ADD($J(PCNT,2)_")"_NARR_" "_"("_STAT_")")
...D QUAL^BTIUPV1(PRIEN,.CNT)
...I CP=1 D
....D FINDCP^BTIUPV1(PRIEN,"G",.CNT) ;Add goals
....D FINDCP^BTIUPV1(PRIEN,"P",.CNT) ;Add care plans
...;IHS/MSC/MGH Patch 1013
...I CP=2 D
....D FINDCP(PRIEN,"G",.CNT)
....D FINDCP(PRIEN,"P",.CNT)
...D VIDT^BTIUPV1(PRIEN,VIEN,.CNT) ;Visit instruction
...D VTRDT^BTIUPV1(PRIEN,VIEN,.CNT) ;V treatment/regimens
...D REFDT^BTIUPV1(PRIEN,VIEN,.CNT) ;V REFERRALS
...D EDU^BTIUPV1(PRIEN,VIEN,.CNT) ;V education by date
Q
FINDCP(PRIEN,TYPE,CNT) ;Find a care plan for today Patch 1013
N INVDT,INVDT2,SIGNDT,ARRDT,STATUS,EDATE,IEN,NODE,PRV,PRVNM,INVDT,CPIEN,CVTDT,SIGN,NODE,Z,DONE,SIEN,PCNT,ARRAY
S DONE=0,PCNT=0,ARRAY=""
S INVDT="" S INVDT=$O(^AUPNCPL("APDT",PRIEN,TYPE,INVDT))
Q:INVDT=""
S CVTDT=9999999-INVDT
Q:$P(CVTDT,".",1)'=DT
S CPIEN="" F S CPIEN=$O(^AUPNCPL("APDT",PRIEN,TYPE,INVDT,CPIEN)) Q:CPIEN="" D
.S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
.S STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
.Q:STATUS'="A"
.S INVDT2=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
.S ARRAY(INVDT2,CPIEN)=""
Q:$D(ARRAY)<10
S ARRDT="" F S ARRDT=$O(ARRAY(ARRDT)) Q:'+ARRDT D
.S CPIEN="" F S CPIEN=$O(ARRAY(ARRDT,CPIEN)) Q:'+CPIEN D
..I PCNT=0 S PCNT=1 D
...I TYPE="P" D ADD(" -CARE PLANS:")
...I TYPE="G" D ADD(" -GOALS:")
..S NODE=$G(^AUPNCPL(CPIEN,0))
..S PRV=$$GET1^DIQ(9000092,CPIEN,.03,"I")
..S PRVNM=$$GET1^DIQ(9000092,CPIEN,.03)
..S SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08,"I")
..S SIGNDT=$$FMTE^XLFDT($P(SIGNDT,".",1),5)
..S SIGN=$$GET1^DIQ(9000092,CPIEN,.07)
..S EDATE=$$GET1^DIQ(9000092,CPIEN,.05)
..Q:SIGN=""&(PRV'=DUZ)
..D TEXT^BTIUPV1(TYPE,CPIEN)
Q
INPT(DFN,TARGET,VIEN,CP) ;Problems updated this hospitalization
N PROB,CNT,RET,I,VST
S CNT=0,CP=$G(CP)
K @TARGET
S VIEN=$G(VIEN)
I VIEN'="" G GETIP
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 GETIP
I CNT=0 S @TARGET@(1,0)="No Problems used during this inpatient record"
Q "~@"_$NA(@TARGET)
;
GETIP ;Get problems to update
N PRIEN,PCNT,INP,STAT
S PCNT=0
S PRIEN="" 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"
.S INP=""
.F S INP=$O(^AUPNPROB(PRIEN,15,"B",VIEN,INP)) Q:'+INP D
..D DATA(PRIEN,VIEN)
Q
DATA(PRIEN,VIEN) ;Get data for a problem
N NARR,STATUS,ICD
S PCNT=PCNT+1
S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
D ADD($J(PCNT,2)_")"_NARR)
D QUAL^BTIUPV1(PRIEN,.CNT)
I CP=2 D
.D FINDCP^BTIUPV1(PRIEN,"G",.CNT) ;Add goals
.D FINDCP^BTIUPV1(PRIEN,"P",.CNT) ;Add care plans
I CP>0 D
.D VIDT^BTIUPV1(PRIEN,VIEN,.CNT) ;Visit instruction
.D VTRDT^BTIUPV1(PRIEN,VIEN,.CNT) ;V treatment/regimens
.D REFDT^BTIUPV1(PRIEN,VIEN,.CNT) ;V REFERRALS
.D EDU^BTIUPV1(PRIEN,VIEN,.CNT) ;V education by date
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))
BTIUPDD1 ; IHS/MSC/MGH - Problem Objects ;21-Oct-2015 14:20;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013,1014**;MAR 20, 2013;Build 6
+2 ;IHS/MSC/MGH Patch 1013 added CP=2 for todays care plans
+3 ;
+4 QUIT
+5 ;
+6 ;
+7 ;Get the problems associated with this visit and only the latest or items updated during this visit
VST(DFN,TARGET,VIEN,CP) ;Problems updated this visit
+1 NEW PROB,CNT,RET,I,VST
+2 SET CNT=0
SET CP=$GET(CP)
+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 SET NARR=$$POV^BTIUPDD(VIEN,PRIEN)
+3 SET ARRAY($PIECE(NARR,U,2),$PIECE(NARR,U,1),PRIEN)=""
+4 QUIT
+5 ;S NARR=$$GET1^DIQ(9000010.07,POV,.04)
ADDITMS(ARRAY) ;Get items in order
+1 NEW STAT,NARR,PRIEN
+2 SET STAT=""
FOR
SET STAT=$ORDER(ARRAY(STAT))
IF STAT=""
QUIT
Begin DoDot:1
+3 SET NARR=""
FOR
SET NARR=$ORDER(ARRAY(STAT,NARR))
IF NARR=""
QUIT
Begin DoDot:2
+4 SET PRIEN=""
FOR
SET PRIEN=$ORDER(ARRAY(STAT,NARR,PRIEN))
IF PRIEN=""
QUIT
Begin DoDot:3
+5 SET PCNT=PCNT+1
+6 DO ADD($JUSTIFY(PCNT,2)_")"_NARR_" "_"("_STAT_")")
+7 DO QUAL^BTIUPV1(PRIEN,.CNT)
+8 IF CP=1
Begin DoDot:4
+9 ;Add goals
DO FINDCP^BTIUPV1(PRIEN,"G",.CNT)
+10 ;Add care plans
DO FINDCP^BTIUPV1(PRIEN,"P",.CNT)
End DoDot:4
+11 ;IHS/MSC/MGH Patch 1013
+12 IF CP=2
Begin DoDot:4
+13 DO FINDCP(PRIEN,"G",.CNT)
+14 DO FINDCP(PRIEN,"P",.CNT)
End DoDot:4
+15 ;Visit instruction
DO VIDT^BTIUPV1(PRIEN,VIEN,.CNT)
+16 ;V treatment/regimens
DO VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)
+17 ;V REFERRALS
DO REFDT^BTIUPV1(PRIEN,VIEN,.CNT)
+18 ;V education by date
DO EDU^BTIUPV1(PRIEN,VIEN,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
FINDCP(PRIEN,TYPE,CNT) ;Find a care plan for today Patch 1013
+1 NEW INVDT,INVDT2,SIGNDT,ARRDT,STATUS,EDATE,IEN,NODE,PRV,PRVNM,INVDT,CPIEN,CVTDT,SIGN,NODE,Z,DONE,SIEN,PCNT,ARRAY
+2 SET DONE=0
SET PCNT=0
SET ARRAY=""
+3 SET INVDT=""
SET INVDT=$ORDER(^AUPNCPL("APDT",PRIEN,TYPE,INVDT))
+4 IF INVDT=""
QUIT
+5 SET CVTDT=9999999-INVDT
+6 IF $PIECE(CVTDT,".",1)'=DT
QUIT
+7 SET CPIEN=""
FOR
SET CPIEN=$ORDER(^AUPNCPL("APDT",PRIEN,TYPE,INVDT,CPIEN))
IF CPIEN=""
QUIT
Begin DoDot:1
+8 SET SIEN=$CHAR(0)
SET SIEN=$ORDER(^AUPNCPL(CPIEN,11,SIEN),-1)
+9 SET STATUS=$PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
+10 IF STATUS'="A"
QUIT
+11 SET INVDT2=9999999-$PIECE($GET(^AUPNCPL(CPIEN,0)),U,5)
+12 SET ARRAY(INVDT2,CPIEN)=""
End DoDot:1
+13 IF $DATA(ARRAY)<10
QUIT
+14 SET ARRDT=""
FOR
SET ARRDT=$ORDER(ARRAY(ARRDT))
IF '+ARRDT
QUIT
Begin DoDot:1
+15 SET CPIEN=""
FOR
SET CPIEN=$ORDER(ARRAY(ARRDT,CPIEN))
IF '+CPIEN
QUIT
Begin DoDot:2
+16 IF PCNT=0
SET PCNT=1
Begin DoDot:3
+17 IF TYPE="P"
DO ADD(" -CARE PLANS:")
+18 IF TYPE="G"
DO ADD(" -GOALS:")
End DoDot:3
+19 SET NODE=$GET(^AUPNCPL(CPIEN,0))
+20 SET PRV=$$GET1^DIQ(9000092,CPIEN,.03,"I")
+21 SET PRVNM=$$GET1^DIQ(9000092,CPIEN,.03)
+22 SET SIGNDT=$$GET1^DIQ(9000092,CPIEN,.08,"I")
+23 SET SIGNDT=$$FMTE^XLFDT($PIECE(SIGNDT,".",1),5)
+24 SET SIGN=$$GET1^DIQ(9000092,CPIEN,.07)
+25 SET EDATE=$$GET1^DIQ(9000092,CPIEN,.05)
+26 IF SIGN=""&(PRV'=DUZ)
QUIT
+27 DO TEXT^BTIUPV1(TYPE,CPIEN)
End DoDot:2
End DoDot:1
+28 QUIT
INPT(DFN,TARGET,VIEN,CP) ;Problems updated this hospitalization
+1 NEW PROB,CNT,RET,I,VST
+2 SET CNT=0
SET CP=$GET(CP)
+3 KILL @TARGET
+4 SET VIEN=$GET(VIEN)
+5 IF VIEN'=""
GOTO GETIP
+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 GETIP
+10 IF CNT=0
SET @TARGET@(1,0)="No Problems used during this inpatient record"
+11 QUIT "~@"_$NAME(@TARGET)
+12 ;
GETIP ;Get problems to update
+1 NEW PRIEN,PCNT,INP,STAT
+2 SET PCNT=0
+3 SET PRIEN=""
FOR
SET PRIEN=$ORDER(^AUPNPROB("AC",DFN,PRIEN))
IF 'PRIEN
QUIT
Begin DoDot:1
+4 ;Check for which statuses to return
+5 SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)
+6 IF STAT="D"
QUIT
+7 SET INP=""
+8 FOR
SET INP=$ORDER(^AUPNPROB(PRIEN,15,"B",VIEN,INP))
IF '+INP
QUIT
Begin DoDot:2
+9 DO DATA(PRIEN,VIEN)
End DoDot:2
End DoDot:1
+10 QUIT
DATA(PRIEN,VIEN) ;Get data for a problem
+1 NEW NARR,STATUS,ICD
+2 SET PCNT=PCNT+1
+3 SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)
+4 DO ADD($JUSTIFY(PCNT,2)_")"_NARR)
+5 DO QUAL^BTIUPV1(PRIEN,.CNT)
+6 IF CP=2
Begin DoDot:1
+7 ;Add goals
DO FINDCP^BTIUPV1(PRIEN,"G",.CNT)
+8 ;Add care plans
DO FINDCP^BTIUPV1(PRIEN,"P",.CNT)
End DoDot:1
+9 IF CP>0
Begin DoDot:1
+10 ;Visit instruction
DO VIDT^BTIUPV1(PRIEN,VIEN,.CNT)
+11 ;V treatment/regimens
DO VTRDT^BTIUPV1(PRIEN,VIEN,.CNT)
+12 ;V REFERRALS
DO REFDT^BTIUPV1(PRIEN,VIEN,.CNT)
+13 ;V education by date
DO EDU^BTIUPV1(PRIEN,VIEN,.CNT)
End DoDot:1
+14 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))
