PRCHMESE ;ISC2/RWS-TRANSMIT OPE TRANSACTIONS TO MAILMAN ;5-8-92/13:06
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
READ ; READ SYSID AND LINE COUNT SEGMENTS
S X=$Q(@TRANSIN),SYSEG=@X
S X=$Q(@X),LCSEG=@X I $P(LCSEG,U,1)'="LC" S ERR="SEGMENT TYPE SHOULD BE LC" Q
S LCNT=$P(LCSEG,U,2),ISNO=$P(SYSEG,U,7),IFNO=$TR($P(LCSEG,U,3)," "),LN=$L(IFNO),IFNO=$P(SYSEG,U,3)_"-"_$E(IFNO,1,LN)
S ^XMB(3.9,XMZ,2,1,0)=" There was an error on IFCAP Requisition Number "_IFNO
S ^XMB(3.9,XMZ,2,2,0)=" These line items must be deleted from the PO and reordered. "
S ^XMB(3.9,XMZ,2,3,0)=" "
S ^XMB(3.9,XMZ,2,4,0)=" Line # - National Stock # - Quantity - Invalid Field - Invalid Data "
S ^XMB(3.9,XMZ,2,5,0)=""
S LIN=5 F I=1:1:LCNT S X=$Q(@X) D I $Q(@X)="" S ERR="LINE COUNT ERROR" Q
.S Y=@X,Y(2)=$P(Y,U,2),Y(3)=$P(Y,U,3),Y(4)=$P(Y,U,4)/100,Y(5)=$P(Y,U,5),Y(6)=$P(Y,U,6)
.S Y(2)=$E(Y(2),1,4)_"-"_$E(Y(2),5,6)_"-"_$E(Y(2),7,9)_"-"_$E(Y(2),10,20)
.S Y=$J(Y(3),3)_$J(Y(2),22)_$J(Y(4),10)_" "_Y(5)_$E(" ",$L(Y(5)),20)_" "_Y(6)
.S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=Y
EXIT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHMESE 1163 printed Dec 13, 2024@02:08:41 Page 2
PRCHMESE ;ISC2/RWS-TRANSMIT OPE TRANSACTIONS TO MAILMAN ;5-8-92/13:06
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
READ ; READ SYSID AND LINE COUNT SEGMENTS
+1 SET X=$QUERY(@TRANSIN)
SET SYSEG=@X
+2 SET X=$QUERY(@X)
SET LCSEG=@X
IF $PIECE(LCSEG,U,1)'="LC"
SET ERR="SEGMENT TYPE SHOULD BE LC"
QUIT
+3 SET LCNT=$PIECE(LCSEG,U,2)
SET ISNO=$PIECE(SYSEG,U,7)
SET IFNO=$TRANSLATE($PIECE(LCSEG,U,3)," ")
SET LN=$LENGTH(IFNO)
SET IFNO=$PIECE(SYSEG,U,3)_"-"_$EXTRACT(IFNO,1,LN)
+4 SET ^XMB(3.9,XMZ,2,1,0)=" There was an error on IFCAP Requisition Number "_IFNO
+5 SET ^XMB(3.9,XMZ,2,2,0)=" These line items must be deleted from the PO and reordered. "
+6 SET ^XMB(3.9,XMZ,2,3,0)=" "
+7 SET ^XMB(3.9,XMZ,2,4,0)=" Line # - National Stock # - Quantity - Invalid Field - Invalid Data "
+8 SET ^XMB(3.9,XMZ,2,5,0)=""
+9 SET LIN=5
FOR I=1:1:LCNT
SET X=$QUERY(@X)
Begin DoDot:1
+10 SET Y=@X
SET Y(2)=$PIECE(Y,U,2)
SET Y(3)=$PIECE(Y,U,3)
SET Y(4)=$PIECE(Y,U,4)/100
SET Y(5)=$PIECE(Y,U,5)
SET Y(6)=$PIECE(Y,U,6)
+11 SET Y(2)=$EXTRACT(Y(2),1,4)_"-"_$EXTRACT(Y(2),5,6)_"-"_$EXTRACT(Y(2),7,9)_"-"_$EXTRACT(Y(2),10,20)
+12 SET Y=$JUSTIFY(Y(3),3)_$JUSTIFY(Y(2),22)_$JUSTIFY(Y(4),10)_" "_Y(5)_$EXTRACT(" ",$LENGTH(Y(5)),20)_" "_Y(6)
+13 SET LIN=LIN+1
SET ^XMB(3.9,XMZ,2,LIN,0)=Y
End DoDot:1
IF $QUERY(@X)=""
SET ERR="LINE COUNT ERROR"
QUIT
EXIT QUIT
