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

BMCMM.m

Go to the documentation of this file. 
  1. BMCMM ; IHS/OIT/FCJ - RCIS - SEND MAILMAN MESSAGE ;     [ 09/12/2006  11:50 AM ]
  1.  ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101
  1.  ;
  1.  ;IHS/ITSC/FCJ SEND MESSAGE TO GROUPS OR 
  1.  ;     REF PROVIDER AND PROVIDER ONLY
  1.  ;     WILL LIST ANY PREVIOUS MESSAGE SENT AND
  1.  ;     ALSO STORE HISTORY OF MSG SENT IN RCIS MESSAGE FILE
  1.  ;     CALLED AFTER INITIAL ENTRY OF REF AND FROM MODIFY
  1.  ;     OPTIONS 14 AND 15
  1.  ;     Only BO notes are sent on the group message which is called
  1.  ;     during adding a new ref and using modify option 14
  1.  ;BMC*4.0*2 8/2/05 IHS/OIT/FCJ ADDED TST;CALLING FROM API AND EP
  1.  ;     Added Case Com to message;Added type of referral and parameter
  1.  ;     to identify patient to subject line
  1.  ;
  1.  ;
  1. ENMM ;EP;MESSAGE for NEW REF AND MODIFICATIONS
  1.  NEW Y,DIC
  1.  Q:'$G(BMCDFN)
  1.  Q:'$G(BMCRDATE)
  1. MSG ;TEST FOR EXISTING MESSAGES ALREADY SENT
  1.  I $D(^BMCMSG("C",BMCRIEN)) D
  1.  .W !!,"A Message has already been sent for this referral:"
  1.  .S BMCMSG=0 W !?3,"DATE",?25,"SENT BY",?55,"GROUP/PROV"
  1.  .F  S BMCMSG=$O(^BMCMSG("C",BMCRIEN,BMCMSG)) Q:BMCMSG'?1N.N  D
  1.  ..S Y=$P(^BMCMSG(BMCMSG,0),U) D DD^%DT
  1.  ..W !?3,Y,?25,$P(^VA(200,$P(^BMCMSG(BMCMSG,0),U,4),0),U)
  1.  ..S BMCGRP=0 F  S BMCGRP=$O(^BMCMSG(BMCMSG,1,BMCGRP)) Q:BMCGRP'?1N.N  D
  1.  ...S BMCGRP1=$P(^BMCMSG(BMCMSG,1,BMCGRP,0),U)
  1.  ...W ?55,$P(^XMB(3.8,BMCGRP1,0),U),!
  1.  ..S BMCPER=0 F  S BMCPER=$O(^BMCMSG(BMCMSG,2,BMCPER)) Q:BMCPER'?1N.N  D
  1.  ...S BMCPER1=$P(^BMCMSG(BMCMSG,2,BMCPER,0),U)
  1.  ...W ?55,$P(^VA(200,BMCPER1,0),U),!
  1.  E  W !!,"A Message has NOT been sent for this referral."
  1.  S DIR(0)="Y",DIR("A")="Do you wish to send a message",DIR("B")="Y"
  1.  D ^DIR K DIR I $D(DIRUT)!'Y G EXT
  1.  I BMCMODE="M",BMCDTYPE=15 D MPER,MSGPRV
  1.  E  D MGRP,MSGGRP
  1.  D SND
  1.  G EXT Q
  1. MGRP ;SELECT MAIL GROUPS TO SEND MESSAGE TO
  1.  ;ENTER THE GROUP TO SEND IT TO AND ADD ENTRY TO THE RCIS MESSAGE FILE
  1.  S BMCGRP="BMC",DIR(0)="S^",Y=0
  1.  F  S BMCGRP=$O(^XMB(3.8,"B",BMCGRP)) Q:$E(BMCGRP,1,3)'="BMC"  D
  1.  .S BMCGRP1=0 S BMCGRP1=$O(^XMB(3.8,"B",BMCGRP,BMCGRP1))
  1.  .S Y=Y+1,BMCGRP(Y)=BMCGRP_U_BMCGRP1
  1.  I Y=0 W !,"THERE ARE NOT ANY RCIS MAIL GROUPS SET UP.",!,"If you would like to set up a mail group, use Mail Groups Option under the",!,"RCIS Management Menu." Q
  1.  F I=1:1:Y W !?5,I_".  "_$P(BMCGRP(I),U)
  1.  S DIR("A")="To select recipient group(s) enter a list or range of numbers"
  1.  S DIR(0)="L^1:"_Y
  1.  D ^DIR I $D(DIRUT) W !?5,"***MESSAGE WAS NOT SENT***" G EXT
  1.  K XMB,XMY
  1.  F I=1:1 Q:$P(Y,",",I)'?1N.N  S XMY("G."_$P(BMCGRP($P(Y,",",I)),U))="",BMCGRPS($P(BMCGRP($P(Y,",",I)),U,2))=""
  1.  Q
  1. MPER ;SETS PRIM PROV AND REF PROV TO AUTO SEND MESSAGE TO
  1.  S BMCPPRV=$P(^AUPNPAT(BMCDFN,0),U,14)
  1.  S BMCRPRV=$P(^BMCREF(BMCRIEN,0),U,6)
  1.  K XMB,XMY
  1.  I 'BMCPPRV,'BMCRPRV W !,"Primary Care Provider and Referring Provider are not definned.",!?5,"***MESSAGE WAS NOT SENT***" G EXT
  1.  F BMCPER=BMCPPRV,BMCRPRV I BMCPER D
  1.  .S XMY(BMCPER)=""
  1.  Q
  1. MSGGRP ;EP CALL BY BMCAPIA1;GROUP MESSAGE
  1.  S Y=$P(^BMCREF(BMCRIEN,0),U,4)
  1.  S XMZ=""
  1.  ;REF IF OPTION SET AND USER ANSWERS YES....
  1.  S XMB="BMC REFERRAL ALERT"  ;LABEL NEW Message
  1.  S XMB(1)=BMCREC("PAT NAME")
  1.  S XMB(1.1)=$S($P($G(^BMCPARM(DUZ(2),4100)),U,7)="Y":XMB(1),1:"")
  1.  S XMB(2)=BMCREC("REF DATE")
  1.  S XMB(3)=BMCRNUMB
  1.  S XMB(4)=""
  1.  S XMB(5)=$$VAL^XBDIQ1(90001,BMCRIEN,1201)
  1.  S XMB(6)=$$FACREF^BMCRLU(BMCRIEN)
  1.  S XMB(7)=$$VAL^XBDIQ1(90001,BMCRIEN,1301)
  1.  S XMB(8)=$$VAL^XBDIQ1(90001,BMCRIEN,.32)
  1.  ;BMC*4.0*2 8/2/05 IHS/OIT/FCJ Added DOS to Message
  1.  S XMB(8)=XMB(8)_"       Date of Service: "_$$AVDOS^BMCRLU(BMCRIEN,"E")
  1.  S Y=$P(^BMCREF(BMCRIEN,0),U,6)
  1.  S:Y XMB(4)=$P(^VA(200,Y,0),U)
  1.  S XMB(9)=$$VAL^XBDIQ1(90001,BMCRIEN,.04)
  1.  D COMMENTS
  1.  Q
  1. MSGPRV ;PRIM PROV AND REF PHY MESSAGE
  1.  S Y=$P(^BMCREF(BMCRIEN,0),U,4),BMCHRN="",BMCSP=""
  1.  F I=1:1:30 S BMCSP=BMCSP_" "
  1.  S XMZ=""
  1.  S XMB="BMC PROV REF ALERT" ;LABEL NEW Message
  1.  S XMB(1)=BMCREC("PAT NAME")
  1.  I $P(^BMCREF(BMCRIEN,0),U,5)'="" D
  1.  .S I=$P(^BMCREF(BMCRIEN,0),U,5)
  1.  .S BMCHRN=$P($G(^AUPNPAT(BMCDFN,41,I,0)),U,2)
  1.  S XMB(2)=BMCRNUMB,XMB(3)=BMCHRN
  1.  S XMB(4)="" S:BMCPPRV XMB(4)=XMB(4)_$P(^VA(200,BMCPPRV,0),U)
  1.  S XMB(5)=$$DOB^AUPNPAT(BMCDFN,"E")
  1.  S XMB(6)=$$FACREF^BMCRLU(BMCRIEN)
  1.  S XMB(7)=$$AVDOS^BMCRLU(BMCRIEN,"E")
  1.  S XMB(8)=$$VAL^XBDIQ1(90001,BMCRIEN,.04)
  1.  D COMMENTS Q
  1. COMMENTS ;IHS/ITSC/FCJ ADDED BO COM FR RCIS COMMENTS FILE,LIFO DISPLAY
  1.  S XMTEXT="^XTMP(""BMCMSG"","_$J_","
  1.  I $D(^BMCCOM("AD",BMCRIEN)) D
  1.  .S BMCL=0,BMCL2=1
  1.  .F  S BMCL=$O(^BMCCOM("AD",BMCRIEN,BMCL)) Q:BMCL'?1N.N  D
  1.  ..S BMCCTYP=$P(^BMCCOM(BMCL,0),U,5)
  1.  ..I BMCMODE="M",BMCDTYPE=14 Q:(BMCCTYP="M")!(BMCCTYP="D")
  1.  ..I BMCMODE="A" Q:BMCCTYP'="B"
  1.  ..I $D(^BMCCOM(BMCL,1)) D
  1.  ...S I=$S(BMCCTYP="C":"Case Review",BMCCTYP="D":"Discharge",BMCCTYP="M":"Medical HX/Findings",1:"Business/CHS")
  1.  ...S ^XTMP("BMCMSG",$J,BMCL2)=I_" Comments  Date: "_$$FMTE^XLFDT($P(^BMCCOM(BMCL,0),U),"5D")_"  By: "_$$VAL^XBDIQ1(90001.03,BMCL,.04)
  1.  ...S BMCL1=0
  1.  ...F  S BMCL1=$O(^BMCCOM(BMCL,1,BMCL1)) Q:BMCL1'?1N.N  D
  1.  ....S BMCL2=BMCL2+1
  1.  ....S ^XTMP("BMCMSG",$J,BMCL2)=^BMCCOM(BMCL,1,BMCL1,0)
  1.  ..S BMCL2=BMCL2+1
  1.  Q
  1. SND ;SEND MESSAGE
  1.  D EN^XMB
  1.  ;BMC*4.0*2 8/2/05 IHS/OIT/FCJ ADDED TST;CALLING FROM API
  1.  ;I $D(XMB) W !?5,"***ERROR: NO MESSAGE SENT***" G EXT
  1.  I $D(XMB) W:$G(BMCAPIA)="" !?5,"***ERROR: NO MESSAGE SENT***" G EXT
  1.  ;W !?5,"***MESSAGE SENT***"
  1.  W:$G(BMCAPIA)="" !?5,"***MESSAGE SENT***"
  1. ADD ;IF MESSAGE SENT ADD TO RCIS MESSAGE FILE
  1.  S (DIE,DIC)="^BMCMSG(",DIC(0)="L"
  1.  D NOW^%DTC S X=%
  1.  S DIC("DR")=".02////"_BMCRIEN_";.03////"_BMCRNUMB_";.04////"_DUZ_";.05////REFERRAL ALERT"
  1.  D ^DIC S DA=+Y Q:Y<1
  1.  I BMCMODE="M",BMCDTYPE=15 D APER Q
  1. AGRP ;ADD GROUPS MESSAGE WAS SENT TO    
  1.  S DA(1)=+Y,(DIE,DIC)=DIC_DA(1)_",1,",DA=1
  1.  I '$D(^BMCMSG(DA(1),1)) S ^BMCMSG(DA(1),1,0)="^90001.571P^^"
  1.  D ^DIC
  1.  S BMCGRP=0  F  S BMCGRP=$O(BMCGRPS(BMCGRP))  Q:BMCGRP'?1N.N  D
  1.  .S DR=".01////"_BMCGRP
  1.  .D ^DIE
  1.  .S $P(^BMCMSG(DA(1),1,0),U,3,4)=DA_U_DA
  1.  .S DA=DA+1
  1.  Q
  1. APER ;ADD PERSON MESSAGE WAS SENT TO
  1.  S DA(1)=+Y,(DIE,DIC)=DIC_DA(1)_",2,",DA=1
  1.  I '$D(^BMCMSG(DA(1),2)) S ^BMCMSG(DA(1),2,0)="^90001.572P^^"
  1.  D ^DIC
  1.  F BMCPER=BMCPPRV,BMCRPRV I BMCPER D  Q:BMCPPRV=BMCRPRV
  1.  .S DR=".01////"_BMCPER
  1.  .D ^DIE
  1.  .S $P(^BMCMSG(DA(1),2,0),U,3,4)=DA_U_DA
  1.  .S DA=DA+1
  1.  Q
  1. EXT K XMB,XMY,XMZ,DIR,DIC,DIE,DA,DR
  1.  K BMCMSG,BMCGRP,BMCGRPS,BMCGRP1,BMCL,BMCL1,BMCL2,BMCLDT,BMCCTYP,BMCTMP
  1.  K BMCPER,BMCPER1,^XTMP("BMCMSG",$J)
  1.  Q