Routine: BGOVEXAM

BGOVEXAM ; IHS/BAO/TMD - V Exam Management ;02-Oct-2013 13:02;PLS

 ;;1.1;BGO COMPONENTS;**1,3,11,12,13**;Mar 20, 2007;Build 3

 ; Return exam records for a patient

 ;  DFN = Patient IEN

 ; .RET = Returned as a list of record in one of two formats:

 ;   For exams:

 ;    E ^ Exam Name [2] ^ Visit Date [3] ^ Result [4] ^ Comment [5] ^ Provider Name [6] ^ Facility Name [7] ^

 ;    Provider IEN [8] ^ Location Name [9] ^ Exam IEN [10] ^ V File IEN [11] ^ Visit IEN [12] ^ Visit Category [13] ^

 ;    Visit Locked [14] ^ Event date [15]

 ;   For refusals:

 ;    R ^ Exam Name [2] ^ Refusal Date [3] ^ Reason [4] ^ Comment [5] ^ Exam IEN [6] ^ V File IEN [7] ^

 ;    Refusal Locked [8]

GET(RET,DFN) ;EP

 N X,CNT,REC,VCAT,EXAM,VDT,VXAM,RESULT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME,EVNDT

 N EXAM,VDATE,VIEN,COMMENT

 S RET=$$TMPGBL^BGOUTL

 S (CNT,EXAM)=0

 F  S EXAM=$O(^AUPNVXAM("AA",DFN,EXAM)) Q:'EXAM  D

 .S VDT=0

 .F  S VDT=$O(^AUPNVXAM("AA",DFN,EXAM,VDT)) Q:'VDT  D

 ..S VXAM=0

 ..F  S VXAM=$O(^AUPNVXAM("AA",DFN,EXAM,VDT,VXAM)) Q:'VXAM  D

 ...S REC=$G(^AUPNVXAM(VXAM,0))

 ...Q:REC=""

 ...S RESULT=$$EXTERNAL^DILFD($$FNUM,.04,,$P(REC,U,4))

 ...I RESULT="",$O(^AUPNPREF("AA",DFN,9999999.15,EXAM,VDT,"")) Q

 ...S EXNAME=$P($G(^AUTTEXAM(EXAM,0)),U)

 ...S PRVIEN=$P($G(^AUPNVXAM(VXAM,12)),U,4)

 ...;Patch 11

 ...S EVNDT=$$FMTDATE^BGOUTL($P($G(^AUPNVXAM(VXAM,12)),U,1))

 ...S PRVNAME=$S('PRVIEN:"",1:$P($G(^VA(200,+PRVIEN,0)),U))

 ...S VIEN=$P(REC,U,3)

 ...Q:'VIEN

 ...S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6)

 ...S FAC=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U,10),1:"")

 ...S FACNAM=$S(LOC:$P($G(^AUTTLOC(LOC,0)),U),1:"")

 ...S:FACNAM FACNAM=$P($G(^DIC(4,FACNAM,0)),U)

 ...S:$P($G(^AUPNVSIT(VIEN,21)),U)'="" FACNAM=$P(^(21),U)

 ...S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)

 ...S VDATE=$$FMTDATE^BGOUTL(9999999-VDT)

 ...S COMMENT=$P($G(^AUPNVXAM(VXAM,811)),U)

 ...S CNT=CNT+1

 ...S @RET@(CNT)="E"_U_EXNAME_U_VDATE_U_RESULT_U_COMMENT_U_PRVNAME_U_FACNAM_U_PRVIEN_U_LOC_U_EXAM_U_VXAM_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT

 ; Add refusal data

 N ARRAY,CNT2,Z,STR,SAVE,SAVE2,DATA

 S CNT2=0,ARRAY="DATA"

 D REFGET^BGOUTL2(.ARRAY,DFN,9999999.15,.CNT2)

 S Z=0 F  S Z=$O(@ARRAY@(Z)) Q:Z=""  D

 .S STR=$G(@ARRAY@(Z))

 .S SAVE=$P(STR,U,13),SAVE2=$P(STR,U,11)

 .I SAVE'="" S $P(STR,U,11)=SAVE,$P(STR,U,13)=SAVE2

 .S CNT=CNT+1

 .S @RET@(CNT)=STR

 ; Return a list of exam types

 ; Returned as a list of records in the format:

 ;  Exam Type IEN ^ Exam Name ^ Exam Code ^ CPT Code

