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