BTIUPRV2 ; IHS/MSC/JS - Problem/Visit Objects ;25-Mar-2014 17:10;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
;Obects for visit-related problem entries from V Visit instructions
;V treatment/regimen and V referral files
Q
;
VIDT(DFN,TARGET) ; Visit Instructions for current visit
N ARRAY,PRIEN,IEN,VCNT,CNT,EDATE,SIGN,STAT,NARR,VST,X,SPRIEN,EIE
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
S CNT=0
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
K @TARGET
S VCNT=0
S SPRIEN=0
S IEN="" F S IEN=$O(^AUPNVVI("AD",VST,IEN)) Q:IEN="" D
.S EIE=$$GET1^DIQ(9000010.58,IEN,.06,"I")
.Q:EIE=1
.S PRIEN=$$GET1^DIQ(9000010.58,IEN,.01,"I")
.S EDATE=$$GET1^DIQ(9000010.58,IEN,1201,"I")
.S EDATE=$$FMTE^XLFDT(EDATE,5)
.S SIGN=$$GET1^DIQ(9000010.58,IEN,.04,"E")
.S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
.I SPRIEN'=PRIEN S SPRIEN=PRIEN D PDATA(IEN)
.D TEXT
I VCNT=0 S @TARGET@(1,0)="No visit instructions for this visit"
Q "~@"_$NA(@TARGET)
;
PDATA(PRIEN) ;Do problem data
S VCNT=VCNT+1
S @TARGET@(VCNT,0)="Problem: "_NARR
Q
TEXT ;do the text
N TXTIEN
S VCNT=VCNT+1
S @TARGET@(VCNT,0)=" INSTRUCTIONS:"
S TXTIEN=0 F S TXTIEN=$O(^AUPNVVI(IEN,11,TXTIEN)) Q:'+TXTIEN D
.S VCNT=VCNT+1
.S @TARGET@(VCNT,0)=" "_$G(^AUPNVVI(IEN,11,TXTIEN,0))
S VCNT=VCNT+1
S @TARGET@(VCNT,0)=" Signed by: "_SIGN
S VCNT=VCNT+1
S @TARGET@(VCNT,0)=""
Q
VTRDT(DFN,TARGET) ; Visit Treatment/Regimens for this visit
N ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
S CNT=0
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
K @TARGET
S VCNT=0
S IEN="" F S IEN=$O(^AUPNVTXR("AD",VST,IEN)) Q:IEN="" D
.S PRIEN=$$GET1^DIQ(9000010.61,IEN,.04,"I")
.S EDATE=$$GET1^DIQ(9000010.61,IEN,1201,"I")
.S EDATE=$$FMTE^XLFDT(EDATE,5)
.;S VCNT=VCNT+1
.;S @TARGET@(VCNT,0)=EDATE
.S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
.S VCNT=VCNT+1
.S @TARGET@(VCNT,0)="Problem: "_NARR
.N IN,OUT,ARR,X
.S SNO=$P($G(^AUPNVTXR(IEN,0)),U,1)
.S IN=SNO_"^^^1",OUT="ARR"
.S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
.I X>0 D
..S TXT=ARR(1,"PRE","TRM")
..S VCNT=VCNT+1
..S @TARGET@(VCNT,0)=" "_TXT
I VCNT=0 S @TARGET@(1,0)="No Treatment/regimen for this visit"
Q "~@"_$NA(@TARGET)
REFPR(DFN,TARGET) ; V referrals for this visit
N ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
S CNT=0
S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
K @TARGET
S VCNT=0
S IEN="" F S IEN=$O(^AUPNVREF("AD",VST,IEN)) Q:IEN="" D
.S PRIEN=$$GET1^DIQ(9000010.59,IEN,.01,"I")
.S EDATE=$$GET1^DIQ(9000010.59,IEN,1201,"I")
.S EDATE=$$FMTE^XLFDT(EDATE,5)
.S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
.S VCNT=VCNT+1
.S @TARGET@(VCNT,0)=" "_NARR
.S SNO=$P($G(^AUPNVREF(IEN,0)),U,1)
.S X=$$CONC^BSTSAPI(SNO_"^^^1")
.I +X D
..S TXT=$P(X,U,4)
..S VCNT=VCNT+1
..S @TARGET@(VCNT,0)=EDATE_" "_TXT_"("_SNO_")"
..S PRV=$$GET1^DIQ(9000010.59,IEN,1202)
..I PRV="" S PRV=$$GET1^DIQ(9000010.59,IEN,1204)
..S VCNT=VCNT+1
..S @TARGET@(VCNT,0)="Provider: "_PRV
I VCNT=0 S @TARGET@(1,0)="No Referrals for this visit"
Q "~@"_$NA(@TARGET)
CARE(DFN,TARGET) ;Care plans entered on this visit
N CNT,VST,X,RET,LOOP,PRIEN,VCNT
S RET="",VCNT=0
;I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
S CNT=0,LOOP=0
;S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
;I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
;S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
K @TARGET
D GET^BGOPROB(.RET,DFN)
F S LOOP=$O(^TMP("BGO",$J,LOOP)) Q:'+LOOP D
.I $P($G(^TMP("BGO",$J,LOOP)),U,1)="P" D
..S PRIEN=$P($G(^TMP("BGO",$J,LOOP)),U,2)
..D FINDCP(PRIEN)
I VCNT=0 S @TARGET@(1,0)="No Care Plans/Goals found"
K ^TMP("BGO",$J)
Q "~@"_$NA(@TARGET)
FINDCP(PRIEN) ;Find a care plan
N TYPE,VSTDT,INVDT,STAT,CPIEN,SIEN,EDATE,IEN,NODE,PRV,PRVNM,SIGN,NARR,NODE,Z
S TYPE=""
S VSTDT=$P($$NOW^XLFDT,".",1)
F S TYPE=$O(^AUPNCPL("APT",PRIEN,TYPE)) Q:TYPE="" D
.S CPIEN="" F S CPIEN=$O(^AUPNCPL("APT",PRIEN,TYPE,CPIEN)) Q:CPIEN="" D
..S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
..S STAT=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
..Q:STAT'="A"
..S EDATE=$P($P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,3),".",1)
..Q:EDATE'=VSTDT
..S NODE=$G(^AUPNCPL(CPIEN,0))
..S PRV=$$GET1^DIQ(9000092,CPIEN,.03,"I")
..S PRVNM=$$GET1^DIQ(9000092,CPIEN,.03)
..S SIGN=$$GET1^DIQ(9000092,CPIEN,.08)
..Q:SIGN=""&(PRV'=DUZ)
..S NARR=$$GET1^DIQ(9000011,PRIEN,.05)
..S VCNT=VCNT+1
..S @TARGET@(VCNT,0)="Problem: "_NARR
..S VCNT=VCNT+1
..S Z=$S(TYPE="G":"Goal",1:"Care Plan")
..S @TARGET@(VCNT,0)=Z_" Provider: "_PRVNM
..S VCNT=VCNT+1
..S @TARGET@(VCNT,0)="Signed on: "_SIGN
..D TEXT2(TYPE)
Q
TEXT2(TYPE) ;do the text
N TXTIEN
S VCNT=VCNT+1
S @TARGET@(VCNT,0)=$S(TYPE="G":" GOAL",1:" CARE PLAN")
S TXTIEN=0 F S TXTIEN=$O(^AUPNCPL(CPIEN,12,TXTIEN)) Q:'+TXTIEN D
.S VCNT=VCNT+1
.S @TARGET@(VCNT,0)=" "_$G(^AUPNCPL(CPIEN,12,TXTIEN,0))
S VCNT=VCNT+1
S @TARGET@(VCNT,0)=""
Q
BTIUPRV2 ; IHS/MSC/JS - Problem/Visit Objects ;25-Mar-2014 17:10;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
+2 ;Obects for visit-related problem entries from V Visit instructions
+3 ;V treatment/regimen and V referral files
+4 QUIT
+5 ;
VIDT(DFN,TARGET) ; Visit Instructions for current visit
+1 NEW ARRAY,PRIEN,IEN,VCNT,CNT,EDATE,SIGN,STAT,NARR,VST,X,SPRIEN,EIE
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+3 SET CNT=0
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+6 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+7 KILL @TARGET
+8 SET VCNT=0
+9 SET SPRIEN=0
+10 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVVI("AD",VST,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+11 SET EIE=$$GET1^DIQ(9000010.58,IEN,.06,"I")
+12 IF EIE=1
QUIT
+13 SET PRIEN=$$GET1^DIQ(9000010.58,IEN,.01,"I")
+14 SET EDATE=$$GET1^DIQ(9000010.58,IEN,1201,"I")
+15 SET EDATE=$$FMTE^XLFDT(EDATE,5)
+16 SET SIGN=$$GET1^DIQ(9000010.58,IEN,.04,"E")
+17 SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)
+18 IF SPRIEN'=PRIEN
SET SPRIEN=PRIEN
DO PDATA(IEN)
+19 DO TEXT
End DoDot:1
+20 IF VCNT=0
SET @TARGET@(1,0)="No visit instructions for this visit"
+21 QUIT "~@"_$NAME(@TARGET)
+22 ;
PDATA(PRIEN) ;Do problem data
+1 SET VCNT=VCNT+1
+2 SET @TARGET@(VCNT,0)="Problem: "_NARR
+3 QUIT
TEXT ;do the text
+1 NEW TXTIEN
+2 SET VCNT=VCNT+1
+3 SET @TARGET@(VCNT,0)=" INSTRUCTIONS:"
+4 SET TXTIEN=0
FOR
SET TXTIEN=$ORDER(^AUPNVVI(IEN,11,TXTIEN))
IF '+TXTIEN
QUIT
Begin DoDot:1
+5 SET VCNT=VCNT+1
+6 SET @TARGET@(VCNT,0)=" "_$GET(^AUPNVVI(IEN,11,TXTIEN,0))
End DoDot:1
+7 SET VCNT=VCNT+1
+8 SET @TARGET@(VCNT,0)=" Signed by: "_SIGN
+9 SET VCNT=VCNT+1
+10 SET @TARGET@(VCNT,0)=""
+11 QUIT
VTRDT(DFN,TARGET) ; Visit Treatment/Regimens for this visit
+1 NEW ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+3 SET CNT=0
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+6 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+7 KILL @TARGET
+8 SET VCNT=0
+9 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVTXR("AD",VST,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+10 SET PRIEN=$$GET1^DIQ(9000010.61,IEN,.04,"I")
+11 SET EDATE=$$GET1^DIQ(9000010.61,IEN,1201,"I")
+12 SET EDATE=$$FMTE^XLFDT(EDATE,5)
+13 ;S VCNT=VCNT+1
+14 ;S @TARGET@(VCNT,0)=EDATE
+15 SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)
+16 SET VCNT=VCNT+1
+17 SET @TARGET@(VCNT,0)="Problem: "_NARR
+18 NEW IN,OUT,ARR,X
+19 SET SNO=$PIECE($GET(^AUPNVTXR(IEN,0)),U,1)
+20 SET IN=SNO_"^^^1"
SET OUT="ARR"
+21 SET X=$$CNCLKP^BSTSAPI(.OUT,.IN)
+22 IF X>0
Begin DoDot:2
+23 SET TXT=ARR(1,"PRE","TRM")
+24 SET VCNT=VCNT+1
+25 SET @TARGET@(VCNT,0)=" "_TXT
End DoDot:2
End DoDot:1
+26 IF VCNT=0
SET @TARGET@(1,0)="No Treatment/regimen for this visit"
+27 QUIT "~@"_$NAME(@TARGET)
REFPR(DFN,TARGET) ; V referrals for this visit
+1 NEW ARRAY,IEN,VCNT,EDATE,SIGN,STAT,NARR,VST,X,SNO,PRIEN,TXT,X
+2 IF $TEXT(GETVAR^CIAVMEVT)=""
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+3 SET CNT=0
+4 SET VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+5 IF VST=""
SET @TARGET@(1,0)="Invalid visit"
QUIT "~@"_$NAME(@TARGET)
+6 SET X="BEHOENCX"
XECUTE ^%ZOSF("TEST")
IF $TEST
SET VST=+$$VSTR2VIS^BEHOENCX(DFN,VST)
IF VST<1
SET @TARGET@(1,0)="Invalid context variables"
QUIT "~@"_$NAME(@TARGET)
+7 KILL @TARGET
+8 SET VCNT=0
+9 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVREF("AD",VST,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+10 SET PRIEN=$$GET1^DIQ(9000010.59,IEN,.01,"I")
+11 SET EDATE=$$GET1^DIQ(9000010.59,IEN,1201,"I")
+12 SET EDATE=$$FMTE^XLFDT(EDATE,5)
+13 SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)
+14 SET VCNT=VCNT+1
+15 SET @TARGET@(VCNT,0)=" "_NARR
+16 SET SNO=$PIECE($GET(^AUPNVREF(IEN,0)),U,1)
+17 SET X=$$CONC^BSTSAPI(SNO_"^^^1")
+18 IF +X
Begin DoDot:2
+19 SET TXT=$PIECE(X,U,4)
+20 SET VCNT=VCNT+1
+21 SET @TARGET@(VCNT,0)=EDATE_" "_TXT_"("_SNO_")"
+22 SET PRV=$$GET1^DIQ(9000010.59,IEN,1202)
+23 IF PRV=""
SET PRV=$$GET1^DIQ(9000010.59,IEN,1204)
+24 SET VCNT=VCNT+1
+25 SET @TARGET@(VCNT,0)="Provider: "_PRV
End DoDot:2
End DoDot:1
+26 IF VCNT=0
SET @TARGET@(1,0)="No Referrals for this visit"
+27 QUIT "~@"_$NAME(@TARGET)
CARE(DFN,TARGET) ;Care plans entered on this visit
+1 NEW CNT,VST,X,RET,LOOP,PRIEN,VCNT
+2 SET RET=""
SET VCNT=0
+3 ;I $T(GETVAR^CIAVMEVT)="" S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
+4 SET CNT=0
SET LOOP=0
+5 ;S VST=$$GETVAR^CIAVMEVT("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+6 ;I VST="" S @TARGET@(1,0)="Invalid visit" Q "~@"_$NA(@TARGET)
+7 ;S X="BEHOENCX" X ^%ZOSF("TEST") I $T S VST=+$$VSTR2VIS^BEHOENCX(DFN,VST) I VST<1 S @TARGET@(1,0)="Invalid context variables" Q "~@"_$NA(@TARGET)
+8 KILL @TARGET
+9 DO GET^BGOPROB(.RET,DFN)
+10 FOR
SET LOOP=$ORDER(^TMP("BGO",$JOB,LOOP))
IF '+LOOP
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^TMP("BGO",$JOB,LOOP)),U,1)="P"
Begin DoDot:2
+12 SET PRIEN=$PIECE($GET(^TMP("BGO",$JOB,LOOP)),U,2)
+13 DO FINDCP(PRIEN)
End DoDot:2
End DoDot:1
+14 IF VCNT=0
SET @TARGET@(1,0)="No Care Plans/Goals found"
+15 KILL ^TMP("BGO",$JOB)
+16 QUIT "~@"_$NAME(@TARGET)
FINDCP(PRIEN) ;Find a care plan
+1 NEW TYPE,VSTDT,INVDT,STAT,CPIEN,SIEN,EDATE,IEN,NODE,PRV,PRVNM,SIGN,NARR,NODE,Z
+2 SET TYPE=""
+3 SET VSTDT=$PIECE($$NOW^XLFDT,".",1)
+4 FOR
SET TYPE=$ORDER(^AUPNCPL("APT",PRIEN,TYPE))
IF TYPE=""
QUIT
Begin DoDot:1
+5 SET CPIEN=""
FOR
SET CPIEN=$ORDER(^AUPNCPL("APT",PRIEN,TYPE,CPIEN))
IF CPIEN=""
QUIT
Begin DoDot:2
+6 SET SIEN=$CHAR(0)
SET SIEN=$ORDER(^AUPNCPL(CPIEN,11,SIEN),-1)
+7 SET STAT=$PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
+8 IF STAT'="A"
QUIT
+9 SET EDATE=$PIECE($PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,3),".",1)
+10 IF EDATE'=VSTDT
QUIT
+11 SET NODE=$GET(^AUPNCPL(CPIEN,0))
+12 SET PRV=$$GET1^DIQ(9000092,CPIEN,.03,"I")
+13 SET PRVNM=$$GET1^DIQ(9000092,CPIEN,.03)
+14 SET SIGN=$$GET1^DIQ(9000092,CPIEN,.08)
+15 IF SIGN=""&(PRV'=DUZ)
QUIT
+16 SET NARR=$$GET1^DIQ(9000011,PRIEN,.05)
+17 SET VCNT=VCNT+1
+18 SET @TARGET@(VCNT,0)="Problem: "_NARR
+19 SET VCNT=VCNT+1
+20 SET Z=$SELECT(TYPE="G":"Goal",1:"Care Plan")
+21 SET @TARGET@(VCNT,0)=Z_" Provider: "_PRVNM
+22 SET VCNT=VCNT+1
+23 SET @TARGET@(VCNT,0)="Signed on: "_SIGN
+24 DO TEXT2(TYPE)
End DoDot:2
End DoDot:1
+25 QUIT
TEXT2(TYPE) ;do the text
+1 NEW TXTIEN
+2 SET VCNT=VCNT+1
+3 SET @TARGET@(VCNT,0)=$SELECT(TYPE="G":" GOAL",1:" CARE PLAN")
+4 SET TXTIEN=0
FOR
SET TXTIEN=$ORDER(^AUPNCPL(CPIEN,12,TXTIEN))
IF '+TXTIEN
QUIT
Begin DoDot:1
+5 SET VCNT=VCNT+1
+6 SET @TARGET@(VCNT,0)=" "_$GET(^AUPNCPL(CPIEN,12,TXTIEN,0))
End DoDot:1
+7 SET VCNT=VCNT+1
+8 SET @TARGET@(VCNT,0)=""
+9 QUIT
