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

AMH30P7.m

Go to the documentation of this file. 
  1. AMH30P7 ; IHS/CMI/LAB - POST INIT BH ;   [ 01/02/05  3:20 PM ]
  1.  ;;3.0;IHS BEHAVIORAL HEALTH;**5,6**;JAN 27, 2003
  1.  ;
  1. ENV ;EP 
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  I '$$INSTALLD("AMH*3.0*6") D SORRY(2)
  1.  I '$$INSTALLD("AICD*3.51*7") D SORRY(2)
  1.  Q
  1.  ;
  1. PRE ;
  1.  F DA=1:1:250 S DIK="^AMHSORT(" D ^DIK
  1.  F DA=1:1:50 S DIK="^AMHDTER(" D ^DIK
  1.  F DA=1:1:10 S DIK="^AMHRECD(" D ^DIK
  1.  D ^XBFMK
  1.  Q
  1. POST ;EP
  1.  S X=$$ADD^XPDMENU("AMH M MANAGER UTILITIES","AMH M EHRBH PARAMETER EDIT","EHRP")
  1.  I 'X W "Attempt to add EHR PARAMETER EDIT option failed.." H 3
  1.  ;add generic bh hosp 44 entries for each division in MHSS SITE PARAMERTERS file
  1.  S AMHX=0 F  S AMHX=$O(^AMHSITE(AMHX)) Q:AMHX'=+AMHX  D
  1.  .S AMHN="BEHAVIORAL HEALTH (TIU) "_$P(^AUTTLOC(AMHX,0),U,7)
  1.  .Q:$D(^SC("B",AMHN))  ;ALREADY HAVE THIS LOCATION
  1.  .D ^XBFMK
  1.  .K DD,DO,D0
  1.  .S X=AMHN,DIC="^SC(",DIC(0)="L",DIADD=1,DLAYGO=44
  1.  .S DIC("DR")="1////BHTIU;2////Z;2.1///OTHER LOCATION;3////"_AMHX_";3.5////"_AMHX
  1.  .D FILE^DICN
  1.  .I Y=-1 W !,"adding default hospital location entry failed for ",AMHN
  1.  .D ^XBFMK K DIADD,DLAYGO
  1.  .Q
  1.  ;D ^AMH30P7B
  1.  Q
  1. INSTALLD(AMHSTAL) ;EP - Determine if patch AMHSTAL was installed, where
  1.  ; AMHSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW AMHY,DIC,X,Y
  1.  S X=$P(AMHSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(AMHSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(AMHSTAL,"*",3)
  1.  D ^DIC
  1.  S AMHY=Y
  1.  D IMES
  1.  Q $S(AMHY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_AMHSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1. BULLETIN ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q
  1.  D HOME^%ZIS,DT^DICRW
  1.  ;
  1.  NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM
  1.  KILL ^TMP($J,"AMHBUL")
  1.  D WRITEMSG,GETRECIP
  1.  ;Change following lines as desired
  1. SUBJECT S XMSUB="* * * IMPORTANT RPMS INFORMATION * * *"
  1. SENDER S XMDUZ="Cimarron Medical Informatics"
  1.  S XMTEXT="^TMP($J,""AMHBUL"",",XMY(1)="",XMY(DUZ)=""
  1.  I $E(IOST)="C" W !,"Sending Mailman message to holders of the"_" "_AMHKEY_" "_"security key."
  1.  D ^XMD
  1.  KILL ^TMP($J,"AMHBUL"),AMHKEY
  1.  Q
  1.  ;
  1. WRITEMSG ;
  1.  S AMHIEN=$O(^AMHPATCH("AA",3,7,0))
  1.  I AMHIEN="" Q
  1.  S AMHX=0,AMHC=0 F  S AMHX=$O(^AMHPATCH(AMHIEN,11,AMHX)) Q:AMHX'=+AMHX  S AMHC=AMHC+1,^TMP($J,"AMHBUL",AMHC)=^AMHPATCH(AMHIEN,11,AMHX,0)
  1.  Q
  1. GETRECIP ;
  1.  ;* * * Define key below to identify recipients * * *
  1.  ;
  1.  S CTR=0,AMHKEY="AMHZMENU"
  1.  F  S CTR=$O(^XUSEC(AMHKEY,CTR)) Q:'CTR  S Y=CTR S XMY(Y)=""
  1.  Q