69 lines
3.1 KiB
Mathematica
69 lines
3.1 KiB
Mathematica
PRCHMSPD ;WISC/RWS-TRANSMIT DO1 TRANS TO MAILMAN ;8-20-92/10:27
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
READ N 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)
|
|
S XMSUB="ISMS to IFCAP "_TYP_" transaction"
|
|
S XMDUZ="IFCAP MESSAGE SERVER"
|
|
F TRY=1:1:5 D GET^XMA2 I TRY<5 Q:XMZ>0
|
|
I TRY=5,XMZ<1 S ERR=" UNABLE TO GET MAILMAN NUMBER AFTER 5 TRIES." G ERROR
|
|
I TYP'="DO1" S ERR="INVALID TRANSACTION TYPE" G ERROR
|
|
;
|
|
SYSID ; READ SYSID SEGMENT
|
|
S X=$Q(@TRANSIN),SYSEG=@X,IFNO=$P(SYSEG,U,7),IFNO=$E(IFNO,1,3)_"-"_$E(IFNO,4,99)
|
|
S ^XMB(3.9,XMZ,2,1,0)=""
|
|
S ^XMB(3.9,XMZ,2,2,0)="Delivery Order for IFCAP Purchase Order # "_IFNO_" has been received."
|
|
S ^XMB(3.9,XMZ,2,3,0)=""
|
|
S ^XMB(3.9,XMZ,2,4,0)=""
|
|
S ^XMB(3.9,XMZ,2,5,0)=""
|
|
;
|
|
CHK ;CHECK IFCAP PURCHASE ORDER NUMBER
|
|
;I $E($P(SYSEG,U,7))="" S ERR="BLANK PO NUMBER IN HEADER" G ERROR
|
|
S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S ERR="PO NUMBER NOT FOUND" Q
|
|
S LIN=5 F I=1:1 S X=$Q(@X),SEG=@X,SEGTYP=$E(SEG,1,2) Q:"AC BI DH"'[SEGTYP D @SEGTYP
|
|
;
|
|
SEND ;SEND MAILMAN MESSAGE
|
|
I $G(ERR)'="" S LIN=$G(LIN)+1,^XMB(3.9,XMZ,2,LIN,0)=ERR
|
|
S:LIN>0 ^XMB(3.9,XMZ,2,0)="^3.92A^"_LIN_U_LIN_U_DT,XMDUN="IFCAP SERVER",X="G.ISM@"_^XMB("NETNAME")
|
|
D WHO^XMA21 S:'$L($O(XMY(""))) XMY(.5)="" S:$G(PPM)]"" XMY(PPM)=""
|
|
D ENT1^XMD K XMY
|
|
;
|
|
EXIT ;CLEAN UP AND QUIT
|
|
I '$D(ERR) S DIK="^PRCF(423.6,",DA=TRNSDA D ^DIK K DIK,DA ; DELETE TRANS FROM TEMP FILE
|
|
K DATA,DESEG,ERR,FLDIN,FLDOUT,IFNO,LIN,NODLS,NODSC,PAIR,SEG,SEGTYP,SYSEG,TRANSIN,TRNSDA,TRY,TYP S ZTREQ="@" QUIT
|
|
Q
|
|
TABLE ;FIELD NAME LOOKUP TABLE ;FIELD # WITHIN SEGMENT,POINTER TO FIELD NAME;
|
|
AC ;;9,578;11,580;12,581;13,582
|
|
D FORMAT Q
|
|
BI ;;2,513.1;3,513.2;4,513.3;5,513.4;6,513.5;8,513.7;9,513.8;10,513.9
|
|
D FORMAT Q
|
|
DH ;;2,533;3,534;4,535;5,541;6,536;7,534.5;8,543;9,543.3;10,543.4;11,538.5;15,514.1;16,515.2;
|
|
S NODSC=$P(SEG,U,20),NODLS=$P(SEG,U,21) D FORMAT,DE:NODSC,DL:NODLS
|
|
Q
|
|
DE ;;
|
|
F J=1:1:NODSC S X=$Q(@X),DESEG=@X G:$P(DESEG,U,1)'="DE" DSCERR D
|
|
.S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=" "_$P(DESEG,U,2)
|
|
Q
|
|
;
|
|
DL ;;4,NSN;5,P/O LINE #;6,CONT #;7,CONT LIN #;8,REQ DEL DATE;9,QUANTITY;10,UNIT OF PURCH;11,SKU FACTOR;12,UNIT COST;13,SKU;14,DISCOUNT;15,INSP QTY;16,STATUS;
|
|
F K=1:1:NODLS S X=$Q(@X),SEG=@X,SEGTYP=$P(SEG,U,1) G:SEGTYP'="DL" DLERR D
|
|
.D FORMAT
|
|
.S NODSC=$P(SEG,U,17) I NODSC S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=" Lines of Description;" F J=1:1:NODSC S X=$Q(@X),Y=@X G:$P(Y,U,1)'="DE" DSCER D
|
|
..S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=" "_$P(Y,U,2)
|
|
Q
|
|
;
|
|
ERROR S ZTDTH="1H" D REQ^%ZTLOAD Q
|
|
;
|
|
DSCERR S ERR="DE Segment Line Count Error" Q
|
|
;
|
|
DSCER S ERR="DL Desc Line Count Error" Q
|
|
;
|
|
DLERR S ERR="DL Segment Line Count Error" Q
|
|
;
|
|
FORMAT ;FORMAT MESSAGE LINES
|
|
S Z=$T(@SEGTYP),Z=$P(Z,";;",2,99) F J=1:1 Q:$P(Z,";",J)="" D
|
|
.S PAIR=$P(Z,";",J),FLDIN=$P(PAIR,",",1),FLDOUT=$P(PAIR,",",2)
|
|
.S DATA=$P(SEG,U,FLDIN) Q:DATA="" S NAME=$S(FLDOUT?.A:FLDOUT,$D(^DD(423,FLDOUT,0)):$P(^(0),U),1:FLDOUT)
|
|
.S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=" The "_NAME_$E(" ",$L(NAME),20)_" is "_DATA_". "
|
|
Q
|