GETTYPES(RET,DUMMY) ;EP

 N EXAM,CNT,REC,NAME,CODE,CPT

 S RET=$$TMPGBL^BGOUTL

 S (CNT,EXAM)=0

 F  S EXAM=$O(^AUTTEXAM(EXAM)) Q:'EXAM  D

 .S REC=$G(^AUTTEXAM(EXAM,0))

 .Q:'$L(REC)

 .Q:$P(REC,U,4)=1

 .;Do not allow nutritional screening in list

 .Q:$P(REC,U,2)=40

 .S NAME=$P(REC,U)

 .S CODE=$P(REC,U,2)

 .S CPT=$P(REC,U,11)

 .S CNT=CNT+1,@RET@(CNT)=EXAM_U_NAME_U_CODE_U_CPT

 ; Get list of valid results for a given EXAM Name or IEN

GETRSLTS(RET,EXAM) ;EP

 N CNT,RL,RLIST

 ;S RET=$$TMPGBL^BGOUTL,CNT=0

 K RET

 S CNT=0

 Q:$G(EXAM)=""

 I EXAM'?1.N D

 .S EXAM=$O(^AUTTEXAM("B",EXAM,""))

 Q:'EXAM

 D VXAMR^AUPNCIX(EXAM,"RLIST")

 S RL=0

 F  S RL=$O(RLIST(RL)) Q:'RL  S CNT=CNT+1,RET(CNT)=$P(RLIST(RL),U,2)

 ; Get primary provider for this V EXAM

PRIPRV(RET,VXAM) ;EP

 S RET=$$PRIPRV^BGOUTL($P(^AUPNVXAM(VXAM,0),U,3))

 ; Delete a V EXAM or associated refusal

 ;  INP = IEN ^ "R" if refusal, otherwise null

DEL(RET,INP) ;EP

 N IEN,REFUSAL

 S IEN=+INP

 S REFUSAL=$P(INP,U,2)="R"

 I 'IEN S RET=$$ERR^BGOUTL(1008)

 E  I REFUSAL S RET=$$REFDEL^BGOUTL2(IEN)

 E  D VFDEL^BGOUTL2(.RET,$$FNUM,IEN)

 ; Set exam or refusal record

 ;  INP = V Exam IEN (if edit) [1] ^ Exam IEN [2] ^ Visit IEN [3] ^ Provider IEN [4] ^ Result [5] ^ Comment [6] ^

 ;        Event Date [7] ^ Location IEN [8] ^ Other Location [9] ^ Historical Flag [10] ^ DFN [11]

 ; .RET = Returned as -1^error text if error

SET(RET,INP) ;EP

 N VFIEN,VCAT,TYPE,VIEN,DFN,PROV,RESULT,COMMENT,EVNTDT,LOCIEN,OUTLOC,HIST,FDA,FNUM,VFNEW

 S RET="",FNUM=$$FNUM

 S VFIEN=$P(INP,U)

 S VFNEW='VFIEN

 S TYPE=$P(INP,U,2)

 S VIEN=+$P(INP,U,3)

 I 'TYPE S RET=$$ERR^BGOUTL(1077) Q

 S HIST=$P(INP,U,10)

 S DFN=$P(INP,U,11)

 I 'VIEN,'HIST S RET=$$ERR^BGOUTL(1002) Q

 S VCAT=$P($G(^AUPNVSIT(VIEN,0)),U,7)

 S:VCAT="E" HIST=1

 S PROV=$P(INP,U,4)

 ;IHS/MSC/MGH Patch 11

 I PROV="" S PROV=DUZ

 I 'PROV,'VFIEN S RET=$$ERR^BGOUTL(1027) Q

 S RESULT=$P(INP,U,5)

 S:RESULT="NORMAL"!(RESULT="NEGATIVE") RESULT="N"

 S COMMENT=$P(INP,U,6)

 S EVNTDT=$P(INP,U,7)

 I EVNTDT="" S EVNTDT=$$NOW^XLFDT

 S LOCIEN=$P(INP,U,8)

 S OUTLOC=$P(INP,U,9)

 I HIST D  Q:RET

 .S RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$S($L(OUTLOC):OUTLOC,1:LOCIEN),VIEN)

 .S:RET>0 VIEN=RET,RET="",VCAT="E"

 S RET=$$CHKVISIT^BGOUTL(VIEN,DFN)

 Q:RET

 I 'VFIEN D  Q:'VFIEN

 .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Exam")

 .S:RET>0 VFIEN=RET,RET=""

 S FDA=$NA(FDA(FNUM,VFIEN_","))

 S @FDA@(.01)="`"_TYPE

 S @FDA@(.04)=RESULT

 S:'VFNEW!$L(COMMENT) @FDA@(81101)=COMMENT

 ;IHS/MSC/MGH Patch 11 change for new fields

 ;S @FDA@(1204)="`"_DUZ

 S @FDA@(1204)="`"_PROV

 S @FDA@(1201)=EVNTDT

 ;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 V File #

