- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXARC2 2626 printed Jan 18, 2025@02:44:36 Page 2
- 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