KIDS Distribution saved on Apr 07, 2020@13:04:38
Include telemedicine visits
**KIDS**:BHS*1.0*16^

**INSTALL NAME**
BHS*1.0*16
"BLD",5640,0)
BHS*1.0*16^HEALTH SUMMARY COMPONENTS^0^3200407^n
"BLD",5640,4,0)
^9.64PA^^
"BLD",5640,6.3)
1
"BLD",5640,"ABPKG")
n
"BLD",5640,"KRN",0)
^9.67PA^9002226^21
"BLD",5640,"KRN",.4,0)
.4
"BLD",5640,"KRN",.401,0)
.401
"BLD",5640,"KRN",.402,0)
.402
"BLD",5640,"KRN",.403,0)
.403
"BLD",5640,"KRN",.5,0)
.5
"BLD",5640,"KRN",.84,0)
.84
"BLD",5640,"KRN",3.6,0)
3.6
"BLD",5640,"KRN",3.8,0)
3.8
"BLD",5640,"KRN",9.2,0)
9.2
"BLD",5640,"KRN",9.8,0)
9.8
"BLD",5640,"KRN",9.8,"NM",0)
^9.68A^2^2
"BLD",5640,"KRN",9.8,"NM",1,0)
BHSENC^^0^B30316845
"BLD",5640,"KRN",9.8,"NM",2,0)
BHSENC2^^0^B25082382
"BLD",5640,"KRN",9.8,"NM","B","BHSENC",1)

"BLD",5640,"KRN",9.8,"NM","B","BHSENC2",2)

"BLD",5640,"KRN",19,0)
19
"BLD",5640,"KRN",19,"NM",0)
^9.68A^^
"BLD",5640,"KRN",19.1,0)
19.1
"BLD",5640,"KRN",101,0)
101
"BLD",5640,"KRN",409.61,0)
409.61
"BLD",5640,"KRN",771,0)
771
"BLD",5640,"KRN",779.2,0)
779.2
"BLD",5640,"KRN",870,0)
870
"BLD",5640,"KRN",8989.51,0)
8989.51
"BLD",5640,"KRN",8989.52,0)
8989.52
"BLD",5640,"KRN",8994,0)
8994
"BLD",5640,"KRN",9002226,0)
9002226
"BLD",5640,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",5640,"KRN","B",3.6,3.6)

"BLD",5640,"KRN","B",3.8,3.8)

"BLD",5640,"KRN","B",9.2,9.2)

"BLD",5640,"KRN","B",9.8,9.8)

"BLD",5640,"KRN","B",19,19)

"BLD",5640,"KRN","B",19.1,19.1)

"BLD",5640,"KRN","B",101,101)

"BLD",5640,"KRN","B",409.61,409.61)

"BLD",5640,"KRN","B",771,771)

"BLD",5640,"KRN","B",779.2,779.2)

"BLD",5640,"KRN","B",870,870)

"BLD",5640,"KRN","B",8989.51,8989.51)

"BLD",5640,"KRN","B",8989.52,8989.52)

"BLD",5640,"KRN","B",8994,8994)

"BLD",5640,"KRN","B",9002226,9002226)

"BLD",5640,"PRE")
BHSP16
"BLD",5640,"QUES",0)
^9.62^^
"BLD",5640,"REQB",0)
^9.611^1^1
"BLD",5640,"REQB",1,0)
BHS*1.0*15^1
"BLD",5640,"REQB","B","BHS*1.0*15",1)

"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)
16^3200407
"PRE")
BHSP16
"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")
3
"RTN","BHSENC")
0^1^B30316845
"RTN","BHSENC",1,0)
BHSENC ;IHS/CIA/MGH - Encounters from PCC ;06-Apr-2020 15:43;DU
"RTN","BHSENC",2,0)
 ;;1.0;HEALTH SUMMARY COMPONENTS;**8,13,16**;Jan 06, 2006;Build 1
"RTN","BHSENC",3,0)
 ;===================================================================
"RTN","BHSENC",4,0)
 ;Taken from APCHS2B
"RTN","BHSENC",5,0)
 ; IHS/TUCSON/LAB - PART 2B OF BHS -- SUMMARY PRODUCTION COMPONENTS ;  [ 06/10/03  11:13 AM ]
