KIDS Distribution saved on Sep 15, 2015@16:46:24
BHS Patch 10
**KIDS**:BHS*1.0*10^

**INSTALL NAME**
BHS*1.0*10
"BLD",5217,0)
BHS*1.0*10^HEALTH SUMMARY COMPONENTS^0^3150915^n
"BLD",5217,4,0)
^9.64PA^^
"BLD",5217,6.3)
4
"BLD",5217,"ABPKG")
n
"BLD",5217,"KRN",0)
^9.67PA^9002226^21
"BLD",5217,"KRN",.4,0)
.4
"BLD",5217,"KRN",.401,0)
.401
"BLD",5217,"KRN",.402,0)
.402
"BLD",5217,"KRN",.403,0)
.403
"BLD",5217,"KRN",.5,0)
.5
"BLD",5217,"KRN",.84,0)
.84
"BLD",5217,"KRN",.84,"NM",0)
^9.68A^^
"BLD",5217,"KRN",3.6,0)
3.6
"BLD",5217,"KRN",3.8,0)
3.8
"BLD",5217,"KRN",9.2,0)
9.2
"BLD",5217,"KRN",9.8,0)
9.8
"BLD",5217,"KRN",9.8,"NM",0)
^9.68A^15^1
"BLD",5217,"KRN",9.8,"NM",15,0)
BHSHS1^^0^B73730425
"BLD",5217,"KRN",9.8,"NM","B","BHSHS1",15)

"BLD",5217,"KRN",19,0)
19
"BLD",5217,"KRN",19.1,0)
19.1
"BLD",5217,"KRN",101,0)
101
"BLD",5217,"KRN",409.61,0)
409.61
"BLD",5217,"KRN",771,0)
771
"BLD",5217,"KRN",779.2,0)
779.2
"BLD",5217,"KRN",870,0)
870
"BLD",5217,"KRN",8989.51,0)
8989.51
"BLD",5217,"KRN",8989.52,0)
8989.52
"BLD",5217,"KRN",8994,0)
8994
"BLD",5217,"KRN",9002226,0)
9002226
"BLD",5217,"KRN","B",.4,.4)

"BLD",5217,"KRN","B",.401,.401)

"BLD",5217,"KRN","B",.402,.402)

"BLD",5217,"KRN","B",.403,.403)

"BLD",5217,"KRN","B",.5,.5)

"BLD",5217,"KRN","B",.84,.84)

"BLD",5217,"KRN","B",3.6,3.6)

"BLD",5217,"KRN","B",3.8,3.8)

"BLD",5217,"KRN","B",9.2,9.2)

"BLD",5217,"KRN","B",9.8,9.8)

"BLD",5217,"KRN","B",19,19)

"BLD",5217,"KRN","B",19.1,19.1)

"BLD",5217,"KRN","B",101,101)

"BLD",5217,"KRN","B",409.61,409.61)

"BLD",5217,"KRN","B",771,771)

"BLD",5217,"KRN","B",779.2,779.2)

"BLD",5217,"KRN","B",870,870)

"BLD",5217,"KRN","B",8989.51,8989.51)

"BLD",5217,"KRN","B",8989.52,8989.52)

"BLD",5217,"KRN","B",8994,8994)

"BLD",5217,"KRN","B",9002226,9002226)

"BLD",5217,"PRE")
BHSP10
"BLD",5217,"QUES",0)
^9.62^^
"BLD",5217,"REQB",0)
^9.611^3^3
"BLD",5217,"REQB",1,0)
BHS*1.0*9^1
"BLD",5217,"REQB",2,0)
ATX*5.1*11^1
"BLD",5217,"REQB",3,0)
BJPC*2.0*11^1
"BLD",5217,"REQB","B","ATX*5.1*11",2)

"BLD",5217,"REQB","B","BHS*1.0*9",1)

"BLD",5217,"REQB","B","BJPC*2.0*11",3)

"MBREQ")
0
"PKG",345,-1)
1^1
"PKG",345,0)
HEALTH SUMMARY COMPONENTS^BHS^Components for VA health summary from indian health
"PKG",345,20,0)
^9.402P^^
"PKG",345,22,0)
^9.49I^1^1
"PKG",345,22,1,0)
1.0^3060317^3060508^2
"PKG",345,22,1,"PAH",1,0)
10^3150915
"PRE")
BHSP10
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
2
"RTN","BHSHS1")
0^15^B73730425
"RTN","BHSHS1",1,0)
BHSHS1 ;IHS/CIA/MGH - Health Summary for pt history components ;15-Sep-2015 16:36;DU
"RTN","BHSHS1",2,0)
 ;;1.0;HEALTH SUMMARY COMPONENTS;**1,2,3,9,10**;March 17, 2006;Build 4
