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

BMC4P12.m

Go to the documentation of this file. 
  1. BMC4P12 ;IHS/OIT/FCJ - BMC 4.0 PATCH 12 ; 16 Feb 2011  2:54 PM
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**12**;JAN 09, 2006;Build 92
  1.  ;
  1.  I '$G(IOM) D HOME^%ZIS
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,"DUZ(0) DOES NOT CONTAIN AN '@'." D SORRY(2) Q
  1.  ;
  1.  S X=$$GET1^DIQ(200,DUZ,.01)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_".",IOM),!
  1.  ;
  1.  NEW IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  ;
  1.  I $$VCHK("BMC","4.0",2,"'=")
  1.  I $$VCHK("DI","22.0",2,"<")
  1.  I $$VCHK("XU","8.0",2,"<")
  1.  I $$VCHK^BMC4P12("AICD","4.0",2,"<")
  1.  I '$$INSTALLD("AG*7.1*11") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I '$$INSTALLD("AUPN*99.1*16") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I '$$INSTALLD("ATX*5.1*5") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I '$$INSTALLD("AUT*98.1*26") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I '$$INSTALLD("LEX*2.0*1003") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I '$$INSTALLD("OR*3.0*190") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  I $$VCHK("BSTS","1.0",2,"'=")
  1.  W !!
  1.  S DIR(0)="Y0",DIR("A")="Is the Facility using PCC" D ^DIR
  1.  I +Y>0,'$$INSTALLD("BJPC*2.0*10") S BMCQUIT=2 D SORRY(BMCQUIT)
  1.  W !
  1.  S DIR(0)="Y0",DIR("A")="Is the Facility using EHR" D ^DIR
  1.  I +Y>0,'$$INSTALLD("BGO*1.1*13") S BMCQUIT=2 D SORRY(BMCQUIT) W !
  1.  ;
  1.  NEW DA,DIC
  1.  S X="BMC",DIC="^DIC(9.4,",DIC(0)="",D="C"
  1.  D IX^DIC
  1.  I Y<0,$D(^DIC(9.4,"C","BMC")) D
  1.  . W !!,*7,*7,$$CJ^XLFSTR("You Have More Than One Entry In The",IOM),!,$$CJ^XLFSTR("PACKAGE File with an ""BMC"" prefix.",IOM)
  1.  . W !,$$CJ^XLFSTR(IORVON_"One entry needs to be deleted."_IORVOFF,IOM)
  1.  . D SORRY(2)
  1.  ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR(IORVON_"You will need to update package(s) before proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  D HELP^XBHELP("INTROE","BMC4E")
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 D HELP^XBHELP("INTROI","BMC4E") I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....Need to update package!",IOM)
  1.  Q
  1.  ;
  1. VCHK(BMCPRE,BMCVER,BMCQUIT,BMCCOMP) ; Check versions needed. 
  1.  NEW BMCV
  1.  S BMCV=$$VERSION^XPDUTL(BMCPRE)
  1.  I BMCV="" D  Q 0
  1.  .W !,$$CJ^XLFSTR("Need "_$S(BMCCOMP="<":"at least ",1:"")_BMCPRE_" v "_BMCVER_"....."_BMCPRE_" v "_BMCV_" Not Present",IOM)
  1.  .D SORRY(BMCQUIT)
  1.  W !,$$CJ^XLFSTR("Need "_$S(BMCCOMP="<":"at least ",1:"")_BMCPRE_" v "_BMCVER_"....."_BMCPRE_" v "_BMCV_" Present",IOM)
  1.  I @(BMCV_BMCCOMP_BMCVER) D SORRY(BMCQUIT) Q 0
  1.  Q 1
  1.  ;
  1. INSTALLD(BMC) ; Determine if patch BMC was installed, where BMC is
  1.  ; the name of the INSTALL.  E.g "AVA*93.2*12".
  1.  NEW DIC,X,Y,P
  1.  ;  lookup package.
  1.  S X=$P(BMC,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup version.
  1.  S DIC=DIC_+Y_",22,",X=$P(BMC,"*",2)
  1.  D ^DIC
  1.  I Y<1 Q 0
  1.  ;  lookup patch.
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BMC,"*",3)
  1.  D ^DIC
  1.  I Y<1 S P=DIC_"""B"","_X_")" I $O(@P)'="" S Y=1
  1.  I Y>0 W !,$$CJ^XLFSTR("Need at least "_BMC_"....."_BMC_" Present",IOM)
  1.  I Y<0 W !,$$CJ^XLFSTR("Need at least "_BMC_".....",IOM)
  1.  Q $S(Y<1:0,1:1)
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  I $$NEWCP^XPDUTL("PRE1","AUDS^BMC4E")
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  ;Add BUSA entries
  1.  I $D(^BUSA(9002319.03,0)) D
  1.  . ;BMC ADD REFERRAL
  1.  . I $O(^BUSA(9002319.03,"B","BMC ADD REFERRAL",""))="" D
  1.  .. NEW DIC,X,DLAYGO,Y,DTOUT,DIRUT,DUOUT,BUSAUPD,DA,ERROR
  1.  .. S DIC(0)="L",DIC="^BUSA(9002319.03,"
  1.  .. L +^BUSA(9002319.03,0):1 E  Q
  1.  .. S X="BMC ADD REFERRAL",DLAYGO=9002319.03
  1.  .. K DO,DD D FILE^DICN
  1.  .. L -^BUSA(9002319.03,0)
  1.  .. I +Y<0 Q
  1.  .. S DA=+Y
  1.  .. S BUSAUPD(9002319.03,DA_",",.02)="P",BUSAUPD(9002319.03,DA_",",.03)="A"
  1.  .. S BUSAUPD(9002319.03,DA_",",.06)="S X=""BMC: Created patient referral"""
  1.  .. S BUSAUPD(9002319.03,DA_",",1.01)="I~2",BUSAUPD(9002319.03,DA_",",2.01)="I~32"
  1.  .. D FILE^DIE("","BUSAUPD","ERROR")
  1.  . ;BMC UPDATE REFERRAL
  1.  . I $O(^BUSA(9002319.03,"B","BMC UPDATE REFERRAL",""))="" D
  1.  .. NEW DIC,X,DLAYGO,Y,DTOUT,DIRUT,DUOUT,BUSAUPD,DA,ERROR
  1.  .. S DIC(0)="L",DIC="^BUSA(9002319.03,"
  1.  .. L +^BUSA(9002319.03,0):1 E  Q
  1.  .. S X="BMC UPDATE REFERRAL",DLAYGO=9002319.03
  1.  .. K DO,DD D FILE^DICN
  1.  .. L -^BUSA(9002319.03,0)
  1.  .. I +Y<0 Q
  1.  .. S DA=+Y
  1.  .. S BUSAUPD(9002319.03,DA_",",.02)="P",BUSAUPD(9002319.03,DA_",",.03)="E"
  1.  .. S BUSAUPD(9002319.03,DA_",",.06)="S X=""BMC: Update patient referral"""
  1.  .. S BUSAUPD(9002319.03,DA_",",1.01)="I~1"
  1.  .. S BUSAUPD(9002319.03,DA_",",1.02)="S X=$$GET1~DIQ(90001,X_"","",.03,""I"")"
  1.  .. S BUSAUPD(9002319.03,DA_",",2.01)="I~1"
  1.  .. S BUSAUPD(9002319.03,DA_",",2.02)="S X=$$GET1~DIQ(90001,X_"","",1309,""I"")"
  1.  .. D FILE^DIE("","BUSAUPD","ERROR")
  1.  ;
  1.  ; --- Restore dd audit settings.
  1.  S %="AUDR^BMC4E"
  1.  I $$NEWCP^XPDUTL("POS1-"_%,%)
  1.  ; --- Set new Index "BA" and "BB"
  1.  S %="INDX^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS2-"_%,%)
  1.  ; --- Add Provider/Vendor Option
  1.  S %="P5^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS3-"_%,%)
  1.  ; --- Add MED HX Opt and fx CHS 2010 PO #'s
  1.  S %="P6^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS4-"_%,%)
  1.  ; --- Add Opt-printing C32s for Active referrals
  1.  S %="P7^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS5-"_%,%)
  1.  ; --- Add Opt-TOC and Edit option for TOC
  1.  S %="P8^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS6-"_%,%)
  1.  ; ---Re-Add Options, removed because a parent opt sent
  1.  S %="P9^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS8-"_%,%)
  1.  ; ---Remove CHS PAID from GEN RET
  1.  S %="P10^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS9-"_%,%)
  1.  ; ---Remove clinic field from V ref file
  1.  S %="P10VR^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS10-"_%,%)
  1.  ; ---Reformat comments to 80 char in RCIS Comments file
  1.  S %="P10COM^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS11-"_%,%)
  1.  ; ---New Opt and fix of V Ref file
  1.  S %="P12^BMC4P12"
  1.  I $$NEWCP^XPDUTL("POS12-"_%,%)
  1.  ; --- Send mail message of install.
  1.  S %="MAIL^BMC4E"
  1.  I $$NEWCP^XPDUTL("POS13-"_%,%)
  1.  Q
  1.  ;
  1. INDX ;INDEX NEW INDECIES "BA", "BB" AND "CD" ;Patch 2
  1.  S BMC="BMC*4.0*2" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D BMES^XPDUTL("BEGIN Indexing Expected Begining Date of Service.")
  1.  S DIK="^BMCREF("
  1.  S DIK(1)="1105^BA"
  1.  D ENALL^DIK
  1.  D BMES^XPDUTL("BEGIN Indexing Appointment/begin DOS.")
  1.  S DIK(1)="1106^BB"
  1.  D ENALL^DIK
  1.  D BMES^XPDUTL("BEGIN Indexing CHS Denial Number.")
  1.  S DIK(1)="1128^CD"
  1.  D ENALL^DIK
  1.  D BMES^XPDUTL("Completed updating new indexes.")
  1.  K DA,DIC,DIK,X
  1.  Q
  1. P5 ;Add Opt for Vendor
  1.  S BMC="BMC*4.0*5" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D BMES^XPDUTL("Begin adding new Provider/Vendor option.")
  1.  I $$ADD^XPDMENU("BMCMENU","BMCVEN","VEN") D MES^XPDUTL($J("",5)_"Provider/Vendor add/edit Menu added to RCIS Main Menu")
  1.  D MES^XPDUTL("END updating option.")
  1.  Q
  1. P6 ;FX CHS PO'S WITH FY 00 INSTEAD OF FY 10
  1.  S BMC="BMC*4.0*6" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D MES^XPDUTL("Updating CHS 2010 PO Numbers.")
  1.  S BMC=3090900 F  S BMC=$O(^BMCREF("B",BMC)) Q:BMC'?1N.N  D
  1.  .S BMC1="" F  S BMC1=$O(^BMCREF("B",BMC,BMC1)) Q:BMC1'?1N.N  D
  1.  ..I $D(^BMCREF(BMC1,41)) S BMC2=0 F  S BMC2=$O(^BMCREF(BMC1,41,BMC2)) Q:BMC2'?1N.N  D
  1.  ...S BMCPO=$P(^BMCREF(BMC1,41,BMC2,0),U,8)
  1.  ...I $E(BMCPO,1,2)="00",$L(BMCPO)=12 D
  1.  ....S $P(^BMCREF(BMC1,41,BMC2,0),U,8)="10"_$E(BMCPO,3,12)
  1.  ....S $P(^BMCREF(BMC1,41,BMC2,11),U)=10
  1.  D BMES^XPDUTL("Begin adding option for Adding Med Hx comments.")
  1.  I $$ADD^XPDMENU("BMC MENU EDIT REFERRAL","BMC MED HX COMMENTS","MED") D MES^XPDUTL($J("",5)_"Enter Medical Hx Comments Menu added to RCIS Edit Menu")
  1.  D MES^XPDUTL("END updating option.")
  1.  Q
  1. P7 ;Add Report opt for the printed C32
  1.  S BMC="BMC*4.0*7" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D BMES^XPDUTL("Begin adding option for Active referrals without a printed C32.")
  1.  I $$ADD^XPDMENU("BMC MENU-RPTS ADMINISTRATIVE","BMC RPT-ACTIVE REFERRALS-C32","ARC") D MES^XPDUTL($J("",5)_"Report for Active ref w/o a C32 Menu added to Adm Report option")
  1.  D MES^XPDUTL("END updating option.")
  1.  Q
  1. P8 ;Add Report TOC Opt and Edit TOC Opt
  1.  S BMC="BMC*4.0*8" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D BMES^XPDUTL("Begin adding option for TOC Report for Approved referrals pending a TOC document.")
  1.  I $$ADD^XPDMENU("BMC MENU-RPTS ADMINISTRATIVE","BMC RPT-APPRV REF TOC PENDING","TOCR") D MES^XPDUTL($J("",5)_"Report for Approved ref w/o a TOC option added to Adm Report option")
  1.  D BMES^XPDUTL("Begin adding Edit option for TOC Information.")
  1.  I $$ADD^XPDMENU("BMC MENU EDIT REFERRAL","BMC MOD TOC","TOC") D MES^XPDUTL($J("",5)_"Edit Option for TOC information for Approved Referrals.")
  1.  D MES^XPDUTL("END updating option.")
  1.  ;
  1. PCCLNK  ;Add RCIS to PCC Visit Merge Utility
  1.  ;NEW INDEX NEED TO REINDEX FOR BETA SITES
  1.  S DIK="^BMCREF(",DIK(1)="1309^VSTR" D ENALL^DIK K DIK
  1.  I $D(^APCDLINK("B","REFERRED CARE INFORMATION SYST")) D  ;already exists
  1.  .S DA=0,DA=$O(^APCDLINK("B","REFERRED CARE INFORMATION SYST",DA))
  1.  .S DIE="^APCDLINK(",DR=".01///REFERRED CARE INFORMATION SYS;1///I $L($T(MRG^BMCPCCV))"
  1.  .D ^DIE K DIE,DA,DR
  1.  Q:$D(^APCDLINK("B","REFERRED CARE INFORMATION SYS"))  ;already exists
  1.  D BMES^XPDUTL("Adding RCIS to PCC Visit Merge Utility . . .")
  1.  NEW DD,DO,DIC,DLAYGO,X,Y
  1.  S DIC="^APCDLINK(",DIC(0)="LE",DLAYGO=9001002
  1.  S DIC("DR")=".02///BMC;1///I $L($T(MRG^BMCPCCV)) D MRG^BMCPCCV;3///I $L($T(DEL^BMCPCCV)) D DEL^BMCPCCV"
  1.  S X="REFERRED CARE INFORMATION SYS" D FILE^DICN
  1.  Q
  1. P9 ;Add Report Opt
  1.  S BMC="BMC*4.0*9" ;Q:$$INSTALLD^BMC4P0(BMC)
  1.  D MES^XPDUTL("Begin updating Special Print Menu option.")
  1.  I $$ADD^XPDMENU("BMC MENU SPECIAL","BMC DISPLAY REFERRAL RECORD","DSP")
  1.  I $$ADD^XPDMENU("BMC MENU SPECIAL","BMC PRINT REFERRAL FORMS","PRF")
  1.  I $$ADD^XPDMENU("BMC MENU SPECIAL","BMC PRINT ROUTING SLIP","PRS")
  1.  I $$ADD^XPDMENU("BMC MENU SPECIAL","BMC MENU-PRINT REPORTS","RPT")
  1.  D MES^XPDUTL("END updating Special Print Menu option.")
  1.  Q
  1. P10 ;Patch 10
  1.  ;S BMC="BMC*4.0*10" Q:$$INSTALLD^BMC4P0(BMC)
  1.  ;Delete GEN RET option 99.1 CHS Paid To Date
  1.  NEW DA,DIE,DIC,DR
  1.  S X="CHS Paid To Date",(DIC,DIE)="^BMCTSORT(",DR=".01////"_"@"
  1.  D ^DIC
  1.  I +Y<0 D BMES^XPDUTL("Unable to remove CHS Paid To Date from Gen Ret items . . .")
  1.  S DA=+Y
  1.  D ^DIE
  1.  D BMES^XPDUTL("CHS Paid To Date removed from Gen Ret items . . .")
  1.  Q
  1.  ;
  1. P10VR ;Clean up clinic stop in V Referral file
  1.  S BMC="BMC*4.0*10" Q:$$INSTALLD^BMC4P0(BMC)
  1.  NEW DA,DIE,DIC,DR
  1.  S DA=0
  1.  S DIE="^AUPNVREF(",DR="1203////"_"@"
  1.  F  S DA=$O(^AUPNVREF(DA)) Q:DA'?1N.N  D:$P($G(^AUPNVREF(DA,12)),U,3)'=""
  1.  .D ^DIE
  1.  D BMES^XPDUTL("Completed clean up of clinic stop field in V Referral file . . .")
  1.  Q
  1. P10COM ;Clean up of comments file
  1.  S BMC="BMC*4.0*10" Q:$$INSTALLD^BMC4P0(BMC)
  1.  NEW DA,DIE,DIC,DR
  1.  S BEGDT=3130100
  1.  F  S BEGDT=$O(^BMCCOM("B",BEGDT)) Q:BEGDT'?1N.N  D
  1.  .S DA=0
  1.  .F  S DA=$O(^BMCCOM("B",BEGDT,DA)) Q:DA'?1N.N  D
  1.  ..Q:'$D(^BMCCOM(DA,1,0))
  1.  ..S DA(1)=0,FLG=0 F  S DA(1)=$O(^BMCCOM(DA,1,DA(1))) Q:DA(1)'?1N.N  I $L(^BMCCOM(DA,1,DA(1),0))>80 S FLG=1
  1.  ..Q:FLG'=1
  1.  ..S DA(1)=0 F  S DA(1)=$O(^BMCCOM(DA,1,DA(1))) Q:DA(1)'?1N.N  D
  1.  ...S ^BMCCOMT(DA,1,DA(1),0)=^BMCCOM(DA,1,DA(1),0)
  1.  ..S ^BMCCOMT(DA,1,0)=^BMCCOM(DA,1,0),BMCDA=(DA(1)-1)
  1.  ..K ^BMCCOM(DA,1)
  1.  ..S BMCDA=0,BMCDA2=0
  1.  ..F  S BMCDA=$O(^BMCCOMT(DA,1,BMCDA)) Q:BMCDA'?1N.N  D
  1.  ...S BMCCOM=^BMCCOMT(DA,1,BMCDA,0)
  1.  ...S L=($L(BMCCOM)/80) I L#1>0 S L=L+1
  1.  ...S (LGTH,LGTH2)=0 F I=1:1:L D
  1.  ....S LGTH=LGTH2+1,BMCDA2=BMCDA2+1,LGTH2=80*BMCDA2 S ^BMCCOM(DA,1,BMCDA2,0)=$E(BMCCOM,LGTH,LGTH2)
  1.  ...S ^BMCCOM(DA,1,0)=^BMCCOMT(DA,1,0),$P(^BMCCOM(DA,1,0),U,2,4)="90001.031"_U_BMCDA2_U_BMCDA2
  1.  K L,LGTH,LGHT2,BMCDA,BMCDA2,BMCCOM,FLG,BEGDT,CT
  1.  D BMES^XPDUTL("Completed clean up RCIS Comments file . . .")
  1.  Q
  1.  ;
  1. P12 ;Add Report Opt and Call-in options 
  1.  ;S BMC="BMC*4.0*12" Q:$$INSTALLD^BMC4P0(BMC)
  1.  D BMES^XPDUTL("Begin adding option for CHS Paid Report.")
  1.  I $$ADD^XPDMENU("BMC MENU-RPTS ADMINISTRATIVE","BMC RPT-CHS ONLY PAID","CHSP") D MES^XPDUTL($J("",5)_"Report for CHS Paid Referrals option added to Adm Report option")
  1.  D BMES^XPDUTL("Begin adding Edit option for Call-in Referrals.")
  1.  I $$ADD^XPDMENU("BMC MENU REFERRAL MANAGEMENT","BMC CALL-IN REFERRAL EDIT","CIN") D MES^XPDUTL($J("",5)_"Edit Call in Referrals added to Referral Management Menu.")
  1.  D MES^XPDUTL("END updating option.")
  1. VREF ;CLEAN UP V REF FILE
  1.  G:$G(^AUPNVREF(0)) ZPAR
  1.  D BMES^XPDUTL("Updating V Referral file.")
  1.  ;FIX TO STUFF 1202 OF V REFERRAL WITH REQUESTING PROVIDER FROM RCIS REFERRAL ENTRY
  1.  ;NULL OUT 1210 FIELD VALUE
  1.  ;MOVE AND CORRECT V REFERRAL INFO BASED ON REFERRAL ENTRY
  1.  NEW APCDVREF,APCDREF,APCDRP,BMCVDFN,BMCVPRV
  1.  S APCDVREF=0 F  S APCDVREF=$O(^AUPNVREF(APCDVREF)) Q:APCDVREF'=+APCDVREF  D
  1.  .S APCDREF=$$VALI^XBDIQ1(9000010.59,APCDVREF,.06)
  1.  .Q:APCDREF=""  ;NO REFERRAL IEN
  1.  .Q:'$D(^BMCREF(APCDREF,0))  ;no referral??
  1.  .S APCDRP=$$VALI^XBDIQ1(90001,APCDREF,.06)  ;REQUESTING PROVIDER IEN
  1.  .S (BMCVDFN,BMCVPRV)="",BMCVDFN=$$VALI^XBDIQ1(90001,APCDREF,1309) I BMCVDFN S BMCVPRV=$$PRIMPROV^APCLV(BMCVDFN,"I")
  1.  .S DIE="^AUPNVREF(",DA=APCDVREF
  1.  .I APCDRP S DR="1210///@;1202////"_APCDRP
  1.  .I 'APCDRP S DR="1210///@;1202///@"
  1.  .I BMCVPRV S DR=DR_";1204////"_BMCVPRV     ;SET PROV ENCOUNTER
  1.  .D ^DIE
  1.  .I $D(Y) D EN^DDIOL("failure to update v referral "_APCDVREF)
  1.  .K DIE,DA,DR
  1.  D BMES^XPDUTL("Completed Updating V Referral file.")
  1. ZPAR ;ADD ENTRY TO ZISH PARAMETER FILE
  1.  D BMES^XPDUTL("Adding entry to Zish Send Parameter file.")
  1.  S X="BMC RCIS REPORTS",DIC="^%ZIB(9888888.93,",DIC(0)="L"
  1.  D ^DIC
  1.  I Y<0 W !,"ZISH SEND PARAMETER FOR THE BMC RCIS REPORTS ENTRY COULD NOT BE ADDED, YOU WILL NEED ADD THROUGH FILEMAN" G GENRET
  1.  S DA=+Y,DIE=DIC
  1.  S DR=".07////"_"B"_";.08////"_"sendto"
  1.  D ^DIE
  1.  K D,D0,D1,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM,DA
  1.  D BMES^XPDUTL("Completed adding Entry to Zish Send Parameter file.")
  1.  ;
  1. GENRET ;UPDATE GEN RET OPTIONS
  1.  D BMES^XPDUTL("Updating items for the Gen Ret Report option.")
  1.  NEW DA,DIE,DIC,DR
  1.  S X="Service Category (CPT)",(DIC,DIE)="^BMCTSORT(",DR=".01////Service Cat HCPCS/CPT"
  1.  D ^DIC I +Y>0 S DA=+Y D ^DIE K DR
  1.  S X="Util Review Committee",DR=".09////952"
  1.  D ^DIC I +Y>0 S DA=+Y D ^DIE K DR
  1.  S X="Mgd Care Committee",DR=".09////950"
  1.  D ^DIC I +Y>0 S DA=+Y D ^DIE K DR
  1.  S X="DT Mgd Care Action",DR=".09////951"
  1.  D ^DIC I +Y>0 S DA=+Y D ^DIE K DR
  1.  S X="Site Created by" D ^DIC I +Y<0 S DIC(0)="L" D
  1.  .D ^DIC S DA=+Y
  1.  .S DR=".02////R;.04////90001.31,.01;.05////S;.06////Site Created by;.07////20;.09////999;.11////R;"
  1.  .S DR=DR_"1////S X=$$FACREQ^BMCRLU1(BMCREF);2////S X=$P(^DIC(4,BMCY,0),U)"
  1.  .D ^DIE
  1.  D BMES^XPDUTL("Completed updating items for the Gen Ret option . . .")
  1.  K DA,DIE,DIC,DR
  1.  Q