Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BYIMIMM5

BYIMIMM5.m

Go to the documentation of this file. 
  1. BYIMIMM5 ;IHS/CIM/THL - IMMUNIZATION DATA EXCHANGE;
  1.  ;;2.0;BYIM IMMUNIZATION DATA EXCHANGE;**3,4,5,6,7,8,9**;JUL 11, 2017;Build 22
  1.  ;
  1. BRIDGE ;EP;TO MONITOR HL7 BRIDGE
  1.  Q
  1. STAT ;EP;TO DETERMINE BRIDGE STATUS
  1.  Q
  1. CANC ;
  1.  Q
  1. START ;
  1.  Q
  1. HOSTCMD ;
  1.  S X="S X=$$TERMINAL^%"_"HOSTCMD(HL7CMD)"
  1.  X X
  1.  Q
  1. END ;
  1.  K X,HL7FUNC,HL7CMD,HL7JOBN,HL7NAME,DIR
  1.  S BYIMQUIT=1
  1.  Q
  1. RXA(BYIMDA) ;EP;TO SET THE IIS CODE FOR RXA-11.4
  1.  Q:$G(BYIMDA)=""
  1.  S BYIMDA=+^AUTTSITE(1,0)
  1.  I $P(^BYIMPARA(0),U,4)>1,'$D(^BYIMPARA(BYIMDA,0)) D
  1.  .W !!,"BYIM Parameter Sites:"
  1.  .S BYIMDA=0
  1.  .F  S BYIMDA=$O(^BYIMPARA(BYIMDA)) Q:'BYIMDA  D
  1.  ..W !?10,$P($G(^DIC(4,BYIMDA,0)),U)
  1.  .S DIC="^BYIMPARA("
  1.  .S DIC(0)="AEMQZ"
  1.  .S DIC("A")="Which BYIM Parameter Site: "
  1.  .D ^DIC
  1.  .I 'Y S BYIMDA="" Q
  1.  .S BYIMDA=+Y
  1.  Q:'BYIMDA
  1.  I '$D(^BYIMPARA(BYIMDA,1)) F  S BYIMDA=$O(^BYIMPARA(BYIMDA)) Q:'BYIMDA  Q:$D(^BYIMPARA(BYIMDA,"LAST EXPORT"))
  1.  Q:'BYIMDA
  1.  N BYIMRXA,DISP,BYIMQUIT
  1.  I $O(^BYIMPARA(BYIMDA,5,0)) D RXA1 Q
  1.  W !!,"Some state Immunization Information Systems (IIS) require facilities to send"
  1.  W !,"a code to identify the facility at which the immunization was administered or"
  1.  W !,"identify the vaccine inventory location instead of the facility name."
  1.  W !!,"If you need to add state IIS assigned code(s) please enter 'Y' below."
  1.  W !,"You will be prompted to select the name of your facility and then"
  1.  W !,"enter the state assigned code."
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Add State IIS Assigned Facility Codes"
  1.  S DIR("B")="NO"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1. RXA1 N BYIMX
  1.  S BYIMQUIT=0
  1.  F  D RXAACT Q:BYIMQUIT
  1.  Q
  1.  ;-----
  1. RXAACT ;ADDITIONAL SITE ACTION
  1.  I '$O(^BYIMPARA(BYIMDA,5,0)) D RXAADD
  1.  I '$O(^BYIMPARA(BYIMDA,5,0)) S BYIMQUIT=1 Q
  1.  D RXADISP
  1.  K DIR
  1.  S DIR(0)="SO^1:Edit Codes;2:Add codes;3:Delete codes"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S BYIMQUIT=1 Q
  1.  I Y=1 D RXAEDIT Q
  1.  I Y=2 D RXAADD Q
  1.  I Y=3 D RXADEL
  1.  Q
  1.  ;-----
  1. RXAADD ;SELECT FACILITIES FOR STATE RXA CODE
  1.  N BYIMX,BYIMY
  1.  S DIC="^DIC(4,"
  1.  S DIC(0)="AEMQZ"
  1.  ;S DIC("S")="I $D(^AUTTSITE(""B"",Y))!$D(^AUTTSITE(1,19251,""B"",Y))"
  1.  S DIC("A")="Select Facility for the IIS assigned Code: "
  1.  W !
  1.  D ^DIC
  1.  I Y<1 S BYIMQUIT=1 Q
  1.  S BYIMX=+Y
  1.  S BYIMY=$P(^DIC(4,+Y,0),U)
  1.  K DIR
  1.  S DIR(0)="FO^1:50"
  1.  S DIR("A")="Enter State IIS Code assigned for **"_BYIMY_"**"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  I X="" S BYIMQUIT=1 Q
  1.  S BYIMY=X
  1.  S X=BYIMX
  1.  S DA(1)=$O(^BYIMPARA(0))
  1.  S DIC="^BYIMPARA("_$$DUZ^BYIMIMM()_",5,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_BYIMY
  1.  S DINUM=X
  1.  D FILE^DICN
  1.  I Y<1 S BYIMQUIT=1 Q
  1.  Q
  1.  ;------
  1. RXADISP ;DISPLAY EXISTING IIS RXA CODES
  1.  N DISP,J,X,Y,Z
  1.  S J=0
  1.  S X=0
  1.  F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),5,X)) Q:'X  S Y=$G(^(X,0)) D:Y
  1.  .S Z=$P($G(^DIC(4,X,0)),U)
  1.  .Q:Z=""
  1.  .S Z=Z_" (IEN "_X_")"
  1.  .S J=J+1
  1.  .S X(Z)=Y
  1.  S J=0
  1.  S X=""
  1.  F  S X=$O(X(X)) Q:X=""  D
  1.  .S J=J+1
  1.  .S $E(DISP(J),11)=J
  1.  .S $E(DISP(J),16)=X
  1.  .S $E(DISP(J),60)=$P(X(X),U,2)
  1.  .S BYIMRXA(J)=+X(X)
  1.  S BYIMJ=J
  1.  W @IOF
  1.  W !?5,"State IIS Assigned Administered-at or Vaccine Inventory Location Code"
  1.  W !!?10,"NO."
  1.  W ?15,"Facility"
  1.  W ?59,"IIS Code"
  1.  W !?10,"---",?15,"------------------------------",?59,"--------------------"
  1.  S J=0
  1.  F  S J=$O(DISP(J)) Q:'J  D
  1.  .W !,DISP(J)
  1.  Q
  1.  ;------
  1. RXAEDIT ;EDIT SITE
  1.  D RXASEL
  1.  Q:'$G(DA)
  1. RXAE1 S DA(1)=BYIMDA
  1.  S DR=".02T"
  1.  S DIE="^BYIMPARA("_BYIMDA_",5,"
  1.  W !!,"Edit  IIS Facility Code for: ",$P($G(^DIC(4,DA,0)),U)
  1.  D ^DIE
  1.  K DA,DR,DIE
  1.  Q
  1.  ;-----
  1. RXADEL ;DELETE SITE
  1.  D RXASEL
  1.  Q:'$G(DA)
  1.  S X=+^BYIMPARA(BYIMDA,5,DA,0)
  1.  S X=$P($G(^DIC(4,X,0)),U)
  1.  W !?10,X
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Delete export/import site: "_X
  1.  S DIR("B")="NO"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y'=1
  1.  S DA(1)=BYIMDA
  1.  S DIK="^BYIMPARA("_BYIMDA_",5,"
  1.  D ^DIK
  1.  K DA,DIK
  1.  Q
  1.  ;-----
  1. RXASEL ;SELECT ADDITION SITE
  1.  I BYIMJ=1 S Y=1 D RXASEL1 Q
  1.  K DIR
  1.  S DIR(0)="NO^1:"_BYIMJ
  1.  S DIR("A")="Select Facility number"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1. RXASEL1 Q:'Y
  1.  Q:'$G(BYIMRXA(Y))
  1.  S DA=BYIMRXA(Y)
  1.  Q
  1.  ;-----
  1. TEST ;EP;CREATE & SEND TEST MESSAGES
  1.  ;PATCH 8 CR 08626 - INCLUDE/EXCLUDE PREVIOUSLY EXPORTED
  1.  ;PATCH 8 CR 08695 - INCLUDE/EXCLUDE HISTORIC IMMS
  1.  ;PATCH 8 CR 08694 - EXCLUDE IMM PRIOR TO SELECTED DATE
  1.  K DIR,BYIMFILE
  1.  W @IOF
  1.  W !!?10,"Select group of patients for TEST export"
  1.  S DIR(0)="SO^1:Random group of patients;2:Select patients for test export"
  1.  S DIR("A")="Which group of patients"
  1.  S DIR("B")="Random group of patients"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  I Y=2 D SEL^BYIMIMM3 Q
  1.  N Y
  1.  S Y=$P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,6)
  1.  S YEARS=$S('Y:19,Y=1:65,1:99)
  1.  S CHILD=$S('Y:"Children",1:"Patients")
  1.  W @IOF
  1.  W !!?10,"TEST export option"
  1.  W !!?10,"An export file will be created for"
  1.  W !?10,CHILD," ",$S(YEARS=19:"18 years of age or under.",1:"of all ages.")
  1.  W !!
  1.  K DIR
  1.  ;PATCH 8 CR 08386 - CHANGE DEFAULT FROM 10 TO 1
  1.  ;S DIR(0)="NO^10:1000"
  1.  S DIR(0)="NO^1:1000"
  1.  ;PATCH 8 CR 08386 END
  1.  S DIR("A",1)="Enter the number of patients"
  1.  S DIR("A")="to include in the test export"
  1.  S DIR("B")="10"
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  K BYIMTEST
  1.  S BYIMTEST=Y
  1.  D TSPEC
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Proceed with test export of "_BYIMTEST_" patients"
  1.  S DIR("B")="NO"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  K ^BYIMTMP($J,"BYIM EXP")
  1.  N XX,X,Y,Z,DOB,DFN,VIS,J
  1.  S J=0
  1.  S VIS=$O(^AUPNVSIT(9999999999),-1)-$R(10)
  1.  F  S VIS=$O(^AUPNVIMM("AD",VIS),-1) Q:'VIS!(J>(BYIMTEST-1))  D
  1.  .;PATCH 8 CR 08694 - SELECT ONLY BEFORE START DATE WHEN START DATE SET
  1.  .N DAT
  1.  .S DAT=+$P($G(^AUPNVSIT(VIS,0)),".")
  1.  .Q:$L(DAT)'=7
  1.  .I BYIMEDAT Q:DAT<BYIMEDAT
  1.  .;PATCH 8 CR 08694 END
  1.  .;ENSURE DIRECT/ADMINISTERED - NON-HISTORIC - VISIT TYPE
  1.  .I BYIMADM=1 Q:"CTNOEDXM"[$P(^AUPNVSIT(VIS,0),U,7)
  1.  .S X=$O(^AUPNVIMM("AD",VIS,0))
  1.  .Q:'X
  1.  .S X=$G(^AUPNVIMM(X,0))
  1.  .S DFN=+$P(X,U,2)
  1.  .Q:'DFN
  1.  .Q:$G(^DPT(DFN,.35))
  1.  .Q:'$G(^AUPNPAT(DFN,0))
  1.  .Q:$D(^BYIMTMP($J,"BYIM EXP",DFN))
  1.  .I BYIMALL'=2!(BYIMADM'=2) Q:'$$NEW^BYIMIMM6(DFN,BYIMALL,BYIMADM,BYIMEDAT)
  1.  .S DOB=$P($G(^DPT(DFN,0)),U,3)
  1.  .I '$P($G(^BYIMPARA($$DUZ^BYIMIMM(),0)),U,6) Q:DOB<(DT-180000)
  1.  .S ^BYIMTMP($J,"BYIM EXP",DFN,VIS)=""
  1.  .S J=J+1
  1.  .S JX=0
  1.  .S JY=0
  1.  .N IMM
  1.  .S IMM=0
  1.  .F  S IMM=$O(^AUPNVIMM("AC",DFN,IMM)) Q:'IMM  D
  1.  ..S JX=JX+1
  1.  ..N IVIS
  1.  ..S IVIS=$P($G(^AUPNVIMM(IMM,0)),U,3)
  1.  ..Q:'IVIS
  1.  S MSGCNT=BYIMTEST+1
  1.  S XX=$P($H,",",2)
  1.  D FN^BYIMIMM
  1.  N DDATE
  1.  S (DDATE,DDDATE)=$O(^BYIMPARA($$DUZ^BYIMIMM(),"LAST EXPORT",9999999999),-1)
  1.  D DEX^BYIMIMM
  1.  Q
  1.  ;-----
  1. CLEAN ;EP;CLEAN UP AFTER TEST EXPORT
  1.  N IMM
  1.  S IMM=0
  1.  F  S IMM=$O(^BYIMTMP("TEST",IMM)) Q:'IMM  D
  1.  .;REMOVE 'D' WHEN SET BY TEST
  1.  .K ^BYIMEXP("D",IMM),^BYIMTMP("TEST",IMM)
  1.  S IMM=0
  1.  F  S IMM=$O(^BYIMTMP("TEST ALL",IMM)) Q:'IMM  D
  1.  .;RESET 'D' WHEN REMOVED BY TEST
  1.  .S ^BYIMEXP("D",IMM,+$O(^BYIMTMP("TEST ALL",IMM,"")))=""
  1.  .K ^BYIMTMP("TEST ALL",IMM)
  1.  ;PATCH 8 CR 08626 END
  1.  ;PATCH 8 CR 08695 END
  1.  ;PATCH 8 CR 08694 END
  1.  Q
  1.  ;-----
  1. TSPEC ;SELECT SPECIFICATIONS FOR TEST EXPORT
  1.  K BYIMEDAT,BYIMADM,BYIMALL
  1.  W @IOF
  1.  W !!?10,"Default TEST export criteria"
  1.  S BYIMEDAT=""
  1.  S BYIMEDAT(0)=""
  1.  S BYIMADM=1
  1.  S BYIMALL=1
  1.  D TSHOW
  1.  K DIR
  1.  S DIR(0)="LO^1:3"
  1.  S DIR("A",1)="   1.  Specify start date for immunizations to include"
  1.  S DIR("A",2)="   2.  Exclude HISTORIC immunizations"
  1.  S DIR("A",3)="   3.  Exclude PREVIOUSLY EXPORTED immunizations"
  1.  S DIR("A",4)="         "
  1.  S DIR("A")="Select all criteria you want to set"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  S BYIMY=Y
  1.  F J=1:1:$L(BYIMY,",")-1 S SR="T"_$P(BYIMY,",",J) D @SR
  1.  Q:'BYIMEDAT&'BYIMADM&'BYIMALL
  1.  D TSHOW
  1.  Q
  1. TSHOW ;SHOW TEST EXPORT CRITERIA
  1.  W !!!?10,"TEST Export Criteria:"
  1.  W !!,"Start date: ",BYIMEDAT(0)
  1.  W !!
  1.  I BYIMADM=2 D  I 1
  1.  .W "Administered and historic"
  1.  E  W "Only administered"
  1.  W " and ",!
  1.  I BYIMALL=2 D  I 1
  1.  .W "new and previously exported"
  1.  E  W "never exported"
  1.  W !,"immunizations will be included in the test export."
  1.  Q
  1.  ;-----
  1. T1 ;SELECT TEST EXPORT DATE
  1.  ;PATCH 8 CR 08694 - EXCLUDE IMM PRIOR TO SELECTED DATE
  1.  K DIR
  1.  S DIR(0)="DO"
  1.  S DIR("A")="Select start date for the TEST export"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'X
  1.  S BYIMEDAT=Y,BYIMEDAT(0)=Y(0)
  1.  ;PATCH 8 CR 08694 END
  1.  Q
  1.  ;-----
  1. T2 ;INCLUDE ONLY ADMINISTERED IMMUNIZATIONS
  1.  ;PATCH 8 CR 08695 - INCLUDE/EXCLUDE HISTORIC IMMS
  1.  S BYIMADM=1
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Exclude HISTORIC immunizations"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:X[U
  1.  S BYIMADM=1
  1.  I 'Y S BYIMADM=2 Q
  1.  S BYIMADM=1
  1.  ;PATCH 8 CR 08695 - END
  1.  Q
  1.  ;-----
  1. T3 ;EXCLUDE PREVIOUSLY EXPORTED IMMUNIZATIONS
  1.  ;PATCH 8 CR 08626 - INCLUDE/EXCLUDE PREVIOUSLY EXPORTED
  1.  ;BYIMALL=1 EXPORT ONLY NEW, NOT YET EXPORTED IMMS
  1.  ;BYIMALL=2 EXPORT NEW AND PREVIOUSLY EXPORTED IMMS
  1.  S BYIMALL=1
  1.  K DIR
  1.  S DIR(0)="YO"
  1.  S DIR("A")="Exclude PREVIOUSLY EXPORTED immunizations"
  1.  S DIR("B")="YES"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:X[U
  1.  I 'Y S BYIMALL=2 Q
  1.  S BYIMALL=1
  1.  ;PATCH 8 CR 08626 - END
  1.  Q
  1.  ;-----
  1. COMPSPEC ;EP;TO SPECIFY MESSAGE COMPONENT CONTENT
  1.  ;N X,Y,Z,XX,SEG,COMP,SCOMP,VAL,BYIMQUIT
  1.  S BYIMQUIT=0
  1.  F  D CS Q:BYIMQUIT
  1.  Q
  1.  ;-----
  1. CS ;REPEAT
  1.  D CDISP
  1.  I '$O(COMP(0)) S QUIT=1 Q
  1.  D CSEL
  1.  Q
  1.  ;-----
  1. CDISP ;EP;DISPLAY COMPONENTS FOR PRIMARY SITE
  1.  S SITE=$P(^DIC(4,$$DUZ^BYIMIMM(),0),U)
  1.  D CHDR(SITE)
  1.  S X=0
  1.  F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),7,X)) Q:'X  S Y=^(X,0) D
  1.  .S SEG=$P(Y,U)
  1.  .S COMP=$P(Y,U,2)
  1.  .S SCOMP=$P(Y,U,3)
  1.  .Q:'COMP!'SCOMP
  1.  .S VAL=$P(Y,U,4)_U_X
  1.  .S:SEG="MSH" SEG="1-MSH"
  1.  .S:SEG="PID" SEG="2-PID"
  1.  .S:SEG="PD1" SEG="3-PD1"
  1.  .S:SEG="NK1" SEG="4-NK1"
  1.  .S:SEG="PV1" SEG="5-PV1"
  1.  .S:SEG="ORC" SEG="6-ORC"
  1.  .S:SEG="RXA" SEG="7-RXA"
  1.  .S XX(SEG,COMP,SCOMP)=VAL
  1.  D CD
  1.  Q
  1.  ;-----
  1. CAS(AS) ;EP;DISPLAY COMPONENTS FOR ADDITIONAL EXPORT SITES
  1.  S SITE=$P(^BYIMPARA($$DUZ^BYIMIMM(),3,AS,0),U)
  1.  D CHDR(SITE)
  1.  N X,Y,Z,XX,SEG,SCOMP,VAL
  1.  S X=0
  1.  F  S X=$O(^BYIMPARA($$DUZ^BYIMIMM(),3,AS,7,X)) Q:'X  S Y=^(X,0) D
  1.  .S SEG=$P(Y,U)
  1.  .S COMP=$P(Y,U,2)
  1.  .S SCOMP=$P(Y,U,3)
  1.  .S VAL=$P(Y,U,4)
  1.  .S:SEG="MSH" SEG="1-MSH"
  1.  .S:SEG="PID" SEG="2-PID"
  1.  .S:SEG="PD1" SEG="3-PD1"
  1.  .S:SEG="NK1" SEG="4-NK1"
  1.  .S:SEG="PV1" SEG="5-PV1"
  1.  .S:SEG="ORC" SEG="6-ORC"
  1.  .S:SEG="RXA" SEG="7-RXA"
  1.  .S XX(SEG,COMP,SCOMP)=X_U_VAL
  1.  D CD
  1.  Q
  1.  ;-----
  1. CD ;
  1.  S JJ=0
  1.  S X=""
  1.  F  S X=$O(XX(X)) Q:X=""  D
  1.  .S Y=0
  1.  .F  S Y=$O(XX(X,Y)) Q:'Y  D
  1.  ..S Z=0
  1.  ..F  S Z=$O(XX(X,Y,Z)) Q:'Z  S VAL=XX(X,Y,Z) D
  1.  ...S JJ=JJ+1
  1.  ...W !,JJ,?5,$P(X,"-",2),?18,Y,?30,Z,?39,$P(VAL,U)
  1.  ...S COMP(JJ)=+VAL_U_$P(X,"-",2)
  1.  S BYIMJ=JJ
  1.  Q
  1.  ;
  1. CHDR(SITE) ;DISPLAY COMPONENT HEADER
  1.  W @IOF
  1.  W !!?15,"HL7 State Specified Message Components"
  1.  W !?15,"For: ",SITE
  1.  W !!?27,"Sub-"
  1.  W !,"NO",?5,"Segment",?15,"Component",?27,"Component",?39,"Value"
  1.  W !,"--",?5,"-------",?15,"---------",?27,"---------",?39,"--------------------------"
  1.  Q
  1.  ;-----
  1. CADD ;ADD ADDITIONAL COMPONENTS
  1.  S DIR(0)="SO^1:MSH;2:PID;3:PD1;4:NK1;5:PV1;6:ORC;7:RXA"
  1.  S DIR("A")="Select a segment for component specification"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  S SEG=Y(0)
  1.  I $D(^BYIMPARA($$DUZ^BYIMIMM(),7,"SEG",X)) D
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="ADD another "_SEG_" component"
  1.  .W !!
  1.  .D ^DIR
  1.  Q:'Y
  1.  S X=SEG
  1.  S DA(1)=$O(^BYIMPARA(0))
  1.  S DIC="^BYIMPARA("_DA(1)_",7,"
  1.  S DIC(0)="L"
  1.  D FILE^DICN
  1.  Q:'Y
  1.  D CE(+Y,SEG)
  1.  Q
  1.  ;-----
  1. CEDIT ;EDIT COMPONENTS
  1.  K DIR
  1.  S DIR(0)="NO^1:"_BYIMJ
  1.  S DIR("A")="Select Component to edit"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  Q:'Y
  1.  S SEG=$P(COMP(Y),U,2)
  1.  D CE(Y)
  1.  Q
  1.  ;-----
  1. CE(DA,SEG) S DIE="^BYIMPARA("_$$DUZ^BYIMIMM()_",7,"
  1.  S DA(1)=$O(^BYIMPARA(0))
  1.  S DA=DA
  1.  S DR=".02;.03;.04"
  1.  W !!,"Edit ",SEG," info",!
  1.  D ^DIE
  1.  Q
  1.  ;-----
  1. CDEL ;DELETE COMPONENTS    
  1.  Q
  1.  ;-----
  1. CSEL ;EP;TO DISPLAY AND ADD/EDIT COMPONENTS
  1.  D CDISP
  1.  K DIR
  1.  S DIR(0)="SO^1:Edit Message Components;2:Add Message Components;3:Delete Message Components"
  1.  W !!
  1.  D ^DIR
  1.  K DIR
  1.  I 'Y S BYIMQUIT=1 Q
  1.  I Y=1 D CEDIT Q
  1.  I Y=2 D CADD Q
  1.  I Y=3 D CDEL
  1.  Q
  1.  ;-----
  1. AGECHK(UIF) ;EP;
  1.  ;TO CHECK EXPORT AGE OF ADD. EXPORT SITE VERSUS EXPORT AGE OF
  1.  ;PRIMARY SITE
  1.  N MSH,PID,DOB,D19
  1.  Q:'$G(UIF) 0
  1.  S MSH=$G(^INTHU(UIF,3,1,0))
  1.  Q:MSH'["MSH|" 0
  1.  S PID=$G(^INTHU(UIF,3,2,0))
  1.  Q:PID="" 0
  1.  S DOB=$P(PID,"|",8)-17000000
  1.  Q:$L(DOB)'=7 0
  1.  S D19=(DT-190000) ;CHANGE TO FM DATE FORMAT AND 19 YEARS
  1.  Q:DOB<D19 1
  1.  Q 0
  1.  ;-----
  1. ASSET(AS) ;EP;SITE STATE VARIABLES
  1.  D:AS=BYIMDUZ
  1.  .S X0=$G(^BYIMPARA(BYIMDUZ,0))
  1.  .S X1=$G(^BYIMPARA(BYIMDUZ,1))
  1.  .S X6=$G(^BYIMPARA(BYIMDUZ,6))
  1.  D:AS'=BYIMDUZ
  1.  .S X0=$G(^BYIMPARA(BYIMDUZ,3,AS,0))
  1.  .S X1=$G(^BYIMPARA(BYIMDUZ,3,AS,1))
  1.  .S X6=$G(^BYIMPARA(BYIMDUZ,3,AS,6))
  1.  S PATH=$$SLASH^BYIMIMM6($P(X0,U,2))
  1.  S (XX("MSH",3,1),XX("FHS",3,1),XX("BHS",3,1))=$P(X1,U,3)
  1.  S (XX("MSH",3,2),XX("FHS",3,2),XX("BHS",3,2))=$P(X1,U,4)
  1.  S (XX("MSH",3,3),XX("FHS",3,3),XX("BHS",3,3))=$P(X1,U,5)
  1.  S (XX("MSH",4,1),XX("FHS",4,1),XX("BHS",4,1))=$P(X0,U,7)
  1.  S (XX("MSH",4,2),XX("FHS",4,2),XX("BHS",4,2))=$P(X1,U,6)
  1.  S (XX("MSH",4,3),XX("FHS",4,3),XX("BHS",4,3))=$P(X1,U,7)
  1.  S XX("MSH",5,1)=$P(X6,U,3)
  1.  S XX("MSH",5,2)=$P(X6,U,4)
  1.  S XX("MSH",5,3)=$P(X6,U,5)
  1.  S XX("MSH",6,1)=$P(X1,U,8)
  1.  S XX("MSH",8,1)=$P(X0,U,15)
  1.  S XX("MSH",11,1)=$P(X6,U,11)
  1.  S XX("PID",11,7)=$P(X6,U,8)
  1.  S XX("PD1",3,1)=$P(X6,U)
  1.  S XX("PD1",3,2)=$P(X6,U,2)
  1.  S XX("PD1",3,3)=$P(X6,U,9)
  1.  S XX("RXA",6,1)=$P(X6,U,10)
  1.  S FE=$P(X0,U,8)
  1.  S PI=$P(X0,U,10)
  1.  S IN1=$P(X0,U,16)
  1.  S CPT=$P(X0,U,17)
  1.  S ESSN=$P(X6,U,7)
  1.  S AGE=$P(X0,U,6)
  1.  Q
  1.  ;----