"RTN","BHSHS1",3,0)
 ;===================================================================
"RTN","BHSHS1",4,0)
 ;VA health summary components for history components
"RTN","BHSHS1",5,0)
 ;includes family hx, personal hx, and surgical hx
"RTN","BHSHS1",6,0)
 ;Taken from APCHS6
"RTN","BHSHS1",7,0)
 ; IHS/TUCSON/LAB - PART 6 OF APCHS -- SUMMARY PRODUCTION COMPONENTS ;
"RTN","BHSHS1",8,0)
 ;;2.0;IHS RPMS/PCC Health Summary;**11**;JUN 24, 1997
"RTN","BHSHS1",9,0)
 ;Patch 1 changes made up to IHS patch 14
"RTN","BHSHS1",10,0)
 ;Patch 2 chages made up to IHS patch 16
"RTN","BHSHS1",11,0)
 ;Patch 3 changes made up to bjpc version 2
"RTN","BHSHS1",12,0)
FMH ; ******************** FAMILY HISTORY * 9000014 *******
"RTN","BHSHS1",13,0)
 ; <SETUP>
"RTN","BHSHS1",14,0)
 N BHSPAT,BHSQ
"RTN","BHSHS1",15,0)
 S BHSPAT=DFN
"RTN","BHSHS1",16,0)
 Q:'$D(^AUPNFH("AC",BHSPAT))
"RTN","BHSHS1",17,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSHS1",18,0)
 ; <DISPLAY>
"RTN","BHSHS1",19,0)
 S BHSDFN="" F BHSQ=0:0 S BHSDFN=$O(^AUPNFH("AC",BHSPAT,BHSDFN)) Q:BHSDFN=""  D FHDSP
"RTN","BHSHS1",20,0)
 ; <CLEANUP>
"RTN","BHSHS1",21,0)
FMHX K BHSDFN,BHSN,BHSICD,BHSDAT,BHSNRQ,BHSICL,X,R,S,N,A
"RTN","BHSHS1",22,0)
 Q
"RTN","BHSHS1",23,0)
FHDSP S BHSN=^AUPNFH(BHSDFN,0)
"RTN","BHSHS1",24,0)
 S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
"RTN","BHSHS1",25,0)
 S X=$P(BHSN,U,3) D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSHS1",26,0)
 S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSHS1",27,0)
 D GETNARR^BHSUTL
"RTN","BHSHS1",28,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  W BHSDAT_" " ;S BHSICL=10 D PRTICD^BHSUTL
"RTN","BHSHS1",29,0)
 S (X,R,S,N,A)=""
"RTN","BHSHS1",30,0)
 S R=$$VAL^XBDIQ1(9000014,BHSDFN,.07)
"RTN","BHSHS1",31,0)
 S N=$$VAL^XBDIQ1(9000014,BHSDFN,.04)_" ("_$$VAL^XBDIQ1(9000014,BHSDFN,.01)_")"
"RTN","BHSHS1",32,0)
 S A=$P(^AUPNFH(BHSDFN,0),U,5)
"RTN","BHSHS1",33,0)
 S S=$$VAL^XBDIQ1(9000014,BHSDFN,.06)
"RTN","BHSHS1",34,0)
 S X=X_$S(R]"":R_"; ",1:"")
"RTN","BHSHS1",35,0)
 S X=X_$S(N]"":N_"; ",1:"")
"RTN","BHSHS1",36,0)
 S X=X_$S(A]"":A_"; ",1:"")
"RTN","BHSHS1",37,0)
 S X=X_$S(S]"":S_"; ",1:"")
"RTN","BHSHS1",38,0)
 W ?10,X,!
"RTN","BHSHS1",39,0)
 Q
"RTN","BHSHS1",40,0)
 ;
"RTN","BHSHS1",41,0)
PMH ; ******************** PERSONAL HISTORY * 9000013 *******
"RTN","BHSHS1",42,0)
 ; <SETUP>
"RTN","BHSHS1",43,0)
 N BHSPAT,BHSQ,BHSNTE,X
"RTN","BHSHS1",44,0)
 S BHSPAT=DFN
"RTN","BHSHS1",45,0)
 Q:'$D(^AUPNPH("AC",BHSPAT))
