- 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