"RTN","BHSENC",6,0)
 ;;2.0;IHS RPMS/PCC Health Summary;**3,11,12**;JUN 24, 1997
"RTN","BHSENC",7,0)
 ;IHS/MSC/MGH added telemed visits patch 16
"RTN","BHSENC",8,0)
 ;
"RTN","BHSENC",9,0)
OUTPT ; ********** OUTPATIENT ENCOUNTERS * 9000010/9000010.07 **********
"RTN","BHSENC",10,0)
 ; <SETUP>
"RTN","BHSENC",11,0)
 N BHSN,BHSNTE,BHSPRV,BHSQ,X
"RTN","BHSENC",12,0)
 S BHSPAT=DFN
"RTN","BHSENC",13,0)
 Q:'$D(^AUPNVSIT("AA",BHSPAT))
"RTN","BHSENC",14,0)
 S BHSOVT="ARSCOTEM" ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
"RTN","BHSENC",15,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSENC",16,0)
 ; <DISPLAY>
"RTN","BHSENC",17,0)
 S BHSPVD=0
"RTN","BHSENC",18,0)
 S BHSPFN="" S BHSDCX="",BHSDPR=""
"RTN","BHSENC",19,0)
 I GMPXHLOC="Y" S BHSDCX=1
"RTN","BHSENC",20,0)
 S BHSDPR=1
"RTN","BHSENC",21,0)
 I 'BHSDPR,'BHSDCX S BHSDCL=23
"RTN","BHSENC",22,0)
 I BHSDCX,'BHSDPR S BHSDCL=32
"RTN","BHSENC",23,0)
 I BHSDCX,BHSDPR S BHSDCL=35
"RTN","BHSENC",24,0)
 I 'BHSDCX,BHSDPR S BHSDCL=28
"RTN","BHSENC",25,0)
 F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D  Q:GMTSNDM=0!(BHSQT)
"RTN","BHSENC",26,0)
 .  S BHSQT=1
"RTN","BHSENC",27,0)
 .  D ONEDATE
"RTN","BHSENC",28,0)
 .  Q:$D(GMTSQIT)
"RTN","BHSENC",29,0)
 .  S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT
"RTN","BHSENC",30,0)
 .  S BHSQT=0
"RTN","BHSENC",31,0)
 .  Q
"RTN","BHSENC",32,0)
 ;
"RTN","BHSENC",33,0)
OUTPTX ; <CLEANUP>
"RTN","BHSENC",34,0)
 K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,GMTSNDT,BHSCLI,BHSPDN,BHSICD,BHSP,BHSICL,BHSNRQ,BHSDPR,BHSDCX
"RTN","BHSENC",35,0)
 K BHSNFL,BHSNSH,BHSCCL,BHSNAB,BHSVSC,BHSITE,BHSQT,BHSDCL,Y,BHSSNO,BHSNORM
"RTN","BHSENC",36,0)
 Q
"RTN","BHSENC",37,0)
 ;
"RTN","BHSENC",38,0)
ONEDATE ;
"RTN","BHSENC",39,0)
 S BHSCCL=""
"RTN","BHSENC",40,0)
 S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSENC",41,0)
 S BHSDTU=0,GMTSNDT=(BHSDAT'=BHSPVD)
"RTN","BHSENC",42,0)
 S BHSVDF="" F BHSQ=0:0 S BHSVDF=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD,BHSVDF)) Q:BHSVDF=""  D  Q:BHSQT
"RTN","BHSENC",43,0)
 .  S BHSQT=1
"RTN","BHSENC",44,0)
 .  S BHSSCL=""
"RTN","BHSENC",45,0)
 .  S BHSN=^AUPNVSIT(BHSVDF,0)
"RTN","BHSENC",46,0)
 .  I $P(BHSN,U,7)="E",'$D(^AUPNVPOV("AD",BHSVDF)) Q  ;don't display events with no pov
"RTN","BHSENC",47,0)
 .  I $P(BHSN,U,7)="I",'$D(^AUPNVPOV("AD",BHSVDF)) Q  ;don't display events with no pov
"RTN","BHSENC",48,0)
 .  I +$P(BHSN,U,9),'$P(BHSN,U,11) D GETCLN,GETPROV,GETSITEV^BHSUTL D
"RTN","BHSENC",49,0)
 ..  I BHSOVT[BHSVSC D DSPVIS
"RTN","BHSENC",50,0)
 ..  Q
