| 1 | PRCPSMSI ;WISC/RFJ-isms issue transaction ;27 Jan 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 5 | I PRCP("DPTYPE")'="W" W !,"THIS OPTION SHOULD ONLY BE USED BY THE WAREHOUSE INVENTORY POINT." Q
|
|---|
| 6 | I $$ISMSFLAG^PRCPUX2(PRC("SITE"))'=2 W !,"YOU NEED TO TURN THE ISMS SWITCH 'ON' BEFORE YOU CAN USE THIS OPTION." Q
|
|---|
| 7 | N %,COUNT,DATA,DELPT,DISYS,INVPT,PRCPFLAG,PRCPWAIT,SCREEN,TOTAL,TRANID,TRANNO,VOUCHER,WRITE,X
|
|---|
| 8 | S IOP="HOME" D ^%ZIS K IOP,^TMP($J,"STRING")
|
|---|
| 9 | S SCREEN="S %=$P(^PRCP(445.2,+Y,0),U,2) I $P(^(0),U)=PRCP(""I""),$E(%)=""R"",+$E(%,2),'$D(DATA(%))"
|
|---|
| 10 | ; write identifier for fileman for file 445.2 (^prcp(445.2,da,0))
|
|---|
| 11 | S WRITE="N %,Y S %=^(0),Y=$P(%,U,17) D DD^%DT W ?35,$P(%,U,2),?50,""posted: "",Y"
|
|---|
| 12 | TRANREG W !!,"Select TRANSACTION (2237) NUMBER: " R X:DTIME S:'$T X="^" Q:X["^"!(X="") S:X=" " X=$P($G(^PRCP(445.2,+$G(^DISV(DUZ,"^PRCP(445.2,")),0)),"^",19) S:'X X="?"
|
|---|
| 13 | I X S DIC="^PRCP(445.2,",DIC(0)="QE",D="C",DIC("W")=WRITE,DIC("S")=SCREEN,PRCPPRIV=1 K DATA D IX^DIC K DIC,PRCPPRIV I +Y<0 S X="?"
|
|---|
| 14 | I X["?" W @IOF,!,"Select the TRANSACTION NUMBER from the list below:",! K DATA,PRCPFLAG D G TRANREG
|
|---|
| 15 | . S X="" F S X=$O(^PRCP(445.2,"C",X)) Q:X="" S Y=0 F S Y=+$O(^PRCP(445.2,"C",X,Y)) Q:'Y X SCREEN I $T D I $D(PRCPFLAG) S X="zzzz"
|
|---|
| 16 | . . I $D(^PRCP(445.2,Y,0)) S %=$P(^(0),"^",2) S:%'="" DATA(%)="" W !,$P(^(0),U,19) X WRITE
|
|---|
| 17 | . . I $Y>(IOSL-2) D P^PRCPUREP Q:$D(PRCPFLAG) W @IOF,"Select the TRANSACTION NUMBER from the list below:",!
|
|---|
| 18 | S TRANNO=X,%=$O(^PRCS(410,"B",TRANNO,0)),DELPT=$P($G(^PRCS(410,+%,9)),"^")
|
|---|
| 19 | S DATA=^PRCP(445.2,+Y,0),TRANID=$P(DATA,"^",2),INVPT=$P($$INVNAME^PRCPUX1($P(DATA,"^",18)),"-",2,99),VOUCHER=$P(DATA,"^",15),Y=$P(DATA,"^",17) D DD^%DT
|
|---|
| 20 | W !!,"TRANSACTION NUMBER: ",TRANNO,?40,"DATE DISTRIBUTED: ",Y,!?40,"INVENTORY POINT : ",$E(INVPT,1,23)
|
|---|
| 21 | K PRCPFLAG S PRCPWAIT=1 W !?5,"...creating code sheets" D DQ^PRCPSMPI(TRANNO,TRANID)
|
|---|
| 22 | I $O(^TMP($J,"STRING",0))="" W " NO code sheets created!" Q
|
|---|
| 23 | W @IOF,!,"THE FOLLOWING CODE SHEETS WILL BE TRANSMITTED FOR ISSUES:"
|
|---|
| 24 | S COUNT=0 F TOTAL=0:1 S COUNT=$O(^TMP($J,"STRING",COUNT)) Q:'COUNT W !?6,^(COUNT) I $Y>(IOSL-5) D P^PRCPUREP Q:$D(PRCPFLAG) W @IOF
|
|---|
| 25 | I $D(PRCPFLAG) D Q Q
|
|---|
| 26 | W !,"TOTAL CODE SHEETS TO TRANSMIT: ",+TOTAL,! I 'TOTAL D Q Q
|
|---|
| 27 | S XP="*** ARE YOU SURE YOU WANT TO CREATE THE ISMS TRANSACTION",XP(1)=" AND TRANSMIT IT TO AUSTIN",XH="ENTER 'YES' TO CREATE THE ISMS TRANSACTION AND TRANSMIT IT TO AUSTIN",XH(1)="ENTER 'NO' OR '^' TO EXIT."
|
|---|
| 28 | W !! I $$YN^PRCPUYN(1)'=1 D Q Q
|
|---|
| 29 | D CODESHT^PRCPSMGO(PRC("SITE"),"ISS",VOUCHER)
|
|---|
| 30 | Q K ^TMP($J,"STRING") Q
|
|---|
