source: FOIAVistA/tag/r/CMOP-PSX/PSXARC2.m@ 876

Last change on this file since 876 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PSXARC2 ;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)
25COMM 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)
29LBL I '$D(LBL) G ACK
30 W !!,"LABEL LOG: "
31 W !,"DATE PRINTED",?30,"PRINTED BY"
32 W !,ZQ
33 S ZX=0
34L1 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
42ACK Q:'$D(ACK)
43 W !!,"Acknowledgement Text: "
44 W !,$P(ACK,"|",2)
45 Q
46RX ;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
66LOT U PSXP S ZPC=1
67L2 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)
70ELOT K ZL,ZDT S ZPC=ZPC+1
71 G L2
Note: See TracBrowser for help on using the repository browser.