| 1 | PRCPRIB0 ;WISC/RFJ-issue book request form(called from ifcap only) ;22 Dec 92
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | DQ ; called from ifcap (not prcp*) to print issue book request
|
|---|
| 8 | ; form
|
|---|
| 9 | ; prcprib = internal entry to 410
|
|---|
| 10 | N %,%H,%I,CLASS,D,DATA,DEPART,DESCNSN,DESCR,ITEMDA,ITEMDATA,LINEDA,LINEITEM,MULTIPLE,NOW,NOWDT,NSN,P,PAGE,PRCPDA,PRCPFLAG,PRIMARY,PRIMDATA,SCREEN,SORT,STAR,TEMPLVL,TOTAL,TRANDAT1,TRANDAT3,TRANDAT7,TRANDAT9,TRANDATA,USER,VENDOR,X,Y
|
|---|
| 11 | S PRCPDA=+$G(PRCPRIB),TRANDATA=$G(^PRCS(410,PRCPDA,0)) I TRANDATA="" W !!,"ERROR -- NUMBER '",PRCPDA,"' NOT IN CONTROL POINT ACTIVITY FILE" Q
|
|---|
| 12 | S PRIMARY=+$P(TRANDATA,"^",6),PRIMDATA=$G(^PRCP(445,PRIMARY,0))
|
|---|
| 13 | S SORT=$P($G(^PRC(411,+TRANDATA,0)),"^",21) I $TR($P(PRIMDATA,"^",10),"S")'="" S SORT=$P(PRIMDATA,"^",10)
|
|---|
| 14 | S:SORT="" SORT="N"
|
|---|
| 15 | ;
|
|---|
| 16 | S TRANDAT1=$G(^PRCS(410,PRCPDA,1)),%=$P(TRANDAT1,"^",3),$P(TRANDAT1,"^",3)=$S(%="ST":"STANDARD",%="EM":"EMERGENCY",%="SP":"SPECIAL",1:"<< NOT SPECIFIED >>")
|
|---|
| 17 | S Y=$P(TRANDAT1,"^") D DD^%DT S $P(TRANDAT1,"^")=Y,Y=$P(TRANDAT1,"^",4) D DD^%DT S $P(TRANDAT1,"^",4)=Y
|
|---|
| 18 | S CLASS=$P($G(^PRCS(410.2,+$P(TRANDAT1,"^",5),0)),"^")
|
|---|
| 19 | ;
|
|---|
| 20 | S TRANDAT3=$G(^PRCS(410,PRCPDA,3)),VENDOR=+$P(TRANDAT3,"^",4)
|
|---|
| 21 | S DEPART=$P($G(^PRC(420,+TRANDATA,1,+$P(TRANDATA,"-",4),0)),"^",18)
|
|---|
| 22 | S:DEPART="" DEPART=$P($G(^PRCP(445,PRIMARY,0)),"^",8) I DEPART'="" S DEPART=DEPART_" "_$$INVNAME^PRCPUX1(PRIMARY)
|
|---|
| 23 | S:DEPART="" DEPART=$P($G(^DIC(49,+$P(TRANDAT3,"^",5),0)),"^")
|
|---|
| 24 | ;
|
|---|
| 25 | S TRANDAT7=$G(^PRCS(410,PRCPDA,7)),USER=$P($G(^VA(200,+TRANDAT7,0)),"^")
|
|---|
| 26 | S TRANDAT9=$G(^PRCS(410,PRCPDA,9))
|
|---|
| 27 | ;
|
|---|
| 28 | D NOW^%DTC S (NOWDT,Y)=% D DD^%DT S NOW=Y
|
|---|
| 29 | K ^TMP($J,"PRCPIB")
|
|---|
| 30 | S LINEDA=0 F S LINEDA=$O(^PRCS(410,PRCPDA,"IT",LINEDA)) Q:'LINEDA S D=$G(^(LINEDA,0)) I D'="" D
|
|---|
| 31 | . S LINEITEM=+$P(D,"^"),ITEMDA=+$P(D,"^",5),ITEMDATA=$G(^PRCP(445,PRIMARY,1,ITEMDA,0))
|
|---|
| 32 | . S TEMPLVL="" I $P(ITEMDATA,"^",23),$P(ITEMDATA,"^",24)>NOWDT S TEMPLVL=$P(ITEMDATA,"^",23)
|
|---|
| 33 | . S STAR="",MULTIPLE=$P($G(^PRC(441,ITEMDA,2,VENDOR,0)),"^",11) I MULTIPLE S %=$P(D,"^",2)/MULTIPLE I $P(%,".",2) S STAR="*"
|
|---|
| 34 | . S DESCR=$G(^PRCS(410,PRCPDA,"IT",LINEDA,1,1,0)) I DESCR="" S DESCR=$$DESCR^PRCPUX1(PRIMARY,ITEMDA)
|
|---|
| 35 | . S NSN=$$NSN^PRCPUX1(ITEMDA)
|
|---|
| 36 | . S DESCNSN=$S(SORT="A":DESCR,1:NSN) S:DESCNSN="" DESCNSN=" "
|
|---|
| 37 | . S ^TMP($J,"PRCPRIB",DESCNSN,LINEITEM,LINEDA)=$$UNITCODE^PRCPUX1(+$P(D,"^",3))_"^"_+$P(ITEMDATA,"^",9)_"^"_+$P(ITEMDATA,"^",7)_"^"_TEMPLVL_"^"_MULTIPLE_"^"_STAR_"^"_DESCR_"^"_NSN
|
|---|
| 38 | D PRINT^PRCPRIB1
|
|---|
| 39 | K ^TMP($J,"PRCPRIB")
|
|---|
| 40 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 41 | Q
|
|---|
