KIDS Distribution saved on Nov 20, 2002@13:24:40
GIS Patch 4, LOINC
**KIDS**:GIS*3.01*4^

**INSTALL NAME**
GIS*3.01*4
"BLD",115,0)
GIS*3.01*4^GENERIC INTERFACE SYSTEM^0^3021120^n
"BLD",115,1,0)
^^1^1^3021007^
"BLD",115,1,1,0)
LOINC Supplement for GIS, also known as GIS patch 4
"BLD",115,4,0)
^9.64PA^^
"BLD",115,"ABPKG")
n
"BLD",115,"INI")

"BLD",115,"INIT")
BHLLPST
"BLD",115,"KRN",0)
^9.67PA^19^18
"BLD",115,"KRN",.4,0)
.4
"BLD",115,"KRN",.401,0)
.401
"BLD",115,"KRN",.402,0)
.402
"BLD",115,"KRN",.403,0)
.403
"BLD",115,"KRN",.5,0)
.5
"BLD",115,"KRN",.84,0)
.84
"BLD",115,"KRN",3.6,0)
3.6
"BLD",115,"KRN",3.8,0)
3.8
"BLD",115,"KRN",9.2,0)
9.2
"BLD",115,"KRN",9.8,0)
9.8
"BLD",115,"KRN",9.8,"NM",0)
^9.68A^1^1
"BLD",115,"KRN",9.8,"NM",1,0)
BHLRLAB^^0^B5762458
"BLD",115,"KRN",9.8,"NM","B","BHLRLAB",1)

"BLD",115,"KRN",19,0)
19
"BLD",115,"KRN",19.1,0)
19.1
"BLD",115,"KRN",101,0)
101
"BLD",115,"KRN",409.61,0)
409.61
"BLD",115,"KRN",771,0)
771
"BLD",115,"KRN",869.2,0)
869.2
"BLD",115,"KRN",870,0)
870
"BLD",115,"KRN",8994,0)
8994
"BLD",115,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",115,"KRN","B",3.6,3.6)

"BLD",115,"KRN","B",3.8,3.8)

"BLD",115,"KRN","B",9.2,9.2)

"BLD",115,"KRN","B",9.8,9.8)

"BLD",115,"KRN","B",19,19)

"BLD",115,"KRN","B",19.1,19.1)

"BLD",115,"KRN","B",101,101)

"BLD",115,"KRN","B",409.61,409.61)

"BLD",115,"KRN","B",771,771)

"BLD",115,"KRN","B",869.2,869.2)

"BLD",115,"KRN","B",870,870)

"BLD",115,"KRN","B",8994,8994)

"BLD",115,"PRE")
BHL2ENV
"BLD",115,"QUES",0)
^9.62^^
"INIT")
BHLLPST
"MBREQ")
0
"PKG",257,-1)
1^1
"PKG",257,0)
GENERIC INTERFACE SYSTEM^GIS^IHS Generic Interface System
"PKG",257,20,0)
^9.402P^^
"PKG",257,22,0)
^9.49I^1^1
"PKG",257,22,1,0)
3.01^3020220
"PKG",257,22,1,"PAH",1,0)
4^3021120
"PKG",257,22,1,"PAH",1,1,0)
^^1^1^3021120
"PKG",257,22,1,"PAH",1,1,1,0)
LOINC Supplement for GIS, also known as GIS patch 4
"PRE")
BHL2ENV
"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")
YES
"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")
YES
"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")
YES
"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","BHL2ENV")
0^^B1381995
"RTN","BHL2ENV",1,0)
BHL2ENV ;cmi/flag/maw - BHL Generic Environment Check [ 10/10/2002  10:44 PM ]
"RTN","BHL2ENV",2,0)
 ;;3.01;BHL IHS Interfaces with GIS;**3,4,5,6,7,8,9**;OCT 15, 2002
"RTN","BHL2ENV",3,0)
 ;
"RTN","BHL2ENV",4,0)
 ;        
"RTN","BHL2ENV",5,0)
 ;
"RTN","BHL2ENV",6,0)
 ;this routine will serve as a generic kids environment check
