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

BMC4P.m

Go to the documentation of this file. 
  1. BMC4P ;IHS/ITSC/FCJ - BMC 4.0 INSTALL RTN 1 OF 2;     
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
  1.  ;
  1.  I '$G(IOM) D HOME^%ZIS
  1.  NEW IORVON,IORVOFF
  1.  S X="IORVON;IORVOFF"
  1.  D ENDR^%ZISS
  1.  I '$G(DUZ) W !,$$CJ^XLFSTR("DUZ UNDEFINED OR 0.",IOM) D SORRY(2) Q
  1.  I '$L($G(DUZ(0))) W !,$$CJ^XLFSTR("DUZ(0) UNDEFINED OR NULL.",IOM) D SORRY(2) Q
  1.  I '(DUZ(0)["@") W:'$D(ZTQUEUED) !,$$CJ^XLFSTR("DUZ(0) DOES NOT CONTAIN AN '@'.",IOM) D SORRY(2) Q
  1.  ;
  1. ENV 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.  S BMCNEW=""
  1.  D NEW I 'BMCNEW I $$VCHK("BMC","3.0",2,"<")
  1.  I $$VCHK("XU","8.0",2,"<")
  1.  I $$VCHK("DI","21.0",2,"<")
  1.  I $$VCHK("ATX","5.1",2,"<")
  1.  I $$VCHK("AUPN","99.1",2,"<")
  1.  G:BMCNEW ENV1
  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. MGR ;****CHECK FOR CHS MANAGER IN PARAMETER, NEEDED TO CONVERT MESSAGES
  1.  S X=0,BMCER=0
  1.  F  S X=$O(^BMCPARM("B",X)) Q:X'?1N.N  D  Q:BMCER
  1.  .S BMCMGR(X)=$P(^BMCPARM(X,0),U,13)
  1.  .I BMCMGR(X)'>0 S BMCER=1
  1.  I BMCER W !!?5,"In the RCIS Site Parameter File CHS Supervisor is not Entered.  This is",!?5,"required for the install." S XPDQUIT=2
  1. ENV1 ;
  1.  I $G(XPDQUIT) W !,$$CJ^XLFSTR(IORVON_"You must Fix it Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
  1.  D HELP^XBHELP("INTROE","BMC4P")
  1.  I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2) Q
  1.  ;
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 D HELP^XBHELP("INTROI","BMC4P") 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(IORVON_"Sorry....You must fix it before you can install."_IORVOFF,IOM)
  1.  Q
  1.  ;
  1. VCHK(BMCPRE,BMCVER,BMCQUIT,BMCCOMP) ; Check versions needed.
  1.  ;  
  1.  NEW BMCV
  1.  S BMCV=$$VERSION^XPDUTL(BMCPRE)
  1.  W !,$$CJ^XLFSTR("Need "_$S(BMCCOMP="<":"at least ",1:"")_BMCPRE_" v "_BMCVER_"....."_BMCPRE_" v "_BMCV_" Present",IOM)
  1.  S BMCV=+(BMCV)
  1.  I @(BMCV_BMCCOMP_BMCVER) D SORRY(BMCQUIT) Q 0
  1.  Q 1
  1.  ;
  1. NEW ;TEST FOR NEW PACKAGE
  1.  S X="BMC",Y="BMB"
  1.  I '$D(^DIC(9.4,"C","BMC")),'$D(^DIC(19,"C",X)),'($E($O(^DIC(19,"B",Y)),1,4)=X),'($E($O(^DIC(19.1,"B",Y)),1,4)=X) W !!,$$CJ^XLFSTR("NEW INSTALL",IOM),! S BMCNEW=1 Q
  1.  Q
  1.  ;
  1. INTROE ; Intro text during KIDS Environment check.
  1.  ;;In this distribution:
  1.  ;;(1) Secondary Referrals 
  1.  ;;    a. Moved Secondary referrals to RCIS Referral file
  1.  ;;    b. Moved Secondary Med Hx comments to RCIS Comments file
  1.  ;;    c. Modified numerous routines to filter Sec Ref from options
  1.  ;;    d. Sec Ref can be displayed using the Display Referral option
  1.  ;;    e. Reports: 
  1.  ;;        1. Added Sec Ref information to the Adm reports
  1.  ;;        2. Sec Ref can now be selected in the General Retrieval
  1.  ;;           Reports Option
  1.  ;;        3. Combined Sec Ref info with in the Utilization reports
  1.  ;;        4. Display Sec Ref info on the Case Management
  1.  ;;           Reports
  1.  ;;    f. Letters added option to print Prim Med HX on letter, also
  1.  ;;       added the date, priority and ref type to print on letter
  1.  ;;    g. Added new fields, amt date, priority, type, local category
  1.  ;;       and status
  1.  ;;    h. Sec Ref can be selected when entering a CHS PO or Denial
  1.  ;;    i. CHS info can be entered for the Sec Ref
  1.  ;;(2) Reports
  1.  ;;     a. Added date range selection to Adm reports
  1.  ;;     b. Added Browse function to Adm reports
  1.  ;;     c. Changed HRN to Ref # on CHS reports
  1.  ;;     d. Sub-totals on Inhouse referral reports
  1.  ;;     e. Removed the CHS Denial still active report
  1.  ;;     f. Added call-ins only and Case com dt to Gen Ret report
  1.  ;;     g. Added Pat elig status on RRR report
  1.  ;;(3) Default on Mod option 2 All Data changed to "Q"
  1.  ;;(4) Review comments for MD/MCC option changed selection to ref #,
  1.  ;;    Patient or date entered
  1.  ;;(5) Site Parameter for CHS, if link is Yes
  1.  ;;    a. Added option to auto close ref for denials linked to Ref
  1.  ;;    b. Added option to allow entry of CHS PO's without a referral
  1.  ;;(6) Print user who entered comments only Date stamp was printing
  1.  ;;(7) View face sheet and HS default to "No" after viewing, also
  1.  ;;    added options to Sec Ref template and Clinicians template
  1.  ;;(8) Closing a ref, removed C2, changed all C2 entries to X and added
  1.  ;;    Unknown and other to reasons, if Other is entered a comment can
  1.  ;;    be entered.
  1.  ;;(9) New option under edit menu to send Mailman message to Referring
  1.  ;;    Provider and Primary care Provider.
  1.  ;;(10)Miscellaneous routine modifications
  1.  ;;  Note: for complete description of changes see RCIS User's manual
  1.  ;;###
  1.  ;
  1. INTROI ; Intro text during KIDS Install.
  1.  ;;A standard message will be produced by this update.
  1.  ;;  
  1.  ;;If you run interactively, results will be displayed on your screen,
  1.  ;;as well as in the mail message and the entry in the INSTALL file.
  1.  ;;If you queue to TaskMan, please read the mail message for results of
  1.  ;;this update, and remember not to Q to the HOME device.
  1.  ;;###
  1.  ;
  1.  ;
  1. AUDS ;EP - From BMC4P0
  1.  D BMES^XPDUTL("Saving current DD AUDIT settings for RCIS files")
  1.  D MES^XPDUTL("and turning DD AUDIT to 'Y'.")
  1.  S ^XTMP("BMC4P0",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^"_$P($P($T(+1),";",2)," ",3,99)
  1.  NEW BMC
  1.  S BMC=0
  1.  F  S BMC=$O(^XTMP("XPDI",XPDA,"FIA",BMC)) Q:'BMC  D
  1.  . I '$D(^XTMP("BMC4P0",BMC,"DDA")) S ^XTMP("BMC4P0",BMC,"DDA")=$G(^DD(BMC,0,"DDA"))
  1.  . D MES^XPDUTL(" File "_$$RJ^XLFSTR(BMC,12)_" - "_$$LJ^XLFSTR(^XTMP("XPDI",XPDA,"FIA",BMC),30)_"- DD audit was '"_$G(^XTMP("BMC4P0",BMC,"DDA"))_"'"),MES^XPDUTL($$RJ^XLFSTR("Set to 'Y'",69))
  1.  . S ^DD(BMC,0,"DDA")="Y"
  1.  .Q
  1.  D MES^XPDUTL("DD AUDIT settings saved in ^XTMP(.")
  1.  Q
  1.  ; -----------------------------------------------------
  1. DELC ;EP;DEL COM FR THE RCIS REF FILE, ie MED HX, BO and Discharge notes
  1.  ;Moved to the RCIS Com file in v3
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0T")  ;Q IF V4.0 INSTALLED
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0")  ;Q IF V4.0 INSTALLED
  1.  D BMES^XPDUTL("Med Hx, BO and Discharge comments were moved in v3.0.")
  1.  D BMES^XPDUTL("BEGIN deleting duplicate Med Hx, BO and Discharge comments.")
  1.  S BMCINST="DELC" D SETVARS^BMC4P0
  1.  Q:$P(^XTMP("BMC4IN",BMCJOB,BMCINST),U)="C"
  1.  F  S BMC=$O(^BMCREF(BMC)) Q:BMC'?1N.N  D
  1.  .F I=1,2,3 I $D(^BMCREF(BMC,I)) D
  1.  ..S DA="" F  S DA=$O(^BMCREF(BMC,I,DA)) Q:DA'?1N.N  D
  1.  ...S DA(1)=BMC,DIK="^BMCREF("_DA(1)_","_I_"," D ^DIK
  1.  ..K ^BMCREF(BMC,I,0)  ;DIK WILL NOT KILL 0 NODE OF WP FIELD
  1.  .S BMCCT=BMCCT+1 I BMCCT#100=1 W "."
  1.  .S $P(^XTMP("BMC4IN",BMCJOB,BMCINST),U,2,3)=BMC_U_BMCCT
  1.  S $P(^XTMP("BMC4IN",BMCJOB,BMCINST),U)="C"  ;COMPLETED
  1.  D BMES^XPDUTL("COMPLETED deletion of Med Hx, BO and Discharge comments.")
  1.  Q
  1.  ; -----------------------------------------------------
  1. DELFLD ;EP
  1.  ;;90001^RCIS REFERRAL^1^PERTINENT MED HX & FINDINGS
  1.  ;;90001^RCIS REFERRAL^2^BUSINESS OFFICE/CHS COMMENTS
  1.  ;;90001^RCIS REFERRAL^3^DISCHARGE NOTES
  1.  ;;END
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0T")  ;Q IF V4.0 INSTALLED
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0")  ;Q IF V4.0 INSTALLED
  1.  D BMES^XPDUTL("BEGIN Removing fields from RCIS data dictionary.")
  1.  NEW DA,DIK
  1.  F BMC=1:1:3 S X=$P($T(DELFLD+BMC),";",3) D
  1.  . D MES^XPDUTL($J("",5)_"Deleting '"_$$LJ^XLFSTR($P(X,U,4),30,".")_"' from '"_$P(X,U,2)_"'")
  1.  . S DA(1)=$P(X,U,1),DA=$P(X,U,3),DIK="^DD("_DA(1)_","
  1.  . D ^DIK
  1.  D MES^XPDUTL("END Removing deleted fields from RCIS data dictionary.")
  1.  Q
  1.  ; -----------------------------------------------------
  1. RESUF ;TEST AND RESET DUPLICATE SUFFIX VALUES
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0T")  ;Q IF V4.0 INSTALLED
  1.  Q:$$INSTALL^BMC4P0("BMC 4.0")  ;Q IF V4.0 INSTALLED
  1.  D BMES^XPDUTL("BEGIN Resetting Duplicate Secondary Referral suffix.")
  1.  S BMCREF=0
  1.  F  S BMCREF=$O(^BMCPROV("S",BMCREF)) Q:BMCREF'?1N.N  S CT=0 D
  1.  .Q:'$D(^BMCPROV("S",BMCREF,"A10"))
  1.  .S BMCSUF="A1",BMCSUFN1=0
  1.  .F  S BMCSUF=$O(^BMCPROV("S",BMCREF,BMCSUF)) Q:BMCSUF=""  D
  1.  ..S BMCIEN=0
  1.  ..F  S BMCIEN=$O(^BMCPROV("S",BMCREF,BMCSUF,BMCIEN)) Q:BMCIEN'?1N.N  S CT=CT+1 I CT>1 D
  1.  ...S:BMCSUF="A10" ^XTMP("BMC4IN",$J,"SUF",BMCREF,BMCIEN,BMCSUF)=""
  1.  ..S BMCSUFN=$E(BMCSUF,2,3) Q:BMCSUFN'>9
  1.  ..S:BMCSUFN>BMCSUFN1 BMCSUFN1=BMCSUFN
  1.  .;SUFFIX VALUES
  1.  .S BMCIEN=0 F  S BMCIEN=$O(^XTMP("BMC4IN",$J,"SUF",BMCREF,BMCIEN)) Q:BMCIEN'?1N.N  D
  1.  ..Q:'$D(^XTMP("BMC4IN",$J,"SUF",BMCREF,BMCIEN,"A10"))
  1.  ..S BMCSUFN1=BMCSUFN1+1
  1.  ..S ^XTMP("BMC4IN",$J,"SUF",BMCREF,BMCIEN,"A10")=BMCSUFN1
  1.  ..;SET NEW SUFFIX IN BMCPROV....
  1.  ..S DIE="^BMCPROV(",DA=BMCIEN,DR="201////A"_BMCSUFN1 D ^DIE
  1.  ..K DIE,DA,X,DR
  1.  K BMCREF,BMCSUF,BMCSUFN,BMCSUFN1
  1.  D MES^XPDUTL("END Resetting Duplicate Secondary Referral suffix.")
  1.  Q
  1.  ; -----------------------------------------------------