BHSPLST2 ;IHS/MSC/MGH - Health Summary for Problem list;04-Jan-2016 10:17;DU
;;1.0;HEALTH SUMMARY COMPONENTS;**13**;Mar 17,2006;Build 6
; IHS/CMI/LAB - PART 4 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;31-Mar-2014 16:53;DU
;
ICPR(DFN,TARGET,TYPE,ACTIVE) ;Care plans by problem
N ARRAY,INVDT,VCNT,CNT,STAT,NARR,X,Y,Z,SIGN,SIGNDT,CDTE,EDATE
K @TARGET
S CNT=0,ARRAY="",ACTIVE=$G(ACTIVE)
D GETPROB2(.ARRAY,DFN,TYPE,ACTIVE)
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 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 CDTE=$P(ARRAY(X,Z,Y),U,8)
...S CNT=CNT+1
...S @TARGET@(CNT,0)=" - Date: "_EDATE
...S CNT=CNT+1
...S @TARGET@(CNT,0)=" - TEXT Status: "_CDTE
...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,ACTIVE) ;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,ACTIVE)
Q
GETPL(ARRAY,PRIEN,TYPE,ACTIVE) ;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) Q:'+SIEN D
..S STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
..Q:ACTIVE="I"&(STATUS="A")
..Q:STATUS="E"
..S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
..S DATA=$$DATA(CPIEN,SIEN,ACTIVE)
..Q:DATA=""
..S VCNT=VCNT+1
..S ARRAY(PRIEN,INVDT,VCNT)=PRIEN_U_INVDT_U_DATA
Q
DATA(CPIEN,SIEN,ACTIVE) ;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:ACTIVE="I"&(STAT="A") ""
Q:STAT="E" ""
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_U_STAT
BHSPLST2 ;IHS/MSC/MGH - Health Summary for Problem list;04-Jan-2016 10:17;DU
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**13**;Mar 17,2006;Build 6
+2 ; IHS/CMI/LAB - PART 4 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;31-Mar-2014 16:53;DU
+3 ;
ICPR(DFN,TARGET,TYPE,ACTIVE) ;Care plans by problem
+1 NEW ARRAY,INVDT,VCNT,CNT,STAT,NARR,X,Y,Z,SIGN,SIGNDT,CDTE,EDATE
+2 KILL @TARGET
+3 SET CNT=0
SET ARRAY=""
SET ACTIVE=$GET(ACTIVE)
+4 DO GETPROB2(.ARRAY,DFN,TYPE,ACTIVE)
+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 SET Z=""
FOR
SET Z=$ORDER(ARRAY(X,Z))
IF Z=""
QUIT
Begin DoDot:2
+15 SET Y=""
FOR
SET Y=$ORDER(ARRAY(X,Z,Y))
IF Y=""
QUIT
Begin DoDot:3
+16 SET EDATE=9999999-$PIECE(ARRAY(X,Z,Y),U,2)
+17 SET EDATE=$$FMTE^XLFDT(EDATE,5)
+18 SET SIGN=$PIECE(ARRAY(X,Z,Y),U,4)
+19 SET SIGNDT=$PIECE(ARRAY(X,Z,Y),U,6)
+20 SET CDTE=$PIECE(ARRAY(X,Z,Y),U,8)
+21 SET CNT=CNT+1
+22 SET @TARGET@(CNT,0)=" - Date: "_EDATE
+23 SET CNT=CNT+1
+24 SET @TARGET@(CNT,0)=" - TEXT Status: "_CDTE
+25 SET CPIEN=$PIECE(ARRAY(X,Z,Y),U,3)
+26 DO TEXT^BTIUPV1(TYPE,CPIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+27 IF CNT=0
SET @TARGET@(1,0)="No Care Plans found of type "_$SELECT(TYPE="G":"Goal",1:"Care Plan")
+28 QUIT "~@"_$NAME(@TARGET)
+29 ;
GETPROB2(ARRAY,DFN,TYPE,ACTIVE) ;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,ACTIVE)
End DoDot:1
+9 QUIT
GETPL(ARRAY,PRIEN,TYPE,ACTIVE) ;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)
IF '+SIEN
QUIT
Begin DoDot:2
+5 SET STATUS=$PIECE($GET(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
+6 IF ACTIVE="I"&(STATUS="A")
QUIT
+7 IF STATUS="E"
QUIT
+8 SET INVDT=9999999-$PIECE($GET(^AUPNCPL(CPIEN,0)),U,5)
+9 SET DATA=$$DATA(CPIEN,SIEN,ACTIVE)
+10 IF DATA=""
QUIT
+11 SET VCNT=VCNT+1
+12 SET ARRAY(PRIEN,INVDT,VCNT)=PRIEN_U_INVDT_U_DATA
End DoDot:2
End DoDot:1
+13 QUIT
DATA(CPIEN,SIEN,ACTIVE) ;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 ACTIVE="I"&(STAT="A")
QUIT ""
+14 IF STAT="E"
QUIT ""
+15 SET SIG=$$GET1^DIQ(9000092,CPIEN,.08,"I")
+16 IF SIG'=""
SET SIG=$$FMTDATE^BGOUTL(SIG)
+17 QUIT CPIEN_U_BY_U_WHEN_U_SIG_U_EVDT_U_STAT