"RTN","BHL2ENV",7,0)
 ;it will look for the appropriate patches to be installed
"RTN","BHL2ENV",8,0)
 ;
"RTN","BHL2ENV",9,0)
CHK ;-- check the following patch(s) to make sure they are there
"RTN","BHL2ENV",10,0)
 K XPDQUIT
"RTN","BHL2ENV",11,0)
 S BHLGI=$O(^DIC(9.4,"B","GENERIC INTERFACE SYSTEM",0))
"RTN","BHL2ENV",12,0)
 I '$G(BHLGI) D  Q
"RTN","BHL2ENV",13,0)
 . S XPDQUIT=1
"RTN","BHL2ENV",14,0)
 . W !!,"You need the Generic Interface System version 3.01, aborting",!
"RTN","BHL2ENV",15,0)
 S BHLVI=$O(^DIC(9.4,BHLGI,22,"B",3.01,0))
"RTN","BHL2ENV",16,0)
 I '$G(BHLVI) D  Q
"RTN","BHL2ENV",17,0)
 . S XPDQUIT=1
"RTN","BHL2ENV",18,0)
 . W !!,"You need the Generic Interface System version 3.01, aborting",!
"RTN","BHL2ENV",19,0)
 I '$O(^DIC(9.4,BHLGI,22,BHLVI,"PAH","B",2,0)) D
"RTN","BHL2ENV",20,0)
 . W !!,"You need all GIS patches through patch 2 to continue",!
"RTN","BHL2ENV",21,0)
 . S XPDQUIT=1
"RTN","BHL2ENV",22,0)
 Q
"RTN","BHL2ENV",23,0)
 ;
"RTN","BHLLPST")
0^^B2231353
"RTN","BHLLPST",1,0)
BHLLPST ; cmi/flag/maw - BHL LOINC POST INIT ; 
"RTN","BHLLPST",2,0)
 ;;3.01;BHL IHS Interfaces with GIS;**4**;OCT 15, 2002
"RTN","BHLLPST",3,0)
 ;
"RTN","BHLLPST",4,0)
 ;
"RTN","BHLLPST",5,0)
 ;
"RTN","BHLLPST",6,0)
 ;this routine will set up the loinc post install questions
"RTN","BHLLPST",7,0)
 ;
"RTN","BHLLPST",8,0)
MAIN ;PEP - this is the main routine driver
"RTN","BHLLPST",9,0)
 D EDIT
"RTN","BHLLPST",10,0)
 D MPORT^BHLU
"RTN","BHLLPST",11,0)
 D COMPILE
"RTN","BHLLPST",12,0)
 D EOJ
"RTN","BHLLPST",13,0)
 Q
"RTN","BHLLPST",14,0)
 ;
"RTN","BHLLPST",15,0)
EDIT ;-- ask which reference lab and then stuff the file
"RTN","BHLLPST",16,0)
 X ^%ZOSF("EON")  ;turn echo on for questions
"RTN","BHLLPST",17,0)
 W !!,"I Will now walk you through setting your Loinc Parameters",!!
"RTN","BHLLPST",18,0)
 S DIC(0)="AEMQZ",DIC="^BLRSITE("
"RTN","BHLLPST",19,0)
 S DIC("A")="Setup Loinc files for which Lab Site: "
"RTN","BHLLPST",20,0)
 D ^DIC
"RTN","BHLLPST",21,0)
 Q:Y<0
"RTN","BHLLPST",22,0)
 S BHLLSITE=+Y
"RTN","BHLLPST",23,0)
 S DIE=DIC,DA=BHLLSITE,DR="500:505"
"RTN","BHLLPST",24,0)
 D ^DIE
"RTN","BHLLPST",25,0)
 K DIC,DIE,DR,DA
"RTN","BHLLPST",26,0)
 S DIR(0)="Y",DIR("A")="Setup Another Loinc Site "
"RTN","BHLLPST",27,0)
 D ^DIR
"RTN","BHLLPST",28,0)
 K DIR
