PRCHMOLS ;WISC/RWS-TRANSMIT OLS TRANS TO MAILMAN ;8-20-92/11:01
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
READ 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)
S MONS="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
S DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
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'="OLS" S ERR="INVALID TRANSACTION TYPE" G ERROR
;
SYSID ; READ SYSID SEGMENT
S X=$Q(@TRANSIN),SYSEG=@X I $P(SYSEG,U,4)'="OLS" S ERR="WRONG TRANSACTION TYPE" G ERROR
S X=$Q(@X),SEG=@X I $P(SEG,U)'="LC" S ERR="LC SEGMENT ERROR" Q
S IFNO=$P(SEG,U,3),IFNO=$E(IFNO,1,3)_"-"_$E(IFNO,4,99),LCNT=$P(SEG,U,2) D CHK
S ^XMB(3.9,XMZ,2,1,0)=" Line Status Transaction (OLS)"
S ^XMB(3.9,XMZ,2,2,0)=""
S ^XMB(3.9,XMZ,2,3,0)=" The following items were Allocated/Backordered/Cancelled"
S LIN=4,^XMB(3.9,XMZ,2,LIN,0)=" from IFCAP Requisition Number "_IFNO
I $D(NOTFOUND) S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)="**** THIS REQUISITION WAS NOT FOUND IN THE FILE ***" K NOTFOUND
S LIN=LIN+1,^XMB(3.9,XMZ,2,5,0)=""
S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)="Line F/K Subs Stat RsnCode Qty SKU Stock Number Comments/Reason Codes "
S BLANKS=$J(" ",57) D LOOKUP^PRCHMOL1
;
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.OGR AUSTIN MESSAGES"
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 BLANKS,DATA,DAYS,DESEG,ERR,FLDIN,FLDOUT,IFNO,JDN,JDF,LCNT,LIN2,LIN,LN,MONS
K NODLS,NODSC,NSN,PAIR,PPM,RESEG,SEG,SEGTYP,SYSEG,TRANSIN,TRNSDA,TRY,TYP
S ZTREQ="@"
Q
;
ERROR S ZTDTH="1H" D REQ^%ZTLOAD
Q
;
CHK ;CHECK IFCAP PURCHASE ORDER NUMBER
S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S NOTFOUND=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHMOLS 2248 printed Dec 13, 2024@02:08:48 Page 2
PRCHMOLS ;WISC/RWS-TRANSMIT OLS TRANS TO MAILMAN ;8-20-92/11:01
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
READ NEW A,B,DA,MO,YR,I,J,K,PRCHPO,X,XMB,XMSUB,XMDUN,XMDUZ,XMZ,Y,Z
SET TRANSIN="^PRCF(423.6,"_PRCDA_",0)"
SET TRNSDA=PRCDA
SET X=@TRANSIN
SET TYP=$EXTRACT(X,1,3)
SET LIN=0
SET TRANSIN=$QUERY(@TRANSIN)
+1 SET MONS="Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec"
+2 SET DAYS="31^28^31^30^31^30^31^31^30^31^30^31"
+3 SET XMSUB="ISMS to IFCAP "_TYP_" transaction"
+4 SET XMDUZ="IFCAP MESSAGE SERVER"
+5 FOR TRY=1:1:5
DO GET^XMA2
IF TRY<5
if XMZ>0
QUIT
+6 IF TRY=5
IF XMZ<1
SET ERR=" UNABLE TO GET MAILMAN NUMBER AFTER 5 TRIES."
GOTO ERROR
+7 IF TYP'="OLS"
SET ERR="INVALID TRANSACTION TYPE"
GOTO ERROR
+8 ;
SYSID ; READ SYSID SEGMENT
+1 SET X=$QUERY(@TRANSIN)
SET SYSEG=@X
IF $PIECE(SYSEG,U,4)'="OLS"
SET ERR="WRONG TRANSACTION TYPE"
GOTO ERROR
+2 SET X=$QUERY(@X)
SET SEG=@X
IF $PIECE(SEG,U)'="LC"
SET ERR="LC SEGMENT ERROR"
QUIT
+3 SET IFNO=$PIECE(SEG,U,3)
SET IFNO=$EXTRACT(IFNO,1,3)_"-"_$EXTRACT(IFNO,4,99)
SET LCNT=$PIECE(SEG,U,2)
DO CHK
+4 SET ^XMB(3.9,XMZ,2,1,0)=" Line Status Transaction (OLS)"
+5 SET ^XMB(3.9,XMZ,2,2,0)=""
+6 SET ^XMB(3.9,XMZ,2,3,0)=" The following items were Allocated/Backordered/Cancelled"
+7 SET LIN=4
SET ^XMB(3.9,XMZ,2,LIN,0)=" from IFCAP Requisition Number "_IFNO
+8 IF $DATA(NOTFOUND)
SET LIN=LIN+1
SET ^XMB(3.9,XMZ,2,LIN,0)="**** THIS REQUISITION WAS NOT FOUND IN THE FILE ***"
KILL NOTFOUND
+9 SET LIN=LIN+1
SET ^XMB(3.9,XMZ,2,5,0)=""
+10 SET LIN=LIN+1
SET ^XMB(3.9,XMZ,2,LIN,0)="Line F/K Subs Stat RsnCode Qty SKU Stock Number Comments/Reason Codes "
+11 SET BLANKS=$JUSTIFY(" ",57)
DO LOOKUP^PRCHMOL1
+12 ;
SEND ;SEND MAILMAN MESSAGE
+1 IF $GET(ERR)'=""
SET LIN=$GET(LIN)+1
SET ^XMB(3.9,XMZ,2,LIN,0)=ERR
+2 if LIN>0
SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_LIN_U_LIN_U_DT
SET XMDUN="IFCAP SERVER"
SET X="G.OGR AUSTIN MESSAGES"
+3 DO WHO^XMA21
if '$LENGTH($ORDER(XMY("")))
SET XMY(.5)=""
if $GET(PPM)]""
SET XMY(PPM)=""
+4 DO ENT1^XMD
KILL XMY
+5 ;
EXIT ;CLEAN UP AND QUIT
+1 ; DELETE TRANS FROM TEMP FILE
IF '$DATA(ERR)
SET DIK="^PRCF(423.6,"
SET DA=TRNSDA
DO ^DIK
KILL DIK,DA
+2 KILL BLANKS,DATA,DAYS,DESEG,ERR,FLDIN,FLDOUT,IFNO,JDN,JDF,LCNT,LIN2,LIN,LN,MONS
+3 KILL NODLS,NODSC,NSN,PAIR,PPM,RESEG,SEG,SEGTYP,SYSEG,TRANSIN,TRNSDA,TRY,TYP
+4 SET ZTREQ="@"
+5 QUIT
+6 ;
ERROR SET ZTDTH="1H"
DO REQ^%ZTLOAD
+1 QUIT
+2 ;
CHK ;CHECK IFCAP PURCHASE ORDER NUMBER
+1 SET DA=$ORDER(^PRC(442,"B",IFNO,0))
IF DA=""
SET NOTFOUND=""
+2 QUIT
