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