"RTN","BHSHS1",46,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSHS1",47,0)
 ; <DISPLAY>
"RTN","BHSHS1",48,0)
 S BHSDFN="" F BHSQ=0:0 S BHSDFN=$O(^AUPNPH("AC",BHSPAT,BHSDFN)) Q:BHSDFN=""  D PHDSP
"RTN","BHSHS1",49,0)
 ; <CLEANUP>
"RTN","BHSHS1",50,0)
PMHX K BHSDFN,BHSN,BHSICD,BHSICL,BHSNRQ,BHSDAT,BHSDTH
"RTN","BHSHS1",51,0)
 Q
"RTN","BHSHS1",52,0)
PHDSP S BHSN=^AUPNPH(BHSDFN,0)
"RTN","BHSHS1",53,0)
 S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
"RTN","BHSHS1",54,0)
 S X=$P(BHSN,U,3) D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSHS1",55,0)
 S BHSDTH=$P(BHSN,U,5) I BHSDTH]"" S X=BHSDTH D REGDT4^GMTSU S BHSDTH=X
"RTN","BHSHS1",56,0)
 S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSHS1",57,0)
 D GETNARR^BHSUTL
"RTN","BHSHS1",58,0)
 K BHSDTE S:BHSDTH]"" BHSNTE="(onset: "_BHSDTH_")"
"RTN","BHSHS1",59,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  W BHSDAT_" " S BHSICL=10 D PRTICD^BHSUTL
"RTN","BHSHS1",60,0)
 Q
"RTN","BHSHS1",61,0)
 ;
"RTN","BHSHS1",62,0)
HOS ; ************* HISTORY OF SURGERY * 9000010.08 (V PROCEDURE)& CPT *******
"RTN","BHSHS1",63,0)
 ; <SETUP>
"RTN","BHSHS1",64,0)
 N BHSPAT,BHSNTE,BHSQ,BHSDFN,BHSICD,BHSN,BHSCNT,BHSNRQ,BHSIVD,BHSDS,BHHOSA
"RTN","BHSHS1",65,0)
 N BHT,BHCPT,BHSIEN,BHCPTI,BHSCSVD,BHSCPT2,I,MATCH,SCODE,Z,TAXIEN,TAXARRAY,ARRAY,CODE
"RTN","BHSHS1",66,0)
 S BHSPAT=DFN,BHSCNT=0
"RTN","BHSHS1",67,0)
 S TAXARRAY="",ARRAY=""
"RTN","BHSHS1",68,0)
 ;Q:'$D(^AUPNVPRC("AC",BHSPAT))
"RTN","BHSHS1",69,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSHS1",70,0)
 S BHSCNT=0
"RTN","BHSHS1",71,0)
 ;IHS/MSC/MGH Move taxonomy build outside of loop
"RTN","BHSHS1",72,0)
 S TAXIEN=$O(^ATXAX("B","APCH MINOR SURGICAL PROCS",0))
"RTN","BHSHS1",73,0)
 I +TAXIEN D BLDTAX^ATXAPI($P(^ATXAX(TAXIEN,0),U),"TAXARRAY",TAXIEN)
"RTN","BHSHS1",74,0)
 ; <DISPLAY>
"RTN","BHSHS1",75,0)
 S BHSIVD=0 F  S BHSIVD=$O(^AUPNVPRC("AA",BHSPAT,BHSIVD)) Q:'BHSIVD  D
"RTN","BHSHS1",76,0)
 .S BHSDFN=0 F   S BHSDFN=$O(^AUPNVPRC("AA",BHSPAT,BHSIVD,BHSDFN)) Q:'BHSDFN  D        ;D HOSDSP Q:$D(GMTSQIT)
"RTN","BHSHS1",77,0)
 ..S BHSICD=$P(^AUPNVPRC(BHSDFN,0),U)
"RTN","BHSHS1",78,0)
 ..S BHSN=^AUPNVPRC(BHSDFN,0)
"RTN","BHSHS1",79,0)
 ..D HOSCHK Q:BHSICD=""
"RTN","BHSHS1",80,0)
 ..S BHSCNT=BHSCNT+1
"RTN","BHSHS1",81,0)
 ..S BHSCSVD=+^AUPNVSIT($P(BHSN,U,3),0)\1
"RTN","BHSHS1",82,0)
 ..D GETICDOP^BHSUTL
