BTIUCPL ; IHS/MSC/JS - TIU V Care Plan Object ;25-Nov-2013 10:05;DU
;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
;5/22/13 - TO TEST EHR GUI, PARAMETER 'PARAM' HARDSET = 265 (PROBLEM IEN)
;
; <<< USE VISIT IEN 2434 (FEB 22 2013 @13:59) PATIENT TEST,MAX >>>
;
;
;NUMBER: 668 NAME: V CARE PLAN
;DESCRIPTION: Artifact 13530 - MU TIU Objects for Care Plan
;
;OBJECT METHOD: S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
;
;TEST DIRECT: S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
; (DFN=76,PRIEN=265,PARAM="L")
;
; S RET=$$CPL^BTIUCPL(76,"BTIUCPL",2434,265)
;
; ^AUPNCPL("ASDT",265,"G",6869670.869591,"A",1,1)=""
; ^AUPNCPL("ASDT",266,"P",6869669.884771,"A",2,1)=""
; ^AUPNCPL("ASDT",267,"G",6869669.884586,"A",3,1)=""
; ^AUPNCPL("ASDT",268,"G",6869596.906661,"A",4,1)=""
;
; ^AUPNCPL("B",265,1)=""
; ^AUPNCPL("B",266,2)=""
; ^AUPNCPL("B",267,3)=""
; ^AUPNCPL("B",268,4)=""
;
CPL(DFN,TARGET,VIEN,PARAM) ;EHR p12
; DFN = The patient this problem belongs to
; TARGET = Location of object report
; VIEN = Visit ien (optional) [IF VIEN PASSED, PROBLEM(S) RETURNED ARE 'Purpose of Visit' POV]
; PARAM = A All problems [IF VIEN NULL AND PARAM NULL, DEFAULTS TO 'L' LAST DATE PROBLEM]
; C Active problems
; L Last date problem
; Problem ien
;
N CNT,CONIEN,CPLANG,CPLANP,CPLARR,CPLCON,CPLVED,CPLVTR,CPLVVI,FNUM,IEN,SNO,STATUS
N VED,VST,VTRIN,VVIN,VVISIT
I $G(TARGET)="" S TARGET=$$TMPGBL
;I $G(TARGET)="" S TARGET="BTIUCPL"
K @TARGET
S RET=""
S CNT=0
I $G(DFN)="" S @TARGET@(1,0)="Invalid input - Missing Patient DFN" Q "~@"_$NA(@TARGET)
I $G(VIEN)="" S @TARGET@(1,0)="Invalid input - Missing Visit ien" Q "~@"_$NA(@TARGET)
I $G(PARAM)="" S @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien" Q "~@"_$NA(@TARGET)
I $G(PARAM)]"" I PARAM'?1N.E S @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien" Q "~@"_$NA(@TARGET)
;
I $G(PARAM)="" S PARAM="L" ; default to last date <<<< future, if 'L' use VVI lkup 5/22/13 <<<<
;
I $G(PARAM)]"" I PARAM?1N.E D PRIEN(PARAM)
Q "~@"_$NA(@TARGET)
;
PRIEN(PRIEN) ;
1 ;-- Get the patient care plan data record(s) --
N X S X="" D CPLAN(.X,PRIEN,DFN,"G",.CNT) ; Care Plan Goals
N X S X="" D CPLAN(.X,PRIEN,DFN,"P",.CNT) ; Care Plan of Care
N X S X="" D CPLVVI(.X,DFN,PRIEN,.CNT) ; Visit Instructions
N X S X="" D CPLVTR(.X,DFN,PRIEN,.CNT) ; Treatment/Regimen
N X S X="" D CPLVED(.X,DFN,PRIEN,.CNT) ; Patient Education
N X S X="" D CPLCON(.X,DFN,PRIEN,.CNT) ; Consults
;
I CNT=0 S @TARGET@(1,0)="No Care Plan record found for patient" Q "~@"_$NA(@TARGET)
;
2 ; -- call GETS^DIQ for file entries --
S IEN="",FNUM=9000092 F S IEN=$O(CPLANG(IEN)) Q:IEN="" D GETDATA
S IEN="",FNUM=9000092 F S IEN=$O(CPLANP(IEN)) Q:IEN="" D GETDATA
S IEN="",FNUM=9000010.58 F S IEN=$O(CPLVVI(IEN)) Q:IEN="" D GETDATA
S IEN="",FNUM=9000010.61 F S IEN=$O(CPLVTR(IEN)) Q:IEN="" D GETDATA
S IEN="",FNUM=9000010.16 F S IEN=$O(CPLVED(IEN)) Q:IEN="" D GETDATA
S IEN="",FNUM=123 F S IEN=$O(CPLCON(IEN)) Q:IEN="" D GETDATA
;
3 ; -- format object report --
N CNT,SPACE,STRPAD
S CNT=0
S $P(SPACE," ",1)=""
S $P(STRPAD," ",3)=""
S IEN="",FNUM=9000092 F S IEN=$O(CPLANG(IEN)) Q:IEN="" D OUT^BTIUCPL1
S IEN="",FNUM=9000092 F S IEN=$O(CPLANP(IEN)) Q:IEN="" D OUT^BTIUCPL1
S IEN="",FNUM=9000010.58 F S IEN=$O(CPLVVI(IEN)) Q:IEN="" D OUT^BTIUCPL1
S IEN="",FNUM=9000010.61 F S IEN=$O(CPLVTR(IEN)) Q:IEN="" D OUT^BTIUCPL1
S IEN="",FNUM=9000010.16 F S IEN=$O(CPLVED(IEN)) Q:IEN="" D OUT^BTIUCPL1
S IEN="",FNUM=123 F S IEN=$O(CPLCON(IEN)) Q:IEN="" D OUT^BTIUCPL1
;
CPLAN(DATA,IEN,DFN,TYPE,CNT) ;
N INVDT,RET
S INVDT=""
F S INVDT=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT)) Q:INVDT="" D
.S STATUS="" F S STATUS=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS)) Q:STATUS="" D
..Q:STATUS="E"
..N CPIEN,SIEN
..S CPIEN="" S CPIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN)) Q:CPIEN="" D
...S SIEN="" F S SIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN,SIEN)) Q:SIEN="" D
....N REC,RECDFN S REC=$G(^AUPNCPL(SIEN,0))
....Q:REC=""
....S RECDFN=$P(REC,U,2)
....Q:RECDFN'=DFN
....I TYPE="G" S CPLANG(SIEN)="" S CNT=CNT+1
....I TYPE="P" S CPLANP(SIEN)="" S CNT=CNT+1
Q
;
CPLVVI(DATA,DFN,PROB,CNT) ;
N FNUM,VVIN
;Return the instructions for the last visit by default
S VVIN="" F S VVIN=$O(^AUPNVVI("B",PROB,VVIN)) Q:VVIN="" D
.N REC,RECDFN S REC=$G(^AUPNVVI(VVIN,0))
.Q:REC=""
.S RECDFN=$P(REC,U,2)
.Q:RECDFN'=DFN
.S VVISIT=$P(REC,U,3)
.Q:'VVISIT
.S CPLVVI(VVIN)="" S CNT=CNT+1
Q
;
CPLVTR(DATA,DFN,PROB,CNT) ;
S VST="" F S VST=$O(^AUPNVTXR("AF",DFN,VST)) Q:VST="" D
.S SNO="" F S SNO=$O(^AUPNVTXR("AF",DFN,VST,SNO)) Q:SNO="" D
..S VTRIN="" F S VTRIN=$O(^AUPNVTXR("AF",DFN,VST,SNO,VTRIN)) Q:VTRIN="" D
...N REC,RECDFN S REC=$G(^AUPNVTXR(VTRIN,0))
...Q:REC=""
...S RECDFN=$P(REC,U,2)
...Q:RECDFN'=DFN
...Q:$P(REC,U,4)'=PROB
...Q:$P(REC,U,5)=1 ; -- DISCONTINUED
...S CPLVTR(VTRIN)="" S CNT=CNT+1
Q
;
CPLVED(DATA,DFN,PROB,CNT) ;
I $G(VVISIT)="" Q
S VED="" F S VED=$O(^AUPNVPED("AC",DFN,VED)) Q:VED="" D
.N REC,RECDFN S REC=$G(^AUPNVPED(VED,0))
.Q:REC=""
.S RECDFN=$P(REC,U,2)
.Q:RECDFN'=DFN
.Q:$P(REC,U,3)'=VVISIT
.S CPLVED(VED)="" S CNT=CNT+1
Q
;
CPLCON(DATA,DFN,PROB,CNT) ;
S CONIEN=""
F S CONIEN=$O(^GMR(123,"I",PROB,CONIEN),-1) Q:'+CONIEN D
.N REC,RECDFN S REC=$G(^GMR(123,CONIEN,0))
.Q:REC=""
.S RECDFN=$P(REC,U,2)
.Q:RECDFN'=DFN
.S CPLCON(CONIEN)="" S CNT=CNT+1
Q
;
GETDATA ;
K CPLERR
D GETS^DIQ(FNUM,IEN_",","**","E","CPLARR","CPLERR")
I $D(CPLERR) D Q "~@"_$NA(@TARGET)
.S @TARGET@(1,0)="Server error: "_$G(FNUM)_$G(CPLERR("DIERR",1))_U_$G(CPLERR("DIERR",1,"TEXT",1))
Q
;
TMPGBL(X) ;EP
K ^TMP("BTIUCPL",$J) Q $NA(^($J))
BTIUCPL ; IHS/MSC/JS - TIU V Care Plan Object ;25-Nov-2013 10:05;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1012**;MAR 20, 2013;Build 45
+2 ;5/22/13 - TO TEST EHR GUI, PARAMETER 'PARAM' HARDSET = 265 (PROBLEM IEN)
+3 ;
+4 ; <<< USE VISIT IEN 2434 (FEB 22 2013 @13:59) PATIENT TEST,MAX >>>
+5 ;
+6 ;
+7 ;NUMBER: 668 NAME: V CARE PLAN
+8 ;DESCRIPTION: Artifact 13530 - MU TIU Objects for Care Plan
+9 ;
+10 ;OBJECT METHOD: S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
+11 ;
+12 ;TEST DIRECT: S RET=$$CPL^BTIUCPL(DFN,"^TMP(""BTIUCPL"",$J)",+$G(TIU("VISIT"),$G(PARAM)))
+13 ; (DFN=76,PRIEN=265,PARAM="L")
+14 ;
+15 ; S RET=$$CPL^BTIUCPL(76,"BTIUCPL",2434,265)
+16 ;
+17 ; ^AUPNCPL("ASDT",265,"G",6869670.869591,"A",1,1)=""
+18 ; ^AUPNCPL("ASDT",266,"P",6869669.884771,"A",2,1)=""
+19 ; ^AUPNCPL("ASDT",267,"G",6869669.884586,"A",3,1)=""
+20 ; ^AUPNCPL("ASDT",268,"G",6869596.906661,"A",4,1)=""
+21 ;
+22 ; ^AUPNCPL("B",265,1)=""
+23 ; ^AUPNCPL("B",266,2)=""
+24 ; ^AUPNCPL("B",267,3)=""
+25 ; ^AUPNCPL("B",268,4)=""
+26 ;
CPL(DFN,TARGET,VIEN,PARAM) ;EHR p12
+1 ; DFN = The patient this problem belongs to
+2 ; TARGET = Location of object report
+3 ; VIEN = Visit ien (optional) [IF VIEN PASSED, PROBLEM(S) RETURNED ARE 'Purpose of Visit' POV]
+4 ; PARAM = A All problems [IF VIEN NULL AND PARAM NULL, DEFAULTS TO 'L' LAST DATE PROBLEM]
+5 ; C Active problems
+6 ; L Last date problem
+7 ; Problem ien
+8 ;
+9 NEW CNT,CONIEN,CPLANG,CPLANP,CPLARR,CPLCON,CPLVED,CPLVTR,CPLVVI,FNUM,IEN,SNO,STATUS
+10 NEW VED,VST,VTRIN,VVIN,VVISIT
+11 IF $GET(TARGET)=""
SET TARGET=$$TMPGBL
+12 ;I $G(TARGET)="" S TARGET="BTIUCPL"
+13 KILL @TARGET
+14 SET RET=""
+15 SET CNT=0
+16 IF $GET(DFN)=""
SET @TARGET@(1,0)="Invalid input - Missing Patient DFN"
QUIT "~@"_$NAME(@TARGET)
+17 IF $GET(VIEN)=""
SET @TARGET@(1,0)="Invalid input - Missing Visit ien"
QUIT "~@"_$NAME(@TARGET)
+18 IF $GET(PARAM)=""
SET @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien"
QUIT "~@"_$NAME(@TARGET)
+19 IF $GET(PARAM)]""
IF PARAM'?1N.E
SET @TARGET@(1,0)="Invalid input - PARAM not a valid Problem ien"
QUIT "~@"_$NAME(@TARGET)
+20 ;
+21 ; default to last date <<<< future, if 'L' use VVI lkup 5/22/13 <<<<
IF $GET(PARAM)=""
SET PARAM="L"
+22 ;
+23 IF $GET(PARAM)]""
IF PARAM?1N.E
DO PRIEN(PARAM)
+24 QUIT "~@"_$NAME(@TARGET)
+25 ;
PRIEN(PRIEN) ;
1 ;-- Get the patient care plan data record(s) --
+1 ; Care Plan Goals
NEW X
SET X=""
DO CPLAN(.X,PRIEN,DFN,"G",.CNT)
+2 ; Care Plan of Care
NEW X
SET X=""
DO CPLAN(.X,PRIEN,DFN,"P",.CNT)
+3 ; Visit Instructions
NEW X
SET X=""
DO CPLVVI(.X,DFN,PRIEN,.CNT)
+4 ; Treatment/Regimen
NEW X
SET X=""
DO CPLVTR(.X,DFN,PRIEN,.CNT)
+5 ; Patient Education
NEW X
SET X=""
DO CPLVED(.X,DFN,PRIEN,.CNT)
+6 ; Consults
NEW X
SET X=""
DO CPLCON(.X,DFN,PRIEN,.CNT)
+7 ;
+8 IF CNT=0
SET @TARGET@(1,0)="No Care Plan record found for patient"
QUIT "~@"_$NAME(@TARGET)
+9 ;
2 ; -- call GETS^DIQ for file entries --
+1 SET IEN=""
SET FNUM=9000092
FOR
SET IEN=$ORDER(CPLANG(IEN))
IF IEN=""
QUIT
DO GETDATA
+2 SET IEN=""
SET FNUM=9000092
FOR
SET IEN=$ORDER(CPLANP(IEN))
IF IEN=""
QUIT
DO GETDATA
+3 SET IEN=""
SET FNUM=9000010.58
FOR
SET IEN=$ORDER(CPLVVI(IEN))
IF IEN=""
QUIT
DO GETDATA
+4 SET IEN=""
SET FNUM=9000010.61
FOR
SET IEN=$ORDER(CPLVTR(IEN))
IF IEN=""
QUIT
DO GETDATA
+5 SET IEN=""
SET FNUM=9000010.16
FOR
SET IEN=$ORDER(CPLVED(IEN))
IF IEN=""
QUIT
DO GETDATA
+6 SET IEN=""
SET FNUM=123
FOR
SET IEN=$ORDER(CPLCON(IEN))
IF IEN=""
QUIT
DO GETDATA
+7 ;
3 ; -- format object report --
+1 NEW CNT,SPACE,STRPAD
+2 SET CNT=0
+3 SET $PIECE(SPACE," ",1)=""
+4 SET $PIECE(STRPAD," ",3)=""
+5 SET IEN=""
SET FNUM=9000092
FOR
SET IEN=$ORDER(CPLANG(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+6 SET IEN=""
SET FNUM=9000092
FOR
SET IEN=$ORDER(CPLANP(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+7 SET IEN=""
SET FNUM=9000010.58
FOR
SET IEN=$ORDER(CPLVVI(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+8 SET IEN=""
SET FNUM=9000010.61
FOR
SET IEN=$ORDER(CPLVTR(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+9 SET IEN=""
SET FNUM=9000010.16
FOR
SET IEN=$ORDER(CPLVED(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+10 SET IEN=""
SET FNUM=123
FOR
SET IEN=$ORDER(CPLCON(IEN))
IF IEN=""
QUIT
DO OUT^BTIUCPL1
+11 ;
CPLAN(DATA,IEN,DFN,TYPE,CNT) ;
+1 NEW INVDT,RET
+2 SET INVDT=""
+3 FOR
SET INVDT=$ORDER(^AUPNCPL("ASDT",IEN,TYPE,INVDT))
IF INVDT=""
QUIT
Begin DoDot:1
+4 SET STATUS=""
FOR
SET STATUS=$ORDER(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS))
IF STATUS=""
QUIT
Begin DoDot:2
+5 IF STATUS="E"
QUIT
+6 NEW CPIEN,SIEN
+7 SET CPIEN=""
SET CPIEN=$ORDER(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN))
IF CPIEN=""
QUIT
Begin DoDot:3
+8 SET SIEN=""
FOR
SET SIEN=$ORDER(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN,SIEN))
IF SIEN=""
QUIT
Begin DoDot:4
+9 NEW REC,RECDFN
SET REC=$GET(^AUPNCPL(SIEN,0))
+10 IF REC=""
QUIT
+11 SET RECDFN=$PIECE(REC,U,2)
+12 IF RECDFN'=DFN
QUIT
+13 IF TYPE="G"
SET CPLANG(SIEN)=""
SET CNT=CNT+1
+14 IF TYPE="P"
SET CPLANP(SIEN)=""
SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
CPLVVI(DATA,DFN,PROB,CNT) ;
+1 NEW FNUM,VVIN
+2 ;Return the instructions for the last visit by default
+3 SET VVIN=""
FOR
SET VVIN=$ORDER(^AUPNVVI("B",PROB,VVIN))
IF VVIN=""
QUIT
Begin DoDot:1
+4 NEW REC,RECDFN
SET REC=$GET(^AUPNVVI(VVIN,0))
+5 IF REC=""
QUIT
+6 SET RECDFN=$PIECE(REC,U,2)
+7 IF RECDFN'=DFN
QUIT
+8 SET VVISIT=$PIECE(REC,U,3)
+9 IF 'VVISIT
QUIT
+10 SET CPLVVI(VVIN)=""
SET CNT=CNT+1
End DoDot:1
+11 QUIT
+12 ;
CPLVTR(DATA,DFN,PROB,CNT) ;
+1 SET VST=""
FOR
SET VST=$ORDER(^AUPNVTXR("AF",DFN,VST))
IF VST=""
QUIT
Begin DoDot:1
+2 SET SNO=""
FOR
SET SNO=$ORDER(^AUPNVTXR("AF",DFN,VST,SNO))
IF SNO=""
QUIT
Begin DoDot:2
+3 SET VTRIN=""
FOR
SET VTRIN=$ORDER(^AUPNVTXR("AF",DFN,VST,SNO,VTRIN))
IF VTRIN=""
QUIT
Begin DoDot:3
+4 NEW REC,RECDFN
SET REC=$GET(^AUPNVTXR(VTRIN,0))
+5 IF REC=""
QUIT
+6 SET RECDFN=$PIECE(REC,U,2)
+7 IF RECDFN'=DFN
QUIT
+8 IF $PIECE(REC,U,4)'=PROB
QUIT
+9 ; -- DISCONTINUED
IF $PIECE(REC,U,5)=1
QUIT
+10 SET CPLVTR(VTRIN)=""
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
CPLVED(DATA,DFN,PROB,CNT) ;
+1 IF $GET(VVISIT)=""
QUIT
+2 SET VED=""
FOR
SET VED=$ORDER(^AUPNVPED("AC",DFN,VED))
IF VED=""
QUIT
Begin DoDot:1
+3 NEW REC,RECDFN
SET REC=$GET(^AUPNVPED(VED,0))
+4 IF REC=""
QUIT
+5 SET RECDFN=$PIECE(REC,U,2)
+6 IF RECDFN'=DFN
QUIT
+7 IF $PIECE(REC,U,3)'=VVISIT
QUIT
+8 SET CPLVED(VED)=""
SET CNT=CNT+1
End DoDot:1
+9 QUIT
+10 ;
CPLCON(DATA,DFN,PROB,CNT) ;
+1 SET CONIEN=""
+2 FOR
SET CONIEN=$ORDER(^GMR(123,"I",PROB,CONIEN),-1)
IF '+CONIEN
QUIT
Begin DoDot:1
+3 NEW REC,RECDFN
SET REC=$GET(^GMR(123,CONIEN,0))
+4 IF REC=""
QUIT
+5 SET RECDFN=$PIECE(REC,U,2)
+6 IF RECDFN'=DFN
QUIT
+7 SET CPLCON(CONIEN)=""
SET CNT=CNT+1
End DoDot:1
+8 QUIT
+9 ;
GETDATA ;
+1 KILL CPLERR
+2 DO GETS^DIQ(FNUM,IEN_",","**","E","CPLARR","CPLERR")
+3 IF $DATA(CPLERR)
Begin DoDot:1
+4 SET @TARGET@(1,0)="Server error: "_$GET(FNUM)_$GET(CPLERR("DIERR",1))_U_$GET(CPLERR("DIERR",1,"TEXT",1))
End DoDot:1
QUIT "~@"_$NAME(@TARGET)
+5 QUIT
+6 ;
TMPGBL(X) ;EP
+1 KILL ^TMP("BTIUCPL",$JOB)
QUIT $NAME(^($JOB))
