source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMOLS.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRCHMOLS ;WISC/RWS-TRANSMIT OLS TRANS TO MAILMAN ;8-20-92/11:01
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,PRCHPO,X,XMB,XMSUB,XMDUN,XMDUZ,XMZ,Y,Z S TRANSIN="^PRCF(423.6,"_PRCDA_",0)",TRNSDA=PRCDA,X=@TRANSIN,TYP=$E(X,1,3),LIN=0,TRANSIN=$Q(@TRANSIN)
6 S MONS="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
7 S DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
8 S XMSUB="ISMS to IFCAP "_TYP_" transaction"
9 S XMDUZ="IFCAP MESSAGE SERVER"
10 F TRY=1:1:5 D GET^XMA2 I TRY<5 Q:XMZ>0
11 I TRY=5,XMZ<1 S ERR=" UNABLE TO GET MAILMAN NUMBER AFTER 5 TRIES." G ERROR
12 I TYP'="OLS" S ERR="INVALID TRANSACTION TYPE" G ERROR
13 ;
14SYSID ; READ SYSID SEGMENT
15 S X=$Q(@TRANSIN),SYSEG=@X I $P(SYSEG,U,4)'="OLS" S ERR="WRONG TRANSACTION TYPE" G ERROR
16 S X=$Q(@X),SEG=@X I $P(SEG,U)'="LC" S ERR="LC SEGMENT ERROR" Q
17 S IFNO=$P(SEG,U,3),IFNO=$E(IFNO,1,3)_"-"_$E(IFNO,4,99),LCNT=$P(SEG,U,2) D CHK
18 S ^XMB(3.9,XMZ,2,1,0)=" Line Status Transaction (OLS)"
19 S ^XMB(3.9,XMZ,2,2,0)=""
20 S ^XMB(3.9,XMZ,2,3,0)=" The following items were Allocated/Backordered/Cancelled"
21 S LIN=4,^XMB(3.9,XMZ,2,LIN,0)=" from IFCAP Requisition Number "_IFNO
22 I $D(NOTFOUND) S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)="**** THIS REQUISITION WAS NOT FOUND IN THE FILE ***" K NOTFOUND
23 S LIN=LIN+1,^XMB(3.9,XMZ,2,5,0)=""
24 S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)="Line F/K Subs Stat RsnCode Qty SKU Stock Number Comments/Reason Codes "
25 S BLANKS=$J(" ",57) D LOOKUP^PRCHMOL1
26 ;
27SEND ;SEND MAILMAN MESSAGE
28 I $G(ERR)'="" S LIN=$G(LIN)+1,^XMB(3.9,XMZ,2,LIN,0)=ERR
29 S:LIN>0 ^XMB(3.9,XMZ,2,0)="^3.92A^"_LIN_U_LIN_U_DT,XMDUN="IFCAP SERVER",X="G.OGR AUSTIN MESSAGES"
30 D WHO^XMA21 S:'$L($O(XMY(""))) XMY(.5)="" S:$G(PPM)]"" XMY(PPM)=""
31 D ENT1^XMD K XMY
32 ;
33EXIT ;CLEAN UP AND QUIT
34 I '$D(ERR) S DIK="^PRCF(423.6,",DA=TRNSDA D ^DIK K DIK,DA ; DELETE TRANS FROM TEMP FILE
35 K BLANKS,DATA,DAYS,DESEG,ERR,FLDIN,FLDOUT,IFNO,JDN,JDF,LCNT,LIN2,LIN,LN,MONS
36 K NODLS,NODSC,NSN,PAIR,PPM,RESEG,SEG,SEGTYP,SYSEG,TRANSIN,TRNSDA,TRY,TYP
37 S ZTREQ="@"
38 Q
39 ;
40ERROR S ZTDTH="1H" D REQ^%ZTLOAD
41 Q
42 ;
43CHK ;CHECK IFCAP PURCHASE ORDER NUMBER
44 S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S NOTFOUND=""
45 Q
Note: See TracBrowser for help on using the repository browser.