"RTN","BHSHS1",83,0)
 ..S Y=$P(BHSN,U,3),X=+^AUPNVSIT(Y,0)\1 D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSHS1",84,0)
 ..S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSHS1",85,0)
 ..I BHSNRQ D GETNARR^BHSUTL
"RTN","BHSHS1",86,0)
 ..;I BHSNRQ="" S BHSNRQ=$P(^ICD0($P(BHSN,U,1),0),U,4)
"RTN","BHSHS1",87,0)
 ..I BHSNRQ="" D
"RTN","BHSHS1",88,0)
 ...;Patch 9 for ICD-10
"RTN","BHSHS1",89,0)
 ...I $$AICD^BHSUTL S BHSNRQ=$P($$ICDOP^ICDEX($P(BHSN,U,1),+^AUPNVSIT($P(BHSN,U,3),0)\1,"","I"),U,5)  ;cmi/anch/maw 8/28/2007 code set
"RTN","BHSHS1",90,0)
 ...E  S BHSNRQ=$P($$ICDOP^ICDCODE($P(BHSN,U,1),+^AUPNVSIT($P(BHSN,U,3),0)\1),U,5)  ;cmi/anch/maw 8/28/2007 code set
"RTN","BHSHS1",91,0)
 ..S BHSDS="DATE?" D
"RTN","BHSHS1",92,0)
 ...S X=$P(BHSN,U,6) I X]"" D REGDT4^GMTSU S BHSDS=X Q
"RTN","BHSHS1",93,0)
 ...S X=(9999999-BHSIVD) D REGDT4^GMTSU S BHSDS=X
"RTN","BHSHS1",94,0)
 ..D GETOPRV
"RTN","BHSHS1",95,0)
 ..S BHHOSA(BHSIVD,"PRC",BHSDFN)=BHSDS_U_BHSNRQ_U_BHSOP_U_BHSICD
"RTN","BHSHS1",96,0)
 ;now go through v cpt
"RTN","BHSHS1",97,0)
 ;IHS/MSC/MGH Move taxonomy lookup outside of loop
"RTN","BHSHS1",98,0)
 S BHT=$O(^ATXAX("B","APCH HS MAJOR PROCEDURE CPTS",0))
"RTN","BHSHS1",99,0)
 I +BHT D BLDTAX^ATXAPI($P(^ATXAX(BHT,0),U),"ARRAY",BHT)
"RTN","BHSHS1",100,0)
 S BHCPTI=0 F  S BHCPTI=$O(^AUPNVCPT("AA",BHSPAT,BHCPTI)) Q:BHCPTI'=+BHCPTI  D
"RTN","BHSHS1",101,0)
 .;IHS/MSC/MGH Patch 10 new check from array
"RTN","BHSHS1",102,0)
 .;I '$$ICD^ATXCHK(BHCPTI,BHT,1) Q  ;not a cpt wanted on this compone
"RTN","BHSHS1",103,0)
 .S CODE=$P($G(^ICPT(BHCPTI,0)),U)
"RTN","BHSHS1",104,0)
 .I '$D(ARRAY(CODE)) Q     ;not a cpt wanted on this component
"RTN","BHSHS1",105,0)
 .S BHSIVD=0 F  S BHSIVD=$O(^AUPNVCPT("AA",BHSPAT,BHCPTI,BHSIVD)) Q:BHSIVD=""  D
"RTN","BHSHS1",106,0)
 ..S BHSIEN=0 F  S BHSIEN=$O(^AUPNVCPT("AA",BHSPAT,BHCPTI,BHSIVD,BHSIEN)) Q:BHSIEN'=+BHSIEN  D
"RTN","BHSHS1",107,0)
 ...S X=(9999999-BHSIVD) D REGDT4^GMTSU S BHSDS=X
"RTN","BHSHS1",108,0)
 ...S BHSN=^AUPNVCPT(BHSIEN,0)
"RTN","BHSHS1",109,0)
 ...S BHSICD=$P(BHSN,U,1)
"RTN","BHSHS1",110,0)
 ...D GETCPT^BHSUTL
"RTN","BHSHS1",111,0)
 ...S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSHS1",112,0)
 ...I BHSNRQ D GETNARR^BHSUTL
"RTN","BHSHS1",113,0)
 ...I BHSNRQ="" S BHSNRQ=$P(^ICPT($P(BHSN,U,1),0),U,2)
"RTN","BHSHS1",114,0)
 ...;IHS/MSC/MGH filter out duplicates
"RTN","BHSHS1",115,0)
 ...S MATCH=0