"RTN","BHSENC",51,0)
 .  Q:$D(GMTSQIT)
"RTN","BHSENC",52,0)
 .  S BHSQT=0
"RTN","BHSENC",53,0)
 .  Q
"RTN","BHSENC",54,0)
 Q
"RTN","BHSENC",55,0)
 ;
"RTN","BHSENC",56,0)
GETPROV ;
"RTN","BHSENC",57,0)
 S BHSPRV=$$PRIMPROV^APCLV(BHSVDF,"T")
"RTN","BHSENC",58,0)
 Q
"RTN","BHSENC",59,0)
GETCLN ;
"RTN","BHSENC",60,0)
 S BHSCLI=$P(BHSN,U,8) I BHSCLI="" S BHSCCL="<none>" Q
"RTN","BHSENC",61,0)
 S BHSCLI=$P(BHSN,U,8) Q:BHSCLI=""
"RTN","BHSENC",62,0)
 Q:'$D(^DIC(40.7,BHSCLI))
"RTN","BHSENC",63,0)
 I $D(^DIC(40.7,BHSCLI,9999999)),$P(^(9999999),U,1)]"" S BHSCLI=$E($P(^DIC(40.7,BHSCLI,9999999),U,1),1,6),BHSCCL=BHSCLI Q
"RTN","BHSENC",64,0)
 S BHSCLI=$E($P(^DIC(40.7,BHSCLI,0),U,1),1,8)
"RTN","BHSENC",65,0)
 S BHSCCL=BHSCLI
"RTN","BHSENC",66,0)
 Q
"RTN","BHSENC",67,0)
DSPVIS ;
"RTN","BHSENC",68,0)
 S BHSDTU=1
"RTN","BHSENC",69,0)
 I $O(^AUPNVPOV("AD",BHSVDF,""))="" D NOPOV Q
"RTN","BHSENC",70,0)
 S BHSPDN="" F BHSQ=0:0 S BHSPDN=$O(^AUPNVPOV("AD",BHSVDF,BHSPDN)) Q:'BHSPDN  S BHSN=^AUPNVPOV(BHSPDN,0) D HASPOV
"RTN","BHSENC",71,0)
 Q
"RTN","BHSENC",72,0)
 ;
"RTN","BHSENC",73,0)
NOPOV ;
"RTN","BHSENC",74,0)
 S (BHSICD,BHSNRQ)="<purpose of visit not yet entered>",BHSMOD=""
"RTN","BHSENC",75,0)
 G COMMON
"RTN","BHSENC",76,0)
 ;
"RTN","BHSENC",77,0)
HASPOV ;
"RTN","BHSENC",78,0)
 ;IHS/MSC/MGH added norm/abnormal Patch 13
"RTN","BHSENC",79,0)
 S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
"RTN","BHSENC",80,0)
 S BHSSNO=$$GET1^DIQ(9000010.07,BHSPDN,1101)
"RTN","BHSENC",81,0)
 S BHSNORM=$$GET1^DIQ(9000010.07,BHSPDN,.29)
"RTN","BHSENC",82,0)
 S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSENC",83,0)
 ;D GETNARR^BHSUTL I $P(BHSN,U,5)]"" S BHSNRQ=BHSNRQ_"  (Stage: "_$P(BHSN,U,5)_")"  ;IHS/CMI/LAB - patched to display stage of 0
"RTN","BHSENC",84,0)
 D GETNARR^BHSUTL I BHSSNO'="" S BHSNRQ=BHSNRQ_";"_BHSNORM_" ("_BHSSNO_")"   ;patch 8 add SNOMED
"RTN","BHSENC",85,0)
 S BHSMOD=$P(BHSN,U,6)
"RTN","BHSENC",86,0)
COMMON ;
"RTN","BHSENC",87,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  S:GMTSNPG GMTSNDT=1
"RTN","BHSENC",88,0)
 I GMTSNDT W BHSDAT S (BHSPFN,BHSSCL)="",GMTSNDT=0
"RTN","BHSENC",89,0)
 I BHSNSH=BHSPFN S BHSFAC=""
"RTN","BHSENC",90,0)
 E  S (BHSFAC,BHSPFN)=BHSNSH,BHSSCL=""
