BGOCC ; IHS/BAO/TMD - Manage Chief Complaints ;09-Apr-2012 14:19;DU
;;1.1;BGO COMPONENTS;**1,3,4,11**;Mar 20, 2007;Build 3
; Returns chief complaint for current vuecentric visit context for
; use by TIU object. Assumes DFN is defined.
TIUML(TARGET) ;
N X
S X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
Q:X="" " "
S X=$$VSTR2VIS^BEHOENCX(DFN,X)
Q:X<1 " "
D GET(.X,X)
S X=$P(X,U,3),X=$S($L(X):"Chief Complaint: "_X,1:"No Chief Complaint.")
K @TARGET
S @TARGET@(1,0)=X
Q "~@"_$NA(@TARGET)
; Returns chief complaint history. If there is a V Narrative of type CHIEF COMPLAINT,
; this is returned preferentially. Otherwise, the value of the CHIEF COMPLAINT field
; of the VISIT file entry is returned.
; INP = Visit IEN
; .RET = List in format:
; IEN [1] ^ Author [2] ^ Line Count [3]
; Text Lines
GET(RET,INP) ;EP
N VIEN,VNT,I,N,CCTYPE,CNT,AUTH
S VIEN=+INP,RET=$$TMPGBL^BGOUTL
I 'VIEN S @RET@(0)=$$ERR^BGOUTL(1002) Q
I '$D(^AUPNVSIT(VIEN,0)) S @RET@(0)=$$ERR^BGOUTL(1003) Q
S CCTYPE=$$CCTYPE
S (CNT,VNT)=0
F S VNT=$O(^AUPNVNT("AD",VIEN,VNT)) Q:'VNT D
.Q:$P($G(^AUPNVNT(VNT,0)),U)'=CCTYPE
.S AUTH=$P($G(^AUPNVNT(VNT,12)),U,4)
.S:AUTH AUTH=AUTH_"~"_$P($G(^VA(200,AUTH,0)),U)
.S (I,N)=0,CNT=CNT+1
.F S N=$O(^AUPNVNT(VNT,11,N)) Q:'N S I=I+1,@RET@(CNT,I)=$G(^(N,0))
.S @RET@(CNT)=VNT_U_AUTH_U_I
S I=$P($G(^AUPNVSIT(VIEN,14)),U)
S:$L(I) CNT=CNT+1,@RET@(CNT)="0^^1",@RET@(CNT,1)=I
Q
; Return IEN for Chief Complaint. Optionally create it if not found.
CCTYPE(CREATE) ;
N TYPE,FDA,IEN
S TYPE=$O(^AUTTNTYP("B","CHIEF COMPLAINT",0))
I 'TYPE,$G(CREATE) D
.S FDA(9999999.89,"+1,",.01)="CHIEF COMPLAINT"
.S:'$$UPDATE^BGOUTL(.FDA,,.IEN) TYPE=$G(IEN(1))
Q TYPE
; Delete chief complaint
DEL(RET,VNT) ;EP
D VFDEL^BGOUTL2(.RET,$$FNUM,VNT)
Q
; Add/edit chief complaint
; INP = Visit IEN ^ V Narrative IEN ^ Chief Complaint
; .RET = V Narrative IEN or -n^error text
SET(RET,INP) ;EP
N VIEN,VFIEN,CC,TYPE,VFNEW,FNUM,FDA
S FNUM=$$FNUM
S VIEN=+INP
S RET=$$CHKVISIT^BGOUTL(VIEN,,"AIT")
Q:RET
S VFIEN=+$P(INP,U,2)
S CC=$P(INP,U,3)
S CC=$$TOWP^BGOUTL("CC")
S TYPE=$$CCTYPE(1)
I 'TYPE S RET=$$ERR^BGOUTL(1004) Q
I CC="" D:VFIEN DEL(.RET,VFIEN) Q
I VFIEN D Q:RET
.N X
.S X=$P($G(^AUPNVNT(VFIEN,12)),U,4)
.I X,X'=DUZ S RET=$$ERR^BGOUTL(1005,$P($G(^VA(200,X,0)),U))
S VFNEW='VFIEN
I 'VFIEN D Q:RET
.D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)
.S:RET>0 VFIEN=RET,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(1100)=CC
S @FDA@(1201)="N"
S @FDA@(1204)="`"_DUZ
;Patch 11 Set date entered
I VFNEW D
.S @FDA@(1216)="N"
.S @FDA@(1217)="`"_DUZ
;Patch 11 Set last modified
S @FDA@(1218)="N"
S @FDA@(1219)="`"_DUZ
S RET=$$UPDATE^BGOUTL(.FDA,"E@")
I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
S:'RET RET=VFIEN
Q
; Return pick list entries for chief complaint
; TYP = 1: Symptom, 2: Disease, 3: Request
; .RET is list of records in format:
; IEN ^ Display Text ^ Body Location Related
GETPL(RET,TYP) ;EP
N IEN,NAME,BODY,CNT
S RET=$$TMPGBL^BGOUTL
I '$G(TYP) S @RET@(1)=$$ERR^BGOUTL(1006) Q
S (IEN,CNT)=0
F S IEN=$O(^BGOCCPL("AC",TYP,IEN)) Q:'IEN D
.N NAME,BODY,X
.S X=$G(^BGOCCPL(IEN,0))
.S NAME=$P(X,U),BODY=$P(X,U,3)
.S CNT=CNT+1,@RET@(CNT)=IEN_U_NAME_U_BODY
Q
; Add a pick list entry
; INP = Name ^ Type ^ Body Related
SETPL(RET,INP) ;EP
N NAME,TYPE,BODY,FDA,IENS,IEN
S NAME=$P(INP,U)
I NAME="" S RET=$$ERR^BGOUTL(1007) Q
S TYPE=+$P(INP,U,2)
S BODY=$P(INP,U,3)
S IENS=$O(^BGOCCPL("B",NAME,0))
S IENS=$S(IENS:IENS_",",1:"+1,")
S FDA=$NA(FDA(90362.2,IENS))
S @FDA@(.01)=NAME
S @FDA@(.02)=TYPE
S @FDA@(.03)=BODY
S RET=$$UPDATE^BGOUTL(.FDA,"E",.IEN)
S:'RET RET=$G(IEN(1),+IENS)
Q
; Delete pick list name
; IEN = Pick List IEN
; .RET = -1^error text if error
DELPL(RET,IEN) ;EP
S:IEN RET=$$DELETE^BGOUTL("^BGOCCPL(",IEN)
Q
; Return V File #
FNUM() Q 9000010.34
BGOCC ; IHS/BAO/TMD - Manage Chief Complaints ;09-Apr-2012 14:19;DU
+1 ;;1.1;BGO COMPONENTS;**1,3,4,11**;Mar 20, 2007;Build 3
+2 ; Returns chief complaint for current vuecentric visit context for
+3 ; use by TIU object. Assumes DFN is defined.
TIUML(TARGET) ;
+1 NEW X
+2 SET X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
+3 IF X=""
QUIT " "
+4 SET X=$$VSTR2VIS^BEHOENCX(DFN,X)
+5 IF X<1
QUIT " "
+6 DO GET(.X,X)
+7 SET X=$PIECE(X,U,3)
SET X=$SELECT($LENGTH(X):"Chief Complaint: "_X,1:"No Chief Complaint.")
+8 KILL @TARGET
+9 SET @TARGET@(1,0)=X
+10 QUIT "~@"_$NAME(@TARGET)
+11 ; Returns chief complaint history. If there is a V Narrative of type CHIEF COMPLAINT,
+12 ; this is returned preferentially. Otherwise, the value of the CHIEF COMPLAINT field
+13 ; of the VISIT file entry is returned.
+14 ; INP = Visit IEN
+15 ; .RET = List in format:
+16 ; IEN [1] ^ Author [2] ^ Line Count [3]
+17 ; Text Lines
GET(RET,INP) ;EP
+1 NEW VIEN,VNT,I,N,CCTYPE,CNT,AUTH
+2 SET VIEN=+INP
SET RET=$$TMPGBL^BGOUTL
+3 IF 'VIEN
SET @RET@(0)=$$ERR^BGOUTL(1002)
QUIT
+4 IF '$DATA(^AUPNVSIT(VIEN,0))
SET @RET@(0)=$$ERR^BGOUTL(1003)
QUIT
+5 SET CCTYPE=$$CCTYPE
+6 SET (CNT,VNT)=0
+7 FOR
SET VNT=$ORDER(^AUPNVNT("AD",VIEN,VNT))
IF 'VNT
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^AUPNVNT(VNT,0)),U)'=CCTYPE
QUIT
+9 SET AUTH=$PIECE($GET(^AUPNVNT(VNT,12)),U,4)
+10 IF AUTH
SET AUTH=AUTH_"~"_$PIECE($GET(^VA(200,AUTH,0)),U)
+11 SET (I,N)=0
SET CNT=CNT+1
+12 FOR
SET N=$ORDER(^AUPNVNT(VNT,11,N))
IF 'N
QUIT
SET I=I+1
SET @RET@(CNT,I)=$GET(^(N,0))
+13 SET @RET@(CNT)=VNT_U_AUTH_U_I
End DoDot:1
+14 SET I=$PIECE($GET(^AUPNVSIT(VIEN,14)),U)
+15 IF $LENGTH(I)
SET CNT=CNT+1
SET @RET@(CNT)="0^^1"
SET @RET@(CNT,1)=I
+16 QUIT
+17 ; Return IEN for Chief Complaint. Optionally create it if not found.
CCTYPE(CREATE) ;
+1 NEW TYPE,FDA,IEN
+2 SET TYPE=$ORDER(^AUTTNTYP("B","CHIEF COMPLAINT",0))
+3 IF 'TYPE
IF $GET(CREATE)
Begin DoDot:1
+4 SET FDA(9999999.89,"+1,",.01)="CHIEF COMPLAINT"
+5 IF '$$UPDATE^BGOUTL(.FDA,,.IEN)
SET TYPE=$GET(IEN(1))
End DoDot:1
+6 QUIT TYPE
+7 ; Delete chief complaint
DEL(RET,VNT) ;EP
+1 DO VFDEL^BGOUTL2(.RET,$$FNUM,VNT)
+2 QUIT
+3 ; Add/edit chief complaint
+4 ; INP = Visit IEN ^ V Narrative IEN ^ Chief Complaint
+5 ; .RET = V Narrative IEN or -n^error text
SET(RET,INP) ;EP
+1 NEW VIEN,VFIEN,CC,TYPE,VFNEW,FNUM,FDA
+2 SET FNUM=$$FNUM
+3 SET VIEN=+INP
+4 SET RET=$$CHKVISIT^BGOUTL(VIEN,,"AIT")
+5 IF RET
QUIT
+6 SET VFIEN=+$PIECE(INP,U,2)
+7 SET CC=$PIECE(INP,U,3)
+8 SET CC=$$TOWP^BGOUTL("CC")
+9 SET TYPE=$$CCTYPE(1)
+10 IF 'TYPE
SET RET=$$ERR^BGOUTL(1004)
QUIT
+11 IF CC=""
IF VFIEN
DO DEL(.RET,VFIEN)
QUIT
+12 IF VFIEN
Begin DoDot:1
+13 NEW X
+14 SET X=$PIECE($GET(^AUPNVNT(VFIEN,12)),U,4)
+15 IF X
IF X'=DUZ
SET RET=$$ERR^BGOUTL(1005,$PIECE($GET(^VA(200,X,0)),U))
End DoDot:1
IF RET
QUIT
+16 SET VFNEW='VFIEN
+17 IF 'VFIEN
Begin DoDot:1
+18 DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN)
+19 IF RET>0
SET VFIEN=RET
SET RET=""
End DoDot:1
IF RET
QUIT
+20 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+21 SET @FDA@(1100)=CC
+22 SET @FDA@(1201)="N"
+23 SET @FDA@(1204)="`"_DUZ
+24 ;Patch 11 Set date entered
+25 IF VFNEW
Begin DoDot:1
+26 SET @FDA@(1216)="N"
+27 SET @FDA@(1217)="`"_DUZ
End DoDot:1
+28 ;Patch 11 Set last modified
+29 SET @FDA@(1218)="N"
+30 SET @FDA@(1219)="`"_DUZ
+31 SET RET=$$UPDATE^BGOUTL(.FDA,"E@")
+32 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+33 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+34 IF 'RET
SET RET=VFIEN
+35 QUIT
+36 ; Return pick list entries for chief complaint
+37 ; TYP = 1: Symptom, 2: Disease, 3: Request
+38 ; .RET is list of records in format:
+39 ; IEN ^ Display Text ^ Body Location Related
GETPL(RET,TYP) ;EP
+1 NEW IEN,NAME,BODY,CNT
+2 SET RET=$$TMPGBL^BGOUTL
+3 IF '$GET(TYP)
SET @RET@(1)=$$ERR^BGOUTL(1006)
QUIT
+4 SET (IEN,CNT)=0
+5 FOR
SET IEN=$ORDER(^BGOCCPL("AC",TYP,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 NEW NAME,BODY,X
+7 SET X=$GET(^BGOCCPL(IEN,0))
+8 SET NAME=$PIECE(X,U)
SET BODY=$PIECE(X,U,3)
+9 SET CNT=CNT+1
SET @RET@(CNT)=IEN_U_NAME_U_BODY
End DoDot:1
+10 QUIT
+11 ; Add a pick list entry
+12 ; INP = Name ^ Type ^ Body Related
SETPL(RET,INP) ;EP
+1 NEW NAME,TYPE,BODY,FDA,IENS,IEN
+2 SET NAME=$PIECE(INP,U)
+3 IF NAME=""
SET RET=$$ERR^BGOUTL(1007)
QUIT
+4 SET TYPE=+$PIECE(INP,U,2)
+5 SET BODY=$PIECE(INP,U,3)
+6 SET IENS=$ORDER(^BGOCCPL("B",NAME,0))
+7 SET IENS=$SELECT(IENS:IENS_",",1:"+1,")
+8 SET FDA=$NAME(FDA(90362.2,IENS))
+9 SET @FDA@(.01)=NAME
+10 SET @FDA@(.02)=TYPE
+11 SET @FDA@(.03)=BODY
+12 SET RET=$$UPDATE^BGOUTL(.FDA,"E",.IEN)
+13 IF 'RET
SET RET=$GET(IEN(1),+IENS)
+14 QUIT
+15 ; Delete pick list name
+16 ; IEN = Pick List IEN
+17 ; .RET = -1^error text if error
DELPL(RET,IEN) ;EP
+1 IF IEN
SET RET=$$DELETE^BGOUTL("^BGOCCPL(",IEN)
+2 QUIT
+3 ; Return V File #
FNUM() QUIT 9000010.34