"RTN","BHSHS1",116,0)
 ...S I="" F  S I=$O(BHHOSA(BHSIVD,"PRC",I)) Q:I=""  D
"RTN","BHSHS1",117,0)
 ....S Z=$G(BHHOSA(BHSIVD,"PRC",I))
"RTN","BHSHS1",118,0)
 ....S BHSCPT2=$P(BHSICD,"-",1)
"RTN","BHSHS1",119,0)
 ....I $D(^ICPT(BHSCPT2,"ICD",0)) D
"RTN","BHSHS1",120,0)
 .....S SCODE=0 F  S SCODE=$O(^ICPT(BHSCPT2,"ICD",SCODE)) Q:SCODE=""!(SCODE="B")!(MATCH=1)  D
"RTN","BHSHS1",121,0)
 ......;Patch 9 for ICD-10
"RTN","BHSHS1",122,0)
 ......;I $P($G(^ICD0(SCODE,0)),U,1)=$P($P(Z,U,4),"-",1) S MATCH=1
"RTN","BHSHS1",123,0)
 ......I $$AICD^BHSUTL D
"RTN","BHSHS1",124,0)
 .......I $P($$ICDOP^ICDEX(SCODE,"","","I"),U,2)=$P($P(Z,U,4),"-",1) S MATCH=1
"RTN","BHSHS1",125,0)
 ......E  I $P($$ICDOP^ICDCODE(SCODE),U,2)=$P($P(Z,U,4),"-",1) S MATCH=1
"RTN","BHSHS1",126,0)
 ...I MATCH=0 D
"RTN","BHSHS1",127,0)
 ....S BHHOSA(BHSIVD,"CPT",BHSIEN)=BHSDS_U_BHSNRQ_U_$S($P($G(^AUPNVCPT(BHSIEN,12)),U,4):$$VAL^XBDIQ1(9000010.18,BHSIEN,1204),1:$$VAL^XBDIQ1(9000010.18,BHSIEN,1202))_U_BHSICD
"RTN","BHSHS1",128,0)
 ....S BHHOSC(BHSIVD,"CPT",$P(^ICPT($P(BHSN,U,1),0),U,1))=""
"RTN","BHSHS1",129,0)
 ;now get all tran codes hcpcs
"RTN","BHSHS1",130,0)
 S BHSIEN=0 F  S BHSIEN=$O(^AUPNVTC("AC",BHSPAT,BHSIEN)) Q:BHSIEN=""  D
"RTN","BHSHS1",131,0)
 .Q:'$D(^AUPNVTC(BHSIEN))
"RTN","BHSHS1",132,0)
 .S V=$P(^AUPNVTC(BHSIEN,0),U,3)
"RTN","BHSHS1",133,0)
 .Q:'V
"RTN","BHSHS1",134,0)
 .Q:'$D(^AUPNVSIT(V,0))
"RTN","BHSHS1",135,0)
 .S V=$P($P(^AUPNVSIT(V,0),U),".")
"RTN","BHSHS1",136,0)
 .S X=V  D REGDT4^GMTSU  S BHSDS=X
"RTN","BHSHS1",137,0)
 .S BHSIVD=9999999-V
"RTN","BHSHS1",138,0)
 .S BHCPT=$$VAL^XBDIQ1(9000010.33,BHSIEN,.07)
"RTN","BHSHS1",139,0)
 .S BHCPTI=$P(^AUPNVTC(BHSIEN,0),U,7)
"RTN","BHSHS1",140,0)
 .;IHS/MSC/MGH changed for patch 10
"RTN","BHSHS1",141,0)
 .Q:'BHCPTI
"RTN","BHSHS1",142,0)
 .;I '$$ICD^ATXCHK(BHCPTI,BHT,1) Q  ;not a cpt wanted on this compone
"RTN","BHSHS1",143,0)
 .S CODE=$P($G(^ICPT(BHCPTI,0)),U)
"RTN","BHSHS1",144,0)
 .I '$D(ARRAY(CODE)) Q     ;not a cpt wanted on this component
"RTN","BHSHS1",145,0)
 .Q:$D(BHHOSC(BHSIVD,"CPT",BHCPT))
"RTN","BHSHS1",146,0)
 .;S BHSNRQ=$P(^ICPT(BHCPTI,0),U,2)
"RTN","BHSHS1",147,0)
 .S BHSNRQ=$P($$CPT^ICPTCOD(BHCPTI,V),U,3)
"RTN","BHSHS1",148,0)
 .S BHSICD=BHCPTI