"RTN","BHSENC",91,0)
 I BHSCCL=BHSSCL S BHSCLI=""
"RTN","BHSENC",92,0)
 E  S (BHSCLI,BHSSCL)=BHSCCL
"RTN","BHSENC",93,0)
 I BHSICD["<purpose of visit not"&(BHSSCL="<none>") S BHSCLI=""
"RTN","BHSENC",94,0)
 I BHSMOD]"" S BHSMTX=$P(^DD(9000010.07,.06,0),U,3),BHSMTX=$P($P(BHSMTX,BHSMOD_":",2),";",1),BHSMTX=$P(BHSMTX,",",1),BHSICD=BHSMTX_" "_BHSICD
"RTN","BHSENC",95,0)
 S:$D(^AUPNVCHS("AD",BHSVDF)) BHSNTE="*** CHS ***"
"RTN","BHSENC",96,0)
 ;S BHSICL=$S(BHSCLI'=" ":35,1:23)
"RTN","BHSENC",97,0)
 W ?10,BHSFAC
"RTN","BHSENC",98,0)
 I BHSDCX,BHSDPR W ?23,$E(BHSCLI,1,6),?30,BHSPRV
"RTN","BHSENC",99,0)
 I BHSDCX,'BHSDPR W ?23,BHSCLI
"RTN","BHSENC",100,0)
 I 'BHSDCX,BHSDPR W ?23,BHSPRV
"RTN","BHSENC",101,0)
 S BHSICL=BHSDCL
"RTN","BHSENC",102,0)
 S:0 BHSICD=BHSVSC_":"_BHSICD D PRTICD^BHSUTL
"RTN","BHSENC",103,0)
 I $D(BHSPDN) D QUAL(BHSPDN)   ;Patch 8 add qualifiers
"RTN","BHSENC",104,0)
 Q
"RTN","BHSENC",105,0)
INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
"RTN","BHSENC",106,0)
 ; <SETUP>
"RTN","BHSENC",107,0)
 N BHSPAT
"RTN","BHSENC",108,0)
 S BHSPAT=DFN
"RTN","BHSENC",109,0)
 Q:'$D(^AUPNVSIT("AA",BHSPAT))
"RTN","BHSENC",110,0)
 S BHSOVT="I" ; NOTE: This controls types of visits displayed
"RTN","BHSENC",111,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSENC",112,0)
 ; <DISPLAY>
"RTN","BHSENC",113,0)
 S BHSDCX="",BHSDPR=""
"RTN","BHSENC",114,0)
 I GMPXHLOC="Y" S BHSDCX=1
"RTN","BHSENC",115,0)
 S BHSDPR=1
"RTN","BHSENC",116,0)
 I 'BHSDPR,'BHSDCX S BHSDCL=23
"RTN","BHSENC",117,0)
 I BHSDCX,'BHSDPR S BHSDCL=32
"RTN","BHSENC",118,0)
 I BHSDCX,BHSDPR S BHSDCL=35
"RTN","BHSENC",119,0)
 I 'BHSDCX,BHSDPR S BHSDCL=28
"RTN","BHSENC",120,0)
 S BHSPVD=0
"RTN","BHSENC",121,0)
 F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D ONEDATE Q:$D(GMTSQIT)  S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT Q:GMTSNDM=0
"RTN","BHSENC",122,0)
 ; <CLEANUP>
"RTN","BHSENC",123,0)
INHOSPX K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,GMTSNDT,BHSCLI,BHSPDN,BHSICD,BHSICL,BHSNRQ
"RTN","BHSENC",124,0)
 K BHSNFL,BHSNSH,BHSNAB,BHSVSC,BHSITE,Y
"RTN","BHSENC",125,0)
 Q
"RTN","BHSENC",126,0)
 ;
"RTN","BHSENC",127,0)
QUAL(IEN) ;Get any qualifiers for this problem
"RTN","BHSENC",128,0)
 N AIEN,FNUM,Q,STRING,STRING2,STRING3,STRING4,X,IEN2
"RTN","BHSENC",129,0)
 Q:$G(IEN)=""
"RTN","BHSENC",130,0)
 S (STRING,STRING2,STRING3,STRING4)=""
"RTN","BHSENC",131,0)
 ;Return qualifiers
"RTN","BHSENC",132,0)
 F X=13,17,18,14 D