"RTN","BHLLPST",29,0)
 Q:'Y
"RTN","BHLLPST",30,0)
 G EDIT
"RTN","BHLLPST",31,0)
 Q
"RTN","BHLLPST",32,0)
 ;
"RTN","BHLLPST",33,0)
COMPILE ;-- compile the ref lab scripts
"RTN","BHLLPST",34,0)
 W !!,"I will now generate scripts and compile the messages...",!
"RTN","BHLLPST",35,0)
 W !!,"Press return when asked to compile scripts",!
"RTN","BHLLPST",36,0)
 S BHLMSI=$O(^INTHL7M("B","HL IHS LOINC R01",0))
"RTN","BHLLPST",37,0)
 Q:'BHLMSI
"RTN","BHLLPST",38,0)
 D COMPILE^BHLU(BHLMSI)
"RTN","BHLLPST",39,0)
 Q
"RTN","BHLLPST",40,0)
 ;
"RTN","BHLLPST",41,0)
EOJ ;-- kill variables and quit
"RTN","BHLLPST",42,0)
 D EN^XBVK("BHL")
"RTN","BHLLPST",43,0)
 Q
"RTN","BHLLPST",44,0)
 ;
"RTN","BHLRLAB")
0^1^B5762458
"RTN","BHLRLAB",1,0)
BHLRLAB ;cmi/flag/maw - BHL Setup Ref Lab Segments 
"RTN","BHLRLAB",2,0)
 ;;3.01;BHL IHS Interfaces with GIS;**4**;OCT 15, 2002
"RTN","BHLRLAB",3,0)
 ;
"RTN","BHLRLAB",4,0)
 ;
"RTN","BHLRLAB",5,0)
 ;this routine will setup special formatting for data residing in the
"RTN","BHLRLAB",6,0)
 ;PV1, OBR, and OBX segments
"RTN","BHLRLAB",7,0)
 ;
"RTN","BHLRLAB",8,0)
ORM ;EP - this is the main routine driver
"RTN","BHLRLAB",9,0)
 D MORC,MOBR
"RTN","BHLRLAB",10,0)
 Q
"RTN","BHLRLAB",11,0)
 ;
"RTN","BHLRLAB",12,0)
ORU ;EP - this is the main routine driver
"RTN","BHLRLAB",13,0)
 D PV1,OBR,OBX
"RTN","BHLRLAB",14,0)
 Q
"RTN","BHLRLAB",15,0)
 ;
"RTN","BHLRLAB",16,0)
PV1 ;-- setup PV1 data
"RTN","BHLRLAB",17,0)
 S INA("PV13LAB",1)=$$PLOC(BHL("VIEN"))
"RTN","BHLRLAB",18,0)
 S INA("PV110LAB",1)=$$CLNC(BHL("VIEN"))
"RTN","BHLRLAB",19,0)
 Q
"RTN","BHLRLAB",20,0)
 ;
"RTN","BHLRLAB",21,0)
OBR ;-- setup OBR data
"RTN","BHLRLAB",22,0)
 S BHL("VLAB")=$G(INDA(9000010.09,1))
"RTN","BHLRLAB",23,0)
 S INA("OBR4LAB",1)=$$LOINC(BHL("VLAB"))
"RTN","BHLRLAB",24,0)
 S INA("OBR16LAB",1)=CS_$$GET1^DIQ(9000010.09,BHL("VLAB"),1202,"E")
"RTN","BHLRLAB",25,0)
 Q
"RTN","BHLRLAB",26,0)
 ;
"RTN","BHLRLAB",27,0)
OBX ;-- setup OBX data
"RTN","BHLRLAB",28,0)
 S INA("OBX7LAB",1)=$$REFLH(BHL("VLAB"))
"RTN","BHLRLAB",29,0)
 S INA("OBX8LAB",1)=$P($G(^AUPNVLAB(BHL("VLAB"),0)),U,5)
"RTN","BHLRLAB",30,0)
 Q
"RTN","BHLRLAB",31,0)
 ;