"RTN","BHSHS1",149,0)
 .D GETCPT^BHSUTL
"RTN","BHSHS1",150,0)
 .S BHHOSA(BHSIVD,"CPT",BHSIEN)=BHSDS_U_BHSNRQ_U_$S($P($G(^AUPNVTC(BHSIEN,12)),U,4):$$VAL^XBDIQ1(9000010.33,BHSIEN,1204),1:$$VAL^XBDIQ1(9000010.33,BHSIEN,1202))_U_BHSICD
"RTN","BHSHS1",151,0)
 ;now display the procedures/cpt codes
"RTN","BHSHS1",152,0)
 W ?1,"TIME",?12,"USER",?30,"CODE AND TEXT",!
"RTN","BHSHS1",153,0)
 S BHSIVD=0 F  S BHSIVD=$O(BHHOSA(BHSIVD)) Q:BHSIVD=""!($D(GMTSQIT))  D
"RTN","BHSHS1",154,0)
 .D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSHS1",155,0)
 .  S BHIEN=0 F  S BHIEN=$O(BHHOSA(BHSIVD,"PRC",BHIEN)) Q:BHIEN'=+BHIEN!($D(GMTSQIT))  D
"RTN","BHSHS1",156,0)
 .. S BHSOP=$P(BHHOSA(BHSIVD,"PRC",BHIEN),U,3)
"RTN","BHSHS1",157,0)
 .. S BHSNRQ=$P(BHHOSA(BHSIVD,"PRC",BHIEN),U,2)
"RTN","BHSHS1",158,0)
 .. S BHSDS=$P(BHHOSA(BHSIVD,"PRC",BHIEN),U,1)
"RTN","BHSHS1",159,0)
 .. S BHSICD=$P(BHHOSA(BHSIVD,"PRC",BHIEN),U,4)
"RTN","BHSHS1",160,0)
 .. W BHSDS,?12,$E(BHSOP,1,15) S BHSNTE="" S BHSICL=26 D PRTICD^BHSUTL
"RTN","BHSHS1",161,0)
 .S BHIEN=0 F  S BHIEN=$O(BHHOSA(BHSIVD,"CPT",BHIEN)) Q:BHIEN'=+BHIEN!($D(GMTSQIT))  D
"RTN","BHSHS1",162,0)
 .. S BHSOP=$P(BHHOSA(BHSIVD,"CPT",BHIEN),U,3)     ;the user
"RTN","BHSHS1",163,0)
 .. S BHSNRQ=$P(BHHOSA(BHSIVD,"CPT",BHIEN),U,2)    ;the narrative
"RTN","BHSHS1",164,0)
 .. S BHSDS=$P(BHHOSA(BHSIVD,"CPT",BHIEN),U,1)     ;the date
"RTN","BHSHS1",165,0)
 .. S BHSICD=$P(BHHOSA(BHSIVD,"CPT",BHIEN),U,4)    ;the code and text
"RTN","BHSHS1",166,0)
 .. W BHSDS,?12,$E(BHSOP,1,15) S BHSNTE="" S BHSICL=26 D PRTICD^BHSUTL
"RTN","BHSHS1",167,0)
 I 'BHSCNT D CKP^GMTSUP Q:$D(GMTSQIT)  W "Minor procedures are on file but have not been displayed.",!
"RTN","BHSHS1",168,0)
 ; now display refusals for icd procedures
"RTN","BHSHS1",169,0)
 S BHSFN=80.1,BHST="PROCEDURE"
"RTN","BHSHS1",170,0)
 S BHSS="S %=0,BHSICD=$P(^AUPNPREF(BHSI,0),U,6) Q:'BHSICD  D HOSCHK^BHSHS1 I BHSICD S %=1"
"RTN","BHSHS1",171,0)
 D DISPREF^BHSRAD
"RTN","BHSHS1",172,0)
 S BHSFN=81,BHST="CPT"
"RTN","BHSHS1",173,0)
 ;IHS/MSC/MGH  Patch 10
"RTN","BHSHS1",174,0)
 S BHSS="S %=0,BHCPT=$P(^AUPNPREF(BHSI,0),U,6) Q:'BHCPT  I $D(ARRAY($P($G(^ICPT(BHCPT,0)),U))) S %=1"
"RTN","BHSHS1",175,0)
 ;I $$ICD^ATXCHK(BHCPT,$O(^ATXAX(""B"",""APCH HS MAJOR PROCEDURE CPTS"",0)),1) S %=1"