"RTN","BHSENC",133,0)
 .S STRING=""
"RTN","BHSENC",134,0)
 .S IEN2=0 F  S IEN2=$O(^AUPNVPOV(IEN,X,IEN2)) Q:'+IEN2  D
"RTN","BHSENC",135,0)
 ..S FNUM=$S(X=13:9000010.0713,X=17:9000010.0717,X=18:9000010.0718,X=14:9000010.0714)
"RTN","BHSENC",136,0)
 ..S AIEN=IEN2_","_IEN_","
"RTN","BHSENC",137,0)
 ..S Q=$$GET1^DIQ(FNUM,AIEN,.01)
"RTN","BHSENC",138,0)
 ..S Q=$$CONCEPT^BGOPAUD(Q)
"RTN","BHSENC",139,0)
 ..S STRING=$S(STRING="":Q,1:STRING_" "_Q)
"RTN","BHSENC",140,0)
 .I STRING'="" D
"RTN","BHSENC",141,0)
 ..W ?30,STRING,!
"RTN","BHSENC2")
0^2^B25082382
"RTN","BHSENC2",1,0)
BHSENC2 ;IHS/CIA/MGH - Encounters from PCC ;06-Apr-2020 15:42;DU
"RTN","BHSENC2",2,0)
 ;;1.0;HEALTH SUMMARY COMPONENTS;**8,13,16**;Jan 6,2006;Build 1
"RTN","BHSENC2",3,0)
 ;===================================================================
"RTN","BHSENC2",4,0)
 ;Taken from APCH2H
"RTN","BHSENC2",5,0)
 ; IHS/TUCSON/LAB - PART 2B OF BHS -- SUMMARY PRODUCTION COMPONENTS ;  [ 02/20/04  1:17 PM ]
"RTN","BHSENC2",6,0)
 ;;2.0;IHS RPMS/PCC Health Summary;**6,11**;JUN 24, 1997
"RTN","BHSENC2",7,0)
 ;IHS/MSC/MGH added telehealth visis patch 16
"RTN","BHSENC2",8,0)
 ;=====================================================================
"RTN","BHSENC2",9,0)
OUTPT ; ********** OUTPATIENT ENCOUNTERS WITHOUT CHR * 9000010/9000010.07 **********
"RTN","BHSENC2",10,0)
 ; <SETUP>
"RTN","BHSENC2",11,0)
 N BHSPAT,BHSN,BHSNTE,X
"RTN","BHSENC2",12,0)
 S BHSPAT=DFN
"RTN","BHSENC2",13,0)
 Q:'$D(^AUPNVSIT("AA",BHSPAT))
"RTN","BHSENC2",14,0)
 S BHSOVT="ARSCOTEM" ; NOTE: THIS CONTROLS TYPES OF VISITS DISPLAYED
"RTN","BHSENC2",15,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSENC2",16,0)
 ; <DISPLAY>
"RTN","BHSENC2",17,0)
 S BHSPVD=0
"RTN","BHSENC2",18,0)
 S BHSPFN=""
"RTN","BHSENC2",19,0)
 S BHSDCX="",BHSDPR=""
"RTN","BHSENC2",20,0)
 I GMPXHLOC="Y" S BHSDCX=1
"RTN","BHSENC2",21,0)
 S BHSDPR=1
"RTN","BHSENC2",22,0)
 I 'BHSDPR,'BHSDCX S BHSDCL=23
"RTN","BHSENC2",23,0)
 I BHSDCX,'BHSDPR S BHSDCL=32
"RTN","BHSENC2",24,0)
 I BHSDCX,BHSDPR S BHSDCL=35
"RTN","BHSENC2",25,0)
 I 'BHSDCX,BHSDPR S BHSDCL=28
"RTN","BHSENC2",26,0)
 F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D  Q:GMTSNDM=0!(BHSQT)
"RTN","BHSENC2",27,0)
 .  S BHSQT=1
"RTN","BHSENC2",28,0)
 .  D ONEDATE
"RTN","BHSENC2",29,0)
 .  Q:$D(GMTSQIT)
"RTN","BHSENC2",30,0)
 .  S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT
"RTN","BHSENC2",31,0)
 .  S BHSQT=0
"RTN","BHSENC2",32,0)
 .  Q
"RTN","BHSENC2",33,0)
 ;
