BTIUPLAN ; IHS/MSC/MGH - Problem/Visit Objects ;06-Jan-2015 12:50;du
;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
;Obects for entries from Care Plan file
Q
;
CPDT(DFN,TARGET,TYPE) ;Active Care Plans by Date
N ARRAY,INVDT,IEN,VCNT,CNT,EDATE,EDTE,SIGN,SIGNDT,STAT,NARR,X,PCNT
K @TARGET
S CNT=0,PCNT=0,EDATE=0
D GETPROB(.ARRAY,DFN,TYPE)
S X=""
F S X=$O(ARRAY(X)) Q:X="" D
.;S EDATE=9999999-X
.;S EDATE=$$FMTE^XLFDT(EDATE,5)
.;S CNT=CNT+1
.;S @TARGET@(CNT,0)="Date: "_EDATE
.S Y="" F S Y=$O(ARRAY(X,Y)) Q:Y="" D
..S PRIEN=$P(ARRAY(X,Y),U,2)
..S EDTE=$P(ARRAY(X,Y),U,7)
..I EDATE'=$P(EDTE,".",1) D
...S CNT=CNT+1
...S @TARGET@(CNT,0)="Date: "_$$FMTE^XLFDT($P(EDTE,".",1),5)
...S EDATE=$P(EDTE,".",1)
..S STAT=$$GET1^DIQ(9000011,PRIEN,.12)
..S PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
..S CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
..S SIGN=$P(ARRAY(X,Y),U,4)
..S SIGNDT=$P(ARRAY(X,Y),U,6)
..S CNT=CNT+1,PCNT=PCNT+1
..S @TARGET@(CNT,0)=$J(PCNT,2)_")"_PNAR
..S CNT=CNT+1
..S @TARGET@(CNT,0)=" - Problem Status: "_STAT
..;S CNT=CNT+1
..;S @TARGET@(CNT,0)=" ("_$P(ARRAY(X,Y),U,6)_" by "_$P(ARRAY(X,Y),U,4)_")"
..S CNT=CNT+1
..S @TARGET@(CNT,0)=" - TEXT"
..S CPIEN=$P(ARRAY(X,Y),U,3)
..D TEXT^BTIUPV1(TYPE,CPIEN)
I CNT=0 S @TARGET@(1,0)="No Care Plans found of type "_$S(TYPE="G":"Goal",1:"Care Plan")
Q "~@"_$NA(@TARGET)
;
GETPROB(ARRAY,DFN,TYPE) ;EP
;Start by finding the patient's problems
N PRIEN,REC,REC8,CONCT,PNAR,STAT,VCNT
S VCNT=0,PRIEN=""
F S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN D
.S REC=$G(^AUPNPROB(PRIEN,0))
.S STAT=$P(REC,U,12)
.Q:STAT="D"!(STAT="I") ;Only doing active problems
.D GETP(.ARRAY,PRIEN,TYPE)
Q
GETP(ARRAY,PRIEN,TYPE) ;Return data
N INVDT,STATUS,CPIEN,SIEN,DATA
S CPIEN="",DATA=""
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 STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
.Q:STATUS'="A"
.S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
.S DATA=$$DATA(CPIEN,SIEN)
.Q:DATA=""
.S VCNT=VCNT+1
.S ARRAY($P(INVDT,".",1),VCNT)=INVDT_U_PRIEN_U_DATA
Q
;
DATA(CPIEN,SIEN) ;Get data for this item
N BY,WHEN,LIEN,TXT,TXTIEN,PTYPE,SIGNED,PROB,SIG,FNUM,NODE,EVDT
S FNUM=9000092.11
S SIGNED=0
S SIGNED=$P($G(^AUPNCPL(CPIEN,0)),U,7)
S EVDT=$P($G(^AUPNCPL(CPIEN,0)),U,5)
Q:(SIGNED="")&(DUZ'=$$GET1^DIQ(9000092,CPIEN,.03,"I")) ""
S NODE=$G(^AUPNCPL(CPIEN,11,SIEN,0))
S LIEN=SIEN_","_CPIEN
S WHEN=$$GET1^DIQ(FNUM,LIEN,.03,"I")
S WHEN=$$FMTDATE^BGOUTL(WHEN)
S BY=$$GET1^DIQ(9000092,CPIEN,.07,"E")
S STAT=$$GET1^DIQ(FNUM,LIEN,.01,"I")
Q:STAT'="A"
S SIG=$$GET1^DIQ(9000092,CPIEN,.08,"I")
I SIG'="" S SIG=$$FMTDATE^BGOUTL(SIG)
Q CPIEN_U_BY_U_WHEN_U_SIG_U_EVDT
;
TEXT(CPIEN) ;do the text
N TXTIEN
S TXTIEN=0 F S TXTIEN=$O(^AUPNCPL(CPIEN,12,TXTIEN)) Q:'+TXTIEN D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=" "_$G(^AUPNCPL(CPIEN,12,TXTIEN,0))
S CNT=CNT+1
S @TARGET@(CNT,0)=""
Q
CPPR(DFN,TARGET,TYPE) ;Active Care plans by problem
N ARRAY,INVDT,VCNT,CNT,STAT,NARR,X,Y,SIGN,SIGNDT
K @TARGET
S CNT=0,ARRAY=""
D GETPROB2(.ARRAY,DFN,TYPE)
S X="" F S X=$O(ARRAY(X)) Q:X="" D
.S PRIEN=X
.S STAT=$$GET1^DIQ(9000011,PRIEN,.12)
.S PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
.S CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
.S CNT=CNT+1
.S @TARGET@(CNT,0)="Problem: "_PNAR
.S CNT=CNT+1
.S @TARGET@(CNT,0)=" - Problem Status: "_STAT
.;S CNT=CNT+1
.;S @TARGET@(CNT,0)=""
.S Z="" F S Z=$O(ARRAY(X,Z)) Q:Z="" D
..S Y="" F S Y=$O(ARRAY(X,Z,Y)) Q:Y="" D
...S EDATE=9999999-$P(ARRAY(X,Z,Y),U,2)
...S EDATE=$$FMTE^XLFDT(EDATE,5)
...S SIGN=$P(ARRAY(X,Z,Y),U,4)
...S SIGNDT=$P(ARRAY(X,Z,Y),U,6)
...S CNT=CNT+1
...S @TARGET@(CNT,0)=" - Date: "_EDATE
...;S CNT=CNT+1
...;S @TARGET@(CNT,0)=" - Signed: "_$P(ARRAY(X,Y),U,4)_" on "_$P(ARRAY(X,Y),U,6)
...S CNT=CNT+1
...S @TARGET@(CNT,0)=" - TEXT"
...S CPIEN=$P(ARRAY(X,Z,Y),U,3)
...D TEXT^BTIUPV1(TYPE,CPIEN)
I CNT=0 S @TARGET@(1,0)="No Care Plans found of type "_$S(TYPE="G":"Goal",1:"Care Plan")
Q "~@"_$NA(@TARGET)
;
GETPROB2(ARRAY,DFN,TYPE) ;EP
;Start by finding the patient's problems
N PRIEN,REC,CONCT,PNAR,STAT,VCNT
S PRIEN="",VCNT=0
F S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN D
.S REC=$G(^AUPNPROB(PRIEN,0))
.S STAT=$P(REC,U,12)
.Q:STAT="D"!(STAT="I") ;Only doing active problems
.D GETPL(.ARRAY,PRIEN,TYPE)
Q
GETPL(ARRAY,PRIEN,TYPE) ;Return data
N INVDT,STATUS,CPIEN,SIEN,DATA
S CPIEN="",DATA=""
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 STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
.Q:STATUS'="A"
.S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
.S DATA=$$DATA(CPIEN,SIEN)
.Q:DATA=""
.S VCNT=VCNT+1
.S ARRAY(PRIEN,INVDT,VCNT)=PRIEN_U_INVDT_U_DATA
Q
BTIUPLAN ; IHS/MSC/MGH - Problem/Visit Objects ;06-Jan-2015 12:50;du
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**1012,1013**;MAR 20, 2013;Build 33
+2 ;Obects for entries from Care Plan file
+3 QUIT
+4 ;
CPDT(DFN,TARGET,TYPE) ;Active Care Plans by Date
+1 NEW ARRAY,INVDT,IEN,VCNT,CNT,EDATE,EDTE,SIGN,SIGNDT,STAT,NARR,X,PCNT
+2 KILL @TARGET
+3 SET CNT=0
SET PCNT=0
SET EDATE=0
+4 DO GETPROB(.ARRAY,DFN,TYPE)
+5 SET X=""
+6 FOR
SET X=$ORDER(ARRAY(X))
IF X=""
QUIT
Begin DoDot:1
+7 ;S EDATE=9999999-X
+8 ;S EDATE=$$FMTE^XLFDT(EDATE,5)
+9 ;S CNT=CNT+1
+10 ;S @TARGET@(CNT,0)="Date: "_EDATE
+11 SET Y=""
FOR
SET Y=$ORDER(ARRAY(X,Y))
IF Y=""
QUIT
Begin DoDot:2
+12 SET PRIEN=$PIECE(ARRAY(X,Y),U,2)
+13 SET EDTE=$PIECE(ARRAY(X,Y),U,7)
+14 IF EDATE'=$PIECE(EDTE,".",1)
Begin DoDot:3
+15 SET CNT=CNT+1
+16 SET @TARGET@(CNT,0)="Date: "_$$FMTE^XLFDT($PIECE(EDTE,".",1),5)
+17 SET EDATE=$PIECE(EDTE,".",1)
End DoDot:3
+18 SET STAT=$$GET1^DIQ(9000011,PRIEN,.12)
+19 SET PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
+20 SET CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
+21 SET SIGN=$PIECE(ARRAY(X,Y),U,4)
+22 SET SIGNDT=$PIECE(ARRAY(X,Y),U,6)
+23 SET CNT=CNT+1
SET PCNT=PCNT+1
+24 SET @TARGET@(CNT,0)=$JUSTIFY(PCNT,2)_")"_PNAR
+25 SET CNT=CNT+1
+26 SET @TARGET@(CNT,0)=" - Problem Status: "_STAT
+27 ;S CNT=CNT+1
+28 ;S @TARGET@(CNT,0)=" ("_$P(ARRAY(X,Y),U,6)_" by "_$P(ARRAY(X,Y),U,4)_")"
+29 SET CNT=CNT+1
+30 SET @TARGET@(CNT,0)=" - TEXT"
+31 SET CPIEN=$PIECE(ARRAY(X,Y),U,3)
+32 DO TEXT^BTIUPV1(TYPE,CPIEN)
End DoDot:2
End DoDot:1
+33 IF CNT=0
SET @TARGET@(1,0)="No Care Plans found of type "_$SELECT(TYPE="G":"Goal",1:"Care Plan")
+34 QUIT "~@"_$NAME(@TARGET)
+35 ;
GETPROB(ARRAY,DFN,TYPE) ;EP
+1 ;Start by finding the patient's problems
+2 NEW PRIEN,REC,REC8,CONCT,PNAR,STAT,VCNT
+3 SET VCNT=0
SET PRIEN=""
+4 FOR
SET PRIEN=$ORDER(^AUPNPROB("AC",DFN,PRIEN))
IF 'PRIEN
QUIT
Begin DoDot:1
+5 SET REC=$GET(^AUPNPROB(PRIEN,0))
+6 SET STAT=$PIECE(REC,U,12)
+7 ;Only doing active problems
IF STAT="D"!(STAT="I")
QUIT
+8 DO GETP(.ARRAY,PRIEN,TYPE)
End DoDot:1
+9 QUIT
GETP(ARRAY,PRIEN,TYPE) ;Return data
+1 NEW INVDT,STATUS,CPIEN,SIEN,DATA
+2 SET CPIEN=""
SET DATA=""
+3 FOR
SET CPIEN=$ORDER(^AUPNCPL("APT",PRIEN,TYPE,CPIEN))
IF CPIEN=""
QUIT
Begin DoDot:1
+4 SET SIEN=$CHAR(0)
SET SIEN=$ORDER(^AUPNCPL(CPIEN,11,SIEN),-1)
+5 SET STATUS=$PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
+6 IF STATUS'="A"
QUIT
+7 SET INVDT=9999999-$PIECE($GET(^AUPNCPL(CPIEN,0)),U,5)
+8 SET DATA=$$DATA(CPIEN,SIEN)
+9 IF DATA=""
QUIT
+10 SET VCNT=VCNT+1
+11 SET ARRAY($PIECE(INVDT,".",1),VCNT)=INVDT_U_PRIEN_U_DATA
End DoDot:1
+12 QUIT
+13 ;
DATA(CPIEN,SIEN) ;Get data for this item
+1 NEW BY,WHEN,LIEN,TXT,TXTIEN,PTYPE,SIGNED,PROB,SIG,FNUM,NODE,EVDT
+2 SET FNUM=9000092.11
+3 SET SIGNED=0
+4 SET SIGNED=$PIECE($GET(^AUPNCPL(CPIEN,0)),U,7)
+5 SET EVDT=$PIECE($GET(^AUPNCPL(CPIEN,0)),U,5)
+6 IF (SIGNED="")&(DUZ'=$$GET1^DIQ(9000092,CPIEN,.03,"I"))
QUIT ""
+7 SET NODE=$GET(^AUPNCPL(CPIEN,11,SIEN,0))
+8 SET LIEN=SIEN_","_CPIEN
+9 SET WHEN=$$GET1^DIQ(FNUM,LIEN,.03,"I")
+10 SET WHEN=$$FMTDATE^BGOUTL(WHEN)
+11 SET BY=$$GET1^DIQ(9000092,CPIEN,.07,"E")
+12 SET STAT=$$GET1^DIQ(FNUM,LIEN,.01,"I")
+13 IF STAT'="A"
QUIT
+14 SET SIG=$$GET1^DIQ(9000092,CPIEN,.08,"I")
+15 IF SIG'=""
SET SIG=$$FMTDATE^BGOUTL(SIG)
+16 QUIT CPIEN_U_BY_U_WHEN_U_SIG_U_EVDT
+17 ;
TEXT(CPIEN) ;do the text
+1 NEW TXTIEN
+2 SET TXTIEN=0
FOR
SET TXTIEN=$ORDER(^AUPNCPL(CPIEN,12,TXTIEN))
IF '+TXTIEN
QUIT
Begin DoDot:1
+3 SET CNT=CNT+1
+4 SET @TARGET@(CNT,0)=" "_$GET(^AUPNCPL(CPIEN,12,TXTIEN,0))
End DoDot:1
+5 SET CNT=CNT+1
+6 SET @TARGET@(CNT,0)=""
+7 QUIT
CPPR(DFN,TARGET,TYPE) ;Active Care plans by problem
+1 NEW ARRAY,INVDT,VCNT,CNT,STAT,NARR,X,Y,SIGN,SIGNDT
+2 KILL @TARGET
+3 SET CNT=0
SET ARRAY=""
+4 DO GETPROB2(.ARRAY,DFN,TYPE)
+5 SET X=""
FOR
SET X=$ORDER(ARRAY(X))
IF X=""
QUIT
Begin DoDot:1
+6 SET PRIEN=X
+7 SET STAT=$$GET1^DIQ(9000011,PRIEN,.12)
+8 SET PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
+9 SET CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
+10 SET CNT=CNT+1
+11 SET @TARGET@(CNT,0)="Problem: "_PNAR
+12 SET CNT=CNT+1
+13 SET @TARGET@(CNT,0)=" - Problem Status: "_STAT
+14 ;S CNT=CNT+1
+15 ;S @TARGET@(CNT,0)=""
+16 SET Z=""
FOR
SET Z=$ORDER(ARRAY(X,Z))
IF Z=""
QUIT
Begin DoDot:2
+17 SET Y=""
FOR
SET Y=$ORDER(ARRAY(X,Z,Y))
IF Y=""
QUIT
Begin DoDot:3
+18 SET EDATE=9999999-$PIECE(ARRAY(X,Z,Y),U,2)
+19 SET EDATE=$$FMTE^XLFDT(EDATE,5)
+20 SET SIGN=$PIECE(ARRAY(X,Z,Y),U,4)
+21 SET SIGNDT=$PIECE(ARRAY(X,Z,Y),U,6)
+22 SET CNT=CNT+1
+23 SET @TARGET@(CNT,0)=" - Date: "_EDATE
+24 ;S CNT=CNT+1
+25 ;S @TARGET@(CNT,0)=" - Signed: "_$P(ARRAY(X,Y),U,4)_" on "_$P(ARRAY(X,Y),U,6)
+26 SET CNT=CNT+1
+27 SET @TARGET@(CNT,0)=" - TEXT"
+28 SET CPIEN=$PIECE(ARRAY(X,Z,Y),U,3)
+29 DO TEXT^BTIUPV1(TYPE,CPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+30 IF CNT=0
SET @TARGET@(1,0)="No Care Plans found of type "_$SELECT(TYPE="G":"Goal",1:"Care Plan")
+31 QUIT "~@"_$NAME(@TARGET)
+32 ;
GETPROB2(ARRAY,DFN,TYPE) ;EP
+1 ;Start by finding the patient's problems
+2 NEW PRIEN,REC,CONCT,PNAR,STAT,VCNT
+3 SET PRIEN=""
SET VCNT=0
+4 FOR
SET PRIEN=$ORDER(^AUPNPROB("AC",DFN,PRIEN))
IF 'PRIEN
QUIT
Begin DoDot:1
+5 SET REC=$GET(^AUPNPROB(PRIEN,0))
+6 SET STAT=$PIECE(REC,U,12)
+7 ;Only doing active problems
IF STAT="D"!(STAT="I")
QUIT
+8 DO GETPL(.ARRAY,PRIEN,TYPE)
End DoDot:1
+9 QUIT
GETPL(ARRAY,PRIEN,TYPE) ;Return data
+1 NEW INVDT,STATUS,CPIEN,SIEN,DATA
+2 SET CPIEN=""
SET DATA=""
+3 FOR
SET CPIEN=$ORDER(^AUPNCPL("APT",PRIEN,TYPE,CPIEN))
IF CPIEN=""
QUIT
Begin DoDot:1
+4 SET SIEN=$CHAR(0)
SET SIEN=$ORDER(^AUPNCPL(CPIEN,11,SIEN),-1)
+5 SET STATUS=$PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
+6 IF STATUS'="A"
QUIT
+7 SET INVDT=9999999-$PIECE($GET(^AUPNCPL(CPIEN,0)),U,5)
+8 SET DATA=$$DATA(CPIEN,SIEN)
+9 IF DATA=""
QUIT
+10 SET VCNT=VCNT+1
+11 SET ARRAY(PRIEN,INVDT,VCNT)=PRIEN_U_INVDT_U_DATA
End DoDot:1
+12 QUIT
