| [613] | 1 | PRCHMOP ;ISC2/RWS-ORDER NUMBER ACK (ONA) TRANSMITTER ;8-20-92/09:55
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | READ ; READ SYSID AND LINE COUNT SEGMENTS
|
|---|
| 5 | S X=$Q(@TRANSIN),SYSEG=@X
|
|---|
| 6 | S X=$Q(@X),LCSEG=@X I $P(LCSEG,U,1)'="LC" S ERR="SEGMENT TYPE SHOULD BE LC" Q
|
|---|
| 7 | 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)
|
|---|
| 8 | F Q:$A($E(ISNO,$L(ISNO)))'=32 S ISNO=$E(ISNO,1,$L(ISNO)-1)
|
|---|
| 9 | S ^XMB(3.9,XMZ,2,1,0)=" IFCAP Requisition Number "_IFNO_" has been assigned # "_ISNO_" in ISMS."
|
|---|
| 10 | S ^XMB(3.9,XMZ,2,2,0)=""
|
|---|
| 11 | S ^XMB(3.9,XMZ,2,3,0)=""
|
|---|
| 12 | S ^XMB(3.9,XMZ,2,4,0)=""
|
|---|
| 13 | S ^XMB(3.9,XMZ,2,5,0)=""
|
|---|
| 14 | S LIN=5 I $Q(@X)=""!(+LCNT'=0) S ERR="LINE COUNT ERROR" Q
|
|---|
| 15 | D ACK
|
|---|
| 16 | EXIT Q
|
|---|
| 17 | ACK ;TRANSMIT ISMS PO # TO IFCAP PO
|
|---|
| 18 | S DA=$O(^PRC(442,"B",IFNO,0)) I DA="" S ERR="REQUISITION NUMBER NOT FOUND" Q
|
|---|
| 19 | S DIE="^PRC(442,",DR="110///^S X=ISNO",DR(2,442.17)="1///" D ^DIE
|
|---|
| 20 | K DA,DIE,DR Q
|
|---|
