PRCHJMSG ;BP/VAC - SEND A MAILMAN MESSAGE ;5/13/13 13:29
;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
;Per VHA Directive 2004-38, this routine should not be modified.
;Send a MailMan message
;XMDUZ=SENDER OF THE MESSAGE
;XMSUB=SUBJECT LINE
;XMTEXT="MSG(" - ARRAY OF MESSAGE LINES
;XMY(DUZ)="" - Receivers of the message
;TO BE PASSED IN
; 2237 NUMBER
; TYPE OF MESSAGE
; ACTION DATE AND TIME AS FILEMAN DATE TIME
; COMMENTS - MULTIPLE ARRAY
; eCMS USER NAME
; eCMS USER EMAIL ADDRESS
; eCMS USER PHONE NUMBER
;TO BE RETRIEVED FROM 2237 OR PASSED IN
; STATION NUMBER 410 .5
; SUB STATION NUMBER 410 448 POINTER TO 411
; ACCOUNTABLE OFFICER 410 39
; CONTROL POINT OFFICIAL(APPROVING OFFICIAL) 410 42 POINTER TO 200
; REQUESTOR 410 40 POINTER TO 200
;
PHMSG(MSG1,MSG2) ;START OF MESSAGE BUILDING
;MSG1 array contains (1)-2237 number;(2)msg type;(3)date and time
; (4) eCMS User Name; (5) eCMS User email
; (6) eCMS User phone number (7) Special message to send to OIT
;MSG2 array contains error comments from ACK or comments from Cancel/return
;
N XMTEXT,XMSUB,XMY,XMDUZ,OUT,I,J,ZZ
N PRCHJ22,PRCHJTY,PRCHJDT,PRCHJRR,PRCHJUN,PRCHJEM,PRCHJPH,PRCHJSP
S PRCHJ22=$G(MSG1(1)) ; 2237 NUMBER
S PRCHJTY=$G(MSG1(2)) ; MESSAGE TYPE
S PRCHJDT=$$FMTE^XLFDT($G(MSG1(3))) ; DATE AND TIME WHEN ACTION TOOK PLACE
K MSG1(3)
S PRCHJUN=$G(MSG1(4)) ; ECMS USER NAME
S PRCHJEM=$G(MSG1(5)) ; ECMS USER EMAIL
S PRCHJPH=$G(MSG1(6)) ; ECMS USER PHONE
S PRCHJSP=$G(MSG1(7)) ; Special OIT message
;I PRCHJTY=1 MESAGE IS AN ACK REJECT
;I PRCHJTY=2 MESSAGE IS A MESSAGE CANCEL
;I PRCHJTY=3 MESAGE IS A RETURN TO ACCOUNTABLE OFFICER
;I PRCHJTY=4 MESSAGE IS A RETURN TO CONTROL POINT
;I PRCHJTY=5 MESSAGE IS RETURN TO AO BECAUSE IT DIDN'T GO TO ECMS
;
;Put errors/text into MSG1 from MSG2
S ZZ=0
F I=1:1 S ZZ=$O(MSG2(ZZ)) Q:ZZ="" S MSG1(I+6)=MSG2(ZZ)
S XMTEXT="MSG1("
;Get information from 2237
D FIND^DIC(410,"","@;.5;39I;40I;42I;448","B",PRCHJ22,,,,,"OUT","ERR")
;Validate that a good 2237 number was sent in
;OUT array contains data from 2237
;OUT("DILIST","ID",1,.3))=SPECIAL OIT MESSAGE
;OUT("DILIST","ID",1,.5))=STATION NUMBER
;OUT('DILIST","ID",1,39)=ACCOUNTABLE OFFICER
;OUT("DILIST","ID",1,40)=REQUESTOR
;OUT("DILIST","ID",1,42))=CONTROL POINT OFFICIAL
;OUT("DILIST","ID",1,448)=SUB STATION
;
BLD ;BUILD MESSAGE
;
;S MSG1(.6)="DATE AND TIME OF ACTION "_PRCHJDT
K MSG1(2)
S MSG1(.3)=" "_PRCHJSP
S MSG1(.4)=" "
S MSG1(.5)="STATION "_OUT("DILIST","ID",1,.5)
I $G(OUT("DILIST","ID",1,448))'="" S MSG1(.5)=MSG1(.5)_" SUBSTATION "_OUT("DILIST","ID",1,448)
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)
I PRCHJTY=2 D
. N PRCX
.F J=39,40,42 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
. 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)=""
.S XMSUB="2237 CANCEL FROM eCMS FOR 2237 "_PRCHJ22
.S MSG1(.6)="eCMS Date/Time Canceled "_PRCHJDT
I PRCHJTY=3 D
.F J=39,40 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
.S XMSUB="2237 RETURNED TO ACCOUNTABLE OFFICER "_PRCHJ22
.S MSG1(.6)="eCMS Date/Time Returned to AO "_PRCHJDT
I PRCHJTY=4 D
. N PRCX
.F J=39,40,42 S:$G(OUT("DILIST","ID",1,J))>0 XMY(OUT("DILIST","ID",1,J))=""
. 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)=""
.S XMSUB="2237 RETURNED TO CONTROL POINT FOR "_PRCHJ22
.S MSG1(.6)="eCMS Date/Time Returned to CP "_PRCHJDT
I PRCHJTY=5 D
.F J=39 S XMY(OUT("DILIST","ID",1,J))=""
.S XMSUB="TRANSMISSION FAILURE FOR 2237 "_PRCHJ22
.S MSG1(.6)="2237 Transmission to eCMS failed "_PRCHJDT
S XMDUZ="IFCAP/eCMS INTERFACE"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJMSG 3974 printed Sep 23, 2025@19:44:12 Page 2
PRCHJMSG ;BP/VAC - SEND A MAILMAN MESSAGE ;5/13/13 13:29
+1 ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
+2 ;Per VHA Directive 2004-38, this routine should not be modified.
+3 ;Send a MailMan message
+4 ;XMDUZ=SENDER OF THE MESSAGE
+5 ;XMSUB=SUBJECT LINE
+6 ;XMTEXT="MSG(" - ARRAY OF MESSAGE LINES
+7 ;XMY(DUZ)="" - Receivers of the message
+8 ;TO BE PASSED IN
+9 ; 2237 NUMBER
+10 ; TYPE OF MESSAGE
+11 ; ACTION DATE AND TIME AS FILEMAN DATE TIME
+12 ; COMMENTS - MULTIPLE ARRAY
+13 ; eCMS USER NAME
+14 ; eCMS USER EMAIL ADDRESS
+15 ; eCMS USER PHONE NUMBER
+16 ;TO BE RETRIEVED FROM 2237 OR PASSED IN
+17 ; STATION NUMBER 410 .5
+18 ; SUB STATION NUMBER 410 448 POINTER TO 411
+19 ; ACCOUNTABLE OFFICER 410 39
+20 ; CONTROL POINT OFFICIAL(APPROVING OFFICIAL) 410 42 POINTER TO 200
+21 ; REQUESTOR 410 40 POINTER TO 200
+22 ;
PHMSG(MSG1,MSG2) ;START OF MESSAGE BUILDING
+1 ;MSG1 array contains (1)-2237 number;(2)msg type;(3)date and time
+2 ; (4) eCMS User Name; (5) eCMS User email
+3 ; (6) eCMS User phone number (7) Special message to send to OIT
+4 ;MSG2 array contains error comments from ACK or comments from Cancel/return
+5 ;
+6 NEW XMTEXT,XMSUB,XMY,XMDUZ,OUT,I,J,ZZ
+7 NEW PRCHJ22,PRCHJTY,PRCHJDT,PRCHJRR,PRCHJUN,PRCHJEM,PRCHJPH,PRCHJSP
+8 ; 2237 NUMBER
SET PRCHJ22=$GET(MSG1(1))
+9 ; MESSAGE TYPE
SET PRCHJTY=$GET(MSG1(2))
+10 ; DATE AND TIME WHEN ACTION TOOK PLACE
SET PRCHJDT=$$FMTE^XLFDT($GET(MSG1(3)))
+11 KILL MSG1(3)
+12 ; ECMS USER NAME
SET PRCHJUN=$GET(MSG1(4))
+13 ; ECMS USER EMAIL
SET PRCHJEM=$GET(MSG1(5))
+14 ; ECMS USER PHONE
SET PRCHJPH=$GET(MSG1(6))
+15 ; Special OIT message
SET PRCHJSP=$GET(MSG1(7))
+16 ;I PRCHJTY=1 MESAGE IS AN ACK REJECT
+17 ;I PRCHJTY=2 MESSAGE IS A MESSAGE CANCEL
+18 ;I PRCHJTY=3 MESAGE IS A RETURN TO ACCOUNTABLE OFFICER
+19 ;I PRCHJTY=4 MESSAGE IS A RETURN TO CONTROL POINT
+20 ;I PRCHJTY=5 MESSAGE IS RETURN TO AO BECAUSE IT DIDN'T GO TO ECMS
+21 ;
+22 ;Put errors/text into MSG1 from MSG2
+23 SET ZZ=0
+24 FOR I=1:1
SET ZZ=$ORDER(MSG2(ZZ))
if ZZ=""
QUIT
SET MSG1(I+6)=MSG2(ZZ)
+25 SET XMTEXT="MSG1("
+26 ;Get information from 2237
+27 DO FIND^DIC(410,"","@;.5;39I;40I;42I;448","B",PRCHJ22,,,,,"OUT","ERR")
+28 ;Validate that a good 2237 number was sent in
+29 ;OUT array contains data from 2237
+30 ;OUT("DILIST","ID",1,.3))=SPECIAL OIT MESSAGE
+31 ;OUT("DILIST","ID",1,.5))=STATION NUMBER
+32 ;OUT('DILIST","ID",1,39)=ACCOUNTABLE OFFICER
+33 ;OUT("DILIST","ID",1,40)=REQUESTOR
+34 ;OUT("DILIST","ID",1,42))=CONTROL POINT OFFICIAL
+35 ;OUT("DILIST","ID",1,448)=SUB STATION
+36 ;
BLD ;BUILD MESSAGE
+1 ;
+2 ;S MSG1(.6)="DATE AND TIME OF ACTION "_PRCHJDT
+3 KILL MSG1(2)
+4 SET MSG1(.3)=" "_PRCHJSP
+5 SET MSG1(.4)=" "
+6 SET MSG1(.5)="STATION "_OUT("DILIST","ID",1,.5)
+7 IF $GET(OUT("DILIST","ID",1,448))'=""
SET MSG1(.5)=MSG1(.5)_" SUBSTATION "_OUT("DILIST","ID",1,448)
+8 IF PRCHJTY=1
SET XMY(OUT("DILIST","ID",1,39))=""
SET XMSUB="MESSAGE REJECTION FOR 2237 "_PRCHJ22
SET MSG1(.6)="IFCAP Date/Time received eCMS Rejection of 2237 "_PRCHJDT
KILL MSG1(4)
+9 IF PRCHJTY=2
Begin DoDot:1
+10 NEW PRCX
+11 FOR J=39,40,42
if $GET(OUT("DILIST","ID",1,J))>0
SET XMY(OUT("DILIST","ID",1,J))=""
+12 SET PRCX=$ORDER(^PRCS(410,"B",PRCHJ22,""))
IF PRCX>0
IF $DATA(^PRC(443,PRCX))
SET PRCX=$$GET1^DIQ(443,PRCX_",",2,"I")
if PRCX>0
SET XMY(PRCX)=""
+13 SET XMSUB="2237 CANCEL FROM eCMS FOR 2237 "_PRCHJ22
+14 SET MSG1(.6)="eCMS Date/Time Canceled "_PRCHJDT
End DoDot:1
+15 IF PRCHJTY=3
Begin DoDot:1
+16 FOR J=39,40
if $GET(OUT("DILIST","ID",1,J))>0
SET XMY(OUT("DILIST","ID",1,J))=""
+17 SET XMSUB="2237 RETURNED TO ACCOUNTABLE OFFICER "_PRCHJ22
+18 SET MSG1(.6)="eCMS Date/Time Returned to AO "_PRCHJDT
End DoDot:1
+19 IF PRCHJTY=4
Begin DoDot:1
+20 NEW PRCX
+21 FOR J=39,40,42
if $GET(OUT("DILIST","ID",1,J))>0
SET XMY(OUT("DILIST","ID",1,J))=""
+22 SET PRCX=$ORDER(^PRCS(410,"B",PRCHJ22,""))
IF PRCX>0
IF $DATA(^PRC(443,PRCX))
SET PRCX=$$GET1^DIQ(443,PRCX_",",2,"I")
if PRCX>0
SET XMY(PRCX)=""
+23 SET XMSUB="2237 RETURNED TO CONTROL POINT FOR "_PRCHJ22
+24 SET MSG1(.6)="eCMS Date/Time Returned to CP "_PRCHJDT
End DoDot:1
+25 IF PRCHJTY=5
Begin DoDot:1
+26 FOR J=39
SET XMY(OUT("DILIST","ID",1,J))=""
+27 SET XMSUB="TRANSMISSION FAILURE FOR 2237 "_PRCHJ22
+28 SET MSG1(.6)="2237 Transmission to eCMS failed "_PRCHJDT
End DoDot:1
+29 SET XMDUZ="IFCAP/eCMS INTERFACE"
+30 DO ^XMD
+31 QUIT
