- 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 Feb 18, 2025@23:34:31 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