AMH30P8 ; 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*7") D SORRY(2)
I '$$INSTALLD("AICD*3.51*7") D SORRY(2)
I '$$INSTALLD("AUPN*99.1*18") D SORRY(2)
Q
;
PRE ;EP
F DA=1:1:999 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
F DA=1:1:200 S DIK="^AMHBHPC(" D ^DIK
S DIU="^AMHBHPC(",DIU(0)="D" D EN^DIU2
D ^XBFMK
Q
POST ;
S AMHX=0 F S AMHX=$O(^AMHREC(AMHX)) Q:AMHX'=+AMHX D
.Q:$P($G(^AMHREC(AMHX,11)),U,10)
.;Q:$P(^AMHREC(AMHX,0),U,16)=""
.S $P(^AMHREC(AMHX,11),U,11)=1
.Q
ADDPC ;
I '$O(^AMHPROBC("B",99.9,0)) D
.S X=99.9,DIC="^AMHPROBC(",DIC(0)="L",DIC("DR")=".02///OTHER EHR CLINICAL;.03///OTHER PATIENT RELATED" K DD,D0,DO S DIADD=1,DLAYGO=9002012.4 D FILE^DICN K DIADD,DLAYGO,DD,DO,D0,DIC
.I Y=-1 W " adding 99.9 failed." Q
;NOW UPDATE ALL DSM CODES PER DENISE'S SPREADSHEET
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B","292.0",AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" S $P(^AMHPROB(AMHX,0),U,15)=1,G=1 Q
.Q
I 'G W !!,"code 292.0 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.89,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///OTHER SPECIFIED DRUG INDUCED MENTAL DISORDERS;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.89 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.81,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED DELIRIUM;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.81 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.82,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED PERSISTING DEMENTIA;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.82 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.83,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED PERSISTING AMNESTIC DISORDER;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.83 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.84,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED MOOD DISORDER;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.84 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.11,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED PSYCHOTIC DISORDER WITH DELUSIONS;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.11 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.12,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///DRUG INDUCED PSYCHOTIC DISORDER WITH HALLUCINATIONS;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.12 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",292.9,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///UNSPECIFIED DRUG INDUCED MENTAL DISORDER;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 292.9 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B","305.90",AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, UNSPECIFIED;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 305.90 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",305.91,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, CONTINUOUS;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 305.91 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",305.92,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, EPISODIC;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 305.92 was not mapped to EHR"
;
S AMHX=0,G=0 F S AMHX=$O(^AMHPROB("B",305.93,AMHX)) Q:AMHX'=+AMHX D
.I $P(^AMHPROB(AMHX,0),U,13)]"" D ^XBFMK S DA=AMHX,DIE="^AMHPROB(",DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, IN REMISSION;.15///1" D ^DIE,^XBFMK S G=1 Q
.Q
I 'G W !!,"code 305.93 was not mapped to EHR"
SU ;map suicide code 40 to 300.9
S DA=$O(^AMHPROB("B",40,0))
I DA S DIE="^AMHPROB(",DR=".05///300.9" D ^DIE K DIE,DA,DR
;
D BULLETIN
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,8,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
AMH30P8 ; 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*7")
DO SORRY(2)
+4 IF '$$INSTALLD("AICD*3.51*7")
DO SORRY(2)
+5 IF '$$INSTALLD("AUPN*99.1*18")
DO SORRY(2)
+6 QUIT
+7 ;
PRE ;EP
+1 FOR DA=1:1:999
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 FOR DA=1:1:200
SET DIK="^AMHBHPC("
DO ^DIK
+5 SET DIU="^AMHBHPC("
SET DIU(0)="D"
DO EN^DIU2
+6 DO ^XBFMK
+7 QUIT
POST ;
+1 SET AMHX=0
FOR
SET AMHX=$ORDER(^AMHREC(AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+2 IF $PIECE($GET(^AMHREC(AMHX,11)),U,10)
QUIT
+3 ;Q:$P(^AMHREC(AMHX,0),U,16)=""
+4 SET $PIECE(^AMHREC(AMHX,11),U,11)=1
+5 QUIT
End DoDot:1
ADDPC ;
+1 IF '$ORDER(^AMHPROBC("B",99.9,0))
Begin DoDot:1
+2 SET X=99.9
SET DIC="^AMHPROBC("
SET DIC(0)="L"
SET DIC("DR")=".02///OTHER EHR CLINICAL;.03///OTHER PATIENT RELATED"
KILL DD,D0,DO
SET DIADD=1
SET DLAYGO=9002012.4
DO FILE^DICN
KILL DIADD,DLAYGO,DD,DO,D0,DIC
+3 IF Y=-1
WRITE " adding 99.9 failed."
QUIT
End DoDot:1
+4 ;NOW UPDATE ALL DSM CODES PER DENISE'S SPREADSHEET
+5 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B","292.0",AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+6 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
SET $PIECE(^AMHPROB(AMHX,0),U,15)=1
SET G=1
QUIT
+7 QUIT
End DoDot:1
+8 IF 'G
WRITE !!,"code 292.0 was not mapped to EHR"
+9 ;
+10 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.89,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+11 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///OTHER SPECIFIED DRUG INDUCED MENTAL DISORDERS;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+12 QUIT
End DoDot:1
+13 IF 'G
WRITE !!,"code 292.89 was not mapped to EHR"
+14 ;
+15 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.81,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+16 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED DELIRIUM;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+17 QUIT
End DoDot:1
+18 IF 'G
WRITE !!,"code 292.81 was not mapped to EHR"
+19 ;
+20 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.82,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+21 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED PERSISTING DEMENTIA;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+22 QUIT
End DoDot:1
+23 IF 'G
WRITE !!,"code 292.82 was not mapped to EHR"
+24 ;
+25 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.83,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+26 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED PERSISTING AMNESTIC DISORDER;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+27 QUIT
End DoDot:1
+28 IF 'G
WRITE !!,"code 292.83 was not mapped to EHR"
+29 ;
+30 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.84,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+31 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED MOOD DISORDER;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+32 QUIT
End DoDot:1
+33 IF 'G
WRITE !!,"code 292.84 was not mapped to EHR"
+34 ;
+35 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.11,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+36 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED PSYCHOTIC DISORDER WITH DELUSIONS;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+37 QUIT
End DoDot:1
+38 IF 'G
WRITE !!,"code 292.11 was not mapped to EHR"
+39 ;
+40 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.12,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+41 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///DRUG INDUCED PSYCHOTIC DISORDER WITH HALLUCINATIONS;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+42 QUIT
End DoDot:1
+43 IF 'G
WRITE !!,"code 292.12 was not mapped to EHR"
+44 ;
+45 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",292.9,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+46 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///UNSPECIFIED DRUG INDUCED MENTAL DISORDER;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+47 QUIT
End DoDot:1
+48 IF 'G
WRITE !!,"code 292.9 was not mapped to EHR"
+49 ;
+50 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B","305.90",AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+51 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, UNSPECIFIED;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+52 QUIT
End DoDot:1
+53 IF 'G
WRITE !!,"code 305.90 was not mapped to EHR"
+54 ;
+55 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",305.91,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+56 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, CONTINUOUS;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+57 QUIT
End DoDot:1
+58 IF 'G
WRITE !!,"code 305.91 was not mapped to EHR"
+59 ;
+60 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",305.92,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+61 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, EPISODIC;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+62 QUIT
End DoDot:1
+63 IF 'G
WRITE !!,"code 305.92 was not mapped to EHR"
+64 ;
+65 SET AMHX=0
SET G=0
FOR
SET AMHX=$ORDER(^AMHPROB("B",305.93,AMHX))
IF AMHX'=+AMHX
QUIT
Begin DoDot:1
+66 IF $PIECE(^AMHPROB(AMHX,0),U,13)]""
DO ^XBFMK
SET DA=AMHX
SET DIE="^AMHPROB("
SET DR=".02///OTHER, MIXED, OR UNSPECIFIED DRUG ABUSE, IN REMISSION;.15///1"
DO ^DIE
DO ^XBFMK
SET G=1
QUIT
+67 QUIT
End DoDot:1
+68 IF 'G
WRITE !!,"code 305.93 was not mapped to EHR"
SU ;map suicide code 40 to 300.9
+1 SET DA=$ORDER(^AMHPROB("B",40,0))
+2 IF DA
SET DIE="^AMHPROB("
SET DR=".05///300.9"
DO ^DIE
KILL DIE,DA,DR
+3 ;
+4 DO BULLETIN
+5 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,8,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
