PRCPSMSI ;WISC/RFJ-isms issue transaction                           ;27 Jan 92
 ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 D ^PRCPUSEL Q:'$G(PRCP("I"))
 I PRCP("DPTYPE")'="W" W !,"THIS OPTION SHOULD ONLY BE USED BY THE WAREHOUSE INVENTORY POINT." Q
 I $$ISMSFLAG^PRCPUX2(PRC("SITE"))'=2 W !,"YOU NEED TO TURN THE ISMS SWITCH 'ON' BEFORE YOU CAN USE THIS OPTION." Q
 N %,COUNT,DATA,DELPT,DISYS,INVPT,PRCPFLAG,PRCPWAIT,SCREEN,TOTAL,TRANID,TRANNO,VOUCHER,WRITE,X
 S IOP="HOME" D ^%ZIS K IOP,^TMP($J,"STRING")
 S SCREEN="S %=$P(^PRCP(445.2,+Y,0),U,2) I $P(^(0),U)=PRCP(""I""),$E(%)=""R"",+$E(%,2),'$D(DATA(%))"
 ; write identifier for fileman for file 445.2 (^prcp(445.2,da,0))
 S WRITE="N %,Y S %=^(0),Y=$P(%,U,17) D DD^%DT W ?35,$P(%,U,2),?50,""posted: "",Y"
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="?"
 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="?"
 I X["?" W @IOF,!,"Select the TRANSACTION NUMBER from the list below:",! K DATA,PRCPFLAG D  G TRANREG
 .   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"
 .   .   I $D(^PRCP(445.2,Y,0)) S %=$P(^(0),"^",2) S:%'="" DATA(%)="" W !,$P(^(0),U,19) X WRITE
 .   .   I $Y>(IOSL-2) D P^PRCPUREP Q:$D(PRCPFLAG)  W @IOF,"Select the TRANSACTION NUMBER from the list below:",!
 S TRANNO=X,%=$O(^PRCS(410,"B",TRANNO,0)),DELPT=$P($G(^PRCS(410,+%,9)),"^")
 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
 W !!,"TRANSACTION NUMBER: ",TRANNO,?40,"DATE DISTRIBUTED: ",Y,!?40,"INVENTORY POINT : ",$E(INVPT,1,23)
 K PRCPFLAG S PRCPWAIT=1 W !?5,"...creating code sheets" D DQ^PRCPSMPI(TRANNO,TRANID)
 I $O(^TMP($J,"STRING",0))="" W "  NO code sheets created!" Q
 W @IOF,!,"THE FOLLOWING CODE SHEETS WILL BE TRANSMITTED FOR ISSUES:"
 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
 I $D(PRCPFLAG) D Q Q
 W !,"TOTAL CODE SHEETS TO TRANSMIT: ",+TOTAL,! I 'TOTAL D Q Q
 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."
 W !! I $$YN^PRCPUYN(1)'=1 D Q Q
 D CODESHT^PRCPSMGO(PRC("SITE"),"ISS",VOUCHER)
Q K ^TMP($J,"STRING") Q