"RTN","BHSENC2",34,0)
OUTPTX ; <CLEANUP>
"RTN","BHSENC2",35,0)
 K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,GMTSNDT,BHSCLI,BHSPDN,BHSICD,BHSICL,BHSNRQ
"RTN","BHSENC2",36,0)
 K BHSNFL,BHSNSH,BHSCCL,BHSNAB,BHSVSC,BHSITE,BHSQT,BHSDCL,Y,BHSDCX,BHSDPR,BHSQ,BHSPRV,BHSSNO,BHSNORM
"RTN","BHSENC2",37,0)
 Q
"RTN","BHSENC2",38,0)
 ;
"RTN","BHSENC2",39,0)
ONEDATE ;
"RTN","BHSENC2",40,0)
 S BHSCCL=""
"RTN","BHSENC2",41,0)
 S X=-BHSIVD\1+9999999 D REGDT4^GMTSU S BHSDAT=X
"RTN","BHSENC2",42,0)
 S BHSDTU=0,GMTSNDT=(BHSDAT'=BHSPVD)
"RTN","BHSENC2",43,0)
 S BHSVDF="" F BHSQ=0:0 S BHSVDF=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD,BHSVDF)) Q:BHSVDF=""  D  Q:BHSQT
"RTN","BHSENC2",44,0)
 .  S BHSQT=1
"RTN","BHSENC2",45,0)
 .  S BHSSCL=""
"RTN","BHSENC2",46,0)
 .  S BHSN=^AUPNVSIT(BHSVDF,0)
"RTN","BHSENC2",47,0)
 .  I +$P(BHSN,U,9),'$P(BHSN,U,11) D GETCLN,GETPROV,GETSITEV^BHSUTL D
"RTN","BHSENC2",48,0)
 .. Q:$$PRIMPROV^APCLV(BHSVDF,"D")=53  ;exclude chr prim prov
"RTN","BHSENC2",49,0)
 .. I $P(BHSN,U,7)="E",'$D(^AUPNVPOV("AD",BHSVDF)) Q  ;don't display events with no pov
"RTN","BHSENC2",50,0)
 ..  I BHSOVT[BHSVSC D DSPVIS
"RTN","BHSENC2",51,0)
 ..  Q
"RTN","BHSENC2",52,0)
 .  Q:$D(GMTSQIT)
"RTN","BHSENC2",53,0)
 .  S BHSQT=0
"RTN","BHSENC2",54,0)
 .  Q
"RTN","BHSENC2",55,0)
 Q
"RTN","BHSENC2",56,0)
 ;
"RTN","BHSENC2",57,0)
GETPROV ;
"RTN","BHSENC2",58,0)
 S BHSPRV=$$PRIMPROV^APCLV(BHSVDF,"T")
"RTN","BHSENC2",59,0)
 Q
"RTN","BHSENC2",60,0)
GETCLN ;
"RTN","BHSENC2",61,0)
 S BHSCLI=$P(BHSN,U,8) I BHSCLI="" S BHSCCL="<none>" Q
"RTN","BHSENC2",62,0)
 S BHSCLI=$P(BHSN,U,8) Q:BHSCLI=""
"RTN","BHSENC2",63,0)
 Q:'$D(^DIC(40.7,BHSCLI))
"RTN","BHSENC2",64,0)
 I $D(^DIC(40.7,BHSCLI,9999999)),$P(^(9999999),U,1)]"" S BHSCLI=$P(^DIC(40.7,BHSCLI,9999999),U,1),BHSCCL=BHSCLI Q
"RTN","BHSENC2",65,0)
 S BHSCLI=$E($P(^DIC(40.7,BHSCLI,0),U,1),1,8)
"RTN","BHSENC2",66,0)
 S BHSCCL=BHSCLI
"RTN","BHSENC2",67,0)
 Q
"RTN","BHSENC2",68,0)
DSPVIS ;
"RTN","BHSENC2",69,0)
 S BHSDTU=1
"RTN","BHSENC2",70,0)
 I $O(^AUPNVPOV("AD",BHSVDF,""))="" D NOPOV Q
"RTN","BHSENC2",71,0)
 S BHSPDN="" F BHSQ=0:0 S BHSPDN=$O(^AUPNVPOV("AD",BHSVDF,BHSPDN)) Q:'BHSPDN  S BHSN=^AUPNVPOV(BHSPDN,0) D HASPOV