FNUM() Q 9000010.13

BGOVEXAM  ; IHS/BAO/TMD - V Exam Management ;02-Oct-2013 13:02;PLS

 +1       ;;1.1;BGO COMPONENTS;**1,3,11,12,13**;Mar 20, 2007;Build 3

 +2       ; Return exam records for a patient

 +3       ;  DFN = Patient IEN

 +4       ; .RET = Returned as a list of record in one of two formats:

 +5       ;   For exams:

 +6       ;    E ^ Exam Name [2] ^ Visit Date [3] ^ Result [4] ^ Comment [5] ^ Provider Name [6] ^ Facility Name [7] ^

 +7       ;    Provider IEN [8] ^ Location Name [9] ^ Exam IEN [10] ^ V File IEN [11] ^ Visit IEN [12] ^ Visit Category [13] ^

 +8       ;    Visit Locked [14] ^ Event date [15]

 +9       ;

 +10      ;   For refusals:

 +11      ;    R ^ Exam Name [2] ^ Refusal Date [3] ^ Reason [4] ^ Comment [5] ^ Exam IEN [6] ^ V File IEN [7] ^

 +12      ;    Refusal Locked [8]

GET(RET,DFN) ;EP

 +1        NEW X,CNT,REC,VCAT,EXAM,VDT,VXAM,RESULT,LOC,FAC,FACNAM,EXNAME,PRVIEN,PRVNAME,EVNDT

 +2        NEW EXAM,VDATE,VIEN,COMMENT

 +3        SET RET=$$TMPGBL^BGOUTL

 +4        SET (CNT,EXAM)=0

 +5        FOR

               SET EXAM=$ORDER(^AUPNVXAM("AA",DFN,EXAM))

               IF 'EXAM

                   QUIT

               Begin DoDot:1

 +6                SET VDT=0

 +7                FOR

                       SET VDT=$ORDER(^AUPNVXAM("AA",DFN,EXAM,VDT))

                       IF 'VDT

                           QUIT

                       Begin DoDot:2

 +8                        SET VXAM=0

 +9                        FOR

                               SET VXAM=$ORDER(^AUPNVXAM("AA",DFN,EXAM,VDT,VXAM))

                               IF 'VXAM

                                   QUIT

                               Begin DoDot:3

 +10                               SET REC=$GET(^AUPNVXAM(VXAM,0))

 +11                               IF REC=""

                                       QUIT

 +12                               SET RESULT=$$EXTERNAL^DILFD($$FNUM,.04,,$PIECE(REC,U,4))

 +13                               IF RESULT=""

                                       IF $ORDER(^AUPNPREF("AA",DFN,9999999.15,EXAM,VDT,""))

                                           QUIT

 +14                               SET EXNAME=$PIECE($GET(^AUTTEXAM(EXAM,0)),U)

 +15                               SET PRVIEN=$PIECE($GET(^AUPNVXAM(VXAM,12)),U,4)

 +16      ;Patch 11

 +17                               SET EVNDT=$$FMTDATE^BGOUTL($PIECE($GET(^AUPNVXAM(VXAM,12)),U,1))

 +18                               SET PRVNAME=$SELECT('PRVIEN:"",1:$PIECE($GET(^VA(200,+PRVIEN,0)),U))

 +19                               SET VIEN=$PIECE(REC,U,3)

 +20                               IF 'VIEN

                                       QUIT

 +21                               SET LOC=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,6)

 +22                               SET FAC=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U,10),1:"")

 +23                               SET FACNAM=$SELECT(LOC:$PIECE($GET(^AUTTLOC(LOC,0)),U),1:"")

 +24                               IF FACNAM

                                       SET FACNAM=$PIECE($GET(^DIC(4,FACNAM,0)),U)

 +25                               IF $PIECE($GET(^AUPNVSIT(VIEN,21)),U)'=""

                                       SET FACNAM=$PIECE(^(21),U)

 +26                               SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)

 +27                               SET VDATE=$$FMTDATE^BGOUTL(9999999-VDT)

 +28                               SET COMMENT=$PIECE($GET(^AUPNVXAM(VXAM,811)),U)

 +29                               SET CNT=CNT+1

 +30                               SET @RET@(CNT)="E"_U_EXNAME_U_VDATE_U_RESULT_U_COMMENT_U_PRVNAME_U_FACNAM_U_PRVIEN_U_LOC_U_EXAM_U_VXAM_U_VIEN_U_VCAT_U_$$ISLOCKED^BEHOENCX(VIEN)_U_EVNDT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +31      ; Add refusal data

 +32       NEW ARRAY,CNT2,Z,STR,SAVE,SAVE2,DATA

 +33       SET CNT2=0

           SET ARRAY="DATA"

 +34       DO REFGET^BGOUTL2(.ARRAY,DFN,9999999.15,.CNT2)

 +35       SET Z=0

