Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXARC2

PSXARC2.m

Go to the documentation of this file.
  1. PSXARC2 ;BIR/HTW-Rx Order Entry Screen for CMOP [ 04/08/97 2:06 PM ]
  1. ;;2.0;CMOP;;11 Apr 97
  1. D NOW^%DTC S Y=% X ^DD("DD")
  1. U PSXP W @PSXPIOF
  1. W ?10,"CMOP MASTER DATABASE ARCHIVE",?45,Y
  1. S REC=$P(REC,"|",2)
  1. W !,"ARCHIVE REPORT FOR TRANSMISSION # "_$P(REC,"^")
  1. W !,?8," by ",$P($G(^VA(200,DUZ,0)),"^")_" on "_$P(Y,"@"),!!
  1. ;Print 552.1 data
  1. W !,$J("Status: ",15),$P(REC,"^",2)
  1. W ?40,$J("Trans D/T: ",15),$P(REC,"^",3)
  1. W !,$J("Received D/T: ",15),$P(REC,"^",4)
  1. W ?40,$J("Closed D/T: ",15),$P(REC,"^",5)
  1. W !,$J("Processed D/T: ",15),$P(REC,"^",6)
  1. W ?40,$J("Start Seq #: ",15),$P(REC,"^",7)
  1. W !,$J("End Seq #: ",15),$P(REC,"^",8)
  1. W ?40,$J("Total Orders: ",15),$P(REC,"^",9)
  1. W !,$J("Total Rx's: ",15),$P(REC,"^",10)
  1. W ?40,$J("Purge Status: ",15),$P(REC,"^",11)
  1. W !,$J("Retrans: ",15),$P(REC,"^",12)
  1. W ?40,$J("Orig Trans #: ",15),$P(REC,"^",13)
  1. W !,$J("Division: ",15),$P(REC,"^",14)
  1. W ?40,$J("Site Name: ",15),$P(REC,"^",15)
  1. W !,$J("Sender: ",15),$P(REC,"^",16)
  1. COMM S $P(ZQ,"-",50)="",$P(ZQ1,"=",75)=""
  1. I '$D(COM) G LBL
  1. W !!,"Comments: "
  1. F ZX=0:0 S ZX=$O(COM(ZX)) Q:'ZX W !,$P(COM(ZX),"|",2)
  1. LBL I '$D(LBL) G ACK
  1. W !!,"LABEL LOG: "
  1. W !,"DATE PRINTED",?30,"PRINTED BY"
  1. W !,ZQ
  1. S ZX=0
  1. L1 S ZX=$O(LBL(ZX)) G:($G(ZX)']"") ACK
  1. S LBL(ZX)=$P(LBL(ZX),"|",2)
  1. F ZXX=1:1 Q:$P($G(LBL(ZX)),"/",ZXX)']"" D
  1. .S ZDT=$P($P(LBL(ZX),"/",ZXX),"^"),ZNAME=$P($P(LBL(ZX),"/",ZXX),"^",2)
  1. .W !,ZDT,?30,ZNAME
  1. .K ZDT,ZNAME
  1. I $O(LBL(ZX))]"" G L1
  1. K ZX,ZXX
  1. ACK Q:'$D(ACK)
  1. W !!,"Acknowledgement Text: "
  1. W !,$P(ACK,"|",2)
  1. Q
  1. RX ;Print 552.4 data
  1. U PSXP
  1. I $G(PSXPIOST)'["C-",($Y>48) W @PSXPIOF
  1. W !!,"Rx #",?17,": ",$P(REC1,"^"),?35,"Fill #",?48,": ",$P(REC1,"^",12)
  1. W ?60,"Qty: ",$P(REC1,"^",13)
  1. W !,"Employee Name",?17,": ",$P(REC1,"^",6)
  1. W !,"Price/Disp Unit",?17,": ",$P(REC1,"^",11)
  1. W ?35,"Drug ID #",?48,": ",$P(REC1,"^",4)
  1. W !,"Release Status",?17,": ",$P(REC1,"^",2)
  1. W ?35,"Release Type",?48,": ",$P(REC2,"^")
  1. W !,"Rx Status",?17,": ",$P(REC1,"^",10)
  1. W ?35,"NDC",?48,": ",$P(REC1,"^",5)
  1. W !,"Carrier",?17,": ",$P(REC2,"^",5)
  1. W ?35,"Package ID #",?48,": ",$P(REC2,"^",6)
  1. W !,"Date Shipped",?17,": ",$P(REC2,"^",4)
  1. W !,"Processed D/T",?17,": ",$P(REC1,"^",7)
  1. W ?42,"Completed D/T: ",$P(REC1,"^",9)
  1. W !,"Remote Error Cond",?17,": ",$P(REC2,"^",2)
  1. W !,"Cancel Reason",?17,": ",$P(REC1,"^",3)
  1. I $G(LOT)']"" W !,ZQ1,! Q
  1. LOT U PSXP S ZPC=1
  1. L2 S ZL=$P($P(LOT,"/",ZPC),"^"),ZDT=$P($P(LOT,"/",ZPC),"^",2)
  1. I $G(ZL)']"",($G(ZDT))']"" K ZL,ZDT W !,ZQ1,! Q
  1. W !,"LOT #: ",$G(ZL),?35,"Expiration Date: ",$G(ZDT)
  1. ELOT K ZL,ZDT S ZPC=ZPC+1
  1. G L2