source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMHLS.m@ 1627

Last change on this file since 1627 was 613, checked in by George Lilly, 16 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1PRCHMHLS ;WISC/RWS-TRANSMIT HLS TRANS TO MAILMAN ;9-17-92/09:53
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5READ N A,B,DA,MO,YR,I,J,K,NSN,X,XMB,XMSUB,XMDUN,XMDUZ,XMZ,Y,Z
6 S TRANSIN="^PRCF(423.6,"_PRCDA_",0)",TRNSDA=PRCDA,X=@TRANSIN,TYP=$E(X,1,3),LIN=0,TRANSIN=$Q(@TRANSIN)
7 S MONS="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
8 S DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
9 S XMSUB="ISMS to IFCAP "_TYP_" transaction"
10 S XMDUZ="IFCAP MESSAGE SERVER"
11 F TRY=1:1:5 D GET^XMA2 I TRY<5 Q:XMZ>0
12 I TRY=5,XMZ<1 S ERR=" UNABLE TO GET MAILMAN NUMBER AFTER 5 TRIES." G ERROR
13 I TYP'="HLS" S ERR="INVALID TRANSACTION TYPE" G ERROR
14 ;
15SYSID ; READ SYSID SEGMENT
16 S X=$Q(@TRANSIN),SYSEG=@X,ISNO=$P(SYSEG,U,7) I $P(SYSEG,U,4)'="HLS" S ERR="WRONG TRANSACTION TYPE" G ERROR
17 S ^XMB(3.9,XMZ,2,1,0)=" Header Status Transaction (HLS)"
18 S ^XMB(3.9,XMZ,2,2,0)=""
19 S ^XMB(3.9,XMZ,2,3,0)=" The following items were changed on ISMS TO/SO number "_ISNO
20 S ^XMB(3.9,XMZ,2,4,0)=""
21 S BLANKS=$J(" ",57),LIN=4 D LOOKUP^PRCHMHL1
22 ;
23SEND ;SEND MAILMAN MESSAGE
24 I $G(ERR)'="" S LIN=$G(LIN)+1,^XMB(3.9,XMZ,2,LIN,0)=ERR
25 S:LIN>0 ^XMB(3.9,XMZ,2,0)="^3.92A^"_LIN_U_LIN_U_DT,XMDUN="IFCAP SERVER",X="G.OGR AUSTIN MESSAGES"
26 D WHO^XMA21 S:'$L($O(XMY(""))) XMY(.5)="" S:$G(PPM)]"" XMY(PPM)=""
27 D ENT1^XMD K XMY
28 ;
29EXIT ;CLEAN UP AND QUIT
30 ;I '$D(ERR) S DIK="^PRCF(423.6,",DA=TRNSDA D ^DIK K DIK,DA ; DELETE TRANS FROM TEMP FILE
31 K BLANKS,DATA,DAYS,DESEG,ERR,FLDIN,FLDOUT,IFNO,ISNO,JDN,JDF,LCNT,LIN,LIN2,LN,NAME
32 K MONS,NODLS,NODSC,PAIR,PPM,RESEG,SEG,SEGTYP,SYSEG,TITLE,TRANSIN,TRNSDA,TRY,TYP
33 S ZTREQ="@"
34 Q
35 ;
36ERROR S ZTDTH="1H" D REQ^%ZTLOAD
37 Q
Note: See TracBrowser for help on using the repository browser.