Routine: BGOVHF

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

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

 ; 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

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

 ; Delete a refusal

DELREF(RET,REF) ;EP

 S RET=$$REFDEL^BGOUTL2(+REF)

 ; Delete a health factor

DEL(RET,VFIEN) ;EP

 D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)

 ; 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

 ; 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

BGOVHF.m