"RTN","BHSHS1",176,0)
 D DISPREF^BHSRAD
"RTN","BHSHS1",177,0)
 ; <CLEANUP>
"RTN","BHSHS1",178,0)
HOSX K BHSDFN,BHSICD,BHSNRQ,BHSDAT,BHSDS,BHSICL,BHSIVD,BHSCOD,BHSCNT,BHSOPN,BHSOP,Y,BHIEN,BHHOSC,BHSS,BHST,BHSFN,V
"RTN","BHSHS1",179,0)
 Q
"RTN","BHSHS1",180,0)
HOSDSP S BHSN=^AUPNVPRC(BHSDFN,0)
"RTN","BHSHS1",181,0)
 S BHSICD=$P(BHSN,U,1)
"RTN","BHSHS1",182,0)
 D HOSCHK Q:BHSICD=""
"RTN","BHSHS1",183,0)
 S BHSCNT=BHSCNT+1
"RTN","BHSHS1",184,0)
 S BHSCSVD=+^AUPNVSIT($P(BHSN,U,3),0)\1
"RTN","BHSHS1",185,0)
 D GETICDOP^BHSUTL
"RTN","BHSHS1",186,0)
 S Y=$P(BHSN,U,3),X=+^AUPNVSIT(Y,0)\1 D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSHS1",187,0)
 S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSHS1",188,0)
 ;Fixed patch 1001
"RTN","BHSHS1",189,0)
 I BHSNRQ D GETNARR^BHSUTL
"RTN","BHSHS1",190,0)
 ;I BHSNRQ="" S BHSNRQ=$P(^ICD0($P(BHSN,U,1),0),U,4)
"RTN","BHSHS1",191,0)
 ;Patch 9 for ICD-10
"RTN","BHSHS1",192,0)
 I $$AICD^BHSUTL D
"RTN","BHSHS1",193,0)
 .I BHSNRQ="" S BHSNRQ=$P($$ICDOP^ICDEX($P(BHSN,U,1),BHSDAT,"","I"),U,5)  ;cmi/anch/maw 8/28/2007 code set versioning
"RTN","BHSHS1",194,0)
 E  I BHSNRQ="" S BHSNRQ=$P($$ICDOP^ICDCODE($P(BHSN,U,1),BHSDAT),U,5)  ;cmi/anch/maw 8/28/2007 code set versioning
"RTN","BHSHS1",195,0)
 ;end patch
"RTN","BHSHS1",196,0)
 S BHSDS="DATE?",X=$P(BHSN,U,6) I Y]"" D REGDT4^GMTSU S BHSDS=X
"RTN","BHSHS1",197,0)
 D GETOPRV
"RTN","BHSHS1",198,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSHS1",199,0)
 W BHSDS W ?12,BHSOP S BHSNTE="" S BHSICL=26 D PRTICD^BHSUTL
"RTN","BHSHS1",200,0)
 K BHSOP
"RTN","BHSHS1",201,0)
 Q
"RTN","BHSHS1",202,0)
HOSCHK ;
"RTN","BHSHS1",203,0)
 ;S BHSCOD=+^ICD0(BHSICD,0)
"RTN","BHSHS1",204,0)
 ;Patch 9 for ICD-10
"RTN","BHSHS1",205,0)
 I $$AICD^BHSUTL S BHSCOD=$P($$ICDOP^ICDEX(BHSICD,"","","I"),U,2)
"RTN","BHSHS1",206,0)
 E  S BHSCOD=$P($$ICDOP^ICDCODE(BHSICD),U,2)
"RTN","BHSHS1",207,0)
 I $D(TAXARRAY(BHSCOD)) S BHSICD=""
"RTN","BHSHS1",208,0)
 ;I $$ICD^ATXAPI(BHSCOD,$O(^ATXAX("B","APCH MINOR SURGICAL PROCS",0)),0) S BHSICD=""
"RTN","BHSHS1",209,0)
 ;I BHSCOD\1>85 S BHSICD="" Q
"RTN","BHSHS1",210,0)
 ;I BHSCOD=69.7 S BHSICD="" Q
"RTN","BHSHS1",211,0)
 ;I BHSCOD\1=23 S BHSICD="" Q
"RTN","BHSHS1",212,0)
 ;I BHSCOD\1=24 S BHSICD="" Q
"RTN","BHSHS1",213,0)
 ;I $E(BHSCOD,1,4)="38.9" S BHSICD="" Q