"RTN","BHLRLAB",32,0)
MORC ;-- setup ORM ORC segment
"RTN","BHLRLAB",33,0)
 S INA("ORC2LABO")=""
"RTN","BHLRLAB",34,0)
 S INA("ORC12LABO")=""
"RTN","BHLRLAB",35,0)
 Q
"RTN","BHLRLAB",36,0)
 ;
"RTN","BHLRLAB",37,0)
MOBR ;-- setup ORM ORC segment
"RTN","BHLRLAB",38,0)
 S INA("OBR4LABO")=""
"RTN","BHLRLAB",39,0)
 S INA("OBR7LABO")=""
"RTN","BHLRLAB",40,0)
 S INA("OBR22LABO")=""
"RTN","BHLRLAB",41,0)
 S INA("OBR27LABO")=""
"RTN","BHLRLAB",42,0)
 Q
"RTN","BHLRLAB",43,0)
 ;
"RTN","BHLRLAB",44,0)
PLOC(BHLZX)        ;-- get patient location
"RTN","BHLRLAB",45,0)
 S BHL("LOCI")=$P($G(^AUPNVSIT(BHLZX,0)),U,6)
"RTN","BHLRLAB",46,0)
 I BHL("LOCI")="" Q ""
"RTN","BHLRLAB",47,0)
 S BHL("ASUFAC")=$P($G(^AUTTLOC(BHL("LOCI"),0)),U,10)
"RTN","BHLRLAB",48,0)
 S BHL("LOCE")=$$VAL^XBDIQ1(9000010,BHLZX,.06)
"RTN","BHLRLAB",49,0)
 Q BHL("ASUFAC")_CS_BHL("LOCE")_CS_"99IHS"
"RTN","BHLRLAB",50,0)
 ;
"RTN","BHLRLAB",51,0)
CLNC(BHLZX)        ;-- get patient clinic code
"RTN","BHLRLAB",52,0)
 S BHL("CLNI")=$P($G(^AUPNVSIT(BHLZX,0)),U,8)
"RTN","BHLRLAB",53,0)
 I BHL("CLNI")="" Q ""
"RTN","BHLRLAB",54,0)
 S BHL("CLNC")=$P($G(^DIC(40.7,BHL("CLNI"),0)),U,2)
"RTN","BHLRLAB",55,0)
 Q BHL("CLNC")
"RTN","BHLRLAB",56,0)
 ;
"RTN","BHLRLAB",57,0)
LOINC(BHLZV)       ;-- get loinc setup
"RTN","BHLRLAB",58,0)
 S BHL("LABTI")=$P($G(^AUPNVLAB(BHLZV,0)),U)
"RTN","BHLRLAB",59,0)
 S BHL("LABTE")=$P($G(^LAB(60,BHL("LABTI"),0)),U)
"RTN","BHLRLAB",60,0)
 S BHL("LOINC")=$P($G(^AUPNVLAB(BHLZV,11)),U,13)
"RTN","BHLRLAB",61,0)
 I BHL("LOINC")="" Q ""
"RTN","BHLRLAB",62,0)
 S BHLCHK=$P($G(^LAB(95.3,BHL("LOINC"),9999999)),U,2)
"RTN","BHLRLAB",63,0)
 ;Q BHL("LOINC")_CS_BHL("LABTE")_CS_"L"
"RTN","BHLRLAB",64,0)
 Q BHLCHK_CS_BHL("LABTE")_CS_"LN"  ;maw chk digit
"RTN","BHLRLAB",65,0)
 ;
"RTN","BHLRLAB",66,0)
REFLH(BHLZV)       ;-- set up ref low/high
"RTN","BHLRLAB",67,0)
 S BHL("REFL")=$P($G(^AUPNVLAB(BHLZV,11)),U,4)
"RTN","BHLRLAB",68,0)
 S BHL("REFH")=$P($G(^AUPNVLAB(BHLZV,11)),U,5)
"RTN","BHLRLAB",69,0)
 Q BHL("REFL")_" - "_BHL("REFH")
"RTN","BHLRLAB",70,0)
 ;
"VER")
8.0^21.0
**END**
**END**