Routine: BGOCC

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

 ; 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)

 ; 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

 ; 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

 ; 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)

 ; 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)

 ; 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

BGOCC.m