"RTN","BHSHS1",214,0)
 ;I BHSCOD=73.09 S BHSICD="" Q
"RTN","BHSHS1",215,0)
 Q
"RTN","BHSHS1",216,0)
GETOPRV ;get Operating Provider
"RTN","BHSHS1",217,0)
 NEW BHSOPN
"RTN","BHSHS1",218,0)
 S BHSOP=""
"RTN","BHSHS1",219,0)
 S BHSOPN=$P(BHSN,U,11)
"RTN","BHSHS1",220,0)
 Q:'+BHSOPN
"RTN","BHSHS1",221,0)
 S BHSOP=$E($P($G(^VA(200,BHSOPN,0)),U,1),1,15)    ;provider name
"RTN","BHSHS1",222,0)
 Q
"RTN","BHSP10")
0^^B4514054
"RTN","BHSP10",1,0)
BHSP10 ; IHS/MSC/MGH - PRE-INSTALL ROUTINE FOR BHS PATCH 10 ;01-Sep-2015 08:48;DU
"RTN","BHSP10",2,0)
 ;;1.0;HEALTH SUMMARY COMPONENTS;**10**;March 17, 2006;Build 4
"RTN","BHSP10",3,0)
 ;
"RTN","BHSP10",4,0)
ENV ;EP; environment check
"RTN","BHSP10",5,0)
 N PATCH
"RTN","BHSP10",6,0)
 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BHSP10",7,0)
 ;
"RTN","BHSP10",8,0)
 ;Check for released version added
"RTN","BHSP10",9,0)
 NEW IEN,PKG S PKG="HEALTH SUMMARY COMPONENTS 1.0",IEN=$O(^XPD(9.6,"B",PKG,0))
"RTN","BHSP10",10,0)
 I 'IEN W !,"You must first install "_PKG_"." S XPDQUIT=2 Q
"RTN","BHSP10",11,0)
 ;
"RTN","BHSP10",12,0)
 ;
"RTN","BHSP10",13,0)
 ;Check for the installation of other patches
"RTN","BHSP10",14,0)
 S PATCH="BHS*1.0*9"
"RTN","BHSP10",15,0)
 I '$$PATCH(PATCH) D  Q
"RTN","BHSP10",16,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","BHSP10",17,0)
 S PATCH="BJPC*2.0*11"
"RTN","BHSP10",18,0)
 I '$$PATCH(PATCH) D  Q
"RTN","BHSP10",19,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","BHSP10",20,0)
 S PATCH="TIU*1.0*1012"
"RTN","BHSP10",21,0)
 I '$$PATCH(PATCH) D  Q
"RTN","BHSP10",22,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","BHSP10",23,0)
 S PATCH="ATX*5.1*11"
"RTN","BHSP10",24,0)
 I '$$PATCH(PATCH) D  Q
"RTN","BHSP10",25,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","BHSP10",26,0)
 Q
"RTN","BHSP10",27,0)
 N IN,INSTDA,STAT
"RTN","BHSP10",28,0)
 S IN="IHS STANDARD TERMINOLOGY 1.0",INSTDA=""
"RTN","BHSP10",29,0)
 I '$D(^XPD(9.7,"B",IN)) D  Q
"RTN","BHSP10",30,0)
 .W !,"You must first install the IHS Standard Terminology 1.0  before installing this patch"
"RTN","BHSP10",31,0)
 S INSTDA=$O(^XPD(9.7,"B",IN,INSTDA),-1)
"RTN","BHSP10",32,0)
 S STAT=+$P($G(^XPD(9.7,INSTDA,0)),U,9)
"RTN","BHSP10",33,0)
 I STAT'=3 D  Q
"RTN","BHSP10",34,0)
 .W !,"IHS Standard Terminology 1.0 must be completely installed before installing this patch"
"RTN","BHSP10",35,0)
 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BHSP10",36,0)
 ;
"RTN","BHSP10",37,0)
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
"RTN","BHSP10",38,0)
 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
"RTN","BHSP10",39,0)
 Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
"RTN","BHSP10",40,0)
 NEW NUM,I,J
"RTN","BHSP10",41,0)
 S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
"RTN","BHSP10",42,0)
 S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
"RTN","BHSP10",43,0)
 ;check if patch is just a number
"RTN","BHSP10",44,0)
 Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
"RTN","BHSP10",45,0)
 S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
"RTN","BHSP10",46,0)
 Q (X=+NUM)
"RTN","BHSP10",47,0)
 ;
"VER")
8.0^22.0
**END**
**END**