FOR

               SET Z=$ORDER(@ARRAY@(Z))

               IF Z=""

                   QUIT

               Begin DoDot:1

 +36               SET STR=$GET(@ARRAY@(Z))

 +37               SET SAVE=$PIECE(STR,U,13)

                   SET SAVE2=$PIECE(STR,U,11)

 +38               IF SAVE'=""

                       SET $PIECE(STR,U,11)=SAVE

                       SET $PIECE(STR,U,13)=SAVE2

 +39               SET CNT=CNT+1

 +40               SET @RET@(CNT)=STR

               End DoDot:1

 +41       QUIT

 +42      ; Return a list of exam types

 +43      ; Returned as a list of records in the format:

 +44      ;  Exam Type IEN ^ Exam Name ^ Exam Code ^ CPT Code

GETTYPES(RET,DUMMY) ;EP

 +1        NEW EXAM,CNT,REC,NAME,CODE,CPT

 +2        SET RET=$$TMPGBL^BGOUTL

 +3        SET (CNT,EXAM)=0

 +4        FOR

               SET EXAM=$ORDER(^AUTTEXAM(EXAM))

               IF 'EXAM

                   QUIT

               Begin DoDot:1

 +5                SET REC=$GET(^AUTTEXAM(EXAM,0))

 +6                IF '$LENGTH(REC)

                       QUIT

 +7                IF $PIECE(REC,U,4)=1

                       QUIT

 +8       ;Do not allow nutritional screening in list

 +9                IF $PIECE(REC,U,2)=40

                       QUIT

 +10               SET NAME=$PIECE(REC,U)

 +11               SET CODE=$PIECE(REC,U,2)

 +12               SET CPT=$PIECE(REC,U,11)

 +13               SET CNT=CNT+1

                   SET @RET@(CNT)=EXAM_U_NAME_U_CODE_U_CPT

               End DoDot:1

 +14       QUIT

 +15      ; Get list of valid results for a given EXAM Name or IEN

GETRSLTS(RET,EXAM) ;EP

 +1        NEW CNT,RL,RLIST

 +2       ;S RET=$$TMPGBL^BGOUTL,CNT=0

 +3        KILL RET

 +4        SET CNT=0

 +5        IF $GET(EXAM)=""

               QUIT

 +6        IF EXAM'?1.N

               Begin DoDot:1

 +7                SET EXAM=$ORDER(^AUTTEXAM("B",EXAM,""))

               End DoDot:1

 +8        IF 'EXAM

               QUIT

 +9        DO VXAMR^AUPNCIX(EXAM,"RLIST")

 +10       SET RL=0

 +11       FOR

               SET RL=$ORDER(RLIST(RL))

               IF 'RL

                   QUIT

               SET CNT=CNT+1

               SET RET(CNT)=$PIECE(RLIST(RL),U,2)

 +12       QUIT

 +13      ; Get primary provider for this V EXAM

PRIPRV(RET,VXAM) ;EP

 +1        SET RET=$$PRIPRV^BGOUTL($PIECE(^AUPNVXAM(VXAM,0),U,3))

 +2        QUIT

 +3       ; Delete a V EXAM or associated refusal

 +4       ;  INP = IEN ^ "R" if refusal, otherwise null

DEL(RET,INP) ;EP

 +1        NEW IEN,REFUSAL

 +2        SET IEN=+INP

 +3        SET REFUSAL=$PIECE(INP,U,2)="R"

 +4        IF 'IEN

               SET RET=$$ERR^BGOUTL(1008)

 +5       IF '$TEST

               IF REFUSAL

                   SET RET=$$REFDEL^BGOUTL2(IEN)

 +6       IF '$TEST

               DO VFDEL^BGOUTL2(.RET,$$FNUM,IEN)

 +7        QUIT

 +8       ; Set exam or refusal record

 +9       ;  INP = V Exam IEN (if edit) [1] ^ Exam IEN [2] ^ Visit IEN [3] ^ Provider IEN [4] ^ Result [5] ^ Comment [6] ^

 +10      ;        Event Date [7] ^ Location IEN [8] ^ Other Location [9] ^ Historical Flag [10] ^ DFN [11]

 +11      ; .RET = Returned as -1^error text if error

