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

PRCHMSHA.m

Go to the documentation of this file.
  1. PRCHMSHA ;WISC/RWS-TRANSMIT SHA TRANS TO MAILMAN ;1/26/98 1130
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. READ N DA,MO,YR,I,J,K,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)
  1. S MONS="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
  1. S DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
  1. S XMSUB="ISMS to IFCAP "_TYP_" transaction"
  1. S XMDUZ="IFCAP MESSAGE SERVER"
  1. F TRY=1:1:5 D GET^XMA2 I TRY<5 Q:XMZ>0
  1. I TRY=5,XMZ<1 S ERR=" UNABLE TO GET MAILMAN NUMBER AFTER 5 TRIES." G ERROR
  1. I TYP'="SHA" S ERR="INVALID TRANSACTION TYPE" G ERROR
  1. ;
  1. SYSID ; READ SYSID SEGMENT
  1. S X=$Q(@TRANSIN),SYSEG=@X I $P(SYSEG,U,4)'="SHA" S ERR="WRONG TRANSACTION TYPE" G ERROR
  1. S X=$Q(@X),SEG=@X I $P(SEG,U)'="SH" S ERR="SH SEGMENT ERROR" Q
  1. S IFNO=$P(SEG,U,4),IFNO=$E(IFNO,1,3)_"-"_$E(IFNO,4,99),SHIPDATE=$P(SEG,U,8),DELDATE=$P(SEG,U,9),CARRIER=$P(SEG,U,7),GBLNO=$P(SEG,U,10)_"-"_$P(SEG,U,11),LCNT=$P(SEG,U,12)
  1. D JDN(.SHIPDATE),JDN(.DELDATE)
  1. S ^XMB(3.9,XMZ,2,1,0)=" SHIPPING ACKNOWLEDGEMENT"
  1. S ^XMB(3.9,XMZ,2,2,0)=""
  1. S ^XMB(3.9,XMZ,2,3,0)=" Items from IFCAP Purchase Order # "_IFNO_" were shipped on "_SHIPDATE
  1. S ^XMB(3.9,XMZ,2,4,0)="Via "_CARRIER_". The estimated delivery date is "_DELDATE
  1. S ^XMB(3.9,XMZ,2,5,0)="on Government Bill of Lading number "_GBLNO_"."
  1. S ^XMB(3.9,XMZ,2,6,0)=" IFCAP Line # - Quantity - SKU - Stock Number "
  1. ;
  1. CHK ;CHECK IFCAP PURCHASE ORDER NUMBER
  1. S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S ERR="PO NUMBER NOT FOUND"
  1. S LIN=6 F I=1:1:LCNT S X=$Q(@X),SEG=@X,SEGTYP=$E(SEG,1,2) G:SEGTYP'="SP" SPERR D
  1. .S NSN=$P(SEG,U,2),NSN=$E(NSN,1,4)_"-"_$E(NSN,5,6)_"-"_$E(NSN,7,9)_"-"_$E(NSN,10,20)
  1. .S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=$J($P(SEG,U,5),10)_$J($P(SEG,U,3)/100,20)_" "_$P(SEG,U,4)_" "_NSN
  1. ;
  1. SEND ;SEND MAILMAN MESSAGE
  1. I $G(ERR)'="" S LIN=$G(LIN)+1,^XMB(3.9,XMZ,2,LIN,0)=ERR
  1. S:LIN>0 ^XMB(3.9,XMZ,2,0)="^3.92A^"_LIN_U_LIN_U_DT,XMDUN="IFCAP SERVER",X="G.OGR AUSTIN MESSAGES"
  1. D WHO^XMA21 S:'$L($O(XMY(""))) XMY(.5)="" S:$G(PPM)]"" XMY(PPM)=""
  1. D ENT1^XMD K XMY
  1. ;
  1. EXIT ;CLEAN UP AND QUIT
  1. I '$D(ERR) S DIK="^PRCF(423.6,",DA=TRNSDA D ^DIK K DIK,DA ; DELETE TRANS FROM TEMP FILE
  1. K DATA,DESEG,ERR,FLDIN,FLDOUT,IFNO,LIN,NODLS,NODSC,PAIR,SEG,SEGTYP,SYSEG,TRANSIN,TRNSDA,TRY,TYP S ZTREQ="@"
  1. Q
  1. JDN(JDN) ; CHANGE JULIAN DATE (JDN) TO DA-MON-YEAR (JDF)
  1. S YR=$E(JDN,1,4),DA=$E(JDN,5,7)
  1. S $P(DAYS,U,2)=$S(YR#400=0:29,(YR#4=0&(YR#100'=0)):29,1:28)
  1. F MO=1:1 S DA=DA-$P(DAYS,U,MO) Q:DA'>0
  1. S DA=DA+$P(DAYS,U,MO),JDN=DA_" "_$P(MONS,U,MO)_" "_YR
  1. Q
  1. ;
  1. ERROR S ZTDTH="1H" D REQ^%ZTLOAD Q
  1. ;
  1. SPERR S ERR="SHIPPING LINE ERROR" Q