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

BMC4P1.m

Go to the documentation of this file. 
  1. BMC4P1 ;IHS/ITSC/FCJ - BMC 4.0 PATCH 1 ;  [ 06/02/2006  2:07 PM ]
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**1**;JUN 01, 2006
  1.  ;
  1.  ;
  1.  I '$G(IOM) D HOME^%ZIS
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY(2) Q
  1.  ;
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY(2) Q
  1.  ;
  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("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.  ;
  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_"FIX IT! Before Proceeding."_IORVOFF,IOM),!!,*7,*7,*7 Q
  1.  ;
  1.  W !!,$$CJ^XLFSTR("ENVIRONMENT OK.",IOM)
  1.  ;
  1.  D HELP^XBHELP("INTROE","BMC4P1")
  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","BMC4P1") I '$$DIR^XBDIR("E","","","","","",1) D SORRY(2)
  1.  ;
  1.  Q
  1.  ;
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",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.  I @(BMCV_BMCCOMP_BMCVER) D SORRY(BMCQUIT) Q 0
  1.  Q 1
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  I $$NEWCP^XPDUTL("PRE1","AUDS^BMC4P1")
  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.  ;
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  ;
  1.  ; --- Restore dd audit settings.
  1.  S %="AUDR^BMC4P1"
  1.  I $$NEWCP^XPDUTL("POS1-"_%,%)
  1.  ;
  1.  ; --- Send mail message of install.
  1.  S %="MAIL^BMC4P1"
  1.  I $$NEWCP^XPDUTL("POS2-"_%,%)
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ;
  1.  D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("BMC4P1",$J)
  1.  D RSLT(" --- BMC v 4.0 Patch 1, has been installed into this uci ---")
  1.  F %=1:1 D RSLT($P($T(GREET+%),";",3)) Q:$P($T(GREET+%+1),";",3)="###"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   D RSLT(^(%,0))
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""BMC4P1"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="BMCZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("BMC4P1",$J)
  1.  D MES^XPDUTL("END Delivering MailMan message to select users.")
  1.  Q
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("BMC4P1",$J,0))+1,^(^(0))=%
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a single key K.
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;
  1. INTROE ; Intro text during KIDS Environment check.
  1.  ;;In this distribution:
  1.  ;;(1) General Retrieval Report:
  1.  ;;    a. Changed CHS PDO issue date to print in format xx/xx/xx
  1.  ;;    b. Added CHS Approval/Denial date to search, sort and print
  1.  ;;    c. Changed heading from Select screen to Search Screen
  1.  ;;(2) Added following Major DX Category:
  1.  ;;    a. Skin and Subcutaneous Tissue
  1.  ;;    b. Complications of Pregnancy, Childbirth and the Puerperium
  1.  ;;(3) Referral Facility Address
  1.  ;;    a. Address fields added to the Rcis Site Parameter file
  1.  ;;    b. If fields are not populated will default to Location file
  1.  ;;    c. Edit and Display Site parameter options were modified
  1.  ;;    d. All letters updated to use new address fields
  1.  ;;(4) Case Management Reports:
  1.  ;;    a. Added total to Print Case Review Comments report
  1.  ;;    b. Added Report run date to the Inpatient Log Report
  1.  ;;    c. Added Date Range to the Area Discharge report
  1.  ;;    d. Added Date Range to the List of High Cost Users Report
  1.  ;;    e. Added Date Range to Potential High Cost Cases
  1.  ;;    f. Added Report Run Date to Patient Dish/Cons Sum not rec'd
  1.  ;;(5) Trending reports now print in Alpha order for providers
  1.  ;;    a. Referral Patterns by Provider or Facility
  1.  ;;    b. CHS Referral Costs By Requesting Prov/Facility
  1.  ;;(6) Display a Referral; when selecting by patient name will display
  1.  ;;    most recent referral entered
  1.  ;;(7) Miscellaneous routine modifications
  1.  ;;    a. Fixed Entering final values when Closing referral
  1.  ;;    b. If Insurance data entered, but not the "insurance plan"
  1.  ;;       letter will error out, will now print 'unknown"
  1.  ;;    c. Sec Ref data entry; fixed space bar at prompt
  1.  ;;    d. Letters now printing elg and coverage for Medicaid/Medicare
  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. GREET ;;To add to mail message.
  1.  ;;  
  1.  ;;Greetings.
  1.  ;;  
  1.  ;;Standard data dictionaries on your RPMS system have been updated.
  1.  ;;  
  1.  ;;You are receiving this message because of the particular RPMS
  1.  ;;security keys that you hold.  This is for your information, only.
  1.  ;;You need do nothing in response to this message.
  1.  ;;  
  1.  ;;Questions about this patch, which is a product of the RPMS DBA
  1.  ;;,
  1.  ;;can be directed to the Help Desk,
  1.  ;;
  1.  ;;Please refer to patch "bmc*4.0*1".
  1.  ;;  
  1.  ;;###;NOTE: This line indicates the end of text in this message.
  1.  ;
  1.  ; -----------------------------------------------------
  1.  ; The global location for dictionary audit is:
  1.  ;           ^DD(FILE,0,"DDA")
  1.  ; If the valuey is "Y", dd audit is on.  Any other value, or the
  1.  ; absence of the node, means dd audit is off.
  1.  ; -----------------------------------------------------
  1. AUDS ;EP - From KIDS.
  1.  D BMES^XPDUTL("Saving current DD AUDIT settings for files in this patch")
  1.  D MES^XPDUTL("and turning DD AUDIT to 'Y'.")
  1.  S ^XTMP("BMC4P1",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("BMC4P1",BMC,"DDA")) S ^XTMP("BMC4P1",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("BMC4P1",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.  ;TEST FOR MIS SPELLED DX CATE DURING BETA TESTING
  1.  I $D(^BMCTDXC("B","COMPLICATIONS FO PREGNANCY,CHI")) D
  1.  .S DA=0,DA=$O(^BMCTDXC("B","COMPLICATIONS FO PREGNANCY,CHI",DA))
  1.  .S DR=".01////COMPLICATIONS OF PREGNANCY,CHILDBIRTH AND PUERPERIUM"
  1.  .S DIE="^BMCTDXC(" I DA D ^DIE
  1.  .K D0,DA,DA,DIE,DR
  1.  Q
  1.  ; -----------------------------------------------------
  1. AUDR ; Restore the file data audit values to their original values.
  1.  D BMES^XPDUTL("Restoring DD AUDIT settings for files in this patch.")
  1.  NEW BMC
  1.  S BMC=0
  1.  F  S BMC=$O(^XTMP("BMC4P1",BMC)) Q:'BMC  D
  1.  . S ^DD(BMC,0,"DDA")=^XTMP("BMC4P1",BMC,"DDA")
  1.  . D MES^XPDUTL(" File "_$$RJ^XLFSTR(BMC,12)_" - "_$$LJ^XLFSTR($$GET1^DID(BMC,"","","NAME"),30)_"- DD AUDIT Set to '"_^DD(BMC,0,"DDA")_"'")
  1.  .Q
  1.  KILL ^XTMP("BMC4P1")
  1.  D MES^XPDUTL("DD AUDIT settings restored.")
  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.  ;
  1.  NEW DIC,X,Y
  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.  Q $S(Y<1:0,1:1)
  1.  ;
  1.  ; -----------------------------------------------------