"RTN","BHSENC2",72,0)
 Q
"RTN","BHSENC2",73,0)
 ;
"RTN","BHSENC2",74,0)
NOPOV ;
"RTN","BHSENC2",75,0)
 S (BHSICD,BHSNRQ)="<purpose of visit not yet entered>",BHSMOD=""
"RTN","BHSENC2",76,0)
 G COMMON
"RTN","BHSENC2",77,0)
 ;
"RTN","BHSENC2",78,0)
HASPOV ;
"RTN","BHSENC2",79,0)
 ;IHS/MSC/MGH added normal/abnormal patch 13
"RTN","BHSENC2",80,0)
 S BHSICD=$P(BHSN,U,1) D GETICDDX^BHSUTL
"RTN","BHSENC2",81,0)
 S BHSSNO=$$GET1^DIQ(9000010.07,BHSPDN,1101)
"RTN","BHSENC2",82,0)
 S BHSNORM=$$GET1^DIQ(9000010.07,BHSPDN,.29)
"RTN","BHSENC2",83,0)
 ;S BHSNRQ=$P(BHSN,U,4) D GETNARR^BHSUTL I $P(BHSN,U,5)]"" S BHSNRQ=BHSNRQ_"  (Stage: "_$P(BHSN,U,5)_")"  ;IHS/CMI/LAB - patched to display stage of 0
"RTN","BHSENC2",84,0)
 S BHSNRQ=$P(BHSN,U,4)
"RTN","BHSENC2",85,0)
 D GETNARR^BHSUTL I BHSSNO'="" S BHSNRQ=BHSNRQ_";"_BHSNORM_" ("_BHSSNO_")"   ;Patch 8 added SNOMED
"RTN","BHSENC2",86,0)
 S BHSMOD=$P(BHSN,U,6)
"RTN","BHSENC2",87,0)
 I $D(BHSPDN) D QUAL^BHSENC(BHSPDN)                  ;Patch 8 added qualifers
"RTN","BHSENC2",88,0)
 ;
"RTN","BHSENC2",89,0)
COMMON ;
"RTN","BHSENC2",90,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)  S:GMTSNPG GMTSNDT=1
"RTN","BHSENC2",91,0)
 I GMTSNDT W BHSDAT S (BHSPFN,BHSSCL)="",GMTSNDT=0
"RTN","BHSENC2",92,0)
 I BHSNSH=BHSPFN S BHSFAC=""
"RTN","BHSENC2",93,0)
 E  S (BHSFAC,BHSPFN)=BHSNSH,BHSSCL=""
"RTN","BHSENC2",94,0)
 I BHSCCL=BHSSCL S BHSCLI=""
"RTN","BHSENC2",95,0)
 E  S (BHSCLI,BHSSCL)=BHSCCL
"RTN","BHSENC2",96,0)
 I BHSICD["<purpose of visit not"&(BHSSCL="<none>") S BHSCLI=""
"RTN","BHSENC2",97,0)
 I BHSMOD]"" S BHSMTX=$P(^DD(9000010.07,.06,0),U,3),BHSMTX=$P($P(BHSMTX,BHSMOD_":",2),";",1),BHSMTX=$P(BHSMTX,",",1),BHSICD=BHSMTX_" "_BHSICD
"RTN","BHSENC2",98,0)
 S:$D(^AUPNVCHS("AD",BHSVDF)) BHSNTE="*** CHS ***"
"RTN","BHSENC2",99,0)
 W ?10,BHSFAC
"RTN","BHSENC2",100,0)
 I BHSDCX,BHSDPR W ?23,$E(BHSCLI,1,6),?30,BHSPRV
"RTN","BHSENC2",101,0)
 I BHSDCX,'BHSDPR W ?23,BHSCLI
"RTN","BHSENC2",102,0)
 I 'BHSDCX,BHSDPR W ?23,BHSPRV
"RTN","BHSENC2",103,0)
 S BHSICL=BHSDCL
"RTN","BHSENC2",104,0)
 S:0 BHSICD=BHSVSC_":"_BHSICD D PRTICD^BHSUTL
"RTN","BHSENC2",105,0)
 I $D(BHSPDN) D QUAL^BHSENC(BHSPDN)                  ;Patch 8 added qualifers