SET(RET,INP) ;EP

 +1        NEW VFIEN,VCAT,TYPE,VIEN,DFN,PROV,RESULT,COMMENT,EVNTDT,LOCIEN,OUTLOC,HIST,FDA,FNUM,VFNEW

 +2        SET RET=""

           SET FNUM=$$FNUM

 +3        SET VFIEN=$PIECE(INP,U)

 +4        SET VFNEW='VFIEN

 +5        SET TYPE=$PIECE(INP,U,2)

 +6        SET VIEN=+$PIECE(INP,U,3)

 +7        IF 'TYPE

               SET RET=$$ERR^BGOUTL(1077)

               QUIT

 +8        SET HIST=$PIECE(INP,U,10)

 +9        SET DFN=$PIECE(INP,U,11)

 +10       IF 'VIEN

               IF 'HIST

                   SET RET=$$ERR^BGOUTL(1002)

                   QUIT

 +11       SET VCAT=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,7)

 +12       IF VCAT="E"

               SET HIST=1

 +13       SET PROV=$PIECE(INP,U,4)

 +14      ;IHS/MSC/MGH Patch 11

 +15       IF PROV=""

               SET PROV=DUZ

 +16       IF 'PROV

               IF 'VFIEN

                   SET RET=$$ERR^BGOUTL(1027)

                   QUIT

 +17       SET RESULT=$PIECE(INP,U,5)

 +18       IF RESULT="NORMAL"!(RESULT="NEGATIVE")

               SET RESULT="N"

 +19       SET COMMENT=$PIECE(INP,U,6)

 +20       SET EVNTDT=$PIECE(INP,U,7)

 +21       IF EVNTDT=""

               SET EVNTDT=$$NOW^XLFDT

 +22       SET LOCIEN=$PIECE(INP,U,8)

 +23       SET OUTLOC=$PIECE(INP,U,9)

 +24       IF HIST

               Begin DoDot:1

 +25               SET RET=$$MAKEHIST^BGOUTL(DFN,EVNTDT,$SELECT($LENGTH(OUTLOC):OUTLOC,1:LOCIEN),VIEN)

 +26               IF RET>0

                       SET VIEN=RET

                       SET RET=""

                       SET VCAT="E"

               End DoDot:1

               IF RET

                   QUIT

 +27       SET RET=$$CHKVISIT^BGOUTL(VIEN,DFN)

 +28       IF RET

               QUIT

 +29       IF 'VFIEN

               Begin DoDot:1

 +30               DO VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,"Exam")

 +31               IF RET>0

                       SET VFIEN=RET

                       SET RET=""

               End DoDot:1

               IF 'VFIEN

                   QUIT

 +32       SET FDA=$NAME(FDA(FNUM,VFIEN_","))

 +33       SET @FDA@(.01)="`"_TYPE

 +34       SET @FDA@(.04)=RESULT

 +35       IF 'VFNEW!$LENGTH(COMMENT)

               SET @FDA@(81101)=COMMENT

 +36      ;IHS/MSC/MGH Patch 11 change for new fields

 +37      ;S @FDA@(1204)="`"_DUZ

 +38       SET @FDA@(1204)="`"_PROV

 +39       SET @FDA@(1201)=EVNTDT

 +40      ;Patch 11 Set date entered

 +41       IF VFNEW

               Begin DoDot:1

 +42               SET @FDA@(1216)="N"

 +43               SET @FDA@(1217)="`"_DUZ

               End DoDot:1

 +44      ;Patch 11 Set last modified

 +45       SET @FDA@(1218)="N"

 +46       SET @FDA@(1219)="`"_DUZ

 +47       SET RET=$$UPDATE^BGOUTL(.FDA,"E")

 +48       IF RET

               IF VFNEW

                   IF $$DELETE^BGOUTL(FNUM,VFIEN)

 +49       IF 'RET

               DO VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)

 +50       IF 'RET

               SET RET=VFIEN

 +51       QUIT

 +52      ; Return V File #

FNUM()     QUIT 9000010.13

BGOVEXAM.m