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

BGOPRBN.m

Go to the documentation of this file. 
  1. BGOPRBN ; IHS/BAO/TMD - Manage problem note ;02-Aug-2013 18:24;DU
  1.  ;;1.1;BGO COMPONENTS;**1,3,13**;Mar 20, 2007
  1.  ; Retrieve notes associated with a problem entry
  1.  ;  PRIEN = Problem IEN
  1.  ;  Returns a list of records in the format:
  1.  ;   Location IEN [1] ^ Note IEN [2] ^ Note # [3] ^ Narrative [4] ^
  1.  ;   Status [5] ^ Date Added [6] ^ Author Name [7]
  1. GET(RET,PRIEN) ;EP
  1.  D NOTES(.RET,PRIEN,1)
  1.  Q
  1.  ; Add/edit Problem Note
  1.  ;  INP = Problem IEN [1] ^ Note IEN [2] ^ Location IEN [3] ^ Note # [4] ^ Narrative [5] ^ Status [6]
  1.  ; .RET = Problem IEN [1] ^ Note IEN [2] ^ Location IEN [3] ^ Note # [4] ^ Narrative [5] ^ Status [6] ^
  1.  ;        Date Entered [7] ^ Author Name [8] ^ Note ID [9]
  1.  ;    or -n^error text
  1. SET(RET,INP) ;EP
  1.  N PRIEN,LIEN,NIEN,NOTN,NARR,STAT,DENT,FDA,NNEW,NOTID,AUTH,X
  1.  S PRIEN=+INP,NIEN=$P(INP,U,2),LIEN=$P(INP,U,3),NOTN=$P(INP,U,4),NARR=$P(INP,U,5),STAT=$P(INP,U,6)
  1.  S NARR=$TR(NARR,$C(13,10))
  1.  S DENT=$S(NIEN:"",1:DT)
  1.  S NNEW='NOTN
  1.  S:'NIEN NIEN=$$GETNIEN(PRIEN,LIEN)
  1.  I 'NIEN S RET=$$ERR^BGOUTL(1045) Q
  1.  S:'NOTN NOTN=1+$O(^AUPNPROB(PRIEN,11,NIEN,11,"B",""),-1)
  1.  S FDA=$NA(FDA(9000011.1111,$S(NNEW:"+1,",1:NOTN_",")_NIEN_","_PRIEN_","))
  1.  S:NNEW @FDA@(.01)=NOTN
  1.  S @FDA@(.03)=NARR
  1.  S @FDA@(.04)=STAT
  1.  S:NNEW @FDA@(.05)=DENT
  1.  S:NNEW @FDA@(.06)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  Q:RET
  1.  S X=^AUPNPROB(PRIEN,0),NOTID=$P(^AUTTLOC($P(X,U,6),0),U,7)_$P(X,U,7)_":"_NOTN
  1.  S X=+$O(^AUPNPROB(PRIEN,11,NIEN,11,"B",NOTN,0))
  1.  S X=$G(^AUPNPROB(PRIEN,11,NIEN,11,X,0)),AUTH=$P($G(^VA(200,+$P(X,U,6),0)),U),DENT=$P(X,U,5)
  1.  D EVT^BGOPROB(PRIEN,1)
  1.  S RET=PRIEN_U_NIEN_U_LIEN_U_NOTN_U_NARR_U_STAT_U_DENT_U_AUTH_U_NOTID
  1.  Q
  1.  ; Delete a problem note
  1.  ;  INP = Problem IEN [1] ^ Location IEN [2] ^ Note IEN [3]
  1. DEL(RET,INP) ;EP
  1.  N PRIEN,LIEN,NIEN,DA
  1.  S RET=""
  1.  S PRIEN=+INP,LIEN=+$P(INP,U,2),NIEN=$P(INP,U,3)
  1.  S LIEN=$O(^AUPNPROB(PRIEN,11,"B",LIEN,0))
  1.  I 'LIEN S RET=$$ERR^BGOUTL(1046) Q
  1.  S DA=NIEN
  1.  S DA(1)=LIEN
  1.  S DA(2)=PRIEN
  1.  S RET=$$DELETE^BGOUTL("^AUPNPROB("_DA(2)_",11,"_DA(1)_",11,",.DA)
  1.  D:'RET EVT^BGOPROB(PRIEN,0)
  1.  Q
  1.  ; Retrieve/create subfile IEN for note/facility
  1. GETNIEN(PRIEN,LIEN) ;
  1.  N NIEN,FDA,IEN,IENS
  1.  S NIEN=$O(^AUPNPROB(PRIEN,11,"B",LIEN,0))
  1.  Q:NIEN NIEN
  1.  S IENS="+1,"_PRIEN_","
  1.  S FDA(9000011.11,IENS,.01)=LIEN
  1.  S:'$$UPDATE^BGOUTL(.FDA,,.IEN) NIEN=IEN(1)
  1.  Q NIEN
  1.  ; Return all notes for a problem entry
  1.  ;  PRIEN  = Problem IEN
  1.  ;  FORMAT = Return format (0=single string, 1=list)
  1. NOTES(RET,PRIEN,FORMAT) ;EP
  1.  N NOT,IEN,NARR,FAC,REC,NMBR,STAT,DATE,AUTH,CNT
  1.  ;IHS/MSC/MGH Date formatting changed patch 13
  1.  K RET
  1.  S RET="",(CNT,IEN)=0
  1.  F  S IEN=$O(^AUPNPROB(PRIEN,11,IEN)) Q:'IEN  D
  1.  .S FAC=$P($G(^AUPNPROB(PRIEN,11,IEN,0)),U)
  1.  .S NOT=0
  1.  .F  S NOT=$O(^AUPNPROB(PRIEN,11,IEN,11,NOT)) Q:'NOT  D
  1.  ..S REC=$G(^AUPNPROB(PRIEN,11,IEN,11,NOT,0))
  1.  ..S NARR=$TR($P(REC,U,3),$C(13,10))
  1.  ..Q:NARR=""
  1.  ..I 'FORMAT S RET=RET_$S($L(RET):"; ",1:"")_NARR
  1.  ..E  D
  1.  ...S NMBR=$P(REC,U)
  1.  ...S STAT=$P(REC,U,4)
  1.  ...S DATE=$P(REC,U,5)
  1.  ...S AUTH=$P(REC,U,6)
  1.  ...S:AUTH AUTH=$P($G(^VA(200,AUTH,0)),U)
  1.  ...S CNT=CNT+1
  1.  ...S RET(CNT)=FAC_U_NOT_U_NMBR_U_NARR_U_STAT_U_$$FMTDATE^BGOUTL(DATE)_U_AUTH
  1.  Q