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