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

PRCHJMSG.m

Go to the documentation of this file.
  1. PRCHJMSG ;BP/VAC - SEND A MAILMAN MESSAGE ;5/13/13 13:29
  1. ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
  1. ;Per VHA Directive 2004-38, this routine should not be modified.
  1. ;Send a MailMan message
  1. ;XMDUZ=SENDER OF THE MESSAGE
  1. ;XMSUB=SUBJECT LINE
  1. ;XMTEXT="MSG(" - ARRAY OF MESSAGE LINES
  1. ;XMY(DUZ)="" - Receivers of the message
  1. ;TO BE PASSED IN
  1. ; 2237 NUMBER
  1. ; TYPE OF MESSAGE
  1. ; ACTION DATE AND TIME AS FILEMAN DATE TIME
  1. ; COMMENTS - MULTIPLE ARRAY
  1. ; eCMS USER NAME
  1. ; eCMS USER EMAIL ADDRESS
  1. ; eCMS USER PHONE NUMBER
  1. ;TO BE RETRIEVED FROM 2237 OR PASSED IN
  1. ; STATION NUMBER 410 .5
  1. ; SUB STATION NUMBER 410 448 POINTER TO 411
  1. ; ACCOUNTABLE OFFICER 410 39
  1. ; CONTROL POINT OFFICIAL(APPROVING OFFICIAL) 410 42 POINTER TO 200
  1. ; REQUESTOR 410 40 POINTER TO 200
  1. ;
  1. PHMSG(MSG1,MSG2) ;START OF MESSAGE BUILDING
  1. ;MSG1 array contains (1)-2237 number;(2)msg type;(3)date and time
  1. ; (4) eCMS User Name; (5) eCMS User email
  1. ; (6) eCMS User phone number (7) Special message to send to OIT
  1. ;MSG2 array contains error comments from ACK or comments from Cancel/return
  1. ;
  1. N XMTEXT,XMSUB,XMY,XMDUZ,OUT,I,J,ZZ
  1. N PRCHJ22,PRCHJTY,PRCHJDT,PRCHJRR,PRCHJUN,PRCHJEM,PRCHJPH,PRCHJSP
  1. S PRCHJ22=$G(MSG1(1)) ; 2237 NUMBER
  1. S PRCHJTY=$G(MSG1(2)) ; MESSAGE TYPE
  1. S PRCHJDT=$$FMTE^XLFDT($G(MSG1(3))) ; DATE AND TIME WHEN ACTION TOOK PLACE
  1. K MSG1(3)
  1. S PRCHJUN=$G(MSG1(4)) ; ECMS USER NAME
  1. S PRCHJEM=$G(MSG1(5)) ; ECMS USER EMAIL
  1. S PRCHJPH=$G(MSG1(6)) ; ECMS USER PHONE
  1. S PRCHJSP=$G(MSG1(7)) ; Special OIT message
  1. ;I PRCHJTY=1 MESAGE IS AN ACK REJECT
  1. ;I PRCHJTY=2 MESSAGE IS A MESSAGE CANCEL
  1. ;I PRCHJTY=3 MESAGE IS A RETURN TO ACCOUNTABLE OFFICER
  1. ;I PRCHJTY=4 MESSAGE IS A RETURN TO CONTROL POINT
  1. ;I PRCHJTY=5 MESSAGE IS RETURN TO AO BECAUSE IT DIDN'T GO TO ECMS
  1. ;
  1. ;Put errors/text into MSG1 from MSG2
  1. S ZZ=0
  1. F I=1:1 S ZZ=$O(MSG2(ZZ)) Q:ZZ="" S MSG1(I+6)=MSG2(ZZ)
  1. S XMTEXT="MSG1("
  1. ;Get information from 2237
  1. D FIND^DIC(410,"","@;.5;39I;40I;42I;448","B",PRCHJ22,,,,,"OUT","ERR")
  1. ;Validate that a good 2237 number was sent in
  1. ;OUT array contains data from 2237
  1. ;OUT("DILIST","ID",1,.3))=SPECIAL OIT MESSAGE
  1. ;OUT("DILIST","ID",1,.5))=STATION NUMBER
  1. ;OUT('DILIST","ID",1,39)=ACCOUNTABLE OFFICER
  1. ;OUT("DILIST","ID",1,40)=REQUESTOR
  1. ;OUT("DILIST","ID",1,42))=CONTROL POINT OFFICIAL
  1. ;OUT("DILIST","ID",1,448)=SUB STATION
  1. ;
  1. BLD ;BUILD MESSAGE
  1. ;
  1. ;S MSG1(.6)="DATE AND TIME OF ACTION "_PRCHJDT
  1. K MSG1(2)
  1. S MSG1(.3)=" "_PRCHJSP
  1. S MSG1(.4)=" "
  1. S MSG1(.5)="STATION "_OUT("DILIST","ID",1,.5)
  1. I $G(OUT("DILIST","ID",1,448))'="" S MSG1(.5)=MSG1(.5)_" SUBSTATION "_OUT("DILIST","ID",1,448)
  1. I PRCHJTY=1 S XMY(OUT("DILIST","ID",1,39))="",XMSUB="MESSAGE REJECTION FOR 2237 "_PRCHJ22,MSG1(.6)="IFCAP Date/Time received eCMS Rejection of 2237 "_PRCHJDT K MSG1(4)
  1. I PRCHJTY=2 D
  1. . N PRCX
  1. .F J=39,40,42 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
  1. . S PRCX=$O(^PRCS(410,"B",PRCHJ22,"")) I PRCX>0,$D(^PRC(443,PRCX)) S PRCX=$$GET1^DIQ(443,PRCX_",",2,"I") S:PRCX>0 XMY(PRCX)=""
  1. .S XMSUB="2237 CANCEL FROM eCMS FOR 2237 "_PRCHJ22
  1. .S MSG1(.6)="eCMS Date/Time Canceled "_PRCHJDT
  1. I PRCHJTY=3 D
  1. .F J=39,40 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
  1. .S XMSUB="2237 RETURNED TO ACCOUNTABLE OFFICER "_PRCHJ22
  1. .S MSG1(.6)="eCMS Date/Time Returned to AO "_PRCHJDT
  1. I PRCHJTY=4 D
  1. . N PRCX
  1. .F J=39,40,42 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
  1. . S PRCX=$O(^PRCS(410,"B",PRCHJ22,"")) I PRCX>0,$D(^PRC(443,PRCX)) S PRCX=$$GET1^DIQ(443,PRCX_",",2,"I") S:PRCX>0 XMY(PRCX)=""
  1. .S XMSUB="2237 RETURNED TO CONTROL POINT FOR "_PRCHJ22
  1. .S MSG1(.6)="eCMS Date/Time Returned to CP "_PRCHJDT
  1. I PRCHJTY=5 D
  1. .F J=39 S XMY(OUT("DILIST","ID",1,J))=""
  1. .S XMSUB="TRANSMISSION FAILURE FOR 2237 "_PRCHJ22
  1. .S MSG1(.6)="2237 Transmission to eCMS failed "_PRCHJDT
  1. S XMDUZ="IFCAP/eCMS INTERFACE"
  1. D ^XMD
  1. Q