BGOVHF ; IHS/BAO/TMD - Manage V HEALTH FACTORS ;09-Oct-2013 13:19;DU
;;1.1;BGO COMPONENTS;**1,3,4,6,11,13**;Mar 20, 2007;Build 3
; Get health factors by patient
; INP = Patient IEN ^ Learn Only Flag ^ V HF IEN (optional)
; .RET returned as a list of records in the format:
; Category [1] ^ HF Name [2] ^ Visit Date [3] ^ Severity [4] ^ Quantity [5] ^ Visit IEN [6] ^
; V File IEN [7] ^ Health Factor Type [8] ^ Comment [9] ^ Visit Locked [10] ^ Event date/time
GET(RET,INP) ;EP
N DFN,LRN,VFIEN,TYPE,CNT,VDT,IEN,VIEN,SEV,QTY,CAT,HFNAME,VDATE,EVNDT
S RET=$$TMPGBL^BGOUTL
S DFN=+INP
S LRN=$P(INP,U,2)
S VFIEN=$P(INP,U,3)
S (TYPE,CNT)=0
F S TYPE=$O(^AUPNVHF("AA",DFN,TYPE)) Q:'TYPE D
.I LRN,'$$ISLEARN(TYPE,1) Q
.S VDT=0
.F S VDT=$O(^AUPNVHF("AA",DFN,TYPE,VDT)) Q:'VDT D
..S VDATE=$$FMTDATE^BGOUTL(9999999-VDT)
..S IEN=0
..F S IEN=$O(^AUPNVHF("AA",DFN,TYPE,VDT,IEN)) Q:'IEN D
...I VFIEN,VFIEN'=IEN Q
...S REC=$G(^AUPNVHF(IEN,0))
...Q:REC=""
...S VIEN=$P(REC,U,3)
...S SEV=$$EXTERNAL^DILFD($$FNUM,.04,,$P(REC,U,4))
...;Patch 11
...S EVNDT=$$FMTDATE^BGOUTL($P($G(^AUPNVHF(IEN,12)),U,1))
...S QTY=$P(REC,U,6)
...S COMMENT=$P($G(^AUPNVHF(IEN,811)),U)
...S HFNAME=$P($G(^AUTTHF(TYPE,0)),U),CAT=$P($G(^(0)),U,3)
...S:CAT CAT=$P($G(^AUTTHF(CAT,0)),U)
...S CNT=CNT+1
...S @RET@(CNT)=CAT_U_HFNAME_U_VDATE_U_SEV_U_QTY_U_VIEN_U_IEN_U_TYPE_U_COMMENT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT
Q
; Return IEN for pap smear/mammogram/ekg
REFLIST(RET,INP) ;EP
I INP="PAP SMEAR" S RET=$O(^LAB(60,"B","PAP SMEAR",0))
E I INP="MAMMOGRAM" S RET=$O(^RAMIS(71,"D",76090,0))
E I INP="EKG" S RET=$O(^AUTTDXPR("B","ECG SUMMARY",0))
E S RET=$$ERR^BGOUTL(1026,INP)
Q
; Add/edit health factor
; INP = HF Type IEN [1] ^ V File IEN [2] ^ Visit IEN [3] ^ Severity [4] ^ Provider IEN [5] ^ Quantity [6] ^ Comment [7] ^ Event dt [8] ^ Enc Provider [9]
SET(RET,INP) ;EP
N VIEN,TYPE,PRV,QTY,SEV,VFIEN,VFNEW,COMMENT,FNUM,FDA,EVNDT,ENCPR
S FNUM=$$FNUM
S TYPE=+INP
I 'TYPE S RET=$$ERR^BGOUTL(1008) Q
S VFIEN=$P(INP,U,2)
S VFNEW='VFIEN
S VIEN=+$P(INP,U,3)
S SEV=$P(INP,U,4)
S PRV=$P(INP,U,5)
S QTY=$P(INP,U,6)
S COMMENT=$P(INP,U,7)
S RET=$$CHKVISIT^BGOUTL(VIEN)
Q:RET
I 'VFIEN D Q:'VFIEN
.D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Health factor")
.S:RET>0 VFIEN=RET,RET=""
S FDA=$NA(FDA(FNUM,VFIEN_","))
S @FDA@(.01)="`"_TYPE
S @FDA@(.04)=SEV
S @FDA@(.05)=$S(PRV:"`"_PRV,1:"")
S @FDA@(.06)=QTY
;Set event date
S EVNDT=$P(INP,U,8)
I EVNDT="" S EVNDT=$$NOW^XLFDT
S @FDA@(1201)=EVNDT
S @FDA@(1204)="`"_DUZ
S:'VFNEW!$L(COMMENT) @FDA@(81101)=COMMENT
;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
; Set refusal
; INP = Refusal Type [1] ^ Item IEN [2] ^ Patient IEN [3] ^ Refusal Date [4] ^ Comment [5] ^ Provider IEN [6]
SETREF(RET,INP) ;EP
N DFN,REFTYP,ITEMIEN,REFDATE,COMMENT,REFTIEN,FILENUM,PRV,CT
S RET=""
S REFTYP=$P(INP,U)
S ITEMIEN=+$P(INP,U,2)
I 'ITEMIEN S RET=$$ERR^BGOUTL(1078) Q
S DFN=+$P(INP,U,3)
I '$D(^AUPNPAT(DFN)) S RET=$$ERR^BGOUTL(1001) Q
S REFDATE=$$CVTDATE^BGOUTL($P(INP,U,4))
S COMMENT=$P(INP,U,5)
S PRV=$P(INP,U,6)
S CT=443390004
S RET=$$REFSET2^BGOUTL2(DFN,REFDATE,ITEMIEN,REFTYP,"R",COMMENT,PRV,"",CT)
Q
; Delete a refusal
DELREF(RET,REF) ;EP
S RET=$$REFDEL^BGOUTL2(+REF)
Q
; Delete a health factor
DEL(RET,VFIEN) ;EP
D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
Q
;
; Return health factor types
; INP = 1: all (default), 2: learning only
; Returns a list of records in the format:
; Name [1] ^ Category Name [2] ^ Gender [3] ^ Type [4] ^ HF Type IEN [5] ^ Quantity Phrase [6] ^ Level Phrase [7]
GETTYPES(RET,INP) ;EP
N ALL,NAME,CATP,CATNAME,TYPE,SEX,HF,CNT,REC,X,QTYPHR,LVLPHR
S RET=$$TMPGBL^BGOUTL
S ALL=INP'=2
S (HF,CNT)=0
F S HF=$O(^AUTTHF(HF)) Q:'HF D ;!(HF>99999) D
.S REC=$G(^AUTTHF(HF,0))
.Q:$P(REC,U,$S($G(DUZ("AG"))="I":13,1:11)) ;P6 ;inactive
.I 'ALL,'$$ISLEARN(+$P(REC,U,3)) Q
.S NAME=$P(REC,U)
.S CATP=$P(REC,U,3)
.S CATNAME=$S(CATP:$P($G(^AUTTHF(CATP,0)),U),1:"")
.S SEX=$P(REC,U,5)
.S TYPE=$P(REC,U,10)
.S QTYPHR=$P(REC,U,11)
.S LVLPHR=$P(REC,U,12)
.S CNT=CNT+1,@RET@(CNT)=NAME_U_CATNAME_U_SEX_U_TYPE_U_HF_U_QTYPHR_U_LVLPHR
Q
; Returns true if health factor is a learning category
ISLEARN(TYPE,CHKPAR) ;
N X
S TYPE=+TYPE
Q:'TYPE!$D(TYPE(TYPE)) 0
S X=$G(^AUTTHF(TYPE,0))
Q:$P(X,U)["LEARN"&($P(X,U,10)="C") 1
Q:'$G(CHKPAR) 0
S TYPE(TYPE)="",TYPE=$P(X,U,3)
Q $$ISLEARN(.TYPE,1)
; Return V File #
FNUM() Q 9000010.23
BGOVHF ; IHS/BAO/TMD - Manage V HEALTH FACTORS ;09-Oct-2013 13:19;DU
+1 ;;1.1;BGO COMPONENTS;**1,3,4,6,11,13**;Mar 20, 2007;Build 3
+2 ; Get health factors by patient
+3 ; INP = Patient IEN ^ Learn Only Flag ^ V HF IEN (optional)
+4 ; .RET returned as a list of records in the format:
+5 ; Category [1] ^ HF Name [2] ^ Visit Date [3] ^ Severity [4] ^ Quantity [5] ^ Visit IEN [6] ^
+6 ; V File IEN [7] ^ Health Factor Type [8] ^ Comment [9] ^ Visit Locked [10] ^ Event date/time
GET(RET,INP) ;EP
+1 NEW DFN,LRN,VFIEN,TYPE,CNT,VDT,IEN,VIEN,SEV,QTY,CAT,HFNAME,VDATE,EVNDT
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET DFN=+INP
+4 SET LRN=$PIECE(INP,U,2)
+5 SET VFIEN=$PIECE(INP,U,3)
+6 SET (TYPE,CNT)=0
+7 FOR
SET TYPE=$ORDER(^AUPNVHF("AA",DFN,TYPE))
IF 'TYPE
QUIT
Begin DoDot:1
+8 IF LRN
IF '$$ISLEARN(TYPE,1)
QUIT
+9 SET VDT=0
+10 FOR
SET VDT=$ORDER(^AUPNVHF("AA",DFN,TYPE,VDT))
IF 'VDT
QUIT
Begin DoDot:2
+11 SET VDATE=$$FMTDATE^BGOUTL(9999999-VDT)
+12 SET IEN=0
+13 FOR
SET IEN=$ORDER(^AUPNVHF("AA",DFN,TYPE,VDT,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+14 IF VFIEN
IF VFIEN'=IEN
QUIT
+15 SET REC=$GET(^AUPNVHF(IEN,0))
+16 IF REC=""
QUIT
+17 SET VIEN=$PIECE(REC,U,3)
+18 SET SEV=$$EXTERNAL^DILFD($$FNUM,.04,,$PIECE(REC,U,4))
+19 ;Patch 11
+20 SET EVNDT=$$FMTDATE^BGOUTL($PIECE($GET(^AUPNVHF(IEN,12)),U,1))
+21 SET QTY=$PIECE(REC,U,6)
+22 SET COMMENT=$PIECE($GET(^AUPNVHF(IEN,811)),U)
+23 SET HFNAME=$PIECE($GET(^AUTTHF(TYPE,0)),U)
SET CAT=$PIECE($GET(^(0)),U,3)
+24 IF CAT
SET CAT=$PIECE($GET(^AUTTHF(CAT,0)),U)
+25 SET CNT=CNT+1
+26 SET @RET@(CNT)=CAT_U_HFNAME_U_VDATE_U_SEV_U_QTY_U_VIEN_U_IEN_U_TYPE_U_COMMENT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
+28 ; Return IEN for pap smear/mammogram/ekg
REFLIST(RET,INP) ;EP
+1 IF INP="PAP SMEAR"
SET RET=$ORDER(^LAB(60,"B","PAP SMEAR",0))
+2 IF '$TEST
IF INP="MAMMOGRAM"
SET RET=$ORDER(^RAMIS(71,"D",76090,0))
+3 IF '$TEST
IF INP="EKG"
SET RET=$ORDER(^AUTTDXPR("B","ECG SUMMARY",0))
+4 IF '$TEST
SET RET=$$ERR^BGOUTL(1026,INP)
+5 QUIT
+6 ; Add/edit health factor
+7 ; INP = HF Type IEN [1] ^ V File IEN [2] ^ Visit IEN [3] ^ Severity [4] ^ Provider IEN [5] ^ Quantity [6] ^ Comment [7] ^ Event dt [8] ^ Enc Provider [9]
SET(RET,INP) ;EP
+1 NEW VIEN,TYPE,PRV,QTY,SEV,VFIEN,VFNEW,COMMENT,FNUM,FDA,EVNDT,ENCPR
+2 SET FNUM=$$FNUM
+3 SET TYPE=+INP
+4 IF 'TYPE
SET RET=$$ERR^BGOUTL(1008)
QUIT
+5 SET VFIEN=$PIECE(INP,U,2)
+6 SET VFNEW='VFIEN
+7 SET VIEN=+$PIECE(INP,U,3)
+8 SET SEV=$PIECE(INP,U,4)
+9 SET PRV=$PIECE(INP,U,5)
+10 SET QTY=$PIECE(INP,U,6)
+11 SET COMMENT=$PIECE(INP,U,7)
+12 SET RET=$$CHKVISIT^BGOUTL(VIEN)
+13 IF RET
QUIT
+14 IF 'VFIEN
Begin DoDot:1
+15 DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Health factor")
+16 IF RET>0
SET VFIEN=RET
SET RET=""
End DoDot:1
IF 'VFIEN
QUIT
+17 SET FDA=$NAME(FDA(FNUM,VFIEN_","))
+18 SET @FDA@(.01)="`"_TYPE
+19 SET @FDA@(.04)=SEV
+20 SET @FDA@(.05)=$SELECT(PRV:"`"_PRV,1:"")
+21 SET @FDA@(.06)=QTY
+22 ;Set event date
+23 SET EVNDT=$PIECE(INP,U,8)
+24 IF EVNDT=""
SET EVNDT=$$NOW^XLFDT
+25 SET @FDA@(1201)=EVNDT
+26 SET @FDA@(1204)="`"_DUZ
+27 IF 'VFNEW!$LENGTH(COMMENT)
SET @FDA@(81101)=COMMENT
+28 ;Patch 11 Set date entered
+29 IF VFNEW
Begin DoDot:1
+30 SET @FDA@(1216)="N"
+31 SET @FDA@(1217)="`"_DUZ
End DoDot:1
+32 ;Patch 11 Set last modified
+33 SET @FDA@(1218)="N"
+34 SET @FDA@(1219)="`"_DUZ
+35 SET RET=$$UPDATE^BGOUTL(.FDA,"E")
+36 IF RET
IF VFNEW
IF $$DELETE^BGOUTL(FNUM,VFIEN)
+37 IF 'RET
DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
+38 IF 'RET
SET RET=VFIEN
+39 QUIT
+40 ; Set refusal
+41 ; INP = Refusal Type [1] ^ Item IEN [2] ^ Patient IEN [3] ^ Refusal Date [4] ^ Comment [5] ^ Provider IEN [6]
SETREF(RET,INP) ;EP
+1 NEW DFN,REFTYP,ITEMIEN,REFDATE,COMMENT,REFTIEN,FILENUM,PRV,CT
+2 SET RET=""
+3 SET REFTYP=$PIECE(INP,U)
+4 SET ITEMIEN=+$PIECE(INP,U,2)
+5 IF 'ITEMIEN
SET RET=$$ERR^BGOUTL(1078)
QUIT
+6 SET DFN=+$PIECE(INP,U,3)
+7 IF '$DATA(^AUPNPAT(DFN))
SET RET=$$ERR^BGOUTL(1001)
QUIT
+8 SET REFDATE=$$CVTDATE^BGOUTL($PIECE(INP,U,4))
+9 SET COMMENT=$PIECE(INP,U,5)
+10 SET PRV=$PIECE(INP,U,6)
+11 SET CT=443390004
+12 SET RET=$$REFSET2^BGOUTL2(DFN,REFDATE,ITEMIEN,REFTYP,"R",COMMENT,PRV,"",CT)
+13 QUIT
+14 ; Delete a refusal
DELREF(RET,REF) ;EP
+1 SET RET=$$REFDEL^BGOUTL2(+REF)
+2 QUIT
+3 ; Delete a health factor
DEL(RET,VFIEN) ;EP
+1 DO VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
+2 QUIT
+3 ;
+4 ; Return health factor types
+5 ; INP = 1: all (default), 2: learning only
+6 ; Returns a list of records in the format:
+7 ; Name [1] ^ Category Name [2] ^ Gender [3] ^ Type [4] ^ HF Type IEN [5] ^ Quantity Phrase [6] ^ Level Phrase [7]
GETTYPES(RET,INP) ;EP
+1 NEW ALL,NAME,CATP,CATNAME,TYPE,SEX,HF,CNT,REC,X,QTYPHR,LVLPHR
+2 SET RET=$$TMPGBL^BGOUTL
+3 SET ALL=INP'=2
+4 SET (HF,CNT)=0
+5 ;!(HF>99999) D
FOR
SET HF=$ORDER(^AUTTHF(HF))
IF 'HF
QUIT
Begin DoDot:1
+6 SET REC=$GET(^AUTTHF(HF,0))
+7 ;P6 ;inactive
IF $PIECE(REC,U,$SELECT($GET(DUZ("AG"))="I"
QUIT
+8 IF 'ALL
IF '$$ISLEARN(+$PIECE(REC,U,3))
QUIT
+9 SET NAME=$PIECE(REC,U)
+10 SET CATP=$PIECE(REC,U,3)
+11 SET CATNAME=$SELECT(CATP:$PIECE($GET(^AUTTHF(CATP,0)),U),1:"")
+12 SET SEX=$PIECE(REC,U,5)
+13 SET TYPE=$PIECE(REC,U,10)
+14 SET QTYPHR=$PIECE(REC,U,11)
+15 SET LVLPHR=$PIECE(REC,U,12)
+16 SET CNT=CNT+1
SET @RET@(CNT)=NAME_U_CATNAME_U_SEX_U_TYPE_U_HF_U_QTYPHR_U_LVLPHR
End DoDot:1
+17 QUIT
+18 ; Returns true if health factor is a learning category
ISLEARN(TYPE,CHKPAR) ;
+1 NEW X
+2 SET TYPE=+TYPE
+3 IF 'TYPE!$DATA(TYPE(TYPE))
QUIT 0
+4 SET X=$GET(^AUTTHF(TYPE,0))
+5 IF $PIECE(X,U)["LEARN"&($PIECE(X,U,10)="C")
QUIT 1
+6 IF '$GET(CHKPAR)
QUIT 0
+7 SET TYPE(TYPE)=""
SET TYPE=$PIECE(X,U,3)
+8 QUIT $$ISLEARN(.TYPE,1)
+9 ; Return V File #
FNUM() QUIT 9000010.23
