BHSEXAM1 ; IHS/MSC/MGH - Exams selected component;29-Oct-2012 11:24;DU
;;1.0;HEALTH SUMMARY COMPONENTS;**7**;March 17, 2006;Build 12
; SLC/SBW,KER - PCE Examination Comp ; 08/27/2002
;
;
; External References
; DBIA 3063 EXAM^PXRHS05
; DBIA 10011 ^DIWP
;
;For selected procedures see if you have a match
EXAM ;EP Get the selected exam list
N GMTSI,GMTSF,GMTSC,EXAM,EXAMSEL
Q:'$D(GMTSEG(GMTSEGN,9999999.15))
S GMTSI=0 F GMTSI=0:0 S GMTSI=$O(GMTSEG(GMTSEGN,9999999.15,GMTSI)) Q:'+GMTSI D
.S EXAM=$G(GMTSEG(GMTSEGN,9999999.15,GMTSI))
.S EXAMSEL(EXAM)=""
D SEL(.EXAMSEL)
Q
SEL(ITEMS) ;
N BHSPAT,V,Y,CNT,BHSEXAM,BHSIVD,BHIEN,EDATE,A,B,C,BHEXAM,BHSA,%
S BHSPAT=DFN
I '$D(^AUPNVXAM("AA",BHSPAT)) Q ;no exams for this patient
; <DISPLAY>
K BHCPTA
S CNT=0
I $D(ITEMS)>0 D
.S BHSEXAM=0 F S BHSEXAM=$O(ITEMS(BHSEXAM)) Q:BHSEXAM="" D
..Q:BHSEXAM=""
..S CNT=0
..S BHSIVD="" F S BHSIVD=$O(^AUPNVXAM("AA",BHSPAT,BHSEXAM,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM) D
...S BHIEN=0 F S BHIEN=$O(^AUPNVXAM("AA",BHSPAT,BHSEXAM,BHSIVD,BHIEN)) Q:BHIEN'=+BHIEN!(CNT+1>GMTSNDM) D
....S BHEXAM=$$VAL^XBDIQ1(9000010.13,BHIEN,.01)
....S EDATE=$$VAL^XBDIQ1(9000010.13,BHIEN,1201)
....S EDATE=$P(EDATE,"@",1)
....I EDATE="" S EDATE=$$VALI^XBDIQ1(9000010,$P(^AUPNVXAM(BHIEN,0),U,3),.01)
....S B=$$VAL^XBDIQ1(9000010.13,BHIEN,.04)
....S C=$$VAL^XBDIQ1(9000010.13,BHIEN,1204)
....S BHSA(BHEXAM,BHSIVD,BHIEN)=BHEXAM_U_EDATE_U_B_U_C
....S CNT=CNT+1
D CKP^GMTSUP Q:$D(GMTSQIT)
W "Exam",?32,"Date",?45,"Result",?65,"Provider",!
S BHSEXAM=0 F S BHSEXAM=$O(BHSA(BHSEXAM)) Q:BHSEXAM=""!($D(GMTSQIT)) D
.D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W ?28,"CODE",?34,"CPT NARRATIVE",?72,"UNITS",!
.;W $$DATE^BHSMU((9999999-BHSIVD))
.S BHSIVD="" F S BHSIVD=$O(BHSA(BHSEXAM,BHSIVD)) Q:BHSIVD=""!($D(GMTSQIT)) D
..S BHIEN=0 F S BHIEN=$O(BHSA(BHSEXAM,BHSIVD,BHIEN)) Q:BHIEN'=+BHIEN!($D(GMTSQIT)) D
...D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W "Exam",?32,"Date",?45,"Result",?65,"Provider",!
...S %=$G(BHSA(BHSEXAM,BHSIVD,BHIEN))
...W $P(%,U,1),?32,$P(%,U,2),?45,$P(%,U,3),?65,$P(%,U,4)
...W !
;
Q
HDR ; Header
W ?5,"Exam",?32,"Result",?47,"Date",?55,"Facility",!!
Q
BHSEXAM1 ; IHS/MSC/MGH - Exams selected component;29-Oct-2012 11:24;DU
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**7**;March 17, 2006;Build 12
+2 ; SLC/SBW,KER - PCE Examination Comp ; 08/27/2002
+3 ;
+4 ;
+5 ; External References
+6 ; DBIA 3063 EXAM^PXRHS05
+7 ; DBIA 10011 ^DIWP
+8 ;
+9 ;For selected procedures see if you have a match
EXAM ;EP Get the selected exam list
+1 NEW GMTSI,GMTSF,GMTSC,EXAM,EXAMSEL
+2 IF '$DATA(GMTSEG(GMTSEGN,9999999.15))
QUIT
+3 SET GMTSI=0
FOR GMTSI=0:0
SET GMTSI=$ORDER(GMTSEG(GMTSEGN,9999999.15,GMTSI))
IF '+GMTSI
QUIT
Begin DoDot:1
+4 SET EXAM=$GET(GMTSEG(GMTSEGN,9999999.15,GMTSI))
+5 SET EXAMSEL(EXAM)=""
End DoDot:1
+6 DO SEL(.EXAMSEL)
+7 QUIT
SEL(ITEMS) ;
+1 NEW BHSPAT,V,Y,CNT,BHSEXAM,BHSIVD,BHIEN,EDATE,A,B,C,BHEXAM,BHSA,%
+2 SET BHSPAT=DFN
+3 ;no exams for this patient
IF '$DATA(^AUPNVXAM("AA",BHSPAT))
QUIT
+4 ; <DISPLAY>
+5 KILL BHCPTA
+6 SET CNT=0
+7 IF $DATA(ITEMS)>0
Begin DoDot:1
+8 SET BHSEXAM=0
FOR
SET BHSEXAM=$ORDER(ITEMS(BHSEXAM))
IF BHSEXAM=""
QUIT
Begin DoDot:2
+9 IF BHSEXAM=""
QUIT
+10 SET CNT=0
+11 SET BHSIVD=""
FOR
SET BHSIVD=$ORDER(^AUPNVXAM("AA",BHSPAT,BHSEXAM,BHSIVD))
IF BHSIVD=""!(BHSIVD>GMTSDLM)
QUIT
Begin DoDot:3
+12 SET BHIEN=0
FOR
SET BHIEN=$ORDER(^AUPNVXAM("AA",BHSPAT,BHSEXAM,BHSIVD,BHIEN))
IF BHIEN'=+BHIEN!(CNT+1>GMTSNDM)
QUIT
Begin DoDot:4
+13 SET BHEXAM=$$VAL^XBDIQ1(9000010.13,BHIEN,.01)
+14 SET EDATE=$$VAL^XBDIQ1(9000010.13,BHIEN,1201)
+15 SET EDATE=$PIECE(EDATE,"@",1)
+16 IF EDATE=""
SET EDATE=$$VALI^XBDIQ1(9000010,$PIECE(^AUPNVXAM(BHIEN,0),U,3),.01)
+17 SET B=$$VAL^XBDIQ1(9000010.13,BHIEN,.04)
+18 SET C=$$VAL^XBDIQ1(9000010.13,BHIEN,1204)
+19 SET BHSA(BHEXAM,BHSIVD,BHIEN)=BHEXAM_U_EDATE_U_B_U_C
+20 SET CNT=CNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+22 WRITE "Exam",?32,"Date",?45,"Result",?65,"Provider",!
+23 SET BHSEXAM=0
FOR
SET BHSEXAM=$ORDER(BHSA(BHSEXAM))
IF BHSEXAM=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:1
+24 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
WRITE ?28,"CODE",?34,"CPT NARRATIVE",?72,"UNITS",!
+25 ;W $$DATE^BHSMU((9999999-BHSIVD))
+26 SET BHSIVD=""
FOR
SET BHSIVD=$ORDER(BHSA(BHSEXAM,BHSIVD))
IF BHSIVD=""!($DATA(GMTSQIT))
QUIT
Begin DoDot:2
+27 SET BHIEN=0
FOR
SET BHIEN=$ORDER(BHSA(BHSEXAM,BHSIVD,BHIEN))
IF BHIEN'=+BHIEN!($DATA(GMTSQIT))
QUIT
Begin DoDot:3
+28 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
WRITE "Exam",?32,"Date",?45,"Result",?65,"Provider",!
+29 SET %=$GET(BHSA(BHSEXAM,BHSIVD,BHIEN))
+30 WRITE $PIECE(%,U,1),?32,$PIECE(%,U,2),?45,$PIECE(%,U,3),?65,$PIECE(%,U,4)
+31 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 QUIT
HDR ; Header
+1 WRITE ?5,"Exam",?32,"Result",?47,"Date",?55,"Facility",!!
+2 QUIT
