| 1 | PSXARC2 ;BIR/HTW-Rx Order Entry Screen for CMOP [ 04/08/97 2:06 PM ]
|
|---|
| 2 | ;;2.0;CMOP;;11 Apr 97
|
|---|
| 3 | D NOW^%DTC S Y=% X ^DD("DD")
|
|---|
| 4 | U PSXP W @PSXPIOF
|
|---|
| 5 | W ?10,"CMOP MASTER DATABASE ARCHIVE",?45,Y
|
|---|
| 6 | S REC=$P(REC,"|",2)
|
|---|
| 7 | W !,"ARCHIVE REPORT FOR TRANSMISSION # "_$P(REC,"^")
|
|---|
| 8 | W !,?8," by ",$P($G(^VA(200,DUZ,0)),"^")_" on "_$P(Y,"@"),!!
|
|---|
| 9 | ;Print 552.1 data
|
|---|
| 10 | W !,$J("Status: ",15),$P(REC,"^",2)
|
|---|
| 11 | W ?40,$J("Trans D/T: ",15),$P(REC,"^",3)
|
|---|
| 12 | W !,$J("Received D/T: ",15),$P(REC,"^",4)
|
|---|
| 13 | W ?40,$J("Closed D/T: ",15),$P(REC,"^",5)
|
|---|
| 14 | W !,$J("Processed D/T: ",15),$P(REC,"^",6)
|
|---|
| 15 | W ?40,$J("Start Seq #: ",15),$P(REC,"^",7)
|
|---|
| 16 | W !,$J("End Seq #: ",15),$P(REC,"^",8)
|
|---|
| 17 | W ?40,$J("Total Orders: ",15),$P(REC,"^",9)
|
|---|
| 18 | W !,$J("Total Rx's: ",15),$P(REC,"^",10)
|
|---|
| 19 | W ?40,$J("Purge Status: ",15),$P(REC,"^",11)
|
|---|
| 20 | W !,$J("Retrans: ",15),$P(REC,"^",12)
|
|---|
| 21 | W ?40,$J("Orig Trans #: ",15),$P(REC,"^",13)
|
|---|
| 22 | W !,$J("Division: ",15),$P(REC,"^",14)
|
|---|
| 23 | W ?40,$J("Site Name: ",15),$P(REC,"^",15)
|
|---|
| 24 | W !,$J("Sender: ",15),$P(REC,"^",16)
|
|---|
| 25 | COMM S $P(ZQ,"-",50)="",$P(ZQ1,"=",75)=""
|
|---|
| 26 | I '$D(COM) G LBL
|
|---|
| 27 | W !!,"Comments: "
|
|---|
| 28 | F ZX=0:0 S ZX=$O(COM(ZX)) Q:'ZX W !,$P(COM(ZX),"|",2)
|
|---|
| 29 | LBL I '$D(LBL) G ACK
|
|---|
| 30 | W !!,"LABEL LOG: "
|
|---|
| 31 | W !,"DATE PRINTED",?30,"PRINTED BY"
|
|---|
| 32 | W !,ZQ
|
|---|
| 33 | S ZX=0
|
|---|
| 34 | L1 S ZX=$O(LBL(ZX)) G:($G(ZX)']"") ACK
|
|---|
| 35 | S LBL(ZX)=$P(LBL(ZX),"|",2)
|
|---|
| 36 | F ZXX=1:1 Q:$P($G(LBL(ZX)),"/",ZXX)']"" D
|
|---|
| 37 | .S ZDT=$P($P(LBL(ZX),"/",ZXX),"^"),ZNAME=$P($P(LBL(ZX),"/",ZXX),"^",2)
|
|---|
| 38 | .W !,ZDT,?30,ZNAME
|
|---|
| 39 | .K ZDT,ZNAME
|
|---|
| 40 | I $O(LBL(ZX))]"" G L1
|
|---|
| 41 | K ZX,ZXX
|
|---|
| 42 | ACK Q:'$D(ACK)
|
|---|
| 43 | W !!,"Acknowledgement Text: "
|
|---|
| 44 | W !,$P(ACK,"|",2)
|
|---|
| 45 | Q
|
|---|
| 46 | RX ;Print 552.4 data
|
|---|
| 47 | U PSXP
|
|---|
| 48 | I $G(PSXPIOST)'["C-",($Y>48) W @PSXPIOF
|
|---|
| 49 | W !!,"Rx #",?17,": ",$P(REC1,"^"),?35,"Fill #",?48,": ",$P(REC1,"^",12)
|
|---|
| 50 | W ?60,"Qty: ",$P(REC1,"^",13)
|
|---|
| 51 | W !,"Employee Name",?17,": ",$P(REC1,"^",6)
|
|---|
| 52 | W !,"Price/Disp Unit",?17,": ",$P(REC1,"^",11)
|
|---|
| 53 | W ?35,"Drug ID #",?48,": ",$P(REC1,"^",4)
|
|---|
| 54 | W !,"Release Status",?17,": ",$P(REC1,"^",2)
|
|---|
| 55 | W ?35,"Release Type",?48,": ",$P(REC2,"^")
|
|---|
| 56 | W !,"Rx Status",?17,": ",$P(REC1,"^",10)
|
|---|
| 57 | W ?35,"NDC",?48,": ",$P(REC1,"^",5)
|
|---|
| 58 | W !,"Carrier",?17,": ",$P(REC2,"^",5)
|
|---|
| 59 | W ?35,"Package ID #",?48,": ",$P(REC2,"^",6)
|
|---|
| 60 | W !,"Date Shipped",?17,": ",$P(REC2,"^",4)
|
|---|
| 61 | W !,"Processed D/T",?17,": ",$P(REC1,"^",7)
|
|---|
| 62 | W ?42,"Completed D/T: ",$P(REC1,"^",9)
|
|---|
| 63 | W !,"Remote Error Cond",?17,": ",$P(REC2,"^",2)
|
|---|
| 64 | W !,"Cancel Reason",?17,": ",$P(REC1,"^",3)
|
|---|
| 65 | I $G(LOT)']"" W !,ZQ1,! Q
|
|---|
| 66 | LOT U PSXP S ZPC=1
|
|---|
| 67 | L2 S ZL=$P($P(LOT,"/",ZPC),"^"),ZDT=$P($P(LOT,"/",ZPC),"^",2)
|
|---|
| 68 | I $G(ZL)']"",($G(ZDT))']"" K ZL,ZDT W !,ZQ1,! Q
|
|---|
| 69 | W !,"LOT #: ",$G(ZL),?35,"Expiration Date: ",$G(ZDT)
|
|---|
| 70 | ELOT K ZL,ZDT S ZPC=ZPC+1
|
|---|
| 71 | G L2
|
|---|
