PRCHMOP ;ISC2/RWS-ORDER NUMBER ACK (ONA) TRANSMITTER ;8-20-92/09:55
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=$P(LCSEG,U,3),IFNO=$E(IFNO,1,3)_"-"_$E(IFNO,4,99)
F Q:$A($E(ISNO,$L(ISNO)))'=32 S ISNO=$E(ISNO,1,$L(ISNO)-1)
S ^XMB(3.9,XMZ,2,1,0)=" IFCAP Requisition Number "_IFNO_" has been assigned # "_ISNO_" in ISMS."
S ^XMB(3.9,XMZ,2,2,0)=""
S ^XMB(3.9,XMZ,2,3,0)=""
S ^XMB(3.9,XMZ,2,4,0)=""
S ^XMB(3.9,XMZ,2,5,0)=""
S LIN=5 I $Q(@X)=""!(+LCNT'=0) S ERR="LINE COUNT ERROR" Q
D ACK
EXIT Q
ACK ;TRANSMIT ISMS PO # TO IFCAP PO
S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S ERR="REQUISITION NUMBER NOT FOUND" Q
S DIE="^PRC(442,",DR="110///^S X=ISNO",DR(2,442.17)="1///" D ^DIE
K DA,DIE,DR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHMOP 966 printed Dec 13, 2024@02:08:49 Page 2
PRCHMOP ;ISC2/RWS-ORDER NUMBER ACK (ONA) TRANSMITTER ;8-20-92/09:55
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=$PIECE(LCSEG,U,3)
SET IFNO=$EXTRACT(IFNO,1,3)_"-"_$EXTRACT(IFNO,4,99)
+4 FOR
if $ASCII($EXTRACT(ISNO,$LENGTH(ISNO)))'=32
QUIT
SET ISNO=$EXTRACT(ISNO,1,$LENGTH(ISNO)-1)
+5 SET ^XMB(3.9,XMZ,2,1,0)=" IFCAP Requisition Number "_IFNO_" has been assigned # "_ISNO_" in ISMS."
+6 SET ^XMB(3.9,XMZ,2,2,0)=""
+7 SET ^XMB(3.9,XMZ,2,3,0)=""
+8 SET ^XMB(3.9,XMZ,2,4,0)=""
+9 SET ^XMB(3.9,XMZ,2,5,0)=""
+10 SET LIN=5
IF $QUERY(@X)=""!(+LCNT'=0)
SET ERR="LINE COUNT ERROR"
QUIT
+11 DO ACK
EXIT QUIT
ACK ;TRANSMIT ISMS PO # TO IFCAP PO
+1 SET DA=$ORDER(^PRC(442,"B",IFNO,0))
IF DA=""
SET ERR="REQUISITION NUMBER NOT FOUND"
QUIT
+2 SET DIE="^PRC(442,"
SET DR="110///^S X=ISNO"
SET DR(2,442.17)="1///"
DO ^DIE
+3 KILL DA,DIE,DR
QUIT
