Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTIUPLAN

BTIUPLAN.m

Go to the documentation of this file.
  1. 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
  1. ;Obects for entries from Care Plan file
  1. Q
  1. ;
  1. CPDT(DFN,TARGET,TYPE) ;Active Care Plans by Date
  1. N ARRAY,INVDT,IEN,VCNT,CNT,EDATE,EDTE,SIGN,SIGNDT,STAT,NARR,X,PCNT
  1. K @TARGET
  1. S CNT=0,PCNT=0,EDATE=0
  1. D GETPROB(.ARRAY,DFN,TYPE)
  1. S X=""
  1. F S X=$O(ARRAY(X)) Q:X="" D
  1. .;S EDATE=9999999-X
  1. .;S EDATE=$$FMTE^XLFDT(EDATE,5)
  1. .;S CNT=CNT+1
  1. .;S @TARGET@(CNT,0)="Date: "_EDATE
  1. .S Y="" F S Y=$O(ARRAY(X,Y)) Q:Y="" D
  1. ..S PRIEN=$P(ARRAY(X,Y),U,2)
  1. ..S EDTE=$P(ARRAY(X,Y),U,7)
  1. ..I EDATE'=$P(EDTE,".",1) D
  1. ...S CNT=CNT+1
  1. ...S @TARGET@(CNT,0)="Date: "_$$FMTE^XLFDT($P(EDTE,".",1),5)
  1. ...S EDATE=$P(EDTE,".",1)
  1. ..S STAT=$$GET1^DIQ(9000011,PRIEN,.12)
  1. ..S PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
  1. ..S CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
  1. ..S SIGN=$P(ARRAY(X,Y),U,4)
  1. ..S SIGNDT=$P(ARRAY(X,Y),U,6)
  1. ..S CNT=CNT+1,PCNT=PCNT+1
  1. ..S @TARGET@(CNT,0)=$J(PCNT,2)_")"_PNAR
  1. ..S CNT=CNT+1
  1. ..S @TARGET@(CNT,0)=" - Problem Status: "_STAT
  1. ..;S CNT=CNT+1
  1. ..;S @TARGET@(CNT,0)=" ("_$P(ARRAY(X,Y),U,6)_" by "_$P(ARRAY(X,Y),U,4)_")"
  1. ..S CNT=CNT+1
  1. ..S @TARGET@(CNT,0)=" - TEXT"
  1. ..S CPIEN=$P(ARRAY(X,Y),U,3)
  1. ..D TEXT^BTIUPV1(TYPE,CPIEN)
  1. I CNT=0 S @TARGET@(1,0)="No Care Plans found of type "_$S(TYPE="G":"Goal",1:"Care Plan")
  1. Q "~@"_$NA(@TARGET)
  1. ;
  1. GETPROB(ARRAY,DFN,TYPE) ;EP
  1. ;Start by finding the patient's problems
  1. N PRIEN,REC,REC8,CONCT,PNAR,STAT,VCNT
  1. S VCNT=0,PRIEN=""
  1. F S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN D
  1. .S REC=$G(^AUPNPROB(PRIEN,0))
  1. .S STAT=$P(REC,U,12)
  1. .Q:STAT="D"!(STAT="I") ;Only doing active problems
  1. .D GETP(.ARRAY,PRIEN,TYPE)
  1. Q
  1. GETP(ARRAY,PRIEN,TYPE) ;Return data
  1. N INVDT,STATUS,CPIEN,SIEN,DATA
  1. S CPIEN="",DATA=""
  1. F S CPIEN=$O(^AUPNCPL("APT",PRIEN,TYPE,CPIEN)) Q:CPIEN="" D
  1. .S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
  1. .S STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
  1. .Q:STATUS'="A"
  1. .S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
  1. .S DATA=$$DATA(CPIEN,SIEN)
  1. .Q:DATA=""
  1. .S VCNT=VCNT+1
  1. .S ARRAY($P(INVDT,".",1),VCNT)=INVDT_U_PRIEN_U_DATA
  1. Q
  1. ;
  1. DATA(CPIEN,SIEN) ;Get data for this item
  1. N BY,WHEN,LIEN,TXT,TXTIEN,PTYPE,SIGNED,PROB,SIG,FNUM,NODE,EVDT
  1. S FNUM=9000092.11
  1. S SIGNED=0
  1. S SIGNED=$P($G(^AUPNCPL(CPIEN,0)),U,7)
  1. S EVDT=$P($G(^AUPNCPL(CPIEN,0)),U,5)
  1. Q:(SIGNED="")&(DUZ'=$$GET1^DIQ(9000092,CPIEN,.03,"I")) ""
  1. S NODE=$G(^AUPNCPL(CPIEN,11,SIEN,0))
  1. S LIEN=SIEN_","_CPIEN
  1. S WHEN=$$GET1^DIQ(FNUM,LIEN,.03,"I")
  1. S WHEN=$$FMTDATE^BGOUTL(WHEN)
  1. S BY=$$GET1^DIQ(9000092,CPIEN,.07,"E")
  1. S STAT=$$GET1^DIQ(FNUM,LIEN,.01,"I")
  1. Q:STAT'="A"
  1. S SIG=$$GET1^DIQ(9000092,CPIEN,.08,"I")
  1. I SIG'="" S SIG=$$FMTDATE^BGOUTL(SIG)
  1. Q CPIEN_U_BY_U_WHEN_U_SIG_U_EVDT
  1. ;
  1. TEXT(CPIEN) ;do the text
  1. N TXTIEN
  1. S TXTIEN=0 F S TXTIEN=$O(^AUPNCPL(CPIEN,12,TXTIEN)) Q:'+TXTIEN D
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" "_$G(^AUPNCPL(CPIEN,12,TXTIEN,0))
  1. S CNT=CNT+1
  1. S @TARGET@(CNT,0)=""
  1. Q
  1. CPPR(DFN,TARGET,TYPE) ;Active Care plans by problem
  1. N ARRAY,INVDT,VCNT,CNT,STAT,NARR,X,Y,SIGN,SIGNDT
  1. K @TARGET
  1. S CNT=0,ARRAY=""
  1. D GETPROB2(.ARRAY,DFN,TYPE)
  1. S X="" F S X=$O(ARRAY(X)) Q:X="" D
  1. .S PRIEN=X
  1. .S STAT=$$GET1^DIQ(9000011,PRIEN,.12)
  1. .S PNAR=$$GET1^DIQ(9000011,PRIEN,.05)
  1. .S CONCT=$$GET1^DIQ(9000011,PRIEN,80001)
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)="Problem: "_PNAR
  1. .S CNT=CNT+1
  1. .S @TARGET@(CNT,0)=" - Problem Status: "_STAT
  1. .;S CNT=CNT+1
  1. .;S @TARGET@(CNT,0)=""
  1. .S Z="" F S Z=$O(ARRAY(X,Z)) Q:Z="" D
  1. ..S Y="" F S Y=$O(ARRAY(X,Z,Y)) Q:Y="" D
  1. ...S EDATE=9999999-$P(ARRAY(X,Z,Y),U,2)
  1. ...S EDATE=$$FMTE^XLFDT(EDATE,5)
  1. ...S SIGN=$P(ARRAY(X,Z,Y),U,4)
  1. ...S SIGNDT=$P(ARRAY(X,Z,Y),U,6)
  1. ...S CNT=CNT+1
  1. ...S @TARGET@(CNT,0)=" - Date: "_EDATE
  1. ...;S CNT=CNT+1
  1. ...;S @TARGET@(CNT,0)=" - Signed: "_$P(ARRAY(X,Y),U,4)_" on "_$P(ARRAY(X,Y),U,6)
  1. ...S CNT=CNT+1
  1. ...S @TARGET@(CNT,0)=" - TEXT"
  1. ...S CPIEN=$P(ARRAY(X,Z,Y),U,3)
  1. ...D TEXT^BTIUPV1(TYPE,CPIEN)
  1. I CNT=0 S @TARGET@(1,0)="No Care Plans found of type "_$S(TYPE="G":"Goal",1:"Care Plan")
  1. Q "~@"_$NA(@TARGET)
  1. ;
  1. GETPROB2(ARRAY,DFN,TYPE) ;EP
  1. ;Start by finding the patient's problems
  1. N PRIEN,REC,CONCT,PNAR,STAT,VCNT
  1. S PRIEN="",VCNT=0
  1. F S PRIEN=$O(^AUPNPROB("AC",DFN,PRIEN)) Q:'PRIEN D
  1. .S REC=$G(^AUPNPROB(PRIEN,0))
  1. .S STAT=$P(REC,U,12)
  1. .Q:STAT="D"!(STAT="I") ;Only doing active problems
  1. .D GETPL(.ARRAY,PRIEN,TYPE)
  1. Q
  1. GETPL(ARRAY,PRIEN,TYPE) ;Return data
  1. N INVDT,STATUS,CPIEN,SIEN,DATA
  1. S CPIEN="",DATA=""
  1. F S CPIEN=$O(^AUPNCPL("APT",PRIEN,TYPE,CPIEN)) Q:CPIEN="" D
  1. .S SIEN=$C(0) S SIEN=$O(^AUPNCPL(CPIEN,11,SIEN),-1)
  1. .S STATUS=$P($G(^AUPNCPL(CPIEN,11,SIEN,0)),U,1)
  1. .Q:STATUS'="A"
  1. .S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
  1. .S DATA=$$DATA(CPIEN,SIEN)
  1. .Q:DATA=""
  1. .S VCNT=VCNT+1
  1. .S ARRAY(PRIEN,INVDT,VCNT)=PRIEN_U_INVDT_U_DATA
  1. Q