"RTN","BHSENC2",106,0)
 Q
"RTN","BHSENC2",107,0)
INHOSP ; ********** INHOSPITAL ENCOUNTERS * 9000010/9000010.07 **********
"RTN","BHSENC2",108,0)
 ; <SETUP>
"RTN","BHSENC2",109,0)
 Q:'$D(^AUPNVSIT("AA",BHSPAT))
"RTN","BHSENC2",110,0)
 S BHSOVT="I" ; NOTE: This controls types of visits displayed
"RTN","BHSENC2",111,0)
 D CKP^GMTSUP Q:$D(GMTSQIT)
"RTN","BHSENC2",112,0)
 ; <DISPLAY>
"RTN","BHSENC2",113,0)
 S BHSPVD=0
"RTN","BHSENC2",114,0)
 F BHSIVD=0:0 S BHSIVD=$O(^AUPNVSIT("AA",BHSPAT,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)  D ONEDATE Q:$D(GMTSQIT)  S:(BHSDAT'=BHSPVD)&BHSDTU GMTSNDM=GMTSNDM-BHSDTU,BHSPVD=BHSDAT Q:GMTSNDM=0
"RTN","BHSENC2",115,0)
 ; <CLEANUP>
"RTN","BHSENC2",116,0)
INHOSPX K BHSIVD,BHSDTU,BHSDAT,BHSVDF,BHSFAC,BHSPFN,BHSSCL,BHSMTX,BHSMOD,BHSPVD,BHSOVT,GMTSNDT,BHSCLI,BHSPDN,BHSICD,BHSICL,BHSNRQ
"RTN","BHSENC2",117,0)
 K BHSNFL,BHSNSH,BHSNAB,BHSVSC,BHSITE,Y
"RTN","BHSENC2",118,0)
 Q
"RTN","BHSENC2",119,0)
 ;
"RTN","BHSP16")
0^^B1389566
"RTN","BHSP16",1,0)
BHSP16 ; IHS/MSC/MGH - PRE-INSTALL ROUTINE FOR BHS PATCH 16 ;06-Apr-2020 15:57;DU
"RTN","BHSP16",2,0)
 ;;1.0;HEALTH SUMMARY COMPONENTS;**16**;March 17, 2006;Build 1
"RTN","BHSP16",3,0)
 ;
"RTN","BHSP16",4,0)
ENV ;EP; environment check
"RTN","BHSP16",5,0)
 N PATCH
"RTN","BHSP16",6,0)
 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
"RTN","BHSP16",7,0)
 ;
"RTN","BHSP16",8,0)
 ;Check for released version added
"RTN","BHSP16",9,0)
 NEW IEN,PKG S PKG="HEALTH SUMMARY COMPONENTS 1.0",IEN=$O(^XPD(9.6,"B",PKG,0))
"RTN","BHSP16",10,0)
 I 'IEN W !,"You must first install "_PKG_"." S XPDQUIT=2 Q
"RTN","BHSP16",11,0)
 ;
"RTN","BHSP16",12,0)
 ;
"RTN","BHSP16",13,0)
 ;Check for the installation of other patches
"RTN","BHSP16",14,0)
 S PATCH="BHS*1.0*15"
"RTN","BHSP16",15,0)
 I '$$PATCH(PATCH) D  Q
"RTN","BHSP16",16,0)
 . W !,"You must first install "_PATCH_"." S XPDQUIT=2
"RTN","BHSP16",17,0)
 Q
"RTN","BHSP16",18,0)
 ;
"RTN","BHSP16",19,0)
PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnnn
"RTN","BHSP16",20,0)
 ;copy of code from XPDUTL but modified to handle 4 digit IHS patch numb
"RTN","BHSP16",21,0)
 Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.4N 0
"RTN","BHSP16",22,0)
 NEW NUM,I,J
"RTN","BHSP16",23,0)
 S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
"RTN","BHSP16",24,0)
 S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
"RTN","BHSP16",25,0)
 ;check if patch is just a number
"RTN","BHSP16",26,0)
 Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
"RTN","BHSP16",27,0)
 S NUM=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
"RTN","BHSP16",28,0)
 Q (X=+NUM)
"RTN","BHSP16",29,0)
 ;
"VER")
8.0^22.0
**END**
**END**