- 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
