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

BGOCPLAN.m

Go to the documentation of this file. 
  1. BGOCPLAN ; IHS/BAO/TMD - pull V Care Plan data ;27-Jan-2016 09:53;DU
  1.  ;;1.1;BGO COMPONENTS;**13,14,17,19**;Mar 20, 2007;Build 5
  1.  ;P14 changed to return time when entered
  1.  ;---------------------------------------------
  1. GET(DATA,IEN,DFN,TYPE,RETI,CNT,PRV) ;EP
  1.  ;Find the latest number of entries for each section using the
  1.  ;parameter and return them to the calling program
  1.  ;Input is IEN = Problem
  1.  ;         DFN = Patient
  1.  ;        TYPE = G(oal) or C(are Plan)
  1.  ;        RETI = Return types (A(active),C(complete),L(latest)
  1.  ;         CNT = Count
  1.  ;         PRV = Provider to look for data on
  1.  ;Ouput: Array in the format
  1.  ;Array(n)=Type (G OR C) [1] ^ C Plan IEN [2] ^ Prob IEN [4] ^ Who entered [4] ^ Date Entered [5] ^ Status [6] ^ SIGN FLAG [7]
  1.  ;          =~t [1] ^ Text of the item [2]
  1.  N GCNT,INVDT,NODE,FNUM,CODE,DONE,STA,STAT,SDATE,CPIEN,SIEN,SORT
  1.  S DONE=0,SDATE=0
  1.  I $G(RETI)="" S RETI="L"
  1.  I $G(DATA)="" S DATA=$$TMPGBL
  1.  I $G(CNT)="" S CNT=1
  1.  S PRV=$G(PRV)
  1.  I RETI="" S RETI="L"
  1.  S INVDT=""
  1.  S TYPE=$S(TYPE="C":"P",1:TYPE)
  1.  I PRV'="" D
  1.  .F  S INVDT=$O(^AUPNCPL("APTP",IEN,TYPE,PRV,INVDT)) Q:INVDT=""!(DONE=1)  D
  1.  ..S CPIEN="" F  S CPIEN=$O(^AUPNCPL("APTP",IEN,TYPE,PRV,INVDT,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="E"
  1.  ...Q:(STATUS="R")&(RETI'="C")
  1.  ...S SORT(INVDT,CPIEN,SIEN)=""
  1.  ...;D DATA(.DATA,CPIEN,SIEN)
  1.  .D DATA(.DATA,.SORT)
  1.  I PRV="" D
  1.  .S CPIEN="" F  S CPIEN=$O(^AUPNCPL("APT",IEN,TYPE,CPIEN)) Q:CPIEN=""!(DONE=1)  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="E"
  1.  ..Q:(STATUS="R")&(RETI'="C")
  1.  ..;D DATA(.DATA,CPIEN,SIEN)
  1.  ..S INVDT=9999999-$P($G(^AUPNCPL(CPIEN,0)),U,5)
  1.  ..S SORT(INVDT,CPIEN,SIEN)=""
  1.  .D DATA(.DATA,.SORT)
  1.  Q
  1. IEN(DATA) ;FIND IEN
  1.  Q:STATUS="E"
  1.  I RETI="C"!(STATUS="A"&((RETI="A")!(RETI="L"))) D
  1.  .S CPIEN="" S CPIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN)) Q:CPIEN=""  D
  1.  ..S SIEN="" F  S SIEN=$O(^AUPNCPL("ASDT",IEN,TYPE,INVDT,STATUS,CPIEN,SIEN),-1) Q:SIEN=""  D
  1.  ..S SORT(INVDT,CPIEN,SIEN)=""
  1.  .D DATA(.DATA,.SORT)
  1.  Q
  1. DATA(DATA,SORT) ;Get data for this item
  1.  N INVDT,CPIEN,SIEN
  1.  S INVDT="" F  S INVDT=$O(SORT(INVDT)) Q:INVDT=""  D
  1.  .S CPIEN="" F  S CPIEN=$O(SORT(INVDT,CPIEN)) Q:CPIEN=""  D
  1.  ..S SIEN="" F  S SIEN=$O(SORT(INVDT,CPIEN,SIEN)) Q:SIEN=""  D
  1.  ...D DATA1(.DATA,CPIEN,SIEN)
  1.  Q
  1. DATA1(DATA,CPIEN,SIEN) ;Get data for one plan
  1.  N BY,WHEN,LIEN,TXT,TXTIEN,PTYPE,SIGNED,PROB,SIG
  1.  S FNUM=9000092.11
  1.  S SIGNED=0
  1.  S SIGNED=$P($G(^AUPNCPL(CPIEN,0)),U,7)
  1.  ;Q:(SIGNED="")&(DUZ'=$$GET1^DIQ(9000092,CPIEN,.03,"I")) ;DKA 9/9/13 Don't filter out
  1.  S NODE=$G(^AUPNCPL(CPIEN,11,SIEN,0))
  1.  I SDATE=0 S SDATE=$P(INVDT,".",1)
  1.  I RETI="L"&(SDATE'=$P(INVDT,".",1)) S DONE=1
  1.  Q:+DONE
  1.  S CNT=CNT+1
  1.  S LIEN=SIEN_","_CPIEN
  1.  S WHEN=$$GET1^DIQ(FNUM,LIEN,.03,"I")
  1.  S WHEN=$$FMTDATE^BGOUTL(WHEN,1)
  1.  S BY=$$GET1^DIQ(FNUM,LIEN,.02,"E")
  1.  S STAT=$$GET1^DIQ(FNUM,LIEN,.01,"I")
  1.  S PTYPE=$S(TYPE="P":"C",1:"G")
  1.  S SIG=$$GET1^DIQ(9000092,CPIEN,.08,"I")
  1.  I SIG'="" S SIG=$$FMTDATE^BGOUTL(SIG)
  1.  ;S @DATA@(CNT)=PTYPE_U_CPIEN_U_IEN_U_BY_U_WHEN_U_STAT_U_SIGNED
  1.  S @DATA@(CNT)=PTYPE_U_CPIEN_U_IEN_U_BY_U_WHEN_U_STAT_U_SIG
  1.  S TXTIEN=0 F  S TXTIEN=$O(^AUPNCPL(CPIEN,12,TXTIEN)) Q:'+TXTIEN  D
  1.  .S CNT=CNT+1
  1.  .;IHS/MSC/MGH changed for carriage returns P17
  1.  .S @DATA@(CNT)="~t"_U_$TR($G(^AUPNCPL(CPIEN,12,TXTIEN,0)),$C(13,10))
  1.  Q
  1.  Q
  1.  ; Input Variables
  1.  ;   DFN     =   Patient
  1.  ;   PRIEN   =   problem this plan belongs to
  1.  ;   INP     =   G(goal) or P(Care plan)[1] ^ IEN [2] (blank if new) ^ EDT(event dt/time) [3] ^ Provider [4]
  1.  ;   STATUS  =   SIEN [1] ^ STATUS [2] ^ WHO ENTERED [3] ^ WHEN [4] ^ Old Item if replaced [5] ^ REASON EIE [6]^ REASON IF OTHER [7] ^ Comment [8]
  1.  ;   TEXT(n) =   Text of the item
  1. SET(RET,DFN,PRIEN,INP,STATUS,TEXT) ;EP
  1.  N FDA,IEN,FPNUM,CIEN,FNUM,IENS,PRNEW,PRIOR,SNOCT,DESCT,X,PIEN
  1.  N TYP,IEN,EDT,PRV,OLD,SIEN,WHO,WHEN,STAT,OLDIEN,NEWIEN,STAT2,X2
  1.  S FNUM=$$FNUM,RET="",ERR=0,OLD=""
  1.  I $G(PRIEN)="" S RET="1^No Problem was input and care planning cannot be saved" Q
  1.  S TYP=$S($P(INP,U,1)="C":"P",1:$P(INP,U,1))
  1.  S IEN=$P(INP,U,2),EDT=$P(INP,U,3),PRV=$P(INP,U,4)
  1.  ;IHS/MSC/MGH Fix for sending in a zero
  1.  I IEN=0 S IEN=""
  1.  I TYP="" S RET="1^A Care Planning type was not entered. Cannot save item" Q
  1.  S STAT=$P(STATUS,U,2)
  1.  I STAT="" S RET="1^No status was entered and care planning cannot be saved" Q
  1.  I IEN="" S CIEN="+1,"
  1.  E  S CIEN=IEN_","
  1.  I EDT="" S EDT=$$NOW^XLFDT
  1.  I PRV="" S PRV=DUZ
  1.  I $P(STATUS,U,4)'="" S OLD=$P(STATUS,U,5)
  1.  S FDA=$NA(FDA(FNUM,CIEN))
  1.  S @FDA@(.01)=PRIEN
  1.  S @FDA@(.02)=DFN
  1.  S @FDA@(.03)=PRV
  1.  S @FDA@(.04)=TYP
  1.  S @FDA@(.05)=EDT
  1.  S @FDA@(.06)=$$NOW^XLFDT
  1.  I OLD'="" S @FDA@(.09)=OLD
  1.  S RET=$$UPDATE^BGOUTL(.FDA,,.PIEN)
  1.  Q:RET
  1.  S:'IEN IEN=PIEN(1)
  1.  S:'RET RET=IEN
  1.  ;Add in the status multiple if it hasn't changed
  1.  S SIEN=$P(STATUS,U,1)
  1.  S X2=$C(0)
  1.  ;Find the latest status
  1.  S X2=$O(^AUPNCPL(IEN,11,X2),-1)
  1.  I X2'="" D
  1.  .S STAT2=$P($G(^AUPNCPL(IEN,11,X2,0)),U,1)
  1.  .I STAT'=STAT2 S SIEN=""     ;Add new entry if status changed
  1.  .E  S SIEN=X2
  1.  S WHO=$P(STATUS,U,3)
  1.  S WHEN=$P(STATUS,U,4)
  1.  I WHO="" S WHO=DUZ
  1.  I WHEN="" S WHEN=$$NOW^XLFDT
  1.  I SIEN="" S SIEN="+1,"_IEN_","
  1.  E  S SIEN=SIEN_","_IEN_","
  1.  N FDA,ERR,IEN2
  1.  S FDA(9000092.11,SIEN,.01)=STAT
  1.  S FDA(9000092.11,SIEN,.02)=WHO
  1.  S FDA(9000092.11,SIEN,.03)=WHEN
  1.  S FDA(9000092.11,SIEN,1)=$P(STATUS,U,8)
  1.  I STAT="E"!(STAT="ENTERED IN ERROR") D
  1.  .S FDA(9000092.11,SIEN,.04)=$P(STATUS,U,6)
  1.  .S FDA(9000091.11,SIEN,.05)=$P(STATUS,U,7)
  1.  D UPDATE^DIE(,"FDA","IEN2","ERR")
  1.  I $G(ERR("DIERR",1)) S RET=-ERR("DIERR",1)_U_ERR("DIERR",1,"TEXT",1) Q
  1.  ;Add in the text of the item if its not signed
  1.  I $$GET1^DIQ(9000092,IEN,.07)="" D
  1.  .N TXT,TCNT,I
  1.  .S TCNT=0
  1.  .S I="" F  S I=$O(TEXT(I)) Q:I=""  D
  1.  ..S TCNT=TCNT+1
  1.  ..S TXT(TCNT,0)=$G(TEXT(I))
  1.  .D WP^DIE(9000092,IEN_",",1200,,"TXT")
  1.  ;if replaced update original
  1.  I +OLD D UPDATE(OLD)
  1.  Q
  1. UPDATE(OLD) ;Update data
  1.  N OLDIEN,FDA,ERR,IEN2
  1.  S OLDIEN="+1,"_OLD_","
  1.  S FDA=$NA(FDA(FNUM,OLDIEN))
  1.  S FDA(9000092.11,OLDIEN,.01)="R"
  1.  S FDA(9000092.11,OLDIEN,.02)=WHO
  1.  S FDA(9000092.11,OLDIEN,.03)=WHEN
  1.  S FDA(9000092.11,OLDIEN,.06)=IEN
  1.  D UPDATE^DIE(,"FDA","IEN2","ERR")
  1.  Q
  1. LOOK(SNOMED) ;Lookup snomed term
  1.  N RET
  1.  S RET=$P($$DESC^BSTSAPI(SNOMED_"^^1"),U,2)
  1.  Q RET
  1.  ;Sign the plan
  1.  ;Input=IEN of the entry
  1.  ;Provider who is signing
  1. SIGN(RET,IEN,PRV) ;Sign the entry
  1.  N FNUM,FDA,IEN2,ERR,AIEN
  1.  S RET="",ERR=""
  1.  S AIEN=IEN_","
  1.  S FDA(9000092,AIEN,.07)=PRV
  1.  S FDA(9000092,AIEN,.08)=$$NOW^XLFDT
  1.  D FILE^DIE("","FDA","ERR")
  1.  I ERR S RET=-1_U_"Unable to sign Care Plan"
  1.  Q
  1.  ; Delete a Care Plan entry
  1. DEL(RET,PLAN) ;EP
  1.  N GBL
  1.  I $G(PLAN)="" S RET="-1^Care Plan number not entered" Q
  1.  I $$GET1^DIQ(9000092,PLAN,.07)'="" S RET="-1^Already signed" Q
  1.  S GBL=$$ROOT^DILFD($$FNUM,,1),RET=""
  1.  S FNUM=$$FNUM^BGOCPLAN
  1.  Q:'PLAN
  1.  I '$L(GBL) S RET=$$ERR^BGOUTL(1069) Q
  1.  S RET=$$DELETE^BGOUTL(FNUM,PLAN)
  1.  D:'RET VFEVT^BGOUTL2(FNUM,PLAN,2,X)
  1.  Q
  1. UPSTAT(RET,IEN,PROB,STAT,COMM) ;Change the status of a care plan or goal
  1.  N AIEN,FDA,ERR,SIEN,IEN2
  1.  S RET=""
  1.  S SIEN="+1,"_IEN_","
  1.  S FDA(9000092.11,SIEN,.01)=STAT
  1.  S FDA(9000092.11,SIEN,.02)=DUZ
  1.  S FDA(9000092.11,SIEN,.03)=$$NOW^XLFDT
  1.  ;S FDA(9000092.11,SIEN,1)=COMM
  1.  S:$G(COMM)'="" FDA(9000092.11,SIEN,1)=COMM  ;2013-09-10 DKA P13 Allow blank comment
  1.  D UPDATE^DIE(,"FDA","IEN2","ERR")
  1.  I $D(ERR)>0 S RET="-1^Unable to update status"
  1.  Q
  1.  ;Input parameter
  1.  ;INP= Problem ien [1] ^ Reason for eie [2] ^ comment if other [3]
  1. EIE(RET,INP) ;Mark an entry entered in error
  1.  N FNUM,IEN2,FDA,IEN,REASON,CMMT,IENS,RET
  1.  S RET=""
  1.  S IENS=$P(INP,U,1)
  1.  S REASON=$P(INP,U,2)
  1.  S CMMT=$P(INP,U,3)
  1.  S FNUM=9000092.11
  1.  S IEN2="+1,"_IENS_","
  1.  S FDA=$NA(FDA(FNUM,IEN2))
  1.  S @FDA@(.01)="E"
  1.  S @FDA@(.02)=DUZ
  1.  S @FDA@(.03)=$$NOW^XLFDT()
  1.  S @FDA@(.04)=REASON
  1.  S @FDA@(.04)=CMMT
  1.  S RET=$$UPDATE^BGOUTL(.FDA,,.IEN)
  1.  Q
  1.  ;EIE can only be done by the author or the chief of MIS
  1.  ;Input = IEN of the entry [1] ^ user deleting [2]
  1. OKDEL(RET,IEN,USER) ;EP  Can this user delete
  1.  N PRV,ENTRYDT,ERR
  1.  S RET=0
  1.  I $G(USER)="" S USER=DUZ
  1.  S PRV=$$GET1^DIQ(9000092,IEN,.03,"I")
  1.  I PRV=USER S RET=1 Q
  1.  S ENTRYDT=$$NOW^XLFDT
  1.  S ERR=""
  1.  S RET=$$ISA^TIUPS139(USER,"CHIEF, MIS",ERR)
  1.  Q
  1. PAR(INP) Q $S($$GET^XPAR("SYS","BEH PARAMETER",INP)>0:$$GET^XPAR("SYS","BEH PARAMETER",INP),1:1)
  1. TMPGBL(X) ;EP
  1.  K ^TMP("BGOPLAN"_$G(X),$J) Q $NA(^($J))
  1.  ; Return file number
  1. FNUM() Q 9000092
  1.  ; Use parameters to get and load TIU templates into the care plan
  1.  ; Nodes Returned by GETITEMS
  1.  ;
  1.  ; Piece  Data
  1.  ; -----  ---------------------
  1.  ;   1    IEN
  1.  ;   2    TYPE
  1.  ;   3    STATUS
  1.  ;   4    NAME
  1.  ;   5    EXCLUDE FROM GROUP BOILERPLATE
  1.  ;   6    BLANK LINES
  1.  ;   7    PERSONAL OWNER
  1.  ;   8    HAS CHILDREN FLAG (0=NONE, 1=ACTIVE, 2=INACTIVE, 3=BOTH)
  1.  ;   9    DIALOG
  1.  ;  10    DISPLAY ONLY
  1.  ;  11    FIRST LINE
  1.  ;  12    ONE ITEM ONLY
  1.  ;  13    HIDE DIALOG ITEMS
  1.  ;  14    HIDE TREE ITEMS
  1.  ;  15    INDENT ITEMS
  1.  ;  16    REMINDER DIALOG IEN
  1.  ;  17    REMINDER DIALOG NAME
  1.  ;  18    LOCKED
  1.  ;  19    COM OBJECT POINTER
  1.  ;  20    COM OBJECT PARAMETER
  1.  ;  21    LINK POINTER
  1. GETROOTS(TIUY,USER,PARAM) ;Get template root info
  1.  N IDX,TIUDA,TYPE,PARAM,ENT,ARY,ERR,LP
  1.  S ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
  1.  D GETLST^XPAR(.ARY,ENT,PARAM,"N",.ERR)
  1.  I $G(ERR) K ARY S DATA=ERR
  1.  S LP=0 F  S LP=$O(ARY(LP)) Q:LP<1  D
  1.  .S TIUDA=$P(ARY(LP),U,1)
  1.  .D ADDNODE(.IDX,TIUDA,1)
  1.  Q
  1. ADDNODE(IDX,TIUDA,INTIUY) ;Adds template node info
  1.  N DATA
  1.  S DATA=$$NODEDATA^TIUSRVT(TIUDA)
  1.  I DATA'="" D
  1.  .S IDX=$G(IDX)+1
  1.  .I $G(INTIUY) S TIUY(IDX)=DATA
  1.  .E  S ^TMP("TIU TEMPLATE",$J,IDX)=DATA
  1.  Q
  1. CPACT(RET,DFN,PRIEN,CPTYP,NUM) ;EP
  1.  ;  DFN  = The patient this problem belongs to
  1.  ;  PRIEN= The problem to return care planning data on
  1.  ;  CPTYP= A  All
  1.  ;         C  Active
  1.  ;         L  Last date
  1.  ;  NUM = Number of entries in V files to return
  1.  ;  RET = Array of care planning items for a problem
  1.  N CNT
  1.  I CPTYP="" S CPTYP="L"
  1.  ;For Visit instructions and treatments, the default is the latest visit
  1.  I $G(NUM)="" S NUM=1
  1.  S RET=$$TMPGBL^BGOUTL
  1.  S CNT=0
  1.  D GET^BGOCPLAN(.RET,PRIEN,DFN,"G",CPTYP,.CNT)
  1.  D GET^BGOCPLAN(.RET,PRIEN,DFN,"P",CPTYP,.CNT)
  1.  D GET^BGOVVI(.RET,DFN,PRIEN,NUM,.CNT)
  1.  D GET^BGOVTR(.RET,DFN,PRIEN,NUM,.CNT)
  1.  D GETCON^BGOVTR(.RET,DFN,PRIEN,NUM,.CNT)
  1.  Q
  1. SCRN(Y,ENT) ;Return only items in shared templates
  1.  N ITM,SEQ,ITEM,ITEMNODE,RET,PROV
  1.  S RET=0
  1.  S ITM=$O(^TIU(8927,"B","Shared Templates",""))
  1.  D LOOP
  1.  I $P(ENT,";",2)="VA(200," D
  1.  . S PROV=$P(ENT,";",1)
  1.  . S ITM=$O(^TIU(8927,"AROOT",PROV,""))
  1.  . D LOOP
  1.  Q RET
  1. LOOP N TYPE
  1.  I $P($G(^TIU(8927,ITM,0)),U,3)'="T" D
  1.  .S (IDX,SEQ)=0
  1.  .F  S SEQ=$O(^TIU(8927,ITM,10,"B",SEQ)) Q:'SEQ  D
  1.  ..S ITEM=0
  1.  ..F  S ITEM=$O(^TIU(8927,ITM,10,"B",SEQ,ITEM)) Q:'ITEM  D
  1.  ...S ITEMNODE=$G(^TIU(8927,ITM,10,ITEM,0))
  1.  ...I $P(ITEMNODE,U,2)=Y D
  1.  ....S TYPE=$P($G(^TIU(8927,$P(ITEMNODE,U,2),0)),U,3)
  1.  ....S RET=$S(TYPE="T":1,TYPE="G":1,1:0)
  1.  Q